Помогите создать firewall на Delphi. Использовал идею из книги Фленова "Delphi в шутку и всерьез" с использованием интерфейсов и фильтров, но оно делает что-то не то. Если при создании интерфейса использовать вместо параметра PF_ACTION_FORWARD параметр PF_ACTION_DROP, то блокируется вообще все, даже сетевые диски. А нужно заблокировать только 80 порт, т.е. доступ в Интернет и порт с номером 3128. Такое ощущение, что фильтры, которые добавляются к интерфейсу после его создания вообще игнорируются.
Код:
Код:
Code:
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(false, '192.168.0.100', FILTER_PROTO_ANY, '80');
Добавление нескольких фильтров
AddFilter(true, '192.168.0.100', FILTER_PROTO_TCP, nil);
AddFilter(true, '192.168.0.100', FILTER_PROTO_TCP, '21');
AddFilter(false, '192.168.0.100', FILTER_PROTO_ANY, '7');
AddFilter(true, '192.168.0.100', FILTER_PROTO_UDP, '1024');
// Блокировка любых исходящих обращений к 80-му порту
AddFilter(false, nil, FILTER_PROTO_TCP, '80');
// Привязать интерфейс к локальному адресу
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.