asked on

List AD Locked users using VBScript and HTML

Hello I would like to create a HTML Vbscript to list locked user accounts. I have a script that lists disabled user accounts. Could i edit this somehow to show locked accounts?

<html>
 
<head>
   <title>Woot</title>
 
</head>
 
<script Language="VBScript">
 
On Error Resume Next
 
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.CommandText = _
    "<LDAP://dc=domain,dc=com>;(&(objectCategory=User)" & _
        "(userAccountControl:1.2.840.113556.1.4.803:=2));Name;Subtree"  
Set objRecordSet = objCommand.Execute
 
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
    document.write objRecordSet.Fields("Name").Value + "<br>"
    objRecordSet.MoveNext
Loop
 
</script>
 
<body>
</body>
</html>

Open in new window

David Lee

Hi, teepes.

This works for me.

Const ADS_UF_SCRIPT = 1
Const ADS_UF_ACCOUNTDISABLE = 2
Const ADS_UF_HOMEDIR_REQUIRED = 8
Const ADS_UF_LOCKOUT = 16
Const ADS_UF_PASSWD_NOTREQD = 32
Const ADS_UF_PASSWD_CANT_CHANGE = 64
Const ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = 128
Const ADS_UF_TEMP_DUPLICATE_ACCOUNT = 256
Const ADS_UF_NORMAL_ACCOUNT = 512
Const ADS_UF_INTERDOMAIN_TRUST_ACCOUNT = 2048
Const ADS_UF_WORKSTATION_TRUST_ACCOUNT = 4096
Const ADS_UF_SERVER_TRUST_ACCOUNT = 8192
Const ADS_UF_DONT_EXPIRE_PASSWD = 65536
Const ADS_UF_MNS_LOGON_ACCOUNT = 131072
Const ADS_UF_SMARTCARD_REQUIRED = 262144
Const ADS_UF_TRUSTED_FOR_DELEGATION = 524288
Const ADS_UF_NOT_DELEGATED = 1048576
Const ADS_UF_USE_DES_KEY_ONLY = 2097152
Const ADS_UF_DONT_REQUIRE_PREAUTH = 4194304
Const ADS_UF_PASSWORD_EXPIRED = 8388608
Const ADS_UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION = 16777216
 
 
Dim adoCon, adoRS
Set adoCon = CreateObject("ADODB.Connection")
With adoCon
    .Provider = "ADsDSOObject"
    .Open "Active Directory Provider"
End With
'Change SomeDomain on the next line to that of your domain'
Set adoRS = adoCon.Execute("SELECT displayName,userAccountControl FROM 'LDAP://SomeDomain' WHERE objectClass='user' AND objectCategory='Person' ORDER BY displayName") 
Do Until adoRS.EOF
	If (adoRS.Fields("userAccountControl") And ADS_UF_LOCKOUT) Then
		WScript.Echo adoRS.Fields("displayName").Value & " is locked"
	End If
	adoRS.MoveNext
Loop
adoRS.Close
Set adoRS = Nothing
adoCon.Close
Set adoCon = Nothing

Open in new window

sirbounty

I think this will work...

<html>
 
<head>
   <title>Woot</title>
 
</head>
 
<script Language="VBScript">
 
On Error Resume Next
Const ADS_UF_ACCOUNTDISABLE = 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.CommandText = _
    "<LDAP://dc=domain,dc=com>;(&(objectCategory=User)" & _
        "(userAccountControl:1.2.840.113556.1.4.803:=2));Name;Subtree"  
Set objRecordSet = objCommand.Execute
 
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
    iUAC = objRecordSet.Fields("userAccountControl")
    If iUAC And ADS_UF_ACCOUNTDISABLE Then
      document.writeobjRecordSet.Fields("Name").Value + " is locked.<br>"
    End If
    objRecordSet.MoveNext
Loop
 
</script>
 
<body>
</body>
</html>

Open in new window

teepes

ASKER

i can't get either of those to work for me. They are just blank. even if i run them in a .vbs file.

sirbounty

You did modify the domain back to your original?

teepes

ASKER

Yep, and made sure i had an account locked out.

yehudaha

change your domain name in this line

"SELECT distinguishedName FROM 'LDAP://dc=domain,dc=net' WHERE objectCategory='user'"

<html>
 
<head>
   <title>Locked Account Status</title>
 
</head>
 
<script Language="VBScript">
 
 
On Error Resume Next
 
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://dc=domain,dc=net' WHERE objectCategory='user'"
 
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
 
Do Until objRecordSet.EOF
strDN = objRecordset.Fields("distinguishedName").Value
Set objUser = GetObject ("LDAP://" & strDN)
    If objuser.isAccountlocked = True Then
        document.write objuser.samAccountName & ", is Locked " + "<br>"
    End If
objrecordset.MoveNext
Set objuser = Nothing
Loop 
 
 
</script>
 
<body>
</body>
</html>

Open in new window

yehudaha

