arp.~pas

显示ARP缓存信息.A R P高效运行的关键是由于每个主机上都有一个A R P高速缓存。这个高速缓存存放了最 近I n t e r n e t地址到硬件地址之间的映射记录。高速缓存中每一项的生存时间

unit arp;

interface

uses
  Windows, Messages, sysutils,Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,winsock, ExtCtrls, Psock, NMDayTim;
//  iphlpapi,IpTypes, IPExport, Iprtrmib,winsock;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    ComboBox1: TComboBox;
    GroupBox3: TGroupBox;
    Memo1: TMemo;
    StaticText1: TStaticText;
    GroupBox4: TGroupBox;
    StaticText2: TStaticText;
    Memo2: TMemo;
    Button4: TButton;
    StaticText3: TStaticText;
    Label3: TLabel;
    Label4: TLabel;
    Button5: TButton;
    Button6: TButton;
    CheckBox1: TCheckBox;
    Timer1: TTimer;
    NMDayTime1: TNMDayTime;
    Label5: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
const
    ARPEntryType  : array[1..4] of string = ( 'Other', 'Invalid',
    'Dynamic', 'Static'
    );
    MAX_ADAPTER_ADDRESS_LENGTH = 8; // arb.

type
  TMacAddress = array[1..MAX_ADAPTER_ADDRESS_LENGTH] of byte;

var
  Form1: TForm1;

implementation
 uses
  IPExport,
  IPHlpApi,
  Iprtrmib,
  IpTypes,
  ipfunctions,
  findcomputerip;

  // TPhysAddrByteArray = array [0..MAXLEN_PHYSADDR - 1] of BYTE;

{$R *.dfm}
var  apindex:dword;
function NextToken( var s: string; Separator: char ): string;
var
  Sep_Pos       : byte;
begin
  Result := '';
  if length( s ) > 0 then
  begin
       Sep_Pos := pos( Separator, s );
       if Sep_Pos > 0 then
       begin
            Result := copy( s, 1, Pred( Sep_Pos ) );
            Delete( s, 1, Sep_Pos );
       end
       else
       begin
            Result := s;
            s := '';
       end;
  end;
end;
function yes_no_mac(mac:string):boolean;
var x:byte;
begin
      yes_no_mac:=true;
      if length(mac)<>17 then
      begin
            yes_no_mac:=false;
            exit;
      end;
      for x:=1 to 17 do
      begin
           IF mac[x] in ['0'..'9','-','A'..'F','a'..'f'] THEN
           begin
                case x of
                3,6,9,12,15:
                if mac[x]<>'-' then
                begin
                     yes_no_mac:=false;
                     exit;
                end;
                end;
           end
           else
           begin
                yes_no_mac:=false;
                exit;
           end;
      end;
end;
function yes_no_ip(ip:string):boolean;
var x,leng:integer;
begin
         leng:=length(ip);
         for x:=1 to leng do
         if not(ip[x] in ['0'..'9','.']) then
         begin
                result:=false;
                exit;
         end;
         x:=0;
         while pos('.',ip)<>0 do
         begin
               if not((strtoint(copy(ip,1,pos('.',ip)-1))>0)and
                  (strtoint(copy(ip,1,pos('.',ip)-1))<255)) then
               begin
                    result:=false;
                    exit;
               end;
               delete(ip,1,pos('.',ip));
               inc(x);
         end;
         if length(ip)<>0 then
         if not((strtoint(ip)>0)and(strtoint(ip)<255)) then
         begin
               result:=false;
               exit;
         end ;
         if x<>3 then
         begin
              result:=false;
              exit;
         end
         else result:=true;
end;
//------------------------------------------------------------------------------
{ concerts numerical MAC-address to ww-xx-yy-zz string }
function MacAddr2Str( MacAddr:  TPhysAddrByteArray; size: integer ): string;
var
  i             : integer;
begin
  if Size = 0 then
  begin
    Result := '00-00-00-00-00-00';
    EXIT;
  end
  else Result := '';
  //
  for i := 0 to Size-1 do
    Result := Result + IntToHex( MacAddr[i], 2 ) + '-';
  Delete( Result, Length( Result ), 1 );
end;
function getip(ip:string):string;
var ips:string;
begin
     ips:='';
     while pos('.',ip)<>0 do
     begin
           ips:=ips+copy(ip,1,pos('.',ip));
           delete(ip,1,pos('.',ip));
     end;
     getip:=ips;
