Solved

Web Site Filtering

Posted on 2006-07-15
11
862 Views
Last Modified: 2011-09-12
Hi
i want delphi source code for filterin web site.please HELP me!!!
0
Comment
Question by:mahdiparak
11 Comments
 
LVL 4

Expert Comment

by:LMuadDIb
ID: 17115077
what exactly do you mean?

you want to parse an html file?
there alot of html parsers, some free http://www.torry.net/quicksearchd.php?String=parse+html&Title=Yes
you can also use the TWebbrowser component

what exactly do you need to filter?
Filter the whole page or just a part of the page?
If the whole page use a html parser component.
If you need only a small part of the page you can do something like this:

FScanFirst: string;
FScanFrom: string;
FScanTo: string;
FPosition: integer;    // find the 1st, 2nd, 3rd , 4th, whatever FScanFirst (so many times)
FData: string;          // result

usage:

FPosition := 1;
FScanFirst:= '<table';
FScanFrom:= '<tr';
FScanTo:= '</table>';

CollectData('c:\webpage.html');

//--example would grab the first table from the web page file

procedure TForm1.CollectData(FFileName: TFilename);
var
  j: integer;
  s,ir,hr: string;
  ch: Char;
  f: TMemorystream;
begin

  f := TMemoryStream.Create;
  try
      f.Clear;
      f.LoadFromfile(FFileName);
      f.Position := 0;
      s := '';
      FData := '';

      for j := 1 to f.size do
      begin
        f.Read(ch,1);
        s := s + ch;
      end;
      ir := s;
      hr := s;
      if Pos(FScanFirst,s) > 0 then
      begin
        Delete(s,1,pos(FScanFirst,s) + Length(FScanFirst) - 1);
        if Pos(FScanFrom,s) > 0 then
        begin
          Delete(s,1,Pos(FScanFrom,s) + Length(FScanFrom) - 1);
          if Pos(FScanTo,s) > 0 then
            FData := Copy(s,1,Pos(FScanTo,s) - 1);
        end;
      end else
            Showmessage('ScanFirst not found: "'+ FScanFirst+'"');
    end;
  finally
    f.free;
  end;
end;

btw, it does not have to be a html tag, can be any text in the web page for this to work
but there are alot of ways of doing it.....
0
 
LVL 1

Author Comment

by:mahdiparak
ID: 17128231
hi lmuaddib
Thnaks for your help but i want a source code for Blocking some ip from server.
0
 

Expert Comment

by:xrfang
ID: 17129987
Hi,

It depends on how you want to do it. For example,

you can do it on the driver level (which I don't know how :))

or you can do it on API level (winsock)

or you can do it in the browser level

there are simply so many ways to do it, and each of the methods are useful in some case but NOT in all cases! You will need to describe your question in more detail (e.g., what is your purpose, and enviroment) before some one can give you advice...
0
 
LVL 1

Author Comment

by:mahdiparak
ID: 17132861
hi
i to write a filtering application for a sever.
for example in a netword with some workstation. if a client want to to access to a web site ( for example www.google.com ) if this site is in filtring list client can't access to this site.
and so sorry becuse my english is very very vey bad :)
0
 
LVL 26

Accepted Solution

by:
Russell Libby earned 500 total points
ID: 17139667
Ah, IP packet filtering. Here is code that I wrote a while back that does just that. I am also including a small demo app that shows how it works.

Regards,
Russell

---

Example first

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IPFilter, StdCtrls;

type
  TForm1            =  class(TForm)
     Button1:       TButton;
     Button2:       TButton;
     Memo1:         TMemo;
     procedure      FormCreate(Sender: TObject);
     procedure      Button1Click(Sender: TObject);
     procedure      Button2Click(Sender: TObject);
  private
     // Private declarations
     FFilter:       TIPFilter;
  public
     // Public declarations
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin

  FFilter:=TIPFilter.Create;
  FFilter.Active:=True;

end;

