Mass user account audit

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Mass user account audit > database

Logged in as: Guest

arrSession:exec spGetSession 2,16,38625

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Mass user account audit > database
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Mass user account audit > database - 10/12/2006 12:10:47 AM

Meg

Posts: 126
Score: 2
Joined: 7/13/2006
From: Australia
Status: offline

After writing http://www.visualbasicscript.com/m_38622/mpage_1/key_/tm.htm#38622 I found many user accounts did not have correct settings because they had been edited manually or missed.

1. Script does a check to see it is not being run from a place where it will fail.
2. Checks if an output database exists and if not creates one
3. Enumerates all users in AD
4. If user name is our standard 3 character format continue
5. Read specific properties from that user account
6. Save output to an Access Database

Powerful thing about this script is that the massive amount of data it can output is in a format which can be queried and sorted and user accounts of interest can be saved as a txt file to be processed by another script.
I should have done it in the main script to filter out accounts in the trash/resource OUs but Access can easily do that in using a query in the database. Once the database queries have been setup you can run the script (takes about 5 minutes for ~1500 users) and at a glance check for obvious configuration problems.

'Script by MJP 2006
'Need to audit all user accounts on domain to see what property settings_ 
'they have relating to the new XP SOE currently being rolled out.
'This information is saved into a database from which queries can be made_ 
'to determine which accounts need to be corrected.  .
'i.e. many users are not in required groups or are missing roaming profile paths
'Usage:-
'Query all user accounts in AD
'Double click on script. 
'Script output is stored in a database "AuditUserPropSUP.mdb"

'Main code
'---------------------------------------
OSType
DBCreateA
' Use ADO to search the domain for all users. 
Set objConnection = CreateObject("ADODB.Connection") 
Set objCommand = CreateObject("ADODB.Command") 
objConnection.Provider = "ADsDSOOBject" 
objConnection.Open "Active Directory Provider" 
Set objCommand.ActiveConnection = objConnection 
' Determine the DNS domain from the RootDSE object. 
Set objRootDSE = GetObject("LDAP://RootDSE") 
strDNSDomain = objRootDSE.Get("defaultNamingContext") 
' Search the entire domain. 
strBase = "<LDAP://" & strDNSDomain & ">" 
' Filter on all user objects. 
strFilter = "(&(objectCategory=person)(objectClass=user))" 
' List of attribute values to retrieve. 
strAttributes = "sAMAccountName, distinguishedName" 
' Create the ADO query using LDAP syntax. 
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" 
' Run the query. 
objCommand.CommandText = strQuery 
objCommand.Properties("Page Size") = 100 
objCommand.Properties("Timeout") = 30 
objCommand.Properties("Cache Results") = False 
' Enumerate the recordset and retrieve attribute values. 
Set objRecordSet = objCommand.Execute 
Do Until objRecordSet.EOF 
   
   strName = objRecordSet.Fields("sAMAccountName").Value
   ADPath = objRecordSet.Fields("distinguishedName").Value

If MYUserAccount(strName)=-1 Then 'Only interested in user accounts exactly 3 characters long
   FieldA = strname
   FieldB = ADName(ADPath)
   FieldC = ADPath
   FieldD = UserProfilePath(ADPath) 
FieldE = UserProfilePathTS(ADPath)

GroupA = "TS_Desktop_XP"
   FieldF = ReadGroup(GroupA, ADPath)
   
   GroupA = "TSDesktop" 
   FieldG = ReadGroup(GroupA, ADPath)
   
   GroupA = "TSUsers"  
   FieldH = ReadGroup(GroupA, ADPath)
       
   GroupA = "GinternetUsersXP" 
   FieldI = ReadGroup(GroupA, ADPath) 
   
   GroupA = "GinternetUsers"
   FieldJ = ReadGroup(GroupA, ADPath)
   
   GroupA = "Win2000Users" 
   FieldK = ReadGroup(GroupA, ADPath)
   
   GroupA = "WinXPUsers"  
   FieldL = ReadGroup(GroupA, ADPath) 
   
   FieldM = "Spare"
   FieldN = "Spare"
   FieldO = "Spare"

