如何获取局域网SQL服务器名

#1

安装  MS  SQL  Server  server/client
引用  Microsoft  SQLDMO  Object  Library

'下面是代码
Option  Explicit

Private  Sub  Command1_Click()
On  Error  GoTo  Err1
       Dim  dmoObj  As  New  SQLDMO.Application
       Dim  I              As  Long

       For  I  =  1  To  dmoObj.ListAvailableSQLServers.Count
               List1.AddItem  dmoObj.ListAvailableSQLServers.Item(I)
       Next
Err1:
End  Sub

#2

在开始-》运行里输入"regsvr32 SQLDMO.DLL"

#3

偶喜欢API,不喜欢DMO

#4

'在网络中查找 SQL 服务器，并将其赋给 frmLand.cmbSName
Private Function getSNameList() As Boolean
    Dim errVSQL As Boolean
    errVSQL = True
    On Error GoTo errSQL
    Dim Server As SQLDMO.NameList
    Dim appDMO As New SQLDMO.Application
    Dim i As Integer
    Set Server = appDMO.ListAvailableSQLServers
    For i = 1 To Server.Count
        cmbSName.AddItem Server(i)
    Next
    errVSQL = False
errSQL:
    If errVSQL Then
        getSNameList = False
    Else
        getSNameList = True
    End If
End Function

Private Sub Form_Load()
    getSNameList
End Sub

#5

楼上的兄弟们，你们都理解错啦，如果用SQL-DMO组件，你们有没有在没有安装SQL的机子上注册这个组件成功过啊。

nik_Amis(Azrael) ：我也想用API，不过我都找不到这类函数，你能不能给点代码？？

#6

这方面的东西好就没搞了，列了一段代码，未测试
最主要API:NetServerEnum具体你自己在研究研究

如果我给的代码少什么东西我再给你找

Private Declare Function NetServerEnum Lib "netapi32" (strServername As Any, ByVal level As Long, BufPtr As Long, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, ByVal servertype As Long, strDomain As Any, resumehandle As Long) As Long

Public Function GetAllDomainSQLServers(ByRef aServer() As String) As Boolean
    Dim l As Long, entriesread As Long, totalentries As Long, hREsume As Long
    Dim BufPtr As Long, level As Long, prefmaxlen As Long, lType As Long
    Dim domain() As Byte, i As Long, sv100 As SV_100, nIndex As Integer
    Dim nCount As Integer, aDomain() As String, n As Integer

    On Error Resume Next
    aDomain = EnumDomains
    If Not IsArray(aDomain) Then GetAllDomainSQLServers = False: Exit Function
    nCount = UBound(aDomain)
    nIndex = 0
    For n = 1 To nCount
        level = 100: prefmaxlen = -1
        lType = SV_TYPE_SQLSERVER
        domain = aDomain(n) & vbNullChar
        l = NetServerEnum(ByVal 0&, level, BufPtr, prefmaxlen, entriesread, totalentries, lType, domain(0), hREsume)
    '    Erase aServer
        If l = 0 Or l = 234& Then
            For i = 0 To entriesread - 1
                CopyMemory sv100, ByVal BufPtr, Len(sv100)
                ReDim Preserve aServer(nIndex)
                aServer(nIndex) = Pointer2stringw(sv100.name)
                nIndex = nIndex + 1
                BufPtr = BufPtr + Len(sv100)
            Next i
        End If
        NetApiBufferFree BufPtr
    Next
    GetAllDomainSQLServers = (Err.Number = 0)
End Function

