<Flags()> Public Enum ServerType As Integer
SV_TYPE_WORKSTATION = &H1
SV_TYPE_SERVER = &H2
SV_TYPE_SQLSERVER = &H4
SV_TYPE_DOMAIN_CTRL = &H8
SV_TYPE_DOMAIN_BAKCTRL = &H10
SV_TYPE_TIME_SOURCE = &H20
SV_TYPE_AFP = &H40
SV_TYPE_NOVELL = &H80
SV_TYPE_DOMAIN_MEMBER = &H100
SV_TYPE_PRINTQ_SERVER = &H200
SV_TYPE_DIALIN_SERVER = &H400
SV_TYPE_XENIX_SERVER = &H800
SV_TYPE_SERVER_UNIX = SV_TYPE_XENIX_SERVER
SV_TYPE_NT = &H1000
SV_TYPE_WFW = &H2000
SV_TYPE_SERVER_MFPN = &H4000
SV_TYPE_SERVER_NT = &H8000
SV_TYPE_POTENTIAL_BROWSER = &H10000
SV_TYPE_BACKUP_BROWSER = &H20000
SV_TYPE_MASTER_BROWSER = &H40000
SV_TYPE_DOMAIN_MASTER = &H80000
SV_TYPE_SERVER_OSF = &H100000
SV_TYPE_SERVER_VMS = &H200000
SV_TYPE_WINDOWS = &H400000 ' Windows95 and above '
SV_TYPE_DFS = &H800000 ' Root of a DFS tree '
SV_TYPE_CLUSTER_NT = &H1000000 ' NT Cluster '
SV_TYPE_TERMINALSERVER = &H2000000 ' Terminal Server(Hydra) '
SV_TYPE_CLUSTER_VS_NT = &H4000000 ' NT Cluster Virtual Server Name '
SV_TYPE_DCE = &H10000000 ' IBM DSS (Directory and Security Services) or equivalent '
SV_TYPE_ALTERNATE_XPORT = &H20000000 ' return list for alternate transport '
SV_TYPE_LOCAL_LIST_ONLY = &H40000000 ' Return local list only '
SV_TYPE_DOMAIN_ENUM = &H80000000
SV_TYPE_ALL = &HFFFFFFFF ' handy for NetServerEnum2 '
End Enum
<DllImport("Netapi32.dll")> Private Shared Function NetServerEnum(ByVal servername As String, ByVal level As Integer, ByRef bufptr As IntPtr, ByVal prefmaxlen As Integer, ByRef entriesread As Integer, ByRef totalentries As Integer, ByVal servertype As ServerType, ByVal domain As String, ByRef resume_handle As Integer) As Integer
Public Const SRV_TYPE_SERVER = &H2
Public Const SRV_TYPE_SQLSERVER = &H4
Public Const SRV_TYPE_NT_PDC = &H8
Public Const SRV_TYPE_NT_BDC = &H10
Public Const SRV_TYPE_PRINT = &H200
Public Const SRV_TYPE_NT = &H1000
Public Const SRV_TYPE_ALL = &HFFFF
Public Const SRV_TYPE_RAS = &H400
Public Const NERR_Success = 0&
Public Const NERR_Access_Denied = 5&
Public Const NERR_MoreData = 234&
Type ServerInfo
PlatformId As Long
ServerName As String
Type As Long
VerMajor As Long
VerMinor As Long
Comment As String
Platform As String
ServerType As Integer
LanGroup As String
LanRoot As String
End Type
Type ListOfServer
Init As Boolean
LastErr As Long
list() As ServerInfo
End Type
Private Type SERVER_INFO_API
PlatformId As Long
ServerName As Long
Type As Long
VerMajor As Long
VerMinor As Long
Comment As Long
End Type
Declare Function NetServerEnum Lib "netapi32" _
(lpServer As Any, ByVal lLevel As Long, vBuffer As Any, _
lPreferedMaxLen As Long, lEntriesRead As Long, lTotalEntries As Long, _
ByVal lServerType As Long, ByVal sDomain$, vResume As Any) As Long
Declare Function NetApiBufferFree Lib "netapi32" _
(ByVal lBuffer&) As Long
Public Function EnumServer(lServerType As Long) As ListOfServer
Dim nRet As Long, x As Integer, i As Integer
Dim lRetCode As Long
Dim tServerInfo As SERVER_INFO_API
Dim lServerInfo As Long
Dim lServerInfoPtr As Long
Dim ServerInfo As ServerInfo
Dim lPreferedMaxLen As Long
Dim lEntriesRead As Long
Dim lTotalEntries As Long
Dim sDomain As String
Dim vResume As Variant
Dim yServer() As Byte
Dim SrvList As ListOfServer
yServer = MakeServerName(ByVal "")
lPreferedMaxLen = 65536
nRet = NERR_MoreData
Do While (nRet = NERR_MoreData)
'Вызов NetServerEnum для получения списка серверов нужного типа
nRet = NetServerEnum(yServer(0), 101, lServerInfo, _
lPreferedMaxLen, lEntriesRead, _
lTotalEntries, lServerType, _
sDomain, vResume)
If (nRet <> NERR_Success And _
nRet <> NERR_MoreData) Then
SrvList.Init = False
SrvList.LastErr = nRet
NetError nRet
Exit Do
End If
' NetServerEnum массив начинается с индекса 1
x = 1
lServerInfoPtr = lServerInfo
Do While x <= lTotalEntries
CopyMem tServerInfo, ByVal lServerInfoPtr, Len(tServerInfo)
ServerInfo.Comment = PointerToStringW(tServerInfo.Comment)
ServerInfo.ServerName = PointerToStringW(tServerInfo.ServerName)
ServerInfo.Type = tServerInfo.Type
ServerInfo.PlatformId = tServerInfo.PlatformId
ServerInfo.VerMajor = tServerInfo.VerMajor
ServerInfo.VerMinor = tServerInfo.VerMinor
ReDim Preserve SrvList.list(1 To x-1) As ServerInfo
SrvList.list(i) = ServerInfo
x = x + 1
lServerInfoPtr = lServerInfoPtr + Len(tServerInfo)
Loop
lRetCode = NetApiBufferFree(lServerInfo)
SrvList.Init = (x > 1)
Loop
EnumServer = SrvList
End Function
И вот пример вызова:
Dim ServerList As ListOfServer
ServerList = EnumServer(SRV_TYPE_SQLSERVER)
Сейчас этот форум просматривают: Google-бот и гости: 1