procedure TForm1.Button1Click(Sender: TObject);
var  dwIndex:       Integer;
begin

  FFilter.ClearInboundFilters;
  FFilter.ClearOutboundFilters;
  for dwIndex:=0 to Pred(Memo1.Lines.Count) do
  begin
     // Filters are created by passing the addres to block, in either DNS name
     // eg "www.google.com" or dot notation "200.10.20.1", the protocol can be set
     // to protoAny, protoIcmp, protoTcp, protoUdp and should be self explanatory. And the
     // final param is the port to filter on. The example here demonstrates blocking a bunch of
     // web sites, both inbound and outbound directions.
     FFilter.AddInboundFilter(Memo1.Lines[dwIndex], protoAny, 80);
     FFilter.AddOutboundFilter(Memo1.Lines[dwIndex], protoAny, 80);
  end;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin

  FFilter.ClearInboundFilters;
  FFilter.ClearOutboundFilters;

end;

end.

-- dfm ---
object Form1: TForm1
  Left = 346
  Top = 176
  Width = 426
  Height = 238
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 12
    Top = 12
    Width = 75
    Height = 25
    Caption = 'Block'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Memo1: TMemo
    Left = 96
    Top = 12
    Width = 185
    Height = 133
    Lines.Strings = (
      'www.google.com'
      'www.yahoo.com'
      'www.msn.com')
    TabOrder = 1
  end
  object Button2: TButton
    Left = 12
    Top = 40
    Width = 75
    Height = 25
    Caption = 'Unblock'
    TabOrder = 2
    OnClick = Button2Click
  end
end

-- and the IPFilter unit --

unit IPFilter;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit           :  IPFILTER
//   Author         :  rllibby
//   Date           :  05.25.2004
//   Description    :  TCPIP network connection blocking unit
//
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows,
  SysUtils,
  Classes,
  WinSock;

////////////////////////////////////////////////////////////////////////////////
//   IP helper library
////////////////////////////////////////////////////////////////////////////////
const
  IPHLPAPI                      =  'IPHLPAPI.DLL';

////////////////////////////////////////////////////////////////////////////////
//   Data types
////////////////////////////////////////////////////////////////////////////////
type
  PByteArray                    =  ^TByteArray;
  TByteArray                    =  Array [0..Pred(MaxInt)] of Byte;
  PIpAddr                       =  ^TIpAddr;
  TIpAddr                       =  packed record
     case Integer of
        0  :  (s_b1:   Byte;
               s_b2:   Byte;
               s_b3:   Byte;
               s_b4:   Byte);
        1  :  (s_w1:   Word;
               s_w2:   Word);
        2  :  (s_addr: LongWord);
     end;

////////////////////////////////////////////////////////////////////////////////
//   FltDefs translation
////////////////////////////////////////////////////////////////////////////////
type
  FILTER_HANDLE                 =  Pointer;
  PFILTER_HANDLE                =  ^FILTER_HANDLE;
  INTERFACE_HANDLE              =  Pointer;
  PINTERFACE_HANDLE             =  ^INTERFACE_HANDLE;

const
  GF_FRAGMENTS                  =  2;
  GF_STRONGHOST                 =  8;
  GF_FRAGCACHE                  =  9;

type
  GLOBAL_FILTER                 =  Integer;
  PGLOBAL_FILTER                =  ^GLOBAL_FILTER;

const
  PF_IPV4                       =  0;
  PF_IPV6                       =  1;

type
  PFADDRESSTYPE                 =  Integer;
  PPFADDRESSTYPE                =  ^PFADDRESSTYPE;

const
  PF_ACTION_FORWARD             =  0;
  PF_ACTION_DROP                =  1;

type
  PFFORWARD_ACTION              =  Integer;
  PPFFORWARD_ACTION             =  ^PPFFORWARD_ACTION;

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:                   PIpAddr;
     SrcMask:                   PIpAddr;
     DstAddr:                   PIpAddr;
     DstMask:                   PIpAddr;
     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);

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';

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';

