unit DropAllU;
{
Aufruf:
InstallFW('192.168.0.2');
und zum schluss:
RemoveFW;
}
interface
procedure InstallFW(MyIP:
String);
procedure RemoveFW;
implementation
uses Windows;
const
IPHLPAPI = '
IPHLPAPI.DLL';
type
PFFORWARD_ACTION = Integer;
PPFFORWARD_ACTION = ^PPFFORWARD_ACTION;
//
INTERFACE_HANDLE = Pointer;
//
PFADDRESSTYPE = Integer;
PPFADDRESSTYPE = ^PFADDRESSTYPE;
//
TByteArray =
Array [0..Pred(MaxInt)]
of Byte;
PByteArray = ^TByteArray;
TIpBytes =
Array [0..3]
of Byte;
const
PF_ACTION_DROP = 1;
const
PF_IPV4 = 0;
function PfCreateInterface(
dwName: DWORD;
inAction: PFFORWARD_ACTION;
outAction: PFFORWARD_ACTION;
bUseLog: BOOL;
bMustBeUnique: BOOL;
var ppInterface: INTERFACE_HANDLE): DWORD;
stdcall;
external IPHLPAPI
name '
_PfCreateInterface@24';
function PfDeleteInterface(
pInterface: INTERFACE_HANDLE): DWORD;
stdcall;
external IPHLPAPI
name '
_PfDeleteInterface@4';
function PfBindInterfaceToIPAddress(
pInterface: INTERFACE_HANDLE;
pfatLinkType: PFADDRESSTYPE;
IPAddress: PByteArray): DWORD;
stdcall;
external IPHLPAPI
name '
_PfBindInterfaceToIPAddress@12';
function PfUnBindInterface(
pInterface: INTERFACE_HANDLE): DWORD;
stdcall;
external IPHLPAPI
name '
_PfUnBindInterface@4';
var
Handle_Interface : INTERFACE_HANDLE =
nil;
function StrToInt(S: PChar): Integer;
begin
Result := 0;
if S = '
'
then Exit;
while S^
in ['
0'..'
9']
do begin
Result := Result * 10 + Integer(S^) - Integer('
0');
Inc( S );
end;
end;
function StrToIpBytes( IpStr:
String ): TIpBytes;
var N : Integer;
begin
N := 0;
while Pos('
.', IpStr)>0
do begin
Result[N] := StrToInt(@Copy(IpStr, 1, Pos('
.', IpStr) - 1)[1]);
Delete(IpStr, 1, Pos('
.', IpStr));
Inc(N);
end;
Result[N] := StrToInt(@IpStr[1]);
end;
procedure InstallFW(MyIP:
String);
var
IpLocal : TIpBytes;
begin
if (MyIP <> '
')
and Not Assigned(Handle_Interface)
then begin
FillChar(IpLocal, 4, #0);
IpLocal := StrToIpBytes(MyIP);
PfCreateInterface(0, PF_ACTION_DROP, PF_ACTION_DROP, False, False, Handle_Interface);
PfBindInterfaceToIPAddress(Handle_Interface, PF_IPV4, @ipLocal);
end;
end;
procedure RemoveFW;
begin
if Assigned(Handle_Interface)
then begin
PfUnBindInterface(Handle_Interface);
PfDeleteInterface(Handle_Interface);
Handle_Interface :=
nil;
end;
end;
end.