Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

VBScript that Cleans Up Eroneous Characters From Log File

Posted on 2009-04-22
7
Medium Priority
?
308 Views
Last Modified: 2012-05-06
I have a script that basically goes out and scrubs the log file of eroneous characters such as ^ (carrots), : (colons) and spaces and then mashes everything together as a true comma separated file.  The script also add's the headers to the top of the CSV that it creates so that I can parse through it more efficiently.

I noticed though that the script output is putting the name of the header in the actual data along with the value and there are still little squares present.  I would assume these ASCI text squares represent "breaks" or "tabs" of some kind not sure.

If I could get it to read as such (Screen shot 1) that would be great!

Set objDialog = CreateObject("UserAccounts.CommonDialog")
 
strHeader = "EVT,DATE,TIME,TYPEOFEVT,EVTID,STATUS,ACCOUNT,TYPEOFUSER,DC,CHANGEPASSWORDATTEMPT,TARGETACCTNAME,TARGETDOMAIN,TARGETACCTID,CALLERUSERNAME,CALLERDOMAIN,CALLERLOGON,PRIVILEGES"
arrHeaders = Split(strHeader, ",")
 
objDialog.Filter = "VBScript Scripts|*.vbs|All Files|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "C:\TEST"
 
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
    Wscript.Quit
End If
 
Dim fso, DestFilename
Dim SourceFileName, Source, TopDestPath, basename, dot, SendtoPath
 
TopDestPath = "C:\TEST"
SendtoPath = "C:\TEST-RESULTS"
'SendtoPath = "C:\TEST\TEST-RESULTS"
 
Set fso = CreateObject("Scripting.FileSystemObject")
Source = objDialog.FileName
SourceFileName = fso.GetFileName(Source)
Set DestFileName = fso.GetFile(Source)
 
