'==================================================================
'「送る」に「ファイルのバージョンチェック」のショートカットを作りますYO！
'http://www10.plala.or.jp/palm84/wsh.html
'http://palm84.hatenablog.com/entry/
'http://www10.plala.or.jp/palm84/archives/wsh/Create_FileVersion-sendto.vbs.txt
'https://eu7w9wsmf6a74xyjdfzl3q-on.drv.tw/archives/wsh/Create_FileVersion-sendto.vbs.txt
'==================================================================
'最終更新 2022.09.30 Windows 11 向けアイコン変更
'Shell オブジェクトを作成
Set objShell = WScript.CreateObject("WScript.Shell")
'FileSystemObject オブジェクトを作成
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const Reg_ProductName = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName"
Const Reg_DisplayVersion = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DisplayVersion"
Const Reg_CurrentBuildNumber = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentBuildNumber"
Title = "ファイルのバージョンチェック"


'*** OSバージョン取得 ***
'myOS = objShell.RegRead(Reg_ProductName)
myOS=  regOS()
myDisplayVersion = objShell.RegRead(Reg_DisplayVersion)

MyKakunin

'*** 環境変数とか取得 ***
SendTo = objShell.SpecialFolders("SendTo")
CuDir = objShell.CurrentDirectory

'*** FileVersion1.vbs ***
strFile = CuDir & "\FileVersion1.vbs"
strWorkingDirectory = ""
strIcon = "%SystemRoot%\system32\imageres.dll, 293"
'If InStr(myOS, "Windows 10") > 0 Then strIcon = "%SystemRoot%\system32\imageres.dll, 300"
If myOS = "Windows 11" Then strIcon = "%SystemRoot%\system32\imageres.dll, 307"
If myOS = "Windows 10" Then strIcon = "%SystemRoot%\system32\imageres.dll, 306"
If myOS = "Windows 7" Then strIcon = "%SystemRoot%\system32\imageres.dll, 2"

If objFSO.FileExists(strFile) Then
		MySC
	Else 
		Set objTxt = objFSO.OpenTextFile(strFile, ForWriting, true, -2)
		objTxt.WriteLine "'=================================================================="
		objTxt.WriteLine "' ファイルのバージョンチェック・テキストへ書き出し"
		objTxt.WriteLine "'http://www10.plala.or.jp/palm84/wsh.html"
		objTxt.WriteLine "'http://www10.plala.or.jp/palm84/archives/wsh/FileVersion1.vbs.txt"
		objTxt.WriteLine "'=================================================================="
		objTxt.WriteLine "Option Explicit"
		objTxt.WriteLine ""
		objTxt.WriteLine "If WScript.Arguments.Count = 0 Then"
		objTxt.WriteLine vbTab & "MsgBox ""ファイルが選択されてませんクマー (´･ω･`)"",48 ,""クマー？ (´；ω；`)"""
		objTxt.WriteLine vbTab & "WScript.Quit"
		objTxt.WriteLine "End If"
		objTxt.WriteLine ""
		objTxt.WriteLine "' FileSystemObject オブジェクト作成"
		objTxt.WriteLine "Dim objFSO, objShell"
		objTxt.WriteLine "Set objFSO = WScript.CreateObject(""Scripting.FileSystemObject"")"
		objTxt.WriteLine "' Shell オブジェクト作成"
		objTxt.WriteLine "Set objShell = WScript.CreateObject(""WScript.Shell"")"
		objTxt.WriteLine ""
		objTxt.WriteLine "' 環境変数の値を取得"
		objTxt.WriteLine "'Dim TEMP"
		objTxt.WriteLine "'TEMP = objShell.ExpandEnvironmentStrings(""%temp%"")"
		objTxt.WriteLine ""
		objTxt.WriteLine "' ログファイル"
		objTxt.WriteLine "Dim appPath, LogFile"
		objTxt.WriteLine "appPath = objFSO.GetParentFolderName(WScript.ScriptFullName)"
		objTxt.WriteLine "LogFile = appPath & ""\FileVersion_log1.txt"""
		objTxt.WriteLine "Const ForReading = 1, ForWriting = 2, ForAppending = 8"
		objTxt.WriteLine "Dim objTxt"
		objTxt.WriteLine "'Set objTxt = objFSO.OpenTextFile(LogFile, ForWriting, true, -2)"
		objTxt.WriteLine "Set objTxt = objFSO.OpenTextFile(LogFile, ForWriting, true, -1)"
		objTxt.WriteLine ""
		objTxt.WriteLine "MyFileVer"
		objTxt.WriteLine ""
		objTxt.WriteLine "objTxt.Close"
		objTxt.WriteLine "objShell.Run """""""" & LogFile & """""""""
		objTxt.WriteLine "Set objTxt = Nothing"
		objTxt.WriteLine "Set objFSO = Nothing"
		objTxt.WriteLine "Set objShell = Nothing"
		objTxt.WriteLine ""
		objTxt.WriteLine "'*********************************************************"
		objTxt.WriteLine "'Sub MyFileVer"
		objTxt.WriteLine "'*********************************************************"
		objTxt.WriteLine "Sub MyFileVer"
		objTxt.WriteLine "Dim objFile, objFolder, objFolderItems, objItem"
		objTxt.WriteLine "Dim strPath, strFileName, strFolder, strName, strName2, strName3, strName4, strName5"
		objTxt.WriteLine "' Shell.Application オブジェクト作成"
		objTxt.WriteLine "Dim objShellApp"
		objTxt.WriteLine "Set objShellApp = CreateObject (""Shell.Application"") "
		objTxt.WriteLine vbTab & "For Each strPath In WScript.Arguments"
		objTxt.WriteLine vbTab & vbTab & "If objFSO.FileExists(strPath) Then"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "Set objFile = objFSO.GetFile(strPath)"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "strFileName = objFSO.GetFileName(strPath)"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "strFolder = objFile.ParentFolder"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "Set objFolder = objShellApp.Namespace (strFolder) "
		objTxt.WriteLine vbTab & vbTab &  vbTab & "Set objFolderItems = objFolder.Items"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "Set objItem = objFolderItems.Item(strFileName)"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "objTxt.WriteLine ""========================================================="""
		objTxt.WriteLine vbTab & vbTab &  vbTab & "objTxt.WriteLine strPath"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "objTxt.WriteLine ""========================================================="""
		objTxt.WriteLine vbTab & vbTab &  vbTab & "On Error Resume Next"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "Dim n"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "For n=0 to 400"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "strName = objFolder.GetDetailsOf(Nothing, n)"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "If strName = ""ファイル バージョン"" Then"
		objTxt.WriteLine vbTab & vbTab &  vbTab & vbTab & "objTxt.WriteLine ""File Version    : "" & objFolder.GetDetailsOf(objItem, n)"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "End If"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "Next"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "Dim m"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "For m=0 to 400"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "strName2 = objFolder.GetDetailsOf(Nothing, m)"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "If strName2 = ""製品バージョン"" Then"
		objTxt.WriteLine vbTab & vbTab &  vbTab & vbTab & "objTxt.WriteLine ""Product Version : "" & objFolder.GetDetailsOf(objItem, m)"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "End If"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "Next"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "Dim l"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "For l=0 to 400"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "strName3 = objFolder.GetDetailsOf(Nothing, l)"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "If strName3 = ""説明"" Then"
		objTxt.WriteLine vbTab & vbTab &  vbTab & vbTab & "objTxt.WriteLine ""説明            : "" & objFolder.GetDetailsOf(objItem, l)"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "End If"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "Next"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "Dim k"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "For k=0 to 400"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "strName4 = objFolder.GetDetailsOf(Nothing, k)"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "If strName4 = ""ファイルの説明"" Then"
		objTxt.WriteLine vbTab & vbTab &  vbTab & vbTab & "objTxt.WriteLine ""ファイルの説明  : "" & objFolder.GetDetailsOf(objItem, k)"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "End If"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "Next"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "On Error GoTo 0"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "objTxt.WriteLine ""最終更新日時    : "" & objFolder.GetDetailsOf(objItem, 3)"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "objTxt.WriteLine ""作成日時        : "" & objFolder.GetDetailsOf(objItem, 4)"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "objTxt.WriteLine ""サイズ          : "" & objFolder.GetDetailsOf(objItem, 1)"
		objTxt.WriteLine vbTab & vbTab & "End If"
		objTxt.WriteLine vbTab & "Next"
		objTxt.WriteLine vbTab & vbTab &  vbTab & "objTxt.WriteLine ""========================================================="""
		objTxt.WriteLine vbTab & "Set objShellApp = Nothing"
		objTxt.WriteLine "End Sub"
		objTxt.Close
		MySC
