vb搜索局域网内所有SQL Server服务器和指定SQL Server服务器上的所有数据库

引用Microsoft SQLDMO Object Library后，函数SQLServerList搜索所有SQL Server服务器，SQLDatabaseList搜索指定SQL Server服务器上的所有数据库

Public 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
   Dim I 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 Function

Public 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
   Dim I As Long
   On Error GoTo SQLDatabaseListErr
   
   SQLDatabaseList = False
   Set objServer = New SQLDMO.SQLServer
   
   objServer.Connect vstrServer, 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.Description

End Function