Option Explicit '------------------------------------------------------------------------- ' trackloginevents.vbs ' ' Beschreibung: ueberwacht das Security Eventlog auf Meldungen ' ' (c)2006 Net at Work Netzwerksysteme GmbH ' ' Version 1.1 (11. Dec 2008) ' + Version basierend auf Eventlogwath ' ' Optimieurng imt Vorfilterung der Events möglich ' '------------------------------------------------------------------------- const conFrom = "trackloginevents@msxfaq.local" Const STRHOMESERVER = "srv01" ' any Exchange Server,. preferred to use the homeserver of the test mailbox Const STRMAILBOX = "fcarius" ' Must be your own address where the message is send from and mirror replies to Const STRALERTMAIL = "administrator@msxfaq.local" ' need to have the SMTP-Adress of the mirror const ProcessOldEvents = true ' set to true dto process existing events const Waitforevents = false ' set to true to run trigger call ForceCScript ' must be rund with CSCRIPT dim strOutFilePrefix strOutFilePrefix = makefilename("TrackLoginEvents-" & Date() & "-" & Time()) ' common name of the output files without extension dim objDebug set objdebug = new DebugWriter objDebug.target = "file:5 console:5" 'ie:2 eventlog:2" ' errorlogging 0=only output, 1=Error 2=Warning 3=information 5++ =debug objDebug.outFile = strOutFilePrefix & ".log" objDebug.writeln "TrackLoginEvents:Skript gestartet", 0 dim OutCSV set OutCSV = new clsCSVWriter OutCSV.OpenFile strOutFilePrefix & ".csv" ,OutCSV.Overwrite ' Overwrite OutCSV.Delimiter = ";" '~ OutCSV.Quote = "'" OutCSV.WriteRawLine("# Security eventlog:") OutCSV.AddHeader "timestamp" OutCSV.AddHeader "status" OutCSV.AddHeader "eventid" OutCSV.AddHeader "User" OutCSV.AddHeader "domain" OutCSV.AddHeader "logintype" OutCSV.AddHeader "workstation" OutCSV.AddHeader "SourceNetAddr" OutCSV.WriteHeader "" ' Header ohne Prefix ausschreiben objDebug.writeln "TrackLoginEvents:OutCSV initialisiert", 5 dim objWMIService, colMonitoredEvents, colLoggedEvents, objEvent Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") objDebug.writeln "TrackLoginEvents:WMI Connect created - searching für events", 5 if ProcessOldEvents then Set colLoggedEvents = objWMIService.ExecQuery ("SELECT * from Win32_NTLogEvent WHERE LogFile = 'Security'") objDebug.writeln "TrackLoginEvents:WMI Connect created - done", 5 For Each objEvent In colLoggedEvents call processEvent(objEvent) next end if if Waitforevents then objDebug.writeln "TrackLoginEvents:WMI Connect created - Waiting für events", 5 Set colMonitoredEvents = objWMIService.ExecNotificationQuery _ ("Select * from __instancecreationevent where TargetInstance isa 'Win32_NTLogEvent' and TargetInstance.LogFile = 'Security'") Do 'Endlosschleife wscript.echo "Warte auf Events..." Set objEvent = colMonitoredEvents.NextEvent wscript.echo "Event ID: " & objEvent.targetInstance.Eventcode & " gefunden am " & now () '~ wscript.echo objEvent.TargetInstance.Message call processEvent(objEvent.targetInstance) wscript.echo "Events verarbeitet" Loop end if wscript.quit(0) sub processEvent(objCurrentEvent) dim strMessage dim dteventdate dteventdate = evtdatetime(objCurrentEvent.TimeGenerated) strMessage = objCurrentEvent.Message select case objCurrentEvent.Eventcode case "540" call ProcessEventSuccess1("540",dteventdate,strMessage) case "528" call ProcessEventSuccess1("528",dteventdate,strMessage) case "529" call ProcessEventFail1("529",dteventdate,strMessage) case else wscript.echo "Event " & objCurrentEvent.Eventcode & " not processed" end select end sub sub ProcessEventSuccess1(streventid, dttimestamp,strText) dim arrMessage strText = replace(strText,vbtab,"") arrMessage = split(strText,vbcrlf&vbcrlf) if ubound(arrMessage) = 16 then objDebug.writeln "TrackLoginEvents: Found Event:" ,3 OutCSV.StartLine OutCSV.AddField "timestamp", dttimestamp OutCSV.AddField "eventid", streventid OutCSV.AddField "status", "Success" objDebug.writeln "TrackLoginEvents: Username :" & trim(split(arrMessage(1),":")(1)),3 OutCSV.AddField "User", trim(split(arrMessage(1),":")(1)) objDebug.writeln "TrackLoginEvents: Domain :" & trim(split(arrMessage(2),":")(1)),3 OutCSV.AddField "domain", trim(split(arrMessage(2),":")(1)) objDebug.writeln "TrackLoginEvents: Logintype :" & trim(split(arrMessage(4),":")(1)),3 OutCSV.AddField "logintype", trim(split(arrMessage(4),":")(1)) objDebug.writeln "TrackLoginEvents: Workstation :" & trim(split(arrMessage(7),":")(1)) ,3 OutCSV.AddField "workstation", trim(split(arrMessage(7),":")(1)) objDebug.writeln "TrackLoginEvents: QuellNetAddr:" & trim(split(arrMessage(14),":")(1)) ,3 OutCSV.AddField "SourceNetAddr", trim(split(arrMessage(14),":")(1)) OutCSV.Writeline 'Zeile rausschreiben ' dim objSendMail ' set objSendMail = CreateObject("CDONTS.NewMail") ' objSendMail.From = conFrom ' objSendMail.To = STRALERTMAIL ' objSendMail.Subject = "Eventlogwatch: " & STREVENTID & " found" ' objSendMail.Body = strMessage ' objSendMail.Send ' set objSendMail = Nothing else objDebug.writeln "TrackLoginEvents: uBOundnot matching - Skip event", 2 end if end sub sub ProcessEventFail1(streventid, dttimestamp,strText) dim arrMessage strText = replace(strText,vbtab,"") arrMessage = split(strText,vbcrlf&vbcrlf) if ubound(arrMessage) = 15 then objDebug.writeln "TrackLoginEvents: Found Event:" ,3 OutCSV.StartLine OutCSV.AddField "timestamp", dttimestamp OutCSV.AddField "eventid", streventid OutCSV.AddField "status", "Fail" objDebug.writeln "TrackLoginEvents: Username :" & trim(split(arrMessage(2),":")(1)),3 OutCSV.AddField "User", trim(split(arrMessage(2),":")(1)) objDebug.writeln "TrackLoginEvents: Domain :" & trim(split(arrMessage(3),":")(1)),3 OutCSV.AddField "domain", trim(split(arrMessage(3),":")(1)) objDebug.writeln "TrackLoginEvents: Logintype :" & trim(split(arrMessage(4),":")(1)),3 OutCSV.AddField "logintype", trim(split(arrMessage(4),":")(1)) objDebug.writeln "TrackLoginEvents: Workstation :" & trim(split(arrMessage(7),":")(1)) ,3 OutCSV.AddField "workstation", trim(split(arrMessage(7),":")(1)) objDebug.writeln "TrackLoginEvents: QuellNetAddr:" & trim(split(arrMessage(13),":")(1)) ,3 OutCSV.AddField "SourceNetAddr", trim(split(arrMessage(13),":")(1)) OutCSV.Writeline 'Zeile rausschreiben ' dim objSendMail ' set objSendMail = CreateObject("CDONTS.NewMail") ' objSendMail.From = conFrom ' objSendMail.To = STRALERTMAIL ' objSendMail.Subject = "Eventlogwatch: " & STREVENTID & " found" ' objSendMail.Body = strMessage ' objSendMail.Send ' set objSendMail = Nothing wscript.quit else objDebug.writeln "TrackLoginEvents: uBOundnot matching - Skip event", 2 end if end sub Function evtdatetime(evttime) ' Auszug aus http://www.sadikhov.com/forum/Assistance-Requested-On-Vbscript_13254.html ' Konvertiert die Datum/Zeit Informationdes Eventlog in ein lesbares Format. Dim tmGen, dtPart,tmPart,strDt tmGen = evttime & "" dtPart = Mid(tmGen,1,8) tmPart = Mid(tmGen,9,6) strDt = Mid(dtPart,5,2) & "/" & Mid(dtPart,7,2) & "/" & Mid(dtPart,1,4) & " " & _ Mid(tmPart,1,2) & ":" & Mid(tmPart,3,2) & ":" & Mid(tmPart,5,2) evtdatetime = FormatDateTime(strDt,0) End Function class debugwriter ' Generic Class für writing debugging information and handling runtime errors ' By default al Level 1 Messaegs are logged to the Console private objIE, file, fs, debugfilename, status, strline private debuglevelIE , debuglevelfile, debugleveleventlog, debuglevelConsole private Sub Class_Initialize status = "active" : strline = "" : debugfilename = "" debuglevelIE = 0 debuglevelfile = 0 debugleveleventlog = 0 debuglevelConsole = 1 End Sub private Sub Class_Terminate() if isobject(OBJIE) then objie.document.write "" end if if debugfilename <> "" then file.Close end if End Sub public sub start : status = "active": end sub public sub pause : status = "pause" : end sub public property let outfile(wert) if debugfilename <> "" then 'Close existing debug file file.close : file = nothing : fs = nothing end if debugfilename = wert ' open debug file Set fs = CreateObject("Scripting.FileSystemObject") Set file = fs.OpenTextFile(makefilename(debugfilename), 8, True) end property public property let setie (wert) : set objIE = wert : objie.visible = true end property public property let target (wert) dim arrTemp, intcount arrTemp = split(wert," ") ' spit by space for intcount = 0 to ubound(arrTemp) select case lcase(split(arrtemp(intcount),":")(0)) case "ie" debuglevelIE = cint(right(arrtemp(intcount),1)) case "file" debuglevelfile = cint(right(arrtemp(intcount),1)) case "eventlog" debugleveleventlog = cint(right(arrtemp(intcount),1)) case "console" debuglevelConsole = cint(right(arrtemp(intcount),1)) end select next end property sub write(strMessage) strline = strline & strMessage end sub Sub writeln(strMessage, intseverity) 'Fügt einen Eintrag in die Log-Datei ein dim blnerror strMessage = strline & strMessage ' add existing Output Messages strline = "" if err <> 0 then ' Sonderbehandlung als "ErrorHandler" blnerror = true strmessage= "RuNTIME ERROR :" & strMessage & vbcrlf & _ "ERR.Number :" & err.number & vbcrlf & _ "ERR.Description:" & err.Description & vbcrlf & _ "ERR.Source :" & err.source & vbcrlf & _ "ERR.HelpFile :" & err.HelpFile & vbcrlf & _ "ERR.HelpContext:" & err.HelpContext & vbcrlf err.clear else blnerror = false end if if ((status = "active") or blnerror) then if (debuglevelfile > 0) and ((debuglevelfile >= intseverity) or blnerror) and (debugfilename <> "") then file.Write(Now & ",") Select Case intseverity Case 0 file.Write("Out0") Case 1 file.Write("Err1") Case 2 file.Write("Wrn2") Case 3 file.Write("Inf3") Case Else file.Write("Dbg"&intseverity) End Select file.WriteLine("," & Convert2Text(strMessage)) strline = "" end if if (debugleveleventlog > 0) and ((debugleveleventlog >=intSeverity) or blnerror) then dim objWSHShell Set objWSHShell = Wscript.CreateObject("Wscript.Shell") Select Case intseverity Case 0 objWSHShell.LogEvent 0, strMessage ' Const EVENT_SUCCESS = 0 Case 1 objWSHShell.LogEvent 1, strMessage ' const EVENT_ERROR = 1 Case 2 objWSHShell.LogEvent 2, strMessage ' Const EVENT_WARNING = 2 Case else objWSHShell.LogEvent 4, strMessage ' Const EVENT_INFO = 4 End Select end if if (debuglevelconsole > 0) and ((debuglevelconsole >=intSeverity) or blnerror) then Select Case intseverity Case 0 wscript.echo now() & ",OuT0:" & strMessage Case 1 wscript.echo now() & ",ERR1:" & strMessage Case 2 wscript.echo now() & ",WRN2:" & strMessage Case 3 wscript.echo now() & ",INF3:" & strMessage Case Else wscript.echo now() & ",DBG" & intseverity & ":" & strMessage End Select end if if (debuglevelie > 0) and ((debuglevelie >= intSeverity) or blnerror) then dim strieline if not isobject(objIE) then Set objIE = CreateObject("InternetExplorer.Application") objIE.navigate("about:blank") objIE.visible = true Do While objIE.Busy WScript.Sleep 50 Loop objIE.document.write "DebugWriter Output" objIE.document.write "
" end if strieline = "" Select Case intseverity Case 0 strieline = strieLine & "" Case 1 strieline = strieLine & "" Case 2 strieline = strieLine & "" Case 3 strieline = strieLine & "" Case Else strieline = strieLine & "" End Select strieline = strieline & "" objIE.document.write cstr(strieline) end if '~ if (instr(DebugTarget,"mom") <>0) or blnerror then '~ scriptContext.echo now() &","& intseverity &":"& strline & strMessage '~ end if end if ' if status = active strline = "" End Sub private function makefilename(wert) ' Converts all invalid characters to valid file names wert = replace(wert,"\","-") wert = replace(wert,"/","-") wert = replace(wert,":","-") wert = replace(wert,"*","-") wert = replace(wert,"?","-") wert = replace(wert,"<","-") wert = replace(wert,"|","-") wert = replace(wert,"""","-") makefilename = wert end function private function Convert2Text(wert) ' Converts non printable characters to "X" , so that Textfile is working dim loopcount, tempwert, inttest tempwert="" for loopcount = 1 to len(wert) ' replace all unprintable characters maybe easier and faster with RegEx tempwert = tempwert & chr(ascb(mid(wert,loopcount,1))) next Convert2Text = tempwert end function end class function makefilename(wert) ' Converts all invalid characters to valid file names wert = replace(wert,"\","-") wert = replace(wert,"/","-") wert = replace(wert,":","-") wert = replace(wert,"*","-") wert = replace(wert,"?","-") wert = replace(wert,"<","-") wert = replace(wert,"|","-") wert = replace(wert,"""","-") makefilename = wert end function sub ForceCScript If InStr(1,WScript.FullName,"cscript",vbTextCompare) = 0 Then ' Prüfung ob mit CSCRIPT gestartet wurde wscript.echo "Bitte mit CSCRIPT aufrufen" wscript.quit (255) end if end sub class clsCSVWriter ' Class to write generic CSVFiles ' Version 1.0 Initial Version ' Version 1.1 WriteHeader + Prefix, WriteRawLine ' Version 1.2 Add "Exists"-Methode und Fehler in "Append"-Methode ' Last Modified: 30. Jan 2008 ' Pending: Quotataion of '"'-Character in Data !! private csvfilename, csvfs, csvfile, chrDelimiter, chrQuote, strline private dictLine private Sub Class_Initialize chrDelimiter =";" : chrQuote = """" : csvfilename = "" set dictLine = createobject("scripting.dictionary") End Sub public property let Delimiter (wert) ' Konfigure the delimiter. Default is ";" chrDelimiter =wert end property public property let Quote(wert) ' Konfigure the sting enquoting. Default is " chrQuote = wert end property public property get Overwrite ' Contant für Filemode Overwrite = 2 end property public property get Append ' Contant für Filemode Append = 8 end property public property get Exist(strFile) Set csvfs = CreateObject("Scripting.FileSystemObject") if csvfs.FileExists(strFile) then Exist = true else Exist = False end if end property sub OpenFile(wert,intFileMode) ' Open and start a new CSV-File if csvfilename <> "" then 'Close existing debug file csvfile.close : csvfile = nothing : csvfs = nothing end if csvfilename = wert ' open debug file Set csvfs = CreateObject("Scripting.FileSystemObject") Set csvfile = csvfs.OpenTextFile(csvfilename, intFileMode, True) end sub sub AddHeader(strvalue) ' Add a new column to the csv dataset if dictLine.exists(strvalue) then objDebug.writeln "CSVWriter: duplicate Header definition:" & strValue, 1 else dictLine.add strvalue, empty end if end sub Sub WriteHeader(strPrefix) ' Write the current Header Definition to the file. optional with a prefix ' Prefix can be used to fake IISLogs with "# Field: " dim key, strline strline = "" for each key in dictLine.keys if strline <> "" then strline = strline & chrDelimiter end if strline = strline & chrQuote & cstr(key) & chrQuote next csvfile.WriteLine(strPrefix & strline) End Sub sub AddField(strfieldname,strvalue) ' add a valuue together with the field name if dictLine.exists(strfieldname) then dictLine.item(strfieldname) = strvalue else objDebug.writeln "CSVWriter: Field not declared:" & strFieldname, 1 end if end sub Sub WriteLine ' Write the current filled fields to the disk and starte a new line dim key, strline strline = "" for each key in dictLine.keys if strline <> "" then strline = strline & chrDelimiter end if strline = strline & chrQuote & dictLine(key) & chrQuote dictLine.item(key) = empty next csvfile.WriteLine(strline) End Sub Sub WriteRawLine(strLine) ' Write line without any formatting etc. Ideal für comments and other custom output csvfile.WriteLine(strline) End Sub sub StartLine ' Start a new line. Remove all existing data of the current line dim key, strline strline = "" for each key in dictLine.keys dictLine.item(key) = empty next End Sub end class
TimeintseverityDescription
" & now () & "Out0Err1Wrn2Inf3Dbg"&intseverity&"" & strmessage & "