Listing 1: EnumerateServers
The code on this page is oft published in the newsgroups and while I've used
it for years, I've no idea who gets credit for it. A search of Google
Groups for the keyword "NetServerEnum" reveals numerous posts with similar code, but I
found no author. Other than leveraging the SQL-DMO library (which isn't
installed on most usre's machines), there seems to be no other solution to the
question of enumerating servers.
Paste the following code into a VB or VBA module and compile. It was
tested after having been formatted in this html page and worked when run from an
Access 2003 code module.
' -- BEGIN MODULE
CODE --
Option Compare Database
Option Explicit
'* Server Type Definitions
Const SV_TYPE_WORKSTATION =
&H1
'* All Net Workstations
Const SV_TYPE_SERVER =
&H2
'* All Net Servers
Const SV_TYPE_SQLSERVER =
&H4
'* Any Server Running MS SQL Server
Const SV_TYPE_DOMAIN_CTRL =
&H8
'* PDCs
Const SV_TYPE_DOMAIN_BAKCTRL =
&H10 '*
BDCs
Const SV_TYPE_TIMESOURCE =
&H20
'* Servers running the TimeSource Service
Const SV_TYPE_AFP =
&H40
'* Apple File Protocol Servers
Const SV_TYPE_NOVELL =
&H80
'* Novell Servers
Const SV_TYPE_DOMAIN_MEMBER =
&H100 '*
LAN Manager 2.x Domain Member
Const SV_TYPE_PRINT =
&H200
'* Server sharing print queue
Const SV_TYPE_DIALIN =
&H400
'* Server running dial-in service
Const SV_TYPE_XENIX_SERVER =
&H800 '* Xenix server
Const SV_TYPE_NT =
&H1000
'* Windows NT (either Workstation or
Server)
Const SV_TYPE_WFW =
&H2000
'* Server running Windows for Workgroups
Const SV_TYPE_MFPN =
&H4000
'* Microsoft File and Print for Netware
Const SV_TYPE_SERVER_NT =
&H8000 '* Windows NT Non-DC server
Const SV_TYPE_POTENTIAL_BROWSER = &H10000
'* Server that can run the Browser
service
Const SV_TYPE_BACKUP_BROWSER =
&H20000 '* Server running
a Browser service as backup
Const
SV_TYPE_MASTER_BROWSER = &H40000 '* Server running the master Browser service
Const SV_TYPE_DOMAIN_MASTER =
&H80000 '* Server
running the domain master Browser
Const
SV_TYPE_WINDOWS =
&H400000
'* Windows 95 or later
Const SV_TYPE_LOCAL_LIST_ONLY = &H40000000 '* Servers maintained by the browser
Const SV_TYPE_DOMAIN_ENUM =
&H80000000 '* Primary
Domain
Const
SV_TYPE_ALL =
&HFFFFFFFF
'* All servers
'* Server
Data Structure used for this function
Type
SERVER_INFO_100
lgSvi100_platform_id As
Long
lgSvi100_servername As Long
End
Type
'* Declare the NetAPI
function
Declare Function NetServerEnum Lib "NetAPI32.DLL" (btComputerName As
Byte, _
ByVal lgLevel As Long, anBuffer As
Any, lgPreferedMaxLen As Long, _
lgEntriesRead As Long, lgTotalEntries As Long, anServerType As Any,
_
btDomain As Byte, lgResumeHandle As Long) As Long
'* Declare the function to
free the buffer
Declare Function NetAPIBufferFree Lib
"NetAPI32.DLL" Alias _
"NetApiBufferFree" (ByVal
lgPtr As Long) As Long
'*
Declare the CopyMemory function
Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" _
(anDest As
Any, ByVal lgSrc As Long, ByVal lgSize As Long)
'* Declare the Array used to
store the servernames
Public stServerArray()
As String
Public Function
EnumerateServers(stType As String) As String
On Error Resume Next
'* Enumerates Servers by Type
Passed into function
Dim lgResult As Long
Dim lgTotalEntries As Long
Dim lgPrefMaxLen As Long
Dim
lgEntriesRead As Long
Dim lgResumeHandle As Long
Dim
stDomain As String
Dim lgBufPtr As Long
Dim lgServerType As Long
Dim
btSrvArray(32) As Byte
Dim btDomain() As Byte
Dim btCompName() As Byte
Dim
i As Integer
Dim stCompName As String
Dim stServerName As String
Dim stText As String
Dim ServerStruct As SERVER_INFO_100
'* Clear values and initialize all of the
variables
lgResumeHandle = 0
ReDim stServerArray(0) As String
'* Set the
domain to the default, primary domain
stDomain =
""
'* Set the computer name to the default, local
system
stCompName = ""
'* Create Null Terminated
Strings
btDomain = stDomain &
vbNullChar
btCompName = stCompName &
vbNullChar
'* Determine stType
Values and set servertype value
'* You may add or remove
these types as needed for your application
If stType = "DCs" Then
'* Enumerate Domain
Controllers
lgServerType =
SV_TYPE_DOMAIN_CTRL + SV_TYPE_DOMAIN_BAKCTRL
ElseIf stType = "SVs" Then
'* Enumerate
Servers
lgServerType =
SV_TYPE_SERVER
ElseIf stType =
"WKs" Then
'* Enumerate
Workstations
lgServerType =
SV_TYPE_WORKSTATION
ElseIf stType
= "ALL" Then
'* Enumerate All
Machines
lgServerType =
SV_TYPE_ALL
ElseIf stType = "WFW"
Then
'* Windows for
Workgroups Servers
lgServerType = SV_TYPE_WFW
ElseIf
stType = "SQL" Then
'* Servers running SQL
Server
lgServerType =
SV_TYPE_SQLSERVER
ElseIf stType =
"NOV" Then
'* Novell
Servers
lgServerType =
SV_TYPE_NOVELL
Else
'* Select Default as
all NT Servers
lgServerType
= SV_TYPE_SERVER + SV_TYPE_NT
End
If
'* Call
NetServerEnum to get a list of Servers
lgResult =
NetServerEnum(btCompName(0), 100, lgBufPtr, lgPrefMaxLen,
_
lgEntriesRead, lgTotalEntries, ByVal lgServerType, ByVal
btDomain(0), _
lgResumeHandle)
EnumerateServers = lgResult
'* Now that we know how many entries were read,
size the array
If
lgTotalEntries <= 0 Then
MsgBox "No Entries Read. Error Code = " & CStr(lgResult)
Exit Function
End
If
ReDim stServerArray(lgTotalEntries - 1) As
String
'* Check for
errors
'* 234 means multiple reads
required
If lgResult
<> 0 And lgResult <> 234 Then
If
lgResult = 2351 Then
stText = "ServerName not found." & Chr$(13) &
_
"Be sure you used the leading \\ on the
servername."
Else
stText = "Error " & lgResult & " enumerating server " &
_
lgEntriesRead
& " of " & lgTotalEntries
End If
MsgBox
stText
Exit Function
End If
For i = 1 To
lgTotalEntries
'* Dereference the ServerStruct Data
Structure
CopyMemory
ServerStruct, lgBufPtr, Len(ServerStruct)
'* Dereference the
server name variable
CopyMemory
btSrvArray(0), ServerStruct.lgSvi100_servername,
33
stServerName =
btSrvArray
Trim (stServerName)
'* send the servername
to the array
'* Change the code
here to send the servername to a control,
etc.
Dim strServer As
String
Dim strallservers As
String
strServer =
ExtractServerName(stServerName)
strallservers = strallservers & ";" & strServer
'* Clear the servername
variable here
stServerName
= ""
'* Move
to the next part of the
buffer
lgBufPtr = lgBufPtr
+ Len(ServerStruct)
Next
i
'* Release the memory used for
the ServerStruct buffer
lgResult =
NetAPIBufferFree(lgBufPtr)
EnumerateServers =
strallservers
End Function
Private Function ExtractServerName(sName As
String)
On Error Resume Next
Dim strExtractedServer
As String
Dim i As Integer
Dim strChar As String *
1
For i = 1 To 100
strChar =
Mid(sName, i, 1)
If Asc(strChar) = 0 Then Exit
For
Next
i
strExtractedServer = Left(sName, i -
1)
ExtractServerName = strExtractedServer
End Function