Upozonění na expiraci hesla AD uživateli

Je potřeba poslat Active Directory uživateli upozorňovací mejlík, že mu za pár dní vytiká heslo.

cscript “PasswordExpiryEmail.vbs” > PwdExpyEmail.log

a soubor PasswordExpiryEmail.vbs je zde:

Option Explicit
Dim objCommand, objConnection, objChild, objUserConnection, strBase, strFilter, strAttributes, strPasswordChangeDate, intPassAge
Dim lngTZBias, objPwdLastSet, strEmailAddress, objMessage
Dim objShell, lngBiasKey, k, PasswordExpiry, strRootDomain, strFromEmailAdd, strSMTPServerName, strSMTPServerPort
Dim strQuery, objRecordset, strName, strCN
' ********************* CHANGE THESE VALUES TO PASSWORD EXPIRY AND ROOT OF WHERE USERS WILL BE SEARCHED ***********************************
PasswordExpiry=3
strRootDomain="dc=banana,dc=local"
strFromEmailAdd="administrator@banana.local"
strSMTPServerName="mina.banana.local"
strSMTPServerPort=25
' *****************************************************************************************************************************************

' Obtain local Time Zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
If UCase(TypeName(lngBiasKey)) = "LONG" Then
  lngTZBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then
  lngTZBias = 0
  For k = 0 To UBound(lngBiasKey)
    lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
  Next
End If
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strBase = "<LDAP://" & strRootDomain & ">"
' strFilter = "(&(objectCategory=person)(objectClass=user))"
strFilter = "(&(objectCategory=person)(objectClass=user) (!userAccountControl:1.2.840.113556.1.4.803:=2)(!userAccountControl:1.2.840.113556.1.4.803:=65536))"
strAttributes = "sAMAccountName,cn,mail,pwdLastSet,distinguishedName"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute
' WScript.echo "Running at " & Date()
Do Until objRecordSet.EOF
  strName = objRecordSet.Fields("sAMAccountName").Value
  strCN = objRecordSet.Fields("cn").value
  strEmailAddress = objRecordSet.Fields("mail").value
  Wscript.Echo "NT Name: " & strName & ", Common Name: " & strCN & ", Email Address:" & strEmailAddress
  Set objUserConnection = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)
  Set objPwdLastSet = objUserConnection.pwdLastSet
  strPasswordChangeDate = Integer8Date(objPwdLastSet, lngTZBias)
  WScript.Echo vbTab & "Password last changed at " & strPasswordChangeDate
  intPassAge = DateDiff("d", strPasswordChangeDate, Now)
  WScript.Echo vbTab & "Password changed " & intPassAge & " days ago"
  If intPassAge = (PasswordExpiry-3) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 3 days"
    Call SendEmailMessage(strEmailAddress, 3)
  ElseIf intPassAge = (PasswordExpiry-6) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 6 days"
    Call SendEmailMessage(strEmailAddress, 6)
  ElseIf intPassAge = (PasswordExpiry-9) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 9 days"
    Call SendEmailMessage(strEmailAddress, 9)
  End If
  objRecordSet.MoveNext
Loop
objConnection.Close

Function Integer8Date(objDate, lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
  Dim lngAdjust, lngDate, lngHigh, lngLow
  lngAdjust = lngBias
  lngHigh = objDate.HighPart
  lngLow = objdate.LowPart
  ' Account for error in IADslargeInteger property methods.
  If lngLow < 0 Then
    lngHigh = lngHigh + 1
  End If
  If (lngHigh = 0) And (lngLow = 0) Then
    lngAdjust = 0
  End If
  lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
  + lngLow) / 600000000 - lngAdjust) / 1440
' Trap error if lngDate is overly large
  On Error Resume Next
  Integer8Date = CDate(lngDate)
  If Err.Number <> 0 Then
    On Error GoTo 0
    Integer8Date = #1/1/1601#
  End If
  On Error GoTo 0
End Function
Sub SendEmailMessage(strDestEmail, strNoOfDays)
  WScript.echo "Sending Email to:" & strDestEmail
  Set objMessage = CreateObject("CDO.Message")
  objMessage.Subject = "Password Expires in " & strNoOfDays & " days"
  objMessage.From = strFromEmailAdd
  objMessage.To = strDestEmail
  objMessage.TextBody = "Your password expires in " & strNoOfDays & " days. Please change your password now to prevent getting locked out of the network."
  objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServerName ' Your mailserver here
  objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strSMTPServerPort
  objMessage.Configuration.Fields.Update
  objMessage.Send
End Sub


Inspirace se dá hleda zde:
http://www.sheenaustin.com/2009/06/19/active-directory-password-expiry-reminder-email/