Помогите создать firewall на Delphi. Использовал идею из книги Фленова "Delphi в шутку и всерьез" с использованием интерфейсов и фильтров, но оно делает что-то не то. Если при создании интерфейса использовать вместо параметра PF_ACTION_FORWARD параметр PF_ACTION_DROP, то блокируется вообще все, даже сетевые диски. А нужно заблокировать только 80 порт, т.е. доступ в Интернет и порт с номером 3128. Такое ощущение, что фильтры, которые добавляются к интерфейсу после его создания вообще игнорируются.
Код:
Код:
Код:
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.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'); 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.
