' 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
' 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 时间: 2003-5-8 22:42
就是这个，非常感谢。作者: Roadbeg 时间: 2003-5-8 22:46
这正想去查 odbc 的 api 说明呢,没想到李兄早有资料,这可好多了. 作者: huanghai 时间: 2003-5-8 22:56
李寻欢 ,你的代码出成果了
