' MIMESweeperから送られるウイルス検出メールから
' 集計用のTSVデータを作成するスクリプト
'
' UTF-8をQuoted-PrintableにしたMIMEメールを対象とします
'
' authoer Jomora(http://jomora.bne.jp)
' version 2005.06.05 作成

'emlファイルがあるフォルダ
SrcDirName = "."
'集計用のタブ文字区切りファイル
TSVFileName = "Result.tsv"

'**Start Encode**

'メイン関数
Set fso = CreateObject("Scripting.FileSystemObject")
Set SrcDir = fso.GetFolder(SrcDirName)
Set TSVFile = fso.CreateTextFile(TSVFileName)
Count = 0
For Each FileName In SrcDir.Files
    FileEx = fso.GetExtensionName(FileName)
    If LCase(FileEx) = "eml" Then
        TSVFile.WriteLine(GetVirusInfo(FileName))
        Count = Count + 1
    End If
Next
TSVFile.Close
WScript.Echo Count & "通のメールを処理しました。"

'メール本文から必要なデータを抜き出す
Function GetVirusInfo(emlFilePath)
    Dim CDO
    Dim Stream

    Set CDO = CreateObject("CDO.Message")
    Set Stream = CreateObject("ADODB.Stream")
    Stream.Open
    Stream.LoadFromFile emlFilePath
    CDO.DataSource.OpenObject Stream,"_Stream"

    sourceStr = CDO.TextBody

    Set re2 = New RegExp
    '日付の区切り文字が2種類ある
    re2.Pattern = "日付(;|：).*\n"
    valueStr = re2.Execute(sourceStr)(0).Value
    dateStr = Mid(valueStr, 4, Len(valueStr) - 5)
    dateArr = Split(dateStr, " ")
    dateArr(0) = Mid(dateArr(0), 1, Len(dateArr(0)) - 1)
    If ubound(dateArr) < 5 Then
        '日付のフォーマットが異なる場合
        ReDim dateArr(6)
    End If

    sender = GetValue(sourceStr, "送信者のアドレス：")
    receiver = GetValue(sourceStr, "受信者のアドレス：")
    'subject = GetValue(sourceStr, "サブジェクト：") '解析不能な文字列が混入
    message_id = GetValue(sourceStr, "Message-ID：")

    virus_name = GetValue(sourceStr, "Scenarios")
    Set re3 = New RegExp
    re3.Pattern = "'(?:(?!').)*'"
    virus_name = re3.Execute(virus_name)(0).Value
    virus_name = Mid(virus_name, 2, Len(virus_name) - 2)

    GetVirusInfo = dateArr(0) & vbTab & dateArr(1) & vbTab & dateArr(2) & vbTab & dateArr(3) & vbTab & dateArr(4) & vbTab & dateArr(5) & vbTab & virus_name & vbTab & sender & vbTab & receiver & vbTab & message_id
End Function

'指定された項目のデータを抽出
Function GetValue(sourceStr, targetStr)
    Set re = New RegExp
    re.Pattern = targetStr & ".*\n"
    valueStr = re.Execute(sourceStr)(0).Value
    GetValue = Mid(valueStr, Len(targetStr) + 1, Len(valueStr) - Len(targetStr) - 2)
End Function
