'==================================================================
'「送る」に「バックアップコピー」のショートカットを作りますYO！
'http://www10.plala.or.jp/palm84/wsh.html
'http://palm84.hatenablog.com/entry/20160306/1457226682
'http://www10.plala.or.jp/palm84/archives/wsh/Create_BackupCopy_date-time-sendto.vbs.txt
'https://eu7w9wsmf6a74xyjdfzl3q-on.drv.tw/archives/wsh/Create_BackupCopy_date-time-sendto.vbs.txt
'==================================================================
'最終更新 2022.09.29 Windows 11 向けアイコン変更
'更新 2019.08.14 Windows 8 対応？
'更新 2018.05.03
'Shell オブジェクトを作成
Set objShell = WScript.CreateObject("WScript.Shell")
'FileSystemObject オブジェクトを作成
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const Reg_ReleaseId = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ReleaseId"
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=  regOS()
If myOS = "Windows 10" Then
	myReleaseId = objShell.RegRead(Reg_ReleaseId)
End If
myDisplayVersion = objShell.RegRead(Reg_DisplayVersion)

MyKakunin

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

'*** ショートカット設定 ***
strFile = SendTo & "\BackupCopy_date-time-sendto.bat"
strWorkingDirectory = ""
strIcon = "%SystemRoot%\system32\shell32.dll, 310"
If myOS = "Windows 11" Then strIcon = "%SystemRoot%\system32\shell32.dll, 310"
If myOS = "Windows 10" Then strIcon = "%SystemRoot%\system32\shell32.dll, 311"
If myOS = "Windows 10" And myReleaseId >= "1703" Then
	strIcon = "%SystemRoot%\system32\shell32.dll, 312"
End If
If myOS = "Windows 7" Then strIcon = "%SystemRoot%\system32\shell32.dll, 284"
strFolder = SendTo
If objFSO.FileExists(strFile) Then objFSO.DeleteFile(strFile)
Set objTxt = objFSO.OpenTextFile(strFile, ForWriting, true, -2)
With objTxt
	.WriteLine "@echo off"
	.WriteLine "title %~nx0"
	.WriteLine "REM ********************************************************************"
	.WriteLine "REM   * 右クリック「送る」に「バックアップコピー」"
	.WriteLine "REM  http://www10.plala.or.jp/palm84/commandline.html"
	.WriteLine "REM  http://palm84.hatenablog.com/entry/20160306/1457226682"
	.WriteLine "REM ********************************************************************"
	.WriteLine "if ""%~1""=="""" GOTO NO_PARAM"
	.WriteLine ""
	.WriteLine ":PARAM"
	.WriteLine "if ""%~1""=="""" GOTO DONE"
	.WriteLine "REM # check directory"
	.WriteLine "set ""FileName=%~n1"""
	.WriteLine "for %%x in (""%~a1"") do set check_dir=%%~x"
	.WriteLine "if /i ""%check_dir:~0,1%""==""d"" ("
	.WriteLine "call :FILECHAU"
	.WriteLine "shift"
	.WriteLine "GOTO PARAM"
	.WriteLine ")"
	.WriteLine "REM # BackupCopy"
	.WriteLine "set ""Source=%~nx1"""
	.WriteLine "echo:"
	.WriteLine "echo:"
	.WriteLine "echo        =============================================================="
	.WriteLine "echo         * %Source%"
	.WriteLine "REM ## date-time"
	.WriteLine "set now=%date%-%time%"
	.WriteLine "set now=%now: =0%"
	.WriteLine "set now=%now:~-20,2%%now:~-17,2%%now:~-14,5%%now:~-8,2%%now:~-5,2%"
	.WriteLine "for %%I in (""%Source%"") do set Target=%%~nI-%now%%%~xI"
	.WriteLine "echo:"
	.WriteLine "echo         * %Target%"
	.WriteLine "echo        =============================================================="
	.WriteLine "pushd %~dp1"
	.WriteLine "copy ""%Source%"" ""%Target%"""
	.WriteLine "shift"
	.WriteLine "GOTO PARAM"
	.WriteLine ""
	.WriteLine ""
	.WriteLine "REM #####################################"
	.WriteLine "REM ### NO_PARAM"
	.WriteLine "REM #####################################"
	.WriteLine ":NO_PARAM"
	.WriteLine "echo:"
	.WriteLine "echo        =============================================================="
	.WriteLine "echo                    ！引数（ファイル指定）がないですYO！"
	.WriteLine "echo        =============================================================="
	.WriteLine "echo:"
	.WriteLine "GOTO END"
	.WriteLine ""
	.WriteLine "REM #####################################"
	.WriteLine "REM ### FILECHAU"
	.WriteLine "REM #####################################"
	.WriteLine ":FILECHAU"
	.WriteLine "echo:"
	.WriteLine "echo        =============================================================="
	.WriteLine "echo         ！ %FileName%"
	.WriteLine "echo:"
	.WriteLine "echo         ！      ... はファイルちゃいます"
	.WriteLine "echo        =============================================================="
	.WriteLine "echo:"
	.WriteLine "exit /b"
	.WriteLine ""
	.WriteLine "REM #####################################"
	.WriteLine "REM ### Done !"
	.WriteLine "REM #####################################"
	.WriteLine ":DONE"
	.WriteLine "echo."
	.WriteLine "echo        **************************************************************"
	.WriteLine "echo        **********              Done !                      **********"
	.WriteLine "echo        **************************************************************"
	.WriteLine "echo:"
	.WriteLine "REM #####################################"
	.WriteLine "REM ### done !"
	.WriteLine "REM #####################################"
	.WriteLine ":END"
	.WriteLine "echo:"
	.WriteLine "echo                     *** 何かキーを押すと閉じます *** "
	.WriteLine "pause >nul"
	.Close
End With
Set objFile = objFSO.GetFile(strFile)
objFile.Attributes = objFile.Attributes + 2
MySC

MsgBox "「送る」に「" & Title & "」のショートカットを作成しました YO！",64 ,"(´･ω･`) クマー！ "

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 & "にショートカットを作成しました。" 

End Sub