Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

List AD Locked users using VBScript and HTML

Posted on 2009-04-09
20
Medium Priority
?
4,916 Views
Last Modified: 2013-12-24
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
Comment
Question by:teepes
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 9
  • 7
  • 2
  • +1
20 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 24109110
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
 
LVL 67

Expert Comment

by:sirbounty
ID: 24109118
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
 

Author Comment

by:teepes
ID: 24109278
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
Prepare for your VMware VCP6-DCV exam.

Josh Coen and Jason Langer have prepared the latest edition of VCP study guide. Both authors have been working in the IT field for more than a decade, and both hold VMware certifications. This 163-page guide covers all 10 of the exam blueprint sections.

 
LVL 67

Expert Comment

by:sirbounty
ID: 24109292
You did modify the domain back to your original?
0
 

Author Comment

by:teepes
ID: 24109298
Yep, and made sure i had an account locked out.
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24110407
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
 
LVL 14

Expert Comment

by:yehudaha
ID: 24110463
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
 

Author Comment

by:teepes
ID: 24110510
The last one kinda worked. It displays locked accounts and some that are disabled.
0
 

Author Comment

by:teepes
ID: 24110615
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
 
LVL 14

Expert Comment

by:yehudaha
ID: 24113657
the first one didn't work ?
do you have automatic unlocking configured in your policies  ?
0
 

Author Comment

by:teepes
ID: 24129850
we have it set to unlock after an hour.
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24130726
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
 

Author Comment

by:teepes
ID: 24130763
Can't use the GetObject with IE.
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24130873
save this with hta extension
0
 

Author Comment

by:teepes
ID: 24130954
now how would i be able to get that to update every 10 seconds with out refreshing the whole page?
0
 
LVL 14

Accepted Solution

by:
yehudaha earned 2000 total points
ID: 24131460
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
 

Author Comment

by:teepes
ID: 24131524
my background is going away after 10 seconds. shouldn't just update the code?
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24131597
no this is a new code, save it as hta file
0
 

Author Closing Comment

by:teepes
ID: 31568615
Thanks
0

Featured Post

Moving data to the cloud? Find out if you’re ready

Before moving to the cloud, it is important to carefully define your db needs, plan for the migration & understand prod. environment. This wp explains how to define what you need from a cloud provider, plan for the migration & what putting a cloud solution into practice entails.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this blog post, we’ll look at how ClickHouse performs in a general analytical workload using the star schema benchmark test.
In this article, we’ll look at how to deploy ProxySQL.
Microsoft Active Directory, the widely used IT infrastructure, is known for its high risk of credential theft. The best way to test your Active Directory’s vulnerabilities to pass-the-ticket, pass-the-hash, privilege escalation, and malware attacks …
Are you ready to implement Active Directory best practices without reading 300+ pages? You're in luck. In this webinar hosted by Skyport Systems, you gain insight into Microsoft's latest comprehensive guide, with tips on the best and easiest way…

721 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question