Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 5019
  • Last Modified:

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

0
teepes
Asked:
teepes
  • 9
  • 7
  • 2
  • +1
1 Solution
 
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
 
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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

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

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 9
  • 7
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now