upassarp.pas

来自「这个是Delphi 2007下写的」· PAS 代码 · 共 209 行

unit uPassARP;
{
  执行 arp -a 导出本机ARP缓存
  并读入 fIPList, fMACList, fInfo 中备查
  Ver0.2         By 木桩 2008.01
}
interface

uses
  Windows, SysUtils, Classes, Forms, Messages,
  uPingThread;

const
  WM_PINGPROCESS = WM_USER + 100;

type
  TIPMACSeeker = class
    fEthInterface: String;
    fIPList, fMACList, fInfo: TStringList;
    fListCount: Integer;

    fPingThreads: array of TPingThread;
    fThreadCount: Integer;
    fBaseIP: String;
    fipStart, fipEnd: Integer;
    fTimeOut: Integer;
    fFormHandle: Cardinal;

    fWaitARP: Boolean;
  private
    procedure ThreadPing();
    procedure WinExecAndGetOut(CMD: String);
  public
    procedure Init(BaseIP: String; ipStart, ipEnd, ThreadCount: Integer; PingTimeOut: Integer = 1000);
    property PingTimeOut: Integer read fTimeOut write fTimeOut;

    constructor Create(RecvFrom: Cardinal);
    destructor Destroy(); override;

    property EthInterface: String read fEthInterface;     // 网络接口(本机地址)
    property IPList: TStringList read fIPList write fIPList;
    property MACList: TStringList read fMACList write fMACList;
    property IPInfo: TStringList read fInfo write fInfo;
    property Count: Integer read fListCount;
    property WaitARP: boolean read fWaitARP write fWaitARP;
  end;

implementation

procedure TIPMACSeeker.ThreadPing();
var
  i, j, RunThreads: Integer;
  isDone: Boolean;
begin
  i := fipStart;
  while (i <= fipEnd) do
  begin
    // 计算需要的线程数
    RunThreads := fipEnd+1 - i;
    if (RunThreads > fThreadCount) then RunThreads := fThreadCount;

    // 创建线程
    for j := 0 to RunThreads - 1 do
    begin
      // 记录Host
      IPList.Strings[i] := Format('%s%d', [fBaseIP, i]);
      fPingThreads[j] := TPingThread.Create(fFormHandle,
                              Format('%s%d', [fBaseIP, i]), fTimeOut);
      Inc(i);
    end;
    PostMessage(fFormHandle, WM_PINGPROCESS, i, RunThreads);

    // 等待线程结束
    repeat
      isDone := True; Sleep(100);
      for j := 0 to RunThreads - 1 do
        isDone := isDone and fPingThreads[j].isPingFinish;
      Application.ProcessMessages;
    until (isDone);
  end;

  fListCount := fIPList.Count;
end;

procedure TIPMACSeeker.Init(BaseIP: String; ipStart, ipEnd,
                ThreadCount: Integer; PingTimeOut: Integer = 1000);
const
  tmpFile = '.\tmpMAC.txt';
var
  i, Index: Integer;
  tmpList: TStringList;
  tmpLine, sMAC, sIP: String;
begin
  // 多线程 Ping
  fThreadCount := ThreadCount;
  SetLength(fPingThreads, fThreadCount);      // 设置线程数
  fBaseIP := BaseIP;
  fipStart := ipStart;                        // 从
  fipEnd := ipEnd;                            // 到
  fTimeOut := PingTimeOut;                    // Ping 超时时间

  // Ping
  ThreadPing();
  SendMessage(fFormHandle, WM_PINGPROCESS, -2, 0);
  if fWaitARP then Sleep(PingTimeOut);

  // 执行 arp -a 导出ARP缓存
  WinExecAndGetOut(Format('cmd /k "arp -a > %s"', [tmpFile]));

  tmpList := TStringList.Create;
  try
    if FileExists(tmpFile) then
    begin
      tmpList.LoadFromFile(tmpFile);
      DeleteFile(tmpFile);
    end;
    // 生成 IP - MAC 列表
    for i := 0 to tmpList.Count - 1 do
    begin
      tmpLine := Trim(tmpList.Strings[i]);
      if tmpLine = '' then Continue;
      if (Pos('Internet Address', tmpLine) > 0) then Continue;
      if (Pos('Interface', tmpLine) > 0) then
      begin
        tmpLine := Trim(Copy(tmpLine, Pos(' ', tmpLine), 15));
        if Pos(fBaseIP, tmpLine) > 0 then
          fEthInterface := tmpLine;
        Continue;
      end;
      if (tmpLine = '--end--') then Break;
      
      sIP := Trim(Copy(tmpLine, 1, 16));        // 取IP
      sMAC := Trim(Copy(tmpLine, 22, 18));      // 取MAC
      tmpLine := Trim(Copy(tmpLine, 44, 10));   // 状态
      if tmpLine <> 'invalid' then
      begin
        // 不是无效地址
        Index := fIPList.IndexOf(sIP);
        if Index >= 0 then                      // 只添加在同一网关下的主机
        begin
          // IP在列表中
          if fInfo.Strings[Index] = '超时' then   // Ping不到但是响应ARP的
            fInfo.Strings[Index] := '有防火墙';     // 标记防火墙标志
          fMACList.Strings[Index] := sMAC;
        end;
      end;
    end;  //end for
  finally
    tmpList.Free;
  end;

  // 添加自己的MAC标识
  Index := fIPList.IndexOf(fEthInterface);
  if Index >= 0 then     
    fMACList.Strings[Index] := ' <  Interface  > ';
end;

constructor TIPMACSeeker.Create(RecvFrom: Cardinal);
var
  i: Integer;
begin
  fFormHandle := RecvFrom;

  fIPList := TStringList.Create;
  fMACList := TStringList.Create;
  fInfo := TStringList.Create;
  fListCount := 256;
  for i := 0 to fListCount - 1 do
  begin
    fIPList.Add('');
    fMACList.Add('');
    fInfo.Add('未知');
  end;

  fWaitARP := True;
  //if AutoInit then Init();

  inherited Create;
end;

destructor TIPMACSeeker.Destroy();
begin
  fIPList.Free;
  fMACList.Free;
  fInfo.Free;
  inherited Destroy;
end;

procedure TIPMACSeeker.WinExecAndGetOut(CMD: String);
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  FillChar(StartupInfo, Sizeof(StartupInfo), #0);
  StartupInfo.cb := Sizeof(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  StartupInfo.wShowWindow := 0;

  if CreateProcess(nil, PChar(CMD), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, PChar(ExtractFileDir(Application.ExeName)), StartupInfo, ProcessInfo) then
  begin
    WaitforSingleObject(ProcessInfo.hProcess, INFINITE);

    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end;
end;

end.