REM **********************************************************
REM シングルクォートで囲む
REM **********************************************************
Function Ss( strValue )
Ss = "'" & strValue & "'"
End Function
REM **********************************************************
REM ダブルクォートで囲む
REM **********************************************************
Function Dd( strValue )
Dd = """" & strValue & """"
End Function
GetStringDir
REM **********************************************************
REM 文字列より機械的にフォルダ部分を取得する
REM **********************************************************
Function GetStringDir( strValue )
Dim aData,I,str
strValue = Replace( strValue, """", "" )
aData = Split( strValue, "\" )
str = ""
For I = 0 to Ubound( aData ) - 1
if I <> 0 then
str = str & "\"
end if
str = str & aData(I)
Next
GetStringDir = str
End Function
ByteLen
REM **********************************************************
REM 文字列のバイト計算
REM **********************************************************
function ByteLen( strTarget )
Dim i,nLen,nRet,strMoji,nAsc
nRet = 0
nLen = Len( strTarget )
For i = 1 to nLen
nRet = nRet + 2
strMoji = Mid( strTarget, i, 1 )
nAsc = Asc( strMoji )
if &H20 <= nAsc and nAsc <= &H7E then
nRet = nRet - 1
end if
if &HA1 <= nAsc and nAsc <= &HDF then
nRet = nRet - 1
end if
Next
ByteLen = nRet
end function
Lpad、LpadB、Rpad、RpadB
REM **********************************************************
REM 指定数、指定文字列左側を埋める
REM **********************************************************
Function Lpad( strValue, str, nLen )
Lpad = Right( String(nLen,str) & strValue, nLen )
End Function
Function LpadB( strValue, str, nLen )
Dim strWork,nLen2
strWork = Right( String(nLen,str) & strValue, nLen )
nLen2 = nLen
Do While ByteLen( strWork ) > nLen
nLen2 = nLen2 - 1
if nLen2 <= 0 then
Exit Do
end if
strWork = Right( String(nLen,str) & strValue, nLen2 )
Loop
LpadB = strWork
End Function
REM **********************************************************
REM 指定数、指定文字列右側を埋める
REM **********************************************************
Function Rpad( strValue, str, nLen )
Rpad = Left( strValue & String(nLen,str), nLen )
End Function
Function RpadB( strValue, str, nLen )
Dim strWork,nLen2
strWork = Left( strValue & String(nLen,str), nLen )
nLen2 = nLen
Do While ByteLen( strWork ) > nLen
nLen2 = nLen2 - 1
if nLen2 <= 0 then
Exit Do
end if
strWork = Left( strValue & String(nLen,str), nLen2 )
Loop
RpadB = strWork
End Function
RegTrim
REM **********************************************************
REM 正規表現のトリム
REM **********************************************************
Function RegTrim( strValue )
Dim regEx, str
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Pattern = "^[ \s]+"
str = regEx.Replace( strValue, "" )
regEx.Pattern = "[ \s]+$"
RegTrim = regEx.Replace( str, "" )
End Function
WscriptQuit
REM **********************************************************
REM Wscript で実行された場合はメッセージを表示して終了
REM **********************************************************
Function WscriptQuit( )
if ScriptType <> 1 then
Exit Function
end if
Dim str
str = WScript.FullName
str = Right( str, 11 )
str = Ucase( str )
if str <> "CSCRIPT.EXE" then
strMessage = "コマンドプロンプトより cscript " & WScript.ScriptFullName
strMessage = strMessage & " と指定して実行して下さい " & vbCrLf & vbCrLf
strMessage = strMessage & "( この文字列をクリップボードにコピーしたい場合は"
strMessage = strMessage & " ctrl+c です )"
WScript.Echo strMessage
WScript.Quit
end if
End Function
Crun、Crun2
REM **********************************************************
REM Wscript で実行された場合は Cscript で実行しなおす
REM **********************************************************
Function Crun( )
if ScriptType <> 1 then
Exit Function
end if
Dim str
str = WScript.FullName
str = Right( str, 11 )
str = Ucase( str )
if str <> "CSCRIPT.EXE" then
str = WScript.ScriptFullName
GetWshShell
strParam = " "
For I = 0 to Wscript.Arguments.Count - 1
if instr(Wscript.Arguments(I), " ") < 1 then
strParam = strParam & Wscript.Arguments(I) & " "
else
strParam = strParam & Dd(Wscript.Arguments(I)) & " "
end if
Next
Call WshShell.Run( "cmd.exe /c cscript.exe " & Dd(str) & strParam & " & pause", 3 )
WScript.Quit
end if
End Function
Function Crun2( nCol )
if ScriptType <> 1 then
Exit Function
end if
Dim str
str = WScript.FullName
str = Right( str, 11 )
str = Ucase( str )
if str <> "CSCRIPT.EXE" then
str = WScript.ScriptFullName
GetWshShell
strParam = " "
For I = 0 to Wscript.Arguments.Count - 1
if instr(Wscript.Arguments(I), " ") < 1 then
strParam = strParam & Wscript.Arguments(I) & " "
else
strParam = strParam & Dd(Wscript.Arguments(I)) & " "
end if
Next
Call WshShell.Run( "cmd.exe /c mode con: cols=" _
& nCol & " & cscript.exe " & Dd(str) & strParam & " & pause", 3 )
WScript.Quit
end if
End function
GetInline
REM **********************************************************
REM ソース内のテキストリソースを取得
REM **********************************************************
Function GetInline( strName )
GetInline = RegTrim( getResource( strName ) ) & vbCrLf
End Function
ScriptType
REM **********************************************************
REM 実行中のスクリプトのタイプ
REM 1:WSH, 2:HTA, 3:ASP, 0:不明
REM **********************************************************
Function ScriptType( )
Dim nType
nType = 0
if IsObject( Wscript ) then
nType = 1
else
if IsObject( window ) then
nType = 2
else
if IsObject( Server ) then
nType = 3
end if
end if
end if
ScriptType = nType
End Function
GetObj
REM **********************************************************REM 文字列を指定して、変数にオブシェクトを作成させるREM **********************************************************
Function GetObj( strTarget, strObjectName )
Dim ExecuteString
ExecuteString = "Dim " & strTarget & " : "
ExecuteString = ExecuteString & "Set " & strTarget & " = "
Select Case ScriptType
Case 1
ExecuteString = ExecuteString & _
"WScript.CreateObject("
Case 2
ExecuteString = ExecuteString & _
"CreateObject("
Case 3
ExecuteString = ExecuteString & _
"Server.CreateObject("
Case Else
ExecuteString = ExecuteString & _
"CreateObject("
End Select
ExecuteString = ExecuteString & Dd( strObjectName ) & ")"
ExecuteGlobal ExecuteString
End Function
GetFso
REM **********************************************************
REM FileSystemObject の取得
REM ExecuteGlobal で定義されたグローバルな変数は
REM ローカルスコープで即参照できない
REM **********************************************************
Function GetFso( )
if not IsObject( Fso ) then
Call GetObj( "Fso", "Scripting.FileSystemObject" )
end if
End Function
GetTextFile、GetTextFileUnicode
REM **********************************************************
REM テキストファイル一括取得
REM **********************************************************
Function GetTextFile( strPath )
GetFso
Dim objHandle
on error resume next
Set objHandle = Fso.OpenTextFile( strPath, 1 )
if Err.Number <> 0 then
ErrorMessage = Err.Description
GetTextFile = ""
else
GetTextFile = objHandle.ReadAll
objHandle.Close
end if
on error goto 0
End Function
Function GetTextFileUnicode( strPath )
GetFso
Dim objHandle
on error resume next
Set objHandle = Fso.OpenTextFile( strPath, 1, , True )
if Err.Number <> 0 then
ErrorMessage = Err.Description
GetTextFile = ""
else
GetTextFile = objHandle.ReadAll
objHandle.Close
end if
on error goto 0
End Function
PutTextFile、PutTextFileUnicode
REM **********************************************************
REM テキストファイル一括書き込み
REM **********************************************************
Function PutTextFile( strPath, strValue )
GetFso
Dim objHandle
on error resume next
Set objHandle = Fso.CreateTextFile( strPath, True )
if Err.Number <> 0 then
ErrorMessage = Err.Description
else
objHandle.Write( strValue )
objHandle.Close
end if
on error goto 0
End Function
REM **********************************************************
REM テキストファイル一括書き込み( Unicode )
REM **********************************************************
Function PutTextFileUnicode( strPath, strValue )
GetFso
Dim objHandle
on error resume next
Set objHandle = Fso.CreateTextFile( strPath, True, True )
if Err.Number <> 0 then
ErrorMessage = Err.Description
else
objHandle.Write( strValue )
objHandle.Close
end if
on error goto 0
End Function