end;
//------------------------------------------------------------------------------
{ converts IP-address in network byte order DWORD to dotted decimal string}
function IpAddr2Str( IPAddr: DWORD ): string;
var
  i             : integer;
begin
  Result := '';
  for i := 1 to 4 do
  begin
    Result := Result + Format( '%3d.', [IPAddr and $FF] );
    IPAddr := IPAddr shr 8;
  end;
  Delete( Result, Length( Result ), 1 );
end;

//------------------------------------------------------------------------------
{ converts dotted decimal IP-address to network byte order DWORD}
function Str2IpAddr( IPStr: string ): DWORD;
var
  i             : integer;
  Num           : DWORD;
begin
  Result := 0;
  for i := 1 to 4 do
  try
    Num := ( StrToInt( NextToken( IPStr, '.' ) ) ) shl 24;
    Result := ( Result shr 8 ) or Num;
  except
    Result := 0;
  end;

end;
//------------------------------------------------------------------------------
{ converts port number in network byte order to DWORD }
function Port2Wrd( nwoPort: DWORD ): DWORD;
begin
  Result := Swap( WORD( nwoPort ) );
end;

//------------------------------------------------------------------------------
{ converts port number in network byte order to string }
function Port2Str( nwoPort: DWORD ): string;
begin
  Result := IntToStr( Port2Wrd( nwoPort ) );
end;

//------------------------------------------------------------------------------
{ converts well-known port numbers to service ID }
procedure get_arptable;
var
  Size: ULONG;
  p: PMibIpNetTable;
  i,j: integer;
  s: string;
begin
  form1.memo1.Clear;
  form1.combobox1.clear;
  form1.ComboBox1.Text:='请选择IP地址...';
  VVGetIpNetTable(p, Size, True);
  if p <> nil then
     if p^.table[0].dwindex<>0 then
     form1.StaticText1.Caption:='网卡序列号:'+format('%8x',[p^.table[0].dwindex]);
      with p^,form1.Memo1.Lines do
      begin
        for i := 0 to dwNumEntries-1 do
          with table[i] do
          begin
            s := '';
            for j := 0 to dwPhysAddrLen-1 do
            s := s + IntToStr(bPhysAddr[j]);
            Add( Format( '%16s   %12s  %10s',
                        [IPAddr2Str( dwAddr ),
                        MacAddr2Str( bphysaddr,dwphysaddrlen),
                        ARPEntryType[dwType]]));
          form1.combobox1.items.add(ipaddr2str(dwaddr));
          end;
      end;
      FreeMem(p);

end;
procedure ipmacSendARP;
var
  DestIP, SrcIP: IPAddr;
  pMacAddr: PULong;
  AddrLen: ULong;
  MacAddr: array[0..5] of byte;
  p: PByte;
  ds,s,m: string;
  sum,i,j: integer;
  Res: DWORD;
function yes_no_se(se:string):boolean;
var i:byte;
begin
     if (length(se)>0)and(length(se)<4) then
     begin
         for i:=1 to length(se) do
         if not(se[i] in ['0'..'9']) then
         begin
              yes_no_se:=false;
              exit;
         end;
         if (strtoint(se)>0) and (strtoint(se)<255) then
         begin
              yes_no_se:=true;
              exit;
         end
         else
         begin
              yes_no_se:=false;
              exit;
         end;
     end
     else
     begin
          yes_no_se:=false;
          exit;
     end;
end;
begin
  form1.Memo2.clear;
  SrcIp := 0;
  sum:=0;
  s:=getip(form1.NMDayTime1.LocalIP);
  if not(yes_no_se(form1.edit3.text)) then
  begin
       showmessage('IP地址范围错误!');
       exit;
  end;
  if not(yes_no_se(form1.edit4.text)) then
  begin
       showmessage('IP地址范围错误!');
       exit;
  end;
  if (strtoint(form1.edit3.text))>(strtoint(form1.edit4.text)) then
  begin
       showmessage('IP地址顺序错误!');
       exit;
  end;
  for j:=strtoint(form1.edit3.text) to strtoint(form1.edit4.text) do
  begin
       ds:=s+inttostr(j);
       DestIP := inet_addr(PChar(ds));
       pMacAddr := @MacAddr[0];
       AddrLen := SizeOf(MacAddr);
       Res := SendARP(DestIP, SrcIP, PMacAddr, AddrLen);
       inc(sum);
       if Res = NO_ERROR then
       begin

       //form1.Memo2.Lines.add(inttostr(Res));
       //SendARP(DestIP, SrcIP, pMacAddr, AddrLen);
            m := '';
            p := PByte(pMacAddr);
            if Assigned(p) and (AddrLen>0) then
            for i := 0 to AddrLen-1 do
            begin
                 m := m + IntToHex(p^,2) + '-';
                 Inc(p);
            end;
            SetLength(m, length(m)-1);
            form1.Memo2.Lines.Add(format('%3s',[inttostr(sum)])+'.  '+IpAddr2Str(destip)+'    '+m);
       end
       else
            form1.Memo2.Lines.Add(format('%3s',[inttostr(sum)])+'.  '+IpAddr2Str(destip)+'         未在线!');
  end;
