Option Explicit '------------------------------------------------------------------------- ' pwexpire ' ' Beschreibung ' Prueft Objekte auf das Alter des Kennworts ' ' Laufzeitfehler werde nicht abgefangen und beenden das Skript. !!! ' ' Das Skript wird mit den Berechtigungen des angemeldeten Benutzers ' ausgeführt. Die entsprechenden Berechtigungen sind sicher zu stellen ' http://www.microsoft.com/technet/scriptcenter/scripts/ad/Users/pwds/uspwvb09.mspx ' http://www.paulsadowski.com/WSH/cdo.htm ' ' (c)2004 Net at Work Netzwerksysteme GmbH ' ' Version 1.0 (31. Aug 2005) Frank Carius ' Initial Release ' Version 1.1 (31. Aug 2005) Frank Carius ' - Mailversand per CDO ' Version 1.2 (12. Sep 2005) Frank Carius ' - Ausgabe des DN ' - Mailoption abschaltbar ' Version 1.3 (23. Sep 2005) Frank Carius ' - Erweiterte Pruefung, ob Mailadresse des Users ueberhaubt vorhanden ist. ' Version 1.4 (02. Nov 2005) Frank Carius ' - Abfangen von Trusts. ' - Reihenfolge ändern, dass Disabled für "Lockedout" ist, wenn beides zutrifft ' - Status wird mehrfach ausgegeben und im XSLT angezeigt ' Version 1.5 (13. Nov 2005) Frank Carius ' Verbesserte "Kennwortalterberechnung ' Version 1.6 (25. Nov 2005) Frank Carius ' XSL Sort nach Age ' Abfangen Beschränkung auf echte User. Ueberspringen von Trustkonten etc ' Version 1.7 (24. Jan 2006) Frank Carius ' Sonderzeichenbehandlung beim DN ' Exportiert ALLE Konten, d.h. auch Computer. Filterung kann per Stylesheet erfolgen ' Version 1.8 (19. Okt 2007) Frank Carius ' XML Farbencoding korrigiert ' Alter < WARN1 (60) = Grüne ' WARN1 < Alter < WARN2 = Gelb ' WARND2 ;(|(&(objectClass=User)(objectCategory=person))(objectClass=computer));distinguishedName,name,mail,pwdLastSet,UserAccountControl,sAMAccountType;subtree" Set oRecordset = oCommand.Execute objDebug.writeln "Done Total Records found:" & oRecordset.recordcount, 0 call xmlWriter.WriteElementString("starttime2", now()) total = 0 : totalwarn1 = 0 : totalwarn2 = 0 : totalok = 0 do until oRecordset.EOF objDebug.writeln "Object:" & total & "/" & oRecordset.recordcount &":" & left(oRecordset.Fields("distinguishedName"),20)&".." ,3 total = total + 1 set oUser = GetObject ("LDAP://" & replace(oRecordset.Fields("distinguishedName"),"/","\/")) intUserAccountControl = oUser.Get("UserAccountControl") blnSkipUser = false '~ if (intUserAccountControl and ADS_UF_NORMAL_ACCOUNT) then call xmlWriter.WriteStartElement("object") call xmlWriter.WriteElementString("name", oRecordset.Fields("name")) call xmlWriter.WriteElementString("dn", oRecordset.Fields("distinguishedname")) objTrans.Set ADS_NAME_TYPE_1779, oRecordset.Fields("distinguishedname") ' use the Set method to specify the RPC 1779 format of the object name. strNTName = objTrans.Get(ADS_NAME_TYPE_NT4) ' use the Get method to retrieve the NT Name. call xmlWriter.WriteElementString("nt4domain", Mid(strNTName, 1, InStr(strNTName, "\") - 1)) call xmlWriter.WriteElementString("nt4User", Mid(strNTName, InStr(strNTName, "\") + 1)) if not isnull(oRecordset.Fields("mail")) then call xmlWriter.WriteElementString("mail", oRecordset.Fields("mail")) if oRecordset.Fields("samAccountType") = SAM_NORMAL_User_ACCOUNT then call xmlWriter.WriteElementString("type", "User") elseif oRecordset.Fields("samAccountType") = SAM_MACHINE_ACCOUNT then call xmlWriter.WriteElementString("type", "computer") else call xmlWriter.WriteElementString("type", oRecordset.Fields("samAccountType")) end if on error resume next dtmValue = oUser.PasswordLastChanged if err.number = 0 then intpwage = clng(now) - clng(dtmValue) ' convert delta into days if err.number <> 0 then objDebug.writeln " PasswordError:" & err.number,1 intpwage = -1 'Error calculating password age end if err.clear on error goto 0 objDebug.writeln " Passwordage:" & intpwage, 4 call xmlWriter.WriteElementString("age", intpwage ) if intUserAccountControl and ADS_UF_ACCOUNTDISABLE Then objDebug.writeln " Passwordage: DISABLED", 4 call xmlWriter.WriteElementString("status", "DISABLED") blnSkipUser = true end if if intUserAccountControl and ADS_UF_LOCKOUT Then objDebug.writeln " Passwordage: LOCKOUT", 4 call xmlWriter.WriteElementString("status", "LOCKOUT") blnSkipUser = true end if if intUserAccountControl and ADS_UF_DONT_EXPIRE_PASSWD Then objDebug.writeln " Passwordage: Never Exire", 4 call xmlWriter.WriteElementString("status", "NEVER") blnSkipUser = true end if if intUserAccountControl and ADS_UF_PASSWORD_EXPIRED Then objDebug.writeln " Passwordage: Expired", 4 call xmlWriter.WriteElementString("status", "EXPIRED") blnSkipUser = true end if if intUserAccountControl and ADS_UF_PASSWD_CANT_CHANGE Then objDebug.writeln " Passwordage: CANTCHANGE", 4 call xmlWriter.WriteElementString("status", "CANTCHANGE") blnSkipUser = true end if if intUserAccountControl and ADS_UF_PASSWD_NOTREQD Then objDebug.writeln " Passwordage: NOTREQD", 4 call xmlWriter.WriteElementString("status", "NOTREQD") blnSkipUser = true end if if blnSkipUser then call xmlWriter.WriteElementString("action", "none") else ' User ist nicht irgendwie deaktiviert, ausgesperrt o.ä. if intpwage = -1 then objDebug.writeln " Status: PWAgeError", 4 call xmlWriter.WriteElementString("status", "PWAge Error") call xmlWriter.WriteElementString("action", "none") totalok = totalok + 1 elseif intpwage < CON_WARN1 then objDebug.writeln " Status: OK", 4 call xmlWriter.WriteElementString("status", "OK") call xmlWriter.WriteElementString("action", "none") totalok = totalok + 1 elseif intpwage < CON_WARN2 then objDebug.writeln " Status: WARN1", 4 call xmlWriter.WriteElementString("status", "WARN1") totalwarn1 = totalwarn1 +1 if enablemail and (isobject(oUser.mail)) Then if oSMTPTest.Test(oUser.mail) then objDebug.writeln " Send Mail1 to:" & oUser.mail, 4 call xmlWriter.WriteElementString("action", "Mail1") Set objMessage = CreateObject("CDO.Message") objMessage.Subject = "Password expiration information" objMessage.Sender = CON_AdministratorenMTP objMessage.To = oUser.Mail objMessage.TextBody = "Your password will expire in " & CON_WARN1 - intpwage &" days" objMessage.Send set objMessage = nothing else call xmlWriter.WriteElementString("action", "InvalidMail") objDebug.writeln " Invalid Mailaddress" , 2 end if else objDebug.writeln " Missing Mailaddress" , 2 call xmlWriter.WriteElementString("action", "noMail") end if else objDebug.writeln " Status: WARN2", 4 call xmlWriter.WriteElementString("status", "WARN2") totalwarn2 = totalwarn2 + 1 if enablemail and (isobject(oUser.mail)) Then if oSMTPTest.Test(oUser.mail) then objDebug.writeln " Send Mail2 to:" & oUser.mail, 4 call xmlWriter.WriteElementString("action", "Mail1") Set objMessage = CreateObject("CDO.Message") objMessage.Subject = "Important password expiration warning !" objMessage.Sender = CON_AdministratorenMTP objMessage.To = oUser.Mail objMessage.TextBody = "Your password will expire in " & CON_WARN2 - intpwage &" days" objMessage.Send set objMessage = nothing objDebug.writeln " Send Mail2 to:" & CON_AdministratorenMTP , 4 Set objMessage = CreateObject("CDO.Message") objMessage.Subject = "User:" & oUser.name & " - Password age :" & intpwage objMessage.Sender = CON_AdministratorenMTP objMessage.To = CON_AdministratorenMTP objMessage.TextBody = "Passwort age is over limit 2" & _ "Details:" &_ "Age :" & intpwage &_ "UserDN:" & oUser.distinguishedname &_ "Name :" & oUser.name objMessage.Send set objMessage = nothing else call xmlWriter.WriteElementString("action", "InvalidMail") objDebug.writeln " Invalid Mailaddress" , 2 end if else objDebug.writeln " Missing Mailaddress" , 2 call xmlWriter.WriteElementString("action", "noMail") end if end if end if else ' Errorreading passwordLastChanged. I assume User must set it during next logon objDebug.writeln " Passwordage:FIRST", 4 call xmlWriter.WriteElementString("age", "FIRST") ' must change password call xmlWriter.WriteElementString("status", "FIRST") ' must change password call xmlWriter.WriteElementString("action", "none") end if ' else ' objDebug.writeln " Passwordage: uNKNOWN" & intUserAccountControl, 4 ' call xmlWriter.WriteElementString("status", "UNKNOWN " & intUserAccountControl) ' call xmlWriter.WriteElementString("action", "none") '~ end if call xmlWriter.WriteEndElement() ' of ("object") oRecordset.MoveNext loop call xmlWriter.WriteElementString("total", total) objDebug.writeln "Total objects checked:" & total, 0 call xmlWriter.WriteElementString("totalok", totalok) objDebug.writeln "Total objects with ok:" & totalok, 0 call xmlWriter.WriteElementString("totalwarn1", totalwarn1) objDebug.writeln "Total objects with warn1:" & totalwarn1, 0 call xmlWriter.WriteElementString("totalwarn2", totalwarn2) objDebug.writeln "Total objects with warn2:" & totalwarn2, 0 call xmlWriter.WriteElementString("endtime", now()) call xmlWriter.WriteEndElement() ' of ("pwexpire") call xmlWriter.Close ' XML schreiben WScript.quit(0) sub writexslt(strfilename) dim txtxsl txtxsl = _ " " & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ "pwexpire Status" & vbcrlf & _ "" & vbcrlf & _ "

