The code perfectly runs on winXP, but not in windows7

veroca · Mar 16, 2010

//This is a lite firewall code
//Doesn't run on windows7, but good on winXP
//We Need to run this program in windows7
//Thank you

unit fltdefs;
////////////////////////////////////////////////////////////////////////////////
//
// Delphi conversion of fltdefs.h for use with the IPHLPAPI.DLL
//
////////////////////////////////////////////////////////////////////////////////
interface

uses
Windows;

const
IPHLPAPI = 'IPHLPAPI.DLL';

// Byte array
type
TByteArray = Array [0..Pred(MaxInt)] of Byte;
PByteArray = ^TByteArray;

// Data types
type
FILTER_HANDLE = Pointer;
PFILTER_HANDLE = ^FILTER_HANDLE;
INTERFACE_HANDLE = Pointer;
PINTERFACE_HANDLE = ^INTERFACE_HANDLE;

// GlobalFilter enumeration
const
GF_FRAGMENTS = 2;
GF_STRONGHOST = 8;
GF_FRAGCACHE = 9;

type
GLOBAL_FILTER = Integer;
PGLOBAL_FILTER = ^GLOBAL_FILTER;

// PFAddressType enumeration
const
PF_IPV4 = 0;
PF_IPV6 = 1;

type
PFADDRESSTYPE = Integer;
PPFADDRESSTYPE = ^PFADDRESSTYPE;

// PFForwardAction enumeration
const
PF_ACTION_FORWARD = 0;
PF_ACTION_DROP = 1;

type
PFFORWARD_ACTION = Integer;
PPFFORWARD_ACTION = ^PFFORWARD_ACTION;

// PFFrameType enumeration
const
PFFT_FILTER = 1;
PFFT_FRAG = 2;
PFFT_SPOOF = 3;

type
PFFRAMETYPE = Integer;
PPFFRAMETYPE = ^PFFRAMETYPE;

type
_PF_FILTER_DESCRIPTOR = packed record
dwFilterFlags: DWORD;
dwRule: DWORD;
pfatType: PFADDRESSTYPE;
SrcAddr: PByteArray;
SrcMask: PByteArray;
DstAddr: PByteArray;
DstMask: PByteArray;
dwProtocol: DWORD;
fLateBound: DWORD;
wSrcPort: Word;
wDstPort: Word;
wSrcPortHighRange: Word;
wDstPortHighRange: Word;
end;
PF_FILTER_DESCRIPTOR = _PF_FILTER_DESCRIPTOR;
PPF_FILTER_DESCRIPTOR = ^PF_FILTER_DESCRIPTOR;

type
_PF_FILTER_STATS = packed record
dwNumPacketsFiltered

WORD;
info: PF_FILTER_DESCRIPTOR;
end;
PF_FILTER_STATS = _PF_FILTER_STATS;
PPF_FILTER_STATS = ^PF_FILTER_STATS;

type
_PF_INTERFACE_STATS = packed record
pvDriverContext: Pointer;
dwFlags: DWORD;
dwInDrops: DWORD;
dwOutDrops: DWORD;
eaInAction: PFFORWARD_ACTION;
eaOutAction: PFFORWARD_ACTION;
dwNumInFilters: DWORD;
dwNumOutFilters: DWORD;
dwFrag: DWORD;
dwSpoof: DWORD;
dwReserved1: DWORD;
dwReserved2: DWORD;
liSyn: LARGE_INTEGER;
liTotalLogged: LARGE_INTEGER;
dwLostLogEntries: DWORD;
FilterInfo: Array [0..0] of PF_FILTER_STATS;
end;
PF_INTERFACE_STATS = _PF_INTERFACE_STATS;
PPF_INTERFACE_STATS = ^PF_INTERFACE_STATS;

type
_PF_LATEBIND_INFO = packed record
SrcAddr: PByteArray;
DstAddr: PByteArray;
Mask: PByteArray;
end;
PF_LATEBIND_INFO = _PF_LATEBIND_INFO;
PPF_LATEBIND_INFO = ^PF_LATEBIND_INFO;

type
_PFLOGFRAME = packed record
Timestamp: LARGE_INTEGER;
pfeTypeOfFrame: PFFRAMETYPE;
dwTotalSizeUsed: DWORD;
dwFilterRule: DWORD;
wSizeOfAdditionalData:Word;
wSizeOfIpHeader: Word;
dwInterfaceName: DWORD;
dwIPIndex: DWORD;
bPacketData: Array [0..0] of Byte;
end;
PFLOGFRAME = _PFLOGFRAME;
PPFLOGFRAME = ^PFLOGFRAME;

