Как получить список доступных MSSQL серверов?

[Евген]

Как получить список доступных MSSQL серверов?

[Sedge]

Код: Выделить всё

Dim oSQLApp As SQLDMO.Application
Dim oSQLGroup As SQLDMO.ServerGroup
Dim oSQLRegServ As SQLDMO.RegisteredServer

cmbSQLServerName.Clear
Set oSQLApp = New SQLDMO.Application
For Each oSQLGroup In oSQLApp.ServerGroups
  For Each oSQLRegServ In oSQLGroup.RegisteredServers
     cmbSQLServerName.AddItem oSQLRegServ.Name
  Next
Next

Set oSQLApp = Nothing
Set oSQLGroup = Nothing
Set oSQLRegServ = Nothing

+ Добавить ссылку на Microsoft SQLDMO Object Library

[Andrey Fedorov]

Можно вот так:

Код: Выделить всё

Private Sub GetSQLServers()
    Dim l As Long, s As String
    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 i As Long
    Dim sv100 As SV_100
    Dim OSInfo As OSVERSIONINFO
   
    OSInfo.dwOSVersionInfoSize = Len(OSInfo)
    GetVersionEx OSInfo
    If OSInfo.dwPlatformId <> 2 Then Exit Sub

    Level = 100
    PrefMaxLen = -1

    l = NetServerEnum(ByVal 0, 101, BufPtr, PrefMaxLen, EntriesRead, TotalEntries, SV_TYPE_SQLSERVER, ByVal 0, hREsume)
    If l = 0 Or l = 234 Then
        For i = 0 To EntriesRead - 1
            CopyMemory sv100, ByVal BufPtr, Len(sv100)
            s = Trim$(Pointer2StringW(sv100.Name))
            If m_iServers >= 0 And 0 = StrComp(m_sDefServer, s, vbTextCompare) Then
                m_mServers(0).Server = s
                m_mServers(0).Comment = Trim$(Pointer2StringW(sv100.Comment))
                If Len(m_mServers(0).Comment) > 0 Then s = s & " (" & m_mServers(0).Comment & ")"
                cbServer.List(0) = s
            Else
                m_iServers = m_iServers + 1: ReDim Preserve m_mServers(m_iServers)
                m_mServers(m_iServers).Server = s
                m_mServers(m_iServers).Comment = Trim$(Pointer2StringW(sv100.Comment))
            End If
            BufPtr = BufPtr + Len(sv100)
        Next i
    End If
    NetApiBufferFree BufPtr
End Sub

Private Function Pointer2StringW(ByVal l As Long) As String
    Dim Buffer() As Byte, nLen As Long

    nLen = lstrlenW(l) * 2
    If nLen Then
        ReDim Buffer(0 To (nLen - 1)) As Byte
        CopyMemory Buffer(0), ByVal l, nLen
        Pointer2StringW = Buffer
    End If
End Function


[Евген]

Первый вариант не подойдет - нужны все сервера, а так только зарегистрированные.
Со вторым сложнее - кажеться все задекларировал, объявил. Но что-то не то, часть нахожу, часть - нет.

[Andrey Fedorov]

Вот декларации - не знаю все ли тут... Проверь.

Код: Выделить всё

Private Type SV_100
    Platform As Long
    Name As Long
    VersionMajor As Long
    VersionMinor As Long
    Type As Long
    Comment As Long
End Type

Private Type TServer
    Server As String
    Comment As String
End Type

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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, _
                                                       iDomain As Long, _
                                                       ResumeHandle As Long) As Long

Public m_bClosed As Boolean, m_sProfileName As String

Private Const SV_TYPE_SQLSERVER As Long = &H4
Dim m_mServers() As TServer, m_iServers As Integer, _
    m_sDefServer As String, m_sDefDatabase As String, m_sPassword As String
Dim bServerFirstDropDown As Boolean, bDatabaseFirstDropDown As Boolean


[/code]