Option Explicit '------------------------------------------------------------------------- ' CheckEXObjects ' ' Beschreibung ' Prueft Objekte im AD, ob diese "richtig" mailaktiviert sind ' ' 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 ' 275636 Creating Exchange mailbox-enabled and mail-enabled objects in Active Directory ' ' (c)2004 Net at Work Netzwerksysteme GmbH ' ' Version 1.0 (24. Juni 2004) Frank Carius ' Version 1.1 (25. Juni 2004) Frank Carius ' Rekursion nicht OK. ' Version 1.2 (25. Juni 2004) Frank Carius ' Nur Benutzer ohne $ (Ausschluss der Computer) ' Version 1.3 (06. Juli 2004) Frank Carius ' Displayname ist nicht mehr Kriterium für "mailenabled" ' Version 1.4 (15. Sep 2004) Frank Carius ' Prüfung auf MAIL und proxy addresses, wenn Object mailenabled ist ' Version 1.5 (15. Sep 2004) Frank Carius ' Kommandozeile für OU-Spezifikation, Bessere Debugausgabe, Errorlevel ' Version 1.6 (15. Sep 2004) ' Erweiterte Ausgabe mittels ERRString ' Version 1.7 ( 16 Sep 2004) ' Deaktivierte User mit MSExchMasterAccountSID prüfen ' Gefundene Felder für Mailaktiv werden mit gedruckt ' Version 1.8 ( 16 Sep 2004) ' Group: HomeMTA und ExpansionServer sind nicht zwingend ' Einfügen von Critical und Warning ' Version 1.9 ( 05 Mrz 2005) ' Warnung bei LegacyExchangeDN Länger 64 Zeichen ' Version 2.0 ( 28 Jul 2005) ' Umstellung auf XML-Ausgabe ' LDAP Searcher statt rekursion ' Test auf DN >64 Zeichen sonst OAB Probleme ' Version 2.1 ( 08 Aug 2005) ' XML sofort schreiben ' Test in eigene Funktion zusammengefasst ' unmergedAtts ergänzt ' Version 2.2 ( 11 Aug 2005) ' Exchange QueryBased DN erweitert ' Contakt + TargetAddress ' Sonderbehandlung fuer UNICODE etc ' Version 2.3 ( 11 Aug 2005) ' RegEx fuer SMTP-Pruefung ' Version 2.3 ( 11 Aug 2005) ' RegEx fuer SMTP-Pruefung ' Version 2.4 ( 25 Aug 2005) ' Lowercase fehler im XSLT, Convert2Txt kleiner, neuer debugWriter ' Version 2.5 ( 13 Sep 2005) ' LegacyExchangeDN prüfung auf Start mit /o= oder ADCDisabledMail bzw ADCDisabledMailByADC ' Version 2.6 ( 22 Sep 2005) ' Ausgaben verbessert ' Version 2.7 ( 24. Okt 2005) ' Targetadress ausgabe addiert, Ausgabe DisabledAccount = masteraccountsid erweitert ' Targetaddress von Error auf Warnung runtergestuft, wenn kein SMTP z.B. FAX etc ' Version 2.8 ( 12. Nov 2005) ' Mailaktivierte Benutzer (also "Kontakte mit SID") wurden nicht richtig erkannt ' Test auf expf:PARTNER800005B011D0C13511D292DEBA8A632905D1F6 bei PublicFolder ' Version 3.0 ( 02. Mrz 2006) ' Filter auf Asugaben möglich ERROR/WARN/OK/UNKNOWN ' umbau auf xmlwriter2.Klasse mit MSXML ' weitere Debugausgaben ' Version 3.1 ( 04. Mrz 2006) ' Erweiterung XMLWriter um Abfangen von "NULL" ' Version 3.2 ( 04. Mrz 2006) ' Erweiterung Ausgabe des Exchange Schemas und Anpassen des LDAP-Stringt ' Version 3.3 ( 28. Jul 2006) ' TargetAddress kann auch ungleich SMTP: sein, z.B. Notes etc ' Version 3.4 ( 24. Okt 2007) ' E2K7 Check: Alias (MailNickName) enthält "leerzeichen" als ERROR ' MailNickname muss leer sein bei Mail disabled objects ' Auflisstung der Anzahl "Kontakte, User, PubFolder ' Korrekturen im Test wenn ein Array kommt ' Version 3.5 ( 06. Dec 2007) ' Prüfung der "mail" adresse in "MAIL". darf kein "SMTP:" enthalten ' Version 3.6 ( 08 Feb 2008) ' isnotmail um "CCMAIL" erweitert ' Geplant ' E2K7 Check: RUS Abweichungen ' Besserer RegEx für X.400 ' Suche nach doppelten Adressen ' Alias und Displayname OK für E2007 '------------------------------------------------------------------------- const OUTPUTSELECTION = "ERROR WARN uNKNOWN" ' Mögliche Einträge: ERROR WARN OK 'const OUTPUTSELECTION = "ERROR WARN OK" Dim totalerr, totalwarn, total, totalunknown, totalok, result, xmlwriter, strGCPath Dim totalmbUser, totalmailUser, totalcontact, totalpf, totalgroup, totalqbdg Dim oConnection, oCommand, oRecordset Dim strTemp, strQuery, lngpage, strProxyAddresses, strObjectClass, strOutFilePrefix Dim counter, strOrgmode, objOrgmode dim xmlDom, xmlroot, xmlChild dim oMailTest Set oMailTest = New ValidMail strOutFilePrefix = makefilename("checkexobjects-" & Date() & "-" & Time()) ' Pfad und Dateiname der Log-Datei dim objDebug set objdebug = new DebugWriter objDebug.target = "file:6 console:3" ' errorlogging 0=only output, 1=Error 2=Warning 3=information 5++ =debug objDebug.outFile = strOutFilePrefix &".log" objDebug.start call ForceCScript ' must be rund with CSCRIPT '~ call abbruch ("Script fortsetzen ?" ,5) ' Last question to stop objDebug.writeln "checkEXObjects: gestartet", 0 set xmlWriter = new XmlTextWriter call writexslt("checkEXObjects.xsl") ' Stylesheet schreiben xmlWriter.filename = strOutFilePrefix & ".xml" xmlWriter.Indentation = 4 call xmlWriter.WriteStylesheet("checkEXObjects.xsl") call xmlWriter.WriteStartElement("checkexobjects") call xmlWriter.WriteElementString("starttime", now()) objDebug.write "Checking Organization "& ExchangeOrg("name") & " für Mixed AGs" if ExchangeOrg("mixed") then objDebug.writeln "Mixed - ADCCheck enabled",0 strOrgmode="mixed" else objDebug.writeln "Native - no ADCCheck",0 strOrgmode="native" end if call xmlWriter.WriteElementString("orgmode", strOrgmode) objDebug.write "Looking für GC" dim oCont, oGC Set oCont = GetObject("GC:") For Each oGC In oCont strGCPath = oGC.ADsPath Next objDebug.writeln "strGCPath=" & strGCPath, 3 dim objRootDSE, strConfigurationNC, objschema,intSchema Set objRootDSE = GetObject("LDAP://RootDSE") strConfigurationNC = objRootDSE.Get("ConfigurationNamingContext") wscript.echo strConfigurationNC set objschema = Getobject("LDAP://CN=ms-Exch-Schema-Version-Pt,cn=Schema," & strConfigurationNC) intschema = objschema.Get("RangeUpper") objDebug.writeln "Exchange Schema Version=" & intschema, 3 call xmlWriter.WriteElementString("exschema", intschema) select case intschema case 4397 call xmlWriter.WriteElementString("exschemastr", "Exchange 2000") case 6870 call xmlWriter.WriteElementString("exschemastr", "Exchange 2003") case else call xmlWriter.WriteElementString("exschemastr", "unknown:"& objschema.Get("RangeUpper")) end select objDebug.write "Querying AD für Objects" & strGCPath Set oConnection = CreateObject("ADODB.Connection") Set oRecordset = CreateObject("ADODB.Recordset") Set oCommand = CreateObject("ADODB.Command") oConnection.Provider = "ADsDSOObject" 'The ADSI OLE-DB provider oConnection.Open "ADs Provider" oCommand.ActiveConnection = oConnection oCommand.Properties("Page Size") = 100 'oCommand.Properties("searchscope") = 2 'ADS_SCOPE_SUBTREE 'oCommand.Properties("Timeout") = 15 'oCommand.Properties("Size Limit") = 0 'oCommand.Properties("Sort On") = "Name" 'oCommand.Properties("Cache Results") = False ' wenn man das aktiv macht, dann hat man nur die Summen !! 'oCommand.Filter = "(objectCategory=group)" ' Computer sind (&(objectCategory=computer)(objectClass=User)) 'oCommand.CommandText = "<" & strGCPath & "/OU=Groups,DC=msxfaq,DC=de>;" & _ if intschema < 6879 then oCommand.CommandText = "<" & strGCPath & ">;" & _ "(|" & _ "(&(objectClass=User)(objectCategory=person))"& _ "(objectClass=contact)"& _ "(objectClass=group)"& _ "(objectClass=publicFolder)"& _ ");" & _ "distinguishedName,name,ObjectClass,LegacyExchangeDN,msExchADCGlobalNames," & _ "displayName,msExchHideFromAddressLists,hideDLMembership,msexchmasteraccountsid," & _ "msExchALObjectVersion,showInAddressBook,msExchPolicyEnabled,givenName,sn,cn,mailNickname,targetAddress,proxyAddresses," & _ "mail,textEncodedORAddress,msExchHomeServerName,msExchExpansionServerName,msExchPoliciesIncluded," & _ "msExchPoliciesExcluded,homeMDB,homeMTA,msExchMailboxGuid,unmergedAtts," & _ "msExchMailboxSecurityDescriptor,msExchResourceGUID,UserAccountControl,msExchUserAccountControl" & _ ";subtree" else oCommand.CommandText = "<" & strGCPath & ">;" & _ "(|" & _ "(&(objectClass=User)(objectCategory=person))"& _ "(objectClass=contact)"& _ "(objectClass=group)"& _ "(objectClass=publicFolder)"& _ "(objectClass=msExchDynamicDistributionList)"& _ ");" & _ "distinguishedName,name,ObjectClass,LegacyExchangeDN,msExchADCGlobalNames," & _ "displayName,msExchHideFromAddressLists,hideDLMembership,msexchmasteraccountsid," & _ "msExchALObjectVersion,showInAddressBook,msExchPolicyEnabled,givenName,sn,cn,mailNickname,targetAddress,proxyAddresses," & _ "mail,textEncodedORAddress,msExchHomeServerName,msExchExpansionServerName,msExchCustomProxyAddresses,msExchPoliciesIncluded," & _ "msExchPoliciesExcluded,homeMDB,homeMTA,msExchMailboxGuid,unmergedAtts,msExchDynamicDLFilter,msExchPurportedSearchUI," & _ "msExchMailboxSecurityDescriptor,msExchResourceGUID,UserAccountControl,msExchUserAccountControl" & _ ";subtree" end if Set oRecordset = oCommand.Execute objDebug.writeln "Done Total Records found:" & oRecordset.recordcount, 0 call xmlWriter.WriteElementString("starttime2", now()) total = 0 : totalerr = 0 : totalwarn = 0 : totalok = 0 : totalunknown = 0 totalmbUser = 0 : totalmailUser = 0 : totalcontact = 0 : totalpf = 0 : totalgroup = 0 : totalqbdg = 0 do until oRecordset.EOF objDebug.write "Object:" & total & "/" & oRecordset.recordcount &":" & left(oRecordset.Fields("distinguishedName"),20)&".." strObjectClass = lcase(join(oRecordset.Fields("ObjectClass"),",")) if instr(strObjectClass,"computer")<>0 then objDebug.writeln "Skip. Is Computer", 0 else total = total + 1 call xmlWriter.WriteStartElement("object") call xmlWriter.WriteElementString("name", oRecordset.Fields("name")) if instr(1,strObjectClass,"User",vbTextCompare)<>0 then objDebug.writeln "Is User", 0 call xmlWriter.WriteElementString("type", "User") result = processUser(oRecordset) elseif instr(1,strObjectClass,"contact",vbTextCompare)<>0 then objDebug.writeln "Is Contact", 0 call xmlWriter.WriteElementString("type", "contact") result = processcontact(oRecordset) elseif instr(1,strObjectClass,"group",vbTextCompare)<>0 then objDebug.writeln "Is Group", 0 call xmlWriter.WriteElementString("type", "group") result = processgroup(oRecordset) elseif instr(1,strObjectClass,"publicfolder",vbTextCompare)<>0 then objDebug.writeln "Is PublicFolder", 0 call xmlWriter.WriteElementString("type", "publicfolder") result = processPF(oRecordset) elseif instr(1,strObjectClass,"msExchDynamicDistributionList",vbTextCompare)<>0 then objDebug.writeln "Is msExchDynamicDistributionList", 0 call xmlWriter.WriteElementString("type", "msExchDynamicDistributionList") result = processQBDG(oRecordset) else objDebug.writeln "Unknown Class:" & strObjectClass, 0 call xmlWriter.WriteElementString("type", "Unknown:" & strObjectClass) result = "critical" end if select case lcase(result) case "critical" objdebug.writeln " = DEFEKTER EINTRAG:" & oRecordset.Fields("distinguishedName"),4 call xmlWriter.WriteElementString("status", "ERROR") if instr(lcase(OUTPUTSELECTION),"error") = 0 then call xmlWriter.DeleteEndElement ' of ("object") else call xmlWriter.WriteEndElement ' of ("object") end if totalerr = totalerr + 1 case "warning" objdebug.writeln " = Warning EINTRAG:" & oRecordset.Fields("distinguishedName"),4 call xmlWriter.WriteElementString("status", "WARN") if instr(lcase(OUTPUTSELECTION),"warn") = 0 then call xmlWriter.DeleteEndElement ' of ("object") else call xmlWriter.WriteEndElement ' of ("object") end if totalwarn = totalwarn + 1 case "ok" objdebug.writeln " = OK EINTRAG:" & oRecordset.Fields("distinguishedName"),4 call xmlWriter.WriteElementString("status", "OK") if instr(lcase(OUTPUTSELECTION),"ok") = 0 then call xmlWriter.DeleteEndElement ' of ("object") else call xmlWriter.WriteEndElement ' of ("object") end if totalok = totalok + 1 case else objdebug.writeln " = uNKNOWN EINTRAG:" & oRecordset.Fields("distinguishedName"),4 call xmlWriter.WriteElementString("status", "UNKNOWN") if instr(lcase(OUTPUTSELECTION),"unknown") = 0 then call xmlWriter.DeleteEndElement ' of ("object") else call xmlWriter.WriteEndElement ' of ("object") end if totalunknown = totalunknown + 1 End select end if oRecordset.MoveNext loop call xmlWriter.WriteElementString("total", total) objDebug.writeln "Total objects checked:" & total, 0 call xmlWriter.WriteElementString("totalok", totalok) objDebug.writeln "Total objects OK:" & totalok, 0 call xmlWriter.WriteElementString("totalwarn", totalwarn) objDebug.writeln "Total objects with warning:" & totalwarn, 0 call xmlWriter.WriteElementString("totalerr", totalerr) objDebug.writeln "Total objects with error:" & totalerr, 0 call xmlWriter.WriteElementString("totalunknown", totalunknown) objDebug.writeln "Total objects unknown:" & totalunknown, 0 call xmlWriter.WriteElementString("totalmbUser", totalmbUser) objDebug.writeln "Total objects totalmbUser:" & totalmbUser, 0 call xmlWriter.WriteElementString("totalmailUser",totalmailUser ) objDebug.writeln "Total objects totalmailUser:" & totalmailUser, 0 call xmlWriter.WriteElementString("totalcontact", totalcontact) objDebug.writeln "Total objects totalcontact:" & totalcontact, 0 call xmlWriter.WriteElementString("totalpf",totalpf ) objDebug.writeln "Total objects totalpf:" &totalpf , 0 call xmlWriter.WriteElementString("totalgroup", totalgroup) objDebug.writeln "Total objects totalgroup:" & totalgroup, 0 call xmlWriter.WriteElementString("totalqbdg", totalqbdg) objDebug.writeln "Total objects totalqbdg:" & totalqbdg, 0 call xmlWriter.WriteElementString("endtime", now()) call xmlWriter.WriteEndElement() ' of ("checkexobjects") call xmlWriter.Close ' XML schreiben If totalerr <> 0 Then objDebug.writeln "Objects with error EXITCODE 1", 0 WScript.quit(1) End If function testattribute(objtest, attribute, test) dim value ' attribute = attribute to test ' test = test to perform: ismail isDN isempty len64 testattribute = false attribute = lcase(attribute) objDebug.writeln "TestAttribute: Attribut" & attribute &"-"& test & " vartype" & vartype(objtest.Fields(attribute)),5 value = objtest.Fields(attribute) '~ objDebug.writeln "TestAttribute: Wert" & value,5 if isarray(value) then objdebug.writeln "TestAttribute: value is Array, cant evaluate",2 else select case lcase(test) case "isempty" If value = "" Then objDebug.writeln "true",5 call xmlWriter.WriteElementString(attribute, "Empty") testattribute = true End If case "isnotempty" If value <> "" Then objdebug.writeln " contains " & objtest.Fields(attribute),5 call xmlWriter.WriteElementString(attribute, "contains " & objtest.Fields(attribute)) testattribute = true End If case "isnull" If isnull(value) Then objDebug.writeln "true",5 call xmlWriter.WriteElementString(attribute, "isNull") testattribute = true End If case "isnotnull" If not isnull(value ) Then objDebug.writeln "true",5 call xmlWriter.WriteElementString(attribute, "Contains Data") testattribute = true End If case "isnotmail" if isnull(value) then objdebug.writeln attribute & "Empty:"& objtest.Fields(attribute),5 call xmlWriter.WriteElementString(attribute, "Empty Mail Address:" & objtest.Fields(attribute)) testattribute = true else If not oMailTest.SMTP(value) and _ not oMailTest.NOTES(value)and _ not oMailTest.MSMAIL(value)and _ not oMailTest.GWISE(value)and _ not oMailTest.CCMAIL(value)and _ not oMailTest.X400(value) Then objdebug.writeln attribute & "Invalid:"& value ,5 call xmlWriter.WriteElementString(attribute, "Invalid Mail Address:" & value) testattribute = true end if End If case "isnotsmtp" if isnull(value) then objdebug.writeln attribute & "Empty:"& objtest.Fields(attribute),5 call xmlWriter.WriteElementString(attribute, "Empty Mail Address:" & objtest.Fields(attribute)) testattribute = true else If not oMailTest.SMTPRaw(value) then objdebug.writeln attribute & "Invalid:"& value ,5 call xmlWriter.WriteElementString(attribute, "Invalid SMTP Address:" & value) testattribute = true end if End If case "isDN" Set regEx = New RegExp regEx.Pattern = "^(((CN)|(DC)|(OU))=[a-z]){1}$" ' REG ist noch nicht komplett !!!!! regex.IgnoreCase = true ' ignore case If regEx.Test(value ) Then objdebug.writeln attribute & " is empty !",5 call xmlWriter.WriteElementString(attribute, "DNMissing") End If testattribute = true case "dnlen64" If instr(replace(value ,"\,","#"),",1")>64 Then 'erstes Komma objdebug.writeln "DNOver64Char!",5 call xmlWriter.WriteElementString(attribute, "DNOver64Char") testattribute = true End If case "legacyexchangedn" If lcase(left(value,3)) <> "/o=" then ' objdebug.writeln "LegacyDN not starting with /o=",5 call xmlWriter.WriteElementString(attribute, "legacyexchangedn missing /o=") testattribute = true End If case "nolegacyexchangedn" If (len(value ) = 0) _ or (value ="ADCDisabledMailByADC") _ or (value ="ADCDisabledMail") then objdebug.writeln "LegacyDN not empty: "& objtest.Fields(attribute),5 call xmlWriter.WriteElementString(attribute, "not empty:"& objtest.Fields(attribute)) testattribute = true End If case "containspace" If instr(value ," ")<>0 Then objDebug.writeln "true",5 call xmlWriter.WriteElementString(attribute, "containspace") testattribute = true End If case "ispflink" ' Test auf expf:PARTNER800005B011D0C13511D292DEBA8A632905D1F6 denkbar If left(value ,5) <> "expf:" then objdebug.writeln "Mail is not a PFLink: "& value ,5 call xmlWriter.WriteElementString(attribute, "Mail is not a PFLink: "& value ) testattribute = true End If case else objdebug.writeln "Invalid Test specified !:" & lcase(test),1 wscript.quit(254) end select end if end function '------------------------------------------------------------------------- ' Verarbeite den angebenen Benutzer '------------------------------------------------------------------------- function processUser (currentobj) Dim result Dim mailenabled ' wird true, wenn Objekt als mailenabled erkannt wird Dim critical ' Wird true, wenn kritische Werte fehlen Dim warning result = 0 : critical = False : warning = False : mailenabled = False objdebug.writeln ("+User:" & currentobj.Fields("distinguishedName")),5 call xmlWriter.WriteElementString("dn", currentobj.Fields("distinguishedName")) ' Check if Exchange enabled: if (currentobj.Fields("mailNickname") <> "") _ and (currentobj.Fields("DisplayName") <> "") _ and ( (currentobj.Fields("HomeMTA") <> "") _ or (currentobj.Fields("HomeMDB") <> "") _ or currentobj.Fields("msExchHomeServerName")<>"") then ' ' --------------- Mailbox enabled User ' totalmbUser = totalmbUser + 1 call xmlWriter.WriteElementString("exchange", "true") objdebug.writeln " - Mailboxenabled : TRUE",4 mailenabled = true objdebug.writeln " - MailNickName: " & currentobj.Fields("mailnickname"),4 ' Mandantory objdebug.writeln " - DisplayName: " & currentobj.Fields("DisplayName"),4 ' Mandantory If testattribute (currentobj, "mailnickname", "containspace") Then critical = True If testattribute (currentobj, "HomeMTA", "isempty") Then critical = True If testattribute (currentobj, "HomeMDB", "isempty") Then critical = True If testattribute (currentobj, "msExchHomeServerName", "isempty") Then critical = True If testattribute (currentobj, "mail", "isnotsmtp") Then critical = True If testattribute (currentobj, "legacyExchangeDN", "legacyexchangedn") Then critical = True If testattribute (currentobj, "msExchPoliciesIncluded", "isempty") Then warning = True If testattribute (currentobj, "unmergedAtts", "isnotempty") Then warning = True If testattribute (currentobj, "distinguishedName", "dnlen64") Then warning = True If testattribute (currentobj, "msExchMailboxGuid", "isnull") Then critical = True If testattribute (currentobj, "textEncodedOrAddress", "isempty") Then critical = True If testattribute (currentobj, "targetAddress", "isnotempty") Then warning = True If testattribute (currentobj, "targetAddress", "isnotmail") Then warning = True End If End If If (strOrgmode="mixed") then ' Test für Mixed Environments if testattribute (currentobj, "msExchADCGLobalNames", "isnull") Then warning = True end if ' Test für disabled account wihtout SELF permission If (currentobj.Fields("msexchUseraccountcontrol") = 2) then if testattribute (currentobj, "msexchmasteraccountsid", "isnull") Then warning = True end if End If If isnull(currentobj.Fields("proxyAddresses")) Then ' Test ob auch die ProxyAdressen gefüllt sind objdebug.writeln " - Proxyadresse fehlen: FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "Missing") critical = True Elseif InStr(LCase(join(currentobj.Fields("proxyAddresses"),",")),"smtp:") = 0 Then objdebug.writeln " - SMTP-Adresse in Proxyadresse: FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "No SMTP") critical = True Elseif InStr(LCase(join(currentobj.Fields("proxyAddresses"),",")),lcase("SMTP:"¤tobj.Fields("mail"))) = 0 Then objdebug.writeln " - SMTP-Adresse in Proxyadresse: primay FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "primary SMTP missing") critical = True End If elseif (currentobj.Fields("mailNickname") <> "") _ and (currentobj.Fields("DisplayName") <> "") _ and (currentobj.Fields("targetAddress") <> "") then ' ' --------------- Mail enabled User ' call xmlWriter.WriteElementString("exchange", "true") objdebug.writeln " - Mailenabled : TRUE",4 mailenabled = true objdebug.writeln " - MailNickName: " & currentobj.Fields("mailnickname"),4 ' Mandantory objdebug.writeln " - DisplayName: " & currentobj.Fields("DisplayName"),4 ' Mandantory totalmailUser = totalmailUser + 1 If testattribute (currentobj, "mailnickname", "containspace") Then critical = True If testattribute (currentobj, "targetAddress", "isnotmail") Then critical = True If testattribute (currentobj, "HomeMTA", "isnotempty") Then critical = True If testattribute (currentobj, "HomeMDB", "isnotempty") Then critical = True If testattribute (currentobj, "msExchHomeServerName", "isnotempty") Then critical = True If testattribute (currentobj, "mail", "isnotsmtp") Then critical = True If testattribute (currentobj, "legacyExchangeDN", "legacyexchangedn") Then critical = True If testattribute (currentobj, "msExchPoliciesIncluded", "isnotempty") Then warning = True If testattribute (currentobj, "distinguishedName", "dnlen64") Then warning = True If testattribute (currentobj, "msExchMailboxGuid", "isnotnull") Then critical = True If (strOrgmode="mixed") then ' Test für Mixed Environments if testattribute (currentobj, "msExchADCGLobalNames", "isnull") Then warning = True end if If isnull(currentobj.Fields("proxyAddresses")) Then ' Test ob auch die ProxyAdressen gefüllt sind objdebug.writeln " - Proxyadresse fehlen: FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "Missing") critical = True Elseif InStr(LCase(join(currentobj.Fields("proxyAddresses"),",")),"smtp:") = 0 Then objdebug.writeln " - SMTP-Adresse in Proxyadresse: FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "No SMTP") critical = True Elseif InStr(LCase(join(currentobj.Fields("proxyAddresses"),",")),lcase("SMTP:"¤tobj.Fields("mail"))) = 0 Then objdebug.writeln " - SMTP-Adresse in Proxyadresse: primay FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "primary SMTP missing") critical = True End If else ' ' --------------- not Exchange relevant ' call xmlWriter.WriteElementString("exchange", "false") objdebug.writeln " - Mailenabled : FALSE",4 mailenabled = false If testattribute (currentobj, "mailnickname", "isnotempty") Then critical = True If testattribute (currentobj, "HomeMTA", "isnotempty") Then critical = True If testattribute (currentobj, "HomeMDB", "isnotempty") Then critical = True If testattribute (currentobj, "msExchHomeServerName", "isnotempty") Then critical = True If testattribute (currentobj, "legacyExchangeDN", "nolegacyexchangedn") then warning = True If testattribute (currentobj, "msExchPoliciesIncluded", "isnotempty") Then warning = True If testattribute (currentobj, "unmergedAtts", "isnotempty") Then warning = True If testattribute (currentobj, "proxyAddresses", "isnotnull") Then critical = True end if processUser = "ok" If warning Then processUser = "warning" If critical Then processUser = "critical" End function '------------------------------------------------------------------------- ' Verarbeite den angebenen Kontakt '------------------------------------------------------------------------- function processcontact (currentobj) Dim result Dim mailenabled ' wird true, wenn Objekt als mailenabled erkannt wird Dim critical ' Wird true, wenn kritische Werte fehlen Dim warning result = 0 : critical = False : warning = False : mailenabled = False objdebug.writeln ("+User:" & currentobj.Fields("distinguishedName")),5 call xmlWriter.WriteElementString("dn", currentobj.Fields("distinguishedName")) ' Check if Exchange enabled: if (currentobj.Fields("mailNickname") <> "") _ and (currentobj.Fields("DisplayName") <> "") then call xmlWriter.WriteElementString("exchange", "true") objdebug.writeln " - Mailenabled : TRUE",4 mailenabled = true objdebug.writeln " - MailNickName: " & currentobj.Fields("mailnickname"),4 ' Mandantory objdebug.writeln " - DisplayName: " & currentobj.Fields("DisplayName"),4 ' Mandantory totalcontact = totalcontact + 1 If testattribute (currentobj, "targetAddress", "isempty") Then ' Mandantory critical = True else If testattribute (currentobj, "targetAddress", "isnotmail") Then warning = True End If If testattribute (currentobj, "mailnickname", "containspace") Then critical = True If testattribute (currentobj, "HomeMTA", "isempty") Then critical = True If testattribute (currentobj, "msExchHomeServerName", "isempty") Then critical = True If testattribute (currentobj, "mail", "isnotsmtp") Then critical = True If testattribute (currentobj, "legacyExchangeDN", "legacyexchangedn") Then critical = True If testattribute (currentobj, "msExchPoliciesIncluded", "isempty") Then warning = True If testattribute (currentobj, "unmergedAtts", "isnotempty") Then warning = True If testattribute (currentobj, "distinguishedName", "dnlen64") Then warning = True If testattribute (currentobj, "textEncodedOrAddress", "isempty") Then critical = True If (strOrgmode="mixed") then if testattribute (currentobj, "msExchADCGLobalNames", "isnull") Then warning = True end if If isnull(currentobj.Fields("proxyAddresses")) Then ' Test ob auch die ProxyAdressen gefüllt sind objdebug.writeln " - Proxyadresse fehlen: FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "Missing") critical = True Elseif InStr(LCase(join(currentobj.Fields("proxyAddresses"),",")),"smtp:") = 0 Then objdebug.writeln " - SMTP-Adresse in Proxyadresse: FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "No SMTP") critical = True Elseif InStr(LCase(join(currentobj.Fields("proxyAddresses"),",")),lcase("SMTP:"¤tobj.Fields("mail"))) = 0 Then objdebug.writeln " - SMTP-Adresse in Proxyadresse: primay FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "primary SMTP missing") critical = True End If else ' not Exchange relevant call xmlWriter.WriteElementString("exchange", "false") objdebug.writeln " - Mailenabled : FALSE",4 mailenabled = false If testattribute (currentobj, "mailnickname", "isnotempty") Then critical = True If testattribute (currentobj, "HomeMTA", "isnotempty") Then critical = True If testattribute (currentobj, "HomeMDB", "isnotempty") Then critical = True If testattribute (currentobj, "msExchHomeServerName", "isnotempty") Then critical = True If testattribute (currentobj, "TargetAddress", "isnotempty") Then warning = True If testattribute (currentobj, "legacyExchangeDN", "nolegacyexchangedn") Then warning = True If testattribute (currentobj, "msExchPoliciesIncluded", "isnotempty") Then warning = True If testattribute (currentobj, "unmergedAtts", "isnotempty") Then warning = True If testattribute (currentobj, "proxyAddresses", "isnotnull") Then critical = True end if processcontact = "ok" If warning Then processcontact = "warning" If critical Then processcontact = "critical" End function '----------------<--------------------------------------------------------- ' Verarbeite die angebene Gruppe '------------------------------------------------------------------------- function processgroup (currentobj) Dim result Dim mailenabled ' wird true, wenn Objekt als mailenabled erkannt wird Dim critical ' Wird true, wenn kritische Werte fehlen Dim warning critical = False : mailenabled = False : warning = False objdebug.writeln ("+GROUP:" & currentobj.Fields("distinguishedName")),5 ' Check if Exchange enabled: if (currentobj.Fields("mailNickname") <> "") _ and (currentobj.Fields("DisplayName") <> "") then call xmlWriter.WriteElementString("exchange", "true") objdebug.writeln " - Mailenabled : TRUE",4 mailenabled = true totalgroup = totalgroup + 1 If testattribute (currentobj, "mailnickname", "containspace") Then critical = True If testattribute (currentobj, "mail", "isnotsmtp") Then critical = True If testattribute (currentobj, "legacyExchangeDN", "legacyexchangedn") Then critical = True If testattribute (currentobj, "msExchExpansionServerName", "isempty") Then warning = True If testattribute (currentobj, "msExchPoliciesIncluded", "isempty") Then warning = True If testattribute (currentobj, "unmergedAtts", "isnotempty") Then warning = True If testattribute (currentobj, "distinguishedName", "dnlen64") Then warning = True If testattribute (currentobj, "textEncodedOrAddress", "isempty") Then critical = True If testattribute (currentobj, "targetAddress", "isnotempty") Then ' Test ob Mailadresse vergeben warning = True If testattribute (currentobj, "targetAddress", "isnotmail") Then ' Test ob Mailadresse vergeben warning = True End If End If If (strOrgmode="mixed") then if testattribute (currentobj, "msExchADCGLobalNames", "isnull") Then warning = True end if If isnull(currentobj.Fields("proxyAddresses")) Then ' Test ob auch die ProxyAdressen gefüllt sind objdebug.writeln " - Proxyadresse fehlen: FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "Missing") critical = True Else ' ProxyAdressen sind vorhanden. Ist auch SMTP dabei ? If InStr(LCase(join(currentobj.Fields("proxyAddresses"),",")),"smtp:") = 0 Then objdebug.writeln " - SMTP-Adresse in Proxyadresse: FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "No SMTP Address") critical = True End If End If else ' Object NICHT Mailenabled call xmlWriter.WriteElementString("exchange", "false") objdebug.writeln " - Mailenabled : FALSE",4 mailenabled = false If testattribute (currentobj, "mailnickname", "isnotempty") Then critical = True If testattribute (currentobj, "HomeMTA", "isnotempty") Then critical = True If testattribute (currentobj, "HomeMDB", "isnotempty") Then critical = True If testattribute (currentobj, "msExchHomeServerName", "isnotempty") Then critical = True If testattribute (currentobj, "legacyExchangeDN", "nolegacyexchangedn") then warning = True If testattribute (currentobj, "msExchPoliciesIncluded", "isnotempty") Then warning = True If testattribute (currentobj, "unmergedAtts", "isnotempty") Then warning = True If testattribute (currentobj, "proxyAddresses", "isnotnull") Then critical = True end if processgroup = "ok" If warning Then processgroup = "warning" If critical Then processgroup = "critical" End function '------------------------------------------------------------------------- ' Verarbeite das öffentliche Ordner-Objekt '------------------------------------------------------------------------- function processPF (currentobj) Dim critical ' Wird true, wenn kritische Werte fehlen dim warning critical = False : warning = false objdebug.writeln ("+PF:" & currentobj.Fields("distinguishedName")),0 call xmlWriter.WriteElementString("exchange", "true") totalpf = totalpf + 1 If testattribute (currentobj, "mailnickname", "containspace") Then critical = True If testattribute (currentobj, "mailnickname", "isempty") Then critical = True If testattribute (currentobj, "DisplayName", "isempty") Then critical = True If testattribute (currentobj, "HomeMDB", "isempty") Then critical = True If testattribute (currentobj, "mail", "isnotsmtp") Then critical = True If testattribute (currentobj, "legacyExchangeDN", "legacyexchangedn") Then critical = True If testattribute (currentobj, "msExchPoliciesIncluded", "isempty") Then warning = True If testattribute (currentobj, "unmergedAtts", "isnotempty") Then warning = True If testattribute (currentobj, "distinguishedName", "dnlen64") Then warning = True If testattribute (currentobj, "textEncodedOrAddress", "isempty") Then critical = True If testattribute (currentobj, "targetAddress", "ispflink") Then critical = True If isnull(currentobj.Fields("proxyAddresses")) Then ' Test ob auch die ProxyAdressen gefüllt sind objdebug.writeln " - Proxyadresse fehlen: FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "Missing") critical = True Else ' ProxyAdressen sind vorhanden. Ist auch SMTP dabei ? If InStr(LCase(join(currentobj.Fields("proxyAddresses"),",")),"smtp:") = 0 Then objdebug.writeln " = SMTP-Adresse in Proxyadresse: FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "Invalid: SMTP Missing") critical = True End If End If processPF = "ok" If warning Then processPF = "warning" If critical Then processPF = "critical" End function '------------------------------------------------------------------------- ' Verarbeite das öffentliche Ordner-Objekt '------------------------------------------------------------------------- function processQBDG (currentobj) Dim critical ' Wird true, wenn kritische Werte fehlen dim warning critical = False : warning = false objdebug.writeln ("+QBDG:" & currentobj.Fields("distinguishedName")),0 call xmlWriter.WriteElementString("exchange", "true") totalqbdg = totalqbdg + 1 If testattribute (currentobj, "mailnickname", "containspace") Then critical = True If testattribute (currentobj, "mailnickname", "isempty") Then critical = True If testattribute (currentobj, "DisplayName", "isempty") Then critical = True If testattribute (currentobj, "mail", "isnotsmtp") Then critical = True If testattribute (currentobj, "legacyExchangeDN", "legacyexchangedn") Then critical = True If testattribute (currentobj, "msExchPoliciesIncluded", "isempty") Then warning = True If testattribute (currentobj, "unmergedAtts", "isnotempty") Then warning = True If testattribute (currentobj, "distinguishedName", "dnlen64") Then warning = True If testattribute (currentobj, "textEncodedOrAddress", "isempty") Then critical = True If testattribute (currentobj, "msExchDynamicDLFilter", "isempty") Then critical = True If testattribute (currentobj, "msExchPurportedSearchUI", "isempty") Then critical = True If testattribute (currentobj, "targetAddress", "isnotempty") Then critical = True If isnull(currentobj.Fields("proxyAddresses")) Then ' Test ob auch die ProxyAdressen gefüllt sind objdebug.writeln " - Proxyadresse fehlen: FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "Missing") critical = True Else ' ProxyAdressen sind vorhanden. Ist auch SMTP dabei ? If InStr(LCase(join(currentobj.Fields("proxyAddresses"),",")),"smtp:") = 0 Then objdebug.writeln " = SMTP-Adresse in Proxyadresse: FEHLT!",4 call xmlWriter.WriteElementString("proxyaddresses", "Invalid: SMTP Missing") critical = True End If End If processQBDG = "ok" If warning Then processQBDG = "warning" If critical Then processQBDG = "critical" End function function ExchangeOrg(question) ' Question = name, dn, mixed dim objRootDSE, strConfigurationNC, oConnection, oCommand, oRecordSet, strQuery objDebug.write "Connecting to RootDSE" Set objRootDSE = GetObject("LDAP://RootDSE") strConfigurationNC = objRootDSE.Get("configurationNamingContext") objDebug.writeln "DONE:ConfigNC=" & strConfigurationNC,6 objDebug.write "Searching für Exchange Org using ADODB" Set oConnection = CreateObject("ADODB.Connection") Set oCommand = CreateObject("ADODB.Command") Set oRecordSet = CreateObject("ADODB.RecordSet") oConnection.Provider = "ADsDSOObject" oConnection.Open "ADs Provider" strQuery = ";" & _ "(objectclass=msExchOrganizationContainer);"& _ "name,distinguishedName,msExchMixedMode" objDebug.write "LDAP-String" & strQuery oCommand.ActiveConnection = oConnection oCommand.CommandText = strQuery Set oRecordSet = oCommand.Execute objDebug.writeln "DONE: record found :" & oRecordSet.recordcount, 4 if oRecordSet.EOF then objDebug.writeln "Unable to read Exchange Organization, Check AD-permissions.", 1 ExchangeOrg = "" else select case lcase(question) case "name" objDebug.writeln "Exchange Orgname =" & oRecordSet.Fields("name"), 3 ExchangeOrg = oRecordSet.Fields("name") case "dn" objDebug.writeln "FOUND dn =" & oRecordSet.Fields("distinguishedName"), 3 ExchangeOrg = oRecordSet.Fields("distinguishedName") case "mixed" objDebug.writeln "MixedMode=" & oRecordSet.Fields("msExchMixedMode"), 3 ExchangeOrg = oRecordSet.Fields("msExchMixedMode") case else objDebug.writeln "ExchangeOrg: wrong question specified. Was:" & question, 1 ExchangeOrg = "" end select end if end function sub writexslt(strfilename) dim txtxsl txtxsl = _ " " & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ "CheckExobjects Status" & vbcrlf & _ "" & vbcrlf & _ "