const
FILTER_PROTO_ANY = $00;
FILTER_PROTO_ICMP = $01;
FILTER_PROTO_TCP = $06;
FILTER_PROTO_UDP = $11;
FILTER_TCPUDP_PORT_ANY = $00;

const
FILTER_ICMP_TYPE_ANY = $FF;
FILTER_ICMP_CODE_ANY = $FF;

const
FD_FLAGS_NOSYN = $01;
FD_FLAGS_ALLFLAGS = FD_FLAGS_NOSYN;

const
LB_SRC_ADDR_USE_SRCADDR_FLAG = $00000001;
LB_SRC_ADDR_USE_DSTADDR_FLAG = $00000002;
LB_DST_ADDR_USE_SRCADDR_FLAG = $00000004;
LB_DST_ADDR_USE_DSTADDR_FLAG = $00000008;
LB_SRC_MASK_LATE_FLAG = $00000010;
LB_DST_MASK_LATE_FLAG = $00000020;

const
ERROR_BASE = 23000;
PFERROR_NO_PF_INTERFACE = (ERROR_BASE + 0); // never returned.
PFERROR_NO_FILTERS_GIVEN = (ERROR_BASE + 1);
PFERROR_BUFFER_TOO_SMALL = (ERROR_BASE + 2);
ERROR_IPV6_NOT_IMPLEMENTED = (ERROR_BASE + 3);

////////////////////////////////////////////////////////////////////////////////
//
// Filter functions exported by IPHLPAPI
//
////////////////////////////////////////////////////////////////////////////////
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 PfAddFiltersToInterface(
ih: INTERFACE_HANDLE;
cInFilters: DWORD;
pfiltIn: PPF_FILTER_DESCRIPTOR;
cOutFilters: DWORD;
pfiltOut: PPF_FILTER_DESCRIPTOR;
pfHandle: PFILTER_HANDLE): DWORD;
stdcall; external IPHLPAPI name '_PfAddFiltersToInterface@24';

function PfRemoveFiltersFromInterface(
ih: INTERFACE_HANDLE;
cInFilters: DWORD;
pfiltIn: PPF_FILTER_DESCRIPTOR;
cOutFilters: DWORD;
pfiltOut: PPF_FILTER_DESCRIPTOR): DWORD;
stdcall; external IPHLPAPI name '_PfRemoveFiltersFromInterface@20';

function PfRemoveFilterHandles(
pInterface: INTERFACE_HANDLE;
cFilters: DWORD;
pvHandles: PFILTER_HANDLE): DWORD;
stdcall; external IPHLPAPI name '_PfRemoveFilterHandles@12';

function PfUnBindInterface(
pInterface: INTERFACE_HANDLE): DWORD;
stdcall; external IPHLPAPI name '_PfUnBindInterface@4';

function PfBindInterfaceToIndex(
pInterface: INTERFACE_HANDLE;
dwIndex: DWORD;
pfatLinkType: PFADDRESSTYPE;
LinkIPAddress: PByteArray): DWORD;
stdcall; external IPHLPAPI name '_PfBindInterfaceToIndex@16';

function PfBindInterfaceToIPAddress(
pInterface: INTERFACE_HANDLE;
pfatLinkType: PFADDRESSTYPE;
IPAddress: PByteArray): DWORD;
stdcall; external IPHLPAPI name '_PfBindInterfaceToIPAddress@12';

function PfRebindFilters(
pInterface: INTERFACE_HANDLE;
pLateBindInfo: PPF_LATEBIND_INFO): DWORD;
stdcall; external IPHLPAPI name '_PfRebindFilters@8';

function PfAddGlobalFilterToInterface(
pInterface: INTERFACE_HANDLE;
gfFilter: GLOBAL_FILTER): DWORD;
stdcall; external IPHLPAPI name '_PfAddGlobalFilterToInterface@8';

function PfRemoveGlobalFilterFromInterface(
pInterface: INTERFACE_HANDLE;
gfFilter: GLOBAL_FILTER): DWORD;
stdcall; external IPHLPAPI name '_PfRemoveGlobalFilterFromInterface@8';

////////////////////////////////////////////////////////////////////////////////
//
// Log APIs. Note that there is at most one log and it must be created
// before any interface needing it is created. There is no way to set a
// log onto an existing interface. The log can be applied to any or all of
// the interfaces.
//
///////////////////////////////////////////////////////////////////////
function PfMakeLog(
hEvent: THandle): DWORD;
stdcall; external IPHLPAPI name '_PfMakeLog@4';

function PfSetLogBuffer(
pbBuffer: PByteArray;
dwSize: DWORD;
dwThreshold: DWORD;
dwEntries: DWORD;
pdwLoggedEntries: PDWORD;
pdwLostEntries: PDWORD;
pdwSizeUsed: PDWORD): DWORD;
stdcall; external IPHLPAPI name '_PfSetLogBuffer@28';

