这是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编辑过]