CheckExObjects Status

" & vbcrlf & _ "

Summary

" & vbcrlf & _ " " & vbcrlf & _ "" & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ "
Starttime
Start Verarbeitung
EndTime
Org-Mode TOTAL
# Objects
# OK
# Warning
# Error
# unknown
" & 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 & _ "
name:typ:exchangestatus:problem:
" & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " homemta:
" & vbcrlf & _ " homemdb:
" & vbcrlf & _ " msexchhomeservername:
" & vbcrlf & _ " mail:
" & vbcrlf & _ " legacyexchangedn:
" & vbcrlf & _ " rdn:
" & vbcrlf & _ " adcglobalname:
" & vbcrlf & _ " disabledUser and msexchmasteraccountsid:
" & vbcrlf & _ " msexchmailboxguid:
" & vbcrlf & _ " proxyaddresses:
" & vbcrlf & _ " textencodedoraddress:
" & vbcrlf & _ " mailnickname:
" & vbcrlf & _ " targetaddress:
" & vbcrlf & _ " msexchexpansionservername:
" & vbcrlf & _ " msexchpoliciesincluded:
" & vbcrlf & _ " msexchadcglobalnames:
" & vbcrlf & _ " msexchpurportedsearchui:
" & vbcrlf & _ " msexchdynamicdlfilter:
" & vbcrlf & _ " containspace:
" & 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 xmlfilename 'stores the filename dim xmldom 'DOM Object dim xmlparent 'currentNode dim xmlroot 'RootNode dim xmlobject 'PArent of currentNode dim intIndentation '~ xmlfile.write "" & vbcrlf private Sub Class_Initialize dim xmldeclaration Set xmlDom = CreateObject("Microsoft.XMLDOM") xmlDom.loadxml "" set xmlobject = xmlDom End Sub private Sub Class_Terminate xmldom.LoadXML getFormattedXML xmldom.save(xmlfilename) End Sub public Property let filename(wert) xmlfilename = wert End Property public Property let Indentation(wert) ' only für Backwards compatibility End Property public Property let Formatting(wert) ' writer.Formatting = Formatting.Indented ' Funktioniert nur mit .nEtg ? End Property sub Writestylesheet (item) dim stylePI Set stylePI = xmlDom.createProcessingInstruction("xml-stylesheet", "type=""text/xsl"" href="""&item & """") xmlDom.appendChild(stylePI) end sub sub WriteStartElement(item) dim xmlobject2 set xmlobject2 = xmlDom.createElement(item) xmlobject.appendchild xmlobject2 set xmlobject = xmlobject2 end sub sub WriteAttributeString(name,value) ' ergänzt eine ID zum aktuellen Element if isnull(value) then value = "" xmlobject.setAttribute name, value end sub sub WriteElementString(item,value) ' add XML tag and Data dim xmldata set xmldata = xmlDom.createElement(item) if isnull(value) then value = "" xmldata.text = value xmlobject.appendchild(xmldata) end sub sub WriteEndElement ' Schliesse den aktuellen Client und gehe ein objekt höher set xmlobject = xmlobject.parentnode end sub sub DeleteEndElement ' Entferne den letzten Client komplett dim xmlobject2 set xmlobject2 = xmlobject set xmlobject = xmlobject.parentnode xmlobject.removechild(xmlobject2) end sub function getXML ' gebe die aktuelle XML-Information unformtiert aus getxml = xmldom.xml end function function LoadXML(strxml) ' ersetze die Information durch eine neue XML-Information xmldom.loadXML(strxml) end function sub Flush() ' Schreibe die aktuelle XML-Struktur als Datei heraus xmldom.LoadXML getFormattedXML xmldom.save(xmlfilename) end sub function getFormattedXML ' Gebe die XML-Struktur formatiert und besser lesbar aus dim oStylesheet set oStylesheet = CreateObject("Microsoft.XMLDOM") oStylesheet.async = False oStylesheet.loadXML ("" & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ "" & vbcrlf & _ "") getFormattedXML = xmlDOM.transformNode(oStylesheet) end function sub close() xmldom.LoadXML getFormattedXML xmldom.save(xmlfilename) 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 ValidMail ' Generic Class to validate an given Address against formal rules ' teh RegEx expressions are not 100% correct but can catch the most errors ' \w = [a-zA-Z0-9_]] dim SMTPRegEx, SMTPRawregEx, MSMAILRegEx, NotesRegEx, GWiseRegEx, X400RegEx, CCMailRegEx private Sub Class_Initialize Set SMTPRawregEx = New RegExp ' Quelle: http://www.regular-expressions.info/email.html SMTPRawregEx.Pattern = "^[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*"_ &"@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+"_ &"(?:[A-Z]{2}|com|org|net|gov|biz|info|name|aero|biz|info|jobs|museum)\b" SMTPRawregEx.IgnoreCase = true Set SMTPregEx = New RegExp SMTPregEx.Pattern = "^(smtp:)[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*"_ &"@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+"_ &"(?:[A-Z]{2}|com|org|net|gov|biz|info|name|aero|biz|info|jobs|museum)\b" SMTPregEx.IgnoreCase = true ' MSMAIL: network/postoffice/User set MSMAILRegEx = New RegExp MSMAILRegEx.Pattern = "^(msmail:)?\w{1,12}/\w{1,12}/\w{1,12}$" MSMAILRegEx.IgnoreCase = true ' NOTES: User/User/User/iUser@domain set NotesRegEx = New RegExp NotesRegEx.Pattern = "^(notes:)?[\w- /]+@[\w- ]$" '~ NotesRegEx.Pattern = "^(notes:)?[\wäöüßäöÜ- /]+@[\wäöüßäöÜ- ]+$" NotesRegEx.IgnoreCase = true 'gwise: domain.postoffice.objectid set GWiseRegEx = New RegExp GWiseRegEx.Pattern = "^(gwise:)?[\w ]+\.[\w ]+\.[\w ]+$" GWiseRegEx.IgnoreCase = true ' X400:c=US;a= ;p=CONTOSO;o=Exchange;s=Sloan;g=Arvin; set X400RegEx = New RegExp X400RegEx.Pattern = "^(x400:)?c=[\w ]+;a=[\w ]+;p=[\w ]+;o=[\w ]+;s=[\w ]+;g=[\w ]+(;\w+=[\w ]+)*;$" X400RegEx.IgnoreCase = true ' CCMAIL:Username at Postoffice set CCMailRegEx = New RegExp CCMailRegEx.Pattern = "^(ccmail:)?\w+ at \w+$" CCMailRegEx.IgnoreCase = true End Sub private Sub Class_Terminate() : Set SMTPregEx = nothing : End Sub function SMTPRaw(wert) SMTPRaw = SMTPRawregEx.test(wert) ' Test is true if Match is found end function function SMTP(wert) SMTP = SMTPregEx.test(wert) ' Test is true if Match is found end function function NOTES(wert) NOTES = NotesRegEx.test(wert) ' Test is true if Match is found end function function MSMAIL(wert) MSMAIL = MSMAILRegEx.test(wert) ' Test is true if Match is found end function function GWISE(wert) GWISE = GWISERegEx.test(wert) ' Test is true if Match is found end function function X400(wert) X400 = X400RegEx.test(wert) ' Test is true if Match is found end function function CCMail(wert) CCMail = CCMAILRegEx.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") 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 & "