End If

Set objTxt = Nothing
Set objShortCut = Nothing
Set objFile = Nothing
Set objFSO = Nothing
Set objShortcut = Nothing
Set objShell = Nothing

'*********************************************************
'* Function regOS
'*********************************************************
Function regOS()
regOS = objShell.RegRead(Reg_ProductName)
If objShell.RegRead(Reg_CurrentBuildNumber) >= "22000" Then
		regOS = "Windows 11"
	ElseIf InStr(regOS, "Windows 10") > 0  Then 
		regOS = "Windows 10"
	ElseIf InStr(regOS, "Windows 8") > 0 Then
		regOS = "Windows 8"
	ElseIf InStr(regOS, "Windows 7") > 0 Then
		regOS = "Windows 7"
End If
'WScript.Echo myOS
End Function

'*********************************************************
' Sub MyKakunin
'*********************************************************
Sub MyKakunin
Kakunin = MsgBox (myOS & " バージョン " & myDisplayVersion & vbCrLf & "「送る」に「" & Title & "」のショートカットを作りますのん？ (´･ω･`)", 65 ,"「送る」に「" & Title & "」のショートカットを作るＹＯ！  (´･ω･`) ") 
If Kakunin = 2 Then
	WScript.Quit
End If
End Sub

'*********************************************************
' Sub MySC
'*********************************************************
Sub MySC
strShortCut = SendTo & "\" & Title & ".lnk"
'*** ショートカットオブジェクトを作成 ***
Set objShortCut = objShell.CreateShortcut(strShortCut)
With objShortCut
' リンク先
	.TargetPath = strFile
' 作業フォルダ
	.WorkingDirectory = strWorkingDirectory
' 引数
	.Arguments = "" 
' コメント
	.Description = ""
' アイコン
	.IconLocation = strIcon
End With
objShortCut.Save

' ショートカットを DeskTop へコピー
' objFSO.CopyFile strShortCut, DeskTop & "\"
'WScript.Echo strFileName & "にショートカットを作成しました。" 
MsgBox "「送る」に「" & Title & "」のショートカットを作成しました YO！"  & vbcrlf & vbcrlf & Title,64 ,"(´･ω･`) クマー！ "

End Sub