Solved

List AD Locked users using VBScript and HTML

Posted on 2009-04-09
20
4,725 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
  • 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
 
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
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 500 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

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Suggested Solutions

Resolve DNS query failed errors for Exchange
Disabling the Directory Sync Service Account in Office 365 will stop directory synchronization from working.
This tutorial will walk an individual through the process of transferring the five major, necessary Active Directory Roles, commonly referred to as the FSMO roles from a Windows Server 2008 domain controller to a Windows Server 2012 domain controlle…
This tutorial will walk an individual through the process of configuring their Windows Server 2012 domain controller to synchronize its time with a trusted, external resource. Use Google, Bing, or other preferred search engine to locate trusted NTP …

757 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now