end;
procedure get_arptablestart;
var
  Size: ULONG;
  p: PMibIpNetTable;
begin
  form1.memo1.Clear;
  VVGetIpNetTable(p, Size, True);
  if p <> nil then
  begin
      apindex:=p^.table[0].dwindex;
      form1.StaticText1.Caption:='网卡序列号:'+format('%8x',[p^.table[0].dwindex])
  end;
  FreeMem(p);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
      checkbox1.State:=cbchecked;
      form1.memo2.Clear;
      get_arptablestart;
      get_arptable;
      form1.label3.caption:='从 '+getip(form1.NMDayTime1.LocalIP);
      form1.label5.caption:='到 '+getip(form1.NMDayTime1.LocalIP);

end;
procedure TForm1.Button4Click(Sender: TObject);
begin
       close;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
      get_arptable;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
        ipmacsendarp;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
      if checkbox1.State=cbchecked then
      get_arptable;
end;
procedure TForm1.Button5Click(Sender: TObject);
var
  dwIfIndex: DWORD;
begin
  dwIfIndex := apindex;
  VVFlushIpNetTable(dwIfIndex);
  Memo1.Lines.Add('缓存已清空!');
  combobox1.clear;
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
      timer1.Enabled:=false;
      checkbox1.State:=cbunchecked;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
   NetRow: TMibIpNetRow;
   s: string;
procedure delzr(var ips:string);
begin
        while pos(' ',ips)<>0 do
        delete(ips,pos(' ',ips),1);
end;
begin
     if combobox1.ItemIndex<>-1 then
     begin
          with NetRow do
          begin
               dwIndex := apindex;
               s := (combobox1.text);
               if s='' then Exit;
               delzr(s);
               dwAddr := inet_addr(PChar((s)));
         end;
         VVDeleteIpNetEntry(NetRow);
         showmessage('已成功删除'+s+'!');
         timer1.Enabled:=true;
         checkbox1.State:=cbchecked;
     end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  Entry: TMibIpNetRow;
  ok:dword;
function CharHex(const C: AnsiChar): Byte;
const
  AnsiDecDigits = ['0'..'9'];
  AnsiHexDigits = ['0'..'9', 'A'..'F', 'a'..'f'];
begin
  Result := $FF;
  if C in AnsiDecDigits then
    Result := Ord(C) - 48
  else if C in AnsiHexDigits then
    Result := Ord(C) - 55;
end;
procedure StringToPhysAddr(PhysAddrString: string; var PhysAddr: TPhysAddrByteArray);
var
  C: Char;
  I, V: Integer;
begin
  PhysAddrString := UpperCase(PhysAddrString);
  for I := 0 to 5 do
  begin
    C := PhysAddrString[I * 3+1];
    V := CharHex(C) shl 4;
    C := PhysAddrString[(I * 3) + 2];
    V := V + CharHex(C);
    PhysAddr[I] := V;
  end;
end;
begin
  if not(yes_no_ip(edit1.text)) then
  begin
       showmessage('IP地址错误!');
       exit;
  end;
  if not(yes_no_mac(edit2.text)) then
  begin
       showmessage('MAC地址错误!');
       exit;
  end;
  FillChar(Entry, SizeOf(Entry), 0);
  Entry.dwAddr := inet_addr(pchar(edit1.text));
  Entry.dwPhysAddrLen := 6;
  Entry.dwType := MIB_IPNET_TYPE_STATIC;
  Entry.dwIndex := apindex;
  StringToPhysAddr(edit2.text, Entry.bPhysAddr);
  ok:=SetIpNetEntry(Entry);
  showmessage('已成功添加'+edit1.text+'!');
end;

end.