Solved

Extremely Difficult Question Only For the Brave!

Posted on 2009-05-05
12
264 Views
Last Modified: 2012-05-06
I have a script that I'd like to run on an hourly basis.  This script when ran pulls all user objects in the Administrator OU in AD.  If a user account in this OUwas disabled and ends up enabled again, I like to catch this.    Better yet I'd like to catch this as well as the User that made the changes and what they changed exactly when they enabled the account.

Right now I have to rule out third party software to do this due to budget reasons and would like to accomplish this via this script that I have.  

THE CHALLENGE:
     I know that the information for these particular functions are located in my Authentications logs folder, they would show the User that made those changes as well as what was done, the million dollar question though is being able to tie the script in to this log to pull the info needed.

     Secondly, when the report is ran, let's say at 10am it shows JDOE user account is DISABLED, at 11am the report is ran again JDOE is now enabled.  Now imagine a thousand lines of users just like this.  I literally have to put 10AM report side-by-side with 11AM report and go down the list manually to see if there are any changes in status, then if detected go to the logs scan through those until I find the user and then look at what was changed, this takes an absurd amount of time.  Is there a way to make this all easier to detect any changes?

     AGAIN, I will not be able to employ third party ADMS software for this, it needs to be done via this script if at all doable.  Any suggestions are greatly appreciated SERIOUSLY!
       
0
Comment
Question by:itsmevic
  • 6
  • 6
12 Comments
 
LVL 70

Expert Comment

by:Chris Dent
ID: 24309077
Hey,

I'm sure we've had this discussion before ;)

It's all possible, but complexity increases with scale.

If you only had 1 - 5 DCs I'd say no bother, we can wack something together in a few hours that deals with this for you and provides pretty reports.

But if you have 50 - 100 DCs it's considerably harder because we would have to read the Security Log from each and every DC to get a clear picture of the changes.

If it is on the scale you need to pull your Security Logs into a database (without killing the DCs), maintain that database and pull the information you want from it on a regular basis. Again, scale is important.

Don't get me wrong, it's possible. But implementation might be the catch.

So, with that in mind. You mention 1000's of users. How many in total? How many Administrators? How many DCs? Do you have resources available to push this into a Database?

Chris
0
 

Author Comment

by:itsmevic
ID: 24309255
After speaking to one of the Senior Engineers that I work with here, he says this can be done and he basically mapped out what type of logic I would need for this script...I just need help putting this all together.  Below was his input on the logic of the script.  I've also attached my present script.

1.  Create an ADODB Disconnected Recordset OldRS 'record set
     a.  Two columns(1) - OldAccount and (2) entire rcord line (Oldline)
     b.  Load old text file into OldRS
     c.  Sort OldRS by OldAccount
     d.  Position to 1st record

2. Create an ADODB Disconnected Recordset NewRS
      a.  Two columns(1) -newAccount and (2) entire record line (NewLine)
      b.  Load old text file into NewRS
      c.  Sort NewRS by NewAccount
      d.  Position to 1st record

3.  Read next OldRS record

4.  Read next New RS record

5. If OldAccount = NewAccount then

          if Old Line = NewLine
                 (nothing has changed for this account, so move on)
                  Read next OldRS
                  Read next NewRS

          Else
   
                 This account has changed so write it out NewLine & ("Changed") to email file
                 Read next OldRS
                 Read next NewRS

         Else

                 If oldAccount < NewAccount (means OldAccount has been deleted)
 
                           Old account has been deleted so write it out OldLine & ("Deleted") to email file
                  Read next OldRS

         Else (means OldAccount > NewAccount means NewAccount has been added)

                  New account has been added so write it out NewLine & ("Added") to email file
                 Read next New RS

5.           Loop until both OldRS and NewRS are EOF

6.     Mail out mail file

7.   Delete oldfile

8 .  Rename newfile to oldfile (preparation for next run)

