得到网絡中可用的SQL服務器列表
'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&
Declare Function SQLAllocConnect Lib "odbc32.dll" (ByVal henv As Long, _
phdbc As Long) As Integer
Declare Function SQLAllocEnv Lib "odbc32.dll" (phenv As Long) As Integer
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
Declare Function SQLDisconnect Lib "odbc32.dll" (ByVal hdbc As Long) As Integer
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
Declare Function SQLFreeConnect Lib "odbc32.dll" (ByVal hdbc As Long) As Integer
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
'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&
Declare Function SQLAllocConnect Lib "odbc32.dll" (ByVal henv As Long, _
phdbc As Long) As Integer
Declare Function SQLAllocEnv Lib "odbc32.dll" (phenv As Long) As Integer
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
Declare Function SQLDisconnect Lib "odbc32.dll" (ByVal hdbc As Long) As Integer
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
Declare Function SQLFreeConnect Lib "odbc32.dll" (ByVal hdbc As Long) As Integer
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