Passwortwechsel Zeitpunkt festlegen

'  
' exch-pwd-expires.vbs  
'  
' Michael B. Smith  
' March 21, 2005  
'  
' This program scans all users in the Users container and all organizational units  
' beneath the HOSTING_OU organizational unit, for users whose passwords have either  
' already expired or will expire within DAYS_FOR_EMAIL days.  
'  
' An email is sent, using CDO, via the SMTP server specified as SMTP_SERVER to the  
' user to tell them to change their password. You should change strFrom to match  
' the email address of the administrator responsible for password changes.  
'  
' You will, at a minimum, need to change the SMTP_SERVER, the HOSTING_OU, and the  
' STRFROM constants. If you run this on an Exchange server, then SMTP_SERVER can   
' be "127.0.0.1" - and it may be either an ip address or a resolvable name.  
'  
' If you don't have an OU containing sub-OU's to scan, then set HOSTING_OU to the  
' empty string ("").  
'  

 Option Explicit

 ' Per environment constants - you should change these!  
 Const HOSTING_OU  = "LDAP Pfad der Benutzer"  
 Const SMTP_SERVER  = "mailserver adresse"  
 Const STRFROM   = "absenderadresse"  
 Const DAYS_FOR_EMAIL  = 15 'Tage bevor das Passwort abläuft an dem Mails gesandt werden sollen  

 ' System Constants - do not change  
 Const ONE_HUNDRED_NANOSECOND    = .000000100   ' .000000100 is equal to 10^-7  
 Const SECONDS_IN_DAY            = 86400
 Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
 Const E_ADS_PROPERTY_NOT_FOUND  = &h8000500D

 ' Change to "True" for extensive debugging output  
 Const bDebug   = true

 Dim objRoot
 Dim numDays, iResult
 Dim strDomainDN
 Dim objContainer, objSub

 Set objRoot = GetObject ("LDAP://RootDSE")  
 strDomainDN = objRoot.Get ("defaultNamingContext")  
 Set objRoot = Nothing

 numdays = GetMaximumPasswordAge (strDomainDN)
 dp "Maximum Password Age: " & numDays  

 If numDays > 0 Then

  Set objContainer = GetObject ("LDAP://CN=Users," & strDomainDN)  
  Call ProcessFolder (objContainer, numDays)
  Set objContainer = Nothing

  If Len (HOSTING_OU) > 0 Then
   Set objContainer = GetObject ("LDAP://OU=" & HOSTING_OU & "," & strDomainDN)  

   For each objSub in objContainer
    Call ProcessFolder (objSub, numDays)
   Next

   Set objContainer = Nothing
  End If

  '========================================  
  ' Add the number of days to the last time  
  ' the password was set.  
  '========================================  
  'whenPasswordExpires = DateAdd ("d", numDays, oUser.PasswordLastChanged)  

  'WScript.Echo "Password Last Changed: " & oUser.PasswordLastChanged  
  'WScript.Echo "Password Expires On: " & whenPasswordExpires  
 End If

 WScript.Echo "Done"  

Function GetMaximumPasswordAge (ByVal strDomainDN)
 Dim objDomain, objMaxPwdAge
 Dim dblMaxPwdNano, dblMaxPwdSecs, dblMaxPwdDays

 Set objDomain = GetObject("LDAP://" & strDomainDN)  
 Set objMaxPWdAge = objDomain.maxPwdAge

 If objMaxPwdAge.LowPart = 0 And objMaxPwdAge.Highpart = 0 Then
  ' Maximum password age is set to 0 in the domain  
  ' Therefore, passwords do not expire  
  GetMaximumPasswordAge = 0
 Else
  dblMaxPwdNano = Abs (objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
  dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
  dblMaxPwdDays = Int (dblMaxPwdSecs / SECONDS_IN_DAY)
  GetMaximumPasswordAge = dblMaxPwdDays
 End If
End Function

Function UserIsExpired (objUser, iMaxAge, iDaysForEmail, iRes)
 Dim intUserAccountControl, dtmValue, intTimeInterval
 Dim strName

 On Error Resume Next
 Err.Clear

 strName = Mid (objUser.Name, 4)
 intUserAccountControl = objUser.Get ("userAccountControl")  

 If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
  dp "The password for " & strName & " does not expire."  
  UserIsExpired = False
 Else
  iRes = 0
  dtmValue = objUser.PasswordLastChanged
  If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
   UserIsExpired = True
   dp "The password for " & strName & " has never been set."  
  Else
   intTimeInterval = Int (Now - dtmValue)
   dp "The password for " & strName & " was last set on " & _  
    DateValue(dtmValue) & " at " & TimeValue(dtmValue) & _  
    " (" & intTimeInterval & " days ago)"  

   If intTimeInterval >= iMaxAge Then
    dp "The password for " & strName & " has expired."  
    UserIsExpired = True
   Else
    iRes = Int ((dtmValue + iMaxAge) - Now)
    dp "The password for " & strName & " will expire on " & _  
     DateValue(dtmValue + iMaxAge) & " (" & _  
     iRes & " days from today)."  

    If iRes <= iDaysForEmail Then
     dp strName & " needs an email for password change"  
     UserIsExpired = True
    Else
     dp strName & " does not need an email for password change"  
     UserIsExpired = False
    End If
   End If

  End If
 End If
End Function

Sub ProcessFolder (objContainer, iMaxPwdAge)
 Dim objUser, iResult

 objContainer.Filter = Array ("User")  

 Wscript.Echo "Checking company = " & Mid (objContainer.Name, 4)  

 For each objUser in objContainer
  If Right (objUser.Name, 1) <> "$" Then  
   If IsEmpty (objUser.Mail) or IsNull  (objUser.Mail) Then
    dp Mid (objUser.Name, 4) & " has no mailbox"  
   Else
    If UserIsExpired (objUser, iMaxPwdAge, DAYS_FOR_EMAIL, iResult) Then
     wscript.Echo "...sending an email for " & objUser.Mail  
     Call SendEmail (objUser, iResult)
    Else
     dp "...don't send an email"  
    End If
   End If
  End If
 Next
End Sub

Sub SendEmail (objUser, iResult)
 Dim objMail

 Set objMail = CreateObject ("CDO.Message")  

 objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing")      = 2  
 objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver")     = SMTP_SERVER  
 objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25  
 objMail.Configuration.Fields.Update

 objMail.From     = STRFROM
 objMail.To       = objUser.Mail

 objMail.Subject  = "Password needs to be set for " & Mid (objUser.Name, 4)  
 objMail.Textbody = "The active directory password for user " & objUser.userPrincipalName & _  
    " (" & objUser.sAMAccountName & ")" & vbCRLF & _  
    "will expire in " & iResult & " days. " & vbCRLF & _  
    "Please change it as soon as possible." & vbCRLF & vbCRLF & _  
    "Thank you," & vbCRLF & _  
    "Absendername"  

 objMail.Send

 Set objMail = Nothing
End Sub

Sub dp (str)
 If bDebug Then
  WScript.Echo str
 End If
End Sub

net user <username> /Domain /LOGONPASSWORDCHG:YES

net user <username> /domain | find /i "Kennwort läuft ab"  

PS C:\> Get-ADUser -Filter 'Name -like "*"' -SearchBase 'OU=HumanResources,OU=UserAccounts,DC=FABRIKAM,DC=COM' -Properties DisplayName | % {Set-ADUser $_ -DisplayName ($_.Surname + ' ' + $_.GivenName)}