dot = InStr(SourceFileName, ".")
basename = Left(SourceFileName, dot-1)
'''MsgBox SendToPath & "\" & basename & ".csv"
DestFileName.Copy SendToPath & "\" & basename & ".csv", True
wscript.echo SourceFileName & " copied to " & SendToPath & "\" & basename & ".csv"
Set objCSV = fso.OpenTextFile(SendtoPath & "\" & basename & ".csv", 1, False)
strNewContents = strHeader
While Not objCSV.AtEndOfStream
        strTheLine = objCSV.ReadLine
        If strTheLine <> "" Then
                ' --- NEW SUGGESTION TO GET RID OF ^' INSTANCES AND DOUBLE SPACES ---
                'If InStr(strTheLine, Chr(94) & Chr(96)) > 0 Then MsgBox Asc(Mid(strTheLine, InStr(strTheLine, "^") + 1, 1))
                If InStr(strTheLine, Chr(94) & Chr(96)) > 0 Then strTheLine = Replace(strTheLine, Chr(94) & Chr(96), ",")
                While InStr(strTheLine, "  ") > 0
                   strTheLine = Replace(strTheLine, "  ", " ")
                Wend
                strTheLine = Replace(strTheLine, "-,", "-")
                strTheLine = Replace(strTheLine, ",0x", "-0x")
                ' -------------------------------------------------------------------
                strNewContents = strNewContents & VbCrLf & strTheLine
        End If
Wend
objCSV.Close
Set objCSV = fso.CreateTextFile(SendtoPath & "\" & basename & ".csv", True)
objCSV.Write strNewContents
objCSV.Close
Set objCSV = Nothing
 
Set fso = nothing
Set DestFileName = Nothing
 
' ********* SECOND SCRIPT STARTS HERE **********
 
'strInputFile = "C:\TEST\TEST.CSV"
'strOutputFile = "C:\TEST\TEST-RESULTS.XLS"
strInputFile = SendtoPath & "\" & basename & ".csv"
strOutputFile = Left(strInputFile, InStrRev(strInputFile, ".") - 1) & "_Results.xls"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
 
Const adVarChar = 200
Const adBigInt = 20
Const MaxCharacters = 255
Set objDataList = CreateObject("ADOR.Recordset")
For intField = 0 To UBound(arrHeaders)
        objDataList.Fields.Append arrHeaders(intField), adVarChar, MaxCharacters
Next
objDataList.Open
        
strNames = ";"
 
Set objFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
While Not objFile.AtEndOfStream
        strTheLine = objFile.ReadLine
        If Trim(strTheLine) <> "" Then
                strLine = Split(strTheLine, ",")
                If LCase(strTheLine) <> LCase(Join(arrHeaders, ",")) Then
                        If InStr(strNames, ";" & strLine(4) & ";") = 0 Then
                                strNames = strNames & strLine(4) & ";"
                        End If
                        objDataList.AddNew
                        For intField = 0 To UBound(arrHeaders)
                                objDataList(arrHeaders(intField)) = strLine(intField)
                        Next
                        objDataList.Update
                End If
        End If
Wend
objFile.Close
If Left(strNames, 1) = ";" Then strNames = Mid(strNames, 2)
If Right(strNames, 1) = ";" Then strNames = Left(strNames, Len(strNames) - 1)
 
objDataList.Sort = "DATE"
objDataList.MoveFirst
 
If Right(LCase(strOutputFile), 4) = ".xls" Then
        Set objExcel = CreateObject("Excel.Application")
        Const xlUp = -4162
        objExcel.Visible = True
        Set objWB = objExcel.Workbooks.Add
        While objWB.Sheets.Count > 1
                objWB.Sheets(objWB.Sheets.Count).Delete
        Wend
        For intField = 0 To UBound(arrHeaders)
        objWB.Sheets(objWB.Sheets.Count).Cells(1, intField + 1).Value = arrHeaders(intField)
    Next
        objWB.Sheets(objWB.Sheets.Count).Rows("1:1").Font.Bold = True
Else
        Set objOutput = objFSO.CreateTextFile(strOutputFile, True)
        objOutput.WriteLine Join(arrHeaders, ",")
        objOutput.Write String(70, "*")
End If
 
If InStr(Join(arrHeaders, ","), ",IP,") > 0 Then
        For Each strUsername In Split(strNames, ";")
                objDataList.Filter = "Username='" & strEvtID & "'"
                objDataList.MoveFirst
                boolDifferent = False
                strCurrentIP = objDataList.Fields("IP")
                While Not objDataList.EOF
                        If objDataList.Fields("IP") <> strCurrentIP Then
                                boolDifferent = True
                        End If
                        objDataList.MoveNext
                Wend
                If boolDifferent = True Then
                        objDataList.MoveFirst
                        strCurrentIP = objDataList.Fields("IP")
                        While Not objDataList.EOF
                                If Right(LCase(strOutputFile), 4) = ".xls" Then
                                        intLastRow = objWB.Sheets(objWB.Sheets.Count).Cells(65536, "A").End(xlUp).Row + 1
                                        For intField = 0 To UBound(arrHeaders)
                                        objWB.Sheets(objWB.Sheets.Count).Cells(intLastRow, intField + 1).Value = objDataList.Fields(arrHeaders(intField))
                                    Next
                                        If objDataList.Fields("IP") <> strCurrentIP Then
                                                objWB.Sheets(objWB.Sheets.Count).Rows(intLastRow & ":" & intLastRow).Font.Bold = True
                                                objWB.Sheets(objWB.Sheets.Count).Rows(intLastRow & ":" & intLastRow).Font.ColorIndex = 3
                                        End If
                                Else
                                        strLine = ""
                                        For intField = 0 To UBound(arrHeaders)
                                        If strLine = "" Then
                                                strLine = objDataList.Fields(arrHeaders(intField))
                                        Else
                                                strLine = strLine & "," & objDataList.Fields(arrHeaders(intField))
                                        End If
                                    Next
                                        objOutput.Write VbCrLf & strLine
                                End If
                                objDataList.MoveNext
                        Wend
                End If
        Next
End If
 
objDataList.Filter = "EvtID <> '540'"
On Error Resume Next
objDataList.MoveFirst
If Err.Number = 0 Then
        On Error GoTo 0
        While Not objDataList.EOF
                If Right(LCase(strOutputFile), 4) = ".xls" Then
                        intLastRow = objWB.Sheets(objWB.Sheets.Count).Cells(65536, "A").End(xlUp).Row + 1
                        For intField = 0 To UBound(arrHeaders)
                        objWB.Sheets(objWB.Sheets.Count).Cells(intLastRow, intField + 1).Value = objDataList.Fields(arrHeaders(intField))
                    Next
                        objWB.Sheets(objWB.Sheets.Count).Rows(intLastRow & ":" & intLastRow).Font.Bold = True
                        objWB.Sheets(objWB.Sheets.Count).Rows(intLastRow & ":" & intLastRow).Font.ColorIndex = 3
                Else
                        strLine = ""
                        For intField = 0 To UBound(arrHeaders)
                        If strLine = "" Then
                                strLine = objDataList.Fields(arrHeaders(intField))
                        Else
                                strLine = strLine & "," & objDataList.Fields(arrHeaders(intField))
                        End If
                    Next
                        objOutput.Write VbCrLf & strLine
                End If
                objDataList.MoveNext
        Wend
Else
        Err.Clear
        On Error GoTo 0
End If
 
If Right(LCase(strOutputFile), 4) = ".xls" Then
        objWB.Sheets(objWB.Sheets.Count).Columns.AutoFit
        objExcel.DisplayAlerts = False
        objWB.SaveAs strOutputFile
        objExcel.DisplayAlerts = True
Else
        objOutput.Close
        Set objShell = CreateObject("WScript.Shell")
        objShell.Run "notepad """ & strOutputFile & """", 1, False
End If

Open in new window

ScreenShot1.xls
TEST-Results.xls
TEST.txt
0
Comment
Question by:itsmevic
  • 4
  • 3
7 Comments
 
LVL 75

Expert Comment

by:käµfm³d 👽
ID: 24207118
They look like tabs. Have you tried adding the code for tab to your replace sequence?

The code is 0x09 or 9.
0
 
LVL 75

Expert Comment

by:käµfm³d 👽
ID: 24207145
You might be able to do Replace(strTheLine, vbTab, "") as well.
0
 

Author Comment

by:itsmevic
ID: 24208698
Yeah, I was thinking they were tabs as well, after some testing I've narrowed it down to it being that, so everywhere there is a square symbol that represents a tab.  I ran the code again by changing what you said to change but it errored out with this:

Line:  44
Char:  46
Error: Unterminated string constant
Code: 800A0409


Set objDialog = CreateObject("UserAccounts.CommonDialog")
 
strHeader = "EVT,DATE,TIME,TYPEOFEVT,EVTID,STATUS,ACCOUNT,TYPEOFUSER,DC,CHANGEPASSWORDATTEMPT,TARGETACCTNAME,TARGETDOMAIN,TARGETACCTID,CALLERUSERNAME,CALLERDOMAIN,CALLERLOGON,PRIVILEGES"
arrHeaders = Split(strHeader, ",")
 
objDialog.Filter = "VBScript Scripts|*.vbs|All Files|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "C:\TEST"
 
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
    Wscript.Quit
End If
 
Dim fso, DestFilename
Dim SourceFileName, Source, TopDestPath, basename, dot, SendtoPath
 
TopDestPath = "C:\TEST"
SendtoPath = "C:\TEST-RESULTS"
'SendtoPath = "C:\TEST\TEST-RESULTS"
 
Set fso = CreateObject("Scripting.FileSystemObject")
Source = objDialog.FileName
SourceFileName = fso.GetFileName(Source)
Set DestFileName = fso.GetFile(Source)
 
dot = InStr(SourceFileName, ".")
basename = Left(SourceFileName, dot-1)
'''MsgBox SendToPath & "\" & basename & ".csv"
DestFileName.Copy SendToPath & "\" & basename & ".csv", True
wscript.echo SourceFileName & " copied to " & SendToPath & "\" & basename & ".csv"
Set objCSV = fso.OpenTextFile(SendtoPath & "\" & basename & ".csv", 1, False)
strNewContents = strHeader
While Not objCSV.AtEndOfStream
	strTheLine = objCSV.ReadLine
	If strTheLine <> "" Then
		' --- NEW SUGGESTION TO GET RID OF ^' INSTANCES AND DOUBLE SPACES ---
		'If InStr(strTheLine, Chr(94) & Chr(96)) > 0 Then MsgBox Asc(Mid(strTheLine, InStr(strTheLine, "^") + 1, 1))
		If InStr(strTheLine, Chr(94) & Chr(96)) > 0 Then strTheLine = Replace(strTheLine, Chr(94) & Chr(96), ",")
		While InStr(strTheLine, "  ") > 0
		   strTheLine = Replace(strTheLine, "  ", " ")
		Wend
		strTheLine = Replace(strTheLine, "vbTab,"")
		strTheLine = Replace(strTheLine, ",0x09", "-0x")
		' -------------------------------------------------------------------
		strNewContents = strNewContents & VbCrLf & strTheLine
	End If
Wend
objCSV.Close
Set objCSV = fso.CreateTextFile(SendtoPath & "\" & basename & ".csv", True)
objCSV.Write strNewContents
objCSV.Close
Set objCSV = Nothing
 
Set fso = nothing
Set DestFileName = Nothing
 
' ********* SECOND SCRIPT STARTS HERE **********
 
'strInputFile = "C:\TEST\TEST.CSV"
'strOutputFile = "C:\TEST\TEST-RESULTS.XLS"
strInputFile = SendtoPath & "\" & basename & ".csv"
strOutputFile = Left(strInputFile, InStrRev(strInputFile, ".") - 1) & "_Results.xls"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
 
Const adVarChar = 200
Const adBigInt = 20
Const MaxCharacters = 255
Set objDataList = CreateObject("ADOR.Recordset")
For intField = 0 To UBound(arrHeaders)
	objDataList.Fields.Append arrHeaders(intField), adVarChar, MaxCharacters
Next
objDataList.Open
	
strNames = ";"
 
Set objFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
While Not objFile.AtEndOfStream
	strTheLine = objFile.ReadLine
	If Trim(strTheLine) <> "" Then
		strLine = Split(strTheLine, ",")
		If LCase(strTheLine) <> LCase(Join(arrHeaders, ",")) Then
			If InStr(strNames, ";" & strLine(4) & ";") = 0 Then
				strNames = strNames & strLine(4) & ";"
			End If
			objDataList.AddNew
			For intField = 0 To UBound(arrHeaders)
				objDataList(arrHeaders(intField)) = strLine(intField)
			Next
			objDataList.Update
		End If
	End If
Wend
objFile.Close
If Left(strNames, 1) = ";" Then strNames = Mid(strNames, 2)
If Right(strNames, 1) = ";" Then strNames = Left(strNames, Len(strNames) - 1)
 
objDataList.Sort = "DATE"
objDataList.MoveFirst
 
If Right(LCase(strOutputFile), 4) = ".xls" Then
	Set objExcel = CreateObject("Excel.Application")
	Const xlUp = -4162
	objExcel.Visible = True
	Set objWB = objExcel.Workbooks.Add
	While objWB.Sheets.Count > 1
		objWB.Sheets(objWB.Sheets.Count).Delete
	Wend
	For intField = 0 To UBound(arrHeaders)
    	objWB.Sheets(objWB.Sheets.Count).Cells(1, intField + 1).Value = arrHeaders(intField)
    Next
	objWB.Sheets(objWB.Sheets.Count).Rows("1:1").Font.Bold = True
Else
	Set objOutput = objFSO.CreateTextFile(strOutputFile, True)
	objOutput.WriteLine Join(arrHeaders, ",")
	objOutput.Write String(70, "*")
End If
 
If InStr(Join(arrHeaders, ","), ",IP,") > 0 Then
	For Each strUsername In Split(strNames, ";")
		objDataList.Filter = "Username='" & strEvtID & "'"
		objDataList.MoveFirst
		boolDifferent = False
		strCurrentIP = objDataList.Fields("IP")
		While Not objDataList.EOF
			If objDataList.Fields("IP") <> strCurrentIP Then
				boolDifferent = True
			End If
			objDataList.MoveNext
		Wend
		If boolDifferent = True Then
			objDataList.MoveFirst
			strCurrentIP = objDataList.Fields("IP")
			While Not objDataList.EOF
				If Right(LCase(strOutputFile), 4) = ".xls" Then
					intLastRow = objWB.Sheets(objWB.Sheets.Count).Cells(65536, "A").End(xlUp).Row + 1
					For intField = 0 To UBound(arrHeaders)
				    	objWB.Sheets(objWB.Sheets.Count).Cells(intLastRow, intField + 1).Value = objDataList.Fields(arrHeaders(intField))
				    Next
					If objDataList.Fields("IP") <> strCurrentIP Then
						objWB.Sheets(objWB.Sheets.Count).Rows(intLastRow & ":" & intLastRow).Font.Bold = True
						objWB.Sheets(objWB.Sheets.Count).Rows(intLastRow & ":" & intLastRow).Font.ColorIndex = 3
					End If
				Else
					strLine = ""
					For intField = 0 To UBound(arrHeaders)
				    	If strLine = "" Then
				    		strLine = objDataList.Fields(arrHeaders(intField))
				    	Else
				    		strLine = strLine & "," & objDataList.Fields(arrHeaders(intField))
				    	End If
				    Next
					objOutput.Write VbCrLf & strLine
				End If
				objDataList.MoveNext
			Wend
		End If
	Next
End If
 
objDataList.Filter = "EvtID <> '540'"
On Error Resume Next
objDataList.MoveFirst
If Err.Number = 0 Then
	On Error GoTo 0
	While Not objDataList.EOF
		If Right(LCase(strOutputFile), 4) = ".xls" Then
			intLastRow = objWB.Sheets(objWB.Sheets.Count).Cells(65536, "A").End(xlUp).Row + 1
			For intField = 0 To UBound(arrHeaders)
		    	objWB.Sheets(objWB.Sheets.Count).Cells(intLastRow, intField + 1).Value = objDataList.Fields(arrHeaders(intField))
		    Next
			objWB.Sheets(objWB.Sheets.Count).Rows(intLastRow & ":" & intLastRow).Font.Bold = True
			objWB.Sheets(objWB.Sheets.Count).Rows(intLastRow & ":" & intLastRow).Font.ColorIndex = 3
		Else
			strLine = ""
			For intField = 0 To UBound(arrHeaders)
		    	If strLine = "" Then
		    		strLine = objDataList.Fields(arrHeaders(intField))
		    	Else
		    		strLine = strLine & "," & objDataList.Fields(arrHeaders(intField))
		    	End If
		    Next
			objOutput.Write VbCrLf & strLine
		End If
		objDataList.MoveNext
	Wend
Else
	Err.Clear
	On Error GoTo 0
End If
 
If Right(LCase(strOutputFile), 4) = ".xls" Then
	objWB.Sheets(objWB.Sheets.Count).Columns.AutoFit
	objExcel.DisplayAlerts = False
	objWB.SaveAs strOutputFile
	objExcel.DisplayAlerts = True
Else
	objOutput.Close
	Set objShell = CreateObject("WScript.Shell")
	objShell.Run "notepad """ & strOutputFile & """", 1, False
End If 

Open in new window

0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 

Author Comment

by:itsmevic
ID: 24208723
The end goal is to remove miscellaneous characters i.e. tab spaces, colons, carrots ects and then add the comma's where needed based off of the string headers at the top.  this way it cleans the log and can be much better parsed through with utilities such as logparser.
0
 
LVL 75

Accepted Solution

by:
käµfm³d   👽 earned 2000 total points
ID: 24208783
Change

    strTheLine = Replace(strTheLine, "vbTab,"")    <-- extra quote before vbTab

to

    strTheLine = Replace(strTheLine, vbTab,"")
0
 

Author Comment

by:itsmevic
ID: 24209153
ABSOLUTELY BEAUTIFUL! it worked all the crap characters are out completely!  You are tha MAN!!!
0
 

Author Closing Comment

by:itsmevic
ID: 31573408
Awesome, very happy!  Expert was quick to respond and very helpful!  Highly recommend!
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Active Directory replication delay is the cause to many problems.  Here is a super easy script to force Active Directory replication to all sites with by using an elevated PowerShell command prompt, and a tool to verify your changes.
In threads here at EE, each comment has a unique Identifier (ID). It is easy to get the full path for an ID via the right-click context menu. However, we often want to post a short link within a thread rather than the full link. This article shows a…
The viewer will learn how to create a basic form using some HTML5 and PHP for later processing. Set up your basic HTML file. Open your form tag and set the method and action attributes.: (CODE) Set up your first few inputs one for the name and …
Video by: Mark
This lesson goes over how to construct ordered and unordered lists and how to create hyperlinks.
Suggested Courses

580 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question