Visual Basic Network Services
NetServerEnum: Get Password Age All Users on the Specified Machine
     
Posted:   Sunday December 19, 2004
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   Windows NT4 / Windows 2000, Windows XP, Windows 2003
Author:   VBnet - Randy Birch
     

Related:  

LookupAccountSid: Determine if the Current Process is Running Under Admin Account
NetUserGetInfo: Get User Password Age
LookupAccountName: Verify a User's Account
     
 Prerequisites
One of the operating systems listed under OS Restrictions above.

This demo builds on the principles shown in NetUserGetInfo: Get User Password Age by enumerating machines on the network and upon selection of one, retrieving the user names and password age for each user. 

Again it uses the USER_INFO_1 structure to retrieve the usernames and password age, in addition to using NetServerEnum and SERVER_INFO_100 to determine the logged-on machines. However unlike the other demo this uses NetUserEnum to retrieve the user info. The illustrations show the data returned from my two machines.

The load event takes care of setting up the form.

 BAS Module Code
None.

 Form Code
Add three labels (Label1, Label2, Label3) and two list boxes (List1, List2) to a form along with the following code:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MAX_PREFERRED_LENGTH As Long = -1
Private Const NERR_SUCCESS As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234
Private Const FILTER_NORMAL_ACCOUNT  As Long = &H2
Private Const LB_SETTABSTOPS As Long = &H192

Private Const SV_TYPE_WORKSTATION As Long = &H1
Private Const SV_TYPE_SERVER As Long = &H2

Private Type SERVER_INFO_100
   sv100_platform_id As Long
   sv100_name As Long
End Type

Private Type USER_INFO_1
  usri1_name As Long
  usri1_password As Long
  usri1_password_age As Long
  usri1_priv As Long
  usri1_home_dir As Long
  usri1_comment As Long
  usri1_flags As Long
  usri1_script_path As Long
End Type

Private Declare Function NetServerEnum Lib "Netapi32" _
  (ByVal Servername As Long, _
   ByVal Level As Long, _
   buf As Any, _
   ByVal prefmaxlen As Long, _
   entriesread As Long, _
   totalentries As Long, _
   ByVal servertype As Long, _
   ByVal domain As Long, _
   resume_handle As Long) As Long

Private Declare Function NetUserEnum Lib "Netapi32" _
  (ByVal Servername As Long, _
   ByVal Level As Long, _
   ByVal Filter As Long, _
   bufptr As Long, _
   ByVal prefmaxlen As Long, _
   entriesread As Long, _
   totalentries As Long, _
   resumehandle As Long) As Long