function PfDeleteLog(
): DWORD;
stdcall; external IPHLPAPI name '_PfDeleteLog@0';

////////////////////////////////////////////////////////////////////////////////
//
// Get statistics. Note pdwBufferSize in an IN/OUT parameter. If
// ERROR_INSUFFICIENT_BUFFER is returned, the common statistics are
// available and the correct byte count is in *pdwBufferSize. If only the
// interface statistics are needed, provide a buffer of size
// PF_INTERFACE_STATS only. If the filter descriptions are also needed,
// then supply a large buffer, or use the returned count from the first call
// to allocate a buffer of sufficient size. Note that for a shared interface,
// this second call may fail with ERROR_INSUFFICIENT_BUFFER. This can happen
// if the other sharers add filters in the interim. This should not happen for
// a UNIQUE interface.
//
////////////////////////////////////////////////////////////////////////////////
function PfGetInterfaceStatistics(
pInterface: INTERFACE_HANDLE;
ppfStats: PPF_INTERFACE_STATS;
pdwBufferSize: PDWORD;
fResetCounters: BOOL): DWORD;
stdcall; external IPHLPAPI name '_PfGetInterfaceStatistics@16';

////////////////////////////////////////////////////////////////////////////////
//
// Test a packet. This call will evaluate the packet against the given
// interfaces and return the filtering action.
//
////////////////////////////////////////////////////////////////////////////////
function PfTestPacket(
pInInterface: INTERFACE_HANDLE;
pOutInterface: INTERFACE_HANDLE;
cBytes: DWORD;
pbPacket: PByteArray;
ppAction: PPFFORWARD_ACTION): DWORD;
stdcall; external IPHLPAPI name '_PfTestPacket@20';

implementation

end.

--------------------------------------------------------------------

Console source code

program netblock;
{$APPTYPE CONSOLE}

uses
Windows,
SysUtils,
fltdefs,
winsock;

// IP address as an array of 4 bytes
type
PIpBytes = ^TIpBytes;
TIpBytes = Array [0..3] of Byte;

// Enumerations
type
TIpInOut = (ioIn, ioOut);
TIpProtocol = (protoTcp, protoUdp, protoicmp, protoAny);

// Globals
var
hIF: INTERFACE_HANDLE;
ipLocal: TIpBytes;

// Convert string to ip
function StrToIp(lpszIP: PChar; lpipAddr: PIpBytes): PIpBytes;
var lpszStr: Array [0..63] of Char;
dwPos: Integer;
lpPos: PChar;
begin

// Copy the IP string over
StrLCopy(@lpszStr, lpszIP, SizeOf(lpszStr));
lpszStr[Pred(SizeOf(lpszStr))]:=#0;

// Clear output buffer
ZeroMemory(lpipAddr, SizeOf(TIpBytes));

// Parse into bytes
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 is the pointer to buffer
result:=lpipAddr;

end;

// Get the local ip address
function GetLocalIPAddr(lpipAddr: PIpBytes): Boolean;
var lpszLocal: Array [0..255] of Char;
pheAddr: PHostEnt;
begin

// Get the host name
if (gethostname(lpszLocal, SizeOf(lpszLocal)) = 0) then
begin
// Get the host ent structure
pheAddr:=gethostbyname(lpszLocal);
if Assigned(pheAddr) then
begin
// Get the ip address
Move(pheAddr^.h_addr_list^^, lpipAddr^, 4);
result:=True;
end
else
result:=False;
end
else
result:=False;

end;

// Add a filter
procedure AddFilter(ioType: TIpInOut; lpszRemote: PChar; protoType: TIpProtocol; lpszPort: PChar);
var ipFlt: PF_FILTER_DESCRIPTOR;
dwPort: Integer;
ipDest: TIpBytes;
ipSrcMask: TIpBytes;
ipDstMask: TIpBytes;
dwRet: DWORD;
begin

// Clear the filter description buffer
ZeroMemory(@ipFlt, SizeOf(ipFlt));

// Set the static filtering flags
ipFlt.dwFilterFlags:=FD_FLAGS_NOSYN;
ipFlt.dwRule:=0;
ipFlt.pfatType:=PF_IPV4;
ipFlt.fLateBound:=0;

// Set protocol filtering
case protoType of
protoTcp : ipFlt.dwProtocol:=FILTER_PROTO_TCP;
protoUdp : ipFlt.dwProtocol:=FILTER_PROTO_UDP;
protoICMP: ipFlt.dwProtocol:=FILTER_PROTO_ICMP;
else
ipFlt.dwProtocol:=FILTER_PROTO_ANY;
end;

