[VBnet Network] NetServerGetInfo: Configuration Info for Domain/Workgroup Servers and Machines

	Visual Basic Network Services NetServerGetInfo: Configuration Info for Domain/Workgroup Servers and Machines

Posted:	Friday March 19, 2006
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows XP
OS restrictions:	Windows NT4, Windows 2000, Windows XP or later
Author:	VBnet - Randy Birch

Related:	NetServerEnum: Obtain Domain/Workgroup Servers and Machines NetServerEnum: Get Version Info for Domain/Workgroup Servers and Machines

Prerequisites

One of the operating systems listed under OS Restrictions above.

NetServerEnum is a versatile function that can lists all servers of the specified type that are visible in a domain.

In addition to listing normal workstations and servers, software flags are also available for to retrieve machines that, for example, lists only domain controllers or only SQL servers. The bit flags can be used individually, combined to list several types (e.g. combining SV_TYPE_WORKSTATION and SV_TYPE_SERVER) to list only machines running that software.

In conjunction with NetServerEnum is a sister API, NetServerGetInfo. Taking either a SERVER_INFO_100, SERVER_INFO_101 or SERVER_INFO_102 structure, this API can return data from the machine name and platform id (Windows NT, Windows, etc), right up to the auto-disconnect time, whether the machine is hidden to other computers in the domain, and the number of users per license.

Since it's always economical to utilize only the minimum structure required for the information desired, for this demo we'll use the SERVER_INFO_100 structure to populate the middle list box in the demo (List2) with machines running the software selected in the top list (List1), and show the OS version information for the selected machine in the bottom list (List3). The demo also utilizes a label to indicate when the call is working and when it's returned (indicated as done). This is helpful when a machine does not immediately respond to the NetServerGetInfo call.

Also utilized is the FormatMessage API to return the error string should a specified machine not be reachable.

There are four entries listed in the machine list when running on my network. The first entry is a wireless print server; the second a TCP/IP network storage disk, and my desktop and laptop computers. As the illustration shows, the print server, even though it is listed when SV_TYPE_ALL is used, does not have an OS thus generates error 58, as shown.

BAS Module Code

None.

Form Code

To a form add three list boxes (List1, List2, List3) and a single label (Label1) to a form. The label captions for the lists are optional. Add the following to the form:

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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'an array to hold the description strings for list3
Private desc() As String

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 FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF

Private Const SV_TYPE_WORKSTATION As Long = &H1
Private Const SV_TYPE_SERVER As Long = &H2
Private Const SV_TYPE_SQLSERVER As Long = &H4
Private Const SV_TYPE_DOMAIN_CTRL As Long = &H8
Private Const SV_TYPE_DOMAIN_BAKCTRL As Long = &H10
Private Const SV_TYPE_TIME_SOURCE As Long = &H20
Private Const SV_TYPE_AFP As Long = &H40
Private Const SV_TYPE_NOVELL As Long = &H80
Private Const SV_TYPE_DOMAIN_MEMBER As Long = &H100
Private Const SV_TYPE_PRINTQ_SERVER As Long = &H200
Private Const SV_TYPE_DIALIN_SERVER As Long = &H400
Private Const SV_TYPE_XENIX_SERVER As Long = &H800
Private Const SV_TYPE_SERVER_UNIX As Long = SV_TYPE_XENIX_SERVER
Private Const SV_TYPE_NT As Long = &H1000
Private Const SV_TYPE_WFW As Long = &H2000
Private Const SV_TYPE_SERVER_MFPN As Long = &H4000
Private Const SV_TYPE_SERVER_NT As Long = &H8000&
Private Const SV_TYPE_POTENTIAL_BROWSER As Long = &H10000
Private Const SV_TYPE_BACKUP_BROWSER As Long = &H20000
Private Const SV_TYPE_MASTER_BROWSER As Long = &H40000
Private Const SV_TYPE_DOMAIN_MASTER As Long = &H80000
Private Const SV_TYPE_SERVER_OSF As Long = &H100000
Private Const SV_TYPE_SERVER_VMS As Long = &H200000
Private Const SV_TYPE_WINDOWS As Long = &H400000 'Windows95 and above
Private Const SV_TYPE_DFS As Long = &H800000 'Root of a DFS tree
Private Const SV_TYPE_CLUSTER_NT As Long = &H1000000 'NT Cluster
Private Const SV_TYPE_TERMINALSERVER As Long = &H2000000 'Terminal Server
Private Const SV_TYPE_DCE As Long = &H10000000 'IBM DSS (Directory and Security Services) or equivalent
Private Const SV_TYPE_ALTERNATE_XPORT As Long = &H20000000 'Return list for alternate transport
Private Const SV_TYPE_LOCAL_LIST_ONLY As Long = &H40000000 'Return local list only
Private Const SV_TYPE_DOMAIN_ENUM As Long = &H80000000 'Return domain list only
Private Const SV_TYPE_ALL As Long = &HFFFFFFFF

