如何使用代码得到网络中可用的SQL 服务器列表

huanghai

如图：

李寻欢

Option Compare Text
Option Explicit

'  RETCODEs
Private Const SQL_ERROR As Long = -1&
Private Const SQL_INVALID_HANDLE As Long = -2&
Private Const SQL_NEED_DATA As Long = 99&
Private Const SQL_NO_DATA_FOUND As Long = 100&
Private Const SQL_SUCCESS As Long = 0&
Private Const SQL_SUCCESS_WITH_INFO As Long = 1&

'  SQLError defines
Private Const SQL_NULL_HENV As Long = 0&
Private Const SQL_NULL_HDBC As Long = 0&
Private Const SQL_NULL_HSTMT As Long = 0&

Private Declare Function SQLAllocConnect Lib "odbc32.dll" (ByVal henv As Long, phdbc As Long) As Integer
Private Declare Function SQLAllocEnv Lib "odbc32.dll" (phenv As Long) As Integer
Private Declare Function SQLBrowseConnect Lib "odbc32.dll" (ByVal hdbc As Long, ByVal szConnStrIn As String, ByVal cbConnStrIn As Integer, ByVal szConnStrOut As String, ByVal cbConnStrOutMax As Integer, pcbconnstrout As Integer) As Integer
Private Declare Function SQLDisconnect Lib "odbc32.dll" (ByVal hdbc As Long) As Integer
Private Declare Function SQLError Lib "odbc32.dll" (ByVal henv As Long, ByVal hdbc As Long, ByVal hstmt As Long, ByVal szSqlState As String, pfNativeError As Long, ByVal szErrorMsg As String, ByVal cbErrorMsgMax As Integer, pcbErrorMsg As Integer) As Integer
Private Declare Function SQLFreeConnect Lib "odbc32.dll" (ByVal hdbc As Long) As Integer
Private Declare Function SQLFreeEnv Lib "odbc32.dll" (ByVal henv As Long) As Integer

Public Function StServerList() As String
On Error Resume Next
    Dim rc As Integer
    Dim henv As Long
    Dim hdbc As Long
    Dim stCon As String
    Dim stConOut As String
    Dim pcbConOut As Integer
    Dim ichBegin As Integer
    Dim ichEnd As Integer
    Dim stOut As String
   
    Const COMMA As String = ","
   
    rc = SQLAllocEnv(henv)
    rc = SQLAllocConnect(ByVal henv, hdbc)
    stCon = "DRIVER=SQL Server"
   
    ' Get the size of the buffer to create and create it
    rc = SQLBrowseConnect(ByVal hdbc, stCon, Len(stCon), stConOut, Len(stConOut) + 2, pcbConOut)
    stConOut = String$(pcbConOut + 2, vbNullChar)
   
    ' Get the actual server list
    rc = SQLBrowseConnect(ByVal hdbc, stCon, Len(stCon), stConOut, Len(stConOut) + 2, pcbConOut)
   
    If (rc <> SQL_SUCCESS) And (rc <> SQL_NEED_DATA) Then
        ' ignore the errors if any occur
    Else
        ' Parse out the server list
        ichBegin = InStr(InStr(1, stConOut, "server="), stConOut, "{", vbBinaryCompare)
        stOut = Mid$(stConOut, ichBegin + 1)
        ichEnd = InStr(1, stOut, "}", vbBinaryCompare)
        StServerList = Left$(stOut, ichEnd - 1)
    End If

    ' Disconnect, free the connection handle, then
    ' free the environment handle.
    rc = SQLDisconnect(hdbc)
    rc = SQLFreeConnect(hdbc)
    rc = SQLFreeEnv(henv)
End Function

Private Sub Form_Load()
    MsgBox StServerList
End Sub

huanghai

就是这个，非常感谢。

Roadbeg

这正想去查 odbc 的 api 说明呢,没想到李兄早有资料,这可好多了.

huanghai

李寻欢 ,你的代码出成果了

http://www.office-cn.net/bbs/dispbbs.asp?boardid=5&id=8260&star=#41813

LeeTien

哥们怎么实现
发过来看看啊

xuwenning

6# LeeTien

xuwenning

示例就是根据李寻欢的代码使用2003版创建的
只有一个窗体，如何利用就靠你了

armada_1

这正想去查 odbc 的 api 说明呢,没想到李兄早有资料,这可好多了.

ycxyls

111111111111111111