function   PfGetInterfaceStatistics(
           pInterface:          INTERFACE_HANDLE;
           ppfStats:            PPF_INTERFACE_STATS;
           pdwBufferSize:       PDWORD;
           fResetCounters:      BOOL): DWORD;
           stdcall; external IPHLPAPI name '_PfGetInterfaceStatistics@16';

function   PfTestPacket(
           pInInterface:        INTERFACE_HANDLE;
           pOutInterface:       INTERFACE_HANDLE;
           cBytes:              DWORD;
           pbPacket:            PByteArray;
           ppAction:            PPFFORWARD_ACTION): DWORD;
           stdcall; external IPHLPAPI name '_PfTestPacket@20';

////////////////////////////////////////////////////////////////////////////////
//   IP filter class wrapper
////////////////////////////////////////////////////////////////////////////////
const
  IP_LOCALHOST      =  'localhost';
  IP_MASKALL        =  '0.0.0.0';
  IP_MASKNONE       =  '255.255.255.255';

type
  TIpProtocol       =  (protoAny, protoIcmp, protoTcp, protoUdp);
  TIpFilter         =  class(TObject)
  private
     // Private declarations
     FHandle:       INTERFACE_HANDLE;
     FLocalHandle:  INTERFACE_HANDLE;
     FLocalIP:      TIpAddr;
     FActive:       Boolean;
     FOutbound:     TList;
     FInbound:      TList;
     function       AllocIpBytes(Address: String): PIpAddr;
     function       AllocFilter(Protocol: TIpProtocol): PPF_FILTER_DESCRIPTOR;
     procedure      FreeFilter(Filter: PPF_FILTER_DESCRIPTOR);
  protected
     // Protected declarations
     function       GetInboundFilter(Index: Integer): PF_FILTER_DESCRIPTOR;
     function       GetInboundFilterCount: Integer;
     function       GetOutboundFilter(Index: Integer): PF_FILTER_DESCRIPTOR;
     function       GetOutboundFilterCount: Integer;
     function       Startup: Boolean;
     procedure      SetActive(Value: Boolean);
     procedure      Cleanup;
  public
     // Public declarations
     constructor    Create;
     destructor     Destroy; override;
     function       AddInboundFilter(Address: String; Protocol: TIpProtocol; Port: Word): Integer;
     function       AddOutboundFilter(Address: String; Protocol: TIpProtocol; Port: Word): Integer;
     procedure      ClearInboundFilters;
     procedure      ClearOutboundFilters;
     procedure      DeleteInboundFilter(Index: Integer);
     procedure      DeleteOutboundFilter(Index: Integer);
     property       Active: Boolean read FActive write SetActive;
     property       InterfaceHandle: INTERFACE_HANDLE read FHandle;
     property       InboundFilterCount: Integer read GetInboundFilterCount;
     property       InboundFilters[Index: Integer]: PF_FILTER_DESCRIPTOR read GetInboundFilter;
     property       OutboundFilterCount: Integer read GetOutboundFilterCount;
     property       OutboundFilters[Index: Integer]: PF_FILTER_DESCRIPTOR read GetOutboundFilter;
  end;

////////////////////////////////////////////////////////////////////////////////
//   Utility functions
////////////////////////////////////////////////////////////////////////////////
function   StrToIp(lpszIP: PChar; lpipAddr: PIpAddr): PIpAddr;
function   GetLocalIPAddr(lpipAddr: PIpAddr): Boolean;

implementation

////////////////////////////////////////////////////////////////////////////////
//   Protected variables
////////////////////////////////////////////////////////////////////////////////
var
  wsaData:       TWSAData;

////////////////////////////////////////////////////////////////////////////////
//   TIpFilter
////////////////////////////////////////////////////////////////////////////////
procedure TIpFilter.ClearInboundFilters;
var  dwIndex:       Integer;
begin

  // Walk all filters and remove them
  for dwIndex:=Pred(FInbound.Count) downto 0 do DeleteInboundFilter(dwIndex);

