Option Explicit '------------------------------------------------------------------------- ' addself 1.1 ' ' 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 (23. Sep 2005) Frank Carius ' - Neubeginn mit XML und LDAP-Suche statt OU-Rekursion ' - AddSelf Funktion angepasst uebernommen von altem Script (Henning Krause) ' Version 1.1 (12. Nov 2008) Frank Carius ' Tippfehler Koirrektur ' http://support.microsoft.com/kb/278966/en-us You cannot move or log on to an Exchange resource mailbox ' To determine how many disabled User accounts do not have the msExchMasterAccountSid attribute, you can generate an LDIF formatting export file. To do this, run the following Ldifde.exe command: ' ldifde -f file.txt -d "dc=domain,dc=com" -l nothing -r "(&(objectcategory=person)(objectclass=User)(msexchUseraccountcontrol=2)(!(msexchmasteraccountsid=*)))" ' Skript AddSelf und entfernen des Users selbst (und SidHistory dinge) ' http://support.microsoft.com/kb/296479 Details zu msexchUseraccountcontrol '------------------------------------------------------------------------- ' Constants für the NameTranslate object. 'Constants used in AD const ADS_UserDISABLED = &H00002 const ADS_NAME_TYPE_1779 = &H000001 ' Name format as specified in RFC 1779. für example, "CN=fcarius,CN=Users,DC=msxfaq,DC=de". const ADS_NAME_TYPE_NT4 = &H00003 const E2K_MB_FULL_MB_ACCESS = &H00001 const E2K_MB_SEND_AS = &H00002 const E2K_MB_EXTERNAL_ACCOUNT = &H00004 const E2K_MB_READ_PERMISSIONS = &H20000 const E2K_MB_TAKE_OWNERSHIP = &H80000 const ADS_ACE_REVISION_DS = &H00004 const ADS_ACETYPE_ACCESS_ALLOWED = &H00000 const ADS_ACEFLAG_INHERIT_ACE = &H00002 Dim total, totalok, totalwarn1, totalwarn2, result, strGCPath, strNTName Dim oConnection, oCommand, oRecordset, oUser Dim strTemp, strQuery, lngpage, strOutFilePrefix, dtmvalue, intUserAccountControl, intpwage dim oSMTPTest, objMessage, objDebug, xmlwriter, objTrans Dim con Dim rs Dim fso Dim file Dim strCommand dim intCounter dim objUser, objSD, objACL, objACE dim found dim rootdse strOutFilePrefix = makefilename("addself-" & 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 "addself: gestartet", 0 set xmlWriter = new XmlTextWriter xmlWriter.filename = strOutFilePrefix & ".xml" xmlWriter.Indentation = 4 call xmlWriter.WriteStylesheet("addself.xsl") call writexslt("addself.xsl") call xmlWriter.WriteStartElement("addself") call xmlWriter.WriteElementString("starttime", now()) 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 objDebug.writeln "Querying AD für Objects at " & strGCPath,4 Set oConnection = CreateObject("ADODB.Connection") Set oRecordset = CreateObject("ADODB.Recordset") Set oCommand = CreateObject("ADODB.Command") oConnection.Provider = "ADsDSOObject" oConnection.Open "ADs Provider" oCommand.ActiveConnection = oConnection oCommand.Properties("Page Size") = 100 oCommand.CommandText = "<" & strGCPath & ">;"&_ "(&(objectcategory=person)(objectclass=User)(msexchUseraccountcontrol=2)(!(msexchmasteraccountsid=*)));" & _ " distinguishedName,name,mail,mailNickName,msExchMasterAccountSid,msexchUseraccountcontrol,UserAccountControl;subtree" Set oRecordset = oCommand.Execute objDebug.writeln "Done Total Records found:" & oRecordset.recordcount, 0 Set objTrans = CreateObject("NameTranslate") 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 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)) call xmlWriter.WriteElementString("oldmsexchUseraccountcontrol", oRecordset.Fields("msexchUseraccountcontrol")) call xmlWriter.WriteElementString("oldmsExchMasterAccountSid", oRecordset.Fields("msExchMasterAccountSid")) ' Logic: Muss muss Exchange enabled sein. ' wenn dann noch disabled, dann muss msexchUseraccountcontrol = 2 und Self addiert werden, wenn kein anderer external account ' wenn dann nicht disabled, dann muss msexchUseraccountcontrol = 0 und es darf kein external account eingetragen sein if oRecordset.Fields("mailNickName") <> "" then 'Must be set if User is mail enabled if (oRecordset.Fields("UserAccountControl") and ADS_UserDISABLED ) > 0 then 'User is disabled call xmlWriter.WriteElementString("disabled", "true") objDebug.writeln " User is DISABLED", 5 if oRecordset.Fields("msexchUseraccountcontrol") = 2 then 'must be 2 if disabled User call xmlWriter.WriteElementString("msexchUseraccountcontrol", "OK") objDebug.writeln " msexchUseraccountcontrol is OK", 5 else call xmlWriter.WriteElementString("msexchUseraccountcontrol", "FIX") objDebug.writeln " msexchUseraccountcontrol is NOT 2 Fixing", 5 end if if not isnull(oRecordset.Fields("msExchMasterAccountSid")) then 'check if the User has a masteraccount set. Err.Number will be zero if Masteraccount is set fixUser(child) counterFixed = counterFixed + 1 else call xmlWriter.WriteElementString("status", "OK1") end if else call xmlWriter.WriteElementString("disabled", "false") objDebug.writeln " User ist ENABLED", 5 if oRecordset.Fields("msexchUseraccountcontrol") = 0 then 'must be 0 if enabled User call xmlWriter.WriteElementString("status", "OK2") objDebug.writeln " msexchUseraccountcontrol is NOT 0 Fixing", 5 else objDebug.writeln " msexchUseraccountcontrol is NOT 0 Fixing", 5 msexchUseraccountcontrol = 0 end if end if else ' User is NOT mailenabled, skip call xmlWriter.WriteElementString("status", "No MailNicname") 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 ("addself") call xmlWriter.Close ' XML schreiben WScript.quit(0) function fixUser(objUser) 'Fixes the accountinformations of the given User dim objSD, objACL, objACE 'Set the primäry Account to SELF objUser.Put "msExchMasterAccountSid", objUser.Get("objectSID") 'Get the mailbox security descriptor set objSD = objUser.Get("msExchMailboxSecurityDescriptor") set objACL = objSD.DiscretionaryAcl found = false for each objACE in objACL 'Iterate through the ACL to find the SELF-Account if objACE.Trustee = "SELF" Then found = true Exit For end if next if not found then 'If no SELF-Account is present, create it set objACE = CreateObject("AccessControlEntry") objace.Trustee = "SELF" objace.AceFlags = ADS_ACEFLAG_INHERIT_ACE objace.AceType = ADS_ACETYPE_ACCESS_ALLOWED objacl.addace objace end if 'Give the SELF-Account the External-Account right objace.AccessMask = objace.accessmask OR E2K_MB_READ_PERMISSIONS OR E2K_MB_FULL_MB_ACCESS OR E2K_MB_EXTERNAL_ACCOUNT 'Save the changes objUser.Put "msExchMailboxSecurityDescriptor", objSD objUser.setInfo end function sub writexslt(strfilename) dim txtxsl txtxsl = _ " " & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ "addself Status" & vbcrlf & _ "" & vbcrlf & _ "

addself 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 & _ "
name:dn:nt4domain:nt4User:age:status:action:
" & 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="" if isnull(wert) then wert = "" 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 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 & "