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

teepesAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
yehudahaConnect With a Mentor Commented:
here:
<html>
<head>
<title>Locked Users</title>
 
</head>
 
<script Language="VBScript">
lock
Sub Window_OnLoad
    iTimerID = window.setInterval("lock", 10000, "VBScript")
End Sub
 
sub lock
 
' 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
end sub
</script>
 
<body>
</body>
</html>

Open in new window

0
 
David LeeCommented:
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

0
 
sirbountyCommented:
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

0
Making Bulk Changes to Active Directory

Watch this video to see how easy it is to make mass changes to Active Directory from an external text file without using complicated scripts.

 
teepesAuthor Commented:
i can't get either of those to work for me. They are just blank. even if i run them in a .vbs file.
0
 
sirbountyCommented:
You did modify the domain back to your original?
0
 
teepesAuthor Commented:
Yep, and made sure i had an account locked out.
0
 
yehudahaCommented:
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

0
 
yehudahaCommented:
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

0
 
teepesAuthor Commented:
The last one kinda worked. It displays locked accounts and some that are disabled.
0
 
teepesAuthor Commented:
could i change the lockeouttime to less than 60 minutes?

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

To something like

(lockouttime=>60)(!lockoutTime=0));Name;Subtree"
0
 
yehudahaCommented:
the first one didn't work ?
do you have automatic unlocking configured in your policies  ?
0
 
teepesAuthor Commented:
we have it set to unlock after an hour.
0
 
yehudahaCommented:
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

0
 
teepesAuthor Commented:
Can't use the GetObject with IE.
0
 
yehudahaCommented:
save this with hta extension
0
 
teepesAuthor Commented:
now how would i be able to get that to update every 10 seconds with out refreshing the whole page?
0
 
teepesAuthor Commented:
my background is going away after 10 seconds. shouldn't just update the code?
0
 
yehudahaCommented:
no this is a new code, save it as hta file
0
 
teepesAuthor Commented:
Thanks
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.