// If nil is passed for the port, set port type to any
if Assigned(lpszPort) then
dwPort:=StrToIntDef(lpszPort, FILTER_TCPUDP_PORT_ANY)
else
dwPort:=FILTER_TCPUDP_PORT_ANY;

// Set port ranges
case ioType of
// Filter all inbound connections to specified port
ioIn :
begin
ipFlt.wDstPort:=FILTER_TCPUDP_PORT_ANY;
ipFlt.wDstPortHighRange:=FILTER_TCPUDP_PORT_ANY;
ipFlt.wSrcPort:=dwPort;
ipFlt.wSrcPortHighRange:=dwPort;
end;
// Filter all outbound connections to specific port
ioOut :
begin
ipFlt.wDstPort:=dwPort;
ipFlt.wDstPortHighRange:=dwPort;
ipFlt.wSrcPort:=FILTER_TCPUDP_PORT_ANY;
ipFlt.wSrcPortHighRange:=FILTER_TCPUDP_PORT_ANY;
end;
end;

// Create default subnet masks
StrToIP('255.255.255.255', @ipSrcMask);
StrToIP('255.255.255.255', @ipDstMask);

// Check for input or output filter
if (ioType = ioIn) then
begin
// Input filter
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
// Output filter
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;

////////////////////////////////////////////////////////////////////////////////
// WinMain
////////////////////////////////////////////////////////////////////////////////
var
wsaData: TWSAData;
begin

// Initialize winsock so we can get the local ip address
if (WSAStartup(MakeWord(1, 1), wsaData) = 0) then
begin

// Get the local IP address
if GetLocalIPAddr(@ipLocal) then
begin

// Create the interface
PfCreateInterface(0, PF_ACTION_FORWARD, PF_ACTION_FORWARD, False, True, hIF);

