2009/03/17

VBScriptでWSE そにょ2・・・


WindowsScriptEncoderを便利に・・・のスクリプト、更新しました。
アーカイブも差し替えました。

・jsファイルのエンコードにも対応させました。
・変換済みファイルが既存の場合、Renameして保護した後、新規にエンコードファイルを作成します。
 それに伴い、変換実行承認画面は廃しました。
・全体の実行開始確認と、終了報告メッセージを追加し、大量変換や操作ミス回避等にも対応させました。

なにぶん当然過ぎたので、結構肝心な説明と思わしきコトが抜けてたんだけど、
WindowsScriptEncoderは、アーカイブに含めるコトができません。
自身で、MSサイトからゲトしてください。 Windows使ってれば無料だし・・・

   VBSEncodeConnection.zip    
▲ を、右クリックしてファイルとして保存してください。

    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
'VBSEncodeConnection
'- Created by LazwardFox -

'パラメータ指定、ないし、vbs/jsファイルドロップで、
'同一フォルダ上にエンコード済みファイル(.vbe/.jse)を作成する。
'このスクリプトのショートカットに対してドロップしても有効。
'テキストエディタなどのマクロに登録しての利用も可

'単独起動 - 無効

' Update 20090317 2103 ScriptEncodeConnection完成までの暫定版として仕上げ
' Update 20090317 1822 JavaScriptへの対応、
' オートバックアップ機能追加(確認画面廃止)
' Update 20090309 1901 発行向けに調整
' Update 20090210 0109
' Release 20050112 1213
' DevStart 20050111 2117

'***** ↓↓↓ ObjectDecralations ↓↓↓ *************************************************
Dim Args, Wsh, Fs

Set Args = WScript.Arguments 'パラメーター取得
If Args.Count <= 0 Then
Set Args = Nothing
Wscript.Quit
End If
Set Wsh = WScript.CreateObject("WScript.Shell")
Set Fs = WScript.CreateObject("Scripting.FileSystemObject") 'ファイル操作

'***** ↓↓↓Decralations↓↓↓ *********************************************************
Dim sTitle, vbSp, vbTc, vbCt, vbWt, vbTs, vbCs
Dim tFile, bE, bF, tR, rE, sF, cF, rF, oF, pTarget

