Client-side VBScript problem with ADO/LDAP -- Please help
I'm a net admin trying to move our logon scripts from KiX to VBScript. Unfortunately, VBScript isn't as intuitive as KiX when it comes to administrative tasks but that's neither here nor there. My problem comes with trying to get the logged on user's description field out of AD in order to decide which portions of the logon script to run. I've tried a number of different things but can't seem to get any of them to work. Here is what I have so far.
Set objNetwork = CreateObject("WScript.Network")
strUserName = objNetwork.UserName
Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim strQuery, adoRecordset, strName, strCN
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
' Search entire ** OU.
strBase = "<LDAP://ou=**,dc=***,dc=**,dc=**,dc=**>"
' Filter on user objects and the current user account name.
strFilter = "(&(objectCategory=person)(objectClass=user)(sAMAccountName=" & strUserName & "))"
' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values and display.
strDN = adoRecordset.Fields("distinguishedName").value
' Wscript.Echo "DN: " & strDN
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
adoRecordset.Close
adoConnection.Close
So far this script grabs the current logged on user's information correctly. For the ADO query, I've tried to add other AD attributes to my strAttributes variable and they work fine (cn, displayName, etc). When I try to grab the "description" attribute, I get all sorts of errors. Extensive searching of this problems yields people with similar issues but none of the posted information fixes my error.
So I just gave up on the ADO attempt and tried to use a straight LDAP call with a .Get method as I'd seen in some other examples (http://www.dx21.com/SCRIPTING/ADSI/ADGUI/USER1.ASP) -- It looks like the only limitation on this would've been that you needed the user's DN in order to grab attributes so I used both scripts. I used the ADO script to grab my DN and then I used the LDAP one to try and get the logged on user's "description" field. When testing out the script, I'm STILL getting an error and I've echo'd my strDN var to make sure that the correct DN is dispalying so I'm not sure what I'm doing wrong. Here is my final attempt. Can anyone help pls?
Set objNetwork = CreateObject("WScript.Network")
strUserName = objNetwork.UserName
Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim strQuery, adoRecordset, strName, strCN
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
' Search entire ** OU.
strBase = "<LDAP://ou=**,dc=***,dc=**,dc=**,dc=**>"
' Filter on user objects and the current user account name.
strFilter = "(&(objectCategory=person)(objectClass=user)(sAMAccountName=" & strUserName & "))"
' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values and display.
strDN = adoRecordset.Fields("distinguishedName").value
' Wscript.Echo "DN: " & strDN
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
adoRecordset.Close
adoConnection.Close
WScript.Echo strDN
Set objUser = GetObject("LDAP://" & strDN)
WScript.Echo objUser.Get("description")
btw, the reporting error is: (null): 0x80005000
[5090 byte] By [
thepip3r] at [2007-11-11 10:09:16]
# 5 Re: Client-side VBScript problem with ADO/LDAP -- Please help
here is a composite of code (even including the way your code gets the username since it was better than mine) that i was able to do a successful "get.description" with. its very long because it was designed to show me a lot of password information:
' In a command prompt, echoing %username% will give you the logon name for the currently logged on user
' Using VBS and "attaching" to the windows shell, we have access to the same environmental variable that
' contains the currently logged on user's name. We
Dim objRootDSE, strDNSDomain
Set objNetwork = CreateObject("WScript.Network")
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
strDC = objRootDSE.Get("dnsHostName")
Wscript.Echo "Authenticating domain controller: " & strDC
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = _
"SELECT distinguishedName FROM 'LDAP://" & strDNSDomain & "' " & _
"WHERE objectCategory='user'AND sAMAccountName='" & objNetwork.UserName & "'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
strDN = objRecordSet.Fields("distinguishedName").Value
arrPath = Split(strDN, ",")
intLength = Len(arrPath(1))
intNameLength = intLength - 3
Wscript.Echo Right(arrPath(1), intNameLength)
Wscript.Echo strDN
objRecordSet.MoveNext
Loop
' PwdLastSet.vbs
' VBScript program to retrieve password information for a user.
' This includes the date the password was last set, the domain maximum
' password age policy, and whether the user can change their password.
'
' ----------------------
' Copyright (c) 2002 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - December 5, 2002
' Version 1.1 - March 7, 2003 - Standardize Hungarian notation.
' Version 1.2 - April 27, 2003 - Retrieve pwdLastSet from one DC.
' Version 1.3 - May 9, 2003 - Account for error in IADsLargeInteger
' property methods HighPart and LowPart.
'
' 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 objUser, strUserDN, objShell, lngBiasKey, lngBias, k
Dim objDomain, objMaxPwdAge, intMaxPwdAge
Dim objDate, dtmPwdLastSet, lngFlag, blnPwdExpire, blnExpired
Dim lngHighAge, lngLowAge
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
' Hard code user Distinguished Name.
strUserDN = Replace(strDN, "/", "\/")
Set objUser = GetObject("LDAP://" & strUserDN)
' 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
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
' Determine domain maximum password age policy in days.
'Set objRootDSE = GetObject("LDAP://RootDSE")
'strDNSDomain = objRootDSE.Get("DefaultNamingContext")
Set objDomain = GetObject("LDAP://" & strDNSDomain)
Set objMaxPwdAge = objDomain.MaxPwdAge
' Account for bug in IADslargeInteger property methods.
lngHighAge = objMaxPwdAge.HighPart
lngLowAge = objMaxPwdAge.LowPart
If (lngLowAge < 0) Then
lngHighAge = lngHighAge + 1
End If
intMaxPwdAge = -((lngHighAge * 2^32) _
+ lngLowAge)/(600000000 * 1440)
' Retrieve user password information.
Set objDate = objUser.PwdLastSet
dtmPwdLastSet = Integer8Date(objDate, lngBias)
lngFlag = objUser.Get("userAccountControl")
blnPwdExpire = True
If ((lngFlag And ADS_UF_PASSWD_CANT_CHANGE) <> 0) Then
blnPwdExpire = False
End If
If ((lngFlag And ADS_UF_DONT_EXPIRE_PASSWD) <> 0) Then
blnPwdExpire = False
End If
' Determine if password expired.
blnExpired = False
If (blnPwdExpire = True) Then
If (DateDiff("d", dtmPwdLastSet, Now) > intMaxPwdAge) Then
blnExpired = True
End If
End If
' Display password information.
WScript.Echo objUser.Get("description")
Wscript.Echo "User: " & strUserDN & vbCrLf & "Password last set: " _
& dtmPwdLastSet & vbCrLf & "Maximum password age (days): " _
& intMaxPwdAge & vbCrLf & "Can password expire? " & blnPwdExpire _
& vbCrLf & "Password expired? " & blnExpired
' Clean up.
'Set objUser = Nothing
'Set objShell = Nothing
'Set objRootDSE = Nothing
'Set objDomain = Nothing
'Set objMaxPwdAge = Nothing
'Set objDate = Nothing
Function Integer8Date(objDate, 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 bug 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
Integer8Date = CDate(lngDate)
End Function
'On Error Resume Next
'Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400
'Set objUser = GetObject("LDAP://" & strUserDN)
intUserAccountControl = objUser.Get("userAccountControl")
If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then ' LINE 11
WScript.Echo "The password does not expire."
WScript.Quit
Else
dtmValue = objUser.PasswordLastChanged
If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then ' LINE 16
WScript.Echo "The password has never been set."
WScript.Quit
Else
intTimeInterval = Int(Now - dtmValue)
WScript.Echo "The password was last set on " & _
DateValue(dtmValue) & " at " & TimeValue(dtmValue) & vbCrLf & _
"The difference between when the password was last" & vbCrLf & _
"set and today is " & intTimeInterval & " days"
End If
'Set objDomain = GetObject("LDAP://" & strDNSDomain)
Set objMaxPwdAge = objDomain.Get("maxPwdAge")
If objMaxPwdAge.LowPart = 0 Then
WScript.Echo "The Maximum Password Age is set to 0 in the " & _
"domain. Therefore, the password does not expire."
WScript.Quit
Else
dblMaxPwdNano = _
Abs(objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND ' LINE 37
dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY) ' LINE 38
WScript.Echo "Maximum password age is " & dblMaxPwdDays & " days"
If intTimeInterval >= dblMaxPwdDays Then
WScript.Echo "The password has expired."
Else
WScript.Echo "The password will expire on " & _
DateValue(dtmValue + dblMaxPwdDays) & " (" & _
Int((dtmValue + dblMaxPwdDays) - Now) & " days from today)."
End If
End If
End If
the only time i got any error with the info you expressed was when there really wasnt any description for the account referenced. it said "the directory property cannot be found in the cache." and gave code 8000500D with a source of active directory.
so at least now you have a verified block of code that should work as long as AD is spitting out the info properly.
