VBScript: Скрипт, который предлагает сменить пароль пользователю Active Directory за необходимое количество дней до его истечения

Скрипт лучше всего выполнять групповой политикой при входе пользователя в домен Active Directory. Установив значение параметра "warningDays", можно регулировать количество дней до окончания действия пароля, когда пользователю при входе в систему скрипт начнет предлагать сменить пароль на новый.

Function SessionId
    Dim oShell, sCmd, oWMI, oChldPrcs, oCols, lOut
    lOut = 0
    Set oShell  = CreateObject("WScript.Shell")
    Set oWMI    = GetObject(_
        "winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    sCmd = "/K " & Left(CreateObject("Scriptlet.TypeLib").Guid, 38)
    oShell.Run "%comspec% " & sCmd, 0
    WScript.Sleep 100
    Set oChldPrcs = oWMI.ExecQuery(_
        "Select * From Win32_Process Where CommandLine Like '%" & sCmd & "'",,32)
    For Each oCols In oChldPrcs
        lOut = oCols.SessionId
        oCols.Terminate
        Exit For
    Next
    SessionId = lOut
End Function

Function getOSVersion(strComputerName)
	Set objWMI = GetObject("winmgmts://" & strComputerName & "/root/cimv2")
	Set colItems = objWMI.ExecQuery("Select * from Win32_OperatingSystem",,48)
	For Each objItem In colItems
		strOSVersion = left(objItem.Version, 2)
	Next
	getOSVersion = strOSVersion
End Function

Dim oDomain
Dim oUser
Dim maxPwdAge
Dim numDays
Dim intAnswer
Dim intUserAccountControl
Dim boolUserAccountControl
Dim warningDays
Dim strComputerName
Dim strOSVersion
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
'==============================================================================
' Number of days before account expiration to start the warning message.
warningDays = 7
'==============================================================================
strComputerName = "."
strOSVersion = getOSVersion(strComputerName)
If (strOSVersion = "10") Or (strOSVersion = "6.") = True Then
	Set LoginInfo = CreateObject("ADSystemInfo")
	Set objUser = GetObject("LDAP://" & LoginInfo.UserName & "")
	strDomainDN = UCase(LoginInfo.DomainDNSName)
	strUserDN = LoginInfo.UserName
	intUserAccountControl = objUser.Get("userAccountControl")
	If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
		boolUserAccountControl = 0
	Else
		boolUserAccountControl = 1
	End If
	Set oDomain = GetObject("LDAP://" & strDomainDN)
	Set maxPwdAge = oDomain.Get("maxPwdAge")
	numDays = CCur((maxPwdAge.HighPart * 2 ^ 32) + _
	maxPwdAge.LowPart) / CCur(-864000000000)
	Set oUser = GetObject("LDAP://" & strUserDN)
	whenPasswordExpires = DateAdd("d", numDays, oUser.PasswordLastChanged)
	fromDate = Date
	daysLeft = DateDiff("d",fromDate,whenPasswordExpires)
	If (daysLeft < (warningDays + 1)) And (daysLeft > -1) And (boolUserAccountControl = 1) = True Then
		Set oShell = CreateObject( "WScript.Shell" )
		sessionName = LCase(oShell.RegRead("HKCU\Volatile Environment\" &SessionId& "\SESSIONNAME"))
		If ( sessionName = "console" ) Then 
			MsgBox "Your password will expire in " & daysleft _
			& " days on " & whenPasswordExpires _
			& ". To change your password, press CTRL+ALT+DELETE and then click ""Change a password..."".", _
			vbExclamation, "Logon Message"
		Else
			intAnswer = MsgBox("Your password will expire in " & daysleft _
			& " days on " & whenPasswordExpires & ". Do you want to change it now?", _
			vbExclamation + vbYesNo, "Logon Message")
			If intAnswer = vbYes Then
				oShell.Run "explorer.exe shell:::{2559a1f2-21d7-11d4-bdaf-00c04f60b9f0}"
			End If
		End If 
	End If
End If