Windows Server 2008 R2 Kennwortrichtlinie - Verständnisfrage

set v=%date%.log

cscript "PasswordExpiryEmail.vbs" >> %v%

exit

Option Explicit

Dim objCommand, objConnection, objChild, objUserConnection, strBase, strFilter, strAttributes, strPasswordChangeDate, intPassAge
Dim lngTZBias, objPwdLastSet, strEmailAddress, objMessage
Dim objShell, lngBiasKey, k, PasswordExpiry, strRootDomain, strFromEmailAdd, strBCCEmailAdd, strSMTPServerName, strSMTPServerPort
Dim strQuery, objRecordset, strName, strCN

' ********************* CHANGE THESE VALUES TO PASSWORD EXPIRY AND ROOT OF WHERE USERS WILL BE SEARCHED ***********************************

PasswordExpiry=90
strRootDomain="dc=domäne,dc=local"
strFromEmailAdd="absender@domäne.de"
strBCCEmailAdd="blindkopie@domäne.de"
strSMTPServerName="exchangeserver.domäne.local"
strSMTPServerPort=port (normal isses 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 = "Your Password Expires in " & strNoOfDays & " days"
objMessage.From = strFromEmailAdd
objMessage.To = strDestEmail
objMessage.Bcc = strBCCEmailAdd
objMessage.TextBody = "Your password expires in " & strNoOfDays & " days." & vbCRLF & "Please change your password now to prevent your Account " & vbCRLF & " " & strName & " " & vbCRLF & " 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