Const vbWq = """"
Const Enc = "C:\Program Files\Windows Script Encoder\screnc.exe"
sTitle = Fs.GetBaseName(Wscript.ScriptName)
Start = Wsh.PopUp("ConvertStart?",15,sTitle,33)
If Start = -1 Or Start = 2 Then
Set Args = Nothing
Set Fs = Nothing
Set Wsh = Nothing
Wscript.Quit
End If

vbSp = " "
vbTc = vbTab & vbCrlf
vbCt = vbCrlf & vbTab
vbWt = vbWq & vbTab
vbTs = String(2,vbTab)
vbCs = String(2,vbCrLf)

'nDT = iDT(""," ","",0)

'***** ↓↓↓MainRoutine↓↓↓ *********************************************************
For iC = 0 To Args.count - 1
tFiles = Args(iC)
If Fs.FileExists(tFiles) then
bE = Lcase(Fs.GetExtensionName(tFiles))
If bE = "vbs" Or bE = "js" Then
bF = Fs.GetBaseName(tFiles) 'NameOnly
tR = Fs.GetParentFolderName(tFiles) 'RoorFolder
rE = "." & Left(bE,2) & "e" 'NewExt
sF = vbWq & tFiles & vbWq 'vbs/js
cF = Fs.BuildPath(tR,bF & rE) 'vbe/jse
If Fs.FileExists(cF) Then
rF = bF & " " & iDT(""," ","",0) & rE
'rF = bF & " " & nDT & rE
Set oF = Fs.GetFile(cF)
oF.Name = rF
Set oF = Nothing
End If
pTarget = vbWq & Enc & vbWq & " " & sF & " " & vbWq & cF & vbWq
Wsh.Run pTarget, 0
End If
End If
Next
Set Args = Nothing
Set Fs = Nothing
Wsh.PopUp "Encoded",5,sTitle
Set Wsh = Nothing
Wscript.Quit

'***** ↓↓↓Functions↓↓↓ *********************************************************
'------------------------------------
'iDT - 日時文字列 ないし 日/時配列取得 for VBScript
'- Created by LazwardFox -

' Update 20090228 0458 変数宣言変更
' Update 20090223 0959 時刻桁処理変更
' Update 20090223 0253 Len記述忘れ修正
' Update 20090223 0135 変数宣言忘れ修正
' Update 20090210 0218
' Update 20090210 0115
' Release 20090209 2035

' iDT (
' dSplitter - DateSplitString (Normal - "/")
' ,dtSeparater - Date/Time SepaleteString (Normal - " ")
' ,tSplitter - TimeSplitString (Normal - ":")
' ,Control - 配列化 0 or 1 (Default - 1)
' )

Public Function iDT(dSplitter,dtSeparater,tSplitter,Control)
Dim nX, nD, nS, strHMS, sResult 'Update 20090228 0458
nX = Now()
nD = FormatDateTime(Date(),0)
nS = ":" & Split(CStr(FormatDateTime(nX,3)),":")(2) 'Update 20090223 0951
strHMS = FormatDateTime(nX,4) & nS 'Update 20090223 0951
If tSplitter = ":" Then
Else
strHMS = Replace(strHMS,":",tSplitter)
End If
sResult = Cstr(Replace(nD,"/",dSplitter)) & "*" & strHMS
If Control = 1 Then
iDT = Split(sResult,"*")
Else
iDT = Replace(sResult,"*",dtSeparater)
End If
End Function
<そのまま使えるVBscript WindowsScriptEncoder 容易 使い方>

やってもうた & しんどい・・・


結局、ココにうpしたブツの体裁整えるのに、連続15時間以上費やしてしまった・・・
もう、背中がイタい^_^;

・・・先の追加分スクリプトをうp向けに修正して、ソレで古いものを見やすく変換したアト 対象を差し替え、
更にコメ書式充て機能付けたので、また変換して差し替えて、途中、貼り先間違えたり・・・
ソレを直したと、思ったら、今度はBloggerのヘンなクセに振り回され再修正・・・
また再度全てを差し替える・・・

つか先日、コメント書式充て機能が付く前のブツで変換したモノも、
差し替えたときに、貼り付け先間違えてて、今朝まで そのままになってたし~m(_ _)m

んで、ようやっと整った次第・・・
まぁ今後は、スクリプトモノのうpは楽になるワナ^_^;

VBScriptでラクをする そにょ2・・・


VB/JavaScript作成は、フリーのテキストエディタ VxEditorを利用させてもらっている。
拡張子毎に、表示条件を設定できるのも便利だ。
ちなみに当方のVBScript向け設定は、以下アーカイブ内のファイルで再現できる。

   VxEditor - VBScript.zip    
▲ を、右クリックしてファイルとして保存してください。


また、記述の際、自分で処理を追いやすくする為、Tabを結構多用する。コメントもまた然りだ。
それらをVXの見た目のまま サイトうpするのには、手作業では結構手間だ。

そもそもBloggerでは、Tabがスペースに置換されてしまうし、
ああいったコードを使うのは、閲覧者サイドの環境にも依存してしまう・・・

で、少し前に、Tabを4つのスペースに置き換えるだけのスクリプトを組んだ。
ドロップすれば、日時付きファイル名で、処理済ファイルが出来た。

だが、コメント部分に書式を割り当てたいと欲が出た。
しかし、これも手作業では結構難だ・・・

そこで、今しがた、前述のスクリプトを改良して出来上がったのが、
   s2Hcnv.zip    
▲ を、右クリックしてファイルとして保存してください。

実のトコ、デバッグ中に、思わぬ難があった。
まず、' クォーテーション、VBScriptでのコメントを表すアレだ。
コイシをInStrで単純走査した結果で書式充てを処理したら、
実行処理内の文字列としてのクォーテーション"'"でまで、コメント向け書式を充ててしまう結果に・・・(-_-;)
結局Do~Loopで、' と "'" を探す処理を繰り返して、差異を検知して回避した。

次に変換ソース、スクリプトを主にターゲットとして作成したとは云え、
文字列としてHTMLタグが入る可能性は大きい、つか、今回のモノがそうだった・・・(´ヘ`;)
で、試行錯誤の後、対策として、< を HTMLコードに置換するように変えてみた・・・ 一見スゴく良かったのだが、
逆に、このHTMLコード自体を、そのままの見た目で必要とする部分に表記できない と云うジレンマが・・・(゚Д゚;)

今回は、このスクリプト自身も完全に変換できるようにしたいっっ! と、云うコトで、
少し無駄だが、変数宣言部に
    ltc = Split("&,l,t,;",",")     
sltc = Join(ltc,"")
を、追加して対応、目的達成と相成った。

また、このスクリプトを利用して作成されたテキストを利用する際には、
対象となるサイトに、以下のようなスタイルシートの記述が必要になる。
(様式は任意で変更してもらってイイと思う)
    <style type="text/css">     

.ScriptExp
{
background-color: #FFFFFF;
border: 0;
align: center;
color: #1e50a2;
line-height: 100%;
}
.ScriptComments
{
font-weight: normal;
color: #FFFFFF;
background-color: #288285;
border: 0;
}

</style>



今回も、既出でない関数を追加した
レジストリから、既定のテキストエディタのパスを取得するだけのモノ・・・
    '------------------------------------     
'TextViwer - テキストファイルを開く既定アプリケーションをフルパスで返します。
'- Created by LazwardFox -

' Release 20090315 2053
' DevStart 20090315 0938

TextViewer(
ResultKey 既定のテキストエディタのパスをレジストリより取得し返します。
任意の変数を割り当ててください。
)

確かに、こんな面倒な手順を踏まなくとも、rundll32 url.dll で、処理すれば、
適切なアプリケーションで勝手に開いてくれるのだが、前ログのフォルダの例も含め、
通常開くアプリケーションを変更している向きには、意外に使いが悪い場合もあったり、
その逆もまた然り だったりで、こういう処理方法のほうが適切な場合が多い。
なので少し面倒だが、レジストリから読み出すことにした。

と、前置きが長かったが、本体ソースは以下参照。今まで通り アーカイブのvbsファイルの内容そのもの。
    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
' Script to HTML Converter
'- Created by LazwardFox -

' スクリプト(VBS/JS)/ini/テキストファイル中の、
' [Tab]を4つのスペースに置き換える / コメントに書式を充てる
' ▼
' HTMLファイルを作成後、エディタで開く。

' Update 20090317 1424 font設定が正しく適用されないBlogger対策
' Update 20090317 1311 JavaScript→HTML変換に対応
' Update 20090317 0928 コメント処理修正
' Update 20090317 0201 Tab to 4 Space Converter から名称変更
' Update 20090317 0201 本文中の"'"を無視するよう変更
' Update 20090317 0146 Headder/Footerを追記し、
' コメント部分に書式を割り当てる処理を追加。
' Update 20090315 2053
' Release 20090313 1855 発行
' DevStart 20090313 1736

'***** ↓↓↓ ObjectDecralations ↓↓↓ *************************************************
Dim Parameters, WSHShell, Fs

Set Parameters = WScript.Arguments 'パラメーター取得
If Parameters.Count <= 0 Then
Wscript.Quit
End If
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set Fs = WScript.CreateObject("Scripting.FileSystemObject") 'ファイル操作

'***** ↓↓↓Decralations↓↓↓ *********************************************************
Const vbWq = """"
Dim vbSp, vbTc, vbCt, vbWt, vbTs, vbCs
Dim sDt, iC, nS, rF, tN, tE, tSep, sF, tFile, sFile, rFile
Dim sHeadder, sFooter, hColor, fColor, rL,ltc, sltc, fQp, iQp, isQp, isQpc, lrL, nrL, rrL, wL

