网络邻居的问题

fishboyok 2001-12-16 12:27:42
怎样实时知道一个局域网里哪几个机器是开的?就好像打开网上邻居一样,可以看到开机的网上邻居。
...全文
117 11 打赏 收藏 转发到动态 举报
写回复
用AI写文章
11 条回复
切换为时间正序
请发表友善的回复…
发表回复
Bardo 2002-01-11
  • 打赏
  • 举报
回复
上次有人问,列出网上邻居中所有计算机的名称。上次所抄给大家的代码有些乱,
现在给出新的代码:

Option Explicit

'==============================================================================
'类模块名称:clsListServer
'模块功能:用来列出所有的、或用户要求的网络服务器。
'==============================================================================


' All workstations
Private Const SV_TYPE_WORKSTATION As Long = &H1
' All servers
Private Const SV_TYPE_SERVER As Long = &H2
' Any server running with Microsoft SQL Server
Private Const SV_TYPE_SQLSERVER As Long = &H4
' Primary domain controller
Private Const SV_TYPE_DOMAIN_CTRL As Long = &H8
' Backup domain controller
Private Const SV_TYPE_DOMAIN_BAKCTRL As Long = &H10
' Server running the Timesource service
Private Const SV_TYPE_TIME_SOURCE As Long = &H20
' Apple File Protocol servers
Private Const SV_TYPE_AFP As Long = &H40
' Novell servers
Private Const SV_TYPE_NOVELL As Long = &H80
' LAN Manager 2.x domain member
Private Const SV_TYPE_DOMAIN_MEMBER As Long = &H100
' Server sharing print queue
Private Const SV_TYPE_PRINTQ_SERVER As Long = &H200
' Server running dial-in service
Private Const SV_TYPE_DIALIN_SERVER As Long = &H400
' Xenix server
Private Const SV_TYPE_XENIX_SERVER As Long = &H800
' Unix server
Private Const SV_TYPE_SERVER_UNIX As Long = SV_TYPE_XENIX_SERVER
' Windows NT/Windows 2000 workstation or server
Private Const SV_TYPE_NT As Long = &H1000
' Server running Windows for Workgroups
Private Const SV_TYPE_WFW As Long = &H2000
' Microsoft File and Print for NetWare
Private Const SV_TYPE_SERVER_MFPN As Long = &H4000
' Windows NT/Windows 2000 server that is not a domain controller
Private Const SV_TYPE_SERVER_NT As Long = &H8000
' Server that can run the browser service
Private Const SV_TYPE_POTENTIAL_BROWSER As Long = &H10000
' Server running a browser service as backup
Private Const SV_TYPE_BACKUP_BROWSER As Long = &H20000
' Server running the master browser service
Private Const SV_TYPE_MASTER_BROWSER As Long = &H40000
' Server running the domain master browser
Private Const SV_TYPE_DOMAIN_MASTER As Long = &H80000

Private Const SV_TYPE_SERVER_OSF As Long = &H100000

Private Const SV_TYPE_SERVER_VMS As Long = &H200000
' Windows 95 or later
Private Const SV_TYPE_WINDOWS As Long = &H400000
' Root of a DFS tree
Private Const SV_TYPE_DFS As Long = &H800000
'SV_TYPE_CLUSTER_NT Server clusters available in the domain
Private Const SV_TYPE_CLUSTER_NT As Long = &H1000000
' IBM DSS (Directory and Security Services) or equivalent
Private Const SV_TYPE_DCE As Long = &H10000000
' return list for alternate transport
Private Const SV_TYPE_ALTERNATE_XPORT As Long = &H20000000
' Servers maintained by the browser.Return local list only
Private Const SV_TYPE_LOCAL_LIST_ONLY As Long = &H40000000
' Primary domain
Private Const SV_TYPE_DOMAIN_ENUM As Long = &H80000000
' All servers. Handy for NetServerEnum2
Private Const SV_TYPE_ALL As Long = &HFFFFFFFF

Public Enum E_SVR_TYPE
ST_SV_TYPE_WORKSTATION = SV_TYPE_WORKSTATION
ST_SV_TYPE_SERVER = SV_TYPE_SERVER
ST_SV_TYPE_SQLSERVER = SV_TYPE_SQLSERVER
ST_SV_TYPE_DOMAIN_CTRL = SV_TYPE_DOMAIN_CTRL
ST_SV_TYPE_DOMAIN_BAKCTRL = SV_TYPE_DOMAIN_BAKCTRL
ST_SV_TYPE_TIME_SOURCE = SV_TYPE_TIME_SOURCE
ST_SV_TYPE_AFP = SV_TYPE_AFP
ST_SV_TYPE_NOVELL = SV_TYPE_NOVELL
ST_SV_TYPE_DOMAIN_MEMBER = SV_TYPE_DOMAIN_MEMBER
ST_SV_TYPE_PRINTQ_SERVER = SV_TYPE_PRINTQ_SERVER
ST_SV_TYPE_DIALIN_SERVER = SV_TYPE_DIALIN_SERVER
ST_SV_TYPE_XENIX_SERVER = SV_TYPE_XENIX_SERVER
ST_SV_TYPE_SERVER_UNIX = SV_TYPE_XENIX_SERVER
ST_SV_TYPE_NT = SV_TYPE_NT
ST_SV_TYPE_WFW = SV_TYPE_WFW
ST_SV_TYPE_SERVER_MFPN = SV_TYPE_SERVER_MFPN
ST_SV_TYPE_SERVER_NT = SV_TYPE_SERVER_NT
ST_SV_TYPE_POTENTIAL_BROWSER = SV_TYPE_POTENTIAL_BROWSER
ST_SV_TYPE_BACKUP_BROWSER = SV_TYPE_BACKUP_BROWSER
ST_SV_TYPE_MASTER_BROWSER = SV_TYPE_MASTER_BROWSER
ST_SV_TYPE_DOMAIN_MASTER = SV_TYPE_DOMAIN_MASTER
ST_SV_TYPE_SERVER_OSF = SV_TYPE_SERVER_OSF
ST_SV_TYPE_SERVER_VMS = SV_TYPE_SERVER_VMS
ST_SV_TYPE_WINDOWS = SV_TYPE_WINDOWS
ST_SV_TYPE_DFS = SV_TYPE_DFS
ST_SV_TYPE_CLUSTER_NT = SV_TYPE_CLUSTER_NT
ST_SV_TYPE_DCE = SV_TYPE_DCE
ST_SV_TYPE_ALTERNATE_XPORT = SV_TYPE_ALTERNATE_XPORT
ST_SV_TYPE_LOCAL_LIST_ONLY = SV_TYPE_LOCAL_LIST_ONLY
ST_SV_TYPE_DOMAIN_ENUM = SV_TYPE_DOMAIN_ENUM
ST_SV_TYPE_ALL = SV_TYPE_ALL
End Enum

