More Exchange Message Tracking
Originally published November 10, 2006
So, in today's earlier post, I talked about exporting the message tracking logs into XML and then using an XSL sheet to report on that data.
What's the problem with that? Well, the ESM Message Tracking Center (MTC) will only export 1,000 entries - maximum. If you have a busy server, you may literally have millions of lines in your message tracking logs.
I've written a program that takes the message tracking logs and converts them completely to XML. It's a little more stupid than the ESM MTC, because one of the things the MTC does behind your back is to consolidate message tracking log entries for the same message (but only when you export to XML).
You need a new XSL sheet, so that it doesn't assume that some entries are consolidated. You get the new sheet here.
Below is the program. Just put the output file (mtrack.xml) and the stylesheet (mtrack.xsl) into the same directory and then double-click on the XML file.
It's VBScript again, of course, since it's designed to work with Exchange Server 2003.
Option Explicit
Const ForReading = 1
Const ForWriting = 2
Dim objXML, iIndent, strIndent, objFSO, objTrack
Dim iLinecount, strFileName
If WScript.Arguments.Count <> 1 Then
e "cscript //nologo track-to-xml.vbs unc-to-tracking-log"
e " "
e "Example: cscript //nologo track-to-xml.vbs \\orange.brnets.local\orange.log\20061105.log"
WScript.Quit 1
End If
strFileName = WScript.Arguments.Item (0)
Call DoSetup ()
Call objXML.WriteLine ("<?xml version=""1.0"" encoding=""utf-8""?>")
Call objXML.WriteLine ("<?xml-stylesheet type=""text/xsl"" href=""mtrack.xsl"" ?>")
Call objXML.WriteLine ("<TrackHistory xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns=""http://www.microsoft.com/schemas/MessageTracking"">")
While Not objTrack.AtEndOfStream
Dim str, arr, i
str = objTrack.Readline ()
If Len (str) > 0 Then
iLineCount = iLineCount + 1
If iLineCount = 3 Then
arr = Split (Mid (str, 3), vbTab)
For i = LBound (arr) To UBound (arr)
e arr (i)
Next
ElseIf iLineCount > 3 Then
Call ProcessLine (str, arr)
Else
e "Skipped line " & iLineCount & " " & str
End If
End If
WEnd
Call DoCleanup ()
Sub ProcessLine (strLine, arrFields)
Dim arr, i, bErr
bErr = False
arr = Split (strLine, vbTab)
If UBound (arr) < UBound (arrFields) Then
e UBound (arr) & " arr " & UBound (arrFields) & " arrFields"
bErr = True
End If
If UBound (arr) > (UBound (arrFields) + 1) Then
e UBound (arr) & " arr " & UBound (arrFields) & " arrFields"
bErr = True
End If
Call XML_Open ("Exchange_MessageTrackingEntry")
Call XMLit_Item ("TimeLogged", arr (0) & " " & arr (1))
Call XMLit_Item ("OriginationTime", arr (14))
Call XMLit_Item ("KeyID", strFilename & "," & iLineCount)
Call XMLit_Item ("MessageID", arr (9))
Call XMLit_Item ("PartnerServer", arr (3))
Call XMLit_Item ("SenderAddress", arr (19))
Call XMLit_Item ("ServerName", arr (5))
Call XMLit_Item ("Subject", arr (18))
Call XMLit_Item ("EntryType", arr (8))
Call XMLit_Item ("RecipientCount", arr (13))
Call XMLit_Item ("Priority", arr (10))
Call XMLit_Item ("Size", arr (12))
Call XMLit_Item ("RecipientAddress", arr (7))
Call XMLit_Item ("RecipientStatus", arr (11))
Call XML_Close ("Exchange_MessageTrackingEntry")
' e "**** " & iLineCount & " **** "
' For i = LBound (arrFields) to UBound (arrFields)
' e i & " - " & arrFields (i) & " = " & arr (i) & " "
' Next
' e " "
If bErr Then
wscript.quit
End If
End Sub
Sub XMLit_Item (strName, strItem)
If Len (strItem) = 0 Then
Exit Sub
End If
If strItem = "-" Then
Exit Sub
End If
If strItem = "<>" Then
Exit Sub
End If
If LCase (strName) = "messageid" Then
If Left (strItem, 1) = "<" Then
strItem = Mid (strItem, 2)
If Instr (strItem, ">") > 1 Then
strItem = Mid (strItem, 1, Instr (strItem, ">") - 1)
End If
End If
End If
strItem = Replace (strItem, "&", "&")
strItem = Replace (strItem, "<", "<")
strItem = Replace (strItem, ">", ">")
strItem = Trim (strItem)
If Len (strItem) = 0 Then
Exit Sub
End If
Call XML_Item (strName, strItem)
End Sub
Sub e (str)
WScript.Echo str
End Sub
Sub DoSetup ()
iIndent = 0
iLineCount = 0
strIndent = ""
Set objFSO = CreateObject ("Scripting.FileSystemObject")
Set objTrack = objFSO.OpenTextFile (strFileName, ForReading)
Set objXML = objFSO.CreateTextFile ("mtrack.xml", True)
End Sub
Sub DoCleanup ()
Call objXML.WriteLine ("</TrackHistory>")
Call objXML.Close ()
Set objXML = Nothing
Call objTrack.Close ()
Set objTrack = Nothing
Set objFSO = Nothing
End Sub
Sub setIndent (i)
Dim j
strIndent = ""
For j = 0 To i
strIndent = strIndent & vbTab
Next
End Sub
Sub XML_Open (str)
Call setIndent (iIndent)
Call objXML.WriteLine (strIndent & "<" & str & ">")
iIndent = iIndent + 1
End Sub
Sub XML_Close (str)
iIndent = iIndent - 1
Call setIndent (iIndent)
Call objXML.WriteLine (strIndent & "</" & str & ">")
End Sub
Sub XML_Item (strName, strItem)
Call setIndent (iIndent)
If Len (strItem) > 0 Then
Call objXML.WriteLine (strIndent & "<" & strName & ">" & strItem & "</" & strName & ">")
Else
Call objXML.WriteLine (strIndent & "</" & strName & ">")
End If
End Sub