用VB怎么查找网络邻居的IP号？

Question

遍历私网资源：**窗体代码.
Option ExplicitPrivate Sub cmdRefresh_Click()
    Dim cComputers As New clsComputers
    Dim cDomains As New clsDomains
    Dim lCurrentNode As Long
    Dim lK As Long
    Dim lX As Long
        
    tvLAN.Nodes.Clear
    tvLAN.Nodes.Add , , "LAN", "LAN", 1
    For lK = 1 To cDomains.GetCount
        tvLAN.Nodes.Add "LAN", tvwChild, cDomains.GetItem(lK), cDomains.GetItem(lK), 2
        lCurrentNode = tvLAN.Nodes.Count
        cComputers.Domain = cDomains.GetItem(lK)
        cComputers.Refresh
        
        For lX = 1 To cComputers.GetCount
            tvLAN.Nodes.Add cDomains.GetItem(lK), tvwChild, cComputers.GetItem(lX), cComputers.GetItem(lX), 3
        Next lX
        tvLAN.Nodes.Item(lCurrentNode).Expanded = True
    Next lK
    tvLAN.Nodes.Item(1).Expanded = True
End SubPrivate Sub Form_Load()
    cmdRefresh_Click
End Sub'**类clsComputers
Option ExplicitPrivate cComputers As New Collection
Private sDomain As StringPrivate 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 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 StrLenA Lib "kernel32" Alias "lstrlenA" (ByVal Ptr As Long) As Long
Private Declare Function StrCopyA Lib "kernel32" Alias "lstrcpyA" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)Private Const RESOURCE_GLOBALNET = &H2
Private Const RESOURCETYPE_DISK = &H1
Private Const ERROR_MORE_DATA = 234
Private Const GMEM_FIXED = &H0
Private Const GMEM_ZEROINIT = &H40
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)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 TypePrivate Type NETRES2
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    lpLocalName As String
    lpRemoteName As String
    lpComment As String
    lpProvider As String
End Type
Public Property Get Domain() As String
    Domain = sDomain
End PropertyPublic Property Let Domain(Value As String)
    sDomain = Value
End Property
Public Function GetCount() As Long
    GetCount = cComputers.Count
End FunctionPublic Function GetItem(Index As Long) As String
    If Index < 1 Or Index > cComputers.Count Then
        Err.Raise 7771, , "The index is not within valid range!"
        Exit Function
    End If
    GetItem = cComputers.Item(Index)
End Function

Answer 1

接上：Public Sub Refresh()
    Dim lBufferPtrTemp As Long
    Dim sComputer As String
    Dim tNetRes As NETRES2
    Dim tNR As NETRESOURCE
    Dim lBufferPtr As Long
    Dim lEnumHwnd As Long
    Dim lReturn As Long
    Dim lBuffer As Long
    Dim lCount As Long
    Dim lK As Long
    
    If Len(sDomain) = 0 Then
        Err.Raise 7772, , "The domain has not been set!"
        Exit Sub
    End If    With tNetRes
        .lpRemoteName = sDomain
        .dwDisplayType = 1
    End With
    
    lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, tNetRes, lEnumHwnd)
    
    If lReturn <> 0 Then
        Err.Raise 7773, , "Could not enumerate computers in domain!"
        Exit Sub
    End If
    
    lBuffer = 1024 * 10
    lBufferPtr = GlobalAlloc(GPTR, lBuffer)
    Do
        lCount = -1
        lReturn = WNetEnumResource(lEnumHwnd, lCount, lBufferPtr, lBuffer)
        
        If lReturn = ERROR_MORE_DATA Then
            GlobalFree lBufferPtr
            lBufferPtr = GlobalAlloc(GPTR, lBuffer)
        Else
            If lReturn = 0 Then
                lBufferPtrTemp = lBufferPtr
                For lK = 1 To lCount
                    CopyMemory tNR, ByVal lBufferPtrTemp, LenB(tNR)
                    sComputer = PointerToAsciiStr(tNR.lpRemoteName)
                    
                    If sComputer <> "" Then
                        sComputer = Mid(sComputer, InStr(sComputer, "\\") + 2)
                        cComputers.Add sComputer
                    End If
                    lBufferPtrTemp = lBufferPtrTemp + LenB(tNR)
                Next
            End If
        End If
    Loop Until lCount = 0
    
    If lEnumHwnd <> 0 Then
        lReturn = WNetCloseEnum(lEnumHwnd)
    End If
    GlobalFree lBufferPtr
