Option Explicit
Public My, MySh, Fs, Parameters
Set My = WScript
With My
Set Parameters = .Arguments
If Parameters.Count <= 0 Then
.Quit
End If
Set MySh = .CreateObject("WScript.Shell")
Set Fs = .CreateObject("Scripting.FileSystemObject")
End With
Public Const vbWq = """"
Public Const vbSpc = " "
Public Const vbSep = ":::"
Public eWS
Dim sTargetSet, sParameters, sParameter, wType, eWait
Dim strParameter, strTargetSet
Dim strTargets, strTarget, strRoot
Dim strTgtFile, arTgtFiles
Dim arParameters, blParameters
Dim blOne, blSingle
strTargetSet = oJoin(Parameters, vbSep)
If InStrRev(strTargetSet, ";") = 0 Then
eWait = False
Else
sTargetSet = Split(strTargetSet, ";")
strTargetSet = sTargetSet(0)
sParameters = Split(sTargetSet(1), ",")
wType = sParameters(0)
eWait = sParameters(1)
End If
strTargetSet = MySh.ExpandEnvironmentStrings(strTargetSet)
arParameters = Split(strTargetSet, vbSep)
blParameters = (Parameters.Count >= 1)
strTargetSet = arParameters(0)
If blParameters Then
If Fs.FolderExists(strTargetSet) Then
If Parameters.Count <= 1 Then
MyQuit
Else
blSingle = False
strRoot = arParameters(0)
strTargets = Parameters(1)
arTgtFiles = Split(strTargets, ",")
blOne = True
For Each strTgtFile In arTgtFiles
strTarget = Fs.BuildPath(strRoot, strTgtFile)
If Fs.FileExists(strTarget) Then
If blOne Then
strTargetSet = vbWq & strTarget & vbWq
blOne = False
Else
strTargetSet = strTargetSet & vbSpc & vbWq & strTarget & vbWq
End if
Else
MyQuit
End If
Next
End If
blParameters = sArrayControl(arParameters, "1,0", arParameters)
Else
If Fs.FileExists(strTargetSet) Then
strRoot = Fs.GetParentFolderName(strTargetSet)
blParameters = sArrayControl(arParameters, "0", arParameters)
Else
MyQuit
End if
blSingle = True
End If
End If
If blSingle Then
strTargetSet = vbWq & strTargetSet & vbWq
End If
If blParameters Then
strTargetSet = strTargetSet & vbSpc & Join(arParameters, vbSpc)
End If
strTargetSet = Replace(strTargetSet, "'", vbWq)
With MySh
.CurrentDirectory = strRoot
.Run strTargetSet, wType, eWait
End With
MyQuit
Function MyQuit()
Set Fs = Nothing
Set MySh = Nothing
Set Parameters = Nothing
My.Quit
End Function
Function oJoin(oTargets, sSep)
Dim iTarget, strTargets
For Each iTarget In oTargets
If strTargets = "" Then
strTargets = iTarget
Else
strTargets = strTargets & sSep & iTarget
End if
oJoin = strTargets
Next
End Function
Function sArrayControl(tgtArray, strPoss, arResult)
Dim arPos, numArray, strArray, strPos, blResult
arPos = Split(strPoss, ",")
numArray = Ubound(tgtArray)
blResult = (numArray > Ubound(arPos))
If blResult Then
strArray = Join(tgtArray, vbSep)
For Each strPos In arPos
If IsNumeric(strPos) Then
strArray = Replace(strArray, tgtArray(strPos) & vbSep, "")
Else
End If
Next
arResult = Split(strArray, vbSep)
Else
arResult = Array("")
End If
sArrayControl = blResult
End Function
|
0 件のコメント:
コメントを投稿
注: コメントを投稿できるのは、このブログのメンバーだけです。