' General definitions
Private Const ERROR_SUCCESS = 0
Private Const ERROR_MORE_DATA = 234

Private Const SIZE_SI_101 = 24

Private Type SERVER_INFO_101
dwPlatformID As Long
lpszServerName As Long
dwVersionMajor As Long
dwVersionMinor As Long
dwType As Long
lpszComment As Long
End Type

Private Declare Function NetServerEnum Lib "netapi32.dll" ( _
ByVal ServerName As Long, _
ByVal level As Long, _
Buffer As Long, _
ByVal prefmaxlen As Long, _
entriesread As Long, _
totalentries As Long, _
ByVal ServerType As Long, _
ByVal domain As Long, _
resumehandle As Long) As Long

Private Declare Function NetApiBufferFree Lib "netapi32.dll" ( _
bufptr As Any) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Long, _
ByVal cbCopy As Long)

Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long


Public Function GetNetServers(Optional ByVal nServerType _
As E_SVR_TYPE = SV_TYPE_ALL&, Optional ByVal szDomainName As String, Optional ErrStr As String) As Variant
'------------------------------------------------------------------------------
'函数名称:GetServers
'函数作用:根据条件获得Net上的计算机名(或服务器名)。
'参数描述:nServerType:需要获得某计算机的类型。
' szDomainName: 指定域或工作组名
' ErrStr: 失败时返回错误信息
'返回值: 变体字串数组,获得的网络计算机名称。
'------------------------------------------------------------------------------

Dim pszServer As Long, pszDomain As Long
Dim nLevel As Long, i As Long, bufptr As Long, TempBufPtr As Long
Dim nPrefMaxLen As Long, nEntriesRead As Long, nTotalEntries As Long
Dim nResumeHandle As Long, nRes As Long
Dim ServerInfo As SERVER_INFO_101
Dim RetValueStr As String
Dim lszDoMainb() As Byte, lngDoMainLen As Long

pszServer = 0&
If Len(szDomainName) = 0 Then
pszDomain = 0&
Else
lngDoMainLen = BSTRtoLPWSTR(szDomainName, lszDoMainb, pszDomain)
End If

nLevel = 101
nPrefMaxLen = &HFFFFFFFF

Do
nRes = NetServerEnum(pszServer, nLevel, bufptr, _
nPrefMaxLen, nEntriesRead, nTotalEntries, _
nServerType, pszDomain, nResumeHandle)
If ((nRes = ERROR_SUCCESS) Or (nRes = ERROR_MORE_DATA)) And _
(nEntriesRead > 0) Then
TempBufPtr = bufptr
For i = 0 To nEntriesRead - 1
If Len(RetValueStr) <> 0 Then
RetValueStr = RetValueStr & ","
End If
CopyMemory ServerInfo, ByVal TempBufPtr, SIZE_SI_101
RetValueStr = RetValueStr & _
GetPointerToByteStringW(ServerInfo.lpszServerName)
TempBufPtr = TempBufPtr + SIZE_SI_101
Next i
Else
ErrStr = "NetServerEnum failed: " & nRes
End If
NetApiBufferFree (bufptr)
Loop While nEntriesRead < nTotalEntries
If Len(RetValueStr) <> 0 Then
GetNetServers = Split(RetValueStr, ",")
Else
GetNetServers = vbNullString
End If

End Function

Private Function GetPointerToByteStringW(ByVal dwData As Long) As String

Dim tmp() As Byte
Dim tmplen As Long
If dwData <> 0 Then
tmplen = lstrlenW(dwData) * 2
If tmplen <> 0 Then
ReDim tmp(0 To (tmplen - 1)) As Byte
CopyMemory tmp(0), ByVal dwData, tmplen
GetPointerToByteStringW = tmp
End If
End If

End Function


Function BSTRtoLPWSTR(sBSTR As String, b() As Byte, lpwsz As Long) As Long

' Input: a nonempty BSTR string
' Input: **undimensioned** byte array b()
' Output: Fills byte array b() with Unicode char string from sBSTR
' Output: Fills lpwsz with a pointer to b() array
' Returns byte count, not including terminating 2-byte Unicode null character
' Original BSTR is not affected

Dim cBytes As Long

cBytes = LenB(sBSTR)

' ReDim array, with space for terminating null
ReDim b(1 To cBytes + 2) As Byte

' Point to BSTR char array
lpwsz = StrPtr(sBSTR)

' Copy the array
CopyMemory b(1), ByVal lpwsz, cBytes + 2

' Point lpsz to new array
lpwsz = VarPtr(b(1))

' Return byte count
BSTRtoLPWSTR = cBytes

End Function




'在窗体中可增加以下代码:
'Private Sub Command1_Click()
' Dim ClsLstSvr As New ClsListServer
' Dim StrNetSvrs As Variant
' Dim ErrStr As String
' Dim i As Integer
' Dim sDomainName As String
'
' sDomainName = "YourDoMainName"
'
' StrNetSvrs = ClsLstSvr.GetNetServers(, sDomainName, ErrStr)
'
' If IsArray(StrNetSvrs) Then
' For i = 0 To UBound(StrNetSvrs)
' Combo1.AddItem StrNetSvrs(i)
' Next i
' End If
'End Sub

这个代码缺省是给出当前工作组中所有计算机的名称。
如果要列出局域网中所有的计算机名。则要用另两个函数
以下来源MSDN

HOWTO: List Local Network Connections with WNetEnumResources

--------------------------------------------------------------------------------
The information in this article applies to:

Microsoft Visual Basic Professional and Enterprise Editions for Windows, versions 4.0, 5.0, 6.0
Microsoft Windows NT versions 3.51, 4.0
Microsoft Windows 95
Microsoft Win32 Software Development Kit (SDK)
Microsoft Windows 2000

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


SUMMARY
WNetOpenEnum and WNetEnumResources can be used to list the local drives, printer ports that have been redirected, and any UNC connections on a machine running Windows 2000, Windows NT, Windows 98, or Windows 95.

The code below demonstrates how to do this from Visual Basic by first calling WNetOpenEnum with the dwType parameter set to RESOURCETYPE_ANY. A valid handle returned via the last parameter is passed to WNetEnumResources. This function fills a temporary buffer with an array of NETRESOURCE structures, which includes information about the local network connections.

Note that this functionality will not list the resources that are redirected on a remote machine. No such functionality exists in either operating system.



MORE INFORMATION
The sample includes one form and one module. Follow the steps below to create the sample.


Create a new project and add the following code to the form:



Option Explicit

Private Const GMEM_FIXED = &H0
Private Const GMEM_ZEROINIT = &H40
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