i think this one will do the job faster

<html>
 
<head>
   <title>Woot</title>
 
</head>
 
<script Language="VBScript">
 
On Error Resume Next
Const ADS_UF_ACCOUNTDISABLE = 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.CommandText = _
    "<LDAP://dc=domain,dc=net>;(&(objectCategory=person)(objectClass=user)(lockouttime=*)(!lockoutTime=0));Name;Subtree"  
Set objRecordSet = objCommand.Execute
 
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
      document.write objRecordSet.Fields("Name").Value + " is locked" + "<br>"
    objRecordSet.MoveNext
Loop
 
</script>
 
<body>
</body>
</html>

Open in new window

teepes

ASKER

The last one kinda worked. It displays locked accounts and some that are disabled.

teepes

ASKER

could i change the lockeouttime to less than 60 minutes?

(lockouttime=*)(!lockoutTime=0));Name;Subtree"

To something like

(lockouttime=>60)(!lockoutTime=0));Name;Subtree"

yehudaha

the first one didn't work ?
do you have automatic unlocking configured in your policies ?

teepes

ASKER

we have it set to unlock after an hour.

yehudaha

don't need to edit nothing run as is

taken from :

http://www.rlmueller.net/Programs/FindLockedOutUsers.txt

<html>
 
<head>
   <title>Woot</title>
 
</head>
 
<script Language="VBScript">
 
 
Option Explicit
 
Dim objRootDSE, strDNSDomain, objShell, lngBiasKey, lngBias, k
Dim objDomain, objDuration, lngHigh, lngLow, lngDuration
Dim adoCommand, adoConnection, adoRecordset
Dim strBase, strFilter, strAttributes, strQuery
Dim strUserDN, dtmLockOut, lngSeconds, str64Bit
 
' Retrieve DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
 
' Obtain local Time Zone bias from local 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
Set objShell = Nothing
 
' Retrieve domain lockout duration policy.
Set objDomain = GetObject("LDAP://" & strDNSDomain)
Set objDuration = objDomain.lockoutDuration
lngHigh = objDuration.HighPart
lngLow = objDuration.LowPart
If (lngHigh = 0 And lngLow = 0) Then
    ' There is no domain lockout duration policy.
    ' Locked out accounts remain locked out until reset.
    ' Any user with value of lockoutTime greater than 0
    ' is locked out.
    str64Bit = "1"
Else
    ' Account for error in IADsLargeInteger property methods.
    If (lngLow < 0) Then
        lngHigh = lngHigh + 1
    End If
    ' Convert to minutes.
    lngDuration = lngHigh * (2^32) + lngLow
    lngDuration = -lngDuration/(60 * 10000000)
 
    ' Determine critical time in the past. Any accounts
    ' locked out after this time will still be locked out,
    ' unless the account has been reset (in which case the
    ' value of the lockoutTime attribute will be 0).
    ' Any accounts locked out before this time will no
    ' longer be locked out.
    ' Trap error if lockoutDuration -1 (2^63 - 1).
    On Error Resume Next
    dtmLockout = DateAdd("n", -lngDuration, Now())
    If (Err.Number <> 0) Then
        On Error GoTo 0
        ' There is no domain lockout duration policy.
        ' Locked out accounts remain locked out until reset.
        ' Any user with value of lockoutTime greater than 0
        ' is locked out.
        str64Bit = "1"
    Else
        On Error GoTo 0
        ' Convert to UTC.
        dtmLockout = DateAdd("n", lngBias, dtmLockout)
 
        ' Find number of seconds since 1/1/1601.
        lngSeconds = DateDiff("s", #1/1/1601#, dtmLockout)
 
        ' Convert to 100-nanosecond intervals. This is the
        ' equivalent Integer8 value (for this time zone).
        str64Bit = CStr(lngSeconds) & "0000000"
    End If
End If
Set objDuration = Nothing
Set objDomain = Nothing
 
' 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
 
' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"
' Filter on all user objects that are still locked out.
strFilter = "(&(objectCategory=person)(objectClass=user)(lockoutTime>=" _
    & str64Bit & "))"
' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
 
' Run the query.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 60
adoCommand.Properties("Cache Results") = False
 
Set adoRecordset = adoCommand.Execute
 
' Enumerate the resulting recordset and display
' names of all locked out users.
document.write "Locked out users:" + "<br>"
Do Until adoRecordset.EOF
    strUserDN = adoRecordset.Fields("distinguishedName").Value
    document.write strUserDN + "<br>"
    adoRecordset.MoveNext
Loop
 
' Clean up.
adoRecordset.Close
adoConnection.Close
</script>
 
<body>
</body>
</html>

Open in new window

teepes

ASKER

Can't use the GetObject with IE.

yehudaha

save this with hta extension

teepes

ASKER

now how would i be able to get that to update every 10 seconds with out refreshing the whole page?

ASKER CERTIFIED SOLUTION

yehudaha

membership