DebugFlag = Trueだと、メッセージのダイアログを表示します。あと、ログファイルの並び順は意識していません。
'---
' プログラム: EGPのファイルからSASログを抽出します。
' 説明: EGPの拡張子をZIPに変更して、ZIPのフォルダからresult.logのファイルを抽出
' 作成者: mining
'
' 引数1: EGPのファイルパス
' 引数2: ログファイルのパス
' 実行例: cscript foo.vbs C:\temp\foo.egp C:\temp\foo.log
'
'---
Option Explicit
On Error Resume Next
'---
' 定数
'---
Const FOF_SILENT = &H4 ' 進捗ダイアログを表示しない
Const FOF_NOCONFIRMATION = &H10 ' 上書き確認ダイアログを表示しない
Const ForWriting = 2 ' テキストファイルのオープン
Const ForReading = 1 ' テキストファイルのオープン
Const TristateUseDefault = -2 ' Opens the file using the system default.
Const TristateTrue = -1 ' Opens the file as Unicode.
Const TristateFalse = 0 ' Opens the file as ASCII.
Const DebugFlag = True
'---
' 変数
'---
Dim objShell
Dim objFso
Dim objTs
Dim sZipFile
Dim sTempFolder
Dim sEgpFilePath
Dim sLogFilePath
Dim ErrCount
Dim WarCount
Dim sMsg
'---
' オブジェクト生成します。
'---
Set objShell = CreateObject("Shell.Application")
Set objFso = CreateObject("Scripting.FileSystemObject")
'---
' 引数をチェックします。
'--
If WScript.Arguments.Count <> 2 Then
Call MsgBox("引数1にEGP、引数2にログファイルを指定してください。", vbOKOnly + vbExclamation, WScript.ScriptName)
WScript.Quit(1)
End If
sEgpFilePath = WScript.Arguments.Item(0)
sLogFilePath = WScript.Arguments.Item(1)
If objFso.FileExists(sEgpFilePath) = False Then
Call MsgBox("引数1で指定したファイルが存在しません。", vbOKOnly + vbExclamation, WScript.ScriptName)
WScript.Quit(1)
End If
'---
' デバッグ用のメッセージ出力
'---
Sub DebugMsg(msg)
If DebugFlag = True Then
Call MsgBox(msg, vbOKOnly + vbInformation, WScript.ScriptName)
End If
End Sub
'---
' ZIPファイルを指定したフォルダに解凍
'---
Sub Unzip(objShell, sFile, sFolder)
Dim objFilesInZip
Dim objFolder
Set objFilesInZip = objShell.Namespace(sFile).Items
If Err.Number <> 0 Then
Exit Sub
End If
Set objFolder = objShell.Namespace(sFolder)
If Err.Number <> 0 Then
Exit Sub
End If
If (Not objFolder Is Nothing) Then
objFolder.CopyHere objFilesInZip, FOF_NOCONFIRMATION + FOF_SILENT
Else
Err.Raise 432 ' オートメーションの操作中にファイル名またはクラス名を見つけられませんでした。
End If
Set objFilesInZip = Nothing
Set objFolder = Nothing
End Sub
'---
' フォルダを作成
'---
Sub CreateUnzipFolder(objFso, sFolder)
objFso.CreateFolder sFolder
End Sub
'---
' フォルダを削除
'---
Sub DeleteUnzipFolder(objFso, sFolder)
If objFso.FolderExists(sFolder) = True Then
objFso.DeleteFolder sFolder, True
End If
End Sub
'---
' テンポラリのフォルダのパスを作成
'---
Function CreateFolderPath(objFso, sFolder)
Const TemporaryFolder = 2
Dim objTempFolder
Set objTempFolder = objFso.GetSpecialFolder(TemporaryFolder)
CreateFolderPath = objFso.BuildPath(objTempFolder.Path, sFolder)
Set objTempFolder = Nothing
End Function
'---
' サブフォルダからresult.logを探して、objTsに出力
'---
Sub SearchLog(objFso, objTs, tmpFolderItems)
Const FileName = "result.log"
Dim objFolderItemsB
Dim objItem
Dim Stream
For Each objItem in tmpFolderItems
' 取り出した物がファイルかフォルダかを判定
If objItem.IsFolder Then
' フォルダであれば、再帰呼び出しでフォルダ階層を手繰ります。
Set objFolderItemsB = objItem.GetFolder
Call SearchLog(objFso, objTs, objFolderItemsB.Items())
ElseIf objItem.Name = FileName Then
' ファイル名が一致したら、テキストを読み取りobjTSに出力します。
Set Stream = CreateObject("ADODB.Stream")
Stream.Charset = "UTF-8"
Stream.Type = 2
Stream.Open
Stream.LoadFromFile(objItem.Path)
objTs.Write(Stream.ReadText)
Stream.Close
Set Stream = Nothing
End If
Next
Set objItem = Nothing
Set objFolderItemsB = Nothing
End Sub
'---
' ログファイルからERROR, WARNINGの件数をカウント
'---
Sub CountLog(objFso, sLogFile, byRef ErrCount, byRef WarCount)
Const KeyError = "e ERROR"
Const KeyWarning = "w WARNING"
Dim objTs
Dim sBuf
On Error Goto 0
ErrCount = 0
WarCount = 0
Set objTs = objFso.OpenTextFile(sLogFile, ForReading, False, TristateTrue)
If Err.Number <> 0 Then
Exit Sub
End If
Do Until objTs.AtEndOfLine = True
sBuf = objTs.ReadLine
If Left(sBuf, Len(KeyError)) = KeyError Then
ErrCount = ErrCount + 1
ElseIf Left(sBuf, Len(KeyWarning)) = KeyWarning Then
WarCount = WarCount + 1
End If
Loop
objTs.Close
If Err.Number <> 0 Then
Exit Sub
End If
Set objTs = Nothing
End Sub
'---
' エラーチェック
'---
Function CheckError(fnName)
Checkerror = False
Dim strmsg
Dim errNum
If Err.Number <> 0 Then
strmsg = "Error #" & Hex(Err.Number) & vbCrLf & "In Function " & fnName & vbCrLf & Err.Description
Call MsgBox(strmsg, vbOkOnly + vbCritical, WScript.ScriptName)
Checkerror = True
End If
End Function
'---
' ログファイルを開きます。
'---
Set objTs = objFso.CreateTextFile(sLogFilePath, True, True)
If CheckError("objFso.CreateTextFile") Then
WScript.Quit(1)
End If
'---
' EGPの拡張子をZIPに変更してコピーします。
'---
sZipFile = CreateFolderPath(objFso, objFso.GetTempName & ".zip")
Call DebugMsg("EGPの拡張子をZIPに変えてコピー:" & sZipFile)
objFso.CopyFile sEgpFilePath, sZipFile
If CheckError("objFso.CopyFile") Then
WScript.Quit(1)
End If
'---
' 解凍先のテンポラリのフォルダを作成します。
'---
sTempFolder = CreateFolderPath(objFso, objFso.GetTempName)
Call DebugMsg("テンポラリのフォルダを作成:" & sTempFolder)
Call CreateUnzipFolder(objFso, sTempFolder)
If CheckError("CreateUnzipFolder") Then
WScript.Quit(1)
End If
'---
' ZIPファイルを解凍します。
'---
Call DebugMsg("ZIPファイルを解凍:" & sZipFile)
Call Unzip(objShell, sZipFile, sTempFolder)
If CheckError("Unzip") Then
WScript.Quit(1)
End If
'---
' テンポラリフォルダからログファイル探してobjTSに出力します。
'---
Call DebugMsg("テンポラリのフォルダからログを収集:" & sTempFolder)
Call SearchLog(objFso, objTs, (objShell.NameSpace(sTempFolder)).Items)
If CheckError("SearchLog") Then
WScript.Quit(1)
End If
'---
' ログファイルを閉じます。
'---
objTs.Close
If CheckError("objTs.Close") Then
WScript.Quit(1)
End If
'---
' テンポラリのフォルダを削除します。
'---
Call DebugMsg("テンポラリのフォルダを削除:" & sTempFolder)
Call DeleteUnzipFolder(objFso, sTempFolder)
If CheckError("DeleteUnzipFolder") Then
WScript.Quit(1)
End If
'---
' ZIPファイルを削除します。
'---
Call DebugMsg("ZIPファイルを削除:" & sZipFile)
objFso.DeleteFile sZipFile
If CheckError("objFso.DeleteFile") Then
WScript.Quit(1)
End If
'---
' Error, Warningの件数を数えます。
'---
Call CountLog(objFso, sLogFilePath, ErrCount, WarCount)
If CheckError("objFso.DeleteFile") Then
WScript.Quit(1)
End If
Call DebugMsg("ERROR件数:" & CStr(ErrCount) & " WARNING件数:" & CStr(WarCount))
'---
' オブジェクトを破棄します。
'---
Set objTs = Nothing
Set objFso = Nothing
Set objShell = Nothing
'---
' 終了
'---
WScript.Quit(0)
0 件のコメント :
コメントを投稿