C++的代码有

这是VB代码 Option Explicit

Private 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

Private Type HOSTENT hName As Long hAliases As Long hAddrType As Integer hLength As Integer hAddrList As Long End Type

Private Const WSADescription_Len = 256 Private Const WSASYS_Status_Len = 128 Private Type WSADATA wversion As Integer wHighVersion As Integer szDescription(0 To WSADescription_Len) As Byte szSystemStatus(0 To WSASYS_Status_Len) As Byte iMaxSockets As Integer iMaxUdpDg As Integer lpszVendorInfo As Long End Type 'wnet API Private Const NO_ERROR = 0 Private Const ERROR_NO_MORE_ITEMS = 259& Private Const RESOURCE_CONTEXT = &H5 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, lpBufferSize As Long) As Long Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long

'winsock API Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSAData As WSADATA) As Long Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname As String) As Long Private Const WS_VERSION_REQD = &H101 Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF& Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF& Private Const MIN_SOCKETS_REQD = 1 Private Const SOCKET_ERROR = -1

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) 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 Function CopyPointer2String Lib "KERNEL32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long Private Const GMEM_FIXED = &H0 Private Const GMEM_ZEROINIT = &H40 Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

Private Sub GetComputer() Dim hEnum As Long Dim lRetval As Long Dim lpBufferSize As Long Dim lpBuffer As Long Dim lpcCount As Long Dim nr As NETRESOURCE Dim lCount As Long Dim sName As String

lpBufferSize = 16 * 1024 '16K lpcCount = &HFFFFFFFF '枚举所有资源 lpBuffer = GlobalAlloc(GPTR, lpBufferSize) nr.dwUsage = 2 nr.lpRemoteName = 0 lRetval = WNetOpenEnum(RESOURCE_CONTEXT, 0, 0, nr, hEnum) Do If lRetval = NO_ERROR Then lRetval = WNetEnumResource(hEnum, lpcCount, lpBuffer, lpBufferSize) If lRetval = NO_ERROR Then For lCount = 1 To lpcCount CopyMemory nr, ByVal lpBuffer + (lCount - 1) * Len(nr), Len(nr) ' Debug.Print PointerToString(nr.lpLocalName), PointerToString(nr.lpRemoteName), PointerToString(nr.lpProvider) sName = PointerToString(nr.lpRemoteName) If sName <> "" Then sName = IIf(Left(sName, 2) = "\\", Right(sName, Len(sName) - 2), sName) List1.AddItem sName & " ---- " & GetIP(sName) End If Next End If End If Loop Until lRetval = ERROR_NO_MORE_ITEMS GlobalFree (lpBuffer) Call WNetCloseEnum(hEnum) Call SocketsCleanup End Sub

Private Sub Command1_Click() GetComputer End Sub

Private Function PointerToString(ByVal Addr As Long) As String Dim str As String str = String(255, Chr(0)) CopyPointer2String str, Addr PointerToString = Left(str, InStr(str, Chr(0)) - 1) End Function

Private Function GetIP(ByVal hostname As String) As String Dim host As HOSTENT Dim bytIP() As Byte Dim lIPAddr As Long Dim lHostAddr As Long Dim lngX As Long If Not SocketsInitialize Then GetIP = "winsock.dll错误，无法获得IP" Exit Function End If lHostAddr = gethostbyname(hostname) If lHostAddr = 0 Then GetIP = "未知错误，无法获得IP地址！" Exit Function End If CopyMemory host, ByVal lHostAddr, Len(host) CopyMemory lIPAddr, ByVal host.hAddrList, 4 '获得IP地址 ReDim bytIP(1 To host.hLength) CopyMemory bytIP(1), ByVal lIPAddr, host.hLength For lngX = 1 To host.hLength GetIP = GetIP & bytIP(lngX) & "." Next GetIP = Left(GetIP, Len(GetIP) - 1) End Function

Private Function SocketsInitialize() As Boolean '初始化winsock Dim WSAD As WSADATA Dim lRetval As Long Dim sLowByte As String, sHighByte As String, sMsg As String lRetval = WSAStartup(WS_VERSION_REQD, WSAD) If lRetval <> 0 Then 'winsock.dll无响应 SocketsInitialize = False Exit Function End If '检查winsock版本 If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = _ WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then '当前版本不被支持 SocketsInitialize = False Exit Function End If If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then 'winsock版本太低 SocketsInitialize = False Exit Function End If SocketsInitialize = True End Function

Function hibyte(ByVal wParam As Integer) As Integer hibyte = wParam \ &H100 And &HFF& End Function Function lobyte(ByVal wParam As Integer) As Integer lobyte = wParam And &HFF& End Function

Sub SocketsCleanup() '中止winsock调用 Dim lRetval As Long lRetval = WSACleanup() If lRetval <> 0 Then MsgBox "中止winsock时发生错误：" & lRetval End If End Sub

跟2楼的C++代码比起来，好象长了很多，其实只是多了API的声明。运行时在窗体上放一个ListBox和一个CommandButton，以前的代码找不到了，临时写了一个，有什么问题发贴。

[此贴子已经被作者于2004-07-05 17:37:56编辑过]

我试了一下,没有问题,firechun,你真行!

是能运行，但找到的只是一个工作组的主机，并不是局域网里所有的主机。

我的只能找到自己组的

nr.dwUsage = 2 nr.lpRemoteName = 0 '这里表示查找当前电脑所在的工作组 lRetval = WNetOpenEnum(RESOURCE_CONTEXT, 0, 0, nr, hEnum)

要查找局域网中所有工作组的电脑，修改WNetOpenEnum的参数，然后递归调用WNetEnumResource即可。