[dr.5y51em]

Почитал книгу Михаила Флёнова "Delphi в шутку и в серьез что умеют хакеры". Там был пример фаерволла, основанного на Paket Filtering (система фильтрация пакетов от мелкомягких), который доступен начиная с Windows 2000. Так вот, я взял его пример, откомпилил, добавил в фильтр IP начал пинговать, он один фиг пингуеться... Я в печали

Вот исходник его юнита:

Код:

unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, fltdefs, winsock, StdCtrls;

type
  PIpBytes       =  ^TIpBytes;
  TIpBytes       =  Array [0..3] of Byte;

type
  TFirewallForm = class(TForm)
    btStartFilter: TButton;
    btStopFilter: TButton;
    procedure btStartFilterClick(Sender: TObject);
    procedure btStopFilterClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    hIF : INTERFACE_HANDLE;
    ipLocal : TIpBytes;
    function StrToIp(lpszIP: PChar; lpipAddr: PIpBytes): PIpBytes;
    function GetLocalIPAddr(lpipAddr: PIpBytes): Boolean;
    procedure AddFilter(inP: Boolean; lpszRemote: PChar; protoType: DWORD; lpszPort: PChar);
  end;

var
  FirewallForm: TFirewallForm;

implementation

{$R *.dfm}

function TFirewallForm.StrToIp(lpszIP: PChar; lpipAddr: PIpBytes): PIpBytes;
var
 lpszStr : Array [0..63] of Char;
 dwPos : Integer;
 lpPos : PChar;
begin
 StrLCopy(@lpszStr, lpszIP, SizeOf(lpszStr));
 lpszStr[Pred(SizeOf(lpszStr))]:=#0;

 ZeroMemory(lpipAddr, SizeOf(TIpBytes));

 dwPos:=Pred(SizeOf(TIpBytes));
 lpPos:=StrRScan(lpszStr, '.');
 while Assigned(lpPos) do
  begin
   lpPos^:=#0;
   Inc(lpPos);
   lpipAddr^[dwPos]:=StrToIntDef(lpPos, 0);
   Dec(dwPos);

   if (dwPos = 0) then
    break;

   lpPos:=StrRScan(lpszStr, '.');
  end;
 lpipAddr^[dwPos]:=StrToIntDef(lpszStr, 0);

 result:=lpipAddr;
end;

function TFirewallForm.GetLocalIPAddr(lpipAddr: PIpBytes): Boolean;
var
 lpszLocal:  Array [0..255] of Char;
 pheAddr:    PHostEnt;
begin
 if (gethostname(lpszLocal, SizeOf(lpszLocal)) = 0) then
  begin
   pheAddr:=gethostbyname(lpszLocal);
   if Assigned(pheAddr) then
    begin
     Move(pheAddr^.h_addr_list^^, lpipAddr^, 4);
     result:=True;
    end
   else
    result:=False;
  end
 else
  result:=False;
end;

procedure TFirewallForm.AddFilter(inP: Boolean;
  lpszRemote: PChar; protoType: DWORD; lpszPort: PChar);
var
 ipFlt : PF_FILTER_DESCRIPTOR;
 dwPort : Integer;
 ipDest : TIpBytes;
 ipSrcMask : TIpBytes;
 ipDstMask :TIpBytes;
