'==================================================================
'「送る」に「画像から img タグ作成」のショートカットを作りますYO！
'http://www10.plala.or.jp/palm84/wsh.html
'http://palm84.hatenablog.com/entry/20150509/1431152354
'http://www10.plala.or.jp/palm84/archives/wsh/Create_HTML_img_tag-sendto.vbs.txt
'https://eu7w9wsmf6a74xyjdfzl3q-on.drv.tw/archives/wsh/Create_HTML_img_tag-sendto.vbs.txt
'==================================================================
'Shell オブジェクトを作成
Set objShell = WScript.CreateObject("WScript.Shell")
'FileSystemObject オブジェクトを作成
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Title = "画像から img タグ作成"

MyKakunin

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

'*** HTML_img_tag.vbs ***
strFile = CuDir & "\HTML_img_tag1.vbs"
strWorkingDirectory = ""
strIcon = "%SystemRoot%\system32\imageres.dll, 67"

If objFSO.FileExists(strFile) Then
		MySC
	Else 
		Set objTxt = objFSO.OpenTextFile(strFile, ForWriting, true, -2)
		objTxt.WriteLine "'=================================================================="
		objTxt.WriteLine "'HTML用、画像のimgタグ作成しますYO!"
		objTxt.WriteLine "'http://d.hatena.ne.jp/palm84/20100325/1269525360"
		objTxt.WriteLine "'http://palm84.hatenablog.com/entry/20150509/1431152354"
		objTxt.WriteLine "'http://www10.plala.or.jp/palm84/archives/wsh/HTML_img_tag.vbs.txt"
		objTxt.WriteLine "'=================================================================="
		objTxt.WriteLine "'On Error Resume Next"
		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 "Dim objFSO,objTxt,objShell,objFile"
		objTxt.WriteLine "Set objFSO = WScript.CreateObject(""Scripting.FileSystemObject"")"
		objTxt.WriteLine ""
		objTxt.WriteLine "' 環境変数の値を取得"
		objTxt.WriteLine "Set objShell = WScript.CreateObject(""WScript.Shell"")"
		objTxt.WriteLine "Dim TEMP"
		objTxt.WriteLine "TEMP = objShell.ExpandEnvironmentStrings(""%Temp%"")"
		objTxt.WriteLine "' ログファイル"
		objTxt.WriteLine "Const ForReading = 1, ForWriting = 2, ForAppending = 8"
		objTxt.WriteLine "Dim LogFile"
		objTxt.WriteLine "LogFile = TEMP & ""\MyHTML_img_tag.txt"""
		objTxt.WriteLine "Set objTxt = objFSO.OpenTextFile(LogFile, ForWriting, true, -2)"
		objTxt.WriteLine ""
		objTxt.WriteLine "Dim strOSVersion"
		objTxt.WriteLine "'Sub"
		objTxt.WriteLine "MyOperatingSystem"
		objTxt.WriteLine "MyImgTag"
		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 MyOperatingSystem"
		objTxt.WriteLine "'*********************************************************"
		objTxt.WriteLine "Sub MyOperatingSystem"
		objTxt.WriteLine vbTab & "On Error Resume Next"
		objTxt.WriteLine vbTab & "Dim strComputer, objWMIService, colItems, objItem"
		objTxt.WriteLine vbTab & "strComputer = ""."""
		objTxt.WriteLine vbTab & "Set objWMIService = GetObject(""winmgmts:\\"" & strComputer & ""\root\cimv2"")"
		objTxt.WriteLine vbTab & "Set colItems = objWMIService.ExecQuery(""Select * from Win32_OperatingSystem"",,48)"
		objTxt.WriteLine vbTab & "'Const Reg_ProductName = ""HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName"""
		objTxt.WriteLine vbTab & "For Each objItem in colItems"
		objTxt.WriteLine vbTab & vbTab & "strOSVersion = objItem.Version"
		objTxt.WriteLine vbTab & "Next"
		objTxt.WriteLine vbTab & "If InStr(strOSVersion, ""5.0."") > 0 Then"
		objTxt.WriteLine vbTab & vbTab & "MsgBox ""Windows 2000 では使えないクマー (´；ω；`) "",48 ,""I am Sorry, ヒゲソ..（ｒｙ"""
		objTxt.WriteLine vbTab & vbTab & "WScript.Quit"
		objTxt.WriteLine vbTab & "End If"
		objTxt.WriteLine vbTab & "Set objWMIService = Nothing"
		objTxt.WriteLine vbTab & "On Error GoTo 0"
		objTxt.WriteLine "End Sub"
		objTxt.WriteLine ""
		objTxt.WriteLine "'*********************************************************"
		objTxt.WriteLine "'* Sub MyImgTag -- 画像のimgタグ作成しますYO!"
		objTxt.WriteLine "'*********************************************************"
		objTxt.WriteLine "Sub MyImgTag"
		objTxt.WriteLine vbTab & "Dim objShellApp"
		objTxt.WriteLine vbTab & "' Shell.Application オブジェクト作成"
		objTxt.WriteLine vbTab & "Set objShellApp = CreateObject(""Shell.Application"")"
		objTxt.WriteLine vbTab & "' 引数（指定ファイル）を strFilePath へ"
		objTxt.WriteLine vbTab & "Dim strFilePath"
		objTxt.WriteLine vbTab & "For Each strFilePath In WScript.Arguments"
		objTxt.WriteLine vbTab & vbTab & "If objFSO.FileExists(strFilePath) Then"
		objTxt.WriteLine vbTab & vbTab & vbTab & "Set objFile = objFSO.GetFile(strFilePath)"
		objTxt.WriteLine vbTab & vbTab & vbTab & "' ファイル名を取得"
		objTxt.WriteLine vbTab & vbTab & vbTab & "Dim strFileName"
		objTxt.WriteLine vbTab & vbTab & vbTab & "strFileName = objFSO.GetFileName(strFilePath)"
		objTxt.WriteLine vbTab & vbTab & vbTab & "' 親フォルダ名を取得"
		objTxt.WriteLine vbTab & vbTab & vbTab & "Dim strFolder"
		objTxt.WriteLine vbTab & vbTab & vbTab & "strFolder = objFile.ParentFolder"
		objTxt.WriteLine vbTab & vbTab & vbTab & "' フォルダ情報取得"
		objTxt.WriteLine vbTab & vbTab & vbTab & "Dim objFolder, objFolderItems, objItem"
		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 vbTab & vbTab & vbTab & "Dim pxWidth, pxHeight"
		objTxt.WriteLine vbTab & vbTab & vbTab & "Dim n, strName"
		objTxt.WriteLine vbTab & vbTab & vbTab & "For n=18 to 400"
		objTxt.WriteLine vbTab & vbTab & vbTab & vbTab & "strName = objFolder.GetDetailsOf(Nothing, n)"
		objTxt.WriteLine vbTab & vbTab & vbTab & vbTab & "If strName = ""幅"" Then"
		objTxt.WriteLine vbTab & vbTab & vbTab & vbTab & vbTab & "pxWidth = objFolder.GetDetailsOf(objItem, n)"
		objTxt.WriteLine vbTab & vbTab & vbTab & vbTab & "End If"
		objTxt.WriteLine vbTab & vbTab & vbTab & "Next"
		objTxt.WriteLine vbTab & vbTab & vbTab & "Dim m, strName2"
		objTxt.WriteLine vbTab & vbTab & vbTab & "For m=18 to 400"
		objTxt.WriteLine vbTab & vbTab & vbTab & vbTab & "strName2 = objFolder.GetDetailsOf(Nothing, m)"
		objTxt.WriteLine vbTab & vbTab & vbTab & vbTab & "If strName2 = ""高さ"" Then"
		objTxt.WriteLine vbTab & vbTab & vbTab & vbTab & vbTab & "pxHeight = objFolder.GetDetailsOf(objItem, m)"
		objTxt.WriteLine vbTab & vbTab & vbTab & vbTab & "End If"
		objTxt.WriteLine vbTab & vbTab & vbTab & "Next"
		objTxt.WriteLine vbTab & vbTab & vbTab & "' 数値以外を置換（消去）"
		objTxt.WriteLine vbTab & vbTab & vbTab & "pxWidth = Replace(pxWidth, "" ピクセル"", """")"
		objTxt.WriteLine vbTab & vbTab & vbTab & "pxHeight = Replace(pxHeight, "" ピクセル"", """")"
		objTxt.WriteLine vbTab & vbTab & vbTab & "' 7 / Vista なら先頭ユニコード文字を除去"
		objTxt.WriteLine vbTab & vbTab & vbTab & "If InStr(strOSVersion, ""6."") > 0 Or InStr(strOSVersion, ""10."") > 0 Then"
		objTxt.WriteLine vbTab & vbTab & vbTab & vbTab & "pxWidth = Mid(pxWidth, 2)"
		objTxt.WriteLine vbTab & vbTab & vbTab & vbTab & "pxHeight = Mid(pxHeight, 2)"
		objTxt.WriteLine vbTab & vbTab & vbTab & "End If"
		objTxt.WriteLine vbTab & vbTab & vbTab & "' テキストへ書き出し"
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write ""<p"""
		objTxt.WriteLine vbTab & vbTab & vbTab & "' ============================================"
		objTxt.WriteLine vbTab & vbTab & vbTab & "' ***** class 属性追加はこの下行を有効に *****"
		objTxt.WriteLine vbTab & vbTab & vbTab & "' ============================================"
		objTxt.WriteLine vbTab & vbTab & vbTab & "'objTxt.Write "" class=""""overflow2"""""""
		objTxt.WriteLine vbTab & vbTab & vbTab & "' ============================================"
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write "">"""
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write ""<img src="""""""
		objTxt.WriteLine vbTab & vbTab & vbTab & "' ============================================"
		objTxt.WriteLine vbTab & vbTab & vbTab & "' ***** この下行に URL or 相対パスを付記  ""./images/nantoka/"" とか ***** "
		objTxt.WriteLine vbTab & vbTab & vbTab & "' ============================================"
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write ""./images/"""
		objTxt.WriteLine vbTab & vbTab & vbTab & "' ============================================"
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write strFileName"
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write """""" width="""""""
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write pxWidth"
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write """""" height="""""""
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write pxHeight"
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write """""" alt="""""""
		objTxt.WriteLine vbTab & vbTab & vbTab & "' ============================================"
		objTxt.WriteLine vbTab & vbTab & vbTab & "' hogehoge は画像の説明に換えませう"
		objTxt.WriteLine vbTab & vbTab & vbTab & "' ""何々のスクリーンショット""  とか"
		objTxt.WriteLine vbTab & vbTab & vbTab & "' ============================================"
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write ""hogehogeのスクリーンショット"""
		objTxt.WriteLine vbTab & vbTab & vbTab & "' ============================================"
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write """""">"""
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write ""</p>"""
		objTxt.WriteLine vbTab & vbTab & vbTab & "objTxt.Write vbCrLf"
		objTxt.WriteLine vbTab & vbTab & vbTab & "Set objItem = Nothing"
		objTxt.WriteLine vbTab & vbTab & vbTab & "Set objFolderItems = Nothing"
		objTxt.WriteLine vbTab & vbTab & vbTab & "Set objFolder = Nothing"
		objTxt.WriteLine vbTab & vbTab & vbTab & "Set objFile = Nothing"
		objTxt.WriteLine vbTab & vbTab & "End If"
		objTxt.WriteLine vbTab & "Next"
		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

'*********************************************************
'Sub MyKakunin
'*********************************************************
Sub MyKakunin
Kakunin = MsgBox ("「送る」に「" & 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