HTA Log Parser



This one was actually pretty hard for me to write, so I really hope, that someone will be able to use it. Practically, this is a parser of logs, that I create in other snippets with my HTA Logging, but it is way more. For starters it also parsers logs produced by AMUR and UARM software. For advanced usage it also provides functionallity to sort and filter. A sample of the parser is used in my HTA Launcher.

Note, that it also need to have follwoing JavaScript in your code:


<script language="JavaScript">

function SortVBArray(arrVBArray, desc) {

newdb = arrVBArray.split("[dbmerg2]");

if (desc == 1) {

return newdb.sort().join('\b');

} else {

return newdb.sort().reverse().join('\b');

}

}

</script>


In case of large logs it may take some time to output the log. Also, even though I tried to polish it, a small bug still remains unsolved: in some cases filter may return 1 line less, than it should. If you find what is causing this - let me know.


'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

' Array sorting

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


function bSort(arrShort, colmn, desc)

Dim olddb, tmpdb, tmpar

On Error resume next

itter = 1

Dim newdb()

ReDim newdb(1)

For olddb = 0 To (UBound(arrshort) - 1)

if itter > 1 Then

redim preserve newdb(itter)

End If

tmpar = arrshort(olddb)(0)

arrshort(olddb)(0) = arrshort(olddb)(colmn)

arrshort(olddb)(colmn) = tmpar

newdb(itter - 1) = Join(arrshort(olddb), "[dbmerg1]")

itter = itter + 1

Next

tmpdb = Split(SortVBArray(Join(newdb, "[dbmerg2]"), desc), Chr(8))

redim arrShort(UBound(tmpdb))

For olddb = 0 To (UBound(tmpdb) - 1)

if trim(tmpdb(olddb)) <> "" Then

arrShort(olddb) = Split(tmpdb(olddb), "[dbmerg1]")

tmpar = arrShort(olddb)(0)

arrShort(olddb)(0) = arrShort(olddb)(colmn)

arrShort(olddb)(colmn) = tmpar

else

arrShort(olddb) = array("", "", "", "", "")

end if

Next

bSort=arrShort

On Error goto 0

end Function


function bSortone(arrShort, desc)

bSortone=Split(SortVBArray(Join(arrShort, "[dbmerg2]"), desc), Chr(8))

end function


'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

' Array reversal

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


Sub Reverse(ByRef myArray)

Dim i, j, idxLast, idxHalf, strHolder

idxLast = UBound(myArray)

idxHalf = Int(idxLast/2)

For i = 0 To idxHalf

strHolder=myArray(i)

myArray(i)=myArray(idxLast-i)

myArray(idxLast-i) = strHolder

Next

End Sub


'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

' Charset convertion

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


Function StrConv(Text,SourceCharset,DestCharset)

Dim Stream

Set Stream = CreateObject("ADODB.Stream")

Stream.Type = adTypeText

Stream.Mode = adModeReadWrite

Stream.Open

Stream.Charset = SourceCharset

Stream.WriteText Text

Stream.Position = 0

Stream.Charset = DestCharset

StrConv = Stream.ReadText

End Function


'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

' Get unique values from array

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


Function uniqFE(fex, colm)

Dim i

Dim dicTemp : Set dicTemp = CreateObject("Scripting.Dictionary")

For i=0 to (ubound(fex) - 1)

dicTemp(fex(i)(colm)) = 0

'dicTemp.add fex(i)(colm), fex(i)(colm)

Next

uniqFE = dicTemp.Keys()

End Function


'*****************************************************************************************************

' GUI drawing / Logs page

'*****************************************************************************************************


function loglineclean(logline)

Set regxpclean = New RegExp

regxpclean.Global = True

regxpclean.IgnoreCase = True

regxpclean.Pattern = "[^\u0003-\u0005\u0020-\u007E\u0410-\u044F\u0401\u0451\u00AB\u00BB\u00A9\u00AE\u2116]"

logline = regxpclean.Replace(logline, "")

logline = replace(logline, "", "")

logline = replace(logline, "&", "&amp;")

logline = replace(logline, "<", "&lt;")

logline = replace(logline, ">", "&gt;")

