1. This site uses cookies. By continuing to use this site, you are agreeing to our use of cookies. Learn More.

VBSCRIPT: Account Lockout Status

Discussion in 'Scripting & Programming' started by Fergal1982, Sep 27, 2006.

  1. Fergal1982

    Fergal1982 Petabyte Poster

    Ok guys. i said id post more, so heres another one. This scrips is designed to take a given username (this assumes the account name is the same as their username - not the upn, although it can be modified to do so), and report back which DC's the account is locked out on. Bear in mind that this script currently assumes that the accounts automatically unlock after 15 minutes - if your policy is different then it will need to be changed.

    Const ForReading = 1
    Public objExplorer
    Public blnConfig
    Public strResults
    QUOTES = Chr(34)
    blnLocked = False
    Counter = 0
    intTimeDiff = CInt(fnGetTimeDiff)
    arrDCList = Array("dc1","dc2","dc3")
    If wscript.arguments.count <> 0 then
      Call subCheckArgs
      'Check if any arguments have been applied and output results based on these arguments. If no Arguments supplied, run as normal
      'NB - If Arguments are supplied, the script will terminate after outputting the appropriate text
      Call subLockOutStatus(arrDCList)
      'Normal Running - Checks Against DCList to see if account is locked out (LockoutTime Less than 15 mins from current time)
    End If
    'Procedure :  subLockOutStatus
    'Description : Checks Each DC in arrDCList to see if Acc Is Locked
    'Date    :  17 July 2006
    'Arguments : arrDCList
    'Returns   :  N/A
    Sub subLockOutStatus(ArrDCList)
    Dim strUsername, lockouttime, strDC, TimesinceLockout, strResults, DC, rsADResults
    strUserName = InputBox("Please Enter Username","UserName")
    If strUserName <> Empty then
      Call ProgressWindow(strUserName)
      For Each DC in arrDCList
        lockoutTime = Empty
        strDC = DC & ".domain.com"
        Set rsADResults = fnQueryAD(strDC,strUserName)
        If not rsADResults.EOF and not rsADResults.BOF then
          Counter = Counter + 1
          LockoutTime = FnDateConvert(rsADResults.fields("lockouttime"))
          If lockouttime <> "No Date" then
            LockoutTime = CDate(DateAdd("n",intTimeDiff,LockOutTime))
            TimesinceLockout = DateDiff("n",LockOutTime,Now)
            If TimeSinceLockout < 15 then
              strResults = strResults & strUserName & " Locked out on: " & strDC & " (" & TimeSinceLockout & ")<br />"
              blnLocked = True
            End If
          End If
        End If
      If Counter = 0 then
        strResults = "No Match in Active Directory"
      ElseIf not blnLocked then
        strResults = "Account Not Locked"
      End If
      Call EchoResults(StrResults,strUserName)
    End If
    End Sub
    'Procedure :  subCheckArgs
    'Description : Check If any arguments are supplied and output requested Data
    'Date    :  17 July 2006
    'Arguments : none - wscript.arguments is a global argument
    'Returns   :  n/a
    Sub subCheckArgs
    Dim strDC, DC
    If wscript.arguments.Count = 1 then
     If lcase(wscript.arguments(0)) = "/config" then
      'Output List of DC's in ArrDCList
        wscript.echo "Checking Status on"
        For each DC in arrDCList
          strDC = DC & ".domain.com"
          wscript.echo strDC
      ElseIf lcase(wscript.arguments(0)) = "/?" then
        'Output List of available commands
        wscript.echo Wscript.ScriptName & VBCRLF & "To Check if a User is Locked Out type:" & vbTab & QUOTES & "Cscript " & wscript.ScriptName & QUOTES _
                    & VBCRLF & "To View Version Number type:" & vbTab & vbTab & QUOTES & "Cscript " & wscript.ScriptName & " /ver" & QUOTES _
                    & VBCRLF & "To View DC List type:" & vbTab & vbTab & vbTab & QUOTES & "Cscript " & wscript.ScriptName & " /config" & QUOTES
      ElseIf lcase(wscript.arguments(0)) = "/ver" then
        'Output Current Version and Last Edited Date
        wscript.echo VBCRLF & "Version Number: " & VerNumber & VBCRLF & "Edited on: " & ModifiedDate
        'Output Standard Error
        wscript.echo "Error: Incorrect Syntax on Argument." & VBCRLF & "To View Available Arguments type: " _
                    & vbTab & QUOTES & "Cscript " & wscript.ScriptName & " /?" & QUOTES
      End If
    ElseIf wscript.arguments.Count > 1 then
      'Too Many Arguments Supplied - Script will only accept Max one at a time
      wscript.echo "Error: Incorrect Number of Arguments"
    End If
    End Sub
    'Procedure : fnDateConvert
    'Description : Converts Date Supplied from AD into an Actual Date
    'Date    :  17 July 2006
    'Arguments :  lngOriginalValue
    'Returns   :  Date
    Function FnDateConvert(LngOriginalValue)
    dim adoDate,longDate,ConvertedDate,longDateHigh,longDateLow
    'Convert Long format Date received from AD to a standard Date
    On Error Resume Next
    adoDate = LngOriginalValue
    Set longDate = adoDate
    If err.number <> 0 then
      ConvertedDate = "No Date"
      longDateHigh = longDate.HighPart
      longDateLow = longDate.LowPart
      If (longDateLow = 0) And (longDateHigh = 0) Then
        ConvertedDate = "No Date"
        If longDateLow < 0 Then longDateHigh = longDateHigh + 1
          ConvertedDate = #1/1/1601# + (((longDateHigh * (2 ^ 32)) + longDateLow)/600000000/1440)
          If ConvertedDate = "10565994.1167301" Then ConvertedDate = "No Date"
        End If
    End If
    FnDateConvert = ConvertedDate
    On Error Goto 0
    End Function
    'Procedure : fnQueryAD
    'Description : Querys AD for relevant Data
    'Date    : 17 July 2006
    'Arguments : DCpath, strUsername
    'Returns   : rsADResults (RecordSet)
    Function fnQueryAD(DCpath,strUserName)
    'Queries AD for the required Details
    Dim Connection, Command
    Const ADS_SCOPE_BASE = 0
    Const userDN = "OU=people,DC=Domain,DC=COM"
    'on error resume next
    'Initialize ADO connection
    Set connection = CreateObject("ADODB.Connection")
    connection.Provider = "ADsDSOObject"
    Set command = CreateObject("ADODB.Command")
    Set command.ActiveConnection = connection
    Command.Properties("Page Size") = 1000
    Command.Properties("Timeout") = 30
    Command.Properties("searchscope") = ADS_SCOPE_SUBTREE
    Command.Properties("Chase referrals") =   ADS_CHASE_REFERRALS_NEVER
    Command.Properties("Cache Results") = False
    command.CommandText = "SELECT lockoutTime FROM " & "'LDAP://" & DCpath & "/" & userDN & "' WHERE   name='" & strUserName & "'"
    Set fnQueryAD = command.Execute
    End Function
    'Procedure : fnGetTimeDiff
    'Description : Get difference between current system time and GMT
    'Date    :  17 July 2006
    'Arguments : n/a
    'Returns   : No. of Mins differnce from GMT (eg if sys time is BST, return will be 60)
    Function fnGetTimeDiff
    Dim os
    for each os in GetObject("winmgmts:").InstancesOf ("Win32_OperatingSystem")
      fnGetTimeDiff = os.CurrentTimeZone
    End Function
    'Procedure : ProgressWindow
    'Description : Creates an IE window Indicating Query in progress
    'Date    :  17 July 2006
    'Arguments : strUserName
    'Returns   : n/a
    Sub ProgressWindow(strUserName)
    Dim strComputer, objWMIService, colItems, intHorizontal, intVertical, objItem
    On Error Resume Next
    strComputer = "."
    Set objWMIService = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
    For Each objItem in colItems
        intHorizontal = objItem.ScreenWidth
        intVertical = objItem.ScreenHeight
    Set objExplorer = CreateObject _
    objExplorer.Navigate "about:blank"
    objExplorer.ToolBar = 0
    objExplorer.StatusBar = 0
    objExplorer.Left = (intHorizontal - 400) / 2
    objExplorer.Top = (intVertical - 200) / 2
    objExplorer.Width = 500
    objExplorer.Height = 250
    objExplorer.Visible = 1
    objExplorer.Document.Body.Style.Cursor = "wait"
    objExplorer.Document.Title = "LockOut Status (" & strUserName & ")"
    objExplorer.Document.Body.InnerHTML = "Checking for Account Lockout Status on Each Domain Controller <br>" _
                                            & "This might take several minutes to complete.</br>"
    on error goto 0
    End Sub
    'Procedure :  EchoResults
    'Description : Changes Window created from ProgressWindow to display results
    'Date    :   17 July 2006
    'Arguments : strResults, struserName
    'Returns   : n/a
    Sub EchoResults(StrResults,strUserName)
    Dim strOutput
    strOutput = "<Big><B>Results:</B></Big><br /><br />" & strResults
    on error resume next
    objExplorer.Document.Body.InnerHTML = strOutput
    objExplorer.Document.Body.Style.Cursor = "default"
    on error goto 0
    End Sub
    Hopefully i've coded this clearly enough, and commented enough, but theres one or two things to note here. The script is designed to be run by double-clicking on it (although its easily run from the command line two). If you run it from the command-line, however, you have a couple of extra features - used for admin features. running the script with the /? argument will list the possible commands. the first allows you to view the current version number (useful if you plan to modify the script several times). the second allows you to view the list of DC's loaded into the script without having to open the script itself (i kinda coded this so that if i hand it to a user and they have problems, i can have them relay the list of dcs without a chance of screwing their script up).

    Obviously you will need to change any references to .domain.com and dc=domain,dc=com to reflect your own AD infrastructure.

    Any questions/feedback, let me know.

    Certifications: ITIL Foundation; MCTS: Visual Studio Team Foundation Server 2010, Administration
    WIP: None at present
  2. Boycie
    Honorary Member

    Boycie Senior Beer Tester


    Great, thanks :thumbleft

    Certifications: MCSA 2003, MCDST, A+, N+, CTT+, MCT
  3. Bluerinse
    Honorary Member

    Bluerinse Exabyte Poster

    Q1. Why have you written this script?

    Q2. As domain controllers replicate user account info every five minutes (by default) a user account could be un-locked on any DC in the domain after AD has been replicated.

    Q3. What am I missing?
    Certifications: C&G Electronics - MCSA (W2K) MCSE (W2K)
  4. Fergal1982

    Fergal1982 Petabyte Poster

    I wrote the script to allow our servicedesk to identify which DCs the account was locked out on and unlock the account (our accounts automatically unlock after 15 mins, so its just for urgent requests).

    DCs replicating user info every 5 mins doesnt seem right to me to be honest. Think of the bandwidth you would lose in a large domain (for instance a 10k user domain). We have about 20 DCs in the uk alone, if these replicated to each other across our wan links every 5 mins it would kill our network. - you could be right though i suppose, i admit ive only just started the AD course.

    Certainly on our domain (and as far as i was aware), the default between sites is about 15-30 mins (certainly on our systems its 30 mins, which means that by the time replication takes place the account has unlocked. so if you need to unlock the account immediately, then you need to know which DC its locked out on, thats where this script comes in.
    Certifications: ITIL Foundation; MCTS: Visual Studio Team Foundation Server 2010, Administration
    WIP: None at present
  5. Sparky
    Highly Decorated Member Award

    Sparky Zettabyte Poster Moderator

    Certifications: MSc MCSE MCSA:M MCSA:S MCITP:EA MCTS(x5) Security+ Network+ A+
    WIP: Exchange 2007\2010
  6. Bluerinse
    Honorary Member

    Bluerinse Exabyte Poster


    Ah, good stuff, I understand now!

    Intra-site (DCs on a high speed LAN) replication is 5 mins by default.

    Inter-site (DCs using slow connections) set up using AD Sites and Services replicate at a set schedule.

    I didn't realise you had more than one site.
    Certifications: C&G Electronics - MCSA (W2K) MCSE (W2K)
  7. Fergal1982

    Fergal1982 Petabyte Poster

    ah yes, sorry. all of our dcs are in different sites (about 20 DC's).
    Certifications: ITIL Foundation; MCTS: Visual Studio Team Foundation Server 2010, Administration
    WIP: None at present

Share This Page