如何取得局域网内的所有电脑的网卡地址及相应的计算机名?

如何取得局域网内的所有电脑的网卡地址及相应的计算机名?

解决方案 »

  1.   

    得到局域网中所有机器名Option ExplicitPrivate Const RESOURCE_CONNECTED As Long = &H1&
    Private Const RESOURCE_GLOBALNET As Long = &H2&
    Private Const RESOURCE_REMEMBERED As Long = &H3&Private Const RESOURCEDISPLAYTYPE_DIRECTORY& = &H9
    Private Const RESOURCEDISPLAYTYPE_DOMAIN& = &H1
    Private Const RESOURCEDISPLAYTYPE_FILE& = &H4
    Private Const RESOURCEDISPLAYTYPE_GENERIC& = &H0
    Private Const RESOURCEDISPLAYTYPE_GROUP& = &H5
    Private Const RESOURCEDISPLAYTYPE_NETWORK& = &H6
    Private Const RESOURCEDISPLAYTYPE_ROOT& = &H7
    Private Const RESOURCEDISPLAYTYPE_SERVER& = &H2
    Private Const RESOURCEDISPLAYTYPE_SHARE& = &H3
    Private Const RESOURCEDISPLAYTYPE_SHAREADMIN& = &H8
    Private Const RESOURCETYPE_ANY As Long = &H0&
    Private Const RESOURCETYPE_DISK As Long = &H1&
    Private Const RESOURCETYPE_PRINT As Long = &H2&
    Private Const RESOURCETYPE_UNKNOWN As Long = &HFFFF&
    Private Const RESOURCEUSAGE_ALL As Long = &H0&
    Private Const RESOURCEUSAGE_CONNECTABLE As Long = &H1&
    Private Const RESOURCEUSAGE_CONTAINER As Long = &H2&
    Private Const RESOURCEUSAGE_RESERVED As Long = &H80000000
    Private Const NO_ERROR = 0
    Private Const ERROR_MORE_DATA = 234 'L    // dderror
    Private Const RESOURCE_ENUM_ALL As Long = &HFFFF
    Private 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 Type
    Private Type NETRESOURCE_REAL
        dwScope As Long
        dwType As Long
        dwDisplayType As Long
        dwUsage As Long
        sLocalName As String
        sRemoteName As String
        sComment As String
        sProvider As String
    End Type
    Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags 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, lpBuffer As NETRESOURCE, lpBufferSize As Long) As Long
    Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
    Private Declare Function VarPtrAny Lib "vb40032.dll" Alias "VarPtr" (lpObject As Any) As Long
    Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (lpTo As Any, lpFrom As Any, ByVal lLen As Long)
    Private Declare Sub CopyMemByPtr Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpTo As Long, ByVal lpFrom As Long, ByVal lLen As Long)
    Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
    Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As LongSub GetLocalInfo()    Const MAX_RESOURCES = 256
        Const NOT_A_CONTAINER = -1    Dim bFirstTime As Boolean
        Dim lReturn As Long
        Dim hEnum As Long
        Dim lCount As Long
        Dim lMin As Long
        Dim lLength As Long
        Dim l As Long
        Dim lBufferSize As Long
        Dim lLastIndex As Long
        Dim uNetApi(0 To MAX_RESOURCES) As NETRESOURCE
        Dim uNet() As NETRESOURCE_REAL
        bFirstTime = True
        Do
            If bFirstTime Then
                lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, ByVal 0&, hEnum)
                bFirstTime = False
            Else
                If uNet(lLastIndex).dwUsage And RESOURCEUSAGE_CONTAINER Then
                    lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, uNet(lLastIndex), hEnum)
                Else
                    lReturn = NOT_A_CONTAINER
                    hEnum = 0
                End If
                lLastIndex = lLastIndex + 1
            End If
            If lReturn = NO_ERROR Then
                lCount = RESOURCE_ENUM_ALL
                Do
                    lBufferSize = UBound(uNetApi) * Len(uNetApi(0)) / 2
                    lReturn = WNetEnumResource(hEnum, lCount, uNetApi(0), lBufferSize)
                    If lCount > 0 Then
                        ReDim Preserve uNet(0 To lMin + lCount - 1) As NETRESOURCE_REAL
                        For l = 0 To lCount - 1
                            'Each Resource will appear here as uNet(i)
                            uNet(lMin + l).dwScope = uNetApi(l).dwScope
                            uNet(lMin + l).dwType = uNetApi(l).dwType
                            uNet(lMin + l).dwDisplayType = uNetApi(l).dwDisplayType
                            uNet(lMin + l).dwUsage = uNetApi(l).dwUsage
                            If uNetApi(l).pLocalName Then
                                lLength = lstrlen(uNetApi(l).pLocalName)
                                uNet(lMin + l).sLocalName = Space$(lLength)
                                CopyMem ByVal uNet(lMin + l).sLocalName, ByVal uNetApi(l).pLocalName, lLength
                            End If
                            If uNetApi(l).pRemoteName Then
                                lLength = lstrlen(uNetApi(l).pRemoteName)
                                uNet(lMin + l).sRemoteName = Space$(lLength)
                                CopyMem ByVal uNet(lMin + l).sRemoteName, ByVal uNetApi(l).pRemoteName, lLength
                            End If
                            If uNetApi(l).pComment Then
                                lLength = lstrlen(uNetApi(l).pComment)
                                uNet(lMin + l).sComment = Space$(lLength)
                                CopyMem ByVal uNet(lMin + l).sComment, ByVal uNetApi(l).pComment, lLength
                            End If
                            If uNetApi(l).pProvider Then
                                lLength = lstrlen(uNetApi(l).pProvider)
                                uNet(lMin + l).sProvider = Space$(lLength)
                                CopyMem ByVal uNet(lMin + l).sProvider, ByVal uNetApi(l).pProvider, lLength
                            End If
                        Next l
                    End If
                    lMin = lMin + lCount
                Loop While lReturn = ERROR_MORE_DATA
            End If
            If hEnum Then
                l = WNetCloseEnum(hEnum)
            End If
        Loop While lLastIndex < lMin
        If UBound(uNet) > 0 Then
            For l = 0 To UBound(uNet)
                Select Case uNet(l).dwDisplayType
                    Case RESOURCEDISPLAYTYPE_DIRECTORY&
                   '     Debug.Print "Directory...",
                    Case RESOURCEDISPLAYTYPE_DOMAIN
                       ' Debug.Print "Domain...",
                    Case RESOURCEDISPLAYTYPE_FILE
                      '  Debug.Print "File...",
                    Case RESOURCEDISPLAYTYPE_GENERIC
                      '  Debug.Print "Generic...",
                    Case RESOURCEDISPLAYTYPE_GROUP
                      '  Debug.Print "Group...",
                    Case RESOURCEDISPLAYTYPE_NETWORK&
                    
                     '   Debug.Print "Network...",
                    Case RESOURCEDISPLAYTYPE_ROOT&
                     '   Debug.Print "Root...",
                    Case RESOURCEDISPLAYTYPE_SERVER
                        
                        MsgBox "Server..." & uNet(l).sRemoteName
                    Case RESOURCEDISPLAYTYPE_SHARE
                     '   Debug.Print "Share...",
                    Case RESOURCEDISPLAYTYPE_SHAREADMIN&
                    '    Debug.Print "ShareAdmin...",
                End Select
              '  Debug.Print uNet(l).sRemoteName, uNet(l).sComment
            Next l
        End If
    End SubPrivate Sub Form_Load()
        Call GetLocalInfo
    End Sub
      

  2.   


    根据机器名，得到IP地址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 Const WSADescription_Len = 256
    Private Const WSASYS_Status_Len = 128Private Type HOSTENT
       hname As Long
       hAliases As Long
       hAddrType As Integer
       hLength As Integer
       hAddrList As Long
    End TypePrivate 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
    Private Declare Function gethostbyaddr Lib "WSOCK32.DLL" (addr As Any, ByVal _
    byteslen As Integer, addrtype As Integer) As Long
    Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
    Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal _
            wVersionRequired&, lpWSAData As WSADATA) As Long
    Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
    Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal _
            hostname$) As Long
    Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, _
            ByVal hpvSource&, ByVal cbCopy&)Function hibyte(ByVal wParam As Integer)    '获得整数的高位
       hibyte = wParam \ &H100 And &HFF&
    End FunctionFunction lobyte(ByVal wParam As Integer)    '获得整数的低位
       lobyte = wParam And &HFF&
    End FunctionFunction SocketsInitialize()
       Dim WSAD As WSADATA
       Dim iReturn As Integer
       Dim sLowByte As String, sHighByte As String, sMsg As String
       
       iReturn = WSAStartup(WS_VERSION_REQD, WSAD)
       
       If iReturn <> 0 Then
          MsgBox "Winsock.dll 没有反应."
          End
       End If
       
       If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
          sHighByte = Trim$(str$(hibyte(WSAD.wversion)))
          sLowByte = Trim$(str$(lobyte(WSAD.wversion)))
          sMsg = "Windows Sockets版本 " & sLowByte & "." & sHighByte
          sMsg = sMsg & " 不被winsock.dll支持 "
          MsgBox sMsg
          End
       End If
       
       If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
          sMsg = "这个系统需要的最少Sockets数为 "
          sMsg = sMsg & Trim$(str$(MIN_SOCKETS_REQD))
          MsgBox sMsg
          End
       End If
       
    End FunctionSub SocketsCleanup()
       Dim lReturn As Long
       
       lReturn = WSACleanup()
       
       If lReturn <> 0 Then
          MsgBox "Socket错误 " & Trim$(str$(lReturn)) & " occurred in Cleanup "
          End
       End If
    End Sub
    Sub Form_Load()
        '初始化Socket
        SocketsInitialize
        Command1.Caption = "在text1输入机器名，text2得到IP"End SubPrivate Sub Form_Unload(Cancel As Integer)
        '清除Socket
        SocketsCleanup
    End Sub
    Private Function getip(name As String) As String
       Dim hostent_addr As Long
       Dim host As HOSTENT
       Dim hostip_addr As Long
       Dim temp_ip_address() As Byte
       Dim i As Integer
       Dim ip_address As String
       
       hostent_addr = gethostbyname(name)
       
       If hostent_addr = 0 Then
          getip = ""
          Exit Function
       End If
       
       RtlMoveMemory host, hostent_addr, LenB(host)
       RtlMoveMemory hostip_addr, host.hAddrList, 4
       
       ReDim temp_ip_address(1 To host.hLength)
       RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
       
       For i = 1 To host.hLength
          ip_address = ip_address & temp_ip_address(i) & "."
       Next
       ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
       
       getip = ip_addressEnd FunctionPrivate Sub Command1_click()
        Dim str As String
        str = getip(Text1.Text)
        If str = "" Then
            Text2.Text = "主机名不能被解释"
        Else
            Text2.Text = str
        End If
    End Sub
      

  3.   


    根据IP 得到网卡地址Option ExplicitPrivate Const NO_ERROR = 0Private Declare Function inet_addr Lib "wsock32.dll" _
      (ByVal s As String) As LongPrivate Declare Function SendARP Lib "iphlpapi.dll" _
      (ByVal DestIP As Long, _
       ByVal SrcIP As Long, _
       pMacAddr As Long, _
       PhyAddrLen As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" _
       Alias "RtlMoveMemory" _
      (dst As Any, _
       src As Any, _
       ByVal bcount As Long)
       
    Private Sub Form_Load()   Text1.Text = "192.168.0.12"
       Text2.Text = ""
       Command1.Caption = "得到网卡地址"
       
    End Sub
    Private Sub Command1_Click()   Dim sRemoteMacAddress As String
       
       If Len(Text1.Text) > 0 Then
       
          If GetRemoteMACAddress(Text1.Text, sRemoteMacAddress) Then
             Text2.Text = sRemoteMacAddress
          Else
             Text2.Text = "(SendARP call failed)"
          End If
          
       End IfEnd Sub
    Private Function GetRemoteMACAddress(ByVal sRemoteIP As String, _
                                         sRemoteMacAddress As String) As Boolean   Dim dwRemoteIP As Long
       Dim pMacAddr As Long
       Dim bpMacAddr() As Byte
       Dim PhyAddrLen As Long
       Dim cnt As Long
       Dim tmp As String
        
        dwRemoteIP = inet_addr(sRemoteIP)
       
       If dwRemoteIP <> 0 Then
           PhyAddrLen = 6
       
           If SendARP(dwRemoteIP, 0&, pMacAddr, PhyAddrLen) = NO_ERROR Then
          
             If pMacAddr <> 0 And PhyAddrLen <> 0 Then
          
                 ReDim bpMacAddr(0 To PhyAddrLen - 1)
                CopyMemory bpMacAddr(0), pMacAddr, ByVal PhyAddrLen
              
                 For cnt = 0 To PhyAddrLen - 1
                   
                   If bpMacAddr(cnt) = 0 Then
                      tmp = tmp & "00-"
                   Else
                      tmp = tmp & Hex$(bpMacAddr(cnt)) & "-"
                   End If
             
                Next
               
                 If Len(tmp) > 0 Then
                   sRemoteMacAddress = Left$(tmp, Len(tmp) - 1)
                   GetRemoteMACAddress = True
                End If            Exit Function
             
             Else
                GetRemoteMACAddress = False
             End If
                
          Else
             GetRemoteMACAddress = False
          End If
          
       Else
          GetRemoteMACAddress = False
       End If
          
    End Function