List SQL Server on a Network

Here is a si=nippit that is done in VB6. You will need to transfer it to .NET


Option Explicit 


' Constants 
Private Const SV_TYPE_SQLSERVER = 4 'this means show all sql servers there are constants for other 
                                         'types of servers also 
Private Const ERR_Success = 0 

' Type 
Private Type SERVER_INFO_100 'server info 100 type this is a constant from MS it returns id 
    sv100_platform_id As Long 'and name there is a 101 that returns much more also a 50 
    sv100_name As Long 
End Type 

' Declares for API & Kernel calls 
Private Declare Function NetServerEnum Lib "Netapi32.dll" _ 
    (ByVal ServerName As String, _ 
    ByVal level As Long, _ 
    ByRef lBufPtr As Long, _ 
    ByRef prefMaxLen As Long, _ 
    entriesRead As Long, _ 
    totalEntries As Long, _ 
    ByVal ServerType As Long, _ 
    ByVal Domain As String, _ 
    resume_handle As Long) As Long 'this one enums the servers 
    ' Important: you MUST pass prefMaxLen by REFERENCE 
     
Private Declare Sub RtlMoveMemory _ 
    Lib "kernel32" ( _ 
    Dest As Any, _ 
    Vsrc As Any, _ 
    ByVal lSize&) 'this on moves a memory chunk 

Private Declare Sub lstrcpyW Lib "kernel32" _ 
    (vDest As Any, ByVal sSrc As Any) 'string copy api 
     
'this one frees buffer mem for use by the os again 
Private Declare Function NetApiBufferFree Lib "Netapi32.dll" _ 
    (ByVal lpBuffer As Long) As Long 
     
'Vars 
Private m_ServerName As String ' Server to run the query on. If left as 
                                  ' a "", will run from the local domain and query 
                                  ' the current sDomain controller 
Private m_NumberOfServers As Integer 'the number of sql servers found 