end;

procedure TIpFilter.ClearOutboundFilters;
var  dwIndex:       Integer;
begin

  // Walk all filters and remove them
  for dwIndex:=Pred(FOutbound.Count) downto 0 do DeleteOutboundFilter(dwIndex);

end;

procedure TIpFilter.DeleteInboundFilter(Index: Integer);
var  lpFilter:      PPF_FILTER_DESCRIPTOR;
begin

  // Get the filter from the list
  lpFilter:=FInbound[Index];

  // Resource protection
  try
     // Remove filter from the list
     FInbound.Delete(Index);
     // Remove the filter
     Win32Check(PfRemoveFiltersFromInterface(FHandle, 1, lpFilter, 0, nil) = NO_ERROR);
  finally
     // Free the filter
     FreeFilter(lpFilter);
  end;

end;

procedure TIpFilter.DeleteOutboundFilter(Index: Integer);
var  lpFilter:      PPF_FILTER_DESCRIPTOR;
begin

  // Get the filter from the list
  lpFilter:=FOutbound[Index];

  // Resource protection
  try
     // Remove filter from the list
     FOutbound.Delete(Index);
     // Remove the filter
     Win32Check(PfRemoveFiltersFromInterface(FHandle, 0, nil, 1, lpFilter) = NO_ERROR);
  finally
     // Free the filter
     FreeFilter(lpFilter);
  end;

end;

function TIpFilter.GetInboundFilter(Index: Integer): PF_FILTER_DESCRIPTOR;
begin

  // Get the filter descriptor
  result:=PF_FILTER_DESCRIPTOR(FInbound[Index]^);

end;

function TIpFilter.GetOutboundFilter(Index: Integer): PF_FILTER_DESCRIPTOR;
begin

  // Get the filter descriptor
  result:=PF_FILTER_DESCRIPTOR(FOutbound[Index]^);

end;

function TIpFilter.GetInboundFilterCount: Integer;
begin

  // Return filter count
  result:=FInbound.Count;

end;

function TIpFilter.GetOutboundFilterCount: Integer;
begin

  // Return filter count
  result:=FOutbound.Count;

end;

function TIpFilter.AddInboundFilter(Address: String; Protocol: TIpProtocol; Port: Word): Integer;
var  lpFilter:      PPF_FILTER_DESCRIPTOR;
begin

  // Allocate memory for filter
  lpFilter:=AllocFilter(Protocol);

  // Resource protection
  try
     // Check protocol
     if (Protocol = protoIcmp) then
     begin
        // Icmp handling
        lpFilter^.wDstPort:=FILTER_ICMP_CODE_ANY;
        lpFilter^.wDstPortHighRange:=FILTER_ICMP_CODE_ANY;
     end
     else
     begin
        // Tcp/Udp handling
        lpFilter^.wDstPort:=FILTER_TCPUDP_PORT_ANY;
        lpFilter^.wDstPortHighRange:=FILTER_TCPUDP_PORT_ANY;
     end;
     // Note: UDP number needs to be decremented by one (ie 5000 blocks 5001)
     if (Protocol = protoUdp) and (Port > 0) then Dec(Port);
     lpFilter^.wSrcPort:=Port;
     lpFilter^.wSrcPortHighRange:=Port;
     // Check remote address
     if (Length(Address) = 0)then
     begin
        // Filter from all remote addresses
        lpFilter^.SrcAddr:=AllocIpBytes(IP_MASKALL);
        lpFIlter^.SrcMask:=AllocIpBytes(IP_MASKALL);
     end
     else
     begin
        // Filter from specific remote address
        lpFilter^.SrcAddr:=AllocIpBytes(Address);
        lpFilter^.SrcMask:=AllocIpBytes(IP_MASKNONE);
     end;
     // Set destination address
     lpFilter^.DstAddr:=AllocIpBytes(IP_LOCALHOST);
     lpFilter^.DstMask:=AllocIpBytes(IP_MASKNONE);
     // Add filter to interface
     Win32Check(PfAddFiltersToInterface(FHandle, 1, lpFilter, 0, nil, nil) = NO_ERROR);
     Win32Check(PfAddFiltersToInterface(FLocalHandle, 1, lpFilter, 0, nil, nil) = NO_ERROR);
  finally
     // Add filter to list
     result:=FInbound.Add(lpFilter);
  end;

