frmmacarp.frm

全面网络扫描器VB源代码 很实用

VERSION 5.00
Begin VB.Form frmmacarp 
   BackColor       =   &H00000000&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Local or Remote MAC Address via SendARP"
   ClientHeight    =   1905
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5115
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1905
   ScaleWidth      =   5115
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text2 
      Height          =   285
      Left            =   1440
      TabIndex        =   4
      Top             =   840
      Width           =   3495
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   1440
      TabIndex        =   2
      Top             =   240
      Width           =   3495
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   1440
      TabIndex        =   0
      Top             =   1320
      Width           =   2415
   End
   Begin VB.Label Label2 
      BackColor       =   &H00000000&
      Caption         =   "MAC Address"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   840
      Width           =   1095
   End
   Begin VB.Label Label1 
      BackColor       =   &H00000000&
      Caption         =   "IP Address"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   240
      Width           =   1095
   End
End
Attribute VB_Name = "frmmacarp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const NO_ERROR = 0

Private Declare Function inet_addr Lib "wsock32.dll" _
  (ByVal s As String) As Long

Private Declare Function SendARP Lib "iphlpapi.dll" _
  (ByVal DestIP As Long, _
   ByVal SrcIP As Long, _
   pMacAddr As Long, _
   PhyAddrLen As Long) As Long

Private 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.1" 'or address of interest
   Text2.Text = ""
   Command1.Caption = "Get Remote Mac Address"
   
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 If

End Sub


Private Function GetRemoteMACAddress(ByVal sRemoteIP As String, _
                                     sRemoteMacAddress As String, _
                                     sDelimiter As String) As Boolean

   Dim dwRemoteIP As Long
   Dim pMacAddr As Long
   Dim bpMacAddr() As Byte
   Dim PhyAddrLen As Long
    
  'convert the string IP into
  'an unsigned long value containing
  'a suitable binary representation
  'of the Internet address given
   dwRemoteIP = ConvertIPtoLong(sRemoteIP)

   If dwRemoteIP <> 0 Then
   
     'must set this up first!
      PhyAddrLen = 6
   
    'assume failure
     GetRemoteMACAddress = False
     
     'retrieve the remote MAC address
      If SendARP(dwRemoteIP, 0&, pMacAddr, PhyAddrLen) = NO_ERROR Then
      
         If (pMacAddr <> 0) And (PhyAddrLen <> 0) Then
      
           'returned value is a long pointer
           'to the MAC address, so copy data
           'to a byte array
            ReDim bpMacAddr(0 To PhyAddrLen - 1)
            CopyMemory bpMacAddr(0), pMacAddr, ByVal PhyAddrLen
            
           'convert the byte array to a string
           'and return success
            sRemoteMacAddress = MakeMacAddress(bpMacAddr(), sDelimiter)
            GetRemoteMACAddress = True
            
         End If 'pMacAddr

      End If  'SendARP
      
   End If  'dwRemoteIP
      
End Function


Private Function ConvertIPtoLong(sIpAddress) As Long

   ConvertIPtoLong = inet_addr(sIpAddress)

End Function


Private Function MakeMacAddress(b() As Byte, sDelim As String) As String

   Dim cnt As Long
   Dim buff As String
   
   On Local Error GoTo MakeMac_error
 
  'so far, MAC addresses are
  'exactly 6 segments in size (0-5)
   If UBound(b) = 5 Then
   
     'concatenate the first five values
     'together and separate with the
     'delimiter char
      For cnt = 0 To 4
         buff = buff & Right$("00" & Hex(b(cnt)), 2) & sDelim
      Next
      
     'and append the last value
      buff = buff & Right$("00" & Hex(b(5)), 2)
         
   End If  'UBound(b)
   
   MakeMacAddress = buff
   
MakeMac_exit:
   Exit Function
   
MakeMac_error:
   MakeMacAddress = "(error building MAC address)"
   Resume MakeMac_exit
   
End Function