「それでも町は廻っている」十番地でまさかのヤマトネタ。原作にはないぞ。ウルトラＱ調の演出で油断させといてあれを入れてくるとは……。
VBSまめちしきー。emailを書いててこの資料のありかはここだよとフルパスを記したいことはよくあって，それ用のアプリ（ExplorerからのDrag&Dropで受けとったフルパスをClipboardに貼りつける）をDelphiやらVBでつくったものだが，現用のPCだと起動がめっちゃくちゃ遅くて――おれのコーディングがださいせいばかりぢゃないと思うんだ――実用性が低い。もうちょっとさっくり動いてもらいたいからフォームなしのVBScriptで書いてみた。てかこんな機能ぐらいExplorer自身がサポートしろよなってハナシだ。
ここで困ったことにはVBScriptはなぜかClipboardを操作できない。できないのよ。ただInternetExplorerがそれをやれるのでCopyするためだけにIEオブジェクトを生成すると言う，これがこのスクリプトのキモである。
フルパスだけでなくファイル名のみ抜いたりFileSchemeぽく"/"区切りにもしたいから，その変換モードごとにwsfをつくって引数を与えることにする。
x:\tool\cp.vbs
'*********************************************************************
'1. wsfファイルから受けとったｎ件のフルパスを編集して，
' Clipboardにcopyする。
'2. 編集モード:
' "F": ファイル名または最下層フォルダ名のみ
' "U": FileSchemeぽくURIに変換
' 以外: 無加工にフルパスのまま
'*********************************************************************
' ver. 1.10 2010.12/11
'*********************************************************************
Option Explicit
sub Main(aryPath, mode)
Dim f, str
str = ""
'フルパスの配列を編集しつつ改行コードで連結
for each f in aryPath
str = str & editPath(f, mode) & vbCR & vbLF
next
'Clipboardへ貼りつけ
call copyToClipboard(str)
end sub
function editPath(s, m)
'渡されたフルパスをmodeに従って編集して返す。
Dim objFS
Dim str
select case m
case "F"
'ファイル名/最下層フォルダ名のみ抽出
set objFS = CreateObject("Scripting.FileSystemObject")
str = objFS.getFileName(s)
set objFS = Nothing
case "U"
'FileSchemeぽく編集
if left(s, 2) = "\\" then
str = "file://" & mid(s, 3, len(s))
else
str = "file:///" & s
end if
str = replace(str, "\", "/")
case else
'デフォルトは無加工
str = s
end select
editPath = str
end function
sub copyToClipboard(s)
'IEObjectを生成してClipboardにCopy。
on error resume next
Dim objIE
set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = false
objIE.Navigate "about:blank"
objIE.Document.ParentWindow.ClipboardData.SetData "text", s
objIE.Quit
set objIE = Nothing
end sub
x:\tool\cp.wsf
<!--
'*********************************************************************
'1. Explorerから受けとったｎ件のフルパスを編集して，
' Clipboardにcopyする。
'2. 編集モード:
' "F": ファイル名または最下層フォルダ名のみ
' "U": FileSchemeぽくURIに変換
' 以外: 無加工にフルパスのまま
'3. 当wsfのショートカットをSendToフォルダに置いてExplorerの右clickで
' 選択ファイルを引き渡す。
'*********************************************************************
' ver. 1.00 2010.12/11
'*********************************************************************
-->
<package>
<job id="CTC">
<reference GUID="{00020813-0000-0000-C000-000000000046}" />
<script language="VBScript" src="cp.vbs"></script>
<script language="VBScript">
call Main(WScript.Arguments, "") '"": 無加工
</script>
</job>
</package>
x:\tool\cpF.wsf
<package>
<job id="CTC">
<reference GUID="{00020813-0000-0000-C000-000000000046}" />
<script language="VBScript" src="cp.vbs"></script>
<script language="VBScript">
call Main(WScript.Arguments, "F") '"F": ファイル名のみ
</script>
</job>
</package>
x:\tool\cpU.wsf
<package>
<job id="CTC">
<reference GUID="{00020813-0000-0000-C000-000000000046}" />
<script language="VBScript" src="cp.vbs"></script>
<script language="VBScript">
call Main(WScript.Arguments, "U") '"U": URIぽくFileScheme調
</script>
</job>
</package>
あとはみっつのwsfのショートカットをSendToフォルダに置いて，Explorerでファイル/フォルダを選択して［送る］すればいい。そうしてここまで書いてきて実際に動かしてみたら大して速くもなくてがっくりしているところである。