pwexpire Status

" & vbcrlf & _ "

Summary

" & vbcrlf & _ " " & vbcrlf & _ "" & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ "
Starttime
Start Verarbeitung
EndTime
# Objects
# OK
# Warn1
# Warn2
" & vbcrlf & _ "
" & vbcrlf & _ "

Details

" & vbcrlf & _ "" & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ "" & vbcrlf & _ "
name:dn:nt4domain:nt4User:age:status:action:
" & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ "
" & vbcrlf & _ "
" & vbcrlf & _ " " & vbcrlf & _ "
" & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ "
" & vbcrlf & _ "
" Const ForWriting = 2 dim fs, file Set fs = CreateObject("Scripting.FileSystemObject") Set file = fs.OpenTextFile(strfilename, ForWriting, True) file.writeline Convert2Text(txtxsl) file.Close end sub ' ================================================== Auxilary procedures and classes ========================== class XMLTextWriter '~ usage in VBScript. Please define StyleSheet and filename first and than start writing the data '~ set xmlWriter = new XmlTextWriter '~ xmlWriter.filename = "filename.xml" '~ xmlWriter.Indentation = 4 '~ call xmlWriter.WriteStylesheet("stylesheet.xsl") '~ call xmlWriter.WriteStartElement("Root") '~ call xmlWriter.WriteElementString("starttime", now()) '~ call xmlWriter.WriteEndElement '~ call xmlWriter.close dim intIndentation dim level, tagopen dim Stack(100) ' i have problems using redim, so i use a fixed number für the depth dim fs, xmlfile private Sub Class_Initialize intIndentation = 4 level = 0 tagopen = false End Sub public Property let filename(wert) Set fs = CreateObject("Scripting.FileSystemObject") Set xmlfile = fs.OpenTextFile(wert, 2, True) ' 2 = ForWriting xmlfile.write "" & vbcrlf End Property public Property let Indentation(wert) intIndentation = wert End Property sub Writestylesheet (item) '* xmlfile.write "" & vbcrlf end sub sub WriteStartElement(item) xmlfile.write vbcrlf & space(intIndentation*level) & "<" & quote(trim(item)) ' & ">" ' Ende offen tagopen = true stack(level) = item level = level + 1 end sub sub WriteAttributeString(item,wert) ' ergänzt eine ID zum aktuellen Element if tagopen then xmlfile.write " id=""" & Quote(wert) & """" else wscript.echo "XMLWriter: Tag not open" wscript.quit(255) end if end sub sub WriteElementString(item,wert) ' wert if tagopen then xmlfile.write ">" : tagopen = false end if xmlfile.write vbcrlf & space(intIndentation*level) xmlfile.write "<" & quote(trim(item)) & ">" xmlfile.write quote(wert) xmlfile.write "" end sub sub WriteEndElement if tagopen then xmlfile.write ">" : tagopen = false end if level = level - 1 xmlfile.write vbcrlf & space(intIndentation*level) & "" end sub private function quote(wert) ' 308060 HOW TO: Locate and Replace Special Characters in an XML File with Visual Basic .NET ' 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 inttest = ascw(mid(wert,loopcount,1)) if ((inttest>=32) and (inttest<127)) or (inttest=10) or (inttest=13) or (inttest=9) then tempwert = tempwert & chr(inttest) ' printable Character or CR LF TAB else tempwert = tempwert & "X" end if next if len (tempwert ) > 0 then tempwert=replace(tempwert ,"&","&") tempwert=replace(tempwert ,"<","<") tempwert=replace(tempwert ,">",">") tempwert=replace(tempwert ,"""",""") tempwert=replace(tempwert ,"'","'") end if quote=tempwert end function sub close() : xmlfile.Close : end sub end class 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 Class ValidSMTP ' Generic Class to validate an given SMTP-Address against formal rules (not a real NSLookup etc) dim SMTPRegEx private Sub Class_Initialize Set SMTPregEx = New RegExp ' von http://www.twilightsoul.com/Default.aspx?tabid=134 '~ SMTPregEx.Pattern = "^((([\t\x20]*[!#-'\*\+\-/-9=\?A-Z\^-~]+[\t\x20]*|" _ '~ & """[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F]*"")+"_ '~ & ")?[\t\x20]*<([\t\x20]*[!#-'\*\+\-/-9=\?A-Z\^-~]+"_ '~ & "(\.[!#-'\*\+\-/-9=\?A-Z\^-~]+)*|""[\x01-\x09\x0B\x0C"_ '~ & "\x0E-\x21\x23-\x5B\x5D-\x7F]*"")@(([a-zA-Z0-9][-a-zA-Z0-9]*"_ '~ & "[a-zA-Z0-9]\.)+[a-zA-Z]{2,}|\[(([0-9]?[0-9]|1[0-9][0-9]|"_ '~ & "2[0-4][0-9]|25[0-5])\.){3}([0-9]?[0-9]|1[0-9][0-9]|"_ '~ & "2[0-4][0-9]|25[0-5])\])>[\t\x20]*|([\t\x20]*"_ '~ & "[!#-'\*\+\-/-9=\?A-Z\^-~]+(\.[!#-'\*\+\-/-9=\?A-Z\^-~]+)*|"_ '~ & """[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F]*"")@"_ '~ & "(([a-zA-Z0-9][-a-zA-Z0-9]*[a-zA-Z0-9]\.)+[a-zA-Z]{2,}|"_ '~ & "\[(([0-9]?[0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])\.){3}"_ '~ & "([0-9]?[0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])\]))$" ' von http://www.twilightsoul.com/Default.aspx?PageContentID=10&tabid=134 SMTPregEx.Pattern = "([\t\x20]*[!#-'\*\+\-/-9=\?A-Z\^-~]+"_ &"(\.[!#-'\*\+\-/-9=\?A-Z\^-~]+)*|""[\x01-\x09\x0B\x0C"_ &"\x0E-\x21\x23-\x5B\x5D-\x7F]*"")@(([a-zA-Z0-9][-a-zA-Z0-9]*"_ &"[a-zA-Z0-9]\.)+[a-zA-Z]{2,}|\[(([0-9]?[0-9]|1[0-9][0-9]|"_ &"2[0-4][0-9]|25[0-5])\.){3}([0-9]?[0-9]|1[0-9][0-9]|"_ &"2[0-4][0-9]|25[0-5])\])" SMTPregEx.IgnoreCase = true End Sub private Sub Class_Terminate() : Set SMTPregEx = nothing : End Sub function Test(wert) test = SMTPregEx.test(wert) ' Test is true if Match is found 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 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 '~ inttest = ascw(mid(wert,loopcount,1)) '~ if ((inttest>=32) and (inttest<127)) or (inttest=10) or (inttest=13) or (inttest=9) then '~ tempwert = tempwert & chr(inttest) ' printable Character or CR LF TAB '~ else '~ tempwert = tempwert & "X" '~ end if tempwert = tempwert & chr(ascb(mid(wert,loopcount,1))) next Convert2Text = tempwert end function 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
TimeintseverityDescription
" & now () & "Out0Err1Wrn2Inf3Dbg"&intseverity&"" & strmessage & "