Private Declare Function GlobalAlloc Lib "KERNEL32" ( _
ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "KERNEL32" ( _
ByVal hMem As Long) As Long

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Private Declare Function CopyPointer2String Lib "KERNEL32" _
Alias "lstrcpyA" ( _
ByVal NewString As String, ByVal OldString As Long) As Long

Private Sub Form_click()
Dim hEnum As Long, lpBuff As Long, nr As NETRESOURCE
Dim cbBuff As Long, cCount As Long
Dim p As Long, res As Long, i As Long

'Setup the NETRESOURCE input structure.
nr.dwUsage = RESOURCEUSAGE_CONTAINER
nr.lpRemoteName = 0
cbBuff = 1000
cCount = &HFFFFFFFF

'Open a Net enumeration operation handle: hEnum.
res = WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, _
0, nr, hEnum)
If res = 0 Then
'Create a buffer large enough for the results.
'1000 bytes should be sufficient.
lpBuff = GlobalAlloc(GPTR, cbBuff)
'Call the enumeration function.
res = WNetEnumResource(hEnum, cCount, lpBuff, cbBuff)
If res = 0 Then
p = lpBuff
Cls
'WNetEnumResource fills the buffer with an array of
'NETRESOURCE structures. Walk through the list and print
'each local and remote name.
For i = 1 To cCount
CopyMemory nr, ByVal p, LenB(nr)
p = p + LenB(nr)
Print PointerToString(nr.lpLocalName), _
PointerToString(nr.lpRemoteName)
Next i
Else
MsgBox "Error: " & Err.LastDllError, vbOKOnly, _
"WNetEnumResources"
End If
If lpBuff <> 0 Then GlobalFree (lpBuff)
WNetCloseEnum (hEnum) 'Close the enumeration
Else
MsgBox "Error: " & Err.LastDllError, vbOKOnly, "WNetOpenEnum"
End If
End Sub

Private Function PointerToString(p As Long) As String
'The values returned in the NETRESOURCE structures are pointers to
'ANSI strings so they need to be converted to Visual Basic
Strings.
Dim s As String
s = String(255, Chr$(0))
CopyPointer2String s, p
PointerToString = Left(s, InStr(s, Chr$(0)) - 1)
End Function

Add a new module to the project and add the following code:



Option Explicit

Public Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As Long
lpRemoteName As Long
lpComment As Long
lpProvider As Long
End Type

Public Declare Function WNetOpenEnum Lib "mpr.dll" Alias _
"WNetOpenEnumA" ( _
ByVal dwScope As Long, _
ByVal dwType As Long, _
ByVal dwUsage As Long, _
lpNetResource As Any, _
lphEnum As Long) As Long

Public Declare Function WNetEnumResource Lib "mpr.dll" Alias _
"WNetEnumResourceA" ( _
ByVal hEnum As Long, _
lpcCount As Long, _
ByVal lpBuffer As Long, _
lpBufferSize As Long) As Long

Public Declare Function WNetCloseEnum Lib "mpr.dll" ( _
ByVal hEnum As Long) As Long

'RESOURCE ENUMERATION.
Public Const RESOURCE_CONNECTED = &H1
Public Const RESOURCE_GLOBALNET = &H2
Public Const RESOURCE_REMEMBERED = &H3

Public Const RESOURCETYPE_ANY = &H0
Public Const RESOURCETYPE_DISK = &H1
Public Const RESOURCETYPE_PRINT = &H2
Public Const RESOURCETYPE_UNKNOWN = &HFFFF

Public Const RESOURCEUSAGE_CONNECTABLE = &H1
Public Const RESOURCEUSAGE_CONTAINER = &H2
Public Const RESOURCEUSAGE_RESERVED = &H80000000

Run the program. When you click on the form, a list of all the local network connections should be displayed, along with the shares they are connected to.



Additional query words:

Keywords : kbnokeyword kbNTOS351 kbNTOS400 kbWinOS2000 kbVBp400 kbVBp500 kbVBp600 kbWinOS95 kbWNet kbGrpVB
Version : WINDOWS:4.0,5.0,6.0,95; winnt:3.51,4.0
Platform : WINDOWS winnt
Issue type : kbhowto
Technology :

这个例子不仅可以列出计算机名,同时网络驱动器打印机即共享文件夹及文件都可以列出。

以下是一来自国外的例子:

NetHood.vbp
--------------------------
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#OLE Automation
Reference=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#C:\WINNT\System32\SCRRUN.DLL#Microsoft Scripting Runtime
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
Form=Form1.frm
Class=NetResource; NetResource.cls
Class=NetResources; NetResources.cls
Module=modGlobal; modGlobal.bas
IconForm="frmNWCheck"
Startup="Sub Main"
HelpFile=""
Title="NWNeighborhood"
ExeName32="NWHood.exe"
Command32=""
Name="NWHood"
HelpContextID="0"
Description="NW Object Demo"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=4
AutoIncrementVer=1
ServerSupportFiles=0
VersionCompanyName="S J Berwin & Co"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0


Form1.frm
-----------------------------
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmNWCheck
Caption = "Network Neighborhood Browser"
ClientHeight = 6195
ClientLeft = 5775
ClientTop = 4320
ClientWidth = 9045
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "Form1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6195
ScaleWidth = 9045
Begin MSComctlLib.ImageList imlNWImages
Left = 0
Top = 5280
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 13
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":08CA
Key = "directory"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":0C1C
Key = "root"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":0F6E
Key = "group"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":12C0
Key = "ndscontainer"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":1612
Key = "network"
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":1964
Key = "server"
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":1CB6
Key = "tree"
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":2008
Key = "domain"
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":235A
Key = "share"
EndProperty
BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":26AC
Key = "adminshare"
EndProperty
BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":29FE
Key = "printer"
EndProperty
BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":2B10
Key = "folder"
EndProperty
BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":2E62
Key = "file"
EndProperty
EndProperty
End
Begin MSComctlLib.TreeView tvwNetwork
Height = 5175
Left = 0
TabIndex = 0
Top = 0
Width = 8655
_ExtentX = 15266
_ExtentY = 9128
_Version = 393217
HideSelection = 0 'False
Indentation = 176
LabelEdit = 1
Style = 7
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
Attribute VB_Name = "frmNWCheck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private NetRoot As NetResource


Private Sub NodeExpand(Node As MSComctlLib.Node)
' Distinguish between expansion of a network object or a file system folder as seen over the network

Dim FSO As Scripting.FileSystemObject
Dim NWFolder As Scripting.Folder
Dim FilX As Scripting.File, DirX As Scripting.Folder
Dim tNod As Node, isFSFolder As Boolean

' Remove the fake node used to force the treeview to show the "+" icon
tvwNetwork.Nodes.Remove Node.Key + "_FAKE"

