Audit a registry key on all computers

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Audit a registry key on all computers > Database

Logged in as: Guest

arrSession:exec spGetSession 2,16,38618

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

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Audit a registry key on all computers > 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 >>

Audit a registry key on all computers > Database - 10/11/2006 10:55:42 PM

Meg

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

Tested only with XP

1. Checks for variable passed for one computer or
2. Enumerates all computers in domain
3. filters results and if that machine can be pinged
4. Retrieves specific registry key of remote computer
5. Output goes to an Access database for something different, allows script to be re-run periodically to add/update results as machines come online
6. Script creates database if it does not exist

'Script by MJP 2006
'Need to audit all computers on domain to see what font setting they have.
'This information will be used to add those machines to an SMS collection.
'Previously this font setting was done manually being set by an administrator.
'Now it is done via an MSI package for labour saving and quality control.
'Usage:-
'Query a specific computer
'cscript AuditRegistry.vbs c070001

'or
'Query all computers
'Just double click on it
'Script output is stored in a database "AuditRegistry.mdb"

dim return
'Ensure there is a database to write to.
DBCreateA
'Check if a "Computer Name" variable was passed to script
On Error Resume next
strComputer=WScript.Arguments.Item(0)
On Error Goto 0
If strComputer="" Then 
' No specific computer was specified, proceed to query all computers in domain
Else
FastPing(strComputer)
If return = "Success" Then
 RKV 'Query Registry Key Value function
End If
WScript.quit    
End If

' Enumerate All Computer Accounts in Active Directory
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = _
   "Select Name, Location from 'LDAP://DC=domain,DC=COM' " _
       & "Where objectClass='computer'"  
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
   strComputer = objRecordSet.Fields("Name").Value
   objRecordSet.MoveNext

'Check computer account is not one of those obsolite entries in AD
If Filters(strComputer) ="True" Then

'check if computer is "ON" add it's font setting to database file
FastPing(strComputer)
If return = "Success" Then
 RKV 'Query Registry Key Value function
End If
End If
Loop
WScript.Echo "Finished"
WScript.Quit

'---------------------------------------
'My fast ping function
Function FastPing(strComputer)
Set WshShell = WScript.CreateObject("WScript.Shell")
return = WshShell.Run("ping "&strComputer&" -n 1 -w 500", 0, true)
if return = 0 then 
return= "Success"
Else 
return = "Failure"
End if
End function
'---------------------------------------
'My Filter function
function Filters(var)
Set myRegExp = New RegExp
myRegExp.IgnoreCase = True
'Only looking for machines starting with C07 or C01
myRegExp.Pattern = "(^C07)|(^C01)"
Filters = myRegExp.test(var)
end function
'---------------------------------------
'Create Database Function
Function DBCreateA
'Check if database exists
Set objFSOA = CreateObject("Scripting.FileSystemObject")
If objFSOA.FileExists(ScriptPath&"AuditRegistry.mdb") Then
' Skip, the database has 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 = AuditRegistry.mdb"
       
'Create table 
Set objConnectionA = CreateObject("ADODB.Connection")
objConnectionA.Open _
   "Provider= Microsoft.Jet.OLEDB.4.0; " & _
       "Data Source= AuditRegistry.mdb" 
objConnectionA.Execute "CREATE TABLE AuditRegistryTable(" & _
   "MachineName TEXT(50) ," & _
   "FontSize TEXT(50))"
objConnectionA.Close  
End if
End Function        
'---------------------------------------        
'Determine path script is running from
Function ScriptPath()
 ScriptPath = Left(WScript.ScriptFullName, _
   Len(WScript.ScriptFullName) - Len(WScript.ScriptName))
End Function
'---------------------------------------
'Write to database function
Function DatabaseUpdate(strComputer, dwValue)
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3
Set objConnectionx = CreateObject("ADODB.Connection")
Set objRecordSetx = CreateObject("ADODB.Recordset")
'Check if machine has been added to database already
objConnectionx.Open _
   "Provider = Microsoft.Jet.OLEDB.4.0; " & _
       "Data Source = AuditRegistry.mdb" 
objRecordSetx.Open "SELECT AuditRegistryTable.MachineName FROM AuditRegistryTable WHERE (((AuditRegistryTable.MachineName)="&Chr(34)&strComputer&Chr(34)&"))", _
       objConnectionx, adOpenStatic, adLockOptimistic
On Error Resume NEXT
objRecordSetx.MoveFirst
If objRecordsetx.Fields.Item("MachineName")="" Then
On Error Goto 0
objRecordSetx.Close
'Add machine to database along with it's font size setting
objRecordSetx.Open "SELECT * FROM AuditRegistryTable" , _
   objConnectionx, adOpenStatic, adLockOptimistic
objRecordSetx.AddNew
objRecordSetx("MachineName") = strComputer
objRecordSetx("FontSize") = dwValue
objRecordSetx.Update
Else
'Machine 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 AuditRegistryTable.MachineName FROM AuditRegistryTable WHERE (((AuditRegistryTable.MachineName)="&Chr(34)&strComputer&Chr(34)&"))", _
       objConnectionx, adOpenStatic, adLockOptimistic
objRecordsetx.Delete
objRecordSetx.Close
'Add machine to database along with it's font size setting
objRecordSetx.Open "SELECT * FROM AuditRegistryTable" , _
   objConnectionx, adOpenStatic, adLockOptimistic
objRecordSetx.AddNew
objRecordSetx("MachineName") = strComputer
objRecordSetx("FontSize") = dwValue
objRecordSetx.Update
End IF
objRecordSetx.Close
objConnectionx.Close
End Function
'---------------------------------------
'Query Registry Key Value function
Function RKV 
dwvalue="fail"
on error resume next
Const HKEY_LOCAL_MACHINE = &H80000002
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
   strComputer & "\root\default:StdRegProv")
 
strKeyPath = "SYSTEM\ControlSet001\Hardware Profiles\0001\Software\Fonts"
strValueName = "LogPixels"
oReg.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,dwValue
'Wscript.Echo "CheckedValue: " & dwValue
on error goto 0
if dwvalue="fail" then
exit function
else
DatabaseUpdate strComputer, dwValue
end if
End Function
'---------------------------------------