[AccessD] Return Names Of All Available Servers

MartyConnelly martyconnelly at shaw.ca
Fri Jan 27 12:44:23 CST 2006


If you mean SQL Servers see below; if you mean all types of servers 
that's a bit trickier

Sub listsql()
' For a single workstation list sql servers with  no network available
'otherwise you need to get all computer names from WMI and iterate
Dim strServer As String
Dim objWMIService As Object
Dim colInstances As Object
Dim objServices As Object
Dim objInstance As Object
Dim objLocator As Object
Dim i As Long
strComputer = "." 'local default computer name
 Set objLocator = CreateObject("WbemScripting.SWbemLocator")
 Set objServices = objLocator.ConnectServer(strServer, 
"root\MicrosoftSQLServer")
 objServices.Security_.ImpersonationLevel = 3
 Set colInstances = objServices.InstancesOf("MSSQL_SQLServer")
 i = 0
 For Each objInstance In colInstances
  i = i + 1
  MsgBox objInstance.Truename & " as instance Truename from WMI"
 Next
End Sub

or


'
'  Over a network domain
'
' http://www.codeguru.com/vb/gen/vb_system/network/article.php/c1641
'
Private Declare Function lstrlenW Lib "kernel32" (ByVal _
        lpString As Long) As Long
'
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
'
Private Declare Function NetApiBufferFree Lib "Netapi32.dll" _
        (ByVal lpBuffer As Long) As Long
'
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (Destination As Any, Source As Any, ByVal Length As Long)
'
Private Const SV_TYPE_SERVER As Long = &H2
Private Const SV_TYPE_SQLSERVER As Long = &H4
'
Private Type SV_100
    platform As Long
    name As Long
End Type
'
'
Public Sub GetSQLServers()
'
' You could change this to be a function returning
' a list of the SQL servers in a ADOR Recordset or an array etc.
'
' At present, it just does a debug.print of all the
' SQL servers on the network.
'
' http://www.codeguru.com/vb/gen/vb_system/network/article.php/c1641

    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 i As Long
    Dim sv100 As SV_100
'
    level = 100
    prefmaxlen = -1
'
    lType = SV_TYPE_SQLSERVER
    'domain = "placeYourDomainNameHere" & vbNullChar
    domain = "Marty" & 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)
            Debug.Print Pointer2stringw(sv100.name)
            bufptr = bufptr + Len(sv100)
        Next i
    End If
    NetApiBufferFree bufptr
'
End Sub


Paul Hartland (ISHARP) wrote:

>To all,
>
>Not sure if this is possible, but is there a way via code that I can return
>the names of all current active servers.  Basically when I open an access DB
>I want it to run through I list of our server names then tell me if a
>connection can be established.  
>
>Thanks in advance for any help/code/pointers on this
>
>Paul Hartland
>Database Developer
>
>  
>

-- 
Marty Connelly
Victoria, B.C.
Canada






More information about the AccessD mailing list