Option Explicit '------------------------------------------------------------------------- ' pfreport.vbs ' ' Beschreibung ' reporting of exchange public folders using WMI ' ' no special handling of runtime error or permissions. script will abort ' ' Script is running with permissions of currently logged on User ' ' (c)2006 Net at Work Netzwerksysteme GmbH ' ' Version 1.0 (25. Nov 2005) Frank Carius ' Erste Version ' Version 1.1 (28. Nov 2005) Frank Carius ' Erweiterung um Mailadresse über GUID suchen ' Version 1.2 (16. Dez 2005) Frank Carius ' Fehlerbehandlung wenn GUID nicht im AD gefunden ' Ausgabe von "disabled", wenn Ordner keine mailadresse habem soll ' Version 1.3 (13 Feb 2006) Frank Carius ' Zusätzliche Properties (DeletedItemLifetime Property u.a. ' Version 1.4 (19 Jun 2006) Frank Carius ' XML-Ausgabe farblich gestalten, kleinere Fixes ' Version 1.5 (19 Jun 2006) Frank Carius ' neuer XMLWriter ' Ausgabe der AdministratorenecurityDescriptior ' Version 1.6 (29. Aug 2006) Frank Carius ' Ausgabe der Proxy Adressen in der XML-Datei und StyleSheet (b) und mail fett (c) ' Version 1.7 (12. Jun 2007) Frank Carius ' Abfangen fehlender Replication Server ' Ausgabe des HomeMTA/HomeMDB aus dem AD Objekt. Prüfung ob existent ' Version 1.8 (14. Feb 2008) Frank Carius ' For-Schleife bei ProxyAddresses mit ErroHandling ' Fehlend: ' Info, der letzten änderung in dem Ordner ' Clientberechtigungen ' beide muss man wohl per WebDav/MAPI auslesen. ' Nur export der "Public Folder", keine Systemprdner ' Ordergröße nur gültig für Ordner mit Replikation auf dem Server. sonst 0 ' '------------------------------------------------------------------------- const cComputerName = "." ' Name of Exchange Server or local computer Dim total, strOutFilePrefix, objDebug, XMLWriter Dim objWMIExchange ' Exchange Namespace WMI object Dim listExchange_PublicFolders ' ExchangeLogons collection Dim objExchange_PublicFolder ' A single ExchangeLogon WMI object dim objGUID2SMTP , strGUID, strreplica dim strProxyAddress dim TestLDAP strOutFilePrefix = makefilename("pfreport-" & Date() & "-" & Time()) ' common name of the output files without extension set objdebug = new DebugWriter objDebug.target = "file:6 console:5" ' 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 "pfreport: gestartet", 0 set xmlWriter = new XmlTextWriter xmlWriter.filename = strOutFilePrefix & ".xml" xmlWriter.Indentation = 4 call xmlWriter.WriteStylesheet("pfreport.xsl") call writexslt("pfreport.xsl") call xmlWriter.WriteStartElement("pfreport") call xmlWriter.WriteElementString("starttime", now()) objDebug.writeln "pfreport: Start WMI-Query", 0 Set objWMIExchange = GetObject("winmgmts:{impersonationLevel=impersonate}!//"& cComputerName&"/root/MicrosoftExchangeV2") If Err.Number <> 0 Then objDebug.writeln "ERROR: unable to connect to the WMI namespace." ,1 Else objDebug.writeln "pfreport: Loading Instances ... may take a long time approx 1h/10000 folder", 0 Set listExchange_PublicFolders = objWMIExchange.InstancesOf("Exchange_PublicFolder") total = 0 If (listExchange_PublicFolders.count > 0) Then ' Were any Exchange_PublicFolder Instances returned? For Each objExchange_PublicFolder in listExchange_PublicFolders total = total + 1 call xmlWriter.WriteStartElement("object") objDebug.writeln "Processing ." & objExchange_PublicFolder.path , 0 call xmlWriter.WriteElementString("name", objExchange_PublicFolder.name) call xmlWriter.WriteElementString("addressbookname", objExchange_PublicFolder.AddressBookName) call xmlWriter.WriteElementString("administrativenote", objExchange_PublicFolder.AdministrativeNote) call xmlWriter.WriteElementString("Administratorenecuritydescriptor", objExchange_PublicFolder.AdministratorenecurityDescriptor) wscript.echo objExchange_PublicFolder.AdministratorenecurityDescriptor call xmlWriter.WriteElementString("associatedmessagecount", objExchange_PublicFolder.AssociatedMessageCount) call xmlWriter.WriteElementString("contactcount", objExchange_PublicFolder.ContactCount) call xmlWriter.WriteElementString("creationtime", objExchange_PublicFolder.CreationTime) if objExchange_PublicFolder.containsrules then call xmlWriter.WriteElementString("containsrules", "true") else call xmlWriter.WriteElementString("containsrules", "false") end if 'call xmlWriter.WriteElementString("foldertree", objExchange_PublicFolder.FolderTree) call xmlWriter.WriteElementString("DeletedItemLifetime", objExchange_PublicFolder.DeletedItemLifetime) call xmlWriter.WriteElementString("friendlyURL", objExchange_PublicFolder.FriendlyURL) call xmlWriter.WriteElementString("ismailenabled", objExchange_PublicFolder.IsMailEnabled) if objExchange_PublicFolder.IsMailEnabled then call xmlWriter.WriteElementString("adproxypath", objExchange_PublicFolder.ADProxyPath) if objExchange_PublicFolder.ADProxyPath <> "" then strGUID = replace(objExchange_PublicFolder.ADProxyPath,"{","") strGUID = replace(strGUID ,"}","") on error resume next set objGUID2SMTP = GetObject("LDAP://") if err.number = 0 then call xmlWriter.WriteElementString("mail", objGUID2SMTP.mail) for each strProxyAddress in objGUID2SMTP.proxyaddresses call xmlWriter.WriteElementString("proxyaddresses", strProxyAddress) next if err.number <> 0 then call xmlWriter.WriteElementString("proxyaddresses","Error Enumerating") end if call xmlWriter.WriteElementString("homeMTA",objGUID2SMTP.HomeMTA) on error resume next set TestLDAP = GetObject("LDAP://" & objGUID2SMTP.homeMTA) if err.number = 0 then call xmlWriter.WriteElementString("homeMTAStatus","HomeMTA-OK") else call xmlWriter.WriteElementString("homeMTAStatus","notfound") end if on error goto 0 call xmlWriter.WriteElementString("homeMDB",objGUID2SMTP.homeMDB) on error resume next set TestLDAP = GetObject("LDAP://" & objGUID2SMTP.homeMDB) if err.number = 0 then call xmlWriter.WriteElementString("homeMDBStatus","HomeMDB-OK") else call xmlWriter.WriteElementString("homeMDBStatus","notfound") end if on error goto 0 else err.clear on error goto 0 call xmlWriter.WriteElementString("mail", "MISSING") end if else call xmlWriter.WriteElementString("mail", "MISSING") end if else call xmlWriter.WriteElementString("mail", "disabled") end if 'call xmlWriter.WriteElementString("targetaddress", objExchange_PublicFolder.TargetAddress) call xmlWriter.WriteElementString("messagecount", objExchange_PublicFolder.MessageCount) call xmlWriter.WriteElementString("attachmentcount", objExchange_PublicFolder.AttachmentCount) call xmlWriter.WriteElementString("lastaccesstime", objExchange_PublicFolder.LastAccessTime) call xmlWriter.WriteElementString("lastmodificationtime", objExchange_PublicFolder.LastModificationTime) call xmlWriter.WriteElementString("maximumitemsize", objExchange_PublicFolder.MaximumItemSize) call xmlWriter.WriteElementString("ownercount", objExchange_PublicFolder.OwnerCount) 'call xmlWriter.WriteElementString("parentfriendlyURL", objExchange_PublicFolder.ParentFriendlyURL) call xmlWriter.WriteElementString("path", objExchange_PublicFolder.Path) call xmlWriter.WriteElementString("totalmessagesize", objExchange_PublicFolder.TotalMessageSize) if isnull(objExchange_PublicFolder.ReplicaList) then call xmlWriter.WriteElementString("replicaserver", "") else for each strreplica in objExchange_PublicFolder.ReplicaList call xmlWriter.WriteElementString("replicalist", strreplica) strreplica = left(strreplica,instr(strreplica,"cn=Servers")-2) strreplica = mid(strreplica,instrrev(strreplica,"cn=")+3) call xmlWriter.WriteElementString("replicaserver", strreplica) next end if call xmlWriter.WriteEndElement() ' of ("object") Next Else objDebug.writeln "pfreport: Keine PublicFolder gefunden !", 2 End If End If call xmlWriter.WriteElementString("total", total) objDebug.writeln "Total objects checked:" & total, 0 call xmlWriter.WriteElementString("endtime", now()) call xmlWriter.WriteEndElement() ' of ("pfreport") call xmlWriter.Close ' XML schreiben WScript.quit(0) sub writexslt(strfilename) dim txtxsl txtxsl = _ " " & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ "pfreport Status" & vbcrlf & _ "" & vbcrlf & _ "

pfreport Status

" & vbcrlf & _ "

Summary

" & vbcrlf & _ " " & vbcrlf & _ "" & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ "
Starttime
EndTime
# Objects
" & 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 & _ " " & 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 & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ "" & vbcrlf & _ "
name:path:mail:items:totalmessagesize:attachmentcount:replicaserver:MTA:MDB:ContainsRules:
" & 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 & _ " No Replica" & vbcrlf & _ " " & vbcrlf & _ "
" & vbcrlf & _ " 		" & vbcrlf & _ " No Server2" & vbcrlf & _ " " & vbcrlf & _ " OK" & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " OK" & 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 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 get filename filename = xmlfilename 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 ' wenn dsa aktiv wird, ist die XML Datei nicht komplett 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 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 & "