LIsting SQL Server

Posted on 2006-04-04
Last Modified: 2010-04-07
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

Question by:harishkg
    LVL 24

    Expert Comment

    The code you have lists all the sql servers in my network.
    LVL 26

    Expert Comment

    You machine shows as (local)
    LVL 8

    Accepted Solution

    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
        lType = SV_TYPE_SQLSERVER
        ' 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(
                    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

    Find Ransomware Secrets With All-Source Analysis

    Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

    Join & Write a Comment

    Suggested Solutions

    There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
    Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
    As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
    Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

    728 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    24 Experts available now in Live!

    Get 1:1 Help Now