isafer_fwrule.~pas

一款防火墙源码

unit iSafer_FWRule;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Mask, StdCtrls, ComCtrls,commctrl, Buttons, ImgList,ShellAPI;

type
  TForm_FWRule = class(TForm)
    FWRule: TPageControl;
    IpRulePage: TTabSheet;
    Panel_Top: TPanel;
    GroupBox_IP: TGroupBox;
    Label_sIP: TLabel;
    Label_eIP: TLabel;
    Label_To1: TLabel;
    Radio_IP_Single: TRadioButton;
    Radio_IP_Range: TRadioButton;
    MaskEdit_sIP: TMaskEdit;
    MaskEdit_eIP: TMaskEdit;
    Radio_IP_All: TRadioButton;
    Radio_Access_Allow: TRadioButton;
    Radio_Access_Deny: TRadioButton;
    GroupBox_Port: TGroupBox;
    Label_sPort: TLabel;
    Label_ePort: TLabel;
    Label_To2: TLabel;
    Radio_Port_Single: TRadioButton;
    Radio_Port_Range: TRadioButton;
    MaskEdit_sPort: TMaskEdit;
    MaskEdit_ePort: TMaskEdit;
    GroupBox_PortType: TGroupBox;
    Radio_TCP: TRadioButton;
    Radio_UDP: TRadioButton;
    Radio_Port_All: TRadioButton;
    PathRulePage: TTabSheet;
    PathEdit: TEdit;
    GroupBox1: TGroupBox;
    Permission: TRadioGroup;
    OpenDialog1: TOpenDialog;
    IPAddressFrom: TBevel;
    IPAddressTo: TBevel;
    BmBtnEditOK: TBitBtn;
    BmBtnEditCancel: TBitBtn;
    BmBtnPath: TBitBtn;
    RuleEditorImageList: TImageList;
    Panel1: TPanel;
    procedure InputStatusCheck(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Radio_IP_SingleClick(Sender: TObject);
    procedure Radio_IP_RangeClick(Sender: TObject);
    procedure Radio_IP_AllClick(Sender: TObject);
    procedure Radio_Port_SingleClick(Sender: TObject);
    procedure Radio_Port_RangeClick(Sender: TObject);
    procedure Radio_Port_AllClick(Sender: TObject);
    procedure BmBtnEditOKClick(Sender: TObject);
    procedure BmBtnEditCancelClick(Sender: TObject);
    procedure BmBtnPathClick(Sender: TObject); private
    { Private declarations }


    FIPAddress: Longint;
    HIPAddressFrom: HWND;
    HIPAddressTo: HWND;
    PrevWndProc: TWndMethod;
    procedure  ChooseEditPathRule();
    procedure  NewWindowProc(var Message: TMessage);

    function   GetIPAddress(handle:HWND):string;
  public
    { Public declarations }
    procedure  SetIPFrom(sIp:string);
    function GetICON(path:string):TIcon;
  end;
//Appley changes to running fire service
  procedure ApplyFWStatus(StatusMode: byte);

var
  Form_FWRule: TForm_FWRule;
  const
  IP_ADDRESS_ID_FROM: Longword = $1100;
  IP_ADDRESS_ID_TO: Longword = $1101;

implementation

uses iSafer_Main, iSafer_Option,
     PSMFWRule;//Add on Web, Feb 11st, 2004

{$R *.dfm}

{Get Icon of application given by app path}
function TForm_FWRule.GetICON(path:string):TIcon;
{var
  wp: Array[1..MAX_PATH] of Char;
  i: Integer;
}
var
TheIcon:TIcon;
begin
  TheIcon:=TIcon.create;
  TheIcon.Handle := ExtractIcon(hInstance,Pchar(path),0);
  if TheIcon.Handle=0 then
  begin
    {ShowMessage('Call');
    for i:=1 to StrLen(Pchar(path)) do wp[i]:=path[i];
    TheIcon.Handle := ExtractIconW(hInstance,PWchar(@wp),0);
    }
    RuleEditorImageList.GetIcon(2,TheIcon);
  end;

  result :=TheIcon;
end;


procedure ApplyFWStatus(StatusMode: byte);//=1: New rules, =2: Stop FW, =0: FW is running and no new rules.
type
  ShareData=record
    dwTotalBytes: DWORD;
    intProcessCount: Integer;
    boNewRule: Array[0..512] of byte;
  end;
var
  //llInit: Boolean;
  HMapping: THandle;
  PMapData: ^ShareData;
begin
  try
  HMapping := CreateFileMapping(THandle($FFFFFFFF), nil, PAGE_READWRITE, 0, SizeOf(ShareData), pchar('PSMFWShareM'));
  // Check if already exists
  //llInit := (GetLastError() <> ERROR_ALREADY_EXISTS);
  if (hMapping = 0) then begin
    SysUtils.Beep;
    MessageBox(0,'Can not apply new rules. '#13#10'Please restart Firewall to apply new rules!','Firewall',MB_OK);
    exit;
  end;
  PMapData := MapViewOfFile(HMapping, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if PMapData = nil then begin
    CloseHandle(HMapping);
    SysUtils.Beep;
    MessageBox(0,'New rules can not be applied. '#13#10'Please restart Firewall to apply new rules!','Firewall',MB_OK);
    exit;
  end;

  //if (not llInit) then begin
    FillChar(PMapData^.boNewRule,SizeOf(PMapData^.boNewRule),StatusMode);
    UnMapViewOfFile(PMapData);
    CloseHandle(HMapping);
  //end;

  except
    SysUtils.Beep;
    MessageBox(0,'Error at ApplyNewRules()','Firewall',MB_OK);
  end;
end;



// 涝仿芒 劝己拳 惑怕 汲沥
{
Updated on 20th Feb to handle IP control.
[e-mail]
}
procedure TForm_FWRule.InputStatusCheck(Sender: TObject);
begin
     // IP林家 涝仿芒 劝己拳 惑怕 汲沥
     if Radio_IP_Single.Checked then begin
          MaskEdit_sIP.Enabled:= True;
          MaskEdit_eIP.Enabled:= False;
          EnableWindow(HIPAddressFrom,TRUE);
          EnableWindow(HIPAddressTo,FALSE);

     end;
     if Radio_IP_Range.Checked then begin
          //MaskEdit_sIP.Enabled:= True;
          //MaskEdit_eIP.Enabled:= True;
          EnableWindow(HIPAddressFrom,TRUE);
          EnableWindow(HIPAddressTo,TRUE);
     end;
     if Radio_IP_All.Checked then begin
          MaskEdit_sIP.Enabled:= False;
          MaskEdit_eIP.Enabled:= False;
          EnableWindow(HIPAddressFrom,FALSE);
          EnableWindow(HIPAddressTo,FALSE);
     end;

     // 器飘锅龋 涝仿芒 劝己拳 惑怕 汲沥
     if Radio_Port_Single.Checked then begin
          MaskEdit_sPort.Enabled:= True;
          MaskEdit_ePort.Enabled:= False;
     end;
     if Radio_Port_Range.Checked then begin
          MaskEdit_sPort.Enabled:= True;
          MaskEdit_ePort.Enabled:= True;
     end;
     if Radio_Port_All.Checked then begin
          MaskEdit_sPort.Enabled:= False;
          MaskEdit_ePort.Enabled:= False;
     end;
end;
{
Init IP Address from IP control
Updated on 19th Feb, 2004
LuuTruongHuy<[e-mail]>
}
procedure TForm_FWRule.FormCreate(Sender: TObject);
var 
  lpInitCtrls: TInitCommonControlsEx;
  wfont: WPARAM;
begin
  lpInitCtrls.dwSize := SizeOf(TInitCommonControlsEx);
  lpInitCtrls.dwICC  := ICC_INTERNET_CLASSES;
  if InitCommonControlsEx(lpInitCtrls) then
  begin
    PrevWndProc := WindowProc;
    WindowProc  := NewWindowProc;
      //Create FROM_IP
      HIPAddressFrom := CreateWindowEx(WS_EX_LEFT, WC_IPADDRESS, nil,
      WS_CHILD + WS_VISIBLE + WS_BORDER + WS_TABSTOP,
      IPAddressFrom.Left, IPAddressFrom.Top, IPAddressFrom.Width, IPAddressFrom.Height,
      GroupBox_IP.Handle, IP_ADDRESS_ID_FROM, HInstance, nil);
      //Creat TO_IP
      HIPAddressTo := CreateWindowEx(WS_EX_LEFT, WC_IPADDRESS, nil,
      WS_CHILD + WS_VISIBLE + WS_BORDER + WS_TABSTOP,
      IPAddressTo.Left, IPAddressTo.Top, IPAddressTo.Width, IPAddressTo.Height,
      GroupBox_IP.Handle, IP_ADDRESS_ID_TO, HInstance, nil);
    //SendMessage(MaskEdit_sPort.Handle,WM_GETFONT)

    SendMessage(HIPAddressFrom, WM_SETFONT, MaskEdit_sPort.Font.Handle, 1);
    SendMessage(HIPAddressTo, WM_SETFONT, MaskEdit_sPort.Font.Handle, 1);
  end;

   PathEdit.MaxLength:=MAX_PATH;   //Set max length of path edit control.
end;

procedure TForm_FWRule.NewWindowProc(var Message: TMessage);
var 
  nField: longint; 
begin
  case Message.Msg of 
    WM_NOTIFY:  
      begin 
        if PNMHDR(Ptr(Message.lParam)).idFrom = IP_ADDRESS_ID_FROM then
        begin
          case PNMIPAddress(ptr(Message.lParam)).hdr.code of
            IPN_FIELDCHANGED:
              begin
                if SendMessage(HIPAddressFrom, IPM_ISBLANK, 0, 0) = 0 then
                  SendMessage(HIPAddressFrom, IPM_GETADDRESS, 0, lParam(LPDWORD(@FIPAddress)));
              end;
          end;
        end;

        if PNMHDR(Ptr(Message.lParam)).idFrom = IP_ADDRESS_ID_TO then
        begin
          case PNMIPAddress(ptr(Message.lParam)).hdr.code of
            IPN_FIELDCHANGED:
              begin
                if SendMessage(HIPAddressTo, IPM_ISBLANK, 0, 0) = 0 then
                  SendMessage(HIPAddressTo, IPM_GETADDRESS, 0, lParam(LPDWORD(@FIPAddress)));
              end;
          end;
        end;

      end;
    WM_COMMAND:
      begin
        if Message.WParamLo = IP_ADDRESS_ID_FROM then
          case Message.WParamHi of
            EN_SETFOCUS:
              begin
                nField := SendMessage(HIPAddressFrom, IPM_GETADDRESS, 0,
                  lParam(LPDWORD(@FIPAddress)));
                if nField = 4 then nField := 0;
                SendMessage(HIPAddressFrom, IPM_SETFOCUS, wParam(nField), 0);
              end;
            EN_KILLFOCUS:
              begin
                if SendMessage(HIPAddressFrom, IPM_ISBLANK, 0, 0) = 0 then
                  SendMessage(HIPAddressFrom, IPM_GETADDRESS, 0, lParam(LPDWORD(@FIPAddress)));
              end;
            EN_CHANGE:
              begin
              end;
          end;

          if Message.WParamLo = IP_ADDRESS_ID_TO then
          case Message.WParamHi of
            EN_SETFOCUS:
              begin
                nField := SendMessage(HIPAddressTo, IPM_GETADDRESS, 0,
                  lParam(LPDWORD(@FIPAddress)));
                if nField = 4 then nField := 0;
                SendMessage(HIPAddressTo, IPM_SETFOCUS, wParam(nField), 0);
              end;
            EN_KILLFOCUS:
              begin
                if SendMessage(HIPAddressFrom, IPM_ISBLANK, 0, 0) = 0 then
                  SendMessage(HIPAddressFrom, IPM_GETADDRESS, 0, lParam(LPDWORD(@FIPAddress)));
              end;
            EN_CHANGE:
              begin
              end;
          end;
      end;

  end;