A working dump all AD users including (name,
AMAccountName ,displayname, accountExpires & description)
Works perfect. One little thing I would like to change is - Instead of
converting the dates to my local timezone, would it be possible to use
the actual date on the in AD/ on the server?
Is there any way to filter the description field? I would like to only
output accounts that which their description field begin with a
specific set of characters. So only description fields that start with
say - "PPC A, followed but random text etc..."
I tried to add in the "Is account disabled" record set but was
unsuccessful. Any suggestions? :)
Option explicit
Dim Con
Dim ocommand
Dim message, strText
Dim sADSPath
Dim fso,ofolders
dim wshShell, RS
Set wshShell = WScript.CreateObject("WScript.Shell")
dim quote,title
quote=chr(34)
dim objDate
dim lngDate
dim objUser
dim objShell, lngBias, lngBiasKey
Set objShell = CreateObject("Wscript.Shell")
' Obtain local Time Zone bias from machine registry.
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
Set objShell = Nothing
If (Not IsCScript()) Then 'If not CScript, re-run with
cscript...
WshShell.Run "CScript.exe " & quote & WScript.ScriptFullName &
quote, 0, true
WScript.Quit '...and stop running as WScript
End If
' Create FileSystemObject object to access file system.
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
'get path name, ending in
Dim desktoppath, logfile, appendout
desktoppath = wshShell.ExpandEnvironmentStrings("%USERPROFILE%")&
"\Desktop\"
dim root
'Get the default ADsPath for the domain to search.
Set root = GetObject("LDAP://rootDSE")
sADSPath = root.Get("defaultNamingContext")
Call ADOConnect
logfile = desktoppath &
left(WScript.ScriptName,Len(WScript.ScriptName)-3)& "csv"
'If fso.FileExists(logfile) Then fso.DeleteFile logfile,True
'setup log
Const ForAppend = 8
set AppendOut = fso.OpenTextFile(logfile, ForAppend, True)
appendout.WriteLine
"name,sAMAccountName,displayname,description,mail,accountExpires"'
LastLogoff,AccountDisabled,IsAccountLocked,mail,accountExpires"
Call ADOQuery
'Show done
appendout.Close
wshshell.Popup "The logfile, " & fso.GetFileName(quote & logfile) & ",
is on your desktop.",15,"Done"
Wscript.Quit 'Script ends
' Functions and Subroutines
'This is the tedious MS way that I no longer use
Sub BailOnFailure(ErrNum, ErrText)
strText = "Error 0x" & Hex(ErrNum) & " " & ErrText
MsgBox strText, vbInformation, "ADSI Error"
WScript.Quit
End Sub
Sub ADOConnect
'Create ADO connection object for Active Directory
Set Con = CreateObject("ADODB.Connection")
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on CreateObject"
End If
Con.Provider = "ADsDSOObject"
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Provider"
End If
Con.Open "Active Directory Provider"
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Open"
End If
'Create ADO command object for the connection.
Set ocommand = CreateObject("ADODB.Command")
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on CreateObject"
End If
ocommand.ActiveConnection = Con
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Active Connection"
End If
End Sub
Sub ADOQuery
dim i
Dim domain,sfilter, sAttribsToReturn, sDepth
'Build the ADsPath element of the commandtext
sADsPath = "<LDAP://" & sADSPath & ">"
'set filter for users only
sFilter = "(&(objectClass=user)(objectCategory=person))"
'Build the returned attributes element of the commandtext.
sAttribsToReturn =
"name,adsPath,sAMAccountName,displayname,description,mail,accountExpires"
',lastlogoff,accountdisabled,isaccountlocked"
'Build the depth element of the commandtext.
sDepth = "subTree"
'Assemble the commandtext.
ocommand.CommandText = sADsPath & ";" & sFilter & ";" &
sAttribsToReturn & ";" & sDepth
'WScript.Echo "CommandText: " & ocommand.CommandText
ocommand.Properties("Page Size") = 1000 'Get 1000 then
continue. Without it, stops at 1000
'Execute the query.
Set rs = ocommand.Execute
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Execute"
End If
' Navigate the record Set
rs.MoveFirst
While Not rs.EOF
GetInfo
rs.MoveNext
Wend
End Sub
Set objDate = objUser.accountExpires
lngDate = (objDate.HighPart * (2^32)) * objDate.LowPart
Sub GetInfo()
Dim strDescription, tArray, strUName, objUser, strExp
'Description is sometimes and array. Annoying
If IsArray (RS.Fields("Description").Value) Then
tArray = RS.Fields("Description").Value
strDescription = tArray(0)
Else
strDescription = RS.Fields("Description").Value
End If
strUName = quote & rs.Fields("Name").Value & quote
message = strUName & "," & rs.Fields("sAMAccountName").Value & ","
& _
quote & rs.Fields("displayname").Value & quote & "," & _
quote & strDescription & quote & "," & _
rs.Fields("mail").Value & ","
On Error Resume next 'connect to user object
Set objUser = GetObject(RS.Fields("AdsPath").Value)
If objUser.AccountExpirationDate = "1/1/1970" Or Err.Number =
-2147467259 Then
strExp = "Never Expires"
Else
strExp = objUser.AccountExpirationDate
End If
message = message & strExp
EchoAndLog message
Err.Clear
On Error goto 0
End Sub
Sub EchoAndLog(message)
WScript.Echo message
appendout.WriteLine message
End Sub
Function IsCScript()
If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
IsCScript = True
Else
IsCScript = False
End If
End Function
strFilter = "(&(objectCategory=person)(objectClass=user)(description=ppc
a*))"
You can only retrieve attributes values with ADO. You cannot retrieve the
values of property methods, like accountDisabled or IsAccountLocked. Also,
lastLogoff never has a value other than 0.
A bit of the userAccountControl attribute determines if an account is
disabled. For example, to retrieve disabled accounts, the filter would be:
strFilter = "(&(objectCategory=person)(objectClass=user)" _
& "(userAccountControl:1.2.840.113556.1.4.803:=2))"
To retrieve users that are not disabled:
strFilter = "(&(objectCategory=person)(objectClass=user)" _
& "(!userAccountControl:1.2.840.113556.1.4.803:=2))"
Or, retrieve the userAccountControl attribute and test with the appropriate
bit mask:
============
Const ADS_UF_ACCOUNTDISABLE = &H02
Set objUser = GetObject("LDAP://cn=Jim Smith,ou=Sales,dc=MyDomain,dc=com")
lngFlag = objUser.userAccountControl
If (lngFlag And ADS_UF_ACCOUNTDISABLE) <> 0 Then
Wscript.Echo "User is disabled"
Else
Wscript.Echo "User is NOT disabled"
End If
============
Checking if an account is locked out is more difficult. You must retrieve
the lockoutTime attribute (Integer8). If it is 0, the account is not locked
out. Otherwise, convert to a date, retrieve the value of the lockoutDuration
attribute (Integer8) of the domain object and convert it to a time interval
and see if this duration has expired since the lockoutTime. If so, the
account is no longer locked out. If user lockoutTime plus domain
lockoutDuration is less than the present time, the account is still locked
out. Note that the IsAccountLocked property method exposed by the LDAP
provider does not work and should not be used. I have an example VBScript
program to determine if a specified user is locked out linked here:
http://www.rlmueller.net/IsUserLocked.htm
For any Integer8 attribute, like accountExpires, you can convert to a
date/time in UTC (Coordinated Univeral Time) by not adjusting for any time
zone bias. If you want to convert to the time zone of a DC in another time
zone, you would need to either hard code the time zone bias, or retrieve it
remotely from the registry of the remote computer. Note that the value is
saved in AD is in UTC, which is independent of the time zone of any DC. The
exact same value is replicated to all DC's no matter what time zone they are
in.
--
Richard Mueller
Microsoft MVP Scripting and ADSI
Hilltop Lab - http://www.rlmueller.net
--
"Chris" <stea...@gmail.com> wrote in message
news:1182359744.7...@m36g2000hse.googlegroups.com...
Thanks Richard,
The Description filter worked great. :)
And now onto the timezone changes. In the script above I took out the
timezone stuff etc. This didn't the dates during the dump.
So I went searching around and tried this script from the Scripting
Guy. The account I am checking has an expire date of 12/31/2007. The
script below & the one above both output - Account expiration date:
01/01/2008 1:00:00 AM
On Error Resume Next
Set objUser = GetObject("LDAP://cn=Jim
Smith,ou=Sales,dc=MyDomain,dc=com"")
dtmAccountExpiration = objUser.AccountExpirationDate
If Err.Number = -2147467259 OR dtmAccountExpiration = #1/1/1970# Then
WScript.Echo "This account has no expiration date."
Else
WScript.Echo "Account expiration date: " &
objUser.AccountExpirationDate
End If
If ADUC says the account expires at the end of the day 12/31/2007, that
means it expires 1/1/2008 at 12:00 AM. However, the values saved in AD are
in UTC (Coordinated Universal Time) and are not adjusted for daylight
savings time changes. If the account expiration date/time was set when
daylight saving time was not in affect, but now daylight savings time is in
affect, this will appear to shift the expiration date one hour later. The
actual value saved in the accountExpires attribute doesn't change, but the
conversion to local time is different because the local time zone bias is
different by one hour. The AccountExpirationDate property method converts
the UTC value in accountExpires to local time, but ignores daylight savings
time changes. I try to explain all of this in the following link:
http://www.rlmueller.net/AccountExpires.htm
At present, Daylight Savings Time is in affect. It will not be in affect on
12/31/2007, so at that time ADUC will show end of day 12/31/2007 and
AccountExpirationDate will show 1/1/2008 12:00 AM and the account will
actually expire at midnight.
Invoking the AccountExpirationDate property methods requires that you bind
to the user object. I see you use ADO to retrieve the accountExpires
attribute, but I don't see where you use it. Since you are retrieving all
the attribute values you need with ADO, there should be no need to bind to
the user object (although the performance hit when doing so is very slight
if you are only dealing with one user). Here is how I convert accountExpires
to a date (assuming the recordset includes accountExpires and the value
lngBias has been retrieved from the local registry):
Do Until adoRecordset.EOF
' Retrieve value of accountExpires.
' Invoke IADsLargeInteger interface by using "Set".
Set objDate = adoRecordset.Fields("accountExpires").Value
' Convert to date in local time zone.
dtmDate = Integer8Date(objDate, lngTZBias)
Wscript.Echo "Account Expires: " & CStr(dtmDate)
adoRecordset.MoveNext
Loop
Function Integer8Date(ByVal objDate, ByVal lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
Dim lngAdjust, lngDate, lngHigh, lngLow
lngAdjust = lngBias
lngHigh = objDate.HighPart
lngLow = objdate.LowPart
' Account for error in IADslargeInteger property methods.
If (lngLow < 0) Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0) Then
lngAdjust = 0
End If
lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
+ lngLow) / 600000000 - lngAdjust) / 1440
' Trap error if lngDate is ridiculously huge.
On Error Resume Next
Integer8Date = CDate(lngDate)
If (Err.Number <> 0) Then
On Error GoTo 0
Integer8Date = #1/1/1601#
End If
On Error GoTo 0
End Function
==========
If a user object has never had an expiration date, AD assigns accountExpires
the largest 64-bit value possible, which is 2^63 - 1. The
AccountExpirationDate property raises an error in this case. The
Integer8Date function above traps this error and assigns the zero date,
since it really means "never".
--
Richard Mueller
Microsoft MVP Scripting and ADSI
Hilltop Lab - http://www.rlmueller.net
--