vbSp = " "
vbTc = vbTab & vbCrlf
vbCt = vbCrlf & vbTab
vbWt = vbWq & vbTab
vbTs = String(2,vbTab)
vbCs = String(2,vbCrLf)
ltc = Split("&,l,t,;",",")
sltc = Join(ltc,"")
sHeadder = "<table class=" & vbWq & "ScriptExp" & vbWq & "><tr class=" & vbWq & "ScriptExp" & vbWq & "><td><pre>"
sFooter = "</pre></td></tr></table>"
hColor = "<a class=" & vbWq & "ScriptComments" & vbWq & "><font color=" & vbWq & "#ffffff" & vbWq & ">"
fColor = "</Font></a>"

'***** ↓↓↓MainRoutine↓↓↓ *********************************************************
For iC = 0 To Parameters.count - 1
tFile = Parameters(iC)
If Fs.FileExists(tFile) then
sDt = iDT(""," ","",0)
nS = Fs.GetFile(tFile).size
If nS < 1 Then
Else
tE = Ucase(Fs.GetExtensionName(tFile))
If tE = "VBS" or tE = "TXT" or tE = "INI" or tE = "JS" then
If tE = "JS" Then
tSep = "//"
Else
tSep = "'"
End If
rF = Fs.GetParentFolderName(tFile)
tN = Fs.GetBaseName(tFile)
sF = Fs.BuildPath(rF,tN & " t2H " & sDt & ".html")
Set sFile = Fs.OpenTextFile(tFile,1) 'Sourceファイルを読み取りモードで開く
Set rFile = Fs.CreateTextFile(sF,0) 'Resultファイルを追記モードで開く
WScript.Sleep 200
Do Until sFile.AtEndOfStream
rL = sFile.ReadLine '行読み込み
rL = Replace(rL,"<",sltc) '不等号 < を HTMLコードに置き換え
fQp = InStr(1,rL,tSep) '最左クォーテーション(以後q)位置
iQp = 0
isQp= 1
isQpc = 1
If fQp > 0 Then '行内のq有
If fQp = 1 Then '行頭にq
rL = hColor & rL & fColor
Else '行頭以外にq
Do
iQp = InStr(isQp + 1,rL,tSep)
isQp = InStr(isQpc + 1,rL,vbWq & tSep & vbWq) + 1 '文字列表記のq有無
If isQp = 0 Then
Exit Do
End If
isQpc = isQp
Loop While iQp = isQp
If iQp > 0 Then
lrL = Left(rL,iQp - 1)
nrL = Len(rL) - iQp
rrL = Right(rL,nrL + 1)
rL = lrL & hColor & rrL & fColor
End If
End If
End If
If sHeadder <> "" And rL = "" Then
Else
wL = sHeadder & " " & Replace(rL,vbTab,vbSp) & " "
rFile.WriteLine wL
sHeadder = ""
End If
Loop
rFile.WriteLine sFooter
WScript.Sleep 200
sFile.Close 'Sourceファイルを閉じる
rFile.Close 'Resultファイルを閉じる
TextViewer tTV
If tTV = "NotSetting" Then
MsgBox "Converted",vbYesNo,"Script to HTML Converter"
Else
WSHShell.Run tTV & vbWq & sF & vbWq, 1
Wscript.Sleep 1000
End If
End If
End If
End If
Next
Set Parameters = Nothing
Set Fs = Nothing
Set WSHShell = Nothing
Wscript.Quit

