'stblib1.vbs
'****************************************************************
' 関数： GetFileAttribute
' 用途： ファイルの情報を取得
' 入力： ファイルパス
' 戻値： (作成、更新、サイズ、タイプ、属性)の連結文字列
'****************************************************************
Function GetFileAttribute(file)
Dim strGetFileAttribute
strGetFileAttribute = ""
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFile = objFso.GetFile(file)
strGetFileAttribute = _
"作成：" & objFile.DateCreated & _
" 更新：" & objFile.DateLastModified & _
" サイズ：" & objFile.Size
'" タイプ：" & objFile.Type & _
'" 属性：" & objFile.Attributes
Set objFile = Nothing
Set objFso = Nothing
GetFileAttribute = strGetFileAttribute
End Function
'****************************************************************
' 関数： GetFileType
' 用途： ZIP検索文字列を含む文字列を返す
' 入力： 文字列
' 戻値： URLパス
'****************************************************************
Function GetFileType(str)
Dim strGetFileType
Dim regEx
Dim Matches
Dim Match
strGetFileType = ""
Set regEx = New RegExp
' 検索パターンを文字列で設定
regEx.Pattern = "http://(.+?).zip"
' 大文字小文字を区別しない ( この場合はどちらでも良い )
regEx.IgnoreCase = True
' 文字列全体を検索 False だと一件しか検索しない
regEx.Global = True
' 検索の実行
Set Matches = regEx.Execute(str)
For Each Match in Matches
' 検索結果の中の () 内の文字列を取得
IF (strGetFileType = "") THEN
strGetFileType = Match.SubMatches(0)
strGetFileType = "http://" & strGetFileType & ".zip"
'WScript.Echo now & "** Match=" & strGetFileType
'WScript.Echo now & "** Match=" & Match.SubMatches(0)
exit For
End IF
Next
GetFileType = strGetFileType
End Function
'****************************************************************
' 関数： GetUrlFile
' 用途： URL からファイル名を求める
' 入力： URL
' 戻値： URLのファイル部分
'****************************************************************
Function GetUrlFile(s)
Dim iPos,sGetUrlFile
sGetUrlFile = ""
iPos = instrRev(s,"/",-1,1)
sGetUrlFile = mid(s,iPos+1)
GetUrlFile = sGetUrlFile
End function
'**************************************************************
' 関数： GetUrlFilename
' 用途： URLパス名からファイル名を求める
' 入力： URLパス
' 戻値： URLのファイル名
'**************************************************************
Function GetUrlFilename(URL)
Dim sPathName, sFileName, ipos
ipos = InStrRev(Trim(URL), "/")
sPathName = Left(URL, ipos)
sFileName = Mid(URL, ipos + 1)
GetUrlFilename = sFileName
End Function
'****************************************************************
' 関数： GetURI
' 用途： URLからURIを求める
' 入力： URL
' 戻値： URLのURI部分
'****************************************************************
Function GetURI(s)
Dim iPos,sURI
sURI = ""
iPos = instrRev(s,"/",-1,1)
sURI = mid(s,1,iPos)
GetURI = sURI
End function
'****************************************************************
' 関数： GetDriveFree
' 用途： ドライブの情報を表示 する
' 入力： ファイル
' 入力： ドライブの情報に表示するコメント
' 戻値： 空きサイズ
'****************************************************************
Function GetDriveFree(sPath,msg)
On Error Resume Next
Dim objFSO ' FileSystemObject
Dim objDrive ' ドライブ情報
Dim sDrive ' ドライブ名
Dim sType ' ドライブ種類の文字列
Dim sGetDriveFree
sGetDriveFree = ""
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
IF Err.Number = 0 THEN
sType = Array("Unknown", "Removable", "HDD", "Network", "CD-ROM", "RAM")
sDrive = objFSO.GetDriveName(sPath)
WScript.Echo vbtab & vbtab & vbtab & "[ドライブ情報] ：" & msg & "ドライブ " & sDrive
IF objFSO.DriveExists(sDrive) THEN
Set objDrive = objFSO.GetDrive(sDrive)
If objDrive.IsReady = True Then
'WScript.Echo " ボリュームラベル：" & objDrive.VolumeName
'WScript.Echo " 種類 ：" & sType(objDrive.DriveType)
'WScript.Echo " ファイルシステム：" & objDrive.FileSystem
WScript.Echo vbtab & vbtab & vbtab & "空領域 / 容量 ：" & _
FormatNumber(objDrive.FreeSpace, 0) & " / " & _
FormatNumber(objDrive.TotalSize, 0) & vbcrlf
'WScript.Echo " フォルダ ：" & objDrive.Path
'WScript.Echo " ルートフォルダ ：" & objDrive.RootFolder
sGetDriveFree = objDrive.FreeSpace
ELSE
WScript.Echo now & " GetDriveFree 準備ができていません"
END IF
ELSE
WScript.Echo now & " GetDriveFree 存在しません。"
END IF
ELSE
WScript.Echo now & " GetDriveFree エラー:" & Err.Number & Err.Description
END IF
'objDrive.Close
Set objFSO = Nothing
Set objDrive = Nothing
GetDriveFree = sGetDriveFree
End Function
'****************************************************************
' 関数： IsCscript
' 用途： 自VBSを起動したWSH コマンドがcScriptを返信
' 入力： 無し
' 戻値： cScriptの時true wScriptの時false
'****************************************************************
Function IsCscript()
' WSH起動コマンド
Const WHS_COMMAND_WSCRIPT = "wscript.exe"
Const WHS_COMMAND_CSCRIPT = "cscript.exe"
IsCscript = true
IF LCase( Right(WScript.FullName, len(WHS_COMMAND_WSCRIPT)) ) = WHS_COMMAND_WSCRIPT THEN
IsCscript = false
END IF
End Function
'****************************************************************
' 関数： SetLogHeader
' 用途： ログヘッダーページをフォーマット
' 入力： ヘッダーのコメントメッセージ
' 戻値： コンピュータ名前
'****************************************************************
Function SetLogHeader(msg)
Dim objNetWork ' ネットワークオブジェクト
Dim objParm ' コマンドラインパラメータ
Dim i ' コマンドライン引数の個数
Dim chr
iStepNo = 0
WScript.Echo now & " ***********************************************************"
WScript.Echo now & EditTitleLine(" ** Script : " & Wscript.ScriptName)
WScript.Echo now & EditTitleLine(" ** " & Wscript.ScriptFullName)
WScript.Echo now & " ** ----------------------------------------------------- **"
WScript.Echo now & EditTitleLine(" ** WSH : " & Wscript.Name)
WScript.Echo now & EditTitleLine(" ** " & Wscript.FullName)
WScript.Echo now & EditTitleLine(" ** " & Wscript.Path)
WScript.Echo now & " ** ----------------------------------------------------- **"
Set objParm = WScript.Arguments
WScript.Echo now & EditTitleLine(" ** Command param count " & objParm.Count)
For i=1 To objParm.Count
WScript.echo now & EditTitleLine(" ** (" & i & ") " & objParm.Item(i - 1))
Next
WScript.Echo now & " ** ----------------------------------------------------- **"
' ネットワークオブジェクトの作成
Set objNetWork = WScript.CreateObject("WScript.Network")
' ユーザ名
WScript.echo now & EditTitleLine(" ** UserName : " & objNetWork.UserName)
' ドメイン名
WScript.echo now & EditTitleLine(" ** UserDomain : " & objNetWork.UserDomain)
' コンピュータ名
WScript.echo now & EditTitleLine(" ** ComputerName : " & GetComputer())
WScript.Echo now & " ***********************************************************"
WScript.Echo now & EditTitleLine(" ** " & msg)
WScript.Echo now & " ***********************************************************"
SetLogHeader = GetComputer()
Set objNetWork = Nothing
End Function
'****************************************************************
' 関数： EditTitleLine
' 用途： 文字列編集、所定のカラム位置に**の文字を挿入する
' 入力： 変種前文字列
' 戻値： 編集後文字列
'****************************************************************
Function EditTitleLine(chr)
Dim sEditTitleLine
Dim iMAXCOLS
iMAXCOLS = 60
sEditTitleLine = left(chr,len(chr)) & Space(iMAXCOLS-len(" **")-len(chr)) & " **"
EditTitleLine = sEditTitleLine
End Function
'****************************************************************
' 関数： SetLogStepStart
' 用途： ログステップ開始のメッセージ表示
' 入力： ステップ番号
' 入力： 連結文字列
' 戻値： 無し
'****************************************************************
Function SetLogStepStart(iStepNo,msg)
WScript.Echo now & " **_STEP(" & iStepNo & ")" & " **_START_** " & msg
End Function
'****************************************************************
' 関数： SetLogStepEnd
' 用途： ログステップ終了
' 入力： ステップ番号
' 入力： 連結文字列
' 戻値： 無し
'****************************************************************
Function SetLogStepEnd(iStepNo,msg)
WScript.Echo now & " **_STEP(" & iStepNo & ")" & " **__END__** " & msg & vbCrLf
End Function