Public Function EnumSQLServers() As Variant 

    ' This function uses the API call NetSeverEnum (Netapi32.dll) 
    ' to retrieve a list of SQL Servers 
    ' - It will only list those SQL Server using NAMED-PIPES, and, 
    ' - It will ONLY work from an NT/2000 workstation/server. 
    ' It will query the Current/Default Domain Controller to get the list 
    ' 
    ' The API function NetServerEnum returns a list in an array 
    ' that is identified by a pointer (lBuf). 
    ' Since VB doesn't inherantly use "pointers" as does C, 
    ' you have to use the value of lBuf and pass it to other 
    ' Kernel32 calls to manipulate the data/memory. 
    ' 
    ' The NetServerEnum API call actually returns TWO arrays: 
    ' 1) lbuf = POINTER to a array of "bytes" that holds a list consisting of 
    ' "Numread" occurances of "SrvList" that are a user defined type/struct of: 
    ' sv100_platform_id As Long 
    ' sv100_name As Long 
    ' 2) The second array is a "btye" list of the server NAMES in UNICODE 
    ' format. 
    ' You get to the second array by using the value stored in sv100_name. 
    ' This is a POINTER (memory address) to the begining element of 
    ' each of the Server names, followed by a "null" to signify the end of that 
    ' Server name 
    ' ---------------------------------------------------------------------- 
    ' Function return value: 
    ' We return a variant array so that the caller can use the 
    ' inherant VB functions to enum the list when it is returned. 
    ' ---------------------------------------------------------------------- 

                             
    Dim lBuf As Long ' a number that is the acutal memory address 
    ' of the returned info 
                             
    Dim prefMaxLen As Long ' DON'T Set! A "0" means give me everything 
    ' on the first call 
                             
    Dim NumRead As Long ' Number of SQL server names RETURNED in lBuf 
    Dim NumSrvrs As Long ' Number of SQL servers that EXIST 
    Dim sDomain As String ' sDomain to check for servers 
    Dim vRsm As Variant ' "Resume-Handle" [not used] 
    Dim rslt As Long ' error #/result of the API call 

    Dim vsqllist() As Variant ' variant to hold the list we create 
    Dim lBufTmp As Long ' 2nd pointer to be used for manipulation 


    Dim bBufferName(99) As Byte ' temporary array to hold the Sql Server name in 
    ' UNICODE format 
                             
    Dim sTmpName As String ' Temporary string for char conversion from 
    ' a "byteW"(UNICODE) to a string/byte (ANSI) 
                             
    Dim SrvList As SERVER_INFO_100 ' This is a usertype/struct that holds 
    ' the pointers to the specific info we want. 
                                 
    Dim x As Integer 
    Dim y As Integer 

    ' Call for the list 
    ' NetServerEnum is an API call from Netapi32.dll 
    ' Declare this API call in a module 
    rslt = NetServerEnum(vbNullString, 100, lBuf, prefMaxLen, _ 
       NumRead, NumSrvrs, SV_TYPE_SQLSERVER, m_ServerName, vRsm) 
     
    ' If it doesn't work, bail 
    If (rslt <> ERR_Success) Then 
        GoTo Exit_Function 
    End If 

    'set number of servers found to use in the get property later 
    m_NumberOfServers = NumSrvrs 

    ' You CAN'T modify lbuf, it is locked by the OS, 
    ' So, copy the contents of lBuf to lBufTmp 
    ' lBuf holds a LONG that is an Memory ADDRESS to a byte array 
    lBufTmp = lBuf 

    ' Loop through the lBuf Array and get the Server Names 
    ' from the second array 

    For x = 0 To NumRead - 1 
        ' redim the return/result variant(array) to hold one more item 
        ReDim Preserve vsqllist(x) 
     
        ' truncate the temp string 
        sTmpName = vbNullString 
     
        ' Fill the SrvList struct with data from the buffer returned from 
        ' the API call 
        ' The Rtl API call expects you to pass a pointer/memory address, 
        ' by specifying "byval", it "tricks" the API call into using 
        ' the number stored in the lBufTmp var as a memory address, 
        ' instead of using the address of lBufTmp. 
        ' This moves the lbuftmp byte array to the SrvList to translate it later 
        RtlMoveMemory SrvList, ByVal lBufTmp, Len(SrvList) 
                 
        ' SqlSrvr.Name is a *ptr to a byte array 
        ' copy the bytes to a temporary byte array for translation. 
        lstrcpyW bBufferName(0), SrvList.sv100_name 
     
        ' Now convert the "unicode bytes" to a string to get the name. 
        ' If Buffer(y) = 0, the "0" is a string terminator, 
        ' meaning end of this Server Name 
        y = 0 
        Do While bBufferName(y) <> 0 
            sTmpName = sTmpName & Chr$(bBufferName(y)) 
            y = y + 2 'use 2 here because of unicode 
        Loop 
     
        ' Add the string to the Variant(array) 
        vsqllist(x) = sTmpName 
     
        ' Increment lbuftmp to point to the NEXT SrvList item 
        ' in the list returned by the API call. 
        lBufTmp = lBufTmp + Len(SrvList) 

    Next x 

    'return the list of servers and free mem 
    If lBuf Then NetApiBufferFree (lBuf) 
    'redim the array here. if it has values nothing happens, if it doesn't have any values we need it 
    'to contain the 0 entry so we can set it to the not sql servers found 
    'if numsrvrs = 0 then no sqlservers found so say so. 
    If NumSrvrs = 0 Then 
        ReDim Preserve vsqllist(x) 
        vsqllist(0) = "No SQL Servers Found" 
    End If 
    EnumSQLServers = vsqllist 
    Exit Function 

Exit_Function: 
    ' Avoid Memory leaks! 
    If lBuf Then NetApiBufferFree (lBuf) 

    Select Case rslt 
        Case Is = 6118 
            Err.Raise vbObjectError + 514, "EnumSQLServers", "Domain Not Found" 
        Case Is = 53 
            Err.Raise vbObjectError + 515, "EnumSQLServers", "Domain Not Available At This Time" 
        Case Else 
            ' Return an error to the caller it will raise error 513 which is the first userdefined error 
            Err.Raise vbObjectError + 513, "EnumSQLServers", "Enumeration Failed Return Code = " & rslt 
    End Select 
     
End Function 

Public Property Get ServerCount() As String 'Number of servers enumerated 
    ServerCount = m_NumberOfServers 
End Property 

Public Property Get DomainToQuery() As String 'which domain to use property 
    DomainToQuery = StrConv(m_ServerName, vbFromUnicode) 'convert back to standard string 
End Property 

Public Property Let DomainToQuery(ByVal Domain As String) 

    If Domain = "" Then Exit Property 'if no domain then exit property we don't want to convert 
                                              'an empty string to unicode 
    m_ServerName = StrConv(Domain, vbUnicode) 'convert to unicode so api can use it 
     
End Property