'***** ↓↓↓Functions↓↓↓ *********************************************************
'------------------------------------
'TextViwer - テキストファイルを開く既定アプリケーションをフルパスで返します。
'- Created by LazwardFox -

' Release 20090315 2053
' DevStart 20090315 0938

Function TextViewer(ResultKey)
Dim sTV
Const RegKey = "HKCR\txtfile\shell\open\command\"
sTV = WSHShell.RegRead(RegKey)
sTV = Replace(sTV, " " & vbWq & "%1" & vbWq, "")
If Fs.FileExists(sTV) Then
ResultKey = sTv & " "
Else
ResultKey = "NotSetting"
End If
End Function

'------------------------------------
'iDT - 日時文字列 ないし 日/時配列取得 for VBScript
'- Created by LazwardFox -

' Update 20090228 0458 変数宣言変更
' Update 20090223 0959 時刻桁処理変更
' Update 20090223 0253 Len記述忘れ修正
' Update 20090223 0135 変数宣言忘れ修正
' Update 20090210 0218
' Update 20090210 0115
' Release 20090209 2035

' iDT (
' dSplitter - DateSplitString (Normal - "/")
' ,dtSeparater - Date/Time SepaleteString (Normal - " ")
' ,tSplitter - TimeSplitString (Normal - ":")
' ,Control - 文字列 0 or 配列 1 (Default - 1)
' )

