Detect Active Directory Password Expiration via VPN

[joshiieeii]

Been trying to come up with a solution to a common issue.

I have users that VPN mostly, and when their passwords expire, they get locked out of email, internal sites, ect... Who then submit a help ticket as to why they are getting prompted for passwords... Soooo...I was pondering making a Post VPN Script that will detect if their password is expired.

Here is what I have so far...

Basically what I am trying to acheive is this:

While vpngui.exe is up and running do these things:

• Poll the 4 IP addresses
• See if any of the above 4 IP's matches the criteria (to verify that they have connected to the network)
• If yes, then poll Active Directory to see if their password has expired
• Take the appropriate action based on if the password has expired

Thing I am having issues with:

• Can't seem to get the IP address criteria to be checked more than the 1st time
• The Active Directory poll appears to be affected by latency, is there any way to compensate for latency?

expandcollapse popup

#include <Date.au3>

Const $ADS_NAME_INITTYPE_GC = 3
Const $ADS_NAME_TYPE_NT4 = 3
Const $ADS_NAME_TYPE_1779 = 1
Dim $domain = @LogonDomain   ;pulls domain that user is logged into
Dim $username = @UserName    ;pulls username that is logged in
Dim $oMyError
Do 
    If ProcessExists ("vpngui.exe") then
    $process = 0
    Else
    exit
    EndIf
Dim $ping = Ping ( "127.0.0.1" ) 
    If $ping > 0 Then
    call ("Expire")
    endif
sleep (3000)
until $process = 1

Func Expire ()
sleep (2000)
;~  ConsoleWrite ( "stage 1"& @CRLF)
Dim $oMyError = ObjEvent("AutoIt.Error", "ComError")    
Dim $objRootDSE = ObjGet("LDAP://RootDSE")  
Dim $objTrans = ObjCreate("NameTranslate")  
$objTrans.Init ($ADS_NAME_INITTYPE_GC, "")
$objTrans.Set ($ADS_NAME_TYPE_1779, @LogonDomain)
$objTrans.Set ($ADS_NAME_TYPE_NT4, @LogonDomain & "\" & @UserName)
Dim $strUserDN = $objTrans.Get ($ADS_NAME_TYPE_1779)
sleep (1000)
Dim $UserObj = ObjGet("LDAP://" & $strUserDN)   
Dim $lastlogin =    $UserObj.PasswordLastChanged
Dim $Date = StringMid ($lastlogin, 1, 4)& "/" & StringMid($lastlogin, 5, 2) & "/" & StringMid($lastlogin, 7, 2)
Dim $Time = StringMid($lastlogin, 9, 2) & ":" & StringMid($lastlogin, 11, 2) & ":" & StringMid($lastlogin, 13, 2)

Dim $ExpirationDate = _DateAdd ( "M", 3, $Date)
Dim $TimeLeftExpire = _Datediff ( "D", _NowCalc(), $ExpirationDate)
    If $TimeLeftExpire < 10 > 0 Then
    MsgBox ( 48, "Password Expiration", "Your password will expire in " & $TimeLeftExpire & " Days.")
        If $TimeLeftExpire = 0 then 
        MsgBox ( 48, "Password Expiration", 'Your password has expired, please CTRL + Alt + Del and click "Change Password"')
        exit
    EndIf
    exit
    endif
    If $TimeLeftExpire > 10 Then
    MsgBox ( 48, "Password Expiration", "Your password will expire in " & $TimeLeftExpire & " Days.")
    exit
    EndIf   
EndFunc

;COM Error function
Func ComError()
    If IsObj($oMyError) Then
        $HexNumber = Hex($oMyError.number, 8)
        SetError($HexNumber)
    Else
        SetError(1)
    EndIf
    Return 0
EndFunc ;==>ComError

Edited October 10, 2006 by joshiieeii

[joshiieeii]

Ok, found a combo that works, change to ping instead of detecting the IP address. Also, I added some sleeps to help with the latency, it seems to work thus far, testing further....