' If this node is marked as a share is it a proper networked directory?
' need to make this check since NDS marks some containers (wrongly, in my opinion) as shares when they're not applicable to
' file system directories (i.e. the two containers demarking NDS and Novell FileServers are marked as shares)
If Node.SelectedImage = "share" Then
On Error Resume Next
Set FSO = New FileSystemObject
Set NWFolder = FSO.GetFolder(Node.Key)
If Err <> 0 Then isFSFolder = False Else isFSFolder = True
On Error GoTo 0
End If

If Node.SelectedImage = "folder" Or (Node.SelectedImage = "share" And isFSFolder = True) Then
' This node is a filesystem folder seen via a network UNC path
' Use FileSystemObjects to get files and directories since network objects (generally) can't see these
'
Set FSO = New Scripting.FileSystemObject
Set NWFolder = FSO.GetFolder(Node.Key) ' The node's key holds the UNC path to the directory
' Enumerate the files in this folder
' To save any more confusion I'm not querying the system to get an icon for each file and executable
' If there's a demand I'll do a modified version, but for the moment I'm just using a generic file icon
For Each FilX In NWFolder.Files
tvwNetwork.Nodes.Add Node.Key, tvwChild, Node.Key + "\" + FilX.Name, FilX.Name, "file", "file"
Next
' Enumerate the folders
For Each DirX In NWFolder.SubFolders
Set tNod = tvwNetwork.Nodes.Add(Node.Key, tvwChild, Node.Key + "\" + DirX.Name, DirX.Name, "folder", "folder")
tvwNetwork.Nodes.Add tNod.Key, tvwChild, tNod.Key + "_FAKE", "FAKE", "folder", "folder"
tNod.Tag = "N"
Next
Node.Tag = "Y"
Else
' Search up through the tree, noting the node keys so that we can then locate the NetResource object
' under NetRoot.
Dim pS As String, kPath() As String, nX As NetResource, i As Integer, tX As NetResource
Set tNod = Node ' Start at the node that was expanded
Do While Not tNod.Parent Is Nothing ' Proceed up the tree using parent references, each time saving the node key to the string pS
pS = tNod.Key + "¦" + pS
Set tNod = tNod.Parent
Loop
' String pS is now of the form "<Node Key>¦<Node Key>¦<Node Key>"
' Split this into an array using the VB6 Split function
kPath = Split(pS, "¦")
Set nX = NetRoot
' Now loop through this array, this time following down the tree of NetResource objects from NetRoot to the child NetResource object that corresponds to
' the node the user clicked
For i = 0 To UBound(kPath) - 1
Set nX = nX.Children(kPath(i))
Next
' Now that we know both the node and the corresponding NetResource we can enumerate the children and add the nodes
For Each tX In nX.Children
Set tNod = tvwNetwork.Nodes.Add(nX.RemoteName, tvwChild, tX.RemoteName, tX.ShortName, LCase(tX.ResourceTypeName), LCase(tX.ResourceTypeName))
tNod.Tag = "N"
' Add fake nodes to all new nodes except when they're printers (you can always be sure a printer never has children)
If tX.ResourceType <> Printer Then tvwNetwork.Nodes.Add tX.RemoteName, tvwChild, tX.RemoteName + "_FAKE", "FAKE", "server", "server"
Next
tvwNetwork.Refresh ' Refresh the view
Node.Tag = "Y" ' Set the tag to "Y" to denote that this node has been expanded and populated
End If

End Sub


Private Sub Form_Load()
' Centre the form on the screen
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2

Dim nX As NetResource, nodX As Node
tvwNetwork.ImageList = imlNWImages
Set NetRoot = New NetResource ' Create a new NetResource object. By default it will be the network root
Set nodX = tvwNetwork.Nodes.Add(, , "_ROOT", "Entire Network", "root", "root") ' Add a node into the tree for it
nodX.Tag = "Y" ' Set populated flag to "Y" since we populate this one immediately
' Populate the top level of objects under "Entire Network"
For Each nX In NetRoot.Children
Set nodX = tvwNetwork.Nodes.Add("_ROOT", tvwChild, nX.RemoteName, nX.ShortName, LCase(nX.ResourceTypeName), LCase(nX.ResourceTypeName))
nodX.Tag = "N" ' We haven't populated the nodes underneath this one yet, so set its flag to "N"
tvwNetwork.Nodes.Add nodX.Key, tvwChild, nodX.Key + "_FAKE", "FAKE", "server", "server" ' Create a fake node under it so that the treeview gives the "+" symbol
nodX.EnsureVisible
Next
' You can't get printers at this level, so there's no point in enumerating the NWPrinters collections yet
End Sub

Private Sub Form_Resize()
tvwNetwork.Width = Me.ScaleWidth
tvwNetwork.Height = Me.ScaleHeight
End Sub


Private Sub tvwNetwork_Expand(ByVal Node As MSComctlLib.Node)
If Node.Tag = "N" Then
NodeExpand Node
End If
End Sub



netResouce.cls
------------------------
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "NetResource"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

' This is where the nasty VB is kept

Public Enum NetResourceTypes ' Enum of possible types of NetResource
Generic = 0
Domain = 1
Server = 2
share = 3
File = 4
Group = 5
Network = 6
Root = 7
ShareAdmin = 8
Directory = 9
Tree = 10
NDSContainer = 11
Printer = &HFF
End Enum

Private mvNetRes As NETRES2
Private mvGotChildren As Boolean
Private mvChildren As NetResources ' Collection of child containers and disk objects (what you usually get in the Network Neighborhood tree)
Private mvAmRoot As Boolean
Private mvAmPrinter As Boolean

Private Declare Function GlobalAlloc Lib "KERNEL32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "KERNEL32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function lstrcpyA Lib "KERNEL32" Alias "lstrcpy" (ByVal NewString As String, ByVal OldString As Long) As Long
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, ByVal lpBuffer As Long, ByRef lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long

Private Type sNETRESOURCE ' API compatible NETRESOURCE structure
dwScope As Long ' All members expressed as Long pointers
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As Long
lpRemoteName As Long
lpComment As Long
lpProvider As Long
End Type

Private Type NETRES2 ' VB compatible NETRESOURCE structure
dwScope As Long ' Members mapped back to VB datatypes
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As String
lpRemoteName As String
lpComment As String
lpProvider As String
End Type

Private Const RESOURCE_CONNECTED = &H1
Private Const RESOURCE_GLOBALNET = &H2
Private Const RESOURCE_REMEMBERED = &H3
Private Const RESOURCE_CONTEXT = &H5

Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCETYPE_DISK = &H1
Private Const RESOURCETYPE_PRINT = &H2
Private Const RESOURCETYPE_UNKNOWN = &HFFFF

Private Const RESOURCEUSAGE_CONNECTABLE = &H1
Private Const RESOURCEUSAGE_CONTAINER = &H2
Private Const RESOURCEUSAGE_RESERVED = &H80000000

Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_DISCARDABLE = &H100
Private Const GMEM_DISCARDED = &H4000
Private Const GMEM_FIXED = &H0
Private Const GMEM_INVALID_HANDLE = &H8000
Private Const GMEM_LOCKCOUNT = &HFF
Private Const GMEM_MODIFY = &H80
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_NOCOMPACT = &H10
Private Const GMEM_NODISCARD = &H20
Private Const GMEM_NOT_BANKED = &H1000
Private Const GMEM_NOTIFY = &H4000
Private Const GMEM_SHARE = &H2000
Private Const GMEM_VALID_FLAGS = &H7F72
Private Const GMEM_ZEROINIT = &H40
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

Private Const ERROR_MORE_DATA = 234

Private Const RESOURCEDISPLAYTYPE_GENERIC = 0
Private Const RESOURCEDISPLAYTYPE_DOMAIN = 1
Private Const RESOURCEDISPLAYTYPE_SERVER = 2
Private Const RESOURCEDISPLAYTYPE_SHARE = 3
Private Const RESOURCEDISPLAYTYPE_FILE = 4
Private Const RESOURCEDISPLAYTYPE_GROUP = 5
Private Const RESOURCEDISPLAYTYPE_NETWORK = 6
Private Const RESOURCEDISPLAYTYPE_ROOT = 7
Private Const RESOURCEDISPLAYTYPE_SHAREADMIN = 8
Private Const RESOURCEDISPLAYTYPE_DIRECTORY = 9
Private Const RESOURCEDISPLAYTYPE_TREE = &HA
Private Const RESOURCEDISPLAYTYPE_NDSCONTAINER = &HB

Private Sub GetPrinters()
' API wrangling...
' Basically the same routine as GetChildren but tweaked to only return printer objects
' It also discards all non-share objects since we only want printers for this enumeration

' Initialise my collection and variables
Dim hEnum As Long, lpBuff As Long
Dim cbBuff As Long, cCount As Long
Dim p As Long, res As Long, i As Long
Dim EnumHTemp As Long
Dim reqBufferSize As Long
Dim nR As sNETRESOURCE ' API friendly structure
Dim tempRes As NETRES2 ' VB friendly structure
Dim tChild As NetResource

' If this object is the Network root then we need to make a slight adjustment to the starting values
' of our API friendly NETRESOURCE structure
If mvAmRoot Then
nR.dwUsage = RESOURCEUSAGE_CONNECTABLE
nR.lpRemoteName = 0
End If

' Open a net enumeration
' Limit enumeration to connectable print resources (i.e. printer objects)
res = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_PRINT, RESOURCEUSAGE_CONNECTABLE, mvNetRes, hEnum)