DatabaseUpdate FieldA, FieldB, FieldC, FieldD, FieldE, FieldF, FieldG, FieldH, FieldI, FieldJ, FieldK, FieldL, FieldM, FieldN, FieldO
End If

objRecordSet.MoveNext 
Loop 
objRecordset.Close 
objConnection.Close 
WScript.Echo "Finished"
WScript.Quit

'Functions
'---------------------------------------
'My MYUserAccount function
function MYUserAccount(var)
Set myRegExp = New RegExp
myRegExp.IgnoreCase = True
myRegExp.Pattern = "\b\w{3}\b"
MYUserAccount = myRegExp.test(var)
end Function
'---------------------------------------
'Create Database Function
Function DBCreateA
'Check if database exists
Set objFSOA = CreateObject("Scripting.FileSystemObject")
If objFSOA.FileExists(ScriptPath&"AuditUserPropSUP.mdb") Then
' Skip, the database has already been created (use the database just found)
Else
'Create Database
Set objConnectionA = CreateObject("ADOX.Catalog")
objConnectionA.Create _
   "Provider = Microsoft.Jet.OLEDB.4.0; " & _
       "Data Source = AuditUserPropSUP.mdb"
       
'Create table 
Set objConnectionA = CreateObject("ADODB.Connection")
objConnectionA.Open _
   "Provider= Microsoft.Jet.OLEDB.4.0; " & _
       "Data Source= AuditUserPropSUP.mdb" 
objConnectionA.Execute "CREATE TABLE AuditUserPropTable(" & _
   "UserName TEXT(50) ," & _
   "DisplayName TEXT(100) ," & _
   "ADPath TEXT(100) ," & _
   "ProfilePath TEXT(50) ," & _
   "TSProfilePath TEXT(50) ," & _
   "TS_Desktop_XP TEXT(50) ," & _
   "TSDesktop TEXT(50) ," & _
   "TSUsers TEXT(50) ," & _
   "GinternetUsersXP TEXT(50) ," & _
   "GinternetUsers TEXT(50) ," & _
   "Win2000Users TEXT(50) ," & _
   "WinXPUsers TEXT(50) ," & _
   "Spare1 TEXT(50) ," & _
   "Spare2 TEXT(50) ," & _
   "Spare3 TEXT(50))"
objConnectionA.Close  
End if
End Function        
'---------------------------------------
'Write to database function
Function DatabaseUpdate(FieldA, FieldB, FieldC, FieldD, FieldE, FieldF, FieldG, FieldH, FieldI, FieldJ, FieldK, FieldL, FieldM, FieldN, FieldO)
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3
Set objConnectionx = CreateObject("ADODB.Connection")
Set objRecordSetx = CreateObject("ADODB.Recordset")
'Check if user account has been added to database already
objConnectionx.Open _
   "Provider = Microsoft.Jet.OLEDB.4.0; " & _
       "Data Source = AuditUserPropSUP.mdb" 
objRecordSetx.Open "SELECT AuditUserPropTable.UserName FROM AuditUserPropTable WHERE (((AuditUserPropTable.UserName)="&Chr(34)&FieldA&Chr(34)&"))", _
       objConnectionx, adOpenStatic, adLockOptimistic
On Error Resume NEXT
objRecordSetx.MoveFirst
If objRecordsetx.Fields.Item("UserName")="" Then
On Error Goto 0
objRecordSetx.Close
'Add user account to database along with properties of interest
objRecordSetx.Open "SELECT * FROM AuditUserPropTable" , _
   objConnectionx, adOpenStatic, adLockOptimistic
