Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1153
  • Last Modified:

LIsting SQL Server

hi Experts,
I am using VB6 and I tried to list the available SQL servers on local network
I use Microsoft SQLDMO Object library in my project and add the following code in a  Form load

    Dim i As Integer
    Dim oNames As SQLDMO.NameList
    Dim oSQLApp As SQLDMO.Application
    Set oSQLApp = New SQLDMO.Application

    Set oNames = oSQLApp.ListAvailableSQLServers()
    For i = 1 To oNames.Count
        List1.AddItem oNames.Item(i)
    Next i

I am testing this now only in the same machine and not in a network, But this is not listing the SQL Server in the same machine eventhough the service is started.
Please help

1 Solution
The code you have lists all the sql servers in my network.
You machine shows as (local)
create a module.
add this code

Option Explicit
' --------------------------------------------------
' Module     : GetSQLServers
' Description: Gets A List of SQLServers for a particular Domain
' --------------------------------------------------

' API declarations

' kernel32 declaration
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetComputerNameEx Lib "kernel32.dll" Alias "GetComputerNameExA" (ByVal NameFormat As Long, ByVal Buffer As String, Size As Long) As Long
Public Const ComputerNameDnsDomain = 2

' netapi declarations
Public 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
Public Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long

Public Const SV_TYPE_SERVER    As Long = &H2
Public Const SV_TYPE_SQLSERVER As Long = &H4

Public Type SV_100
    Platform As Long
    name     As Long
End Type
Public SQLServers As Collection

Public Sub proc_GetSQLServers()
' --------------------------------------------------
' Comments  : hunts for SQL Server boxes on your domain's LAN
' --------------------------------------------------
    On Error GoTo Err_GetSQLServers
    Dim L            As Long
    Dim EntriesRead  As Long
    Dim TotalEntries As Long
    Dim hResume      As Long
    Dim bufPtr       As Long
    Dim Level        As Long
    Dim PrefMaxLen   As Long
    Dim lType        As Long
    Dim Domain()     As Byte
    Dim I            As Long
    Dim sv100        As SV_100
    Dim strDomain    As String
    Level = 100
    PrefMaxLen = -1
    ' use your own domain name
    'Domain = "MYNETWORKDOMAIN" & vbNullChar
    strDomain = GetDomainName
    'search for a .local or .domain ... at the end and remove it
    Set SQLServers = New Collection
    If strDomain = "" Then
        strDomain = MachName
        SQLServers.Add MachName
        Exit Sub
    End If
    If InStr(strDomain, ".") > 0 Then
        strDomain = Left(strDomain, InStr(strDomain, ".") - 1)
    End If

        If (IsNull(Domain)) Or (Len(Format(Domain)) < 1) Then
            'strDomain = InputBox("Please enter your network's Domain Name", "     DOMAIN NAME NEEDED", "MYCOMPANYDOMAIN")
            Screen.MousePointer = vbHourglass
            Domain = Trim$(strDomain) & vbNullChar
            If Len(Format(Domain)) < 1 Then
                ' no value entered, or user cancelled
                MsgBox "No Domain Name value entered," & vbCrLf & "            or user cancelled", vbInformation, "     Exiting Program"
                ' use value entered in inputbox
                Domain = strDomain & vbNullChar
            End If
        End If
    L = NetServerEnum(ByVal 0&, _
            Level, _
            bufPtr, _
            PrefMaxLen, _
            EntriesRead, _
            TotalEntries, _
            lType, _
            Domain(0), _
        If L = 0 Or L = 234& Then
            For I = 0 To EntriesRead - 1
                CopyMemory sv100, ByVal bufPtr, Len(sv100)
                SQLServers.Add Pointer2StringW(sv100.name)
                bufPtr = bufPtr + Len(sv100)
            Next I
        End If
    NetApiBufferFree bufPtr
    On Error GoTo 0
    Exit Sub
    Select Case Err
        Case 0
            Resume Next
        Case Else
            MsgBox "Error Code: " & Err.Number & vbCrLf & vbCrLf & Err.Description & vbCrLf & vbCrLf & Err.Source, vbInformation, "GetSQLServers - Advisory"
            Resume Exit_GetSQLServers
    End Select
End Sub
Private Function Pointer2StringW(ByVal L As Long) As String
    ' --------------------------------------------------
    ' Comments  : converts pointers returned by API call
    '              to string containing the SQL Servers' names
    ' Parameters: L
    ' Returns   : String
    ' --------------------------------------------------
    On Error GoTo Err_Pointer2StringW
    Dim Buffer() As Byte
    Dim nLen     As Long
    nLen = (Len(L)) * 4
    If nLen Then
        ReDim Buffer(0 To (nLen - 1)) As Byte
        CopyMemory Buffer(0), ByVal L, nLen
        Pointer2StringW = Buffer
    End If
    On Error GoTo 0
    Exit Function
    Select Case Err
        Case 0
            Resume Next
        Case Else
            MsgBox "Error Code: " & Err.Number & vbCrLf & vbCrLf & Err.Description & vbCrLf & vbCrLf & Err.Source, vbInformation, "Pointer2StringW - Advisory"
            Resume Exit_Pointer2StringW
    End Select
End Function

Public Function GetDomainName() As String
   Dim lLength As Long
   Dim lRet As Long
   On Error Resume Next
   GetDomainName = String$(255, vbNullChar)
   lLength = 255
   lRet = GetComputerNameEx(ComputerNameDnsDomain, GetDomainName, lLength)
   If lRet = 0 Then
       'return 0 indicates failure
       GetDomainName = ""
       'return <> 0 indicates success, strip trailing null characters
       GetDomainName = Left$(GetDomainName, lLength)
   End If
End Function

' Implimentation on a form with a combobox named cboServers:

        Dim I As Long
        For I = 1 To SQLServers.Count
            cboServers.AddItem SQLServers.Item(I)


Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now