Public Function EnumDomains() As Variant
    Dim plngRtn As Long, plngEnumHwnd As Long, plngCount As Long, plngLoop As Long, plngBufSize As Long
    Dim pastrDomainNames() As String, patypNetAPI(0 To MAX_RESOURCES) As NETRESOURCE
    plngEnumHwnd = 0&
    plngRtn = WNetOpenEnum(dwScope:=RESOURCE_GLOBALNET, dwType:=RESOURCETYPE_ANY, dwUsage:=RESOURCEUSAGE_ALL, lpNetResource:=ByVal 0&, lphEnum:=plngEnumHwnd)
    If plngRtn = NO_ERROR Then
        plngCount = RESOURCE_ENUM_ALL
        plngBufSize = (UBound(patypNetAPI) + 100) * Len(patypNetAPI(0))
        plngRtn = WNetEnumResource(hEnum:=plngEnumHwnd, lpcCount:=plngCount, lpBuffer:=patypNetAPI(0), lpBufferSize:=plngBufSize)
    End If
    If plngEnumHwnd <> 0 Then Call WNetCloseEnum(plngEnumHwnd)
    plngRtn = WNetOpenEnum(dwScope:=RESOURCE_GLOBALNET, dwType:=RESOURCETYPE_ANY, dwUsage:=RESOURCEUSAGE_ALL, lpNetResource:=patypNetAPI(0), lphEnum:=plngEnumHwnd)
    plngCount = 200
    If plngRtn = NO_ERROR Then
        plngCount = RESOURCE_ENUM_ALL
        plngBufSize = UBound(patypNetAPI) * Len(patypNetAPI(0))
        plngRtn = WNetEnumResource(hEnum:=plngEnumHwnd, lpcCount:=plngCount, lpBuffer:=patypNetAPI(0), lpBufferSize:=plngBufSize)
        If plngCount > 0 Then
            ReDim pastrDomainNames(1 To plngCount) As String
            For plngLoop = 0 To plngCount - 1
                pastrDomainNames(plngLoop + 1) = PointerToAsciiStr(patypNetAPI(plngLoop).pRemoteName)
            Next plngLoop
        End If
    End If
    If plngEnumHwnd <> 0 Then Call WNetCloseEnum(plngEnumHwnd)
    EnumDomains = pastrDomainNames
End Function

Private Function Pointer2stringw(ByVal l As Long) As String
    Dim Buffer() As Byte, nLen As Long
    nLen = lstrlenW(l) * 2
    If nLen Then
        ReDim Buffer(0 To (nLen - 1)) As Byte
        CopyMemory Buffer(0), ByVal l, nLen
        Pointer2stringw = Buffer
    End If
End Function

Private Function PointerToAsciiStr(ByVal xilngPtrToString As Long) As String
    On Error Resume Next         ' Don't accept an error here
    Dim plngLen As Long, pstrStringValue As String, plngNullPos As Long, plngRtn As Long
    plngLen = StrLenA(xilngPtrToString)
    If xilngPtrToString > 0 And plngLen > 0 Then
        pstrStringValue = Space$(plngLen + 1)
        plngRtn = StrCopyA(pstrStringValue, xilngPtrToString)
        plngNullPos = InStr(pstrStringValue, Chr$(0))
        If plngNullPos > 0 Then
            PointerToAsciiStr = Left$(pstrStringValue, plngNullPos - 1)    'Lose the null terminator...
        Else
            PointerToAsciiStr = pstrStringValue 'Just pass the string...
        End If
    Else
        PointerToAsciiStr = ""
    End If
End Function

#7

谢谢，我先去试试，

#8

NetServerEnum这个函数不行，
运行时，DLL入口不对

#9

Private  Sub  GetSqlServer()
Dim  oSQLServerDMOApp  As  Object
Dim  i  As  Integer
Dim  namX  As  Object
   On  Error  Resume  Next
   Set  oSQLServerDMOApp  =  CreateObject("SQLDMO.Application")
   Set  namX  =  oSQLServerDMOApp.ListAvailableSQLServers
   For  i  =  1  To  namX.Count
       cmbServer.AddItem  namX.Item(i)
   Next
   cmbServer.ListIndex  =  0

End  Sub

---------------------------------------------------------------

安装  MS  SQL  Server  server/client
引用  Microsoft  SQLDMO  Object  Library

'CODE
Option  Explicit

Private  Sub  Command1_Click()
On  Error  GoTo  Err1
       Dim  dmoObj  As  New  SQLDMO.Application
       Dim  I  As  Long

       For  I  =  1  To  dmoObj.ListAvailableSQLServers.Count
             List1.AddItem  dmoObj.ListAvailableSQLServers.Item(I)
       Next
Err1:
End  Sub

#10

NetAPI32.dll不能在98系统下注册的，这样的话有些机子就不能用了，

#11

还有没有人知道啊，
自己UP

#12

