This will list out the last logon time for each user. Will scan all your
dc's.
Make sure to change your domain name. Open up the output file in Excel
separation is via semi-colon
'
' Author Paul Bergson
' Date Written June 24, 2003
' Description Rips out all users and their context from AD and writes
them to a ssv file (semi-colon seperated)
' Modified December 3, 2003 Fixed sAMAccountName
reference bug
' January 2, 2004 Added display name to the csv
output file
'
'
Option Explicit
Dim aryContainer(500) ' Track the name of all containers
Dim aryCN(9999,10) ' Track the name of all users
Dim aryWhen() ' When Created
Dim arySvCN() ' Original context
Dim aryHomeDirectory() ' Location of home folder
Dim aryScriptPath() ' Location of script path
Dim arydisplayName() ' Display Name
Dim cntLen, cntComma, cntRight
Dim cntX, cntY, cntZ
Dim cntL, cntM, cntO
Dim cntColumns
Dim flgLoop
Dim flgContainerFnd
Dim txtName, txtCN, txtSvName
Dim usr
Dim flag
Dim objConnection
Dim objRecordSet
Dim objCommand
Dim objUser
Dim fso
Dim ts
Dim strHomeDirectory
Dim Output
Dim fsoHTA
Dim tsHTA
Dim oRoot, sConfig, oConnection, oCommand, sQuery
Dim oResults, oDC, sDNSDomain, oShell, nBiasKey
Dim nBias, k, sDCs(), sAdsPath, oDate, nDate
Dim oComputer, nLatestDate
Const ADS_UF_PASSWD_NOTREQD = &H0020
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const ADS_UF_PASSWORD_EXPIRED = &H800000
Const ADS_UF_ACCOUNTDISABLE = &H0002
Sub AvailableDCs
' Obtain local Time Zone bias from machine registry.
' Watch for line wrapping.
Set oShell = CreateObject("Wscript.Shell")
nBiasKey =
oShell.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\Ac
tiveTimeBias")
If UCase(TypeName(nBiasKey)) = "LONG" Then
nBias = nBiasKey
ElseIf UCase(TypeName(nBiasKey)) = "VARIANT()" Then
nBias = 0
For k = 0 To UBound(nBiasKey)
nBias = nBias + (nBiasKey(k) * 256^k)
Next
End If
' Determine configuration context and
' DNS domain from RootDSE object.
Set oRoot = GetObject("LDAP://RootDSE")
sConfig = oRoot.Get("ConfigurationNamingContext")
sDNSDomain = oRoot.Get("DefaultNamingContext")
' Use ADO to search Active Directory for
' ObjectClass nTDSDSA.
' This will identify all Domain Controllers.
Set oCommand = CreateObject("ADODB.Command")
Set oConnection = CreateObject("ADODB.Connection")
oConnection.Provider = "ADsDSOObject"
oConnection.Open = "Active Directory Provider"
oCommand.ActiveConnection = oConnection
sQuery = "<LDAP://" & sConfig _
& ">;(ObjectClass=nTDSDSA);AdsPath;subtree"
oCommand.CommandText = sQuery
oCommand.Properties("Page Size") = 100
oCommand.Properties("Timeout") = 30
oCommand.Properties("Searchscope") = 2
oCommand.Properties("Cache Results") = False
Set oResults = oCommand.Execute
' Enumerate parent objects of class nTDSDSA. Save
' Domain Controller names in dynamic array sDCs.
k = 0
Do Until oResults.EOF
Set oDC = _
GetObject(GetObject(oResults.Fields("AdsPath")).Parent)
If Not UCASE(Left(oDC.DNSHostName,3)) = "VDC" and Not
UCASE(Left(oDC.DNSHostName,5)) = "DCSRE" Then ' don't include virtual
servers or SRE
ReDim Preserve sDCs(k)
sDCs(k) = oDC.DNSHostName
k = k + 1
End If
oResults.MoveNext
Loop
End Sub
Sub LastTime
' Hard code LDAP AdsPath of user.
sAdsPath = arySvCN(cntL)
' Retrieve LastLogon attribute for computer on
' each Domain Controller.
nLatestDate = #1/1/1601#
oDate = #1/1/1601#
For k = 0 To Ubound(sDCs)
On Error Resume Next
Set oComputer = GetObject("LDAP://" & sDCs(k) & "/" & sAdsPath)
' Trap error in case LastLogon is null.
Set oDate = oComputer.LastLogon
On Error Resume Next
If Err.Number <> 0 Then
Err.Clear
nDate = #1/1/1601#
Else
If (oDate.HighPart = 0) And (oDate.LowPart = 0 ) Then
nDate = #1/1/1601#
Else
nDate = #1/1/1601# + (((oDate.HighPart * (2 ^ 32)) _
+ oDate.LowPart)/600000000 - nBias)/1440
End If
End If
Err.Clear
If nDate > nLatestDate Then
nLatestDate = nDate
End If
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Routine to strip out all containers and place in the aryContainer '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Stripper
Do
cntLen = Len(txtName)-3
txtName = Right(txtName,cntLen) ' Drops the Container
Type Name
cntComma = Instr(txtName,",") - 1 ' Find the end of the
name
If cntComma < 0 Then ' Last Name to process
there is no comma
cntComma = Len(txtName)
End If
txtCN = Left(txtName,cntComma) ' Pull the Name out of
the Distinguished Name
flgContainerFnd = "N"
For cntL = 0 to 500 ' Does this current
Container exist?
If aryContainer(cntL) = "" Then ' If current location is
blank then add it to the table
aryContainer(cntL) = txtCN
Exit For
End If
If aryContainer(cntL) = txtCN Then ' OU found
Exit For
End if
Next
aryCN(cntX, cntY) = cntL ' Store location of OU
cntY = cntY + 1 ' increment counter
cntComma = Instr(txtName,",") ' If equal to zero then
all done
If cntComma > 0 Then
cntRight = Len(txtName) - (cntComma) ' Get to start of next
part of name
txtName = Right(txtName, cntRight) ' Purge CN name
flgLoop = "Y"
Else
flgLoop = "N" ' Set all done flag
End If
Loop Until flgLoop = "N"
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Main Code of Program '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set objConnection = CreateObject("ADODB.Connection") ' Create a Connection
object in memory
objConnection.Open "Provider=ADsDSOObject;" ' Open the Connection
object using the ADSI OLE DB provider
Set objCommand = CreateObject("ADODB.Command") 'Create an ADO Command
object in memory, and assign the Command _
objCommand.ActiveConnection = objConnection ' object's
ActiveConnection property to the Connection object
objCommand.Properties("Page Size") = 100
objCommand.Properties("Size Limit") = 3000
objCommand.CommandText = _
"<LDAP://dc=YourDomain,dc=com>;(objectCategory=user);sAMAccountName,distingu
ishedName,name,whenCreated,homeDirectory,scriptPath,displayName;subtree"
'
"<LDAP://dc=YourDomain,dc=com>;(objectCategory=user);distinguishedName,name,
whenCreated,homeDirectory,scriptPath;subtree"
Set objRecordSet = objCommand.Execute ' Run the query by
calling the Execute method of the Command object
cntX = 0
cntY = 0
While Not objRecordSet.EOF
txtName = lcase(objRecordSet.Fields("distinguishedName")) '
Access each record in objRecordSet
txtSvName = txtName
ReDim Preserve arySvCN(cntX)
ReDim Preserve aryWhen(cntX) ' Save when
account created
ReDim Preserve aryHomeDirectory(cntX)
ReDim Preserve aryScriptPath(cntX)
ReDim Preserve arydisplayName(cntX)
aryWhen(cntX) = lcase(objRecordSet.Fields("whenCreated"))
aryHomeDirectory(cntX) = lcase(objRecordSet.Fields("homeDirectory"))
aryScriptPath(cntX) = lcase(objRecordSet.Fields("scriptPath"))
arydisplayName(cntX) = lcase(objRecordSet.Fields("displayName"))
cntLen = Len(txtName)
txtName = Left(txtName,(cntLen-18)) ' Provides the name w/o
dc=Your Domain,dc=com
cntLen = Len(txtName)-3
txtName = Right(txtName,cntLen) ' Drops the Container
Type Name
cntComma = Instr(txtName,",") - 1 ' Find the end of the
name
txtCN = Left(txtName,cntComma) ' Pull the Name out of
the Distinguished Name
aryCN(cntX, cntY) = lcase(objRecordSet.Fields("sAMAccountName")) '
Save Name
arySvCN(cntX) = txtSvName ' Save Distinguished
Name
cntY = cntY + 1 ' increment table
counter
cntRight = Len(txtName) - (cntComma + 1) ' Get to start of next
part of name
txtName = Right(txtName,cntRight) ' Purge CN name
Call Stripper ' Build table of the
context of the user
cntX = cntX + 1
cntY = 0
objRecordSet.MoveNext
Wend
Call AvailableDCs ' Go get the DC's in the
domain
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Create a file on the p drive '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set fso = CreateObject("Scripting.FileSystemObject")
set ts = fso.CreateTextFile("c:\temp\users.txt", True)
For cntL = 0 to 500 ' Find out how many
columns used
If aryContainer(cntL) = "" Then
Exit For
End If
Next
cntColumns = cntL
ts.write("Logon Name; Context")
'For cntO = 1 to cntColumns - 2 ' used to add headers for
ou
' ts.write("; OU")
'Next
ts.write("; Header OU") ' Remove for multiple
OU's
ts.writeline("; Last Logon Date; Creation Date; Home Folder; Script; Display
Name; Password Not Needed; Password Does Not Expire; Expired Password;
Account Is Disabled")
For cntL = 0 to 9999 ' Cycle through all
users found
If aryCN(cntL,0) = "" Then ' Quit once end found
Exit For
End If
ts.write(aryCN(cntL,0)) & "; " ' Output users logon
name
ts.write(arySvCN(cntL)) & "; " ' Output full context of
user
ts.write(aryContainer(aryCN(cntL,1))) ' Output users Home OU
' code will enumurate all the individual columns from within the context
' For cntM = 1 to 11
' If aryCN(cntL,cntM) > "" Then
' ts.write ("; ")
' ts.write(aryContainer(aryCN(cntL,cntM))) ' Output the context of
this user
' Else
' Exit For ' No records left to
process
' End If
' Next
'
' If cntColumns > cntM Then ' Align Columns
' For cntO = 1 to cntColumns - cntM
' ts.write("; ")
' Next
' End If
Call LastTime ' Sniff Out Last Time
logged on
If nLatestDate <> "1/1/1601" Then
ts.write("; " & nLatestDate)
Else
ts.write("; ")
End If
ts.write("; ") ' Date Account Was
Created
ts.write(aryWhen(cntL))
ts.write("; ") ' Home folder location
If aryHomeDirectory(cntL) > "" Then
ts.write(aryHomeDirectory(cntL))
Else
ts.write(" ")
End If
ts.write("; ")
If aryScriptPath(cntL) > "" Then
ts.write(aryScriptPath(cntL))
Else
ts.write(" ")
End If
ts.write("; ")
If arydisplayName(cntL) > "" Then
ts.write(arydisplayName(cntL))
Else
ts.write(" ")
End If
If aryContainer(aryCN(cntL,1)) <> "ServiceAccounts" Then
on error resume next
Set usr = GetObject("WinNT://gob/" & aryCN(cntL,0))
flag = usr.Get("UserFlags")
If flag AND ADS_UF_PASSWD_NOTREQD Then
ts.write("; y")
Else
ts.write("; ")
End If
If flag AND ADS_UF_DONT_EXPIRE_PASSWD Then
ts.write("; y")
Else
ts.write("; ")
End If
If flag AND ADS_UF_PASSWORD_EXPIRED Then
ts.write("; y")
Else
ts.write("; ")
End If
If flag AND ADS_UF_ACCOUNTDISABLE Then
ts.write("; y")
Else
ts.write("; ")
End If
End If
ts.writeline() ' Start a newline
Next
objConnection.Close
--
Paul Bergson MCT, MCSE, MCSA, CNE, CNA, CCA
This posting is provided "AS IS" with no warranties, and confers no rights.