// Add some filters - these are just examples
AddFilter(ioIn, 'THE_IP_TO_BLOCK', protoICMP, '8'); //ping
AddFilter(ioOut, 'THE_IP_TO_BLOCK', protoICMP, '8); //ping
// AddFilter(ioIn, nil, protoICMP, '8'); //ping
// AddFilter(ioOut, nil, protoICMP, '8'); //ping

AddFilter(ioIn, 'THE_IP_TO_BLOCK', protoTCP, '139'); //folder/file sharing
AddFilter(ioOut, 'THE_IP_TO_BLOCK', protoTCP, '445'); //folder/file sharing
// AddFilter(ioIn, nil, protoTCP, '139'); //folder/file sharing
// AddFilter(ioOut, nil, protoTCP, '445'); //folder/file sharing

// Bind the interface to the local IP address
PfBindInterfaceToIPAddress(hIF, PF_IPV4, @ipLocal);

// Wait until enter is pressed
WriteLn('Press [ENTER] to stop filtering');
ReadLn;

// Unbind and remove filter interface
PfUnBindInterface(hIF);
PfDeleteInterface(hIF);

end
else
// Display the winsock error
WriteLn(Format('WinSock error: %d', [WSAGetLastError]));

// Cleanup
WSACleanup;

end
else
// Display the winsock error
WriteLn(Format('WinSock error: %d', [WSAGetLastError]));

end.

whosrdaddy · Mar 16, 2010

Veroca,
please post code blocks between code tags. This makes it readable for all of us here. (this has been asked before)

like this:
[ignore]

Code:

//put your code block here
procedure JustForTest;
begin
end;

[/ignore]

this will give this output:

Code:

procedure JustForTest;
begin
end;

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

veroca · Mar 16, 2010

Code:

//OK, sorry
//Whats the problem in this with windows 7?
unit fltdefs;
////////////////////////////////////////////////////////////////////////////////
//
//   Delphi conversion of fltdefs.h for use with the IPHLPAPI.DLL
//
////////////////////////////////////////////////////////////////////////////////
interface

uses
  Windows;

const
  IPHLPAPI          =  'IPHLPAPI.DLL';

// Byte array
type
  TByteArray        =  Array [0..Pred(MaxInt)] of Byte;
  PByteArray        =  ^TByteArray;

// Data types
type
  FILTER_HANDLE     =  Pointer;
  PFILTER_HANDLE    =  ^FILTER_HANDLE;
  INTERFACE_HANDLE  =  Pointer;
  PINTERFACE_HANDLE =  ^INTERFACE_HANDLE;

// GlobalFilter enumeration
const
  GF_FRAGMENTS      =  2;
  GF_STRONGHOST     =  8;
  GF_FRAGCACHE      =  9;

type
  GLOBAL_FILTER     =  Integer;
  PGLOBAL_FILTER    =  ^GLOBAL_FILTER;

// PFAddressType enumeration
const
  PF_IPV4           =  0;
  PF_IPV6           =  1;

type
  PFADDRESSTYPE     =  Integer;
  PPFADDRESSTYPE    =  ^PFADDRESSTYPE;

// PFForwardAction enumeration
const
  PF_ACTION_FORWARD =  0;
  PF_ACTION_DROP    =  1;

type
  PFFORWARD_ACTION  =  Integer;
  PPFFORWARD_ACTION =  ^PFFORWARD_ACTION;

// PFFrameType enumeration
const
  PFFT_FILTER       =  1;
  PFFT_FRAG         =  2;
  PFFT_SPOOF        =  3;

type
  PFFRAMETYPE       =  Integer;
  PPFFRAMETYPE      =  ^PFFRAMETYPE;

type
  _PF_FILTER_DESCRIPTOR   =  packed record
     dwFilterFlags:       DWORD;
     dwRule:              DWORD;
     pfatType:            PFADDRESSTYPE;
     SrcAddr:             PByteArray;
     SrcMask:             PByteArray;
     DstAddr:             PByteArray;
     DstMask:             PByteArray;
     dwProtocol:          DWORD;
     fLateBound:          DWORD;
     wSrcPort:            Word;
     wDstPort:            Word;
     wSrcPortHighRange:   Word;
     wDstPortHighRange:   Word;
  end;
  PF_FILTER_DESCRIPTOR    =  _PF_FILTER_DESCRIPTOR;
  PPF_FILTER_DESCRIPTOR   =  ^PF_FILTER_DESCRIPTOR;

type
  _PF_FILTER_STATS        =  packed record
     dwNumPacketsFiltered:DWORD;
     info:                PF_FILTER_DESCRIPTOR;
  end;
  PF_FILTER_STATS         =  _PF_FILTER_STATS;
  PPF_FILTER_STATS        =  ^PF_FILTER_STATS;

type
  _PF_INTERFACE_STATS     =  packed record
     pvDriverContext:     Pointer;
     dwFlags:             DWORD;
     dwInDrops:           DWORD;
     dwOutDrops:          DWORD;
     eaInAction:          PFFORWARD_ACTION;
     eaOutAction:         PFFORWARD_ACTION;
     dwNumInFilters:      DWORD;
     dwNumOutFilters:     DWORD;
     dwFrag:              DWORD;
     dwSpoof:             DWORD;
     dwReserved1:         DWORD;
     dwReserved2:         DWORD;
     liSyn:               LARGE_INTEGER;
     liTotalLogged:       LARGE_INTEGER;
     dwLostLogEntries:    DWORD;
     FilterInfo:          Array [0..0] of PF_FILTER_STATS;
  end;
  PF_INTERFACE_STATS      =  _PF_INTERFACE_STATS;
  PPF_INTERFACE_STATS     =  ^PF_INTERFACE_STATS;

type
  _PF_LATEBIND_INFO       =  packed record
     SrcAddr:             PByteArray;
     DstAddr:             PByteArray;
     Mask:                PByteArray;
  end;
  PF_LATEBIND_INFO        =  _PF_LATEBIND_INFO;
  PPF_LATEBIND_INFO       =  ^PF_LATEBIND_INFO;

type
  _PFLOGFRAME             =  packed record
     Timestamp:           LARGE_INTEGER;
     pfeTypeOfFrame:      PFFRAMETYPE;
     dwTotalSizeUsed:     DWORD;
     dwFilterRule:        DWORD;
     wSizeOfAdditionalData:Word;
     wSizeOfIpHeader:     Word;
     dwInterfaceName:     DWORD;
     dwIPIndex:           DWORD;
     bPacketData:         Array [0..0] of Byte;
  end;
  PFLOGFRAME              =  _PFLOGFRAME;
  PPFLOGFRAME             =  ^PFLOGFRAME;

const
  FILTER_PROTO_ANY        =  $00;
  FILTER_PROTO_ICMP       =  $01;
  FILTER_PROTO_TCP        =  $06;
  FILTER_PROTO_UDP        =  $11;
  FILTER_TCPUDP_PORT_ANY  =  $00;

const
  FILTER_ICMP_TYPE_ANY    =  $FF;
  FILTER_ICMP_CODE_ANY    =  $FF;

const
  FD_FLAGS_NOSYN          =  $01;
  FD_FLAGS_ALLFLAGS       =  FD_FLAGS_NOSYN;

const
  LB_SRC_ADDR_USE_SRCADDR_FLAG  =  $00000001;
  LB_SRC_ADDR_USE_DSTADDR_FLAG  =  $00000002;
  LB_DST_ADDR_USE_SRCADDR_FLAG  =  $00000004;
  LB_DST_ADDR_USE_DSTADDR_FLAG  =  $00000008;
  LB_SRC_MASK_LATE_FLAG         =  $00000010;
  LB_DST_MASK_LATE_FLAG         =  $00000020;

const
  ERROR_BASE                    =  23000;
  PFERROR_NO_PF_INTERFACE       =  (ERROR_BASE + 0); // never returned.
  PFERROR_NO_FILTERS_GIVEN      =  (ERROR_BASE + 1);
  PFERROR_BUFFER_TOO_SMALL      =  (ERROR_BASE + 2);
  ERROR_IPV6_NOT_IMPLEMENTED    =  (ERROR_BASE + 3);

////////////////////////////////////////////////////////////////////////////////
//
// Filter functions exported by IPHLPAPI
//
////////////////////////////////////////////////////////////////////////////////
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   PfAddFiltersToInterface(
           ih:               INTERFACE_HANDLE;
           cInFilters:       DWORD;
           pfiltIn:          PPF_FILTER_DESCRIPTOR;
           cOutFilters:      DWORD;
           pfiltOut:         PPF_FILTER_DESCRIPTOR;
           pfHandle:         PFILTER_HANDLE): DWORD;
           stdcall; external IPHLPAPI name '_PfAddFiltersToInterface@24';

function   PfRemoveFiltersFromInterface(
           ih:               INTERFACE_HANDLE;
           cInFilters:       DWORD;
           pfiltIn:          PPF_FILTER_DESCRIPTOR;
           cOutFilters:      DWORD;
           pfiltOut:         PPF_FILTER_DESCRIPTOR): DWORD;
           stdcall; external IPHLPAPI name '_PfRemoveFiltersFromInterface@20';

function   PfRemoveFilterHandles(
           pInterface:       INTERFACE_HANDLE;
           cFilters:         DWORD;
           pvHandles:        PFILTER_HANDLE): DWORD;
           stdcall; external IPHLPAPI name '_PfRemoveFilterHandles@12';

function   PfUnBindInterface(
           pInterface:       INTERFACE_HANDLE): DWORD;
           stdcall; external IPHLPAPI name '_PfUnBindInterface@4';

function   PfBindInterfaceToIndex(
           pInterface:       INTERFACE_HANDLE;
           dwIndex:          DWORD;
           pfatLinkType:     PFADDRESSTYPE;
           LinkIPAddress:    PByteArray): DWORD;
           stdcall; external IPHLPAPI name '_PfBindInterfaceToIndex@16';

function   PfBindInterfaceToIPAddress(
           pInterface:       INTERFACE_HANDLE;
           pfatLinkType:     PFADDRESSTYPE;
           IPAddress:        PByteArray): DWORD;
           stdcall; external IPHLPAPI name '_PfBindInterfaceToIPAddress@12';

function   PfRebindFilters(
           pInterface:       INTERFACE_HANDLE;
           pLateBindInfo:    PPF_LATEBIND_INFO): DWORD;
           stdcall; external IPHLPAPI name '_PfRebindFilters@8';

function   PfAddGlobalFilterToInterface(
           pInterface:       INTERFACE_HANDLE;
           gfFilter:         GLOBAL_FILTER): DWORD;
           stdcall; external IPHLPAPI name '_PfAddGlobalFilterToInterface@8';

function   PfRemoveGlobalFilterFromInterface(
           pInterface:       INTERFACE_HANDLE;
           gfFilter:         GLOBAL_FILTER): DWORD;
           stdcall; external IPHLPAPI name '_PfRemoveGlobalFilterFromInterface@8';

////////////////////////////////////////////////////////////////////////////////
//
// Log APIs. Note that there is at most one log and it must be created
// before any interface needing it is created. There is no way to set a
// log onto an existing interface. The log can be applied to any or all of
// the interfaces.
//
///////////////////////////////////////////////////////////////////////
function   PfMakeLog(
           hEvent:           THandle): DWORD;
           stdcall; external IPHLPAPI name '_PfMakeLog@4';

function   PfSetLogBuffer(
           pbBuffer:         PByteArray;
           dwSize:           DWORD;
           dwThreshold:      DWORD;
           dwEntries:        DWORD;
           pdwLoggedEntries: PDWORD;
           pdwLostEntries:   PDWORD;
           pdwSizeUsed:      PDWORD): DWORD;
           stdcall; external IPHLPAPI name '_PfSetLogBuffer@28';

function   PfDeleteLog(
           ): DWORD;
           stdcall; external IPHLPAPI name '_PfDeleteLog@0';

////////////////////////////////////////////////////////////////////////////////
//
// Get statistics. Note pdwBufferSize in an IN/OUT parameter. If
// ERROR_INSUFFICIENT_BUFFER is returned, the common statistics are
// available and the correct byte count is in *pdwBufferSize. If only the
// interface statistics are needed, provide a buffer of size
// PF_INTERFACE_STATS only. If the filter descriptions are also needed,
// then supply a large buffer, or use the returned count from the first call
// to allocate a buffer of sufficient size. Note that for a shared interface,
// this second call may fail with ERROR_INSUFFICIENT_BUFFER. This can happen
// if the other sharers add filters in the interim. This should not happen for
// a UNIQUE interface.
//
////////////////////////////////////////////////////////////////////////////////
function   PfGetInterfaceStatistics(
           pInterface:       INTERFACE_HANDLE;
           ppfStats:         PPF_INTERFACE_STATS;
           pdwBufferSize:    PDWORD;
           fResetCounters:   BOOL): DWORD;
           stdcall; external IPHLPAPI name '_PfGetInterfaceStatistics@16';

////////////////////////////////////////////////////////////////////////////////
//
// Test a packet. This call will evaluate the packet against the given
// interfaces and return the filtering action.
//
////////////////////////////////////////////////////////////////////////////////
function   PfTestPacket(
           pInInterface:     INTERFACE_HANDLE;
           pOutInterface:    INTERFACE_HANDLE;
           cBytes:           DWORD;
           pbPacket:         PByteArray;
           ppAction:         PPFFORWARD_ACTION): DWORD;
           stdcall; external IPHLPAPI name '_PfTestPacket@20';

implementation

end.

--------------------------------------------------------------------

Console source code

program netblock;
{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils,
  fltdefs,
  winsock;

// IP address as an array of 4 bytes
type
  PIpBytes       =  ^TIpBytes;
  TIpBytes       =  Array [0..3] of Byte;

// Enumerations
type
  TIpInOut       =  (ioIn, ioOut);
  TIpProtocol    =  (protoTcp, protoUdp, protoicmp, protoAny);

// Globals
var
  hIF:           INTERFACE_HANDLE;
  ipLocal:       TIpBytes;

// Convert string to ip
function StrToIp(lpszIP: PChar; lpipAddr: PIpBytes): PIpBytes;
var  lpszStr:    Array [0..63] of Char;
     dwPos:      Integer;
     lpPos:      PChar;
begin

  // Copy the IP string over
  StrLCopy(@lpszStr, lpszIP, SizeOf(lpszStr));
  lpszStr[Pred(SizeOf(lpszStr))]:=#0;

  // Clear output buffer
  ZeroMemory(lpipAddr, SizeOf(TIpBytes));

  // Parse into bytes
  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 is the pointer to buffer
  result:=lpipAddr;

end;

// Get the local ip address
function GetLocalIPAddr(lpipAddr: PIpBytes): Boolean;
var  lpszLocal:  Array [0..255] of Char;
     pheAddr:    PHostEnt;
begin

  // Get the host name
  if (gethostname(lpszLocal, SizeOf(lpszLocal)) = 0) then
  begin
     // Get the host ent structure
     pheAddr:=gethostbyname(lpszLocal);
     if Assigned(pheAddr) then
     begin
        // Get the ip address
        Move(pheAddr^.h_addr_list^^, lpipAddr^, 4);
        result:=True;
     end
     else
        result:=False;
  end
  else
     result:=False;

end;

// Add a filter
procedure AddFilter(ioType: TIpInOut; lpszRemote: PChar; protoType: TIpProtocol; lpszPort: PChar);
var  ipFlt:      PF_FILTER_DESCRIPTOR;
     dwPort:     Integer;
     ipDest:     TIpBytes;
     ipSrcMask:  TIpBytes;
     ipDstMask:  TIpBytes;
     dwRet:      DWORD;
begin

  // Clear the filter description buffer
  ZeroMemory(@ipFlt, SizeOf(ipFlt));

  // Set the static filtering flags
  ipFlt.dwFilterFlags:=FD_FLAGS_NOSYN;
  ipFlt.dwRule:=0;
  ipFlt.pfatType:=PF_IPV4;
  ipFlt.fLateBound:=0;

  // Set protocol filtering
  case protoType of
     protoTcp :  ipFlt.dwProtocol:=FILTER_PROTO_TCP;
     protoUdp :  ipFlt.dwProtocol:=FILTER_PROTO_UDP;
     protoICMP:  ipFlt.dwProtocol:=FILTER_PROTO_ICMP;
  else
     ipFlt.dwProtocol:=FILTER_PROTO_ANY;
  end;

  // If nil is passed for the port, set port type to any
  if Assigned(lpszPort) then
     dwPort:=StrToIntDef(lpszPort, FILTER_TCPUDP_PORT_ANY)
  else
     dwPort:=FILTER_TCPUDP_PORT_ANY;

  // Set port ranges
  case ioType of
     // Filter all inbound connections to specified port
     ioIn  :
     begin
        ipFlt.wDstPort:=FILTER_TCPUDP_PORT_ANY;
        ipFlt.wDstPortHighRange:=FILTER_TCPUDP_PORT_ANY;
        ipFlt.wSrcPort:=dwPort;
        ipFlt.wSrcPortHighRange:=dwPort;
     end;
     // Filter all outbound connections to specific port
     ioOut :
     begin
        ipFlt.wDstPort:=dwPort;
        ipFlt.wDstPortHighRange:=dwPort;
        ipFlt.wSrcPort:=FILTER_TCPUDP_PORT_ANY;
        ipFlt.wSrcPortHighRange:=FILTER_TCPUDP_PORT_ANY;
     end;
  end;

  // Create default subnet masks
  StrToIP('255.255.255.255', @ipSrcMask);
  StrToIP('255.255.255.255', @ipDstMask);

  // Check for input or output filter
  if (ioType = ioIn) then
  begin
     // Input filter
     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
     // Output filter
     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;


////////////////////////////////////////////////////////////////////////////////
// WinMain
////////////////////////////////////////////////////////////////////////////////
var
  wsaData:       TWSAData;
begin

  // Initialize winsock so we can get the local ip address
  if (WSAStartup(MakeWord(1, 1), wsaData) = 0) then
  begin

     // Get the local IP address
     if GetLocalIPAddr(@ipLocal) then
     begin

        // Create the interface
        PfCreateInterface(0, PF_ACTION_FORWARD, PF_ACTION_FORWARD, False, True, hIF);

        // Add some filters - these are just examples
        AddFilter(ioIn, 'THE_IP_TO_BLOCK', protoICMP, '8'); //ping
        AddFilter(ioOut, 'THE_IP_TO_BLOCK', protoICMP, '8); //ping
     // AddFilter(ioIn, nil, protoICMP, '8'); //ping
     // AddFilter(ioOut, nil, protoICMP, '8'); //ping


        AddFilter(ioIn, 'THE_IP_TO_BLOCK', protoTCP, '139'); //folder/file sharing
        AddFilter(ioOut, 'THE_IP_TO_BLOCK', protoTCP, '445'); //folder/file sharing
     // AddFilter(ioIn, nil, protoTCP, '139'); //folder/file sharing
     // AddFilter(ioOut, nil, protoTCP, '445'); //folder/file sharing



        // Bind the interface to the local IP address
        PfBindInterfaceToIPAddress(hIF, PF_IPV4, @ipLocal);

        // Wait until enter is pressed
        WriteLn('Press [ENTER] to stop filtering');
        ReadLn;

        // Unbind and remove filter interface
        PfUnBindInterface(hIF);
        PfDeleteInterface(hIF);

     end
     else
        // Display the winsock error
        WriteLn(Format('WinSock error: %d', [WSAGetLastError]));

     // Cleanup
     WSACleanup;

  end
  else
     // Display the winsock error
     WriteLn(Format('WinSock error: %d', [WSAGetLastError]));

end.

veroca · Mar 17, 2010

Hi whosrDaddy

Do you know the problem of the code why it is not working on windows 7? But in windows XP is working good.

veroca · Mar 19, 2010

Hello is there anyone who can answer the problem?
The problem is why the code above is working on windows XP, but not on windows 7.

whosrdaddy · Mar 19, 2010

Well the reason could be that the windows socket interface has been largely rewritten going from XP to vista to W7.
So I'm not really surpised that this doesn't work any more.
Try to explain maybe what you're trying to achieve.

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

Glenn9999 · Mar 19, 2010

Yes, check this with the new published API and make sure it is still identical.

I'm waiting for the white paper entitled "Finding Employment in the Era of Occupational Irrelevancy

veroca · Mar 20, 2010

Hi whosrDaddy

I'm just trying to achieve a personal fireall that works on XP and Windows 7.

The problem is that code only works on XP, and I hope you have the idea how it will work.

I've already done checking the api, and as I noticed there are lot of additional functions, but still the functions used on that firewall code are same, but I hope someone has notice a difference.

Thank you

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

The code perfectly runs on winXP, but not in windows7

veroca

Programmer

whosrdaddy

Vendor

veroca

Programmer

veroca

Programmer

veroca

Programmer

whosrdaddy

Vendor

Glenn9999

Programmer

veroca

Programmer

Similar threads

Part and Inventory Search

Sponsor