How to Find Active Directory Accounts with Expiring Passwords

How to Find Active Directory Accounts with Expiring Passwords

In an organization with multiple employees, it becomes tedious for the administrators to track users who's passwords are about to expire. This is crucial because, if the users fails to reset their passwords, the phone at the helpdesk is bound to ring. This means that the users are locked out of their accounts, loose out on productivity, and if the helpdesk is outsourced to external organizations, these password expiry calls can end up costing the organizations dearly.

 

Commonly available PowerShell scripts can only be used to return the list of users and when their respective passwords will expire. However, if you'd like to know which of your users have a soon-to-expire password, that is, lets say, passwords that expire in 7 days or lesser, you'd have very few options. Luckily, admins can turn to VBScript to retrieve a list of Soon-to-expire password users  . Follow these steps:

 

  1. Identify the domain from which you want to retrieve the list of users and the necessary LDAP attributes.

  2. Identify the primary Domain Controller which houses the user base.

  3. Compile and execute the script.

The report will be exported in the given format. For a different format, the script is to be edited accordingly.

VBScript

  1. Option Explicit
  2. Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
  3. Dim objRootDSE, strDNSDomain, strQuery, adoRecordset
  4. Dim dtmDate1, dtmDate2, intDays, strName, strEmail
  5. Dim lngSeconds1, str64Bit1, lngSeconds2, str64Bit2
  6. Dim objShell, lngBiasKey, lngBias, k
  7. Dim objDomain, objMaxPwdAge, lngHighAge, lngLowAge, sngMaxPwdAge
  8. Dim objDate, dtmPwdLastSet, dtmExpires
  9. Dim strItem, strPrefix, objFSO, objLogFile

  11. Const ForWriting = 2
  12. Set objFSO = CreateObject("Scripting.FileSystemObject")
  13. Set objLogFile = objFSO.CreateTextFile("C:\Scripts\PasswordExp.csv", ForWriting, True)

  15. objLogFile.Write "sAMAccountName,"
  16. objLogFile.Write "mail,"
  17. objLogFile.Write "passwordExpiresAt"
  18. objLogFile.Writeline

  20. ' Specify number of days. Any users whose password expires within
  21. this many days after today will be processed.'
  22. intDays = 14

  24. ' Determine domain maximum password age policy in days.
  25. Set objRootDSE = GetObject("LDAP://RootDSE")
  26. strDNSDomain = objRootDSE.Get("DefaultNamingContext")
  27. Set objDomain = GetObject("LDAP://" & strDNSDomain)
  28. Set objMaxPwdAge = objDomain.MaxPwdAge

  30. lngHighAge = objMaxPwdAge.HighPart
  31. lngLowAge = objMaxPwdAge.LowPart
  32. If (lngLowAge < 0) Then
  33. lngHighAge = lngHighAge + 1
  34. End If

  36. ' Convert from 100-nanosecond intervals into days.
  37. sngMaxPwdAge = -((lngHighAge * 2^32) _
  38. + lngLowAge)/(600000000 * 1440)

  40. ' Determine the password last changed date such that the password
  41. would just now be expired. We will not process users whose
  42. password has already expired.'
  43. dtmDate1 = DateAdd("d", - sngMaxPwdAge, Now())

  45. ' Determine the password last changed date such that the password
  46. 'will expire intDays in the future.'
  47. dtmDate2 = DateAdd("d", intDays - sngMaxPwdAge, Now())

  49. ' Obtain local Time Zone bias from machine registry.
  50. This bias changes with Daylight Savings Time.'
  51. Set objShell = CreateObject("Wscript.Shell")
  52. lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
  53. & "TimeZoneInformation\ActiveTimeBias")
  54. If (UCase(TypeName(lngBiasKey)) = "LONG") Then
  55. lngBias = lngBiasKey
  56. ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
  57. lngBias = 0
  58. For k = 0 To UBound(lngBiasKey)
  59. lngBias = lngBias + (lngBiasKey(k) * 256^k)
  60. Next
  61. End If

  63. ' Convert the datetime values to UTC.
  64. dtmDate1 = DateAdd("n", lngBias, dtmDate1)
  65. dtmDate2 = DateAdd("n", lngBias, dtmDate2)

  67. ' Find number of seconds since 1/1/1601 for these dates.
  68. lngSeconds1 = DateDiff("s", #1/1/1601#, dtmDate1)
  69. lngSeconds2 = DateDiff("s", #1/1/1601#, dtmDate2)

  71. ' Convert the number of seconds to a string
  72. ' and convert to 100-nanosecond intervals.
  73. str64Bit1 = CStr(lngSeconds1) & "0000000"
  74. str64Bit2 = CStr(lngSeconds2) & "0000000"

  76. ' Setup ADO objects.
  77. Set adoCommand = CreateObject("ADODB.Command")
  78. Set adoConnection = CreateObject("ADODB.Connection")
  79. adoConnection.Provider = "ADsDSOObject"
  80. adoConnection.Open "Active Directory Provider"
  81. Set adoCommand.ActiveConnection = adoConnection

  83. ' Search entire Active Directory domain.
  84. strBase = "<LDAP://" & strDNSDomain & ">"
  85.  
  86. ' Filter on user objects where the password expires between the
  87. ' dates specified, the account is not disabled, password never
  88. ' expires is not set, password not required is not set,
  89. ' and password cannot change is not set.
  90. strFilter = "(&(objectCategory=person)(objectClass=user)" _
  91. & "(pwdLastSet>=" & str64Bit1 & ")" _
  92. & "(pwdLastSet<=" & str64Bit2 & ")" _
  93. & "(!userAccountControl:1.2.840.113556.1.4.803:=2)" _
  94. & "(!userAccountControl:1.2.840.113556.1.4.803:=65536)" _
  95. & "(!userAccountControl:1.2.840.113556.1.4.803:=32)" _
  96. & "(!userAccountControl:1.2.840.113556.1.4.803:=48))"
  97.  
  98. ' Comma delimited list of attribute values to retrieve.
  99. strAttributes = "sAMAccountName,mail,pwdLastSet"

  101. ' Construct the LDAP syntax query.
  102. strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
  103. adoCommand.CommandText = strQuery
  104. adoCommand.Properties("Page Size") = 100
  105. adoCommand.Properties("Timeout") = 30
  106. adoCommand.Properties("Cache Results") = False

  108. ' Run the query.
  109. Set adoRecordset = adoCommand.Execute

  111. ' Enumerate the resulting recordset.
  112. Do Until adoRecordset.EOF
  113. strName = adoRecordset.Fields("sAMAccountName").Value
  114. strEmail = adoRecordset.Fields("mail").Value & ""
  115. If (TypeName(adoRecordset.Fields("pwdLastSet").Value) = "Object") Then
  116. Set objDate = adoRecordset.Fields("pwdLastSet").Value
  117. dtmPwdLastSet = Integer8Date(objDate, lngBias)
  118. Else
  119. dtmPwdLastSet = #1/1/1601#
  120. End If
  121. dtmExpires = DateAdd("d", sngMaxPwdAge, dtmPwdLastSet)

  123. objLogFile.Write strName & ","
  124. objLogFile.Write strEmail & ","
  125. objLogFile.Write dtmExpires
  126. objLogFile.Writeline
  127. adoRecordset.MoveNext
  128. Loop

  130. ' Clean up.
  131. objLogFile.Close
  132. adoRecordset.Close
  133. adoConnection.Close

  135. Function Integer8Date(ByVal objDate, ByVal lngBias)
  136. ' Function to convert Integer8 (64-bit) value to a date, adjusted for
  137. ' local time zone bias.
  138. Dim lngAdjust, lngDate, lngHigh, lngLow
  139. lngAdjust = lngBias
  140. lngHigh = objDate.HighPart
  141. lngLow = objDate.LowPart
  142. ' Account for error in IADsLargeInteger property methods.
  143. If (lngLow < 0) Then
  144. lngHigh = lngHigh + 1
  145. End If
  146. If (lngHigh = 0) And (lngLow = 0) Then
  147. lngAdjust = 0
  148. End If
  149. lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
  150. + lngLow) / 600000000 - lngAdjust) / 1440
  151. ' Trap error if lngDate is ridiculously huge.
  152. On Error Resume Next
  153. Integer8Date = CDate(lngDate)
  154. If (Err.Number <> 0) Then
  155. On Error GoTo 0
  156. Integer8Date = #1/1/1601#
  157. End If
  158. On Error GoTo 0

  160. End Function