' Check for errors
If res <> 0 Then
' Error returned when trying to open the enumeration
' Probably means we don't have access to see its children.
' See the MSDN for more details on possible errors.
' Currently no trapping is done here and the routine just exits with an empty children collection
Exit Sub
End If

' Now begin to enumerate the collection
EnumHTemp = hEnum
' Allocate a default buffer for the NETRESOURCE structure returned from the enum routine, say 1K
cbBuff = 1024&
lpBuff = GlobalAlloc(GPTR, cbBuff)
Do
EnumHTemp = hEnum
cCount = &HFFFFFFFF ' Number of entries to return from enumeration - &HFFFFFFFF causes all objects to be returned
res = WNetEnumResource(hEnum, cCount, lpBuff, cbBuff)
If res = ERROR_MORE_DATA Then
' The enumeration has reported that the lpBuff is not big enough to hold all of the information in the
' NETRESOURCE structure. cbBuff has been updated to hold the required amount of space.
GlobalFree lpBuff ' Free the memory we're using for the current small buffer
lpBuff = GlobalAlloc(GPTR, cbBuff) ' Allocate a new space of the size requested by the enumeration
Else
If res = 0 Then ' No error
p = lpBuff
' cCount holds the number of NETRESOURCE structures returned in this pass
' (The enumeration returns as many as will fit into the buffer)
For i = 1 To cCount ' Loop through the buffer, tackling each structure in turn
CopyMemory nR, ByVal p, LenB(nR) ' Copy the block of memory representing the structure into a local API friendly NETRESOURCE structure
p = p + LenB(nR) ' Step forward in the buffer by the length of the copied structure
If nR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE Then
tempRes.dwDisplayType = nR.dwDisplayType
tempRes.dwScope = nR.dwScope
tempRes.dwType = nR.dwType
tempRes.dwUsage = nR.dwUsage
tempRes.lpComment = lStrCpy(nR.lpComment)
tempRes.lpLocalName = lStrCpy(nR.lpLocalName)
tempRes.lpProvider = lStrCpy(nR.lpProvider)
tempRes.lpRemoteName = lStrCpy(nR.lpRemoteName)
Set tChild = New NetResource
tChild.NRStruct = tempRes
tChild.IsPrinter = True ' I know this is a bit of a fudge, but I didn't think it worth the effort to write polymorphic classes for such a small matter
mvChildren.Add tChild
End If
Next
End If
End If
Loop Until cCount = 0
' Close the enum
WNetCloseEnum hEnum
' Free the memory
GlobalFree lpBuff

End Sub

Friend Property Let IsPrinter(pVal As Boolean)
mvAmPrinter = pVal
End Property

Private Function lStrCpy(lStrPointer As Long) As String
Dim TString As String
TString = String(255, Chr$(0))
lstrcpyA TString, lStrPointer
lStrCpy = Left(TString, InStr(TString, Chr$(0)) - 1)
End Function

Public Property Get Children() As NetResources
If Not mvGotChildren Then GetChildren
Set Children = mvChildren
End Property



Public Property Get Comment() As String
Comment = mvNetRes.lpComment
End Property

Private Sub GetChildren()
' API wrangling...

' Initialise my collection and variables
Set mvChildren = New NetResources
Dim hEnum As Long, lpBuff As Long
Dim cbBuff As Long, cCount As Long
Dim p As Long, res As Long, i As Long
Dim EnumHTemp As Long
Dim reqBufferSize As Long
Dim nR As sNETRESOURCE ' API friendly structure
Dim tempRes As NETRES2 ' VB friendly structure
Dim tChild As NetResource

' If this object is the Network root then we need to make a slight adjustment to the starting values
' of our API friendly NETRESOURCE structure
If mvAmRoot Then
nR.dwUsage = RESOURCEUSAGE_CONNECTABLE
nR.lpRemoteName = 0
End If

' Open a net enumeration
res = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, mvNetRes, hEnum)

' Check for errors
If res <> 0 Then
' Error returned when trying to open the enumeration
' Probably means we don't have access to see its children.
' See the MSDN for more details on possible errors.
' Currently no trapping is done here and the routine just exits with an empty children collection
Exit Sub
End If

