Private Const SV_TYPE_SQLSERVER As Long = &H4 ' SQL Server
Const ERROR_SUCCESS = 0
Const ERROR_MORE_DATA = 234
Const SIZE_SI_101 = 24
Private Type SERVER_INFO_101
dwPlatformId As Long
lpszServerName As Long
dwVersionMajor As Long
dwVersionMinor As Long
dwType As Long
lpszComment As Long
End Type
Private Declare Sub RtlMoveMemory Lib "kernel32" ( _
hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function NetServerEnum Lib "netapi32.dll" ( _
ByVal servername As String, _
ByVal Level As Long, _
BUFFER As Long, _
ByVal PrefMaxLen As Long, _
entriesread As Long, _
totalentries As Long, _
ByVal ServerType As Long, _
ByVal domain As String, _
resumehandle As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" ( _
BufPtr As Any) As Long
Private Declare Function lstrcpyW Lib "kernel32" ( _
ByVal lpszDest As String, ByVal lpszSrc As Long) As Long
Public Sub GetServerList()
'This sub scans the local network for all Servers running SQL Server. It outputs the list to a combo box
Dim pszTemp As String
Dim pszServer As String
Dim pszDomain As String
Dim lLevel As Long
Dim i As Long
Dim BufPtr As Long
Dim TempBufPtr As Long
Dim PrefMaxLen As Long
Dim lEntriesRead As Long
Dim lTotalEntries As Long
Dim lServerType As Long
Dim lResumeHandle As Long
Dim lRes As Long
Dim ServerInfo As SERVER_INFO_101
pszServer = vbNullString
pszDomain = vbNullString
lLevel = 101
BufPtr = 0
lPrefMaxLen = &HFFFFFFFF
lEntriesRead = 0
lTotalEntries = 0
lServerType = SV_TYPE_SQLSERVER
lResumeHandle = 0
Do
lRes = NetServerEnum(pszServer, lLevel, BufPtr, _
lPrefMaxLen, lEntriesRead, lTotalEntries, _
lServerType, pszDomain, lResumeHandle)
If ((lRes = ERROR_SUCCESS) Or (lRes = ERROR_MORE_DATA)) And _
(lEntriesRead > 0) Then
TempBufPtr = BufPtr
For i = 1 To lEntriesRead
RtlMoveMemory ServerInfo, TempBufPtr, SIZE_SI_101
'Add Records to ComboBox
Combo1.AddItem PointerToString(ServerInfo.lpszServerName)
TempBufPtr = TempBufPtr + SIZE_SI_101
Next i
Else
MsgBox "NetServerEnum failed: " & lRes
End If
NetApiBufferFree (BufPtr)
Loop While lEntriesRead < lTotalEntries
End Sub
Public Function PointerToString(lpszString As Long) As String
' converts a pointer to a string to a VB string
Dim lpszStr1 As String
Dim lpszStr2 As String
Dim lRes As Long
lpszStr1 = String(1000, "*")
lRes = lstrcpyW(lpszStr1, lpszString)
lpszStr2 = (StrConv(lpszStr1, vbFromUnicode))
PointerToString = Left(lpszStr2, InStr(lpszStr2, Chr$(0)) - 1)
End Function