Windows Vista Forums

Help with VBscript to pull User information

  1. #1


    Brian Guest

    Help with VBscript to pull User information

    I'm working with a script originally developed by Richard Mueller, and can't
    seem to coax all of the information I need out of Active Directory. I need
    to pull the Username, Display Name, Date of last logon and the status of the
    account. In the script I'm also pulling the distinguished name, description,
    and the last time the password was changed. I'm able to get every aspect of
    the script except for the last logon time to work perfectly. When running
    the script, I get the following error, "DocumentUsers.vbs(150): Exception:
    Object required: 'Fields(...).Value'
    ". I'm guessing I've missed a very simple call to ensure I'm pulling back
    the lastLogon value but for the life of me I can't find the mistake.

    ' DocumentUsers.vbs
    ' VBScript program to document all users in Active Directory. Can be
    ' used to create a comma delimited file that can be read into a
    ' spreadsheet program.
    '
    ' ----------------------------------------------------------------------
    ' Copyright (c) 2007 Richard L. Mueller
    ' Hilltop Lab web site - http://www.rlmueller.net
    ' Version 1.0 - August 6, 2007
    '
    ' You have a royalty-free right to use, modify, reproduce, and
    ' distribute this script file in any way you find useful, provided that
    ' you agree that the copyright owner above has no warranty, obligations,
    ' or liability for such use.

    Option Explicit

    Dim objRootDSE, strDNSDomain, adoCommand, adoConnection, strConfig
    Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
    Dim strDN, strNTName, strDisplayName, arrDesc, strFilePath
    Dim strItem, strDesc, objLastLogon, dtmLastLogon
    Dim lngFlags, strFlags, objPwdLastSet, dtmPwdLastSet
    Dim objShell, lngBiasKey, lngTZBias, k, arrAttrValues
    Dim objFSO, objFile, objDC

    ' Check for required arguments.
    If (Wscript.Arguments.Count < 1) Then
    Wscript.Echo "Arguments <FileName> required. For example:" & vbCrLf _
    & "cscript PwdLastChanged.vbs c:\MyFolder\UserList.txt"
    Wscript.Quit(0)
    End If

    strFilePath = Wscript.Arguments(0)
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    ' Open the file for write access.
    On Error Resume Next
    Set objFile = objFSO.OpenTextFile(strFilePath, 2, True, 0)
    If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "File " & strFilePath & " cannot be opened"
    Set objFSO = Nothing
    Wscript.Quit(1)
    End If
    On Error GoTo 0

    ' Obtain local Time Zone bias from machine registry.
    Set objShell = CreateObject("Wscript.Shell")
    lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
    & "TimeZoneInformation\ActiveTimeBias")
    If (UCase(TypeName(lngBiasKey)) = "LONG") Then
    lngTZBias = lngBiasKey
    ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
    lngTZBias = 0
    For k = 0 To UBound(lngBiasKey)
    lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
    Next
    End If
    Set objShell = Nothing

    ' Determine DNS domain name.
    Set objRootDSE = GetObject("LDAP://RootDSE")
    strConfig = objRootDSE.Get("configurationNamingContext")
    strDNSDomain = objRootDSE.Get("defaultNamingContext")

    ' Use ADO to search Active Directory.
    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

    ' Enumerate parent objects of class nTDSDSA. Save Domain Controller
    ' AdsPaths in dynamic array arrstrDCs.
    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

    ' Search entire domain.
    For k = 0 To Ubound(arrstrDCs)
    strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
    ' Search for all users.
    strFilter = "(&(objectCategory=person)(objectClass=user))"
    ' Comma delimited list of attribute values to retrieve.
    strAttributes = "distinguishedName,sAMAccountName,displayName," _
    & "description,userAccountControl,lastLogon,pwdLastSet"
    ' Construct the LDAP query.
    strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
    ' Run the query.
    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

    ' Output heading line.
    objFile.WriteLine """Distinguished Name"",""NT Name"",""Name""," _
    & "Description"",""Flags"",""Password Last Set"",""Last Logon"""

    ' Enumerate the resulting recordset.
    Do Until adoRecordset.EOF
    ' Retrieve single-valued strings.
    strDN = adoRecordset.Fields("distinguishedName").Value
    ' Escape any forward slash characters, "/", with the backslash
    ' escape character. All other characters that should be escaped are.
    strDN = Replace(strDN, "/", "\/")

    strNTName = adoRecordset.Fields("sAMAccountName").Value
    'strDisplayName = objItem.Get("displayName").Value
    strDisplayName = adoRecordset.Fields("displayName").Value

    ' The description attribute is multi-valued, but
    ' there is never more than one item in the array.
    arrDesc = adoRecordset.Fields("description").Value
    If IsNull(arrDesc) Then
    strDesc = ""
    Else
    For Each strItem In arrDesc
    strDesc = strItem
    Next
    End If

    ' Test bits of userAccountControl.
    lngFlags = CLng(adoRecordset.Fields("userAccountControl").Value)
    strFlags = GetFlags(lngFlags)

    ' Convert Integer8 value to date in current time zone.
    Set objLastLogon = adoRecordset.Fields("lastLogon").Value
    dtmLastLogon = Integer8Date(objLastLogon, lngTZBias)

    Set objPwdLastSet = adoRecordset.Fields("pwdLastSet").Value
    dtmPwdLastSet = Integer8Date(objPwdLastSet, lngTZBias)

    ' Create array of string values to display.
    arrAttrValues = Array(strDN, strNTName, strDisplayName, _
    strDesc, strFlags, CStr(dtmPwdLastSet), CStr(dtmLastLogon))

    ' Display array of values in a comma delimited line, with each
    ' value enclosed in quotes.
    'Wscript.Echo CSVLine(arrAttrValues)
    objFile.WriteLine CSVLine(arrAttrValues)

    ' Move to next record in recordset.
    adoRecordset.MoveNext
    Loop

    ' Clean up.
    adoRecordset.Close
    adoConnection.Close
    End If
    Next

    Function GetFlags(ByVal lngFlag)
    ' Function to test bits of userAccountControl attribute.
    ' Settings delimited by semicolons.

    ' Define bit masks.
    Const ADS_UF_ACCOUNTDISABLE = &H02
    Const ADS_UF_HOMEDIR_REQUIRED = &H08
    Const ADS_UF_LOCKOUT = &H10
    Const ADS_UF_PASSWD_NOTREQD = &H20
    Const ADS_UF_PASSWD_CANT_CHANGE = &H40
    Const ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = &H80
    Const ADS_UF_TEMP_DUPLICATE_ACCOUNT = &H100
    Const ADS_UF_NORMAL_ACCOUNT = &H200
    Const ADS_UF_INTERDOMAIN_TRUST_ACCOUNT = &H800
    Const ADS_UF_WORKSTATION_TRUST_ACCOUNT = &H1000
    Const ADS_UF_SERVER_TRUST_ACCOUNT = &H2000
    Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
    Const ADS_UF_MNS_LOGON_ACCOUNT = &H20000
    Const ADS_UF_SMARTCARD_REQUIRED = &H40000
    Const ADS_UF_TRUSTED_FOR_DELEGATION = &H80000
    Const ADS_UF_NOT_DELEGATED = &H100000
    Const ADS_UF_USE_DES_KEY_ONLY = &H200000
    Const ADS_UF_DONT_REQUIRE_PREAUTH = &H400000
    Const ADS_UF_PASSWORD_EXPIRED = &H800000
    Const ADS_UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION = &H1000000

    GetFlags = ""

    If (lngFlag And ADS_UF_ACCOUNTDISABLE) <> 0 Then
    GetFlags = GetFlags & ";" & "User account disabled"
    End If
    If (lngFlag And ADS_UF_HOMEDIR_REQUIRED) <> 0 Then
    GetFlags = GetFlags & ";" & "Home directory required"
    End If
    If (lngFlag And ADS_UF_LOCKOUT) <> 0 Then
    GetFlags = GetFlags & ";" & "Account currently locked out"
    End If
    If (lngFlag And ADS_UF_PASSWD_NOTREQD) <> 0 Then
    GetFlags = GetFlags & ";" & "No password required"
    End If
    If (lngFlag And ADS_UF_PASSWD_CANT_CHANGE) <> 0 Then
    GetFlags = GetFlags & ";" & "User cannot change password"
    End If
    If (lngFlag And ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED) <> 0 Then
    GetFlags = GetFlags & ";" & "User can send an encrypted password"
    End If
    If (lngFlag And ADS_UF_TEMP_DUPLICATE_ACCOUNT) <> 0 Then
    GetFlags = GetFlags & ";" & "Account for user in another domain
    (local user account)"
    End If
    If (lngFlag And ADS_UF_NORMAL_ACCOUNT) <> 0 Then
    GetFlags = GetFlags & ";" & "Default account for typical user"
    End If
    If (lngFlag And ADS_UF_INTERDOMAIN_TRUST_ACCOUNT) <> 0 Then
    GetFlags = GetFlags & ";" & "A ""permit to trust"" account for a
    domain that ""trusts"" other domains"
    End If
    If (lngFlag And ADS_UF_WORKSTATION_TRUST_ACCOUNT) <> 0 Then
    GetFlags = GetFlags & ";" & "Computer account"
    End If
    If (lngFlag And ADS_UF_SERVER_TRUST_ACCOUNT) <> 0 Then
    GetFlags = GetFlags & ";" & "Computer account for system backup
    domain controller"
    End If
    If (lngFlag And ADS_UF_DONT_EXPIRE_PASSWD) <> 0 Then
    GetFlags = GetFlags & ";" & "Password does not expire"
    End If
    If (lngFlag And ADS_UF_MNS_LOGON_ACCOUNT) <> 0 Then
    GetFlags = GetFlags & ";" & "MNS logon account"
    End If
    If (lngFlag And ADS_UF_SMARTCARD_REQUIRED) <> 0 Then
    GetFlags = GetFlags & ";" & "User must logon using a smart card"
    End If
    If (lngFlag And ADS_UF_TRUSTED_FOR_DELEGATION) <> 0 Then
    GetFlags = GetFlags & ";" & "Service account under which a service
    runs, trusted for Kerberos"
    End If
    If (lngFlag And ADS_UF_NOT_DELEGATED) <> 0 Then
    GetFlags = GetFlags & ";" & "Security context will not be delegated
    to a service"
    End If
    If (lngFlag And ADS_UF_USE_DES_KEY_ONLY) <> 0 Then
    GetFlags = GetFlags & ";" & "Must use DES encryption types for keys"
    End If
    If (lngFlag And ADS_UF_DONT_REQUIRE_PREAUTH) <> 0 Then
    GetFlags = GetFlags & ";" & "Account does not require Kerberos
    preauthenication for logon"
    End If
    If (lngFlag And ADS_UF_PASSWORD_EXPIRED) <> 0 Then
    GetFlags = GetFlags & ";" & "User password has expired"
    End If
    If (lngFlag And ADS_UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION) <> 0 Then
    GetFlags = GetFlags & ";" & "Account enabled for delegation"
    End If

    If (Len(GetFlags) > 1) Then
    GetFlags = Mid(GetFlags, 2)
    End If

    End Function

    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

    Function CSVLine(ByVal arrValues)
    ' Function to convert array of values into comma delimited
    ' values enclosed in quotes.
    Dim strItem

    CSVLine = ""
    For Each strItem In arrValues
    ' Replace any embedded quotes with two quotes.
    If (strItem <> "") Then
    strItem = Replace(strItem, """", """" & """")
    End If
    ' Append string values, enclosed in quotes,
    ' delimited by commas.
    If (CSVLine = "") Then
    CSVLine = """" & strItem & """"
    Else
    CSVLine = CSVLine & ",""" & strItem & """"
    End If
    Next

    End Function

    Wscript.Echo "Done"


    Thank you,

    --
    Brian Moffitt, MCSE 2003

      My System SpecsSystem Spec

  2. #2


    Richard Mueller [MVP] Guest

    Re: Help with VBscript to pull User information


    "Brian" <Brian@xxxxxx> wrote in message
    news:98615B61-CC88-44F1-9A09-363114507D66@xxxxxx

    > I'm working with a script originally developed by Richard Mueller, and
    > can't
    > seem to coax all of the information I need out of Active Directory. I
    > need
    > to pull the Username, Display Name, Date of last logon and the status of
    > the
    > account. In the script I'm also pulling the distinguished name,
    > description,
    > and the last time the password was changed. I'm able to get every aspect
    > of
    > the script except for the last logon time to work perfectly. When running
    > the script, I get the following error, "DocumentUsers.vbs(150): Exception:
    > Object required: 'Fields(...).Value'
    > ". I'm guessing I've missed a very simple call to ensure I'm pulling back
    > the lastLogon value but for the life of me I can't find the mistake.
    >
    > ' DocumentUsers.vbs
    > ' VBScript program to document all users in Active Directory. Can be
    > ' used to create a comma delimited file that can be read into a
    > ' spreadsheet program.
    > '
    > ' ----------------------------------------------------------------------
    > ' Copyright (c) 2007 Richard L. Mueller
    > ' Hilltop Lab web site - http://www.rlmueller.net
    > ' Version 1.0 - August 6, 2007
    > '
    > ' You have a royalty-free right to use, modify, reproduce, and
    > ' distribute this script file in any way you find useful, provided that
    > ' you agree that the copyright owner above has no warranty, obligations,
    > ' or liability for such use.
    >
    > Option Explicit
    >
    > Dim objRootDSE, strDNSDomain, adoCommand, adoConnection, strConfig
    > Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
    > Dim strDN, strNTName, strDisplayName, arrDesc, strFilePath
    > Dim strItem, strDesc, objLastLogon, dtmLastLogon
    > Dim lngFlags, strFlags, objPwdLastSet, dtmPwdLastSet
    > Dim objShell, lngBiasKey, lngTZBias, k, arrAttrValues
    > Dim objFSO, objFile, objDC
    >
    > ' Check for required arguments.
    > If (Wscript.Arguments.Count < 1) Then
    > Wscript.Echo "Arguments <FileName> required. For example:" & vbCrLf _
    > & "cscript PwdLastChanged.vbs c:\MyFolder\UserList.txt"
    > Wscript.Quit(0)
    > End If
    >
    > strFilePath = Wscript.Arguments(0)
    > Set objFSO = CreateObject("Scripting.FileSystemObject")
    >
    > ' Open the file for write access.
    > On Error Resume Next
    > Set objFile = objFSO.OpenTextFile(strFilePath, 2, True, 0)
    > If (Err.Number <> 0) Then
    > On Error GoTo 0
    > Wscript.Echo "File " & strFilePath & " cannot be opened"
    > Set objFSO = Nothing
    > Wscript.Quit(1)
    > End If
    > On Error GoTo 0
    >
    > ' Obtain local Time Zone bias from machine registry.
    > Set objShell = CreateObject("Wscript.Shell")
    > lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
    > & "TimeZoneInformation\ActiveTimeBias")
    > If (UCase(TypeName(lngBiasKey)) = "LONG") Then
    > lngTZBias = lngBiasKey
    > ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
    > lngTZBias = 0
    > For k = 0 To UBound(lngBiasKey)
    > lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
    > Next
    > End If
    > Set objShell = Nothing
    >
    > ' Determine DNS domain name.
    > Set objRootDSE = GetObject("LDAP://RootDSE")
    > strConfig = objRootDSE.Get("configurationNamingContext")
    > strDNSDomain = objRootDSE.Get("defaultNamingContext")
    >
    > ' Use ADO to search Active Directory.
    > 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
    >
    > ' Enumerate parent objects of class nTDSDSA. Save Domain Controller
    > ' AdsPaths in dynamic array arrstrDCs.
    > 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
    >
    > ' Search entire domain.
    > For k = 0 To Ubound(arrstrDCs)
    > strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
    > ' Search for all users.
    > strFilter = "(&(objectCategory=person)(objectClass=user))"
    > ' Comma delimited list of attribute values to retrieve.
    > strAttributes = "distinguishedName,sAMAccountName,displayName," _
    > & "description,userAccountControl,lastLogon,pwdLastSet"
    > ' Construct the LDAP query.
    > strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
    > ' Run the query.
    > 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
    >
    > ' Output heading line.
    > objFile.WriteLine """Distinguished Name"",""NT Name"",""Name""," _
    > & "Description"",""Flags"",""Password Last Set"",""Last Logon"""
    >
    > ' Enumerate the resulting recordset.
    > Do Until adoRecordset.EOF
    > ' Retrieve single-valued strings.
    > strDN = adoRecordset.Fields("distinguishedName").Value
    > ' Escape any forward slash characters, "/", with the backslash
    > ' escape character. All other characters that should be escaped are.
    > strDN = Replace(strDN, "/", "\/")
    >
    > strNTName = adoRecordset.Fields("sAMAccountName").Value
    > 'strDisplayName = objItem.Get("displayName").Value
    > strDisplayName = adoRecordset.Fields("displayName").Value
    >
    > ' The description attribute is multi-valued, but
    > ' there is never more than one item in the array.
    > arrDesc = adoRecordset.Fields("description").Value
    > If IsNull(arrDesc) Then
    > strDesc = ""
    > Else
    > For Each strItem In arrDesc
    > strDesc = strItem
    > Next
    > End If
    >
    > ' Test bits of userAccountControl.
    > lngFlags = CLng(adoRecordset.Fields("userAccountControl").Value)
    > strFlags = GetFlags(lngFlags)
    >
    > ' Convert Integer8 value to date in current time zone.
    > Set objLastLogon = adoRecordset.Fields("lastLogon").Value
    > dtmLastLogon = Integer8Date(objLastLogon, lngTZBias)
    >
    > Set objPwdLastSet = adoRecordset.Fields("pwdLastSet").Value
    > dtmPwdLastSet = Integer8Date(objPwdLastSet, lngTZBias)
    >
    > ' Create array of string values to display.
    > arrAttrValues = Array(strDN, strNTName, strDisplayName, _
    > strDesc, strFlags, CStr(dtmPwdLastSet), CStr(dtmLastLogon))
    >
    > ' Display array of values in a comma delimited line, with each
    > ' value enclosed in quotes.
    > 'Wscript.Echo CSVLine(arrAttrValues)
    > objFile.WriteLine CSVLine(arrAttrValues)
    >
    > ' Move to next record in recordset.
    > adoRecordset.MoveNext
    > Loop
    >
    > ' Clean up.
    > adoRecordset.Close
    > adoConnection.Close
    > End If
    > Next
    >
    > Function GetFlags(ByVal lngFlag)
    > ' Function to test bits of userAccountControl attribute.
    > ' Settings delimited by semicolons.
    >
    > ' Define bit masks.
    > Const ADS_UF_ACCOUNTDISABLE = &H02
    > Const ADS_UF_HOMEDIR_REQUIRED = &H08
    > Const ADS_UF_LOCKOUT = &H10
    > Const ADS_UF_PASSWD_NOTREQD = &H20
    > Const ADS_UF_PASSWD_CANT_CHANGE = &H40
    > Const ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = &H80
    > Const ADS_UF_TEMP_DUPLICATE_ACCOUNT = &H100
    > Const ADS_UF_NORMAL_ACCOUNT = &H200
    > Const ADS_UF_INTERDOMAIN_TRUST_ACCOUNT = &H800
    > Const ADS_UF_WORKSTATION_TRUST_ACCOUNT = &H1000
    > Const ADS_UF_SERVER_TRUST_ACCOUNT = &H2000
    > Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
    > Const ADS_UF_MNS_LOGON_ACCOUNT = &H20000
    > Const ADS_UF_SMARTCARD_REQUIRED = &H40000
    > Const ADS_UF_TRUSTED_FOR_DELEGATION = &H80000
    > Const ADS_UF_NOT_DELEGATED = &H100000
    > Const ADS_UF_USE_DES_KEY_ONLY = &H200000
    > Const ADS_UF_DONT_REQUIRE_PREAUTH = &H400000
    > Const ADS_UF_PASSWORD_EXPIRED = &H800000
    > Const ADS_UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION = &H1000000
    >
    > GetFlags = ""
    >
    > If (lngFlag And ADS_UF_ACCOUNTDISABLE) <> 0 Then
    > GetFlags = GetFlags & ";" & "User account disabled"
    > End If
    > If (lngFlag And ADS_UF_HOMEDIR_REQUIRED) <> 0 Then
    > GetFlags = GetFlags & ";" & "Home directory required"
    > End If
    > If (lngFlag And ADS_UF_LOCKOUT) <> 0 Then
    > GetFlags = GetFlags & ";" & "Account currently locked out"
    > End If
    > If (lngFlag And ADS_UF_PASSWD_NOTREQD) <> 0 Then
    > GetFlags = GetFlags & ";" & "No password required"
    > End If
    > If (lngFlag And ADS_UF_PASSWD_CANT_CHANGE) <> 0 Then
    > GetFlags = GetFlags & ";" & "User cannot change password"
    > End If
    > If (lngFlag And ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED) <> 0 Then
    > GetFlags = GetFlags & ";" & "User can send an encrypted password"
    > End If
    > If (lngFlag And ADS_UF_TEMP_DUPLICATE_ACCOUNT) <> 0 Then
    > GetFlags = GetFlags & ";" & "Account for user in another domain
    > (local user account)"
    > End If
    > If (lngFlag And ADS_UF_NORMAL_ACCOUNT) <> 0 Then
    > GetFlags = GetFlags & ";" & "Default account for typical user"
    > End If
    > If (lngFlag And ADS_UF_INTERDOMAIN_TRUST_ACCOUNT) <> 0 Then
    > GetFlags = GetFlags & ";" & "A ""permit to trust"" account for a
    > domain that ""trusts"" other domains"
    > End If
    > If (lngFlag And ADS_UF_WORKSTATION_TRUST_ACCOUNT) <> 0 Then
    > GetFlags = GetFlags & ";" & "Computer account"
    > End If
    > If (lngFlag And ADS_UF_SERVER_TRUST_ACCOUNT) <> 0 Then
    > GetFlags = GetFlags & ";" & "Computer account for system backup
    > domain controller"
    > End If
    > If (lngFlag And ADS_UF_DONT_EXPIRE_PASSWD) <> 0 Then
    > GetFlags = GetFlags & ";" & "Password does not expire"
    > End If
    > If (lngFlag And ADS_UF_MNS_LOGON_ACCOUNT) <> 0 Then
    > GetFlags = GetFlags & ";" & "MNS logon account"
    > End If
    > If (lngFlag And ADS_UF_SMARTCARD_REQUIRED) <> 0 Then
    > GetFlags = GetFlags & ";" & "User must logon using a smart card"
    > End If
    > If (lngFlag And ADS_UF_TRUSTED_FOR_DELEGATION) <> 0 Then
    > GetFlags = GetFlags & ";" & "Service account under which a service
    > runs, trusted for Kerberos"
    > End If
    > If (lngFlag And ADS_UF_NOT_DELEGATED) <> 0 Then
    > GetFlags = GetFlags & ";" & "Security context will not be delegated
    > to a service"
    > End If
    > If (lngFlag And ADS_UF_USE_DES_KEY_ONLY) <> 0 Then
    > GetFlags = GetFlags & ";" & "Must use DES encryption types for
    > keys"
    > End If
    > If (lngFlag And ADS_UF_DONT_REQUIRE_PREAUTH) <> 0 Then
    > GetFlags = GetFlags & ";" & "Account does not require Kerberos
    > preauthenication for logon"
    > End If
    > If (lngFlag And ADS_UF_PASSWORD_EXPIRED) <> 0 Then
    > GetFlags = GetFlags & ";" & "User password has expired"
    > End If
    > If (lngFlag And ADS_UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION) <> 0
    > Then
    > GetFlags = GetFlags & ";" & "Account enabled for delegation"
    > End If
    >
    > If (Len(GetFlags) > 1) Then
    > GetFlags = Mid(GetFlags, 2)
    > End If
    >
    > End Function
    >
    > 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
    >
    > Function CSVLine(ByVal arrValues)
    > ' Function to convert array of values into comma delimited
    > ' values enclosed in quotes.
    > Dim strItem
    >
    > CSVLine = ""
    > For Each strItem In arrValues
    > ' Replace any embedded quotes with two quotes.
    > If (strItem <> "") Then
    > strItem = Replace(strItem, """", """" & """")
    > End If
    > ' Append string values, enclosed in quotes,
    > ' delimited by commas.
    > If (CSVLine = "") Then
    > CSVLine = """" & strItem & """"
    > Else
    > CSVLine = CSVLine & ",""" & strItem & """"
    > End If
    > Next
    >
    > End Function
    >
    > Wscript.Echo "Done"
    >
    >
    > Thank you,
    >
    > --
    > Brian Moffitt, MCSE 2003
    I have just found that on W2k3 the lastLogon attribute can be "not set". On
    W2k I believe in similar situations that lastLogon will have the value 0. I
    see that pwdLastSet always has a value. If pwdLastSet has never been
    assigned a value, the value is 0, whether on W2k or W2k3 servers. It appears
    that lastLogon is somehow different. If no value has been assigned the value
    is 0 on W2k, but "not set" on W2k3. The fix is to replace this:

    Set objLastLogon = adoRecordset.Fields("lastLogon").Value
    dtmLastLogon = Integer8Date(objLastLogon, lngTZBias)

    with the following:

    On Error Resume Next
    Set objLastLogon = adoRecordset.Fields("lastLogon").Value
    If (Err.Number <> 0) Then
    On Error GoTo 0
    dtmLastLogon = #1/1/1601#
    Else

    On Error GoTo 0
    dtmLastLogon = Integer8Date(objLastLogon, lngTZBias)
    End If

    For some strange reason, similar defensive code does not appear necessary
    with the pwdLastSet attribute (at least in my tests).

    The large issue, however, is that you are querying every DC in the domain.
    This is necessary if you are retrieving lastLogon, as this attribute is not
    replicated and a different value is saved on every DC. All the other
    attributes are replicated. Your program will write one line to the file for
    each user for each DC in the domain.

    Since you got the same error I got, I assume you have at least one W2k3 DC.
    If your domain is at W2k3 functional level, you should retrieve
    lastLogonTimeStamp instead. The lastLogonTimeStamp attribute is replicated,
    so there is no need to query every DC.

    I would suggest you should run the script so it does not repeat the query on
    every DC, but retrieves attribute values that are replicated. If you must
    retrieve the value of an attribute that is not replicated, like lastLogon,
    use a separate script. If you have 200 users and 10 DC's in your domain your
    output file will have 2001 lines. Each user will have 10 lines in the file.

    I still have an issue with Integer8 attributes I want to investigate
    further. I want to check which attributes can be Null (or "not set") instead
    of 0. The rules have apparently changed. If an Integer8 attribute can be
    missing, you need to code similar to the fix above, where the possible error
    is trapped. So far I have not found this necessary for pwdLastSet.

    --
    Richard Mueller
    MVP Directory Services
    Hilltop Lab - http://www.rlmueller.net
    --



      My System SpecsSystem Spec

  3. #3


    Brian Guest

    Re: Help with VBscript to pull User information

    Richard,

    Thank you for the response. It looks like the domain is at the W2k3
    functional level so I'll try going back to an older version of the script
    (which doesn't query all DCs) and see if I can return the lastLogonTimeStamp.
    Otherwise I guess I'll just deal with all the duplicates (fortunately only 2
    DCs and less than 500 users).

    Thank you again,
    Brian
    --
    Brian Moffitt, MCSE 2003


    "Richard Mueller [MVP]" wrote:

    >
    > "Brian" <Brian@xxxxxx> wrote in message
    > news:98615B61-CC88-44F1-9A09-363114507D66@xxxxxx

    > > I'm working with a script originally developed by Richard Mueller, and
    > > can't
    > > seem to coax all of the information I need out of Active Directory. I
    > > need
    > > to pull the Username, Display Name, Date of last logon and the status of
    > > the
    > > account. In the script I'm also pulling the distinguished name,
    > > description,
    > > and the last time the password was changed. I'm able to get every aspect
    > > of
    > > the script except for the last logon time to work perfectly. When running
    > > the script, I get the following error, "DocumentUsers.vbs(150): Exception:
    > > Object required: 'Fields(...).Value'
    > > ". I'm guessing I've missed a very simple call to ensure I'm pulling back
    > > the lastLogon value but for the life of me I can't find the mistake.
    > >
    > > ' DocumentUsers.vbs
    > > ' VBScript program to document all users in Active Directory. Can be
    > > ' used to create a comma delimited file that can be read into a
    > > ' spreadsheet program.
    > > '
    > > ' ----------------------------------------------------------------------
    > > ' Copyright (c) 2007 Richard L. Mueller
    > > ' Hilltop Lab web site - http://www.rlmueller.net
    > > ' Version 1.0 - August 6, 2007
    > > '
    > > ' You have a royalty-free right to use, modify, reproduce, and
    > > ' distribute this script file in any way you find useful, provided that
    > > ' you agree that the copyright owner above has no warranty, obligations,
    > > ' or liability for such use.
    > >
    > > Option Explicit
    > >
    > > Dim objRootDSE, strDNSDomain, adoCommand, adoConnection, strConfig
    > > Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
    > > Dim strDN, strNTName, strDisplayName, arrDesc, strFilePath
    > > Dim strItem, strDesc, objLastLogon, dtmLastLogon
    > > Dim lngFlags, strFlags, objPwdLastSet, dtmPwdLastSet
    > > Dim objShell, lngBiasKey, lngTZBias, k, arrAttrValues
    > > Dim objFSO, objFile, objDC
    > >
    > > ' Check for required arguments.
    > > If (Wscript.Arguments.Count < 1) Then
    > > Wscript.Echo "Arguments <FileName> required. For example:" & vbCrLf _
    > > & "cscript PwdLastChanged.vbs c:\MyFolder\UserList.txt"
    > > Wscript.Quit(0)
    > > End If
    > >
    > > strFilePath = Wscript.Arguments(0)
    > > Set objFSO = CreateObject("Scripting.FileSystemObject")
    > >
    > > ' Open the file for write access.
    > > On Error Resume Next
    > > Set objFile = objFSO.OpenTextFile(strFilePath, 2, True, 0)
    > > If (Err.Number <> 0) Then
    > > On Error GoTo 0
    > > Wscript.Echo "File " & strFilePath & " cannot be opened"
    > > Set objFSO = Nothing
    > > Wscript.Quit(1)
    > > End If
    > > On Error GoTo 0
    > >
    > > ' Obtain local Time Zone bias from machine registry.
    > > Set objShell = CreateObject("Wscript.Shell")
    > > lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
    > > & "TimeZoneInformation\ActiveTimeBias")
    > > If (UCase(TypeName(lngBiasKey)) = "LONG") Then
    > > lngTZBias = lngBiasKey
    > > ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
    > > lngTZBias = 0
    > > For k = 0 To UBound(lngBiasKey)
    > > lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
    > > Next
    > > End If
    > > Set objShell = Nothing
    > >
    > > ' Determine DNS domain name.
    > > Set objRootDSE = GetObject("LDAP://RootDSE")
    > > strConfig = objRootDSE.Get("configurationNamingContext")
    > > strDNSDomain = objRootDSE.Get("defaultNamingContext")
    > >
    > > ' Use ADO to search Active Directory.
    > > 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
    > >
    > > ' Enumerate parent objects of class nTDSDSA. Save Domain Controller
    > > ' AdsPaths in dynamic array arrstrDCs.
    > > 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
    > >
    > > ' Search entire domain.
    > > For k = 0 To Ubound(arrstrDCs)
    > > strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
    > > ' Search for all users.
    > > strFilter = "(&(objectCategory=person)(objectClass=user))"
    > > ' Comma delimited list of attribute values to retrieve.
    > > strAttributes = "distinguishedName,sAMAccountName,displayName," _
    > > & "description,userAccountControl,lastLogon,pwdLastSet"
    > > ' Construct the LDAP query.
    > > strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
    > > ' Run the query.
    > > 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
    > >
    > > ' Output heading line.
    > > objFile.WriteLine """Distinguished Name"",""NT Name"",""Name""," _
    > > & "Description"",""Flags"",""Password Last Set"",""Last Logon"""
    > >
    > > ' Enumerate the resulting recordset.
    > > Do Until adoRecordset.EOF
    > > ' Retrieve single-valued strings.
    > > strDN = adoRecordset.Fields("distinguishedName").Value
    > > ' Escape any forward slash characters, "/", with the backslash
    > > ' escape character. All other characters that should be escaped are.
    > > strDN = Replace(strDN, "/", "\/")
    > >
    > > strNTName = adoRecordset.Fields("sAMAccountName").Value
    > > 'strDisplayName = objItem.Get("displayName").Value
    > > strDisplayName = adoRecordset.Fields("displayName").Value
    > >
    > > ' The description attribute is multi-valued, but
    > > ' there is never more than one item in the array.
    > > arrDesc = adoRecordset.Fields("description").Value
    > > If IsNull(arrDesc) Then
    > > strDesc = ""
    > > Else
    > > For Each strItem In arrDesc
    > > strDesc = strItem
    > > Next
    > > End If
    > >
    > > ' Test bits of userAccountControl.
    > > lngFlags = CLng(adoRecordset.Fields("userAccountControl").Value)
    > > strFlags = GetFlags(lngFlags)
    > >
    > > ' Convert Integer8 value to date in current time zone.
    > > Set objLastLogon = adoRecordset.Fields("lastLogon").Value
    > > dtmLastLogon = Integer8Date(objLastLogon, lngTZBias)
    > >
    > > Set objPwdLastSet = adoRecordset.Fields("pwdLastSet").Value
    > > dtmPwdLastSet = Integer8Date(objPwdLastSet, lngTZBias)
    > >
    > > ' Create array of string values to display.
    > > arrAttrValues = Array(strDN, strNTName, strDisplayName, _
    > > strDesc, strFlags, CStr(dtmPwdLastSet), CStr(dtmLastLogon))
    > >
    > > ' Display array of values in a comma delimited line, with each
    > > ' value enclosed in quotes.
    > > 'Wscript.Echo CSVLine(arrAttrValues)
    > > objFile.WriteLine CSVLine(arrAttrValues)
    > >
    > > ' Move to next record in recordset.
    > > adoRecordset.MoveNext
    > > Loop
    > >
    > > ' Clean up.
    > > adoRecordset.Close
    > > adoConnection.Close
    > > End If
    > > Next
    > >
    > > Function GetFlags(ByVal lngFlag)
    > > ' Function to test bits of userAccountControl attribute.
    > > ' Settings delimited by semicolons.
    > >
    > > ' Define bit masks.
    > > Const ADS_UF_ACCOUNTDISABLE = &H02
    > > Const ADS_UF_HOMEDIR_REQUIRED = &H08
    > > Const ADS_UF_LOCKOUT = &H10
    > > Const ADS_UF_PASSWD_NOTREQD = &H20
    > > Const ADS_UF_PASSWD_CANT_CHANGE = &H40
    > > Const ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = &H80
    > > Const ADS_UF_TEMP_DUPLICATE_ACCOUNT = &H100
    > > Const ADS_UF_NORMAL_ACCOUNT = &H200
    > > Const ADS_UF_INTERDOMAIN_TRUST_ACCOUNT = &H800
    > > Const ADS_UF_WORKSTATION_TRUST_ACCOUNT = &H1000
    > > Const ADS_UF_SERVER_TRUST_ACCOUNT = &H2000
    > > Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
    > > Const ADS_UF_MNS_LOGON_ACCOUNT = &H20000
    > > Const ADS_UF_SMARTCARD_REQUIRED = &H40000
    > > Const ADS_UF_TRUSTED_FOR_DELEGATION = &H80000
    > > Const ADS_UF_NOT_DELEGATED = &H100000
    > > Const ADS_UF_USE_DES_KEY_ONLY = &H200000
    > > Const ADS_UF_DONT_REQUIRE_PREAUTH = &H400000
    > > Const ADS_UF_PASSWORD_EXPIRED = &H800000
    > > Const ADS_UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION = &H1000000
    > >
    > > GetFlags = ""
    > >
    > > If (lngFlag And ADS_UF_ACCOUNTDISABLE) <> 0 Then
    > > GetFlags = GetFlags & ";" & "User account disabled"
    > > End If
    > > If (lngFlag And ADS_UF_HOMEDIR_REQUIRED) <> 0 Then
    > > GetFlags = GetFlags & ";" & "Home directory required"
    > > End If
    > > If (lngFlag And ADS_UF_LOCKOUT) <> 0 Then
    > > GetFlags = GetFlags & ";" & "Account currently locked out"
    > > End If
    > > If (lngFlag And ADS_UF_PASSWD_NOTREQD) <> 0 Then
    > > GetFlags = GetFlags & ";" & "No password required"
    > > End If
    > > If (lngFlag And ADS_UF_PASSWD_CANT_CHANGE) <> 0 Then
    > > GetFlags = GetFlags & ";" & "User cannot change password"
    > > End If
    > > If (lngFlag And ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED) <> 0 Then
    > > GetFlags = GetFlags & ";" & "User can send an encrypted password"
    > > End If
    > > If (lngFlag And ADS_UF_TEMP_DUPLICATE_ACCOUNT) <> 0 Then
    > > GetFlags = GetFlags & ";" & "Account for user in another domain
    > > (local user account)"
    > > End If
    > > If (lngFlag And ADS_UF_NORMAL_ACCOUNT) <> 0 Then
    > > GetFlags = GetFlags & ";" & "Default account for typical user"
    > > End If
    > > If (lngFlag And ADS_UF_INTERDOMAIN_TRUST_ACCOUNT) <> 0 Then
    > > GetFlags = GetFlags & ";" & "A ""permit to trust"" account for a
    > > domain that ""trusts"" other domains"
    > > End If
    > > If (lngFlag And ADS_UF_WORKSTATION_TRUST_ACCOUNT) <> 0 Then
    > > GetFlags = GetFlags & ";" & "Computer account"
    > > End If
    > > If (lngFlag And ADS_UF_SERVER_TRUST_ACCOUNT) <> 0 Then
    > > GetFlags = GetFlags & ";" & "Computer account for system backup
    > > domain controller"
    > > End If
    > > If (lngFlag And ADS_UF_DONT_EXPIRE_PASSWD) <> 0 Then
    > > GetFlags = GetFlags & ";" & "Password does not expire"
    > > End If
    > > If (lngFlag And ADS_UF_MNS_LOGON_ACCOUNT) <> 0 Then
    > > GetFlags = GetFlags & ";" & "MNS logon account"
    > > End If
    > > If (lngFlag And ADS_UF_SMARTCARD_REQUIRED) <> 0 Then
    > > GetFlags = GetFlags & ";" & "User must logon using a smart card"
    > > End If
    > > If (lngFlag And ADS_UF_TRUSTED_FOR_DELEGATION) <> 0 Then
    > > GetFlags = GetFlags & ";" & "Service account under which a service
    > > runs, trusted for Kerberos"
    > > End If
    > > If (lngFlag And ADS_UF_NOT_DELEGATED) <> 0 Then
    > > GetFlags = GetFlags & ";" & "Security context will not be delegated
    > > to a service"
    > > End If
    > > If (lngFlag And ADS_UF_USE_DES_KEY_ONLY) <> 0 Then
    > > GetFlags = GetFlags & ";" & "Must use DES encryption types for
    > > keys"
    > > End If
    > > If (lngFlag And ADS_UF_DONT_REQUIRE_PREAUTH) <> 0 Then
    > > GetFlags = GetFlags & ";" & "Account does not require Kerberos
    > > preauthenication for logon"
    > > End If
    > > If (lngFlag And ADS_UF_PASSWORD_EXPIRED) <> 0 Then
    > > GetFlags = GetFlags & ";" & "User password has expired"
    > > End If
    > > If (lngFlag And ADS_UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION) <> 0
    > > Then
    > > GetFlags = GetFlags & ";" & "Account enabled for delegation"
    > > End If
    > >
    > > If (Len(GetFlags) > 1) Then
    > > GetFlags = Mid(GetFlags, 2)
    > > End If
    > >
    > > End Function
    > >
    > > 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

      My System SpecsSystem Spec


Help with VBscript to pull User information
Similar Threads
Thread Forum
Get access token information using vbscript ? VB Script
Impersonating user via vbscript? VB Script
Retrieve information of a remote machine in vbscript VB Script
Scripting - pull out information from System Properties->General_> PowerShell
Online Pop Up Logon Page - User name (Auto captured in pull down m Live Messenger