Private Const PLATFORM_ID_DOS As Long = 300
Private Const PLATFORM_ID_OS2 As Long = 400
Private Const PLATFORM_ID_NT As Long = 500
Private Const PLATFORM_ID_OSF As Long = 600
Private Const PLATFORM_ID_VMS As Long = 700

Private Const LB_SETTABSTOPS As Long = &H192
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200

'Mask applied to sv*_version_major in
'order to obtain the major version number
Private Const MAJOR_VERSION_MASK As Long = &HF

Private Type SERVER_INFO_100
  sv100_platform_id  As Long
  sv100_name As Long
End Type

Private Type SERVER_INFO_101
  sv101_platform_id  As Long
  sv101_name As Long
  sv101_version_major As Long
  sv101_version_minor As Long
  sv101_type As Long
  sv101_comment 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 NetServerGetInfo Lib "Netapi32" _
  (ByVal servername As Long, _
   ByVal level As Long, _
   bufptr As Any) As Long

Private Declare Function NetApiBufferFree Lib "netapi32.dll" _
   (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 Declare Function FormatMessage Lib "kernel32" _
     Alias "FormatMessageA" _
    (ByVal dwFlags As Long, _
     lpSource As Long, _
     ByVal dwMessageId As Long, _
     ByVal dwLanguageId As Long, _
     ByVal lpBuffer As String, _
     ByVal nSize As Long, _
     Arguments As Any) As Long



Private Sub Form_Load()

  'possible software types
   With List1
      .AddItem "SV_TYPE_WORKSTATION"
      .ItemData(.NewIndex) = SV_TYPE_WORKSTATION
      .AddItem "SV_TYPE_SERVER"
      .ItemData(.NewIndex) = SV_TYPE_SERVER
      .AddItem "SV_TYPE_SQLSERVER"
      .ItemData(.NewIndex) = SV_TYPE_SQLSERVER
      .AddItem "SV_TYPE_DOMAIN_CTRL"
      .ItemData(.NewIndex) = SV_TYPE_DOMAIN_CTRL
      .AddItem "SV_TYPE_DOMAIN_BAKCTRL"
      .ItemData(.NewIndex) = SV_TYPE_DOMAIN_BAKCTRL
      .AddItem "SV_TYPE_TIME_SOURCE"
      .ItemData(.NewIndex) = SV_TYPE_TIME_SOURCE
      .AddItem "SV_TYPE_AFP"
      .ItemData(.NewIndex) = SV_TYPE_AFP
      .AddItem "SV_TYPE_NOVELL"
      .ItemData(.NewIndex) = SV_TYPE_NOVELL
      .AddItem "SV_TYPE_DOMAIN_MEMBER"
      .ItemData(.NewIndex) = SV_TYPE_DOMAIN_MEMBER
      .AddItem "SV_TYPE_PRINTQ_SERVER"
      .ItemData(.NewIndex) = SV_TYPE_PRINTQ_SERVER
      .AddItem "SV_TYPE_DIALIN_SERVER"
      .ItemData(.NewIndex) = SV_TYPE_DIALIN_SERVER
      .AddItem "SV_TYPE_XENIX_SERVER"
      .ItemData(.NewIndex) = SV_TYPE_XENIX_SERVER
      .AddItem "SV_TYPE_SERVER_UNIX"
      .ItemData(.NewIndex) = SV_TYPE_XENIX_SERVER
      .AddItem "SV_TYPE_NT"
      .ItemData(.NewIndex) = SV_TYPE_NT
      .AddItem "SV_TYPE_WFW"
      .ItemData(.NewIndex) = SV_TYPE_WFW
      .AddItem "SV_TYPE_SERVER_MFPN"
      .ItemData(.NewIndex) = SV_TYPE_SERVER_MFPN
      .AddItem "SV_TYPE_SERVER_NT"
      .ItemData(.NewIndex) = SV_TYPE_SERVER_NT
      .AddItem "SV_TYPE_POTENTIAL_BROWSER"
      .ItemData(.NewIndex) = SV_TYPE_POTENTIAL_BROWSER
      .AddItem "SV_TYPE_BACKUP_BROWSER"
      .ItemData(.NewIndex) = SV_TYPE_BACKUP_BROWSER
      .AddItem "SV_TYPE_MASTER_BROWSER"
      .ItemData(.NewIndex) = SV_TYPE_MASTER_BROWSER
      .AddItem "SV_TYPE_DOMAIN_MASTER"
      .ItemData(.NewIndex) = SV_TYPE_DOMAIN_MASTER
      .AddItem "SV_TYPE_SERVER_OSF"
      .ItemData(.NewIndex) = SV_TYPE_SERVER_OSF
      .AddItem "SV_TYPE_SERVER_VMS"
      .ItemData(.NewIndex) = SV_TYPE_SERVER_VMS
      .AddItem "SV_TYPE_WINDOWS"
      .ItemData(.NewIndex) = SV_TYPE_WINDOWS 
      .AddItem "SV_TYPE_DFS"
      .ItemData(.NewIndex) = SV_TYPE_DFS 
      .AddItem "SV_TYPE_CLUSTER_NT"
      .ItemData(.NewIndex) = SV_TYPE_CLUSTER_NT 
      .AddItem "SV_TYPE_TERMINALSERVER"
      .ItemData(.NewIndex) = SV_TYPE_TERMINALSERVER 
      .AddItem "SV_TYPE_DCE"
      .ItemData(.NewIndex) = SV_TYPE_DCE 
      .AddItem "SV_TYPE_ALTERNATE_XPORT"
      .ItemData(.NewIndex) = SV_TYPE_ALTERNATE_XPORT 
      .AddItem "SV_TYPE_LOCAL_LIST_ONLY"
      .ItemData(.NewIndex) = SV_TYPE_LOCAL_LIST_ONLY
      .AddItem "SV_TYPE_DOMAIN_ENUM"
      .ItemData(.NewIndex) = SV_TYPE_DOMAIN_ENUM
      .AddItem "SV_TYPE_ALL"
      .ItemData(.NewIndex) = SV_TYPE_ALL
   End With

  'used to display OS info
   ReDim desc(0 To 12) As String
   
   desc(0) = "server name" & vbTab
   desc(1) = "platform id" & vbTab
   desc(2) = "OS major version" & vbTab
   desc(3) = "OS minor version" & vbTab
   desc(4) = "server comment" & vbTab

  'set up tabstops in List3
   ReDim TabStop(0) As Long
   TabStop(0) = 99
   Call SendMessage(List3.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List3.hwnd, LB_SETTABSTOPS, 1, TabStop(0))

End Sub


Private Sub List1_Click()

   If List1.ListIndex > -1 Then
      
      List2.Clear
      List3.Clear
      Label1.Caption = "Working ...."
      Label1.Refresh
      Call GetServers(List1.ItemData(List1.ListIndex))
      Label1.Caption = "Done."

   End If
   
End Sub


Private Sub List2_Click()
   
   Dim sServername As String
   
   If (List2.ListIndex > -1) Then
   
      Label1.Caption = "Working ...."
      Label1.Refresh
      
      sServername = QualifyServer(List2.List(List2.ListIndex))
      Call GetServerOsInfo(sServername)
      Label1.Caption = "Done."
         
   Else
      List2.AddItem ""
   
   End If
   
End Sub


Private Function GetServers(dwServerType As Long) As Long

  'lists all servers running the specified
  'type of software 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.
  '
  'The call is enumerating all machines on the
  'network (SV_TYPE_ALL); however, by Or'ing
  'specific bit masks for defined types you can
  'customize the returned data. For example, a
  'value of 0x00000003 combines the bit masks for
  'SV_TYPE_WORKSTATION (0x00000001) and
  'SV_TYPE_SERVER (0x00000002).
  '
  'dwServerName must be Null. The level parameter
  '(101 here) specifies the data structure being
  'used (in this case a SERVER_INFO_101 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 enumerate
  'specific domains, pass StrPtr("YourDomainName"),
  'not a string directly.
   success = NetServerEnum(0&, _
                           100, _
                           bufptr, _
                           MAX_PREFERRED_LENGTH, _
                           dwEntriesread, _
                           dwTotalentries, _
                           dwServerType, _
                           0&, _
                           dwResumehandle)

  'if all goes well
   If success = NERR_SUCCESS Then
      
      nStructSize = LenB(se100)
      
     '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_101 struct
        'in order to add the name to a list
         CopyMemory se100, ByVal bufptr + (nStructSize * cnt), nStructSize
            
         List2.AddItem GetPointerToByteStringW(se100.sv100_name)
         
      Next
      
   End If
   
  'clean up, regardless of success
  'and return number of entries read
  'as sign of success
   Call NetApiBufferFree(bufptr)
   GetServers = dwEntriesread

End Function


Private Sub GetServerOsInfo(sServername As String)

   Dim bufptr As Long
   Dim success As Long
   Dim nStructSize As Long
   Dim se101 As SERVER_INFO_101
   
   List3.Clear
   
  'success returns 0 if successful
  'or an error code if not
   success = NetServerGetInfo(StrPtr(sServername), _
                              101, _
                              bufptr)

   If success = NERR_SUCCESS Then
      
     'get one chunk of data and cast
     'into an SERVER_INFO_101 struct
     'and add the data to List3
      nStructSize = LenB(se101)
      CopyMemory se101, ByVal bufptr, nStructSize
         
      List3.AddItem desc(0) & GetPointerToByteStringW(se101.sv101_name)
      List3.AddItem desc(1) & GetPlatform(se101.sv101_platform_id)
      List3.AddItem desc(2) & (se101.sv101_version_major And MAJOR_VERSION_MASK)
      List3.AddItem desc(3) & se101.sv101_version_minor
      List3.AddItem desc(4) & GetPointerToByteStringW(se101.sv101_comment)
      
   Else
   
     'handle any error code by
     'displaying message
      List3.AddItem GetSystemMessage(success)
      
   End If
   
  'clean up
   Call NetApiBufferFree(bufptr)
  
End Sub


Private Function GetSystemMessage(errcode As Long) As String
    
   Dim ret As Long
   Dim sBuff As String
       
  'messages are normally returned with a trailing 
  'CrLf and null char. By specifying FORMAT_MESSAGE_MAX_WIDTH_MASK 
  'we're saying don't add the CrLf.
   sBuff = Space(256)
   ret = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM _
                       Or FORMAT_MESSAGE_IGNORE_INSERTS _
                       Or FORMAT_MESSAGE_MAX_WIDTH_MASK, _
                       0&, errcode, 0, _
                       sBuff, _
                       Len(sBuff), _
                       ByVal 0&)
        
   If (ret <> 0) Then
      GetSystemMessage = TrimNull(sBuff)
   Else
      GetSystemMessage = "unknown error " & errcode
   End If
    
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 GetPlatform(ByVal dwPlatformID As Long) As String

   Select Case dwPlatformID
      Case PLATFORM_ID_DOS: GetPlatform = "DOS"
      Case PLATFORM_ID_OS2: GetPlatform = "Windows 9x"
      Case PLATFORM_ID_NT:  GetPlatform = "Windows NT"
      Case PLATFORM_ID_OSF: GetPlatform = "OSF"
      Case PLATFORM_ID_VMS: GetPlatform = "VMS"
   End Select
   
End Function


Private Function QualifyServer(ByVal sServer As String) As String

  'if nullstring was passed, the
  'API does not expect slashes in
  'the server name
   If Len(sServer) > 0 Then
  
     'are already two slashes
     'preceding 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  'Left$(sServer, 1) <> "\"
      End If  'Left$(sServer, 2) = "\\"
   
   Else
   
     'empty string passed, so return it
      QualifyServer = sServer
      
   End If  'Len(sServer)
   
End Function


Private Function TrimNull(startstr As String) As String

   TrimNull = Trim$(Left$(startstr, lstrlenW(StrPtr(startstr))))

End Function

Comments

PayPal Link