'局域网里搜索SQL服务器
'可以列出局域网内注册或未注册的SQL服务器
'参数：用于显示服务器名的组合框
Public Function GetLocalSQLServer(ByRef cmbServer As ComboBox) As Boolean
    Dim oSQLServerDMOApp   As SQLDMO.Application
    Dim oServerGroup   As SQLDMO.ServerGroup
    Dim oRegisteredServer   As SQLDMO.RegisteredServer
    Dim i   As Integer, j   As Integer
    Dim namX   As NameList
    Dim blnEquate As Boolean

    Screen.MousePointer = 11

    Set oSQLServerDMOApp = New SQLDMO.Application

    cmbServer.Clear
    '首先显示的是注册了的数据库
    '处理所有服务器组
    For Each oServerGroup In oSQLServerDMOApp.ServerGroups
        '处理每个注册了的服务器
        For Each oRegisteredServer In oServerGroup.RegisteredServers
            '添加每个名字到  combobox
            cmbServer.AddItem oRegisteredServer.Name
        Next
    Next
    Set oRegisteredServer = Nothing
    Set oServerGroup = Nothing

    '接下来显示尚未注册的数据库
    Set namX = oSQLServerDMOApp.ListAvailableSQLServers
    For i = 1 To namX.Count
        blnEquate = False
        '检查该服务器是否已经被列出来
        For j = 0 To cmbServer.ListCount - 1
            If cmbServer.List(j) = namX.Item(i) Then
                blnEquate = True
                Exit For '退出内圈循环
            End If
        Next j
        If blnEquate = False Then
            cmbServer.AddItem namX.Item(i)
        End If
    Next i

    '显示第一个服务器
    If cmbServer.ListCount > 0 Then
        cmbServer.ListIndex = 0
    End If

    Set namX = Nothing
    Set oSQLServerDMOApp = Nothing

    Screen.MousePointer = 0
End Function

#13

转的！  出处记不得了！

'类可实现的功能
'1, 可取得域或工作组内所有的SqlServer服务器名
'2, 取得各项网络设置
Option Explicit
Private uNet() As NETRESOURCE_REAL
'取得SqlServer服务器名
'返回的服务器名用","相隔
Public Function GetSQLServers() As String
    Dim l As Long
    Dim entriesread As Long
    Dim totalentries As Long
    Dim hREsume As Long
    Dim bufptr As Long
    Dim level As Long
    Dim prefmaxlen As Long
    Dim lType As Long
    Dim domain() As Byte
    Dim sv100 As SV_100
    Dim strReturnValue As String

    Dim strDomainList As String '取得的域或工作组列表，用","格开
    Dim iPos As Integer
    Dim i As Integer
    Dim strPart As String

    level = 100
    prefmaxlen = -1
    lType = SV_TYPE_SQLSERVER

    strDomainList = GetDomain()

    i = 1

    Do
        iPos = InStr(i, strDomainList, ",")
        If iPos = 0 Then
            strPart = Mid(strDomainList, i, Len(strDomainList))
        Else
            strPart = Mid(strDomainList, i, iPos - i)
        End If
        domain = strPart & vbNullChar
        l = NetServerEnum(ByVal 0&, _
                level, _
                bufptr, _
                prefmaxlen, _
                entriesread, _
                totalentries, _
                lType, _
                domain(0), _
                hREsume)
        If l = 0 Or l = 234& Then
            For i = 0 To entriesread - 1
                CopyMemory sv100, ByVal bufptr, Len(sv100)

                If strReturnValue = "" Then
                    strReturnValue = Pointer2Stringw(sv100.name)
                Else
                    strReturnValue = strReturnValue & "," & Pointer2Stringw(sv100.name)
                End If

                bufptr = bufptr + Len(sv100)
            Next i
        End If

        i = iPos + 1
    Loop Until iPos = 0

    NetApiBufferFree bufptr

    GetSQLServers = strReturnValue
End Function

'指针转换为字符串
Private Function Pointer2Stringw(ByVal l As Long) As String
    Dim Buffer() As Byte
    Dim nLen As Long

    nLen = lstrlenW(l) * 2

    If nLen Then
        ReDim Buffer(0 To (nLen - 1)) As Byte
        CopyMemory Buffer(0), ByVal l, nLen
        Pointer2Stringw = Buffer
    End If
