Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Extremely Difficult Question Only For the Brave!

Posted on 2009-05-05
12
Medium Priority
?
307 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 6
12 Comments
 
LVL 71

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
Nothing ever in the clear!

This technical paper will help you implement VMware’s VM encryption as well as implement Veeam encryption which together will achieve the nothing ever in the clear goal. If a bad guy steals VMs, backups or traffic they get nothing.

 
LVL 71

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 71

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 71

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 71

Accepted Solution

by:
Chris Dent earned 2000 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 71

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

Featured Post

Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Uncontrolled local administrators groups within any organization pose a huge security risk. Because these groups are locally managed it becomes difficult to audit and maintain them.
A bad practice commonly found during an account life cycle is to set its password to an initial, insecure password. The Password Reset Tool was developed to make the password reset process easier and more secure.
This tutorial will walk an individual through the process of configuring their Windows Server 2012 domain controller to synchronize its time with a trusted, external resource. Use Google, Bing, or other preferred search engine to locate trusted NTP …
Sometimes it takes a new vantage point, apart from our everyday security practices, to truly see our Active Directory (AD) vulnerabilities. We get used to implementing the same techniques and checking the same areas for a breach. This pattern can re…

636 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