End SubPrivate Function PointerToAsciiStr(ByVal lPtrToString As Long) As String
    On Local Error Resume Next
    Dim lLength As Long
    Dim sStringValue As String
    Dim lNullPos As Long
    Dim lReturn As Long
    
    lLength = StrLenA(lPtrToString)
    
    If lPtrToString > 0 And lLength > 0 Then
        sStringValue = Space$(lLength + 1)
        lReturn = StrCopyA(sStringValue, lPtrToString)
        lNullPos = InStr(1, sStringValue, Chr$(0))
        If lNullPos > 0 Then
            PointerToAsciiStr = Left$(sStringValue, lNullPos - 1)
        Else
            PointerToAsciiStr = sStringValue
        End If
    Else
        PointerToAsciiStr = ""
    End If
End Function'**类clsDomains
Option ExplicitPrivate cDomains As New Collection
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lppEnumHwnd As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal pEnumHwnd As Long, lpcCount As Long, lpBuffer As NETRESOURCE, lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal p_lngEnumHwnd As Long) As Long
Private Declare Function StrLenA Lib "kernel32" Alias "lstrlenA" (ByVal Ptr As Long) As Long
Private Declare Function StrCopyA Lib "kernel32" Alias "lstrcpyA" (ByVal RetVal As String, ByVal Ptr As Long) As LongPrivate Const RESOURCE_GLOBALNET As Long = &H2&
Private Const RESOURCETYPE_ANY As Long = &H0&
Private Const RESOURCEUSAGE_ALL As Long = &H0&
Private Const RESOURCE_ENUM_ALL As Long = &HFFFF
Private Const NO_ERROR As Long = 0&
Private Const MAX_RESOURCES As Long = 256Private Type NETRESOURCE
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    pLocalName As Long
    pRemoteName As Long
    pComment As Long
    pProvider As Long
End TypePublic Function GetCount() As Long
    GetCount = cDomains.Count
End Function
Public Function GetItem(Index As Long) As String
    If Index < 1 Or Index > cDomains.Count Then
        Err.Raise 7771, , "The index is not within valid range!"
        Exit Function
    End If
    GetItem = cDomains.Item(Index)
End Function
Public Sub Refresh()
    Dim tNetAPI(0 To MAX_RESOURCES) As NETRESOURCE
    Dim lBufferSize As Long
    Dim lEnumHwnd As Long
    Dim lReturn As Long
    Dim lCount As Long
    Dim lLoop As Long    Do While cDomains.Count > 0
        cDomains.Remove 1
    Loop
    lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, tNetAPI(0), lEnumHwnd)
    
    If lReturn = NO_ERROR Then
        lCount = RESOURCE_ENUM_ALL
        
        lBufferSize = UBound(tNetAPI) * Len(tNetAPI(0))
        lReturn = WNetEnumResource(lEnumHwnd, lCount, tNetAPI(0), lBufferSize)
        
        If lCount > 0 Then
            For lLoop = 0 To lCount - 1
                cDomains.Add PointerToAsciiStr(tNetAPI(lLoop).pRemoteName)
            Next lLoop
        End If
    End If
    
    If lEnumHwnd <> 0 Then
        Call WNetCloseEnum(lEnumHwnd)
    End If
End SubPrivate Function PointerToAsciiStr(ByVal lPtrToString As Long) As String
    On Local Error Resume Next
    Dim lLength As Long
    Dim sStringValue As String
    Dim lNullPos As Long
    Dim lReturn As Long
    
    lLength = StrLenA(lPtrToString)
    
    If lPtrToString > 0 And lLength > 0 Then
        sStringValue = Space$(lLength + 1)
        lReturn = StrCopyA(sStringValue, lPtrToString)
        lNullPos = InStr(1, sStringValue, Chr$(0))
        If lNullPos > 0 Then
            PointerToAsciiStr = Left$(sStringValue, lNullPos - 1)
        Else
            PointerToAsciiStr = sStringValue
        End If
    Else
        PointerToAsciiStr = ""
    End If
End FunctionPrivate Sub Class_Initialize()
    Call Refresh
End Sub
Private Sub Class_Terminate()
    Do While cDomains.Count > 0
        cDomains.Remove 1
    Loop
End Sub

Answer 2

还有一个问题,我用的是UDP协议,无连接的.是不是就不需要动态生成winsock控件.用一个,只要每次发信息时改变这个控件的remoteHostIP属性,这样做可以吗?