objRecordSetx.AddNew
objRecordSetx("UserName") = FieldA
objRecordSetx("DisplayName") = FieldB
objRecordSetx("ADPath") = FieldC
objRecordSetx("ProfilePath") = FieldD
objRecordSetx("TSProfilePath") = FieldE
objRecordSetx("TS_Desktop_XP") = FieldF
objRecordSetx("TSDesktop") = FieldG
objRecordSetx("TSUsers") = FieldH
objRecordSetx("GinternetUsersXP") = FieldI
objRecordSetx("GinternetUsers") = FieldJ
objRecordSetx("Win2000Users") = FieldK
objRecordSetx("WinXPUsers") = FieldL
objRecordSetx("Spare1") = FieldM
objRecordSetx("Spare2") = FieldN
objRecordSetx("Spare3") = FieldO
objRecordSetx.Update
Else
'User Account is already in the database delete and re-add entry to avoid duplicates
On Error Goto 0
objRecordSetx.Close
'Delete database record
objRecordsetx.CursorLocation = adUseClient
objRecordSetx.Open "SELECT AuditUserPropTable.UserName FROM AuditUserPropTable WHERE (((AuditUserPropTable.UserName)="&Chr(34)&FieldA&Chr(34)&"))", _
       objConnectionx, adOpenStatic, adLockOptimistic
objRecordsetx.Delete
objRecordSetx.Close
'Add user account to database along with properties of interest
objRecordSetx.Open "SELECT * FROM AuditUserPropTable" , _
   objConnectionx, adOpenStatic, adLockOptimistic
objRecordSetx.AddNew
objRecordSetx("UserName") = FieldA
objRecordSetx("DisplayName") = FieldB
objRecordSetx("ADPath") = FieldC
objRecordSetx("ProfilePath") = FieldD
objRecordSetx("TSProfilePath") = FieldE
objRecordSetx("TS_Desktop_XP") = FieldF
objRecordSetx("TSDesktop") = FieldG
objRecordSetx("TSUsers") = FieldH
objRecordSetx("GinternetUsersXP") = FieldI
objRecordSetx("GinternetUsers") = FieldJ
objRecordSetx("Win2000Users") = FieldK
objRecordSetx("WinXPUsers") = FieldL
objRecordSetx("Spare1") = FieldM
objRecordSetx("Spare2") = FieldN
objRecordSetx("Spare3") = FieldO
objRecordSetx.Update
End IF
objRecordSetx.Close
objConnectionx.Close
End Function
'---------------------------------------
'Determine path script is running from
Function ScriptPath()
 ScriptPath = Left(WScript.ScriptFullName, _
   Len(WScript.ScriptFullName) - Len(WScript.ScriptName))
End Function
'--------------------------------------- 
'---------------------------------------
' Extract name from AD path
Function ADName(ADsPath)
Set objUser = GetObject ("LDAP://"&ADsPath)
ADName = objUser.displayName
End Function
'---------------------------------------
'Read Group Membership
Function ReadGroup(GroupA, ADsPath)
Set objGroupA = GetObject("LDAP://cn="& GroupA &",ou=Groups,dc=DOMAIN,dc=COM")
If objGroupA.IsMember("LDAP://"&ADsPath) Then
ReadGroup="Yes"
Else
ReadGroup="No"
End If
End function
'---------------------------------------
' Read Profile Path
Function UserProfilePath(ADsPath)
Set objUser = GetObject ("LDAP://"&ADsPath)
UserProfilePath = objUser.profilePath
End Function
'---------------------------------------
' Read TS Profile Path
Function UserProfilePathTS(ADsPath)
Set objUser = GetObject ("LDAP://"&ADsPath)
UserProfilePathTS = objUser.TerminalServicesProfilePath
End Function
'---------------------------------------
'---------------------------------------
Function OSType
'check OS is not xp - if it is then error bacause the TS-Profile part of the script can't run
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
For Each objOperatingSystem in colOperatingSystems
Caption= objOperatingSystem.Caption
OSType = objOperatingSystem.OSType
Next
'wscript.echo Caption
If Caption = "Microsoft Windows XP Professional" or Caption = "Microsoft Windows 2000 Server"Then 
WScript.echo "Please run script from a 2003 server"
WScript.quit
End If
End function
'---------------------------------------