In un modulo
codice:
Option Explicit
'****************************************************************************
'* Server Type Definitions
'****************************************************************************
Public Const SV_TYPE_WORKSTATION = &H1 '* All Net Workstations
Public Const SV_TYPE_SERVER = &H2 '*All Net Servers
Public Const SV_TYPE_SQLSERVER = &H4 '* Any Server Running MS SQL Server
Public Const SV_TYPE_DOMAIN_CTRL = &H8 '* PDCs
Public Const SV_TYPE_DOMAIN_BAKCTRL = &H10 '* BDCs
Public Const SV_TYPE_TIMESOURCE = &H20 '* Servers running the TimeSource Service
Public Const SV_TYPE_AFP = &H40 '* Apple File Protocol Servers
Public Const SV_TYPE_NOVELL = &H80 '* Novell Servers
Public Const SV_TYPE_DOMAIN_MEMBER = &H100 '* LAN Manager 2.x Domain Member
Public Const SV_TYPE_PRINT = &H200 '* Server sharing print queue
Public Const SV_TYPE_DIALIN = &H400 '* Server running dial-in service
Public Const SV_TYPE_XENIX_SERVER = &H800 '* Xenix server
Public Const SV_TYPE_NT = &H1000 '* Windows NT (either Workstation or Server)
Public Const SV_TYPE_WFW = &H2000 '* Server running Windows for Workgroups
Public Const SV_TYPE_MFPN = &H4000 '* Microsoft File and Print for Netware
Public Const SV_TYPE_SERVER_NT = &H8000 '* Windows NT Non-DC server
Public Const SV_TYPE_POTENTIAL_BROWSER = &H10000 '* Server that can run the Browser service
Public Const SV_TYPE_BACKUP_BROWSER = &H20000 '* Server running a Browser service as backup
Public Const SV_TYPE_MASTER_BROWSER = &H40000 '* Server running the master Browser service
Public Const SV_TYPE_DOMAIN_MASTER = &H80000 '* Server running the domain master Browser
Public Const SV_TYPE_WINDOWS = &H400000 '* Windows 95 or later
Public Const SV_TYPE_LOCAL_LIST_ONLY = &H40000000 '* Servers maintained by the browser
Public Const SV_TYPE_DOMAIN_ENUM = &H80000000 '* Primary Domain
Public Const SV_TYPE_ALL = &HFFFFFFFF '* All servers
'* Server Data Structure used for this function
Type SERVER_INFO_100
lgSvi100_platform_id As Long
lgSvi100_servername As Long
End Type
'* Declare the NetAPI function
Declare Function NetServerEnum Lib "NetAPI32.DLL" (btComputerName As Byte, _
ByVal lgLevel As Long, anBuffer As Any, lgPreferedMaxLen As Long, _
lgEntriesRead As Long, lgTotalEntries As Long, anServerType As Any, _
btDomain As Byte, lgResumeHandle As Long) As Long
'* Declare the function to free the buffer
Declare Function NetAPIBufferFree Lib "NetAPI32.DLL" Alias _
"NetApiBufferFree" (ByVal lgPtr As Long) As Long
'* Declare the CopyMemory function
Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" _
(anDest As Any, ByVal lgSrc As Long, ByVal lgSize As Long)
'* Declare the Array used to store the servernames
Public stServerArray() As String
Public Function EnumerateServers(stType As String) As Long
'* Enumerates Servers by Type Passed into function
Dim lgResult As Long, lgTotalEntries As Long
Dim lgPrefMaxLen As Long, lgEntriesRead As Long
Dim lgResumeHandle As Long, stDomain As String
Dim lgBufPtr As Long, lgServerType As Long
Dim btSrvArray(32) As Byte, btDomain() As Byte
Dim I As Integer, stCompName As String
Dim stServerName As String, stText As String
Dim ServerStruct As SERVER_INFO_100
'* Clear values and initialize all of the variables
lgResumeHandle = 0
ReDim stServerArray(0) As String
'* Set the domain to the default, primary domain
stDomain = ""
'* Set the computer name to the default, local system
stCompName = ""
'* Create Null Terminated Strings
btDomain = stDomain & vbNullChar
'* Determine stType Values and set servertype value
'* You may add or remove these types as needed for your application
If stType = "DCs" Then
'* Enumerate Domain Controllers
lgServerType = SV_TYPE_DOMAIN_CTRL + SV_TYPE_DOMAIN_BAKCTRL
ElseIf stType = "SVs" Then
'* Enumerate Servers
lgServerType = SV_TYPE_SERVER
ElseIf stType = "WKs" Then
'* Enumerate Workstations
lgServerType = SV_TYPE_WORKSTATION
ElseIf stType = "ALL" Then
'* Enumerate All Machines
lgServerType = SV_TYPE_ALL
ElseIf stType = "WFW" Then
'* Windows for Workgroups Servers
lgServerType = SV_TYPE_WFW
ElseIf stType = "SQL" Then
'* Servers running SQL Server
lgServerType = SV_TYPE_SQLSERVER
ElseIf stType = "NOV" Then
'* Novell Servers
lgServerType = SV_TYPE_NOVELL
Else
'* Select Default as all NT Servers
lgServerType = SV_TYPE_SERVER + SV_TYPE_NT
End If
'* Call NetServerEnum to get a list of Servers
lgResult = NetServerEnum(0&, 100, lgBufPtr, 4096, lgEntriesRead, lgTotalEntries, lgServerType, ByVal btDomain(0), 0)
EnumerateServers = lgResult
'* Now that we know how many entries were read, size the array
If lgTotalEntries <= 0 Then
MsgBox "No Entries Read. Error Code = " & CStr(lgResult)
Exit Function
End If
ReDim stServerArray(lgTotalEntries - 1) As String
'* Check for errors
If lgResult <> 0 And lgResult <> 234 Then '* 234 means multiple reads required
If lgResult = 2351 Then
stText = "ServerName not found." & Chr$(13) & "Be sure you used the leading \\ on the servername."
Else
stText = "Error " & lgResult & " enumerating server " & lgEntriesRead & " of " & lgTotalEntries
End If
MsgBox stText
Exit Function
End If
For I = 1 To lgTotalEntries
'* Dereference the ServerStruct Data Structure
CopyMemory ServerStruct, lgBufPtr, Len(ServerStruct)
'* Dereference the server name variable
CopyMemory btSrvArray(0), ServerStruct.lgSvi100_servername, 33
stServerName = btSrvArray
Trim (stServerName)
'* send the servername to the array
'* Change the code here to send the servername to a control, etc.
stServerArray(I - 1) = stServerName
Form1.List1.AddItem stServerName
'* Clear the servername variable here
stServerName = ""
'* Move to the next part of the buffer
lgBufPtr = lgBufPtr + Len(ServerStruct)
Next I
'* Release the memory used for the ServerStruct buffer
lgResult = NetAPIBufferFree(lgBufPtr)
End Function
Nel Form (di nome Form1) inserire un listbox (di nome list1).
Per caricare nella lista tutti i PC in rete
codice:
EnumerateServers "ALL"