[RESOLVED] Getting account expiration date from Active Directory for a given user

[jgags]

I'm need to create a function that gets the account expiration date from Active Directory for a given user. I've been a VB developer for years, but I'm not that familiar with accssing AD information and I'm not seeing a lot of documentation out there. Any help or code samples would be greatly appreciated.

[RhinoBull]

Few comments regarding your request:

- user must have admin rights on the remote server
- you may try using NetUserGetInfo along with USER_INFO_3 structure but I'm not sure about the exp. date.

Here is a sample you may try:

Option Explicit
 
Private Const ERROR_SUCCESS As Long = 0
 
Private Type USER_INFO_3
   usri3_name              As Long
   usri3_password          As Long
   usri3_password_age      As Long
   usri3_priv              As Long
   usri3_home_dir          As Long
   usri3_comment           As Long
   usri3_flags             As Long
   usri3_script_path       As Long
   usri3_auth_flags        As Long
   usri3_full_name         As Long
   usri3_usr_comment       As Long
   usri3_parms             As Long
   usri3_workstations      As Long
   usri3_last_logon        As Long
   usri3_last_logoff       As Long
   usri3_acct_expires      As Long
   usri3_max_storage       As Long
   usri3_units_per_week    As Long
   usri3_logon_hours       As Long
   usri3_bad_pw_count      As Long
   usri3_num_logons        As Long
   usri3_logon_server      As Long
   usri3_country_code      As Long
   usri3_code_page         As Long
   usri3_user_id           As Long
   usri3_primary_group_id  As Long
   usri3_profile           As Long
   usri3_home_dir_drive    As Long
   usri3_password_expired  As Long
End Type
 
Private Declare Function NetUserGetInfo Lib "Netapi32" _
    (servername As Byte, username As Byte, _
    ByVal level As Long, bufptr As Long) As Long
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (pTo As Any, uFrom As Any, ByVal lSize As Long)
 
Private Sub Command1_Click()
Dim success As Long
Dim buff As Long
Dim bServer() As Byte
Dim bUser() As Byte
Dim ui3 As USER_INFO_3
Dim lPwdDaysSoFar As Long
 
    bUser = "validuser" & vbNullChar '<<--- provide valid user
    bServer = "\\some.domain.info" & vbNullChar '<<--- provide valid domain
    
    'retrieve the user info into a buffer
    success = NetUserGetInfo(bServer(0), bUser(0), 3, buff)
    
    If success = ERROR_SUCCESS Then
        
        'copy it to a USER_INFO_3 structure
        CopyMemory ui3, ByVal buff, Len(ui3)
        
        Debug.Print ui3.usri3_acct_expires      'true/false
        Debug.Print ui3.usri3_password_expired  'true/false
        Debug.Print ui3.usri3_password_age      'long (most probably seconds ellapsed since the last change)
        
        lPwdDaysSoFar = ui3.usri3_password_age \ 86400
        Debug.Print "Days since pwd last changed: " & lPwdDaysSoFar
        
    End If
 
End Sub

[jgags]

Thank you. I'll play around with this code and post back when I have time.

[jgags]

Here's what I ended up using:

Public Function days_until_password_expires(ByVal strDomain As String, ByVal strusername As String) As Integer
        Dim dblMaxPwdNano As Double
        Dim dblMaxPwdSecs As Double
        Dim dblMaxPwdDays As Double
        Dim sDomainAndUserName As String = strDomain & "\" & strusername
 
        Dim oDomain As DirectoryEntry = New DirectoryEntry("LDAP://mesaverde", adminusername, adminpwd")
        Dim obj As Object = oDomain.NativeObject
        Dim search As DirectorySearcher = New DirectorySearcher(oDomain)
        search.Filter = "(SAMAccountName=" & strusername & ")"
        search.PropertiesToLoad.Add("cn")
        Dim result As SearchResult = search.FindOne()
        If Not IsDBNull(result) Then
            Dim oUser As DirectoryEntry = result.GetDirectoryEntry
            If Not IsNothing(oUser.Properties("userAccountControl").Value) Then
 
 
                '***********************************************************************************
                ' obtain the maximum password age
                Const ONE_HUNDRED_NANOSECOND = 0.0000001
                Const SECONDS_IN_DAY = 86400
                Dim objMaxPwdAge As ActiveDs.LargeInteger = oDomain.Properties("MaxPwdAge").Value
                If objMaxPwdAge.LowPart = 0 Then
                    'MsgBox("The Maximum Password Age is set to 0 in the domain. Therefore, the password does not expire.")
                Else
                    dblMaxPwdNano = System.Math.Abs(objMaxPwdAge.HighPart * 2 ^ 32 + objMaxPwdAge.LowPart)
                    dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND   ' LINE 13
                    dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)      ' LINE 14
                    'MsgBox("Maximum password age: " & dblMaxPwdDays & " days")
                End If
 
 
 
                ''PasswordLastChanged 
                Dim liPasswdLastSet As ActiveDs.LargeInteger = oUser.Properties("pwdLastSet").Value
 
                ''Convert the highorder/loworder parts to a long 
                Dim datePasswdLastSet As Long = ((CType((liPasswdLastSet.HighPart) * 2 ^ 32, Long)) + CType(liPasswdLastSet.LowPart, Long))
 
                ''Now convert it from FileTime to DateTime string 
                Dim datePasswdLastSetVal As DateTime = DateTime.FromFileTime(datePasswdLastSet)
                Dim datepwdexpire As DateTime = DateValue(datePasswdLastSetVal.AddDays(dblMaxPwdDays))
                Dim ts As TimeSpan = datepwdexpire.Subtract(Now)
 
                Return ts.Days
 
            End If
        End If
    End Function