End Function
'取得网络的各项配置
Private Sub GetNetworkSetting()
    Const MAX_RESOURCES = 256
    Const NOT_A_CONTAINER = -1
    Dim bFirstTime As Boolean
    Dim lReturn As Long
    Dim hEnum As Long
    Dim lCount As Long
    Dim lMin As Long
    Dim lLength As Long
    Dim l As Long
    Dim lBufferSize As Long
    Dim lLastIndex As Long
    Dim uNetApi(0 To MAX_RESOURCES) As NETRESOURCE

    bFirstTime = True
    Do
        If bFirstTime Then
            lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, _
              RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, ByVal 0&, hEnum)
            bFirstTime = False
        Else
            If uNet(lLastIndex).dwUsage _
                And RESOURCEUSAGE_CONTAINER Then
                lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, _
                   RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, _
                   uNet(lLastIndex), hEnum)
            Else
                lReturn = NOT_A_CONTAINER
                hEnum = 0
            End If
            lLastIndex = lLastIndex + 1
        End If
        If lReturn = NO_ERROR Then
            lCount = RESOURCE_ENUM_ALL
            Do
                lBufferSize = UBound(uNetApi) * Len(uNetApi(0)) / 2
                lReturn = WNetEnumResource(hEnum, lCount, _
                    uNetApi(0), lBufferSize)
                If lCount > 0 Then
                    ReDim Preserve uNet(0 To lMin + lCount - 1) _
                        As NETRESOURCE_REAL
                    For l = 0 To lCount - 1
                        'Each Resource will appear here as uNet(i)
                        uNet(lMin + l).dwScope = uNetApi(l).dwScope
                        uNet(lMin + l).dwType = uNetApi(l).dwType
                        uNet(lMin + l).dwDisplayType = _
                            uNetApi(l).dwDisplayType
                        uNet(lMin + l).dwUsage = uNetApi(l).dwUsage
                        If uNetApi(l).pLocalName Then
                            lLength = lstrlen(uNetApi(l).pLocalName)
                            uNet(lMin + l).sLocalName = _
                               Space$(lLength)
                            CopyMem ByVal uNet(lMin _
                               + l).sLocalName, _
                               ByVal uNetApi(l).pLocalName, lLength
                        End If
                        If uNetApi(l).pRemoteName Then
                            lLength = lstrlen( _
                               uNetApi(l).pRemoteName)
                            uNet(lMin + l).sRemoteName = _
                               Space$(lLength)
                            CopyMem ByVal uNet(lMin + _
                               l).sRemoteName, _
                               ByVal uNetApi(l).pRemoteName, lLength
                        End If
                        If uNetApi(l).pComment Then
                            lLength = lstrlen(uNetApi(l).pComment)
                            uNet(lMin + l).sComment = _
                                Space$(lLength)
                            CopyMem ByVal uNet(lMin + l).sComment, _
                                ByVal uNetApi(l).pComment, lLength
                        End If
                        If uNetApi(l).pProvider Then
                            lLength = lstrlen(uNetApi(l).pProvider)
                            uNet(lMin + l).sProvider = _
                               Space$(lLength)
                            CopyMem ByVal uNet(lMin + l).sProvider, _
                               ByVal uNetApi(l).pProvider, lLength
                        End If
                    Next l
                End If
                lMin = lMin + lCount
            Loop While lReturn = ERROR_MORE_DATA
        End If
        If hEnum Then
            l = WNetCloseEnum(hEnum)
        End If
    Loop While lLastIndex < lMin
End Sub

#14

接上：

'从网络的各项配置中取得Domain名称，各Domain名用","格开
Public Function GetDomain() As String
    Dim DomainList As String
    Dim l As Long
    DomainList = ""

    Call GetNetworkSetting

    If UBound(uNet) > 0 Then
        For l = 0 To UBound(uNet)
            If uNet(l).dwDisplayType = RESOURCEDISPLAYTYPE_DOMAIN Then

                If DomainList = "" Then
                    DomainList = uNet(l).sRemoteName
                Else
                    DomainList = DomainList & "," & uNet(l).sRemoteName
                End If
            End If
'            Select Case uNet(l).dwDisplayType
'                Case RESOURCEDISPLAYTYPE_DIRECTORY&
'                    Debug.Print "Directory...",
'                Case RESOURCEDISPLAYTYPE_DOMAIN
'                    Debug.Print "Domain...",
'                Case RESOURCEDISPLAYTYPE_FILE
'                    Debug.Print "File...",
'                Case RESOURCEDISPLAYTYPE_GENERIC
'                    Debug.Print "Generic...",
'                Case RESOURCEDISPLAYTYPE_GROUP
'                    Debug.Print "Group...",
'               Case RESOURCEDISPLAYTYPE_NETWORK&
'                    Debug.Print "Network...",
'                Case RESOURCEDISPLAYTYPE_ROOT&
'                    Debug.Print "Root...",
'                Case RESOURCEDISPLAYTYPE_SERVER
'                    Debug.Print "Server...",
'                Case RESOURCEDISPLAYTYPE_SHARE
'                    Debug.Print "Share...",
'                Case RESOURCEDISPLAYTYPE_SHAREADMIN&
'                    Debug.Print "ShareAdmin...",
'            End Select
'            Debug.Print uNet(l).sRemoteName, uNet(l).sComment
        Next l
    End If
    GetDomain = DomainList
End Function

#15

谢谢各位，不过还是有点遗憾，这些都是有限制的

秒客网

如何获取局域网SQL服务器名

15 个解决方案

#1

#2

#3

#4

#5

#6

#7

#8

#9

#10

#11

#12

#13

#14

#15

#1

#2

#3

#4

#5

#6

#7

#8

#9

#10

#11

#12

#13

#14

#15

相关文章