arp.dpr

IPHlpAPI delphi源码

{******************************************************************}
{                                                                  }
{       Arp.dpr - IP Helper API Demonstration project              }
{                                                                  }
{ Portions created by Marcel van Brakel are                        }
{ Copyright (C) 2000 Marcel van Brakel.                            }
{ All Rights Reserved.                                             }
{                                                                  }
{ The original file is: Arp.dpr, released  December 2000.          }
{ The initial developer of the Pascal code is Marcel van Brakel    }
{ ([e-mail]).                                             }
{ 								   }
{ Contributor(s):  Vladimir Vassiliev ([e-mail])       }
{                  John Penman ([e-mail])             }
{                                                                  }
{ Obtained through:                                                }
{ Joint Endeavour of Delphi Innovators (Project JEDI)              }
{                                                                  }
{ You may retrieve the latest version of this file at the Project  }
{ JEDI home page, located at http://delphi-jedi.org.               }
{                                                                  }
{ The contents of this file are used with permission, subject to   }
{ the Mozilla Public License Version 1.1 (the "License"); you may  }
{ not use this file except in compliance with the License. You may }
{ obtain a copy of the License at                                  }
{ http://www.mozilla.org/NPL/NPL-1_1Final.html                     }
{                                                                  }
{ Software distributed under the License is distributed on an      }
{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or   }
{ implied. See the License for the specific language governing     }
{ rights and limitations under the License.                        }
{                                                                  }
{******************************************************************}

program Arp;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, Winsock,
  IpExport, IpHlpApi, IpTypes, IpIfConst, IpRtrMib;

//------------------------------------------------------------------------------

// Convert IP address to dotted decimal

function IpAddrToString(Addr: DWORD): string;
var
  inad: in_addr;
begin
  inad.s_addr := Addr;
  Result := inet_ntoa(inad);
end;

//------------------------------------------------------------------------------

function StringToIpAddr(const Addr: string): DWORD;
begin
  Result := inet_addr(PChar(Addr));
end;

//------------------------------------------------------------------------------

// Converts a physical address to a string. Length is the number of entries in
// the PhysAddr array and PhysAddr itself is the array which contains the
// "encoded" physical address

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

function PhysAddrToString(Length: DWORD; PhysAddr: TPhysAddrByteArray): string;
var
  I: Integer;
begin
  Result := '';
  if Length = 0 then Exit;
  for I := 0 to Length - 1 do
    if I = Integer(Length - 1) then
      Result := Result + Format('%.2x', [PhysAddr[I]])
    else
      Result := Result + (Format('%.2x-', [PhysAddr[I]]));
end;

//------------------------------------------------------------------------------

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
  Assert(Length(PhysAddrString) = 17);
  Assert(
    (PhysAddrString[3] = '-') and
    (PhysAddrString[6] = '-') and
    (PhysAddrString[9] = '-') and
    (PhysAddrString[12] = '-') and
    (PhysAddrString[15] = '-'));
  PhysAddrString := UpperCase(PhysAddrString);
  for I := 0 to 5 do
  begin
    C := PhysAddrString[I * 3];
    V := CharHex(C) shl 4;
    C := PhysAddrString[(I * 3) + 1];
    V := V + CharHex(C);
    PhysAddr[I] := V;
  end;
end;

//------------------------------------------------------------------------------

// Returns the IP address table. The caller must free the memory.

function GetIpAddrTableWithAlloc: PMibIpAddrTable;
var
  Size: ULONG;
begin
  Size := 0;
  GetIpAddrTable(nil, Size, True);
  Result := AllocMem(Size);
  if GetIpAddrTable(Result, Size, True) <> NO_ERROR then
  begin
    FreeMem(Result);
    Result := nil;
  end;
end;

//------------------------------------------------------------------------------

// Returns the IP address (dotted decimal string representation) of the interface
// with the specified index. IpAddrTable is used for the lookup and must be
// sorted. If IpAddrTable is nil, the returned string is '<unknown>'

function IntfIndexToIpAddress(IpAddrTable: PMibIpAddrTable; Index: DWORD): string;
var
  I: Integer;
begin
  if IpAddrTable = nil then
    Result := '<unknown>'
  else
  begin
    for I := 0 to IpAddrTable^.dwNumEntries - 1 do
    begin
      {$R-}
      if IpAddrTable^.table[I].dwIndex = Index then
      begin
        Result := IpAddrToString(IpAddrTable^.table[I].dwAddr);
        Break;
      end;
      {$R+}
    end;
  end;
end;

//------------------------------------------------------------------------------

// Returns a string representing the ARP entry type

function ArpTypeToString(dwType: DWORD): string;
begin
  case dwType of
    MIB_IPNET_TYPE_OTHER: Result := 'Other';
    MIB_IPNET_TYPE_INVALID: Result := 'Invalid';
    MIB_IPNET_TYPE_DYNAMIC: Result := 'Dynamic';
    MIB_IPNET_TYPE_STATIC: Result := 'Static';
  end;
end;

//------------------------------------------------------------------------------

// Displays the ARP table. Filter specifies an IP address for which to display
// ARP entries. If filter is an empty string, all ARP entries are displayed.

procedure DisplayArpTable(const Filter: string);
var
  Size: ULONG;
  I: Integer;
  NetTable: PMibIpNetTable;      // ARP table
  NetRow: TMibIpNetRow;          // ARP entry from ARP table
  CurrentIndex: DWORD;           // Used for displaying a header in case of multiple interfaces
  IpAddrTable: PMibIpAddrTable;  // Address table used for interface index to IP address mapping 
begin
  Size := 0;
  GetIpNetTable(nil, Size, True);
  NetTable := AllocMem(Size);
  try
    if GetIpNetTable(NetTable, Size, True) = NO_ERROR then
    begin
      // Get the IP address table
      IpAddrTable := GetIpAddrTableWithAlloc;
      try
        // Remember the first interface index and display header
        CurrentIndex := NetTable^.table[0].dwIndex;
        WriteLn(Format('Interface: %s on Interface 0x%u', [IntfIndexToIpAddress(IpAddrTable, CurrentIndex), CurrentIndex]));
        WriteLn('  Internet address     Physical address     Type');
        // For each ARP entry
        for I := 0 to NetTable^.dwNumEntries - 1 do
        begin
          {$R-}NetRow := NetTable^.table[I];{$R+}
          if CurrentIndex <> NetRow.dwIndex then
          begin
            // We're changing interfaces, display a new header
            CurrentIndex := NetRow.dwIndex;
            WriteLn;
            WriteLn(Format('Interface: %s on Interface 0x%u',
              [IntfIndexToIpAddress(IpAddrTable, CurrentIndex), CurrentIndex]));
            WriteLn('  Internet address     Physical address     Type');
          end;
          // Only display the entry if it matches the filter
          if (Filter = '') or (Filter = IpAddrToString(NetRow.dwAddr)) then
            WriteLn(Format('  %-20s %-20s %s', [
              IpAddrToString(NetRow.dwAddr),
              PhysAddrToString(NetRow.dwPhysAddrLen, TPhysAddrByteArray(NetRow.bPhysAddr)),
              ArpTypeToString(NetRow.dwType)]));
        end;
      finally
        FreeMem(IpAddrTable);
      end;
    end
    else
    begin
      // Assume failure of GetIpNetTable means there are no ARP entries. This is
      // usually the case but it could fail for other reasons.
      WriteLn('No ARP entries found.');
    end;
  finally
    FreeMem(NetTable);
  end;
end;

//------------------------------------------------------------------------------

// Deletes Host from the ARP table. Host is either an IP address or '*'. In the
// latter case all hosts are deleted from the ARP table. Intf is the internet
// address (IP address) of the interface for which to delete the applicable
// ARP entries. If empty, Host is deleted from each interface ARP table.

function IpAddressToAdapterIndex(const Intf: string): Integer; overload;
var
  Adapters, Adapter: PIpAdapterInfo;
  Size: ULONG;
  IpAddrString: PIpAddrString;
begin
  Result := -1;