unit1.~pas

以服务方式定时检查网关IP与MAC地址是否相符

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, DosCommand, WinSock;

type
  TServiceFixArp = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceCreate(Sender: TObject);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

type
  FixARP = class(TThread)
  private
    { Private declarations }
    CommandFinish:Boolean;
    ArpDOSCommand:TDosCommand;
    procedure CommandNewLine(Sender:TObject;NewLine:String;OutputType:TOutputType);
    procedure CommandTerminated(Sender: TObject);
//    procedure LogAlarmToText(sContent: string);
  protected
    procedure Execute; override;
  public
    constructor Create(bRun:Boolean);
  end;

var
  ServiceFixArp: TServiceFixArp;
  FixArpThread: FixARP;
  procedure LogAlarmToText(sContent: string);
  Function SendArp(ipaddr:ulong;
    temp:dword;
    ulmacaddr:pointer;
    ulmacaddrleng:pointer) : DWord; StdCall; External 'Iphlpapi.dll' Name 'SendARP';
implementation

{$R *.DFM}
constructor FixARP.Create(bRun:Boolean);
begin
  CommandFinish:=True;
  ArpDOSCommand := TDosCommand.Create(Application);
  ArpDOSCommand.InputToOutput := False;
  ArpDOSCommand.OnNewLine := CommandNewLine;
  ArpDOSCommand.OnTerminated := CommandTerminated;
  inherited Create(bRun);//False线程建立立即执行
end;

procedure FixARP.Execute;
var
  myip:ulong;
  mymac:array[0..5] of byte;
  mymaclength:ulong;
  r:integer;
  s:string;
begin
  myip:=inet_addr(PChar('10.215.223.9'));
  mymaclength:=length(mymac);
  while not Terminated do begin
    r:=sendarp(myip,0,@mymac,@mymaclength);
    if (r = 0) and CommandFinish then begin
      s:=format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',[mymac[0],mymac[1],mymac[2],mymac[3],mymac[4],mymac[5]]);
      if s <> '00-01-7A-00-F7-6D' then LogAlarmToText('发现ARP欺骗攻击!源Mac:'+s);
      ArpDOSCommand.CommandLine := 'arp -s 10.215.223.9 00-01-7a-00-f7-6d';
      CommandFinish := False;
      try
        ArpDOSCommand.Execute;
      except
        //
      end;
    end;
    Sleep(5000);
  end;
//  label2.caption:='errorcode:'+inttostr(r);
//  label3.caption:=format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',[mymac[0],mymac[1],mymac[2],mymac[3],mymac[4],mymac[5]]);
end;

procedure FixARP.CommandNewLine(Sender:TObject;NewLine:String;OutputType:TOutputType);
begin
  LogAlarmToText(NewLine);
end;

procedure FixARP.CommandTerminated(Sender: TObject);
begin
  CommandFinish := True;
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  ServiceFixArp.Controller(CtrlCode);
end;

function TServiceFixArp.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TServiceFixArp.ServiceStart(Sender: TService;
  var Started: Boolean);
begin
  FixArpThread:=FixARP.Create(False);
  if FixArpThread <> nil then LogAlarmToText('Server Started.');
end;

procedure TServiceFixArp.ServiceStop(Sender: TService;
  var Stopped: Boolean);
begin
  FixArpThread.Terminate;
  LogAlarmToText('Server Stoped.');
end;

procedure LogAlarmToText(sContent: string);
var
  f: TextFile;
  sFileName: string;
//  Year, Month, Day, Hour, Min, Sec, MSec: Word;
  Year, Month, Day: Word;
begin
  if sContent = '' then Exit;
  DecodeDate(Now,Year,Month,Day);
  //DecodeTime(Now,Hour,Min,Sec,MSec);
  sFileName := IntToStr(Month);
  if Length(sFileName) = 1 then sFileName := '0' + sFileName;
//  sFileName := IntToStr(Year) + sFileName;
  sFileName := 'OA_AutoBackup_' + IntToStr(Year) + sFileName + '.log';
  if FileExists(sFileName) then
    begin
      AssignFile(f, sFileName);
      Append(f);
    end
  else begin
      AssignFile(f, sFileName);
      Rewrite(f);
  end;
  Writeln(f, DateTimeToStr(Now) + ' ' + sContent);
  Flush(f);
  CloseFile(f);
end;

procedure TServiceFixArp.ServiceCreate(Sender: TObject);
begin
  //设置路径
  ChDir(ExtractFilePath(Paramstr(0)));

end;

end.