Private Declare Function NetApiBufferFree Lib "Netapi32" _
   (ByVal Buffer As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pTo As Any, uFrom As Any, _
   ByVal lSize As Long)
   
Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long

Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
   (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long



Private Sub Form_Load()

   With List1
      .Move 200, 600, 2000, 2300
   End With
   
   With List2
      .Move List1.Left + List1.Width + 100, 600, 4700, 2300
   End With
   
   Me.Width = List2.Left + List2.Width + 300
   Me.Height = List1.Top + List2.Height + 600
   
   With Label1
      .Caption = "Logged in machines"
      .Move 250, 300, 2000
      .WordWrap = True
      .AutoSize = True
   End With
   
   With Label2
      .Caption = "Users"
      .Move List2.Left + 50, 300, 2000
      .WordWrap = True
      .AutoSize = True
   End With
   
   With Label3
      .Caption = "Password Age"
      .Move List2.Left + 2060, 300, 2000
      .WordWrap = True
      .AutoSize = True
   End With
   
  'set up a tabstop in list2
   Dim TabStop(0 To 0) As Long
   TabStop(0) = 90
   Call SendMessage(List2.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List2.hwnd, LB_SETTABSTOPS, 1, TabStop(0))
   
  'load the available machines
  '(both servers and workstations)
   Call GetServers

End Sub


Private Sub List1_Click()

   If List1.ListIndex > -1 Then
   
      With List2
         .Clear
         .AddItem "working ..."
         .Refresh
      End With
      
      GetUserEnumInfo List1.List(List1.ListIndex)
      
   End If
   
End Sub


Private Sub GetServers()

  'lists all servers of the specified type
  'that are visible in a domain

   Dim bufptr          As Long
   Dim dwEntriesread   As Long
   Dim dwTotalentries  As Long
   Dim dwResumehandle  As Long
   Dim se100           As SERVER_INFO_100
   Dim success         As Long
   Dim nStructSize     As Long
   Dim cnt             As Long

  'Call passing MAX_PREFERRED_LENGTH to have the
  'API allocate required memory for the return values.
  '
  'dwServerName must be Null. The level parameter
  '(100 here) specifies the data structure being
  'used (in this case a SERVER_INFO_100 structure).
  '
  'The domain member is passed as Null, indicating
  'machines on the primary domain are to be retrieved.
  'If you decide to use this member to specify a
  'specific domain, use or pass StrPtr("domain name"),
  'not the string itself.
   nStructSize = LenB(se100)
   
   success = NetServerEnum(0&, _
                           100, _
                           bufptr, _
                           MAX_PREFERRED_LENGTH, _
                           dwEntriesread, _
                           dwTotalentries, _
                           SV_TYPE_WORKSTATION Or SV_TYPE_SERVER, _
                           0&, _
                           dwResumehandle)

  'if all goes well
   If success = NERR_SUCCESS And _
      success <> ERROR_MORE_DATA Then

     'loop through the returned data, adding each
     'machine to the list
      For cnt = 0 To dwEntriesread - 1

        'get one chunk of data and cast
        'into an SERVER_INFO_100 type
        'in order to add the machine
        'name to the list
         CopyMemory se100, ByVal bufptr + (nStructSize * cnt), nStructSize
         List1.AddItem GetPointerToByteStringW(se100.sv100_name)

      Next

   End If

  'clean up, regardless of success
   Call NetApiBufferFree(bufptr)

End Sub


Private Sub GetUserEnumInfo(Optional sServer As String)

   Dim bufptr As Long
   Dim dwEntriesread As Long
   Dim dwTotalentries As Long
   Dim dwResumehandle As Long
   Dim success As Long
   Dim dwServer As Long
   Dim cnt As Long
   Dim nStructSize As Long
   Dim ui1 As USER_INFO_1

   sServer = QualifyServer(sServer)
   dwServer = StrPtr(sServer)
   
   success = NetUserEnum(dwServer, _
                         1, _
                         FILTER_NORMAL_ACCOUNT, _
                         bufptr, _
                         MAX_PREFERRED_LENGTH, _
                         dwEntriesread, _
                         dwTotalentries, _
                         dwResumehandle)
   
   List2.Clear
   
   If success = NERR_SUCCESS And _
      success <> ERROR_MORE_DATA Then
   
      nStructSize = LenB(ui1)
     
      For cnt = 0 To dwEntriesread - 1
         
         CopyMemory ui1, ByVal bufptr + (nStructSize * cnt), nStructSize

         List2.AddItem GetPointerToByteStringW(ui1.usri1_name) & _
                       vbTab & _
                       ConvertPwSeconds(ui1.usri1_password_age)
         
      Next
   
   End If
   
   NetApiBufferFree bufptr   
   
End Sub


Private Function ConvertPwSeconds(dwSeconds As Long) As String

   Dim buff As String

  'assume password has expired
   buff = "(password expired)"

   If dwSeconds > 0 Then
   
      Select Case dwSeconds
      
         Case Is >= 31449600:
            buff = FormatNumber(dwSeconds / 31449600, 2) & " years" & _
                  "  (" & FormatNumber(dwSeconds, 0) & " seconds)"

         Case Is >= 604800:
            buff = FormatNumber(dwSeconds / 604800, 2) & " weeks" & _
                  "  (" & FormatNumber(dwSeconds, 0) & " seconds)"
                  
         Case Is >= 86400:
            buff = FormatNumber(dwSeconds / 86400, 2) & " days" & _
                  "  (" & FormatNumber(dwSeconds, 0) & " seconds)"

         Case Is >= 3600:
            buff = FormatNumber(dwSeconds / 3600, 2) & " hours" & _
                  "  (" & FormatNumber(dwSeconds, 0) & " seconds)"

         Case Is >= 60:
            buff = FormatNumber(dwSeconds / 60, 2) & " minutes" & _
                  "  (" & FormatNumber(dwSeconds, 0) & " seconds)"

         Case Is < 60:
            buff = FormatNumber(dwSeconds, 2) & " seconds"
      
      End Select
      
   End If

   ConvertPwSeconds = buff

End Function


Private Function GetPointerToByteStringW(ByVal dwData As Long) As String

   Dim tmp() As Byte
   Dim tmplen As Long

   If dwData <> 0 Then
      tmplen = lstrlenW(dwData) * 2
      If tmplen <> 0 Then
         ReDim tmp(0 To (tmplen - 1)) As Byte
         CopyMemory tmp(0), ByVal dwData, tmplen
         GetPointerToByteStringW = tmp
     End If
   End If
    
End Function


Private Function QualifyServer(ByVal sServer As String) As String

  'see if there are already two slashes
  'preceeding the server name
   If Left$(sServer, 2) = "\\" Then
   
     'there are, so the server is already
     'qualified; return the passed string
      QualifyServer = sServer
   
   Else
   
     'there aren't two, but is there one?
      If Left$(sServer, 1) = "\" Then
      
        'yes, so add one more
         QualifyServer = "\" & sServer
      
      Else
      
        'the string needs both
         QualifyServer = "\\" & sServer
      
      End If  'If Left$(sServer, 1)
   End If  'If Left$(sServer, 2)
   
End Function
 Comments

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter