Date/Time conversion for accountExpire passwrdExpire etc... The actual (server date/time) ? Not local time.

Here is the script I'm working with.

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

Richard
Wed Jun 20 12:56:37 CDT 2007

To filter on users where the description field starts with a string, I
believe you can use:

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" <stealthyc@gmail.com> wrote in message
news:1182359744.717540.306300@m36g2000hse.googlegroups.com...
> Here is the script I'm working with.
>
> 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
>

Chris
Thu Jun 21 11:13:14 CDT 2007

On Jun 20, 12:56 pm, "Richard Mueller [MVP]" <rlmueller-
nos...@ameritech.nospam.net> wrote:
> To filter on users where the description field starts with a string, I
> believe you can use:
>
> 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


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

Richard
Thu Jun 21 12:30:55 CDT 2007

>
> 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
--