VB怎么列举局域网上的SQL服务器名，像数据器连接配置一样？

Question

怎么列举局域网上的SQL服务器名，再列出服务器中的所有数据库
谢谢

Answer 1

两个文本框，一个按钮
Dim ServerName() As String
Dim DataName() As String
Dim Server As String
Dim I As Long
Dim j As LongPublic Function SQLServerList(ByRef strServerName() As String, _
                              Optional ByRef rlngErrNum As Long, _
                              Optional ByRef rstrErrDescr As String) As Boolean
                              
   Dim objServerApp As SQLDMO.Application
   Dim objServers As SQLDMO.NameList
   Dim lngServerCount As Long
   On Error GoTo SQLServerListErr
   
   SQLServerList = False
   Set objServerApp = New SQLDMO.Application
   Set objServers = objServerApp.ListAvailableSQLServers
   
   lngServerCount = objServers.Count
   ReDim strServerName(lngServerCount - 1)
   
   For I = 1 To lngServerCount
   
      strServerName(I - 1) = objServers.Item(I)
   
   Next I
   
   SQLServerList = True
   
   Err.Clear
SQLServerListErr:
   Set objServers = Nothing
   Set objServerApp = Nothing
   
   rlngErrNum = Err.Number
   rstrErrDescr = Err.Description
End FunctionPublic Function SQLDatabaseList(ByVal vstrServer As String, _
                              strDatabase() As String, _
                              Optional ByVal vstrUser As String = "sa", _
                              Optional ByVal vstrPassWord As String = "", _
                              Optional rlngErrNum As Long, Optional rstrErrDescr As String) As Boolean
                              
   Dim objServer As SQLDMO.SQLServer
   Dim lngDatabaseCount As Long
   On Error GoTo SQLDatabaseListErr
   
   SQLDatabaseList = False
   Set objServer = New SQLDMO.SQLServer
   
   objServer.Connect "lch", vstrUser, vstrPassWord   lngDatabaseCount = objServer.Databases.Count
   ReDim strDatabase(lngDatabaseCount - 1)
   
   For I = 1 To lngDatabaseCount
      strDatabase(I - 1) = objServer.Databases.Item(I, "dbo").Name
   Next I
   
   SQLDatabaseList = True
   
   Err.Clear
SQLDatabaseListErr:
   Set objServer = Nothing
   
   rlngErrNum = Err.Number
   rstrErrDescr = Err.DescriptionEnd Function
Private Sub Command1_Click()
Call SQLServerList(ServerName())
For I = 0 To UBound(ServerName)
Text1 = Text1 & ServerName(I) & vbCrLfCall SQLDatabaseList(ServerName(I), DataName())
For j = 0 To UBound(DataName)
Text2 = Text2 & DataName(j) & vbCrLf
Next
NextEnd SubPrivate Sub Form_Load()End Sub