end;

function TIpFilter.AddOutboundFilter(Address: String; Protocol: TIpProtocol; Port: Word): Integer;
var  lpFilter:      PPF_FILTER_DESCRIPTOR;
begin

  // Allocate memory for filter
  lpFilter:=AllocFilter(Protocol);

  // Resource protection
  try
     // Note: UDP number needs to be decremented by one (ie 5000 blocks 5001)
     if (Protocol = protoUdp) and (Port > 0) then Dec(Port);
     // Filter all remote ports coming into specified port
     lpFilter^.wDstPort:=Port;
     lpFilter^.wDstPortHighRange:=Port;
     // Check protocol
     if (Protocol = protoIcmp) then
     begin
        // Icmp handling
        lpFilter^.wSrcPort:=FILTER_ICMP_CODE_ANY;
        lpFilter^.wSrcPortHighRange:=FILTER_ICMP_CODE_ANY;
     end
     else
     begin
        // Tcp/Udp handling
        lpFilter^.wSrcPort:=FILTER_TCPUDP_PORT_ANY;
        lpFilter^.wSrcPortHighRange:=FILTER_TCPUDP_PORT_ANY;
     end;
     // Set source address
     lpFilter^.SrcAddr:=AllocIpBytes(IP_LOCALHOST);
     lpFilter^.SrcMask:=AllocIpBytes(IP_MASKNONE);
     // Check remote address
     if (Length(Address) = 0)then
     begin
        // Filter from all remote addresses
        lpFilter^.DstAddr:=AllocIpBytes(IP_MASKALL);
        lpFIlter^.DstMask:=AllocIpBytes(IP_MASKALL);
     end
     else
     begin
        // Filter from specific remote address
        lpFilter^.DstAddr:=AllocIpBytes(Address);
        lpFilter^.DstMask:=AllocIpBytes(IP_MASKNONE);
     end;
     // Add filter to interface
     Win32Check(PfAddFiltersToInterface(FHandle, 0, nil, 1, lpFilter, nil) = NO_ERROR);
  finally
     // Add filter to list
     result:=FOutbound.Add(lpFilter);
  end;

end;

function TIpFilter.AllocIpBytes(Address: String): PIpAddr;
begin

  // Allocate memory for IP byte setting and convert address
  result:=StrToIp(PChar(Address), AllocMem(SizeOf(TIpAddr)));

end;

function TIpFilter.AllocFilter(Protocol: TIpProtocol): PPF_FILTER_DESCRIPTOR;
begin

  // Allocate memory for filter
  result:=AllocMem(SizeOf(PF_FILTER_DESCRIPTOR));

  // Set defaults for all filters
  result^.dwFilterFlags:=FD_FLAGS_NOSYN;
  result^.dwRule:=0;
  result^.pfatType:=PF_IPV4;
  result^.fLateBound:=0;

  // Set protocol filtering
  case Protocol of
     protoAny    :  result^.dwProtocol:=FILTER_PROTO_ANY;
     protoIcmp   :  result^.dwProtocol:=FILTER_PROTO_ICMP;
     protoTcp    :  result^.dwProtocol:=FILTER_PROTO_TCP;
     protoUdp    :  result^.dwProtocol:=FILTER_PROTO_UDP;
  else
     // Sanity check
     result^.dwProtocol:=FILTER_PROTO_ANY;
  end;

end;

