'------------------------------------------------------------------------- ' End2End-SMTPflow ' ' Beschreibung ' Sendet eine Testmail und prüft den Empfang der Bestätigung beim folgenden Aufruf ' ' Vorgehensweise ' - Check des Posteingang auf Mails mit bestimmten Betreff ' Vergleich Zeitstempel mit Empfangszeit der Mail ' WENN delta über Grenzwert, dann Alarm ' - Datum der aktuellsten Statusmail > Timeout -> Warnung ' - Versand einer Statusmail an den mirroraccount ' ' beim ersten Aufruf oder bei Pausen >15min beim Aufruf ist ein Alarm ok da es keine aktuellere Statusmail gibt ! ' Das Skript sollte z.B: mit dem taskPlaner regelmäßig gestartet werden ' Jede empfangene Mail sind ca 300 Byte, d.h.alle 15 min ergibt dies weniger als 10 MByte/Jahr ' ' Ausgabe als RRD-Datenbank und CSV-Datei ' ' Voraussetzung ' - Ausführender Benutzer muss auf das Postfächer berechtigt sein ' - Verbindung zum DC/GC und Mailserver ' CDO 1.21 (z.B. auf dem Exchange Server) ' ' Version 1.0 (06. Dez 2005) ' Erste Version ' Meldung an Admin o.ä., ' Version 1.1 (08. Dez 2005) ' Ausgabe der reinen Nutzdaten als XML-Datei zur Auswertung als Grafik (Excel etc.) ' Version 1.2 (08. Dez 2005) ' Tokens als Konstanten ' Löschen der Nachrichten > 24h ' Optional export in RRDTool/MRTG ' Version 1.3 (20. Dez 2005) ' Option als "LOOP" zu starten (z.B. als StartupScript oder Dienst) ' XML-Datei wird immer wieder wieder überschrieben ' xmlReportWriter reste entfernt ' Version 1.4 (02. Jan 2006) ' mirror@charite.de als Default entfernt ' DIM Befehle einsortiert ' Delete Option geändert auf last Message bleibt always bestehen ' RRD-Datenbank angepasst (24h stat 23:50) ' Version 2.0 (03. Jan 2006) ' Neue Ausgabe !!. Ausgabe als RRD und "CSV-Logdatei" ' Löschen aller Statusmails aus dem Posteingang nach Verarbeitung ' Achtung: Ein sehr schneller mehrmaliger aufruf kann Fehlalarme melden, wenn die Antwortmail des vorherigen Aufrufs noch nicht da ist. (Meist Sekunden) ' Version 2.1 (05. Jan 2006) ' oMapiMessage.TimeCreated und oMapiMessage.TimeReceived ' RRD Timestamp basierend auf dem Sendedatum statt dem Empfangendatum. "Ausfälle" sind so dann auch besser erkennbar. ' Version 2.2 (06. Jan 2006) ' Grafikausgabe nach .\Web ' Protokolldatei ohne Datum/Zeit-Stempel ' Version 2.3 (06. Jan 2006) ' Danke an Giesen, Carsten (Sympatex) für die aktive Mithilfe bei Verbesserungen und Fehlersuche ' Erweiterung um 100x100 Bild mit Rot, wenn letzer Test fehlgeschlagen für Sharepoint Webpart ' Version 2.4 (11. Jan 2006) ' Maximalwert für Grafik, damit eine lange Mail nicht die Grafk überskaliert ' Version 2.5 (19. Jan 2006) ' Mehr Debugging aufgrund einiger unbekannter Abbrüche ' irrtümlich auskommentiertes "on error resume next" wieder aktiviert ' Entfernen von Abbruch ' Version 2.6 (08. Okt 2006) ' Ergebnis in Betreff übernommen ' ' Erweiterungen: ' Anbindung an Datenbanken, Meldung per SNMP o.ä. ' Verbesserte Fehlerbehandung im Subject ' AdminMail als Dringend ? ' ' Links ' http://people.ee.ethz.ch/~oetiker/webtools/rrdtool/tut/rrdtutorial.en.html ' http://www.merlyn.demon.co.uk/vb-dates.htm ' http://people.ee.ethz.ch/~oetiker/webtools/mrtg/paper/ '------------------------------------------------------------------------- Option Explicit ' Bitte diese Konstanten pflegen Const STRHOMESERVER = "srv01" ' any Exchange Server,. preferred to use the homeserver of the test mailbox Const STRMAILBOX = "Administrator@msxfaq.local" ' Must be your own address where the message is send from and mirror replies to Const STRMIRROR = "Administrator@example.com" ' need to have the SMTP-Adress of the mirror Const STRALERTMAIL = "administrator@msxfaq.local" ' need to have the SMTP-Adress of the mirror const CSVFILENAME = ".\End2End-SMTPflow.CSV" 'Pfad und Name der CSV-Protokolldatei" Const INTTIMEOUT = 240 ' in Sekunden = 40 minuten maximale Zeitspanne zwischen Versand und Empfang Const STRRRDEXE = ".\RRDTOOL.EXE" ' Pfad und Name der RRDTOol Exe Const STRRRDDB = ".\End2End-SMTPflow.RRD" 'Pfad und Name der Datenbank" Const STRRRDBILD = " .\web\End2End-SMTPflow" 'Pfad und Namesanfang ohne Erweiterung des erstellen Bildes Wenn leer, dann keine Grafikerzeugung const INTRRDINTERVAL = 600 ' Intervalle des Aufrufs für RRD-Datenbank const STRTOKEN1 = "MSXFAQ:End2End-SMTPflow:" ' prefix im Betreff const STRTOKEN2 = ":MSXFAQ:End2End-SMTPflow" ' PostFix im Betreff dim strOutFilePrefix, blnstop dim strAlertSubject call ForceCScript ' must be rund with CSCRIPT to avoid messageboxes 'call abbruch ("End2End-SMTPflow Script fortsetzen ?" ,5) ' Last question to stop ' ----- Initialisierung der Debugging und Loggingoptionen 'strOutFilePrefix = "End2End-SMTPflow-" & makefilename(Date() & "-" & Time()) ' Pfad und Dateiname der Log-Datei strOutFilePrefix = "End2End-SMTPflow" ' Pfad und Dateiname der Log-Datei dim objDebug set objdebug = new DebugWriter objDebug.target = "file:3 console:6" ' ie eventlog objDebug.outFile = strOutFilePrefix &".log" objDebug.start objDebug.writeln "End2End-SMTPflow: gestartet", 0 if wscript.arguments.count = 0 then objDebug.writeln "End2End-SMTPflow: Single Run", 0 call End2End-SMTPflow elseif lcase(wscript.arguments(0)) = "loop" then blnstop = false do objDebug.writeln "End2End-SMTPflow: RunAgain", 0 call End2End-SMTPflow call abbruch ("End2End-SMTPflow Script fortsetzen ?" ,INTRRDINTERVAL) ' wait time loop else objDebug.writeln "End2End-SMTPflow: Error - Invalid Argument", 0 end if objDebug.writeln "End2End-SMTPflow: beendet", 0 wscript.quit(0) sub End2End-SMTPflow dim strResult, strSent, introundtrip, dtStarttime dim oMapiMessages, oMapiMessage, oMapiSession, objMessage dim dtLastMessage, intlastroundtrip dim blnglobalalert, strglobalerror, blnstop on error resume next strResult = "Fehlermeldungen:" Set oMapiSession = CreateObject("MAPI.Session") if Err.Number <> 0 Then objDebug.writeln " Error creating MAPI Session Skip Mailbox",1 strResult = strResult & vbcrlf & "ERROR CDOObject" else objDebug.writeln " Logon to mailbox " & STRHOMESERVER & "/" & STRMAILBOX, 0 oMapiSession.Logon "", "", False, True, 0, true, STRHOMESERVER & vbLF & STRMAILBOX if Err.Number <> 0 Then objDebug.writeln " Error MAPI Logon",1 strResult = strResult & vbcrlf & "ERROR MapiLogon" else objDebug.writeln " Open Inbox", 0 Set oMapiMessages = oMapiSession.Inbox.Messages ' Posteingang öffnen if Err.Number <> 0 Then objDebug.writeln " Error MAPI Get Inbox",1 strResult = strResult & vbcrlf & "ERROR MapiGetInbox" else objDebug.writeln " Processing Inbox", 0 dtLastMessage = 0 ' Speicher für das Datum der letzten Statusmail intlastroundtrip = 0 ' roundtriptime of last status message blnglobalalert = false For Each oMapiMessage In oMapiMessages ' Alle EMails auflisten if instr(oMapiMessage.Subject,STRTOKEN1) <> 0 _ and instr(oMapiMessage.Subject,STRTOKEN1) < instr(oMapiMessage.Subject,STRTOKEN2) then ' Statusmessage objDebug.writeln " Process message:" & oMapiMessage.Subject,3 strSent = mid(oMapiMessage.Subject,instr(oMapiMessage.Subject,STRTOKEN1)+len(STRTOKEN1)) ' hier muss noch mehr Errorhandling rein strSent = left(strSent,instr(strSent,STRTOKEN2)-1) objDebug.writeln " Timestamp :" & strSent,5 objDebug.writeln " TimeReceived:" & oMapiMessage.TimeReceived , 5 introundtrip = round((oMapiMessage.TimeReceived - cdate(strsent))*86400) objDebug.writeln " Delta:" & introundtrip ,5 if introundtrip > INTTIMEOUT then objDebug.writeln " ALERT Statusmail vom " & strsent & " Roundtrip:" & introundtrip & " > Delta: " & INTTIMEOUT,2 strAlertSubject = "Roundtrip:" & introundtrip & " > Delta: " & INTTIMEOUT call appendcsvfile (CSVFILENAME,now,strsent,oMapiMessage.TimeReceived,introundtrip,"ALERT") strResult = strResult & vbcrlf & " ALERT Statusmail am " & strsent & " Roundtrip " & introundtrip & " > "& INTTIMEOUT blnglobalalert = true else objDebug.writeln " OK Statusmail vom " & strsent & " Roundtrip:" & introundtrip & "< Delta: " & INTTIMEOUT,2 call appendcsvfile (CSVFILENAME,now,strsent,oMapiMessage.TimeReceived,introundtrip,"OK") end if ' RRD Datenbank aktualisieren ' Obergrenze fuer Grafik festlegen um skalierung nicht kaputt zu machen. if introundtrip > INTTIMEOUT then introundtrip = INTTIMEOUT updaterrd STRRRDDB,cdate(strSent),"roundtrip",introundtrip,blnglobalalert ' Last message Counter Updaten if oMapiMessage.TimeReceived > dtLastMessage then ' updating the last message marker objDebug.writeln " Cleanup:Updating last message marker",5 dtLastMessage = oMapiMessage.TimeReceived intlastroundtrip = introundtrip end if objDebug.writeln " Cleanup:Delete message",2 oMapiMessage.delete else ' Ignoring other messages objDebug.writeln " SKIP message:" & oMapiMessage.Subject,5 end if objDebug.writeln " --------------------------",2 Next ' Was there a Status Mail ? if dtLastMessage = 0 then strResult = strResult & vbcrlf & " ALERT keine Statusmail gefunden" strAlertSubject = "No Statusmail found" objDebug.writeln " ALERT keine Statusmail gefunden",5 blnglobalalert = true else if intlastroundtrip > INTTIMEOUT then ' Check last statusmail strResult = strResult & vbcrlf & " ALERT Letzte Statusmail am " & dtLastMessage & " Roundtrip " & intlastroundtrip & " > "& INTTIMEOUT objDebug.writeln " ALERT Letzte Statusmail am " & dtLastMessage & " Roundtrip " & intlastroundtrip & " > "& INTTIMEOUT,5 strAlertSubject = "Last Roundtrip:" & intlastroundtrip & " > Delta: " & INTTIMEOUT blnglobalalert = true end if if round((now - dtLastMessage)*86400) > (INTTIMEOUT + INTRRDINTERVAL) then ' letzte Mail ist schon sehr Alt objDebug.writeln " ALERT Letzte Statusmail am " & dtLastMessage & " > Delta: " & INTTIMEOUT + INTRRDINTERVAL ,2 strResult = strResult & vbcrlf & "ALERT Letzte Statusmail am " & dtLastMessage & " Older than Delta Age:" & INTTIMEOUT + INTRRDINTERVAL strAlertSubject = "Last Message very old" & dtLastMessage blnglobalalert = true else ' letzte Mail ist schon älter als DELTA Sekunden objDebug.writeln " OK Letzte Statusmail " & dtLastMessage & " < Delta",0 end if end if ' ----------------- Mail per CDO direkt senden Set oMapiMessage = oMapiMessages.add oMapiMessage.Subject = STRTOKEN1 & now () & STRTOKEN2 oMapiMessage.Text = "Heartbeat für MIRROR Testing" '~ oMapiMessage.Recipients.Add "Mirror","SMTP:" & strMirror oMapiMessage.Recipients.Add "Mirror", "SMTP:" & STRMIRROR oMapiMessage.Recipients.Resolve oMapiMessage.Update oMapiMessage.Send False ' keinen Dialog anzeigen if blnglobalalert then ' Sende Alarmmeldung objDebug.writeln " ALERTMAIL: Last Status = ALERT",2 Set oMapiMessage = oMapiMessages.add oMapiMessage.Subject = "End2End-SMTPflow-ALERT:" & strAlertSubject oMapiMessage.Text = "End2End-SMTPflow ist fehlgeschlagen" & strResult oMapiMessage.Recipients.Add "Mirror","SMTP:" & STRALERTMAIL oMapiMessage.Importance = 2 ' http://msdn.microsoft.com/library/en-us/cdo/html/5af697e2-6d98-4e4f-9d66-5d11d64c6730.asp oMapiMessage.Recipients.Resolve oMapiMessage.Update oMapiMessage.Send False ' keinen Dialog anzeigen end if set oMapiMessages = nothing end if objDebug.writeln "Logoff from Mailbox ", 0 oMapiSession.Logoff end if objDebug.writeln "Logoff complete, Releasing MAPI Session", 0 Set oMapiSession = Nothing objDebug.writeln "MAPI-Session released", 0 strResult = "OK" End If on error goto 0 end sub function UpdateRRD(strRRDFile, strRRDTimeStamp, strRRDparam, strRRDvalue, RRDstatus) '~ http://people.ee.ethz.ch/~oetiker/webtools/rrdtool/ '~ http://de.wikipedia.org/wiki/RRDtool '~ http://www.msxfaq.de/tools/rrdtool.htm '~ Parameters are in CONST RRDEXE, RRDDB, RRDPNG '~ RRDTool Timecounter uses Seconds since 1.1.1970 Windows "now()" uses days since 30.12.1899 dim objFSO, objWshShell, intresult , strCommandline, dblrrdtime Set objFSO = CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(STRRRDEXE) Then ' Skip RRD, if binary not found dblrrdtime = (cdbl(strRRDTimeStamp) - cdbl(cdate("1.1.1970"))) * 86400 Set objWshShell = CreateObject("WScript.Shell") If not objFSO.FileExists(strRRDFile) Then ' Create initial RRD Database strCommandline = STRRRDEXE & " create " & strRRDFile ' Pfad zur RRD Datei strCommandline = strCommandline & " -s " & INTRRDINTERVAL ' Step alle 10 Min ein Messwert annehmen strCommandline = strCommandline & " DS:" & strRRDparam & ":GAUGE:" & INTRRDINTERVAL*2 & ":0:U" 'Variable als GAUGE und "Ausfall-Zeit = 2* Intervall" strCommandline = strCommandline & " RRA:AVERAGE:0.5:1:" & 86400/INTRRDINTERVAL + 1 'RoundRobin: 24 Stunden Aufzeichnung strCommandline = strCommandline & " RRA:AVERAGE:0.5:7:" & 86400/INTRRDINTERVAL + 1 'RoundRobin: 7 Tage Aufzeichnung strCommandline = strCommandline & " RRA:AVERAGE:0.5:30:" & 86400/INTRRDINTERVAL + 1 'RoundRobin: 30 Tage Aufzeichnung objDebug.writeln "Create RRDDB:" ,4 objDebug.writeln "Create RRDDB:" & strCommandline ,7 intresult = objWshShell.run(strCommandline,7,true) ' wait für exit and start window minimized if intresult <> 0 then objDebug.writeln "Error Creating RRDDB:" & intresult,1 updateRRD = 1 end if end if ' Update Entries in existing Database strCommandline = STRRRDEXE & " Update " & strRRDFile & " " & dblrrdtime & ":" & strRRDValue objDebug.writeln "Update RRDDB:",4 objDebug.writeln "Update RRDDB:" & strCommandline ,7 intresult = objWshShell.run (strCommandline,7,true) if intresult <> 0 then objDebug.writeln "Error updating RRDDB:" & intresult , 1 if STRRRDBILD = "" then objDebug.writeln "RRDPNG not specified. Not creating RRDPNG" , 3 updateRRD = 2 else ' Create Pictures strCommandline = STRRRDEXE & " graph " & STRRRDBILD & "-day.png" strCommandline = strCommandline & " -t ""SMTP Roundtriptime""" ' Titleüberschrift strCommandline = strCommandline & " -v ""Sekunden""" ' Beschriftung Y-Achse strCommandline = strCommandline & " -s end-23h" ' Startzeit = Ende - 1 Tag strCommandline = strCommandline & " DEF:roundtrip="& strRRDFile &":roundtrip:AVERAGE" strCommandline = strCommandline & " LINE1:roundtrip#0000FF:""Roundtrip letzter Tag""" objDebug.writeln "Creating RRDPNG" ,4 objDebug.writeln "Creating RRDPNG" & strCommandline ,7 intresult = objWshShell.run(strCommandline,7,true) ' wait für exit and start window minimized if intresult <> 0 then objDebug.writeln "Error Creating RRDPNG:" & intresult, 1 updateRRD = 2 end if strCommandline = STRRRDEXE & " graph " & STRRRDBILD & "-week.png" strCommandline = strCommandline & " -t ""SMTP Roundtriptime""" ' Titleüberschrift strCommandline = strCommandline & " -v ""Sekunden""" ' Beschriftung Y-Achse strCommandline = strCommandline & " -s end-1w" ' Startzeit = Ende - 1 Woche strCommandline = strCommandline & " DEF:roundtrip="& strRRDFile &":roundtrip:AVERAGE" strCommandline = strCommandline & " LINE1:roundtrip#00FF00:""Roundtrip letzte Woche""" objDebug.writeln "Creating RRDPNG" ,4 objDebug.writeln "Creating RRDPNG" & strCommandline ,7 intresult = objWshShell.run(strCommandline,7,true) ' wait für exit and start window minimized if intresult <> 0 then objDebug.writeln "Error Creating RRDPNG:" & intresult, 1 updateRRD = 3 end if strCommandline = STRRRDEXE & " graph " & STRRRDBILD & "-month.png" strCommandline = strCommandline & " -t ""SMTP Roundtriptime""" ' Titleüberschrift strCommandline = strCommandline & " -v ""Sekunden""" ' Beschriftung Y-Achse strCommandline = strCommandline & " -s end-1m" ' Startzeit = Ende - 1 Monat strCommandline = strCommandline & " DEF:roundtrip="& strRRDFile &":roundtrip:AVERAGE" strCommandline = strCommandline & " LINE1:roundtrip#FF0000:""Roundtrip letzter Monat""" objDebug.writeln "Creating RRDPNG" ,4 objDebug.writeln "Creating RRDPNG" & strCommandline ,7 intresult = objWshShell.run(strCommandline,7,true) ' wait für exit and start window minimized if intresult <> 0 then objDebug.writeln "Error Creating RRDPNG:" & intresult,1 updateRRD = 4 end if 'Webpartgrafik 100x100, wird rot, wenn der letzte Test fehlgeschlagen ist zur NUtzung als SharepointWebpart. strCommandline = STRRRDEXE & " graph " & STRRRDBILD & "-webpart.png" strCommandline = strCommandline & " -t ""Mail-Laufzeit""" ' Titleüberschrift strCommandline = strCommandline & " -v ""Sekunden""" ' Beschriftung Y-Achse strCommandline = strCommandline & " -s end-5h" ' Startzeit = Ende - 1 Tag strCommandline = strCommandline & " -w 100" ' Breite in Pixel strCommandline = strCommandline & " -h 100" ' Höhe in Pixel if RRDstatus = true then strCommandline = strCommandline & " -c CANVAS#FF0000" ' Hintergrund Rot end if strCommandline = strCommandline & " DEF:roundtrip="& strRRDFile &":roundtrip:AVERAGE" strCommandline = strCommandline & " LINE1:roundtrip#0000FF:""letzten 6h""" objDebug.writeln "Creating RRDPNG" ,4 objDebug.writeln "Creating RRDPNG" & strCommandline ,7 intresult = objWshShell.run(strCommandline,7,true) ' wait für exit and start window minimized if intresult <> 0 then objDebug.writeln "Error Creating RRDPNG:" & intresult, 1 updateRRD = 5 end if end if Else updateRRD = 255 ' RRD Exe not found" End If end function ' ================================================== Auxilary procedures and classes ========================== function findGCPath objDebug.write "Looking für GC" dim oCont, oGC, strGCPath Set oCont = GetObject("GC:") For Each oGC In oCont findGCPath = oGC.ADsPath Next objDebug.writeln "strGCPath=" & strGCPath, 5 end function sub appendcsvfile(strcsvfilename,field1,field2,field3,field4,field5) 'appendcsvfile(filename,now,strsent,oMapiMessage.TimeReceived,introundtrip,"OK") dim objFSO, csvfile dim header Set objFSO = CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(strcsvfilename) Then Set csvfile = objFSO.OpenTextFile(strcsvfilename, 8, True) ' 2 = Forappending, create new Else ' create file Set csvfile = objFSO.OpenTextFile(strcsvfilename, 2, True) ' 2 = für Writing, create new csvfile.write "logdate,senttime,receivetime,delta,status" & vbcrlf End If csvfile.write """" & field1 & """,""" & field2 & """,""" & field3 & """,""" & field4 & """,""" & field5 & """"& vbcrlf csvfile.close end sub class debugwriter ' Generic Class für writing debugging information private objIE, file, fs, debugfilename, status, strline private debuglevelIE , debuglevelfile, debugleveleventlog, debuglevelConsole private Sub Class_Initialize status = "active" : strline = "" : debugfilename = "" debuglevelIE = -1 debuglevelfile = -1 debugleveleventlog = -1 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 strMessage = strline & strMessage if (status = "active") Then if (debuglevelfile >= intseverity) 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)) end if if debugleveleventlog >=intSeverity 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 >=intSeverity 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 >=intSeverity 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) 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 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 Sub abbruch(info,waittime) ' usage: call abbruch ("Script abbrechen" ,5) dim WshShell, result Set WshShell = CreateObject("WScript.Shell") result = WshShell.Popup("Continue script at position "& vbcrlf & info & vbcrlf & "Waiting "&waittime&" Seconds", waittime, "Stop Script", 33) 'OKCancel(1) + Question (32) If result = 2 Then WScript.echo "Abbruch durch Anwender (Exitcode = 255)" WScript.Quit(255) End If End Sub function makefilename(byVal 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 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
TimeintseverityDescription
" & now () & "Out0Err1Wrn2Inf3Dbg"&intseverity&"" & strmessage & "