' Now begin to enumerate the collection
EnumHTemp = hEnum
' Allocate a default buffer for the NETRESOURCE structure returned from the enum routine, say 1K
cbBuff = 1024&
lpBuff = GlobalAlloc(GPTR, cbBuff)
Do
EnumHTemp = hEnum
cCount = &HFFFFFFFF ' Number of entries to return from enumeration - &HFFFFFFFF causes all objects to be returned
res = WNetEnumResource(hEnum, cCount, lpBuff, cbBuff)
If res = ERROR_MORE_DATA Then
' The enumeration has reported that the lpBuff is not big enough to hold all of the information in the
' NETRESOURCE structure. cbBuff has been updated to hold the required amount of space.
GlobalFree lpBuff ' Free the memory we're using for the current small buffer
lpBuff = GlobalAlloc(GPTR, cbBuff) ' Allocate a new space of the size requested by the enumeration
Else
If res = 0 Then ' No error
p = lpBuff
' cCount holds the number of NETRESOURCE structures returned in this pass
' (The enumeration returns as many as will fit into the buffer)
For i = 1 To cCount ' Loop through the buffer, tackling each structure in turn
CopyMemory nR, ByVal p, LenB(nR) ' Copy the block of memory representing the structure into a local API friendly NETRESOURCE structure
p = p + LenB(nR) ' Step forward in the buffer by the length of the copied structure
tempRes.dwDisplayType = nR.dwDisplayType ' Begin copying the members of the API friendly structure to the VB friendly structure
tempRes.dwScope = nR.dwScope
tempRes.dwType = nR.dwType
tempRes.dwUsage = nR.dwUsage
tempRes.lpComment = lStrCpy(nR.lpComment) ' String copies accomplished by using the lStrCpy routine
tempRes.lpLocalName = lStrCpy(nR.lpLocalName)
tempRes.lpProvider = lStrCpy(nR.lpProvider)
tempRes.lpRemoteName = lStrCpy(nR.lpRemoteName)
Set tChild = New NetResource ' Create the new NetResource object that will be the new child
tChild.NRStruct = tempRes ' Pass the current VB friendly NETRESOURCE structure to tbe force populate method of the NetResource object
mvChildren.Add tChild ' Add the new object to my children collection
Next
End If
End If
Loop Until cCount = 0
' Close the enum
WNetCloseEnum hEnum
' Free the memory
GlobalFree lpBuff

' In order to distinguish printers from other shares we need to enumerate them separately
GetPrinters

mvGotChildren = True

End Sub

Public Property Get LocalName() As String
LocalName = mvNetRes.lpLocalName

End Property


Friend Property Let NRStruct(RHS As NETRES2)
' Private force populate routine
' When a NetResource object it defaults to being the network root object
' The only way to change this is to call this routine and pass a VB friendly NETRES2 NETRESOURCE structure
' When this function is called correctly it populates the data for this NetResource and forces it to act as a child rather than
' a network root.
' When compiled as a COM DLL this function will not be visible to the user - it's intended for internal use only
mvNetRes = RHS
mvAmRoot = False
End Property



Public Property Get Provider() As String
Provider = mvNetRes.lpProvider
End Property

Public Property Get RemoteName() As String
RemoteName = mvNetRes.lpRemoteName
End Property


Public Property Get ResourceType() As NetResourceTypes
If Not mvAmPrinter Then ResourceType = mvNetRes.dwDisplayType Else ResourceType = Printer

End Property

Public Property Get ResourceTypeName() As String
' Provides a friendly name for the resource type as an alternative to using the enumerated "ResourceType" property
' This can be used to quicky bind NetResource objects to named images in an imagelist control (for example)
If mvAmPrinter Then
ResourceTypeName = "Printer"
Exit Property
End If
Select Case mvNetRes.dwDisplayType
Case RESOURCEDISPLAYTYPE_GENERIC
ResourceTypeName = "Generic"
Case RESOURCEDISPLAYTYPE_DOMAIN
ResourceTypeName = "Domain"
Case RESOURCEDISPLAYTYPE_SERVER
ResourceTypeName = "Server"
Case RESOURCEDISPLAYTYPE_SHARE
ResourceTypeName = "Share"
Case RESOURCEDISPLAYTYPE_FILE
ResourceTypeName = "File"
Case RESOURCEDISPLAYTYPE_GROUP
ResourceTypeName = "Group"
Case RESOURCEDISPLAYTYPE_NETWORK
ResourceTypeName = "Network"
Case RESOURCEDISPLAYTYPE_ROOT
ResourceTypeName = "Root"
Case RESOURCEDISPLAYTYPE_SHAREADMIN
ResourceTypeName = "AdminShare"
Case RESOURCEDISPLAYTYPE_DIRECTORY
ResourceTypeName = "Directory"
Case RESOURCEDISPLAYTYPE_TREE
ResourceTypeName = "Tree"
Case RESOURCEDISPLAYTYPE_NDSCONTAINER
ResourceTypeName = "NDSContainer"
End Select
End Property