procedure TIpFilter.FreeFilter(Filter: PPF_FILTER_DESCRIPTOR);
begin

  // Check filter
  if Assigned(Filter) then
  begin
     // Free memory for addresses and masks
     if Assigned(Filter^.SrcAddr) then FreeMem(Filter.SrcAddr);
     if Assigned(Filter^.SrcMask) then FreeMem(Filter.SrcMask);
     if Assigned(Filter^.DstAddr) then FreeMem(Filter.DstAddr);
     if Assigned(Filter^.DstMask) then FreeMem(Filter.DstMask);
     // Free memory for record struct
     FreeMem(Filter);
  end;

end;

procedure TIpFilter.SetActive(Value: Boolean);
var  lpIpAddr:      TIpAddr;
begin

  // Check for state change
  if (Value <> FActive) then
  begin
     // Check old state
     if FActive then
        // Unbind the interface
        Win32Check(PfUnBindInterface(FHandle) = NO_ERROR)
     else
     begin
        // Get local host address
        StrToIp('127.0.0.1', @lpIpAddr);
        Win32Check(PfBindInterfaceToIPAddress(FHandle, PF_IPV4, @FLocalIP) = NO_ERROR);
        Win32Check(PfBindInterfaceToIPAddress(FLocalHandle, PF_IPV4, @lpIpAddr) = NO_ERROR);
     end;
     // Set new state
     FActive:=Value;
  end;

end;

function TIpFilter.Startup: Boolean;
begin

  // Get the local IP address
  GetLocalIPAddr(@FLocalIP);

  // Create the interface (do not bind yet)
  result:=(PfCreateInterface(0, PF_ACTION_FORWARD, PF_ACTION_FORWARD, False, True, FHandle) = NO_ERROR) and
          (PfCreateInterface(0, PF_ACTION_FORWARD, PF_ACTION_FORWARD, False, True, FLocalHandle) = NO_ERROR);

end;

procedure TIpFilter.Cleanup;
var  dwIndex:       Integer;
begin

  // Resource protection
  try
     // Clear all filters from outbound list (do not worry about removing them)
     for dwIndex:=Pred(FOutbound.Count) downto 0 do FreeFilter(FOutbound[dwIndex]);
     // Clear all filters from inbound list (do not worry about removing them)
     for dwIndex:=Pred(FInbound.Count) downto 0 do FreeFilter(FInbound[dwIndex]);
  finally
     // Clear the lists
     FOutbound.Clear;
     FInbound.Clear;
     // Unbind the interface handle (if active)
     if FActive then PfUnBindInterface(FHandle);
     // Delete the interface handle
     PfDeleteInterface(FHandle);
  end;

end;

constructor TIpFilter.Create;
begin

  // Perform inherited
  inherited Create;

  // Create internal lists
  FActive:=False;
  FOutbound:=TList.Create;
  FInbound:=TList.Create;

  // Startup
  Win32Check(Startup);

end;

destructor TIpFilter.Destroy;
begin

  // Resource protection
  try
     // Cleanup lists and delete the interface
     Cleanup;
     // Free the lists
     FreeAndNil(FOutbound);
     FreeAndNil(FInbound);
  finally
     // Perform inherited
     inherited Destroy;
  end;

end;

function StrToIp(lpszIP: PChar; lpipAddr: PIpAddr): PIpAddr;
var  dwAddr:     LongWord;
     pheAddr:    PHostEnt;
