Audit Domain controllers and store users last logon
**************************
Option Explicit
Dim objRootDSE, strConfig, adoConnection, adoCommand, strQuery Dim adoRecordset, objDC Dim strDNSDomain, objShell, lngBiasKey, lngBias, k, arrstrDCs() Dim strDN, dtmDate, objDate, objList, strUser Dim strBase, strFilter, strAttributes, lngHigh, lngLow
Set objList = CreateObject("Scripting.Dictionary") objList.CompareMode = vbTextCompare
Set objShell = CreateObject("Wscript.Shell") lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" & "TimeZoneInformation\ActiveTimeBias") If (UCase(TypeName(lngBiasKey)) = "LONG") Then lngBias = lngBiasKey ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then lngBias = 0 For k = 0 To UBound(lngBiasKey) lngBias = lngBias + (lngBiasKey(k) * 256^k) Next End If
'Determine configuration context and DNS domain from RootDSE object. Set objRootDSE = GetObject("LDAP://RootDSE") strConfig = objRootDSE.Get("configurationNamingContext") strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoCommand = CreateObject("ADODB.Command") Set adoConnection = CreateObject("ADODB.Connection") adoConnection.Provider = "ADsDSOObject" adoConnection.Open "Active Directory Provider" adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strConfig & ">" strFilter = "(objectClass=nTDSDSA)" strAttributes = "AdsPath" strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery adoCommand.Properties("Page Size") = 100 adoCommand.Properties("Timeout") = 60 adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
k = 0 Do Until adoRecordset.EOF Set objDC = _ GetObject(GetObject(adoRecordset.Fields("AdsPath").Value).Parent) ReDim Preserve arrstrDCs(k) arrstrDCs(k) = objDC.DNSHostName k = k + 1 adoRecordset.MoveNext Loop adoRecordset.Close
'Retrieve lastLogon attribute for each user on each Domain Controller. For k = 0 To Ubound(arrstrDCs) strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">" strFilter = "(&(objectCategory=person)(objectClass=user))" strAttributes = "distinguishedName,lastLogon" strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" adoCommand.CommandText = strQuery On Error Resume Next Set adoRecordset = adoCommand.Execute If (Err.Number <> 0) Then On Error GoTo 0 Wscript.Echo "Domain Controller not available: " & arrstrDCs(k) Else On Error GoTo 0 Do Until adoRecordset.EOF strDN = adoRecordset.Fields("distinguishedName").Value On Error Resume Next Set objDate = adoRecordset.Fields("lastLogon").Value If (Err.Number <> 0) Then On Error GoTo 0 dtmDate = #1/1/1601# Else On Error GoTo 0 lngHigh = objDate.HighPart lngLow = objDate.LowPart If (lngLow < 0) Then lngHigh = lngHigh + 1 End If If (lngHigh = 0) And (lngLow = 0 ) Then dtmDate = #1/1/1601# Else dtmDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) + lngLow)/600000000 - lngBias)/1440 End If End If If (objList.Exists(strDN) = True) Then If (dtmDate > objList(strDN)) Then objList.Item(strDN) = dtmDate End If Else objList.Add strDN, dtmDate End If adoRecordset.MoveNext Loop adoRecordset.Close End If Next
'Output latest lastLogon date for each user. For Each strUser In objList.Keys Wscript.Echo strUser & " ; " & objList.Item(strUser) Next
'Clean up. adoConnection.Close Set objRootDSE = Nothing Set adoConnection = Nothing Set adoCommand = Nothing Set adoRecordset = Nothing Set objDC = Nothing Set objDate = Nothing Set objList = Nothing Set objShell = Nothing
|