9.  Finish
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then

    strPath = Wscript.ScriptFullName

    strCommand = "%comspec% /k cscript  """ & strPath & """"

    Set objShell = CreateObject("Wscript.Shell")

    objShell.Run(strCommand), 1, True

    Wscript.Quit

End If

 

'/////////////////// Email variables/////////////////////////

strServer = "mailhost.test.com"

strTo = "jdoe@abc.com, jsmith@abc.com"

strFrom = "jdoe@abc.com"

strSubject = "Admin Accounts OU - Change Detected"

strBody = "Please see the change in user status accounts below:" & VbCrLf

 '///////////////////////////////////////////////////////////

Set objConnection = CreateObject("ADODB.Connection")

objConnection.Provider = "ADsDSOObject"

objConnection.Open("Ads Provider")

 

Set rsUsers = CreateObject("ADODB.Recordset")                                        

 

Set objRootDSE = GetObject("LDAP://RootDSE")

 

strLogFile = "\\my-server\logs\AdminStatus.log"

 

Set objFSO = CreateObject("Scripting.FileSystemObject")

Const intForReading = 1

 

Set dictPrevious = CreateObject("Scripting.Dictionary")

Set dictCurrent = CreateObject("Scripting.Dictionary")

 

' First read the previous status

If objFSO.FileExists(strLogFile) = True Then

        Set objFile = objFSO.OpenTextFile(strLogFile, intForReading, False)

        While Not objFile.AtEndOfStream

                strLine = objFile.ReadLine

                If Trim(strLine) <> "" Then

                dictPrevious.Add Split(strLine, ";")(0), Split(strLine, ";")(1)

                End If

        Wend

        objFile.Close

End If

 

strFilter = "(&(objectCategory=user))"

'strCmd = "<LDAP://OU=Administrators," & objRootDSE.Get("DefaultNamingContext") & ">;" & strFilter & ";adsPath;subtree"

strCmd = "<LDAP://OU=Administrators," & objRootDSE.Get("DefaultNamingContext") & ">;" & strFilter & ";adsPath;subtree"

               

Const ADS_UF_ACCOUNTDISABLE = 2

 

Set rsUsers = objConnection.Execute(strCmd)

'Loop through recordset to check the status

rsUsers.MoveFirst

While Not rsUsers.EOF

	WScript.Echo "About to bind to: " & rsUsers.fields("adsPath") & VbCrLf

	Set objUser = GetObject(rsUsers.fields("adsPath"))

	If objUser.Class = "user" Then

		On Error Resume Next

		intUAC = objUser.Get("userAccountControl")

		If Err.Number = 0 Then

			On Error GoTo 0

			If intUAC And ADS_UF_ACCOUNTDISABLE Then

				strStatus = "Disabled"

			Else

				strStatus = "Enabled"

			End If

			dictCurrent.Add objUser.AdsPath, strStatus

			If objFSO.FileExists(strLogFile) = True Then

				If dictPrevious.Exists(objUser.adsPath) = True Then

					If dictPrevious(objUser.adsPath) <> strStatus Then

						WScript.Echo objUser.DisplayName & " has been changed from " & dictPrevious(objUser.adsPath) & " to " & strStatus

						strBody = strBody & VbCrLf & objUser.DisplayName & " has been changed from " & dictPrevious(objUser.adsPath) & " to " & strStatus & vbCrLf

					End If

				End If

			End If

		Else

			Err.Clear

			On Error GoTo 0

			WScript.Echo "ERROR: Cannot read UserAccountControl for " & objUser.DisplayName

		End If

	End If

	rsUsers.MoveNext

Wend

 

'/////////////////////SENDS THE FILE///////////////////////////

SendEmail strServer, strTo, strFrom, strSubject, strMailBody, strLogFile

WScript.Echo "Email has been sent."

 

rsUsers.Close

objConnection.Close

' Now write the current status back to the log file

Set objFile = objFSO.CreateTextFile(strLogFile, True)

For Each strUser In dictCurrent

        objFile.WriteLine strUser & ";" & dictCurrent(strUser)

Next

objFile.Close

WScript.Echo "Script has finished. You can check the account status in " & strLogFile
 

'//////////////////////////////////////////////////////MAIL FUNCTION///////////////////////////////////////////////////////// 

Sub SendEmail(SMTPSrvIP, ToField, FromField, SubjectField, TextField, Attachment)

     

     Set objEmail = CreateObject("CDO.Message")
 

     objEmail.From = FromField

     objEmail.To = ToField

	 objEmail.Subject = SubjectField

     objEmail.Textbody = TextField
 

     If ucase(Attachment) <> "NONE" Then

     objEmail.AddAttachment Attachment

     End If
 

     objEmail.Configuration.Fields.Item _

	("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Use 1 for local SMTP

     objEmail.Configuration.Fields.Item _

	("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPSrvIP

     objEmail.Configuration.Fields.Item _

	("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'Modify this to the correct port number

     objEmail.Configuration.Fields.Update
 

     objEmail.Send
 

End Sub

'////////////////////////////////////////////////////END MAIL FUNCTION//////////////////////////////////////////////////////////

Open in new window

0
 

Author Comment

by:itsmevic
ID: 24309272
Chris I think you confused this question with another question I had on writing a script for Service Accounts and checking for change to them by Administrators.  This question deals with my Administrators OU only and looks at accts that are disabled but have been re-enabled.  This script would catch that.
0
 
LVL 70

Expert Comment

by:Chris Dent
ID: 24309336

It's the same way I would approach that part. I've done similar for monitoring trust relationships in a forest. It's perhaps worth popping that in here for the similarity in approach.

One of the most notable differences that updates to the stored data must be manually initiated (because in this case I wouldn't expect a high rate of change).

In short it does the following:

1. Gets a file, reading the contents into a Dictionary Object (as above)
2. Reads the details from AD
3. Compare the two data sets
4. If a trust has been created or removed, notify admin

Chris
Option Explicit

 

' Script to get trusts, compare with stored configuration and notify if changed

 

Sub ShowUsage

  Dim strUsage : strUsage = "Usage:" & vbCrLf & vbCrLf

  strUsage = strUsage & WScript.ScriptName & " /Command:[Update | Notify] [/MailServer:<ServerName>] [/Recipient:<Address>]" & vbCrLf

  strUsage = strUsage & vbCrLf

  strUsage = strUsage & "Arguments:" & vbCrLf & vbCrlf

  strUsage = strUsage & "    Command      Update - Updates the contents of the text file with data from the global catalog" & vbCrLf

  strUsage = strUsage & "                 Notify - Notifies the recipient using mailserver if the trust data changes" & vbCrLf

  strUsage = strUsage & "    MailServer   Server used to send mail. Defaults is localhost" & vbCrLf

  strUsage = strUsage & "    Recipient    Email address of person or group to notify" & vbCrLf

 

  WScript.Echo strUsage

  WScript.Quit

End Sub

 

Function GetTrusts

  ' Returns a Scripting.Dictionary object containing details of the Trust

  ' Format:

  ' Key: DistinguishedName

  ' Data: Array( Trusted Domain, Type, Attributes, Direction, Partner, Created, Changed )

 

  Const ADS_SCOPE_SUBTREE = 2

 

  ' Trust Type - http://msdn.microsoft.com/en-us/library/cc223771(PROT.10).aspx

  Dim objTrustTypes : Set objTrustTypes = CreateObject("Scripting.Dictionary")

  objTrustTypes.Add 4, "DCE"

  objTrustTypes.Add 3, "MIT"

  objTrustTypes.Add 2, "UpLevel"

  objTrustTypes.Add 1, "DownLevel"

 

  ' Trust Attributes - http://msdn.microsoft.com/en-us/library/cc223779(PROT.10).aspx

  Dim objTrustAttributes : Set objTrustAttributes = CreateObject("Scripting.Dictionary")

  objTrustAttributes.Add 128, "UsesRC4Encryption"

  objTrustAttributes.Add 64, "TreatAsExternal"

  objTrustAttributes.Add 32, "WithinForest"

  objTrustAttributes.Add 16, "CrossOrganisation"

  objTrustAttributes.Add 8, "ForestTransitive"

  objTrustAttributes.Add 4, "QuarantinedDomain"

  objTrustAttributes.Add 2, "UpLevelOnly"

  objTrustAttributes.Add 1, "NonTransitive"

 

  ' Trust Direction - http://msdn.microsoft.com/en-us/library/cc223768(PROT.10).aspx

  Dim objTrustDirection : Set objTrustDirection = CreateObject("Scripting.Dictionary")

  objTrustDirection.Add 3, "BiDirectional"

  objTrustDirection.Add 2, "Outbound"

  objTrustDirection.Add 1, "Inbound"

  objTrustDirection.Add 0, "Disabled"

 

  Dim objConnection : Set objConnection = CreateObject("ADODB.Connection")

  objConnection.Provider = "ADsDSOObject"

  objConnection.Open "Active Directory Provider"

 

  Dim objCommand : Set objCommand = CreateObject("ADODB.Command")

  objCommand.ActiveConnection = objConnection

 

  Dim objRootDSE : Set objRootDSE = GetObject("LDAP://RootDSE")

  objCommand.CommandText = "SELECT distinguishedName, name, trustType, trustAttributes, trustDirection, " & _

    "trustPartner, whenCreated, whenChanged FROM 'GC://" & objRootDSE.Get("rootDomainNamingContext") & _

    "' WHERE objectClass='trustedDomain'"

  Set objRootDSE = Nothing

 

  objCommand.Properties("Page Size") = 1000

  objCommand.Properties("Timeout") = 600

  objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

  objCommand.Properties("Cache Results") = False

 

  Dim objRecordSet : Set objRecordSet = objCommand.Execute

 

  Dim objTrusts : Set objTrusts = CreateObject("Scripting.Dictionary")

 

  While Not objRecordSet.EOF

    Dim dblFlag

    Dim strAttributes : strAttributes = ""

    For Each dblFlag in objTrustAttributes

      If objRecordSet.Fields("trustAttributes").Value And dblFlag Then

        strAttributes = strAttributes & objTrustAttributes(dblFlag) & " "

      End If

    Next

 

    objTrusts.Add objRecordSet.Fields("distinguishedName").Value, Array( _

      objRecordSet.Fields("name").Value, _

      objTrustTypes(objRecordSet.Fields("trustType").Value), _

      strAttributes, _

      objTrustDirection(objRecordSet.Fields("trustDirection").Value), _

      objRecordSet.Fields("trustPartner").Value, _

      objRecordSet.Fields("whenCreated").Value, _

      objRecordSet.Fields("whenChanged").Value)

 

    objRecordSet.MoveNext

  Wend

 

  objConnection.Close

 

  Set objRecordSet = Nothing

  Set objCommand = Nothing

  Set objConnection = Nothing

 

  Set GetTrusts = objTrusts

End Function

 

Sub SendMail(strRecipient, strBody, strMailServer)

 

  Dim objMail : Set objMail = CreateObject("CDO.Message")

  objMail.Subject = "Trust monitor"

 

  objMail.From = strRecipient

  objMail.To = strRecipient

 

  objMail.TextBody = strBody

 

  objMail.Configuration.Fields.Item _

    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

  objMail.Configuration.Fields.Item _

    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strMailServer

  objMail.Configuration.Fields.Item _

    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

 

  objMail.Configuration.Fields.Update

  objMail.Send

End Sub

 

'

' Main Code

'

 

Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")

Dim objFile

 

Dim objTrusts : Set objTrusts = GetTrusts

 

If LCase(WScript.Arguments.Named("command")) = "update" Then

  Set objFile = objFileSystem.OpenTextFile("Trusts.txt", 2, True, 0)

 

  Dim strDN

  For Each strDN in objTrusts

    objFile.WriteLine strDN & vbTab & Join(objTrusts(strDN), vbTab)

  Next

 

ElseIf LCase(WScript.Arguments.Named("command")) = "notify" Then

 

  Dim strRecipient : strRecipient = WScript.Arguments.Named("recipient")

 

  If strRecipient = "" Then

    WScript.Echo "ERROR: No recipient defined"

    ShowUsage

  End If

 

  Dim strMailServer : strMailServer = WScript.Arguments.Named("mailserver")

 

  If strMailServer = "" Then

    strMailServer = "localhost"

  End If

 

  Dim objTrustsInFile : Set objTrustsInFile = CreateObject("Scripting.Dictionary")

 

  If objFileSystem.FileExists("Trusts.txt") Then

    Set objFile = objFileSystem.OpenTextFile("Trusts.txt", 1, False, 0)

 

    Dim arrTrustData()

    Do While Not objFile.AtEndOfStream

      Dim arrTrustInFile : arrTrustInFile = Split(objFile.ReadLine, vbTab)

 

      ReDim arrTrustData(0)

      Dim i

      For i = 1 to UBound(arrTrustInFile)

        ReDim Preserve arrTrustData(i - 1)

        arrTrustData(i - 1) = arrTrustInFile(i)

      Next

 

      objTrustsInFile.Add arrTrustInFile(0), arrTrustData

    Loop

  End If

 

  Dim strTrust

 

  ' Comparison - Check for new Trusts

 

  Dim objNewTrusts : Set objNewTrusts = CreateObject("Scripting.Dictionary")

 

  For Each strTrust in objTrusts

    If Not objTrustsInFile.Exists(strTrust) Then

      objNewTrusts.Add strTrust, objTrusts(strTrust)

    End If      

  Next

 

  ' Comparison - Check for removed Trusts

 

  Dim objRemovedTrusts : Set objRemovedTrusts = CreateObject("Scripting.Dictionary")

 

  For Each strTrust in objTrustsInFile

    If Not objTrusts.Exists(strTrust) Then

      objRemovedTrusts.Add strTrust, objTrustsInFile(strTrust)

    End If

  Next

 

  ' Data: Array( Trusted Domain, Type, Attributes, Direction, Partner, Created, Changed )

 

  Dim strMessageBody

  Dim booNotify : booNotify = False

  If objNewTrusts.Count > 0 Then

    booNotify = True

    strMessageBody = "New Trusts:" & vbCrLf & vbCrLf

    For Each strTrust in objNewTrusts

      strMessageBody = strMessageBody & "DN: " & strTrust & vbCrLf & _

        "Trusted Domain: " & objNewTrusts(strTrust)(0) & vbCrLf & _

        "Type: " & objNewTrusts(strTrust)(1) & vbCrLf & _

        "Attributes: " & objNewTrusts(strTrust)(2) & vbCrLf & _

        "Direction: " & objNewTrusts(strTrust)(3) & vbCrLf & _

        "Partner: " & objNewTrusts(strTrust)(4) & vbCrLf & _

        "Created: " & objNewTrusts(strTrust)(5) & vbCrLf & _

        "Changed: " & objNewTrusts(strTrust)(6) & vbCrLf & vbCrLf

    Next

  End If

  If objRemovedTrusts.Count > 0 Then

    booNotify = True

    For Each strTrust in objRemovedTrusts

      strMessageBody = strMessageBody & "DN: " & strTrust & vbCrLf & _

        "Trusted Domain: " & objRemovedTrusts(strTrust)(0) & vbCrLf & _

        "Type: " & objRemovedTrusts(strTrust)(1) & vbCrLf & _

        "Attributes: " & objRemovedTrusts(strTrust)(2) & vbCrLf & _

        "Direction: " & objRemovedTrusts(strTrust)(3) & vbCrLf & _

        "Partner: " & objRemovedTrusts(strTrust)(4) & vbCrLf & _

        "Created: " & objRemovedTrusts(strTrust)(5) & vbCrLf & _

        "Changed: " & objRemovedTrusts(strTrust)(6) & vbCrLf & vbCrLf

    Next

  End If

  If booNotify = True Then

    strMessageBody = strMessageBody & "If these trusts are correct please run " & WScript.ScriptName & " /Command:Update"

 

    SendMail strRecipient, strMessageBody, strMailServer

  End If

Else

 

  ShowUsage

 

End If

Open in new window

0
 
LVL 70

Expert Comment

by:Chris Dent
ID: 24309358

I associated it with the other question because of this:

>  I know that the information for these particular functions are located in
> my Authentications logs folder, they would show the User that made those
> changes as well as what was done, the million dollar question though is being
> able to tie the script in to this log to pull the info needed.

Notifications for changes in account status, no problem at all. That's actually nice and easy.

Who caused the change in state is hard. That ties into the Security Logs in exactly the same way as would have had to be done to capture where Service Accounts are being used. Different Events, same approach applies.

Chris
0
 

Author Comment

by:itsmevic
ID: 24309483
Wow that's a monster of a script...geez.
0
 

Author Comment

by:itsmevic
ID: 24309506
I'm just studying over the script you provided me, trying to soak as much of this stuff up as possible.  I've been tasked with writing an array of scripts and just having basic scripting knowledge you can imagine the load I'm feeling right now.  
0
 
LVL 70

Expert Comment

by:Chris Dent
ID: 24309532

Yeah, I can :) But I'm more than happy to help you put it together (although not tonight because it's almost time for bed ;)).

Anyway, the principals of the script above can be applied here, I'll modify it for monitoring accounts tomorrow morning and then we can have a play and see how to make it pretty.

Chris
0
 

Author Comment

by:itsmevic
ID: 24309574
wow thanks a bunch Chris, I swear if you can pull something together and your local a Steak and Beer on me man fo sure !
0
 
LVL 70

Accepted Solution

by:
Chris Dent earned 500 total points
ID: 24314182

Here you go, this will give you something to play around with ;)

Chris


' Constants
 

' The path from the domain for the OU we're to check

Const RELATIVE_LDAP_PATH = "OU=Administrators"
 

' A filter for the serach

Const LDAP_FILTER = "(&(objectCategory=person)(objectClass=user))"
 

' The text file to read and store data in

Const FILE_NAME = "AccountState.txt"
 

' If you want the script to update the file at the end

Const UPDATE_FILE = True
 

' Mail Config

Const MAIL_TO = "jdoe@abc.com"

Const MAIL_SERVER = "mailhost.test.com"
 

' A set of moderately interesting account flags
 

Dim objAccountFlags : Set objAccountFlags = CreateObject("Scripting.Dictionary")

objAccountFlags.Add "AccountDisabled", 2

objAccountFlags.Add "AccountLocked", 16

objAccountFlags.Add "PasswordNotRequired", 32

objAccountFlags.Add "UserCannotChangePassword", 64  ' Here for reference, but cannot be detected using the method below. Requires ACL enumeration.

objAccountFlags.Add "StoreUsingReversibleEncryption", 128

objAccountFlags.Add "PasswordNeverExpires", 65536

objAccountFlags.Add "SmartCardRequired", 262144

objAccountFlags.Add "TrustedForDelegation", 524288

objAccountFlags.Add "CannotBeDelegated", 1048576

objAccountFlags.Add "UseDESEncryption", 2097152

objAccountFlags.Add "DoNotRequireKerberosPreAuth", 4194304

objAccountFlags.Add "PasswordExpired", 8388608
 

Function DirectorySearcher(strLdapPath, strLdapFilter, strPropertiesToLoad, strScope, strKey)

  ' Returns a dictionary object containing search results. Key is object distinguished name.
 

  Dim objConnection : Set objConnection = CreateObject("ADODB.Connection")

  objConnection.Provider = "ADsDSOObject"

  objConnection.Open "Active Directory Provider"
 

  On Error Resume Next : Err.Clear

  Dim objRecordSet : Set objRecordSet = objConnection.Execute("<" & strLdapPath & ">;" & _

    strLdapFilter & ";" & strPropertiesToLoad & ";" & strScope)

  If Err.Number <> 0 Then

    WScript.Echo "ERROR: Failed to connect to specified DC"

    WScript.Quit

  End If

  On Error Goto 0
 

  Dim arrPropertiesToLoad : arrPropertiesToLoad = Split(strPropertiesToLoad, ",")
 

  Dim objSearchResults : Set objSearchResults = CreateObject("Scripting.Dictionary")

  objSearchResults.CompareMode = vbTextCompare
 

  Dim strValues()

  Do Until objRecordSet.EOF

    Dim strProperty, strValue : Dim i : i = 0

    For Each strProperty in arrPropertiesToLoad

      If IsNull(objRecordSet.Fields(strProperty)) Then

        strValue = ""

      Else

        strValue = objRecordSet.Fields(strProperty).Value

        If IsArray(strValue) Then

          strValue = Join(strValue, ";")

        End If

      End If

      ReDim Preserve arrValues(i)

      arrValues(i) = strValue : i = i + 1

    Next
 

    objSearchResults.Add objRecordSet.Fields(strKey).Value, arrValues
 

    objRecordSet.MoveNext

  Loop
 

  Set DirectorySearcher = objSearchResults

End Function
 

Function LoadStateFile(strFileName)

  ' Returns a Dictionary Object containing file data
 

  Dim objFileData : Set objFileData = CreateObject("Scripting.Dictionary")

  objFileData.CompareMode = vbTextCompare
 

  Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")

  ' Open the Text File for reading

  If objFSO.FileExists(strFileName) Then
 

    Dim objFile : Set objFile = objFSO.OpenTextFile(strFileName, 1, False, 0)
 

    Do While Not objFile.AtEndOfStream

      Dim strLine : strLine = objFile.ReadLine

      If Trim(strLine) <> "" Then

        ' Assuming Tab Delimited input. About the easiest for VbScript to deal with.

        Dim arrLine : arrLine = Split(strLine, vbTab)
 

        ' Data format is this:

        ' <DN>    <Name>    <userAccountControl (Numeric)>    <memberOf (; delimited)>

        ' Loading this as it exists will exactly match the results of the AD search
 

        objFileData.Add arrLine(0), arrLine

      End If

    Loop

  End If
 

  Set LoadStateFile = objFileData

End Function
 

Function GenerateStateChangeReport(objPreviousState, objCurrentState)

  ' Builds a report detailing changes in accounts (if any)
 

  Dim strHeader : strHeader = "Account Status Report " & Now & vbCrLf & vbCrLf & _

    "Number of Accounts in File: " & objPreviousState.Count & vbCrLf & _

    "Number of Accounts in AD: " & objCurrentState.Count & vbCrLf & vbCrLf

  Dim strReport : strReport = ""
 

  ' Check for deleted accounts and changes in current account state
 

  Dim strDN : Dim intChanges : intChanges = 0

  For Each strDN in objPreviousState

    If objCurrentState.Exists(strDN) Then
 

      ' The account existed before. Check for changes.
 

      Dim i

      For i = 0 to UBound(objCurrentState(strDN))

        Dim strChagnedValue

        If CStr(objPreviousState(strDN)(i)) <> CStr(objCurrentState(strDN)(i)) Then
 

          ' Account property has changed for attribute "i"
 

          Select Case i

            Case 1 : strReport = strReport & "Name changed (" & strDN & "): From: " & _

              objPreviousState(strDN)(1) & " To: " & objCurrentState(strDN)(1) & vbCrLf
 

            Case 2 : strReport = strReport & "User Account Control changed (" & strDN & "): From: " & _

              objPreviousState(strDN)(2) & " To: " & objCurrentState(strDN)(2)
 

              Dim intUACDiff : intUACDiff = CDbl(objCurrentState(strDN)(2)) - CDbl(objPreviousState(strDN)(2))

              If intUACDiff < 0 Then

                strReport = strReport & " Flags Removed: "

              Else

                strReport = strReport & " Flags Added: "

              End If
 

              Dim strAccFlag : intUACDiff = Abs(intUACDiff)

              For Each strAccFlag in objAccountFlags

                If intUACDiff And objAccountFlags(strAccFlag) Then

                  strReport = strReport & " " & strAccFlag

                End If

              Next

              strReport = strReport & vbCrLf
 

            Case 3 : strReport = strReport & "Group Membership changed " & strDN & "):"
 

              Dim strGroup

              For Each strGroup in Split(objCurrentState(strDN)(3), ";")

                If InStr(objPreviousState(strDN)(3), strGroup) = 0 Then

                  strReport = strReport & " Added: " & strGroup

                End If

              Next
 

              For Each strGroup in Split(objPreviousState(strDN)(3), ";")

                If InStr(objCurrentState(strDN)(3), strGroup) = 0 Then

                  strReport = strReport & " Removed: " & strGroup

                End If

              Next

              strReport = strReport & vbCrLf
 

          End Select
 

        End If

      Next
 

    Else

      ' The account no longer exists. Notify.
 

      strReport = strReport & "Account Deleted or Removed from OU: " & strDN & vbCrLf
 

    End If

  Next
 

  ' Check for new accounts
 

  For Each strDN in objCurrentState

    ' Check for New Accounts and Notify
 

    If Not objPreviousState.Exists(strDN) Then

      strReport = strReport & "Account Added to OU: " & strDN & vbCrLf

    End If

  Next
 

  If strReport = "" Then strReport = "No Changes Found" & vbCrLf
 

  GenerateStateChangeReport = strHeader & strReport
 

End Function
 

Sub UpdateStateFile(strFileName, objCurrentState)
 

  Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")

  ' Open the Text File for writing

  Dim objFile : Set objFile = objFSO.OpenTextFile(strFileName, 2, True, 0)
 

  Dim strDN

  For Each strDN in objCurrentState

    objFile.WriteLine Join(objCurrentState(strDN), vbTab)

  Next
 

End Sub
 

Sub SendMail(strRecipient, strBody, strMailServer)

 

  Dim objMail : Set objMail = CreateObject("CDO.Message")

  objMail.Subject = "Admin Accounts OU - Change Detected"

 

  objMail.From = strRecipient

  objMail.To = strRecipient

 

  objMail.TextBody = strBody

 

  objMail.Configuration.Fields.Item _

    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

  objMail.Configuration.Fields.Item _

    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strMailServer

  objMail.Configuration.Fields.Item _

    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

 

  objMail.Configuration.Fields.Update

  objMail.Send

End Sub

 
 

Dim objRootDSE : Set objRootDSE = GetObject("LDAP://RootDSE")

Dim strLdapPath : strLdapPath = "LDAP://" & RELATIVE_LDAP_PATH & "," & objRootDSE.Get("defaultNamingContext")
 

' Get the details of each user from AD

' This will create a Scripting.Dictionary Object with the following data structure:

' Key: <DN>. Value: Array(<DN>, <Name>, <userAccountControl (Numeric)>, <memberOf (; delimited)>
 

Dim objCurrentState : Set objCurrentState = DirectorySearcher(strLdapPath, LDAP_FILTER, _

  "distinguishedName,name,userAccountControl,memberOf", "subtree", "distinguishedName")
 

' Load the text file containing the previous user status
 

Dim objPreviousState : Set objPreviousState = LoadStateFile(FILE_NAME)
 

Dim strReport : strReport = GenerateStateChangeReport(objPreviousState, objCurrentState)
 

If UPDATE_FILE = True Then

  UpdateStateFile FILE_NAME, objCurrentState

End If
 

SendMail MAIL_TO, strReport, MAIL_SERVER

Open in new window

0
 

Author Comment

by:itsmevic
ID: 24327960
I ran the script, it produces a pretty cool little report.  Could you break down exactly what it reports?  
0
 
LVL 70

Expert Comment

by:Chris Dent
ID: 24358614

Sorry I completely missed your reply. Sure I can break it down a bit more. This is an excessively commented version :)

Chris
' Constants

 

' The path from the domain for the OU we're to check

Const RELATIVE_LDAP_PATH = "OU=Administrators"

 

' A filter for the serach

Const LDAP_FILTER = "(&(objectCategory=person)(objectClass=user))"

 

' The text file to read and store data in

Const FILE_NAME = "AccountState.txt"

 

' If you want the script to update the file at the end

Const UPDATE_FILE = True

 

' Mail Config

Const MAIL_TO = "jdoe@abc.com"

Const MAIL_SERVER = "mailhost.test.com"

 

' A set of moderately interesting account flags

' These flags are used within the userAccountControl attribute

 

Dim objAccountFlags : Set objAccountFlags = CreateObject("Scripting.Dictionary")

objAccountFlags.Add "AccountDisabled", 2

objAccountFlags.Add "AccountLocked", 16

objAccountFlags.Add "PasswordNotRequired", 32

objAccountFlags.Add "UserCannotChangePassword", 64  ' Here for reference, but cannot be detected using the method below. Requires ACL enumeration.

objAccountFlags.Add "StoreUsingReversibleEncryption", 128

objAccountFlags.Add "PasswordNeverExpires", 65536

objAccountFlags.Add "SmartCardRequired", 262144

objAccountFlags.Add "TrustedForDelegation", 524288

objAccountFlags.Add "CannotBeDelegated", 1048576

objAccountFlags.Add "UseDESEncryption", 2097152

objAccountFlags.Add "DoNotRequireKerberosPreAuth", 4194304

objAccountFlags.Add "PasswordExpired", 8388608

 

Function DirectorySearcher(strLdapPath, strLdapFilter, strPropertiesToLoad, strScope, strKey)

  ' Returns a dictionary object containing search results.
 

  ' Create an instance of ADODB Connection. We'll use this to

  ' connect to Active Directory so we can search. 

  Dim objConnection : Set objConnection = CreateObject("ADODB.Connection")

  objConnection.Provider = "ADsDSOObject"

  objConnection.Open "Active Directory Provider"
 

  ' Allow the code to carry on even if there's a fatal error. We'll handle

  ' the error ourselves. 

  On Error Resume Next : Err.Clear

  Dim objRecordSet : Set objRecordSet = objConnection.Execute("<" & strLdapPath & ">;" & _

    strLdapFilter & ";" & strPropertiesToLoad & ";" & strScope)

  If Err.Number <> 0 Then

    ' If the error number is not 0 something went wrong. Probably failure to connect

    ' to the LDAP path.
 

    WScript.Echo "ERROR: Failed to connect to specified DC"

    WScript.Quit

  End If

  ' Change back to no error handling. The script will terminate if it encounters

  ' an error.

  On Error Goto 0
 

  ' Create an array from the PropertiesToLoad list (comma delimited list)

  Dim arrPropertiesToLoad : arrPropertiesToLoad = Split(strPropertiesToLoad, ",")

 

  ' Create a Dictionary object to store data in

  Dim objSearchResults : Set objSearchResults = CreateObject("Scripting.Dictionary")

  ' Not really necessary here, but switch to Text Comparison instead of Binary.

  ' With Binary any comparison is case sensitive. 

  objSearchResults.CompareMode = vbTextCompare

 

  Dim arrValues()

  Do Until objRecordSet.EOF

    ' Start looping through the records

    Dim strProperty, strValue : Dim i : i = 0

    ' For each of the Properties we've chosen to return

    For Each strProperty in arrPropertiesToLoad

      ' Check it has a value

      If IsNull(objRecordSet.Fields(strProperty)) Then

        ' If it doesn't set it to blank 

        strValue = ""

      Else

        ' And if it does, hold onto it

        strValue = objRecordSet.Fields(strProperty).Value

        ' Some attributes are arrays

        If IsArray(strValue) Then

          ' If it is, Join it together into a string

          strValue = Join(strValue, ";")

        End If

      End If

      ' Increase the size of the array by one

      ReDim Preserve arrValues(i)

      ' Add the value we got to the array.

      arrValues(i) = strValue : i = i + 1

    Next

    ' Add the object and add the values to the Dictionary.

    objSearchResults.Add objRecordSet.Fields(strKey).Value, arrValues

    ' Move to the next record (otherwise we'd loop forever)

    objRecordSet.MoveNext

  Loop
 

  ' Return the results to the main code 

  Set DirectorySearcher = objSearchResults

End Function

 

Function LoadStateFile(strFileName)

  ' Returns a Dictionary Object containing file data

 

  Dim objFileData : Set objFileData = CreateObject("Scripting.Dictionary")

  objFileData.CompareMode = vbTextCompare

 

  Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")

  ' Check the file exists

  If objFSO.FileExists(strFileName) Then

 

    ' Open the file for reading (1), set overwrite to False, and open in ASCII mode (0)

    Dim objFile : Set objFile = objFSO.OpenTextFile(strFileName, 1, False, 0)

 

    ' DO until we run out of file to read

    Do While Not objFile.AtEndOfStream

      Dim strLine : strLine = objFile.ReadLine

      ' Make sure the line isn't blank

      If Trim(strLine) <> "" Then

        ' Assuming Tab Delimited input. About the easiest for VbScript to deal with.

        Dim arrLine : arrLine = Split(strLine, vbTab)

 

        ' Data format is this:

        ' <DN>    <Name>    <userAccountControl (Numeric)>    <memberOf (; delimited)>

        ' Loading this as it exists will exactly match the results of the AD search

 

        objFileData.Add arrLine(0), arrLine

      End If

    Loop

  End If

 

  ' Return the state file contents to the main code

  Set LoadStateFile = objFileData

End Function

 

Function GenerateStateChangeReport(objPreviousState, objCurrentState)

  ' Builds a report detailing changes in accounts (if any)

 

  ' Start creating the report. Make the header line with a bit of a summary.

  Dim strHeader : strHeader = "Account Status Report " & Now & vbCrLf & vbCrLf & _

    "Number of Accounts in File: " & objPreviousState.Count & vbCrLf & _

    "Number of Accounts in AD: " & objCurrentState.Count & vbCrLf & vbCrLf

  Dim strReport : strReport = ""

 

  ' Check for deleted accounts and changes in current account state

 

  Dim strDN : Dim intChanges : intChanges = 0

  For Each strDN in objPreviousState

    ' If the account in our recorded state still exists...

    If objCurrentState.Exists(strDN) Then

 

      ' The account existed before. Check for changes.

 

      Dim i

      For i = 0 to UBound(objCurrentState(strDN))

        Dim strChagnedValue

        ' Text comparison, because not all fields are text we need this to be a 

        ' uniform comparison. Text 1 is not equal to Integer 1.

        If CStr(objPreviousState(strDN)(i)) <> CStr(objCurrentState(strDN)(i)) Then

 

          ' Account property has changed for attribute "i"

 

          Select Case i

            Case 1 : strReport = strReport & "Name changed (" & strDN & "): From: " & _

              objPreviousState(strDN)(1) & " To: " & objCurrentState(strDN)(1) & vbCrLf

 

            Case 2 : strReport = strReport & "User Account Control changed (" & strDN & "): From: " & _

              objPreviousState(strDN)(2) & " To: " & objCurrentState(strDN)(2)

 

              Dim intUACDiff : intUACDiff = CDbl(objCurrentState(strDN)(2)) - CDbl(objPreviousState(strDN)(2))

              If intUACDiff < 0 Then

                strReport = strReport & " Flags Removed: "

              Else

                strReport = strReport & " Flags Added: "

              End If

 

              ' Abs returns the Absolute number. No positive or negative.

              Dim strAccFlag : intUACDiff = Abs(intUACDiff)

              For Each strAccFlag in objAccountFlags

                ' Bitwise comparison. If userAccountControl has the flag...

                If intUACDiff And objAccountFlags(strAccFlag) Then

                  strReport = strReport & " " & strAccFlag

                End If

              Next

              strReport = strReport & vbCrLf

 

            Case 3 : strReport = strReport & "Group Membership changed " & strDN & "):"

 

              ' memberOf is a list of distinguishedName's for groups

              ' See if any groups have been added

              Dim strGroup

              For Each strGroup in Split(objCurrentState(strDN)(3), ";")

                If InStr(objPreviousState(strDN)(3), strGroup) = 0 Then

                  strReport = strReport & " Added: " & strGroup

                End If

              Next

 

              ' And see if any have been removed

              For Each strGroup in Split(objPreviousState(strDN)(3), ";")

                If InStr(objCurrentState(strDN)(3), strGroup) = 0 Then

                  strReport = strReport & " Removed: " & strGroup

                End If

              Next

              strReport = strReport & vbCrLf

 

          End Select

 

        End If

      Next

 

    Else

      ' The account no longer exists. Notify.

 

      strReport = strReport & "Account Deleted or Removed from OU: " & strDN & vbCrLf

 

    End If

  Next

 

  ' Check for new accounts

 

  For Each strDN in objCurrentState

    ' Check for New Accounts and Notify

 

    If Not objPreviousState.Exists(strDN) Then

      strReport = strReport & "Account Added to OU: " & strDN & vbCrLf

    End If

  Next

 

  If strReport = "" Then strReport = "No Changes Found" & vbCrLf

 

  ' Return the report to the main code

  GenerateStateChangeReport = strHeader & strReport

 

End Function

 

Sub UpdateStateFile(strFileName, objCurrentState)

  ' Write the current state back to the state file 
 

  Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")

  ' Open the Text File for writing

  Dim objFile : Set objFile = objFSO.OpenTextFile(strFileName, 2, True, 0)

 

  Dim strDN

  For Each strDN in objCurrentState

    objFile.WriteLine Join(objCurrentState(strDN), vbTab)

  Next

 

End Sub

 

Sub SendMail(strRecipient, strBody, strMailServer)

  ' Send a mail with the report
 

  Dim objMail : Set objMail = CreateObject("CDO.Message")

  objMail.Subject = "Admin Accounts OU - Change Detected"

 

  objMail.From = strRecipient

  objMail.To = strRecipient

 

  objMail.TextBody = strBody

 

  objMail.Configuration.Fields.Item _

    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

  objMail.Configuration.Fields.Item _

    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strMailServer

  objMail.Configuration.Fields.Item _

    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

 

  objMail.Configuration.Fields.Update

  objMail.Send

End Sub
 

'

' Main code

'
 

' Connect to the Root DSA Specific Entry which holds information

' about the directory

Dim objRootDSE : Set objRootDSE = GetObject("LDAP://RootDSE")

' Take the hard-coded Relative LDAP Path and add on the LDAP path for the

' current domain.

Dim strLdapPath : strLdapPath = "LDAP://" & RELATIVE_LDAP_PATH & "," & objRootDSE.Get("defaultNamingContext")

 

' Get the details of each user from AD

' This will create a Scripting.Dictionary Object with the following data structure:

' Key: <DN>. Value: Array(<DN>, <Name>, <userAccountControl (Numeric)>, <memberOf (; delimited)>

 

Dim objCurrentState : Set objCurrentState = DirectorySearcher(strLdapPath, LDAP_FILTER, _

  "distinguishedName,name,userAccountControl,memberOf", "subtree", "distinguishedName")

 

' Load the text file containing the previous user status
 

Dim objPreviousState : Set objPreviousState = LoadStateFile(FILE_NAME)
 

' Compare the two saved States and report on changes.

 

Dim strReport : strReport = GenerateStateChangeReport(objPreviousState, objCurrentState)

 

If UPDATE_FILE = True Then

  ' Overwrite the existing state file with any changes

  UpdateStateFile FILE_NAME, objCurrentState

End If

 

' Send an email notification of the changes.

SendMail MAIL_TO, strReport, MAIL_SERVER

Open in new window

0

Join & Write a Comment

Restoring deleted objects in Active Directory has been a standard feature in Active Directory for many years, yet some admins may not know what is available.
Is your Office 365 signature not working the way you want it to? Are signature updates taking up too much of your time? Let's run through the most common problems that an IT administrator can encounter when dealing with Office 365 email signatures.
This tutorial will walk an individual through the steps necessary to join and promote the first Windows Server 2012 domain controller into an Active Directory environment running on Windows Server 2008. Determine the location of the FSMO roles by lo…
This tutorial will walk an individual through the process of transferring the five major, necessary Active Directory Roles, commonly referred to as the FSMO roles to another domain controller. Log onto the new domain controller with a user account t…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now