Option Explicit '------------------------------------------------------------------------- ' SMTPBackupRestore.1.0.vbs ' ' Beschreibung: ' "Rettet" die primäre SMTP-Adresse der User in ein Benutzerdefiniertes Feld (Angeben !!) ' Erlaubt danach das Vergleichen bzw Zurücksetzen der Adresse auf den alten Wert ' Ideal um vor größeren Migrationen und änderungen am RUS die "wichtigste" Adresse zu sichern ' Der RUS ergänzt immer nur Adressen, so dass ein Löschen nur durch einen Admin passierne kann ' Aber der RUS könnte die primäre Adresse unbemerkt ändern und damit würden alle ausgehenden Mails ' mit der "falschen" Adresse raus gehen. ' ' Achtung: uNterschied: ' Wenn Sie in der MMC die primäre Adresse Adresse ändern, wird die alte Adresse aus den Proxy Adressen entfernt ! ' Das Skript setzt jedoch die primäre Adresse und ergänzt oder setzt gegebenenfalls die bestehende als Primäre Proxy ' ' 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 ' ' (c)2004 Net at Work Netzwerksysteme GmbH ' + Steuerung über Konstanten statt Kommandozeile ' ' Version 1.0 (24. Apr 2005) ' + erste Version ' Version 1.1 (06 Okt 2007) ' + Bugfix und DebugWriter Klasse ' '------------------------------------------------------------------------- ' Hier müssen ihre Gruppen definiert werden. Nur Personen in der Gruppe sind für dsa Protokoll "aktiv" geschaltet. ' alle anderen werden ohne weitere Rückfrage deaktiviert. Const conSaveFeld = "ExtensionAttribute4" 'AD-Feld, in das die Adresse "gesichert" wird Const conDNSDomain = "DC=msxfaq,DC=local" 'Domäne, die bearbeitet wird. '* Const ADS_PROPERTY_CLEAR = 1 Const ADS_PROPERTY_UPDATE = 2 '* Const ADS_PROPERTY_APPEND = 3 Dim chrAction ' Dim count ' Dim logging ' Dim objCommand, objConnection, objRecordSet, objUser 'Objekte' Dim strAttributes, strBase, strcurrentMail, strDN, strFilter, strQuery, strSaveMail, strProxyAddresses 'Strings call ForceCScript ' must be rund with CSCRIPT call abbruch ("MailboxReport Script fortsetzen ?" ,5) ' Last question to stop ' ----- Dateiname für Ausgaben erstellen. dim oShell, strOutFilePrefix set oShell = createobject("wscript.shell") strOutFilePrefix = oShell.currentdirectory & "\MailboxReport-" & makefilename(Date() & "-" & Time()) ' Pfad und Dateiname der Log-Datei ' ----- Initialisierung der Debugging und Loggingoptionen dim objDebug set objdebug = new clsDebugWriter objDebug.target = "file:5 console:6" ' ie eventlog objDebug.outFile = strOutFilePrefix &".log" objDebug.start objDebug.writeln " SMTPBackupRestore wurde gestartet.",0 If (WScript.Arguments.count <>1) Then objDebug.writeln "Falsche Aufrufparameter", 1 objDebug.writeln "Bitte geben sie eine Option an",0 objDebug.writeln "S = SAVE : Sichere aktuelle Mailadresse in benutzerdefiniertes Feld",0 objDebug.writeln "C = CHECK: Prüfe Adressen und melde unterschiede",0 objDebug.writeln "R = RESET: Setze die früher gesicherte Adresse wieder Primär",0 If conSaveFeld = "ExtensionAttribute4" Then objDebug.writeln "AD-Feld ist ExtensionAttribute4", 0 objDebug.writeln "Warnung: Sie nutzen das Standard Feld ExtensionAttribute4 zur Sicherung",0 objDebug.writeln " Stellen Sie sicher, dass dieses Feld nicht anderweitig verwendet wird",0 objDebug.writeln " oder ändern Sie das Feld im Script",0 End If WScript.quit(1) Else Select Case lcase(WScript.Arguments.Unnamed.Item(0)) Case "s" 'Save SMTP Address objDebug.writeln "Action = SAVE", 0 chrAction = "s" Case "c" 'Check SMTP Address objDebug.writeln "Action = CHECK", 0 chrAction = "c" Case "r" 'Reset Adresse to earlier value objDebug.writeln "Action = RESET", 0 chrAction = "r" End Select End If objDebug.writeln "Connect to Active Directory" ,5 Set objCommand = CreateObject("ADODB.Command") ' mit ADO das Active Directory durchsuchen Set objConnection = CreateObject("ADODB.Connection") objConnection.Provider = "ADsDSOObject" objConnection.Open "Active Directory Provider" objCommand.ActiveConnection = objConnection strBase = "" ' Gesamte Domäne durchsuchen ' Filter für alle Exchange Postfächer (aus in Exchange 2003 angelegter Adressliste) strFilter = "(&(&(& (mailnickname=*) (| (&(objectCategory=person)(objectClass=User)(|(homeMDB=*)(msExchHomeServerName=*))) ))))" strAttributes = "distinguishedName,mail,"&conSaveFeld ' Gesuchte Attribute strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" ' LDAP query zusammenbauen objCommand.CommandText = strQuery objCommand.Properties("Page Size") = 100 ' max 100 Ergebnisse auf einmal erhalten objCommand.Properties("Timeout") = 30 ' Timeout 30 Sekunden objCommand.Properties("Cache Results") = False Set objRecordSet = objCommand.Execute ' und los objDebug.writeln "Connect done" ,5 count = 0 Do until objRecordSet.EOF ' jeden Datensatz einzeln bearbeiten. count = count + 1 strDN = objRecordSet.Fields("distinguishedName").Value ' DN ermitteln objDebug.writeln "Processing " & count & ":" & strDN,5 ' Diagnoseausgabe strcurrentMail = objRecordSet.Fields("Mail").Value ' aktuelle Mailadresse strSaveMail = objRecordSet.Fields(conSaveFeld).Value ' gesicherte Mailadresse Select Case chrAction Case "s" 'Save SMTP Address Set objUser= GetObject("LDAP://" & strDN) ' User verbinden objUser.Put conSaveFeld ,strcurrentMail ' Aktuelle Mailadresse sichern objUser.setinfo objDebug.writeln " SAVE: " & strDN&" - " & strcurrentMail,5 Case "c" 'Check SMTP Address If InStr(strSaveMail,"@") > 0 Then 'Zumindest ein @ ist im Sicherungsfeld If strcurrentMail <> strSaveMail Then objDebug.writeln " DIFF,"&strDN&", Adresse verändert. Aktuell:" & strcurrentMail&" Alt:"&strSaveMail,3 Else objDebug.writeln " OK ,"&strDN&",Adresse unverändert" & strcurrentMail,5 End If Else objDebug.writeln "FAIL,"&strDN&",Keine gespeicherte/gültige Adresse in Sicherungsfeld",1 End If Case "r" 'Reset Adresse to earlier value If InStr(strSaveMail,"@") > 0 Then If strcurrentMail <> strSaveMail Then Set objUser= GetObject("LDAP://" & strDN) ' User verbinden objUser.Put "mail" , strSaveMail ' Aktuelle Mailadresse sichern objDebug.writeln " RSET: Mailadresse modifiziert Rollback" ,4 strProxyAddresses = Join(objUser.GetEx("ProxyAddresses"),vbTab) 'Alle ProxyAddressen zusammenführen. strProxyAddresses = Replace(strProxyAddresses,"SMTP:","smtp:") 'bisherige primäry runterstufen If InStr(strProxyAddresses,strSaveMail)=0 Then strProxyAddresses = strProxyAddresses & vbTab & "SMTP:"&strSaveMail ' Hinzufügen Else strProxyAddresses = Replace(strProxyAddresses,"smtp:"&strSaveMail,"SMTP:"&strSaveMail) 'Setzen End If objUser.put "ProxyAddresses", Split(strProxyAddresses,vbTab) objUser.setinfo objDebug.writeln " OK: Written" ,5 Else objDebug.writeln " OK: Adresse unverändert. kein Schreiben",5 End If Else objDebug.writeln " SKIP: no saved address!",5 End If Case Else objDebug.writeln "Error: unknown Action",1 End Select objDebug.writeln "----------------------------",0 objRecordSet.MoveNext ' Nächster Benutzer Loop objDebug.writeln "Skript beendet",0 WScript.quit(0) class clsDebugWriter ' Version 1.2 New Level rating. Corrected illegal file names ' Version 1.3 MakeFileName entfernt fuer absolute angaben ' Generic Class für writing debugging information and handling runtime errors ' By default al Level 1 Messaegs are logged to the Console ' Version 29. Mar 2006 ' Debug Levels ' 0=only output ' 1=Critical ' 2=Error ' 3=Warning ' 4=information ' 5++ =verbose private objIE, file, fs, debugfilename, status, strline private debuglevelIE , debuglevelfile, debugleveleventlog, debuglevelConsole private Sub Class_Initialize status = "active" : strline = "" : debugfilename = "" debuglevelIE = 0 debuglevelfile = 0 debugleveleventlog = 0 debuglevelConsole = 1 End Sub private Sub Class_Terminate() if isobject(OBJIE) then objie.document.write "" end if if debugfilename <> "" then file.Close end if End Sub public sub start : status = "active": end sub public sub pause : status = "pause" : end sub public property let outfile(wert) if debugfilename <> "" then 'Close existing debug file file.close : file = nothing : fs = nothing end if debugfilename = wert ' open debug file Set fs = CreateObject("Scripting.FileSystemObject") Set file = fs.OpenTextFile(debugfilename, 8, True) end property public property let setie (wert) : set objIE = wert : objie.visible = true end property public property let target (wert) dim arrTemp, intcount arrTemp = split(wert," ") ' spit by space for intcount = 0 to ubound(arrTemp) select case lcase(split(arrtemp(intcount),":")(0)) case "ie" debuglevelIE = cint(right(arrtemp(intcount),1)) case "file" debuglevelfile = cint(right(arrtemp(intcount),1)) case "eventlog" debugleveleventlog = cint(right(arrtemp(intcount),1)) case "console" debuglevelConsole = cint(right(arrtemp(intcount),1)) end select next end property sub write(strMessage) strline = strline & strMessage end sub Sub writeln(strMessage, intseverity) 'Fügt einen Eintrag in die Log-Datei ein dim blnerror strMessage = strline & strMessage ' add existing Output Messages strline = "" if err <> 0 then ' Sonderbehandlung als "ErrorHandler" blnerror = true strmessage= "RUNTIME ERROR :" & strMessage & vbcrlf & _ "ERR.Number :" & err.number & vbcrlf & _ "ERR.Description:" & err.Description & vbcrlf & _ "ERR.Source :" & err.source & vbcrlf & _ "ERR.HelpFile :" & err.HelpFile & vbcrlf & _ "ERR.HelpContext:" & err.HelpContext & vbcrlf err.clear else blnerror = false end if if ((status = "active") or blnerror) then if (debuglevelfile > 0) and ((debuglevelfile >= intseverity) or blnerror) and (debugfilename <> "") then file.Write(Now & ",") Select Case intseverity Case 0 file.Write("Out0") Case 1 file.Write("Cri1") Case 2 file.Write("Err2") Case 3 file.Write("Wrn3") Case 4 file.Write("Inf4") Case Else file.Write("Dbg"&intseverity) End Select file.WriteLine("," & Convert2Text(strMessage)) strline = "" end if if (debugleveleventlog > 0) and ((debugleveleventlog >=intSeverity) or blnerror) then dim objWSHShell Set objWSHShell = Wscript.CreateObject("Wscript.Shell") Select Case intseverity Case 0 objWSHShell.LogEvent 0, strMessage ' Const EVENT_SUCCESS = 0 Case 1 objWSHShell.LogEvent 1, strMessage ' const EVENT_ERROR = 1 Case 2 objWSHShell.LogEvent 1, strMessage ' const EVENT_ERROR = 1 Case 3 objWSHShell.LogEvent 2, strMessage ' Const EVENT_WARNING = 2 Case else objWSHShell.LogEvent 4, strMessage ' Const EVENT_INFO = 4 End Select end if if (debuglevelconsole > 0) and ((debuglevelconsole >=intSeverity) or blnerror) then Select Case intseverity Case 0 wscript.echo now() & ",OUT0:" & strMessage Case 1 wscript.echo now() & ",CRI1:" & strMessage Case 2 wscript.echo now() & ",ERR1:" & strMessage Case 3 wscript.echo now() & ",WRN2:" & strMessage Case 4 wscript.echo now() & ",INF3:" & strMessage Case Else wscript.echo now() & ",DBG" & intseverity & ":" & strMessage End Select end if if (debuglevelie > 0) and ((debuglevelie >= intSeverity) or blnerror) then dim strieline if not isobject(objIE) then Set objIE = CreateObject("InternetExplorer.Application") objIE.navigate("about:blank") objIE.visible = true do While objIE.Busy WScript.Sleep 50 Loop objIE.document.write "DebugWriter Output" objIE.document.write "
" end if strieline = "" Select Case intseverity Case 0 strieline = strieLine & "" Case 1 strieline = strieLine & "" Case 2 strieline = strieLine & "" Case 3 strieline = strieLine & "" Case 4 strieline = strieLine & "" Case Else strieline = strieLine & "" End Select strieline = strieline & "" objIE.document.write cstr(strieline) end if '~ if (instr(DebugTarget,"mom") <>0) or blnerror then '~ scriptContext.echo now() &","& intseverity &":"& strline & strMessage '~ end if end if ' if status = active strline = "" End Sub private function 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 () & "Out0CritErr WarnInfoDbg"&intseverity&"" & strmessage & "