logline = replace(logline, """", "&quot;")

logline = replace(logline, "'", "&#39;")

loglineclean = logline

end function


function arrfiller(logtype, logline)

logtime = ""

logws = ""

loguser = ""

logmsg = ""

logline = loglineclean(logline)

strpos = InStrRev(logline,"", -1)

If strpos > 0 Then

logline = right(logline, len(logline) - strpos)

end if

strpos = InStr(1, logline, "")

If strpos > 0 Then

else

stline = ""

End if

logline = trim(logline)

if logline <> "" Then

opbrms = InStr(1, logline, "")

If opbrms > 0 Then

logtype = logtype & trim(replace(left(logline, opbrms - 1), "", ""))

logline = right(logline, len(logline) - opbrms - 11)

opbrts = InStr(1, logline,"")

if opbrts <> 0 Then

logtime = replace(trim(left(logline, 11)), ".", ":")

logline = right(logline, len(logline) - opbrts)

opbrws = InStr(1, logline,"")

if opbrws <> 0 Then

logws = trim(left(logline, opbrws - 1))

logline = right(logline, len(logline) - opbrws)

opbruser = InStr(1, logline,"")

if opbruser <> 0 Then

loguser = trim(left(logline, opbruser - 1))

End if

logmsg = trim(replace(replace(right(logline, len(logline) - opbruser), "", ""), "", ": "))

else

logmsg = trim(replace(replace(right(logline, len(logline) - opbrws), "", ""), "", ": "))

End if

else

logmsg = trim(replace(replace(right(logline, len(logline) - opbrts), "", ""), "", ": "))

end if

if logtime <> "" or logws <> "" or loguser <> "" or logmsg <> "" then

if itter > 1 Then

redim preserve logfilearr(itter)

end if

logfilearr(itter - 1) = Array(logtype, logtime, logws, loguser, logmsg)

itter = itter + 1

end if

End if

End if

end function


Function ProcLogPage(procday)

'check value

if procday = "getvalue" then

procday = txt_logdate.value

end if


'building html

dim HTML

HTML = "<TABLE width=100% height=100% cellSpacing=0 cellPadding=7 style=""border: ridge 3px"" id = 'tbl'><tr><td unselectable='on' onselectstart='return false;' onmousedown='return false;' colspan=6><center><h2>Clearing Launcher v4.0<br>" & launchtitle & "</h2></center></td></tr>"

html = html & "<tr unselectable='on' onselectstart='return false;' onmousedown='return false;'><td style=""border-top: ridge 3px;"" align=center width=16%><b>Date</b></td><td style=""border-top: ridge 3px;"" align=center width=16%><b>Message type</b></td><td style=""border-top: ridge 3px;"" align=center width=16%><b>Workstation</b></td><td style=""border-top: ridge 3px;"" align=center width=16%><b>User</b></td><td style=""border-top: ridge 3px;"" align=center width=16%><b>Page</b></td><td style=""border-top: ridge 3px;"" align=center width=16%>&nbsp;</td></tr>"

html = html & "<tr><td style=""border-bottom: ridge 3px"" align=center width=16%><input type=textbox style=""background=#F8F8FF;width:100px;"" name=""txt_logdate"" value=""" & procday & """></td><td unselectable='on' onselectstart='return false;' onmousedown='return false;' style=""border-bottom: ridge 3px"" align=center width=16%>"

html = html & "<div name=""msgtypediv"" id=""msgtypediv""><select id=""msgtype"" name=""msgtype""><option value=""all"">All</option></select></div></td>"

html = html & "<td unselectable='on' onselectstart='return false;' onmousedown='return false;' style=""border-bottom: ridge 3px"" align=center width=16%><div id=""wsdiv"" name=""wsdiv""><select id=""workstation"" name=""workstation""><option value=""all"">All</option>"

html = html & "</select></div></td><td unselectable='on' onselectstart='return false;' onmousedown='return false;' style=""border-bottom: ridge 3px"" align=center width=16%><div id=""usernamediv"" name=""username""><select id=""username"" name=""username""><option value=""all"">All</option>"

html = html & "</select></div></td><td unselectable='on' onselectstart='return false;' onmousedown='return false;' style=""border-bottom: ridge 3px"" align=center width=16%><div id=""pagediv"" name=""pagediv""><select id=""page"" name=""page""><option value=""1"">1</option>"

html = html & "</select></div></td><td unselectable='on' onselectstart='return false;' onmousedown='return false;' style=""border-bottom: ridge 3px"" align=center width=16%><input style=""filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='white', endColorstr='lightblue',GradientType=0);"" type = button onclick=""vbscript:logoutput()"" value = ""Refresh"">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input style=""filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='white', endColorstr='lightblue',GradientType=0);"" type = button onclick=""vbscript:CreateStartPage()"" value = ""Return"">&nbsp;<input id=""quitbutt"" style=""filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='white', endColorstr='lightblue',GradientType=0);"" type = button onclick=""jscript:window.close();"" value = ""Quit""></td></tr>"

html = html & "<tr height=100%><td colspan=6><div id=""logtable"" name=""logtable"" style=""height=100%;overflow:scroll;""></div></td></tr></table>"

astra_page.innerHTML = HTML

call logoutput()

End Function


function logoutput()

Dim re

call writeinfile (HTA_Log & dateyyymmdd() & ".log", "[Action ]" & logstartline() & "Running log query with """ & txt_logdate.value & """ as date, """ & msgtype.value & """ as log type, """ & workstation.value & """ as workstation, """ & username.value & """ as user, """ & page.value & """ as page ", "", ForAppending, 0)

Set re = New RegExp

re.Pattern = "^(\d{8})$"

if re.Test(txt_logdate.value) Then

If isdate(Mid(txt_logdate.value, 1, 4) & "." & Mid(txt_logdate.value, 5, 2) & "." & Mid(txt_logdate.value, 7, 2)) Then

else

call writeinfile (HTA_Log & dateyyymmdd() & ".log", "[Warning]" & logstartline() & "Parameter is not a correct date!", "Parameter provided does not seem like a correct date", ForAppending, 2)

exit function

End if

else

call writeinfile (HTA_Log & dateyyymmdd() & ".log", "[Warning]" & logstartline() & "Incorrect paramter format used!", "Only digits are allowed with total length of 8 characters", ForAppending, 2)

exit function

End if

redim logfilearr(1)

itter = 1

Dim logtype, logtime, logws, loguser, logmsg, opbrms, objTextFile, strnextline, opbrws, clbrws, opbrus, clbrus, msgtypehtml


On Error Resume Next

If objFSO.fileexists(HTA_Log & txt_logdate.value & ".log") Then

Set objTextFile = objFSO.openTextfile(HTA_Log & txt_logdate.value & ".log", ForReading)

Do Until objTextFile.AtEndOfStream

If itter > 1 Then

redim preserve logfilearr(itter)

end if

logtype = ""

logtime = ""

logws = ""

loguser = ""

logmsg = ""

opbrms = 1

strNextLine = objTextFile.Readline

if left(strNextLine, 1) = "[" and mid(strNextLine, 9, 1) = "]" Then

logtype = Trim(mid(strNextLine, 2, 7))

end if

if mid(strNextLine, 11, 1) = "[" and mid(strNextLine, 23, 1) = "]" Then

logtime = Trim(mid(strNextLine, 12, 11))

end if

opbrws = InStr(24, strNextLine,"[")

if opbrws <> 0 Then

clbrws = InStr(opbrws, strNextLine,"]")

opbrus = InStr(opbrws + 1, strNextLine,"[")

opbrms = clbrws + 1

else

clbrws = 0

end if

if clbrws <> 0 Then

clbrus = InStr(clbrws + 1, strNextLine,"]")

opbrms = clbrus + 1

logws = Trim(mid(strNextLine, opbrws + 1, clbrws - opbrws - 1))

end if

if clbrus <> 0 Then

loguser = Trim(mid(strNextLine, opbrus + 1, clbrus - opbrus - 1))

end if

logmsg = Trim(mid(strNextLine, opbrms))

logfilearr(itter - 1) = Array(logtype, logtime, logws, loguser, logmsg)

itter = itter + 1

Loop

objTextFile.Close

end if


if objFSO.FolderExists(UARM_MOW_Log_Dir & "\" & txt_logdate.value & "\") Then

set oLogFolder=objFSO.GetFolder(UARM_MOW_Log_Dir & "\" & txt_logdate.value & "\")

for each oLogFile in oLogFolder.Files

Set fLog=objFSO.openTextfile(oLogFile)

call arrfiller("KBR", fLog.readline)

logarmarr = split(fLog.Readall, "")

for each logline in logarmarr

call arrfiller("KBR", logline)

next

next

end if


if objFSO.FolderExists(UARM_SPB_Log_Dir & "\" & txt_logdate.value & "\") Then

set oLogFolder=objFSO.GetFolder(UARM_SPB_Log_Dir & "\" & txt_logdate.value & "\")

for each oLogFile in oLogFolder.Files

Set fLog=objFSO.openTextfile(oLogFile)

call arrfiller("KBR", fLog.readline)

logarmarr = split(fLog.Readall, "")

for each logline in logarmarr

call arrfiller("KBR", logline)

next

next

end if


if objFSO.FolderExists(RTGS_Log_Dir & "\" & txt_logdate.value & "\") Then

set oLogFolder=objFSO.GetFolder(RTGS_Log_Dir & "\" & txt_logdate.value & "\")

for each oLogFile in oLogFolder.Files

Set fLog=objFSO.openTextfile(oLogFile)

call arrfiller("RTGS", fLog.readline)

logarmarr = split(fLog.Readall, "")

for each logline in logarmarr

call arrfiller("RTGS", logline)

next

next

end if

logfilearr=bSort(logfilearr, 1, 1)

On Error Goto 0


msgtypehtml="<select id=""msgtype"" name=""msgtype""><option value=""all"">All</option>"

Dim temparr, filteradded, logtp, wshtml, userhtml, logline, lpages, pagehtml, pagecount, endline, stline

temparr=uniqFE(logfilearr, 0)

temparr=bSortone(temparr, 0)

Reverse temparr

filteradded = false

for each logtp in temparr

if logtp <> "" then

msgtypehtml = msgtypehtml & "<option value=""" & logtp & """"

if lcase(logtp) = lcase(msgtype.value) Then

msgtypehtml = msgtypehtml & " selected=""selected"""

filteradded = true

End if

msgtypehtml = msgtypehtml & ">" & logtp & "</option>"

end if

Next

if filteradded = false and lcase(msgtype.value) <> "all" Then

msgtypehtml = msgtypehtml & "<option value=""" & msgtype.value & """ selected=""selected"">" & msgtype.value & "</option>"

end if

msgtypehtml = msgtypehtml & "</select>"


wshtml="<select id=""workstation"" name=""workstation""><option value=""all"">All</option>"

temparr=uniqFE(logfilearr, 2)

temparr=bSortone(temparr, 0)

filteradded = false

for each logtp in temparr

if logtp <> "" Then

wshtml = wshtml & "<option value=""" & logtp & """"

if lcase(logtp) = lcase(workstation.value) Then

wshtml = wshtml & " selected=""selected"""

filteradded = true

End if

wshtml = wshtml & ">" & logtp & "</option>"

end if

Next

if filteradded = false and lcase(workstation.value) <> "all" Then

wshtml = wshtml & "<option value=""" & workstation.value & """ selected=""selected"">" & workstation.value & "</option>"

end if

wshtml = wshtml & "</select>"


userhtml="<select id=""username"" name=""username""><option value=""all"">All</option>"

temparr=uniqFE(logfilearr, 3)

temparr=bSortone(temparr, 0)

filteradded = false

for each logtp in temparr

if logtp <> "" Then

userhtml = userhtml & "<option value=""" & logtp & """"

if lcase(logtp) = lcase(username.value) Then

userhtml = userhtml & " selected=""selected"""

filteradded = true

End if

userhtml = userhtml & ">" & logtp & "</option>"

end if

Next

if filteradded = false and lcase(username.value) <> "all" Then

userhtml = userhtml & "<option value=""" & username.value & """ selected=""selected"">" & username.value & "</option>"

end if

userhtml = userhtml & "</select>"


dim filtlogfilearr()

redim filtlogfilearr(1)

itter = 1

for logline = (ubound(logfilearr) - 1) to 0 step -1

if (lcase(logfilearr(logline)(0)) = lcase(msgtype.value) OR lcase(msgtype.value) = "all") AND (lcase(logfilearr(logline)(2)) = lcase(workstation.value) OR lcase(workstation.value) = "all") AND (lcase(logfilearr(logline)(3)) = lcase(username.value) OR lcase(username.value) = "all") Then

if itter > 1 Then

redim preserve filtlogfilearr(itter)

End if

filtlogfilearr(itter - 1) = logfilearr(logline)

itter = itter + 1

end if

next

lpages = ubound(filtlogfilearr) / 500

if int(lpages) <> lpages Then

lpages = int(lpages) + 1

end if


if ubound(filtlogfilearr) / 500 > 0.002 Then

pagehtml="<select id=""page"" name=""page"">"

if int(page.value) > int(lpages) Then

page.value = 1

end if

for pagecount = 1 to lpages

pagehtml = pagehtml & "<option value=""" & pagecount & """"

if int(pagecount) = int(page.value) Then

pagehtml = pagehtml & " selected=""selected"""

filteradded = true

End if

pagehtml = pagehtml & ">" & pagecount & "</option>"

Next

pagehtml = pagehtml & "</select>"


logoutput = "<table cellpadding=2 cellspacing=0>"

if int(page.value) = 1 then

endline = 0

else

endline = (1 - 500 + 500 * int(page.value))

end if

if (ubound(filtlogfilearr) - 1) < (int(page.value) * 500) then

if ((int(page.value) * 500) - (ubound(filtlogfilearr) - 1)) <= 500 then

stline = (ubound(filtlogfilearr) - 1)

else

if (ubound(filtlogfilearr) - 1) <= 500 Then

stline = (ubound(filtlogfilearr) - 1)

else

stline = 500

end if

end if

elseif (ubound(filtlogfilearr) - 1) => (int(page.value) * 500) then

stline = endline + 499

end if

for logline = endline to stline

logoutput = logoutput & "<tr"

if lcase(filtlogfilearr(logline)(0)) = "action" Then

logoutput = logoutput & " style=""background-color:#EBF5FF;color:#000055"""

elseif lcase(filtlogfilearr(logline)(0)) = "filemover" Then

logoutput = logoutput & " style=""background-color:#F0F0F0;color:#000055"""

elseif lcase(filtlogfilearr(logline)(0)) = "error" or lcase(filtlogfilearr(logline)(0)) = "hasherr" or lcase(filtlogfilearr(logline)(0)) = "kbrerror" or lcase(filtlogfilearr(logline)(0)) = "rtgserror" Then

logoutput = logoutput & " style=""background-color:#FFEBEB;color:red"""

elseif lcase(filtlogfilearr(logline)(0)) = "warning" or lcase(filtlogfilearr(logline)(0)) = "kbrwarning" or lcase(filtlogfilearr(logline)(0)) = "hashwar" or lcase(filtlogfilearr(logline)(0)) = "rtgswarning" Then

logoutput = logoutput & " style=""background-color:#FFFFC8;color:#000042"""

elseif lcase(filtlogfilearr(logline)(0)) = "info" or lcase(filtlogfilearr(logline)(0)) = "hashok" Then

logoutput = logoutput & " style=""background-color:white;color:black"""

elseif lcase(filtlogfilearr(logline)(0)) = "ok" Then

logoutput = logoutput & " style=""background-color:#54C571;color:#006555"""

else

logoutput = logoutput & " style=""background-color:white;color:black"""

end if

if lcase(filtlogfilearr(logline)(0)) = "hasherr" or lcase(filtlogfilearr(logline)(0)) = "hashok" Then

filtlogfilearr(logline)(4) = replace(filtlogfilearr(logline)(4), "|||", "<br>")

end if

logoutput = logoutput & "><td>" & filtlogfilearr(logline)(0) & "</td><td>" & filtlogfilearr(logline)(1) & "</td><td>" & filtlogfilearr(logline)(2) & "</td><td>" & filtlogfilearr(logline)(3) & "</td><td width=100%>" & filtlogfilearr(logline)(4) & "</td></tr>"

next

logoutput = logoutput & "</table>"

else

pagehtml = "<select id=""page"" name=""page""><option value=""1"">1</option>"

logoutput = "Nothing to show"

End if

document.getElementById("logtable").innerHTML = logoutput

document.getElementById("msgtypediv").innerHTML = msgtypehtml

document.getElementById("wsdiv").innerHTML = wshtml

document.getElementById("usernamediv").innerHTML = userhtml

document.getElementById("pagediv").innerHTML = pagehtml

Dim content

Set content = document.getElementById("tbl")

window.resizeTo Document.ParentWindow.Screen.AvailWidth * 0.75, Document.ParentWindow.Screen.AvailHeight * 0.75

window.moveTo ((Document.ParentWindow.Screen.AvailWidth - document.body.clientWidth) / 2), ((Document.ParentWindow.Screen.AvailHeight - document.body.clientHeight) / 2)

redim logfilearr(1)

end function

[Snippets]