begin
 ZeroMemory(@ipFlt, SizeOf(ipFlt));

 ipFlt.dwFilterFlags:=FD_FLAGS_NOSYN;
 ipFlt.dwRule:=0;
 ipFlt.pfatType:=PF_IPV4;
 ipFlt.fLateBound:=0;

 ipFlt.dwProtocol:=protoType;

 if Assigned(lpszPort) then
  dwPort:=StrToIntDef(lpszPort, FILTER_TCPUDP_PORT_ANY)
 else
  dwPort:=FILTER_TCPUDP_PORT_ANY;

 if inP then
  begin
   ipFlt.wDstPort:=FILTER_TCPUDP_PORT_ANY;
   ipFlt.wDstPortHighRange:=FILTER_TCPUDP_PORT_ANY;
   ipFlt.wSrcPort:=dwPort;
   ipFlt.wSrcPortHighRange:=dwPort;
  end
 else
  begin
   ipFlt.wDstPort:=dwPort;
   ipFlt.wDstPortHighRange:=dwPort;
   ipFlt.wSrcPort:=FILTER_TCPUDP_PORT_ANY;
   ipFlt.wSrcPortHighRange:=FILTER_TCPUDP_PORT_ANY;
  end;

 StrToIP('255.255.255.0', @ipSrcMask);
 StrToIP('255.255.255.0', @ipDstMask);

 if inP then
  begin
   if Assigned(lpszRemote) then
    begin
     ipFlt.SrcAddr:=PByteArray(StrToIp(lpszRemote, @ipDest));
     ipFlt.SrcMask:=@ipSrcMask;
    end
   else
    begin
     ipFlt.SrcAddr:=PByteArray(StrToIp('0.0.0.0', @ipDest));
     StrToIP('0.0.0.0', @ipSrcMask);
     ipFlt.SrcMask:=@ipSrcMask;
    end;
   ipFlt.DstAddr:=@ipLocal;
   ipFlt.DstMask:=@ipDstMask;
   PfAddFiltersToInterface(hIF, 1, @ipFlt, 0, nil, nil);
  end
 else
  begin
   ipFlt.SrcAddr:=@ipLocal;
   ipFlt.SrcMask:=@ipSrcMask;
   if Assigned(lpszRemote) then
    begin
     ipFlt.DstAddr:=PByteArray(StrToIp(lpszRemote, @ipDest));
     ipFlt.DstMask:=@ipDstMask;
    end
   else
    begin
     ipFlt.DstAddr:=PByteArray(StrToIp('0.0.0.0', @ipDest));
     StrToIP('0.0.0.0', @ipDstMask);
     ipFlt.DstMask:=@ipDstMask;
    end;
   PfAddFiltersToInterface(hIF, 0, nil, 1, @ipFlt, nil);
 end;
end;


procedure TFirewallForm.btStartFilterClick(Sender: TObject);
var
 wsaData:       TWSAData;
begin
 if (WSAStartup(MakeWord(1, 1), wsaData) <> 0) then
  begin
   ShowMessage('Îøèáêà Winsock');
   exit;
  end;

 if not GetLocalIPAddr(@ipLocal) then
  exit;

 //Ñîçäàíèå èíòåðôåéñà
 PfCreateInterface(0, PF_ACTION_FORWARD, PF_ACTION_FORWARD, False, True, hIF);

 // Äîáàâëåíèå íåñêîëüêèõ ôèëüòðîâ
 AddFilter(true, '192.168.1.1', FILTER_PROTO_TCP, nil);
 AddFilter(true, '192.168.8.57', FILTER_PROTO_TCP, '21');
 AddFilter(false, '192.168.1.3', FILTER_PROTO_ANY, '7');
 AddFilter(true, '192.168.1.4', FILTER_PROTO_UDP, '1024');

 // Áëîêèðîâêà ëþáûõ èñõîäÿùèõ îáðàùåíèé ê 80-ìó ïîðòó
 AddFilter(false, nil, FILTER_PROTO_TCP, '21');

 // Ïðèâÿçàòü èíòåðôåéñ ê ëîêàëüíîìó àäðåñó
 PfBindInterfaceToIPAddress(hIF, PF_IPV4, @ipLocal);

 btStopFilter.Enabled:=true;
end;

procedure TFirewallForm.btStopFilterClick(Sender: TObject);
begin
 PfUnBindInterface(hIF);
 PfDeleteInterface(hIF);

 WSACleanup;
 btStopFilter.Enabled:=false;
end;

end.