begin

  // Check for common settings
  if Assigned(lpszIP) and (StrIComp(lpszIP, IP_LOCALHOST) = 0) then
     // Get the local ip address
     GetLocalIPAddr(lpipAddr)
  else
  begin
     // Check assignment
     if Assigned(lpszIp) then
     begin
        // Check mask all
        if (StrIComp(lpszIP, IP_MASKALL) = 0) then
           dwAddr:=0
        // Check mask none
        else if (StrIComp(lpszIP, IP_MASKNONE) = 0) then
           dwAddr:=INADDR_NONE
        else
        begin
           // Attempt . notation conversion
           dwAddr:=inet_addr(lpszIP);
           // Check conversion (IP_MASKNONE will have already been handled)
           if (dwAddr = LongWord(INADDR_NONE)) then
           begin
              // Attempt host name conversion
              pheAddr:=gethostbyname(lpszIP);
              // Check conversion
              if Assigned(pheAddr) then
                 // Get the ip address
                 Move(pheAddr^.h_addr_list^^, dwAddr, SizeOf(LongWord))
              else
                 // Failed to get the ip address, use none
                 dwAddr:=INADDR_NONE;
           end;
        end
     end
     else
        // Convert IP_MASKALL
        dwAddr:=inet_addr(IP_MASKALL);
     // Move the longword into the byte array
     Move(dwAddr, lpipAddr^, SizeOf(LongWord));
  end;

  // Result is the pointer to passed ip address buffer
  result:=lpipAddr;

end;

function GetLocalIPAddr(lpipAddr: PIpAddr): 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
        // Failure
        result:=False;
  end
  else
     // Failure
     result:=False;

end;

initialization

  // Initialize winsock so we can get the local ip address
  WSAStartup(MakeWord(1, 1), wsaData);

finalization

  // Cleanup
  WSACleanup;

end.

0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 1

Author Comment

by:mahdiparak
ID: 17144810
hi rllibby
thanks for your help. but i have a problem.
when i want to compile this code in delphi 7 complier show this message

 [Error] IPFilter.pas(713): Constant expression violates subrange bounds
 [Error] IPFilter.pas(728): Constant expression violates subrange bounds

why?
0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 17145451
Probably becuase of this  (compiled on delphi 5):

          dwAddr:=inet_addr(lpszIP);

change those 2 lines to:

          dwAddr:=LongWord(inet_addr(lpszIP));

and you should be good

Russell

0
 
LVL 1

Author Comment

by:mahdiparak
ID: 17145823
very very thanks. this is very Excellent
0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 17145946

Your very welcome.
By the way, I would have assisted sooner, but until you explained what you were trying to do, the problem was unclear

Russell
0
 

Expert Comment

by:last_danger
ID: 34546680
This code does not work in Windows 7
0
 

Expert Comment

by:prasiddutta
ID: 36525375
Hi rllibby

it's not working in Win 7

Compile error



Have any solution?
 
[DCC Error] IPFilter.pas(77): E2086 Type 'PPFFORWARD_ACTION' is not yet completely defined
[DCC Warning] IPFilter.pas(387): W1002 Symbol 'Win32Check' is specific to a platform
[DCC Warning] IPFilter.pas(407): W1002 Symbol 'Win32Check' is specific to a platform
[DCC Warning] IPFilter.pas(490): W1002 Symbol 'Win32Check' is specific to a platform
[DCC Warning] IPFilter.pas(491): W1002 Symbol 'Win32Check' is specific to a platform
[DCC Warning] IPFilter.pas(543): W1002 Symbol 'Win32Check' is specific to a platform
[DCC Warning] IPFilter.pas(611): W1002 Symbol 'Win32Check' is specific to a platform
[DCC Warning] IPFilter.pas(616): W1002 Symbol 'Win32Check' is specific to a platform
[DCC Warning] IPFilter.pas(617): W1002 Symbol 'Win32Check' is specific to a platform
[DCC Warning] IPFilter.pas(671): W1002 Symbol 'Win32Check' is specific to a platform
[DCC Error] IPFilter.pas(715): E2010 Incompatible types: 'PAnsiChar' and 'PWideChar'
[DCC Error] IPFilter.pas(720): E2010 Incompatible types: 'PAnsiChar' and 'PWideChar'
[DCC Error] IPFilter.pas(749): E2010 Incompatible types: 'PAnsiChar' and 'array[0..255] of Char'
[DCC Error] IPFilter.pas(752): E2010 Incompatible types: 'PAnsiChar' and 'array[0..255] of Char'
[DCC Fatal Error] Project5.dpr(5): F2063 Could not compile used unit 'IPFilter.pas'

Open in new window

0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now