Visual Basic Programming Code Examples

Visual Basic > Database SQL Stuff Code Examples

Enumerate the Servers (inc. SQL) on a domain

Enumerate the Servers (inc. SQL) on a domain

To enumerate the SQL servers on a specified domain use the following code:

Option Explicit

Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function NetServerEnum Lib "netapi32" (strServername As Any, ByVal level As Long, bufptr As Long, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, ByVal servertype As Long, strDomain As Any, resumehandle As Long) As Long
Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

'Different types of server
Private Const SV_TYPE_WORKSTATION = &H1, SV_TYPE_SERVER = &H2
Private Const SV_TYPE_SQLSERVER = &H4, SV_TYPE_DOMAIN_CTRL = &H8
Private Const SV_TYPE_DOMAIN_BAKCTRL = &H10, SV_TYPE_TIME_SOURCE = &H20
Private Const SV_TYPE_AFP = &H40, SV_TYPE_NOVELL = &H80, SV_TYPE_ALL = &HFFFFFFFF

Private Type SV_100
    platform As Long
    name As Long
End Type

'Example calling routine
Sub Test()
    Dim saServers() As String, sDomainName As String, lThisDomain As Long
    EnumDomainServers saServers, Environ$("USERDOMAIN")
    On Error GoTo ExitSub
    For lThisDomain = 0 To UBound(saServers)
        Debug.Print saServers(lThisDomain)
    Next
ExitSub:
End Sub


'Purpose   :    To enumerate the servers on a specified domain.
'Inputs    :    [sDomainName]       The domain name to check the servers on. If not specified enumerates the servers
'                                   on the local domain
'               [lType]             The type of server to enumerate. Defaults to SQL Server
'Outputs   :    saServers()         A zero bound string array containing all the servers on the specified domain


Public Sub EnumDomainServers(saServers() As String, Optional sDomainName As String = "Local", Optional lType = SV_TYPE_SQLSERVER)
    Dim lRet As Long, lEntriesRead As Long, lTotalEntries As Long
    Dim lhResume As Long, lBufPtr As Long, lLevel As Long
    Dim lPrefMaxLen As Long, lThisEntry As Long, lptrStart As Long
    Dim abDomain() As Byte
    Dim tSv100 As SV_100

    lLevel = 100
    lPrefMaxLen = -1            'Use automatic max length
    If Right$(sDomainName, 1) <> vbNullChar Then
        abDomain = sDomainName & vbNullChar
    End If

    lRet = NetServerEnum(ByVal 0&, lLevel, lptrStart, lPrefMaxLen, lEntriesRead, lTotalEntries, lType, abDomain(0), lhResume)
    
    If (lRet = 0 Or lRet = 234&) And lEntriesRead > 0 Then
        lBufPtr = lptrStart
        ReDim saServers(0 To lEntriesRead - 1)
        For lThisEntry = 0 To lEntriesRead - 1
            CopyMemory tSv100, ByVal lBufPtr, Len(tSv100)
            saServers(lThisEntry) = StrFromPtr(tSv100.name)
            'Move the pointer along by the length of the structure
            lBufPtr = lBufPtr + Len(tSv100)
        Next
    Else
        'No Servers Found. Clear the array
        Erase saServers
    End If

    'Free the resource
    Call NetApiBufferFree(lptrStart)         
End Sub


'Purpose     :  Converts a pointer to a string into a string.
'Inputs      :  lPtr            A long pointer to a string held in memory
'Outputs     :  The string held at the specified memory address


Private Function StrFromPtr(ByVal lPtr As Long) As String
    Dim lLen As Long
    Dim abytBuf() As Byte

    'Get the length of the string at the memory location
    lLen = lstrlenW(lPtr) * 2 - 1   'Unicode string (must double the buffer size)
    
    If lLen > 0 Then
        ReDim abytBuf(lLen)
        'Copy the memory contents into a byte array
        Call CopyMemory(abytBuf(0), ByVal lPtr, lLen)
        'convert and return the buffer
        StrFromPtr = abytBuf
    End If
End Function