全局代码
Public Class SqlLocator
#Region "供使用API方式时使用"
<System.Runtime.InteropServices.DllImport("odbc32.dll")> _
Private Shared Function SQLAllocHandle(hType As Short, inputHandle As IntPtr, ByRef outputHandle As IntPtr) As Short
End Function
<System.Runtime.InteropServices.DllImport("odbc32.dll")> _
Private Shared Function SQLSetEnvAttr(henv As IntPtr, attribute As Integer, valuePtr As IntPtr, strLength As Integer) As Short
End Function
<System.Runtime.InteropServices.DllImport("odbc32.dll")> _
Private Shared Function SQLFreeHandle(hType As Short, handle As IntPtr) As Short
End Function
<System.Runtime.InteropServices.DllImport("odbc32.dll", CharSet := System.Runtime.InteropServices.CharSet.Ansi)> _
Private Shared Function SQLBrowseConnect(hconn As IntPtr, inString As System.Text.StringBuilder, inStringLength As Short, outString As System.Text.StringBuilder, outStringLength As Short, ByRef outLengthNeeded As Short) As Short
End Function
Private Const SQL_HANDLE_ENV As Short = 1
Private Const SQL_HANDLE_DBC As Short = 2
Private Const SQL_ATTR_ODBC_VERSION As Integer = 200
Private Const SQL_OV_ODBC3 As Integer = 3
Private Const SQL_SUCCESS As Short = 0
Private Const SQL_NEED_DATA As Short = 99
Private Const DEFAULT_RESULT_SIZE As Short = 1024
Private Const SQL_DRIVER_STR As String = "DRIVER=SQL SERVER"
#End Region
''' <summary>
''' 禁止实例化
''' </summary>
Private Sub New()
End Sub
''' <summary>
''' 获取网内的数据库服务器名称
''' </summary>
''' <returns>服务器名称数组</returns>
Public Shared Function GetLocalSqlServerNamesWithAPI() As String()
Dim List As String = String.Empty
Dim henv As IntPtr = IntPtr.Zero
Dim hconn As IntPtr = IntPtr.Zero
Dim inString As New System.Text.StringBuilder(SQL_DRIVER_STR)
Dim outString As New System.Text.StringBuilder(DEFAULT_RESULT_SIZE)
Dim inStringLength As Short = CShort(inString.Length)
Dim lenNeeded As Short = 0
Try
If SQL_SUCCESS = SQLAllocHandle(SQL_HANDLE_ENV, henv, henv) Then
If SQL_SUCCESS = SQLSetEnvAttr(henv, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3, 0) Then
If SQL_SUCCESS = SQLAllocHandle(SQL_HANDLE_DBC, henv, hconn) Then
If SQL_NEED_DATA = SQLBrowseConnect(hconn, inString, inStringLength, outString, DEFAULT_RESULT_SIZE, lenNeeded) Then
If DEFAULT_RESULT_SIZE < lenNeeded Then
outString.Capacity = lenNeeded
If SQL_NEED_DATA <> SQLBrowseConnect(hconn, inString, inStringLength, outString, lenNeeded, lenNeeded) Then
Throw New ApplicationException("Unabled to aquire SQL Servers from ODBC driver.")
End If
End If
List = outString.ToString()
Dim start As Integer = List.IndexOf("{") + 1
Dim len As Integer = list.IndexOf("}") - start
If (start > 0) AndAlso (len > 0) Then
list = list.Substring(start, len)
Else
list = String.Empty
End If
End If
End If
End If
End If
Catch
list = String.Empty
Finally
If hconn <> IntPtr.Zero Then
SQLFreeHandle(SQL_HANDLE_DBC, hconn)
End If
If henv <> IntPtr.Zero Then
SQLFreeHandle(SQL_HANDLE_ENV, hconn)
End If
End Try
Dim array As String() = Nothing
If List.Length > 0 Then
array = List.Split(","C)
End If
Return array
End Function
End Class
调用代码
Dim ary() as string = SqlLocator.GetLocalSqlServerNamesWithAPI
For Each a As String In ary
output.show(a)
Next
加好友 
发短信
Post By：2014/12/21 10:44:00 [只看该作者]
