Re: I want to Query
- From: "Paul Bergson" <pbergson@xxxxxxxxxxxxxxxxx>
- Date: Fri, 3 Feb 2006 08:13:46 -0600
Below is a vb script that will do just this. It will list out the last
logon date for user as well as multiple account attributes. It outputs the
data to c:\temp in a *.csv file. I have this running in a nightly scheduled
task which can list out new user creation which helps for SOX compliance. I
am redoing my website so it isn't available for down load right now. I hope
to have it up this weekend.
'
' Author Paul Bergson Duluth, Mn
' Date Written January 2006
' Description Rips out all users and their context from AD and writes
them to a csv file
'
'
' This may be reused as long as
you don't remove my name or sell it
'
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, tmpName
Dim usr
Dim flag
Dim objConnection
Dim objRecordSet
Dim objCommand
Dim objUser
Dim fso
Dim ts
Dim strHomeDirectory
Dim Output
Dim WshNetwork
Dim strDomainName ' NetBIOS Domain Name
Dim fsoHTA
Dim tsHTA
Dim CurrentDate
Dim MonthDate
Dim DayDate
Dim YearDate
Dim FileDate
Dim exFlg ' Exchange Object flag
Dim arrDomLevels
Dim LDAPADsPath
Dim LDAPStart
Dim cntDropHost
Dim oRoot, sConfig, oConnection, oCommand, sQuery
Dim oResults, oDC, sDNSDomain, oShell, nBiasKey
Dim nBias, k, sDCs(), sAdsPath, oDate, nDate
Dim oComputer, nLatestDate
Const FileLocation = "c:\temp\" ' Define the starting location of where
you want to store the csv
Const ADS_UF_PASSWD_NOTREQD = &H0020
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const ADS_UF_PASSWORD_EXPIRED = &H800000
Const ADS_UF_ACCOUNTDISABLE = &H0002
' Find all defined DC's in the domain
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\ActiveTimeBias")
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
'
''''' Time to find out the actual DC names, verify if online and if so save
them to an array
'
Do Until oResults.EOF
Set oDC = _
GetObject(GetObject(oResults.Fields("AdsPath")).Parent)
On Error Resume Next
Set oComputer = GetObject("LDAP://"; & oDC.DNSHostName) ' Attach to see
if DC is available
if CStr(Err.Number) = 0 then ' if no error then the DC exists
ReDim Preserve sDCs(k)
sDCs(k) = oDC.DNSHostName
k = k + 1
end if
oResults.MoveNext
Loop
cntDropHost = inStr(sDCs(0),".") + 1 '
Find the start of the domain name
LDAPStart = Mid(sDCs(0),cntDropHost,(Len(sDCs(0))-cntDropHost+1)) '
Drop the host name
arrDomLevels = Split(LDAPStart, ".") ' Convert to LDAP Path
(dc=yourdomain,dc=com...)
LDAPADsPath = "dc=" & Join(arrDomLevels, ",dc=")
' Find The NetBIOS Name of the domain
Set WshNetwork = WScript.CreateObject("WScript.Network")
strDomainName = WshNetwork.UserDomain ' Store the Domain
Name
End Sub
'
''''' Find out the last time on each DC
'
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
' This is the start of the program
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Main Code of Program '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Call AvailableDCs ' Go get the DC's in
the domain
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://"; & LDAPADsPath &
">;(objectCategory=user);sAMAccountName,distinguishedName,name,whenCreated,homeDirectory,scriptPath,displayName;subtree"
Set objRecordSet = objCommand.Execute ' Run the query by calling
the Execute method of the Command object
cntX = 0
cntY = 0
'
''''' Do an LDAP call and get all users in AD and save the users data
'
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 ' Move to next user
Wend
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Create a file using todays date as part of the file name '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
CurrentDate = Date
YearDate = Year(CurrentDate)
MonthDate = Month(CurrentDate)
If MonthDate < 9 then
MonthDate = "0" & MonthDate
End If
DayDate = Day(CurrentDate)
If DayDate < 9 then
DayDate = "0" & DayDate
End If
FileDate = FileLocation & YearDate & MonthDate & DayDate & "_accts.csv"
Set fso = CreateObject("Scripting.FileSystemObject")
set ts = fso.CreateTextFile(FileDate, True) ' Create the file
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")
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")
'
''''' Finally output the data (This system is only setup for a max of 10,000
users
'
For cntL = 0 to 9999 ' Cycle through all
users found
If aryCN(cntL,0) = "" Then ' Quit once end found
Exit For
End If
'If this is an Replicated Exchange Object, drop it
exFlg = InStr(1,arySvCN(cntL), "adc_replication",1)
If exFlg = 0 Then
ts.write(aryCN(cntL,0)) & ", " ' Output users logon
name
'Drop all comma's in the context
tmpName = Replace(arySvCN(cntL), ",", " ")
ts.write(tmpName) & ", " ' Output full context
of user
ts.write(aryContainer(aryCN(cntL,1))) ' Output users Home
OU
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
on error resume next
Set usr = GetObject("WinNT://" & strDomainName & "/" &
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
ts.writeline() ' Start a newline
End If
Next
objConnection.Close
--
Paul Bergson MCT, MCSE, MCSA, CNE, CNA, CCA
This posting is provided "AS IS" with no warranties, and confers no rights.
"Silver" <Silver@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:98207B8D-3F6F-45A1-8628-C60924A6BF6B@xxxxxxxxxxxxxxxx
I would like to view the Home directory when I create a query for users
and
Login Names
.
- Prev by Date: Re: Potential conflict in creating external trust
- Next by Date: Re: Internet Access after Active Directory Install
- Previous by thread: Re: Potential conflict in creating external trust
- Next by thread: Re: I want to Query
- Index(es):
Relevant Pages
|
Loading