Public Function iDT(dSplitter,dtSeparater,tSplitter,Control)
Dim nX, nD, nS, strHMS, sResult 'Update 20090228 0458
nX = Now()
nD = FormatDateTime(Date(),0)
nS = ":" & Split(CStr(FormatDateTime(nX,3)),":")(2) 'Update 20090223 0951
strHMS = FormatDateTime(nX,4) & nS 'Update 20090223 0951
If tSplitter = ":" Then
Else
strHMS = Replace(strHMS,":",tSplitter)
End If
sResult = Cstr(Replace(nD,"/",dSplitter)) & "*" & strHMS
If Control = 1 Then
iDT = Split(sResult,"*")
Else
iDT = Replace(sResult,"*",dtSeparater)
End If
End Function


しかし、JavaScript使いには向かないモノになってるっポイ。
と云うのも、文字列を表すときにシングルクォーテーション使われたらドウにもナリません(´ヘ`;)
元々、VBS向けに作成したワケだし・・・
当方みたく、JSでも、ダブルクォーテーション使うって向きなら問題ナシ。

まぁ、このスクリプト中の 検出用のクォーテーションを // に差し替えればJSでも使えるケド・・・
アトで その機能追加しようカナ、拡張子で分岐して・・・


結局、スグに拡張してしまった^_^;
多分問題なく動く・・・ハズw
<そのまま使えるVBscript スクリプト HTML 公開化 変換 pre>

VBScriptでラクをする そにょ1・・・


ショートカット1クリックで複数フォルダを開けたら…
しかも、当日フォルダがあれば、そっちを見つけて開くとか勝手に出来ないものか・・・
ヒトの手を抜きたいという欲望には限りがないw

そう云う向きに使えるスクリプトなど・・・

   DateFolderOpener.zip    
▲ を、右クリックしてファイルとして保存してください。

ファイル名を任意に変えて、同名iniファイルを同じフォルダに配置して利用するのは、今まで紹介したモノと同様。
iniファイルも、単純に
   C:\WINDOWS
C:\WINDOWS\system32\GroupPolicy
と、云う具合に、フォルダを列挙するだけ。

但し、その配下が、
   [指定したフォルダ]
└ yyyy
└ mm
└ dd
と云うカタチの構成の場合で、当日を指すフォルダがあれば、ソチラを優先で開き、
それ以外の指定フォルダは、エクスプローラで ただ開くだけとなる。

下のソースを見てもらえば判ると思うが、コイツは今、うっかり間違って
自身へ フォルダ(複数可)をドロップしても動作するようになってる。
ただエクスプローラで開くだけなので、機能としては、ほぼ無意味。
なのでココは、ini自分で書くのも面倒になってきたってのもあるので、
ini他を自動作成するよう、処理差し替えようかとか考えている。

    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
'DateFolderOpener
'- Created by LazwardFox -

'パラメータ指定/iniファイル記述で、複数の同日日付フォルダを同時に開く。
'単独起動 - 処理なし

'注) 20090223 0300 タスクマネージャ動作時、直接指定の場合、パラメータ指定不可

' Update 20090315 2240 lnkChk機能拡張
' Update 20090315 1958 複数ドロップ、ショートカットドロップに対応。
' Release 20090315 1431
' DevStart 20090315 0812

'***** ↓↓↓ ObjectDecralations ↓↓↓ ************************************************
Dim Parameters, WSHShell, Fs

Set Parameters = WScript.Arguments 'パラメーター取得
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set Fs = WScript.CreateObject("Scripting.FileSystemObject") 'ファイル制御

'***** ↓↓↓ Decralations ↓↓↓ ******************************************************
Const vbWq = """"
Dim win, Explorer, arTargets, iTargets, pTargets(), iRoot, nDT, tFolder, tExec
win = WSHShell.ExpandEnvironmentStrings("%systemroot%")
Explorer = Fs.BuildPath(win,"Explorer.exe") & " /e,"

'***** ↓↓↓MainRoutine↓↓↓ *********************************************************
'ParameterCheck BaseSet -----
If Parameters.Count = 0 Then
iTargets = arIni()
ElseIf Parameters.Count = 1 Then
iTargets = Split(Parameters(0),",")
ElseIf Parameters.Count >=2 Then
For Pc = 0 To Parameters.Count - 1
Redim Preserve pTargets(Pc)
pTargets(Pc) = Parameters(Pc)
Next
iTargets = pTargets
Else
Wscript.Quit
End IF
lnkChk iTargets, 1, arTargets '0 - .url無効化
'----------------------------
nDT = iDT("\"," ","",1)(0)
For Each iRoot In arTargets
If iRoot = "" Then
ElseIf Fs.FolderExists(iRoot) Then
tFolder = Fs.BuildPath(iRoot,nDT)
If Fs.FolderExists(tFolder) Then
Else
tFolder = iRoot
End If
tExec = Explorer & tFolder
WSHShell.Run tExec, 1
Wscript.Sleep 500
End If
Next
Set Fs = Nothing
Set WSHShell = Nothing
Wscript.Quit

'***** ↓↓↓Functions↓↓↓ *********************************************************
'------------------------------------
'lnkChk with scGet
'- Created by LazwardFox -

'パラメータがショートカットファイル(.lnk/.url)を指す場合、
'リンク先フルパスに差し替えて配列を返す。

' Update 20090315 2240 Control処理拡張
' Release 20090315 1958
' DevStart 20090315 1634

'lnkChk(
' SourceArray 配列での入力に限定されます。
' ,Control 0 - .urlファイル(インターネットショートカット)は無効化
' 1 - ショートカット内URL有効化 / 2 - 無条件
' ,ResultArray 処理結果を配列で返します。無効な配列は削除されています。
' )

Function lnkChk(SourceArray,Control,ResultArray)
Dim Pc, iSA, eSA, cSA, lPass, ePass, rSAs()
Pc = 0
For Each iSA in SourceArray
eSA = Ucase(Fs.GetExtensionName(iSA))
cSA = (eSA = "LNK") or ((eSA = "URL") And Control > 0)
If cSA Then '-- lnk/url TargetGet
scGet iSA, lPass
ePass = Ucase(Fs.GetExtensionName(lPass))
If ePass = "" Then '-- Folder True
ElseIf Control >= 2 Then '-- All True - NoLimit
ElseIf ePass = "HTML" And Control >= 1 Then '-- URL True
Else '-- BadTarget
lPass = ""
End If
ElseIf eSA = "" Then '-- Folder
lPass = iSA
Else '-- lnk/url Cancel
lPass = ""
End If
If lPass = "" Then '-- NullSkip
Else '-- ArraySet
Redim Preserve rSAs(Pc)
rSAs(Pc) = lPass
Pc = Pc + 1
End If
Next
ResultArray = rSAs
End Function

'------------------------------------
'scGet - ショートカットファイル(.lnk/.url)のリンク先フルパスを返す。
'- Created by LazwardFox -

'Update
'Release 20090315 1958
' DevStart 20090315 1634

' scGet(
' scSource ショートカットファイルのフルパスを指定
' ,scResult ショートカット内のリンク先を返します。
' 任意の変数を割り当ててください。
' )

Function scGet(scSource, scResult)
Dim tSc
If Fs.FileExists(scSource) Then
Set tSc = WSHShell.CreateShortcut(scSource)
scResult = tSc.TargetPath
Set tSc = Nothing
Else
scResult = ""
End If
End Function

'------------------------------------
'iDT - 日時文字列 ないし 日/時配列取得 for VBScript
'- Created by LazwardFox -

' Update 20090228 0458 変数宣言変更
' Update 20090223 0959 時刻桁処理変更
' Update 20090223 0253 Len記述忘れ修正
' Update 20090223 0135 変数宣言忘れ修正
' Update 20090210 0218
' Update 20090210 0115
' Release 20090209 2035

' iDT (
' dSplitter - DateSplitString (Normal - "/")
' ,dtSeparater - Date/Time SepaleteString (Normal - " ")
' ,tSplitter - TimeSplitString (Normal - ":")
' ,Control - 配列化 0 or 1 (Default - 1)
' )

Public Function iDT(dSplitter,dtSeparater,tSplitter,Control)
Dim nX, nD, nS, strHMS, sResult 'Update 20090228 0458
nX = Now()
nD = FormatDateTime(Date(),0)
nS = ":" & Split(CStr(FormatDateTime(nX,3)),":")(2) 'Update 20090223 0951
strHMS = FormatDateTime(nX,4) & nS 'Update 20090223 0951
If tSplitter = ":" Then
Else
strHMS = Replace(strHMS,":",tSplitter)
End If
sResult = Cstr(Replace(nD,"/",dSplitter)) & "*" & strHMS
If Control = 1 Then
iDT = Split(sResult,"*")
Else
iDT = Replace(sResult,"*",dtSeparater)
End If
End Function

'------------------------------------
'arIni with iniLoader
'- Created by LazwardFox -

'スクリプトと同名のiniファイルがあれば、内容を配列で取得
'対象フォルダを取得、iniファイルがあれば優先する。戻り値は配列

' Update 20090223 0550 変則的フォルダ名回避のため修正
' Release 20090223 0509

Public Function arIni()
Dim sNFull, rFolder, sN, iniFile
sNFull = Wscript.ScriptFullName
rFolder = Fs.GetParentFolderName(sNFull)
sN = Fs.GetBaseName(sNFull)
iniFile = Fs.BuildPath(rFolder,sN & ".ini")
If Fs.FileExists(iniFile) Then
arIni = iniLoader(iniFile,0)
Else
arIni = Array(rFolder)
End If
End Function

'------------------------------------
'iniLoarder - 対象をiniファイルより取得。
'- Created by LazwardFox -

' Update 20090223 0550 戻り値可変 [ 0 - 配列 ] [ 1 - カンマ区切り文字列 ]
' Release 20090223 0509

Public Function iniLoader(iniFile, Control)
Dim nS
nS = Fs.GetFile(iniFile).size
If nS = 0 Then
iniLoader = Array(Fs.GetParentFolderName(iniFile))
Else
Dim iFile, lResult, strResults
Set iFile = Fs.OpenTextFile(iniFile,1) 'iniファイルを読み取りモードで開く
WScript.Sleep 150
Do Until iFile.AtEndOfStream '読み込み
lResult = lResult & ";" & iFile.ReadLine & ";"
Loop
WScript.Sleep 150
iFile.Close 'Iniファイルを閉じる
strResults = Replace(Replace(lResult,";;",","),";","")
If Control = 0 Then
iniLoader = Split(strResults, ",")
Else
iniLoader = strResults
End If
End If
End Function


関数毎にバラバラに管理してたファイルから寄せ集めたので、
クレジットまでダブってしまっているのは御愛嬌ってコトで・・・^_^;
<そのまま使えるVBScript 日付 フォルダ 作成 自動化 複数 ルートフォルダ 指定可能>