Public Property Get ShortName() As String
' Return just the final part of the object's name (rather than a fully qualified path or context)
Dim i As Integer
i = InStrRev(mvNetRes.lpRemoteName, "\")
ShortName = Right(mvNetRes.lpRemoteName, Len(mvNetRes.lpRemoteName) - i)
End Property


Private Sub Class_Initialize()
mvAmRoot = True
End Sub


Private Sub Class_Terminate()
Set mvChildren = Nothing
End Sub


NetResources.cls
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "NetResources"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Collection" ,"NetResource"
Attribute VB_Ext_KEY = "Member0" ,"NetResource"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

'local variable to hold collection
Private mCol As Collection

Friend Function Add(objNewMember As NetResource) As NetResource
' Note : this function only allows adding of already extant objects. NetResource objects cannot be created
' by adding them to a NetResources collection since most of the network structure is hardware based and
' cannot be changed by software.

'create a new object
mCol.Add objNewMember, objNewMember.RemoteName
'return the object created
Set Add = objNewMember

End Function

Public Property Get Item(vntIndexKey As Variant) As NetResource
Attribute Item.VB_UserMemId = 0
' This item routine is a slight modification from the norm
' If an invalid or unmatched key is passed then this property returns a Nothing object rather than an error
Dim nrX As NetResource
On Error Resume Next
Set nrX = mCol(vntIndexKey)
If Err <> 0 Then
Set Item = Nothing
Else
Set Item = nrX
End If
'Set Item = mCol(vntIndexKey)
End Property



Public Property Get Count() As Long
'used when retrieving the number of elements in the
'collection. Syntax: Debug.Print x.Count
Count = mCol.Count
End Property


Public Sub Remove(vntIndexKey As Variant)
'used when removing an element from the collection
'vntIndexKey contains either the Index or Key, which is why
'it is declared as a Variant
'Syntax: x.Remove(xyz)


mCol.Remove vntIndexKey
End Sub


Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
'this property allows you to enumerate
'this collection with the For...Each syntax
Set NewEnum = mCol.[_NewEnum]
End Property


Private Sub Class_Initialize()
'creates the collection when this class is created
Set mCol = New Collection
End Sub


Private Sub Class_Terminate()
'destroys collection when this class is terminated
Set mCol = Nothing
End Sub

fishboyok 2001-12-23
  • 打赏
  • 举报
回复
怎么没人回答?
Bardo 2001-12-23
  • 打赏
  • 举报
回复
那上不可能的!!
Bardo 2001-12-18
  • 打赏
  • 举报
回复
将: netapi32.dll
打包后安装!
fishboyok 2001-12-18
  • 打赏
  • 举报
回复
这样不是将win me的动态连接库覆盖了?
fishboyok 2001-12-17
  • 打赏
  • 举报
回复
高手请进!
fishboyok 2001-12-17
  • 打赏
  • 举报
回复
这段代码在windows 2000中可以实现,而在windows me中无法实现,好像动态联接库不同。请问怎么解决?
Bardo 2001-12-16
  • 打赏
  • 举报
回复
Option Explicit



'==============================================================================
'类模块名称:clsListServer
'模块功能:用来列出所有的、或用户要求的网络服务器。
'

'==============================================================================



'Windows Net API
Private Const MAX_PREFERRED_LENGTH As Long = -1
Private Const NERR_SUCCESS As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234&

Private Const SV_TYPE_WORKSTATION As Long = &H1
Private Const SV_TYPE_SERVER As Long = &H2
Private Const SV_TYPE_SQLSERVER As Long = &H4
Private Const SV_TYPE_DOMAIN_CTRL As Long = &H8
Private Const SV_TYPE_DOMAIN_BAKCTRL As Long = &H10
Private Const SV_TYPE_TIME_SOURCE As Long = &H20
Private Const SV_TYPE_AFP As Long = &H40
Private Const SV_TYPE_NOVELL As Long = &H80
Private Const SV_TYPE_DOMAIN_MEMBER As Long = &H100
Private Const SV_TYPE_PRINTQ_SERVER As Long = &H200
Private Const SV_TYPE_DIALIN_SERVER As Long = &H400
Private Const SV_TYPE_XENIX_SERVER As Long = &H800
Private Const SV_TYPE_SERVER_UNIX As Long = SV_TYPE_XENIX_SERVER
Private Const SV_TYPE_NT As Long = &H1000
Private Const SV_TYPE_WFW As Long = &H2000
Private Const SV_TYPE_SERVER_MFPN As Long = &H4000
Private Const SV_TYPE_SERVER_NT As Long = &H8000
Private Const SV_TYPE_POTENTIAL_BROWSER As Long = &H10000
Private Const SV_TYPE_BACKUP_BROWSER As Long = &H20000
Private Const SV_TYPE_MASTER_BROWSER As Long = &H40000
Private Const SV_TYPE_DOMAIN_MASTER As Long = &H80000
Private Const SV_TYPE_SERVER_OSF As Long = &H100000
Private Const SV_TYPE_SERVER_VMS As Long = &H200000
Private Const SV_TYPE_WINDOWS As Long = &H400000 'Windows95 +
Private Const SV_TYPE_DFS As Long = &H800000 'Root of a DFS tree
Private Const SV_TYPE_CLUSTER_NT As Long = &H1000000 'NT Cluster
Private Const SV_TYPE_TERMINALSERVER As Long = &H2000000 'Terminal Server
Private Const SV_TYPE_DCE As Long = &H10000000 'IBM DSS
Private Const SV_TYPE_ALTERNATE_XPORT As Long = &H20000000 'return alternate transport
Private Const SV_TYPE_LOCAL_LIST_ONLY As Long = &H40000000 'return local only
Private Const SV_TYPE_DOMAIN_ENUM As Long = &H80000000
Private Const SV_TYPE_ALL As Long = &HFFFFFFFF

Private Const SV_PLATFORM_ID_OS2 As Long = 400
Private Const SV_PLATFORM_ID_NT As Long = 500

Private Const PLATFORM_ID_DOS As Long = 300
Private Const PLATFORM_ID_OS2 As Long = 400
Private Const PLATFORM_ID_NT As Long = 500
Private Const PLATFORM_ID_OSF As Long = 600
Private Const PLATFORM_ID_VMS As Long = 700

'Mask applied to svX_version_major in
'order to obtain the major version number
Private Const MAJOR_VERSION_MASK As Long = &HF

'======================================================================
'//自定义枚举-服务器类型

Public Enum ServerType
ST_SV_TYPE_ALL = SV_TYPE_ALL
ST_SV_TYPE_NT = SV_TYPE_NT
ST_SV_TYPE_WINDOWS = SV_TYPE_WINDOWS
ST_SV_TYPE_SQLSERVER = SV_TYPE_SQLSERVER
[Servers running Windows for Workgroups] = SV_TYPE_WFW
[Servers running Unix] = SV_TYPE_SERVER_UNIX
[LAN Manager workstations] = SV_TYPE_WORKSTATION
[LAN Manager servers] = SV_TYPE_SERVER
[NT/2000 servers not domain controller] = SV_TYPE_SERVER_NT
[Servers maintained by the browser] = SV_TYPE_LOCAL_LIST_ONLY
[Primary Domain (ignore version info)] = SV_TYPE_DOMAIN_ENUM

End Enum

'=======================================================================

Private Type SERVER_INFO_101
sv101_platform_id As Long
sv101_name As Long
sv101_version_major As Long
sv101_version_minor As Long
sv101_type As Long
sv101_comment As Long
End Type

Private Declare Function NetServerEnum Lib "Netapi32" _
(ByVal ServerName As Long, _
ByVal level As Long, _
buf As Any, _
ByVal prefmaxlen As Long, _
entriesread As Long, _
totalentries As Long, _
ByVal ServerType As Long, _
ByVal domain As Long, _
resume_handle As Long) As Long

Private Declare Function NetApiBufferFree Lib "netapi32.dll" _
(ByVal Buffer As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pTo As Any, uFrom As Any, _
ByVal lSize As Long)

Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long

'------------------------------------------------------------------------------
'函数名称:GetServers
'函数作用:根据条件获得Net上的计算机名(或服务器名)。
'参数描述:需要获得某计算机的类型。
'返回值: 集合,获得的网络计算机名称。
'------------------------------------------------------------------------------
Public Function GetServers(Optional ByVal strServerType _
As ServerType = ST_SV_TYPE_ALL) As Collection

'//列出在一个domain中的所有的服务器
Dim bufptr As Long
Dim dwEntriesread As Long
Dim dwTotalentries As Long
Dim dwResumehandle As Long
Dim dwServertype As Long
Dim se101 As SERVER_INFO_101
Dim success As Long
Dim nStructSize As Long
Dim cnt As Long

Dim colNetServer As New Collection

nStructSize = LenB(se101)
dwServertype = strServerType


'//这个调用列举了在网络上的所有的机器(SV_TYPE_ALL)或者是其他类型的机器。
success = NetServerEnum(0&, _
101, _
bufptr, _
MAX_PREFERRED_LENGTH, _
dwEntriesread, _
dwTotalentries, _
dwServertype, _
0&, _
dwResumehandle)



'//符合条件
If success = NERR_SUCCESS And _
success <> ERROR_MORE_DATA Then

For cnt = 0 To dwEntriesread - 1

CopyMemory se101, ByVal bufptr + (nStructSize * cnt), nStructSize

colNetServer.Add GetPointerToByteStringW(se101.sv101_name)

Next

End If

'clean up, regardless of success
Call NetApiBufferFree(bufptr)


Set GetServers = colNetServer

End Function


Private Function GetPlatformString(ByVal dwPlatformID As Long) As String

Select Case dwPlatformID
Case PLATFORM_ID_DOS: GetPlatformString = "DOS"
Case PLATFORM_ID_OS2: GetPlatformString = "Windows"
Case PLATFORM_ID_NT: GetPlatformString = "Windows NT"
Case PLATFORM_ID_OSF: GetPlatformString = "OSF"
Case PLATFORM_ID_VMS: GetPlatformString = "VMS"
End Select

End Function


Private Function GetPointerToByteStringW(ByVal dwData As Long) As String

Dim tmp() As Byte
Dim tmplen As Long

If dwData <> 0 Then

tmplen = lstrlenW(dwData) * 2

If tmplen <> 0 Then

ReDim tmp(0 To (tmplen - 1)) As Byte
CopyMemory tmp(0), ByVal dwData, tmplen
GetPointerToByteStringW = tmp

End If

End If

End Function

'////////////////////////////////////////////////////////////////////
' '在窗体FORM中写下面代码,colserver集合返回你要的SQLSERVER服务器的服务器名.
' '//获得网络上的所有的服务器列表。
' Dim mclsListServer As clsListServer
' Set mclsListServer = New clsListServer
' Dim colServer As Collection
' Set colServer = mclsListServer.GetServers(ST_SV_TYPE_SQLSERVER)

这一代码可以显示同一网段的所有机器!
不同网段的无法显示,可以作为参考!
fishboyok 2001-12-16
  • 打赏
  • 举报
回复
有没有源代码?简单一点的?
liege 2001-12-16
  • 打赏
  • 举报
回复
把网段里所有的IP都ping一遍,不就知道了。

或者监听以太网帧,分析其中的源MAC地址,不也知道了

方法太多了
fishboyok 2001-12-16
  • 打赏
  • 举报
回复
关注!
Re:CCNA_CCNP 思科网络认证 动态路由 EIGRP 和 OSPF 协议======================# EIGRP协议特点(CISCO产品专用独家协议) 使用Hello消息发现邻居,然后交换路由信息,使用Hello包维持邻居表 代替其它动态协议周期性更新而消耗资源。 有备用路径,当最佳路径不可用,立即使用备用路径 备用路径比动态获取新路径效率更高。 度量值默认为带宽和延迟,也可以添加负载和可靠性以及最大传输单元(MTU) rip只是hops跳数为依据,使用带宽和延时为指标更合理 还可以负载、可靠性和MTU为依据,选择最佳路径。 默认支持4条链路的不同代价的负载均衡,可以更改为最多6条 最大跳数为255(默认是100跳) rip只有15hops,所有只能够使用在小型网络中。 触发式更新路由表,即网络发生变化时,增量更新 hello包和触发式结合,消耗设置资源更低 支持路由的自动汇总。 支持大的网络,可以使用自制系统号来区别可共享路由信息的路由器集合,路由信息只可以在拥有相同自制系统号的路由器间共享。 (即一片路由和另一片路由,不计划发布沟通的情况下,可以以系统号区分) 如同VLAN方式 管理距离是90 直连0静态路由1;rip协议120;EIGRP协议90(比rip优先级高) # EIGRP度量值 EIGRP度量值 带宽 延迟 可靠性 负载 最大路径和跳数 默认支持4条等价路径 最大跳数100,也可以设置成255 # EIGRP三张表 邻居关系表 拓扑表 路由表 # EIGRP专业术语 可行距离(FD)                :A到E最小开销的路径(最佳路径) 被通告距离(AD)            :A的前一个路由器,到E的开销 继任者(最佳路径)          :可行路径下一跳的路由器 可行的继任者(备用路径):被通告距离 ---------------------------------------------------------------------------------------# 介绍OSPF协议 开放最短路径优先(OSPF)是一个开放标准的路由选择协议,它被各种网络开发商所广泛使用。 即无厂家边界 # OSPF协议具有下列特性: 由区域和自治系统组成 最小化的路由更新的流量(触发式更新,平时hello包打招呼,类eigrp协议) 允许可缩放性 支持变VLSM和CIDR(五类间路由/23) 拥有不受限的跳数 允许多销售商的设备集成(开放的标准) 度量值是带宽 # OSPF术语 Router-ID(网络中的身份:取ip最大值) 网络中运行OSPF协议的路由器都要有一个唯一的标识,这就是Router-ID,并且Router-ID在网络中绝对不可以有重复。 COST(开销) OSPF协议选择最佳路径的标准是带宽,带宽越高计算出来的开销越低。到达目标网络的各个链路累计开销最低的,就是最佳路径。 链路(Link) 就是路由器上的接口,在这里,应该指运行在OSPF进程下的接口。 链路状态(Link-State) 链路状态(LSA)就是OSPF接口上的描述信息,例如接口上的IP地址,子网掩码,网络类型,Cost值等等,OSPF路由器之间交换的并不是路由表,而是链路状态(LSA)。 邻居(Neighbor) 两台或多台运行OSPF的路由器在一个公共的网络上形成的基本关系。 但是不一定交换信息 邻接(Adjacency) OSPF只有邻接状态才会交换LSA。 只有发生交换数据关系的设备间叫做邻接 邻居间选择一个交通站DR,负责邻居间交换数据--------------------------------------------------------------------------------------- # 在边界路由器通过再发布方式向内部网段传递默认路由 两个不同协议自治区:RIP 和 EIGRP 路由再发布 两个不同协议自治区:OSPF 和 EIGRP 路由再发布 两个不同协议自治区:OSPF 和 RIP 路由再发布------------------------------------------------------------------                

1,502

社区成员

发帖
与我相关
我的任务
社区描述
VB 网络编程
社区管理员
  • 网络编程
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