isafer_option.~pas

一款防火墙源码

unit iSafer_Option;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, StdCtrls, ShellAPI, Registry, IniFiles,
  ScktComp, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  Sockets,StrUtils,IdTrivialFTPBase, Menus, Buttons, Winsock, ImgList;

type
  TForm_Option = class(TForm)
    PageControl1: TPageControl;
    TabSheet_FWRule: TTabSheet;
    TabSheet_Level: TTabSheet;
    TabSheet_FWLog: TTabSheet;
    TabSheet_Folder: TTabSheet;
    GroupBox_Folder: TGroupBox;
    ListView_Folder: TListView;
    GroupBox_FWRule: TGroupBox;
    ListView_FWRule: TListView;
    GroupBox_Level: TGroupBox;
    Label1: TLabel;
    Label_Level0: TLabel;
    Label_Level1: TLabel;
    Label_Level2: TLabel;
    TrackBar_Level: TTrackBar;
    TabSheet_Port: TTabSheet;
    GroupBox_Port: TGroupBox;
    ListView_Port: TListView;
    ListView_PortTemp: TListView;
    Path_List: TListView;
    LogPopupMenu: TPopupMenu;
    mnuAddIPRule: TMenuItem;
    N1: TMenuItem;
    Display1: TMenuItem;
    mnuAddPathRule: TMenuItem;
    N2: TMenuItem;
    mnuDirection: TMenuItem;
    mnuPermission: TMenuItem;
    mnuApplicationPath: TMenuItem;
    mnuBytesReceived: TMenuItem;
    mnuBytesSent: TMenuItem;
    mnuSocketNumber: TMenuItem;
    mnuClearLog: TMenuItem;
    mnuHostName: TMenuItem;
    ProgressBar: TProgressBar;
    BmBtnAddNew: TBitBtn;
    BmtBtnDelete: TBitBtn;
    BmBtnFolderView: TBitBtn;
    BmBtnReload: TBitBtn;
    BmBtnFolderStop: TBitBtn;
    BmBtnFolderInfo: TBitBtn;
    BmBtnPortDefault: TBitBtn;
    BmBtnPortBackDoor: TBitBtn;
    BmBtnPortAll: TBitBtn;
    FWImageList: TImageList;
    BmBtnCancelSecuiry: TBitBtn;
    BmBtnApplySecurity: TBitBtn;
    ImageListForAppPath: TImageList;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    GroupBox1: TGroupBox;
    Label5: TLabel;
    Label_Level3: TLabel;
    GroupBox2: TGroupBox;
    ListView_FWLog: TListView;

    procedure UpdateFolderInfo(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure TabSheet_FolderShow(Sender: TObject);
    // 焊救 荐霖 汲沥 - 包访 窃荐
    procedure TabSheet_LevelShow(Sender: TObject);
    procedure TrackBar_LevelChange(Sender: TObject);
    // 规拳寒 肺弊 - 包访 窃荐

    // 傍蜡 弃歹 包府 - 包访 窃荐
    procedure ListView_FolderSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);


    
    procedure Btn_FolderReloadClick(Sender: TObject);
    // 器飘 胶牡 - 包访 窃荐

    procedure ListView_FWRuleEnter(Sender: TObject);
    procedure Path_ListEnter(Sender: TObject);
    procedure ListView_FWRuleSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure mnuAddIPRuleClick(Sender: TObject);
    procedure mnuAddPathRuleClick(Sender: TObject);
    procedure mnuDirectionClick(Sender: TObject);
    procedure mnuApplicationPathClick(Sender: TObject);
    procedure mnuBytesReceivedClick(Sender: TObject);
    procedure mnuBytesSentClick(Sender: TObject);
    procedure mnuSocketNumberClick(Sender: TObject);
    procedure mnuPermissionClick(Sender: TObject);
    procedure ListView_FWLogEnter(Sender: TObject);
    procedure mnuClearLogClick(Sender: TObject);
    procedure mnuHostNameClick(Sender: TObject);
    procedure BmBtnAddNewClick(Sender: TObject);
    procedure BmtBtnDeleteClick(Sender: TObject);
    procedure BmBtnApplySecurityClick(Sender: TObject);
    procedure BmBtnCancelSecuiryClick(Sender: TObject);
    procedure BmBtnFolderViewClick(Sender: TObject);
    procedure BmBtnFolderInfoClick(Sender: TObject);
    procedure BmBtnFolderStopClick(Sender: TObject);
    procedure BmBtnReloadClick(Sender: TObject);
    procedure BmBtnPortDefaultClick(Sender: TObject);
    procedure BmBtnPortBackDoorClick(Sender: TObject);
    procedure BmBtnPortAllClick(Sender: TObject);
    procedure mnuRuleAddnewClick(Sender: TObject);
    procedure DeleteClick(Sender: TObject);
    procedure mnuRuleChangePermisionClick(Sender: TObject);
  

    { Private declarations }
  public
     FDriverLoaded: BOOL;
     bPortScanning: Boolean;
     ServerSocket:TServerSocket;

     //DDT
     procedure TrapMSG(var MSGX: TMessage);
     //DDT

 {
     Procedure FirewallCallback(name : pchar;
                                messageBuf : pointer; messageLen : dword;
                                answerBuf  : pointer    ; answerLen  : dword); stdcall;

  }
  end;

  //DDT
  LogInf=record
     mTime: string[30];
     mDirection:string[10];
     mPermit:String[10];
     mIP:string;
     mHostName:shortstring;
     mPort:String[10];
     mPath:shortstring;
     mToltalRec:String[30];
     mToltalSen:String[30];
     mTotalRecSen:String[30];
     mSockNo:String[20];
  end;
  //DDT

const
  MSGUDP  = 'UDP  / RemoteIP: %3d.%3d.%3d.%3d / LocalPort: %5d';
  MSGTCP  = 'TCP  / RemoteIP: %3d.%3d.%3d.%3d / LocalPort: %5d';
  MSGICMP = 'ICMP / RemoteIP: %3d.%3d.%3d.%3d / Type     : %5d / Code: %5d';

  //DDT
  LogBuffSize=1024;
  //DDT

var
  Form_Option: TForm_Option;
  OS: TOSVersionInfo;
  ChosenRuleType: Integer;
  isLogStarted: Boolean;

  //DDT
  Logs: array[1..LogBuffSize] of LogInf ;
  LogID: Integer;
  mainHWND: HWND;
  //DDT

  //update on march 17, imagelist for logging.
  logImages: TImageList;
  logPaths:TStringlist;

  const PATH_RULE_TYPE: Integer =1;
  const IP_RULE_TYPE: Integer=0;
  const REQUEST_TIMEOUT:Integer=1000;

  

implementation

uses iSafer_Main, iSafer_Resource, iSafer_FWRule,
  PSMFWRule, PSMFWLog,madCodeHook, FWDebug;//iShieldUnit_95, iShieldUnit_NT

{$R *.dfm}

function NameFromIP(ip:string;var hostname:shortstring): Boolean;
var
     WSAData: TWSAData;
     InetAddr: u_long;
     HostEntPtr: PHostEnt;
     retVal:Boolean;

     len: Integer;

begin
     WSAStartUp( $101, WSAData );
     try
          InetAddr := inet_addr(PChar(ip));
          if InetAddr = SOCKET_ERROR then
               raise Exception.Create( 'Invalid address entered' );

          HostEntPtr := GetHostByAddr( @InetAddr, len, AF_INET );
          if HostEntPtr = NIL then
               raise Exception.Create( 'WinSock error: ' + IntToStr( WSAGetLastError() ) );

          // Insert hostname into list
          hostname := String( HostEntPtr^.h_name );
          retVal:=True;
     except
          on E: Exception do begin
              retVal:=False;
          end;
     end;
     Result:=retVal;
end;

{Implement Log process call back function}//20040226
Procedure PSMFW_Callback(name : pchar;
                                messageBuf : pointer; messageLen : dword;
                                answerBuf  : pointer    ; answerLen  : dword); stdcall;

Var
     HMapMutex: THandle;
     LogItems:TPSMFWLog;
     //ListItem: TListItem;
     //strTmp:String;
     //NumberOflogLine: Integer;

     MyLogID:Integer;
begin
    //Check where there is space character
    //at the beginning of the line
    if(String(messageBuf)[1]=' ') then Exit;

    MyLogID:=-1;
    HMapMutex := CreateMutex(nil, false, pchar('PSMFirewallApplication'));
    if HMapMutex <> 0 then begin
      if WaitForSingleObject(HMapMutex,100) = WAIT_OBJECT_0 then  begin
        LogID:=(LogID mod LogBuffSize) + 1;
        MyLogID:=LogID;
      end;
      ReleaseMutex(HMapMutex);
      CloseHandle(HMapMutex);
    end;

    if MyLogID>=0 then
    with LogItems do begin
      LogItems:= TPSMFWLog.Create;
      LogItems.AssignLogItems(messageBuf);

      Logs[MyLogID].mTime:=mTime;
      Logs[MyLogID].mDirection:=mDirection;
      Logs[MyLogID].mPermit:=mPermit;
      Logs[MyLogID].mIP:=mIP;
      Logs[MyLogID].mHostName:=mHostName;
      Logs[MyLogID].mPort:=mPort;
      Logs[MyLogID].mPath:=mPath;
      Logs[MyLogID].mToltalRec:=mToltalRec;
      Logs[MyLogID].mToltalSen:=mToltalSen;
      Logs[MyLogID].mTotalRecSen:=mTotalRecSen;
      Logs[MyLogID].mSockNo:=mSockNo;
      Free;
      PostMessage(mainHWND,WM_USER,MyLogID,MyLogID);
    end;//with LogItems do begin
end;

//DDT20040226
procedure TForm_Option.TrapMSG(var MSGX: TMessage);
var
  ListItem: TListItem;
begin
  case MSGX.Msg of
    WM_USER://New log arrived
      begin
        if Form_Option.ListView_FWLog.Items.Count>500 then
        begin
          mnuClearLogClick(Nil);
        end;

        Form_Option.ListView_FWLog.Items.BeginUpdate;
        ListItem:=Form_Option.ListView_FWLog.Items.Add;
        ListItem.ImageIndex:=6;


        //display log information
        with Logs[MSGX.WParam] do
        begin
          //if(not NameFromIP(mIP,mHostName)) then mHostName:= mIP;
          if(logPaths.IndexOf(mPath)<0) then //This Path is not added
          begin
              ListItem.ImageIndex:=logImages.AddIcon(Form_FWRule.GetICON(mPath));
              logPaths.Add(LowerCase(mPath));
          end
          else //path is existing
          begin
               ListItem.ImageIndex:=logPaths.IndexOf(LowerCase(mPath));
          end;
         
          ListItem.Caption:=mTime;
          ListItem.SubItems.Add(mDirection);
          //if  mPermit=0 then  strTmp:='DENY'
          //else  strTmp:='ALLOW';
          ListItem.SubItems.Add(mPermit);
          ListItem.SubItems.Add(mIP);

          ListItem.SubItems.Add(mHostName);


          ListItem.SubItems.Add(mPort);

          ListItem.SubItems.Add(mPath);


          ListItem.SubItems.Add(mToltalRec);
          ListItem.SubItems.Add(mToltalSen);
          ListItem.SubItems.Add(mTotalRecSen);
          ListItem.SubItems.Add(mSockNo);
        end;
        Form_Option.ListView_FWLog.Items.EndUpdate;
        if((Form_Option.ListView_FWLog.Selected=Nil)) then
          ListItem.MakeVisible(TRue);
      end;

    WM_USER+1://Reserved
    else WndProc(MSGX);
  end;
end;
//DDT

// 傍蜡 弃歹 沥焊 舅酒郴扁
procedure TForm_Option.UpdateFolderInfo(Sender: TObject);
var
     i, j: Integer;
     sTemp: TStrings;
     valueName, valuePath, valueRemark, strTemp: String;
     valueSize: Integer;
     valueBuf: PChar;
     Registry, Registry2: TRegistry;
     ListItem: TListItem;
begin
     ListView_Folder.Items.Clear;

     // Windows NT/2000 拌凯
     Registry:= TRegistry.Create;
     Registry.RootKey:= HKEY_LOCAL_MACHINE;
     if Registry.OpenKey('SYSTEM\CurrentControlSet\Services\lanmanserver\Shares', False) then begin
          sTemp:= TStringList.Create;
          Registry.GetValueNames(sTemp);
          for i:=0 to sTemp.Count-1 do begin
               valueName:= sTemp.Strings[i];
               valueSize:= Registry.GetDataSize(valueName);
               GetMem(ValueBuf, ValueSize);
               try
                    if Registry.ReadBinaryData(ValueName, ValueBuf^, ValueSize) <> 0 then begin
                         for j:=0 to valueSize-1 do begin
                              if valueBuf[j] = #0 then valueBuf[j]:= '|';
                         end;
                         valuePath:= '';
                         strTemp:= valueBuf;
                         if Pos('|Path=', strTemp) > 0 then begin
                              Delete(strTemp, 1, Pos('|Path=', strTemp) + Length('|Path=') - 1);
                              valuePath:= Copy(strTemp, 1, Pos('|', strTemp) - 1);
                         end;
                         valueRemark:= '';
                         strTemp:= valueBuf;
                         if Pos('|Remark=', strTemp) > 0 then begin
                              Delete(strTemp, 1, Pos('|Remark=', strTemp) + Length('|Remark=') - 1);
                              valueRemark:= Copy(strTemp, 1, Pos('|', strTemp) - 1);
                         end;
                         ListItem:= ListView_Folder.Items.Add;
                         ListItem.ImageIndex:=8;
                         ListItem.Caption:= valueName;
                         ListItem.SubItems.Add(valuePath);
                         ListItem.SubItems.Add(valueRemark);
                    end;
               finally
                    FreeMem(ValueBuf);
               end;
          end;
          sTemp.Free;
          Registry.CloseKey;
     end;
     Registry.Free;

     // Windows 95/98 拌凯
     Registry:= TRegistry.Create;
     Registry.RootKey:= HKEY_LOCAL_MACHINE;
     if Registry.OpenKey('Software\Microsoft\Windows\CurrentVersion\Network\LanMan', False) then begin
          sTemp:= TStringList.Create;
          Registry.GetKeyNames(sTemp);
          for i:=0 to sTemp.Count-1 do begin
               valueName:= sTemp.Strings[i];
               Registry2:= TRegistry.Create;
               Registry2.RootKey:= HKEY_LOCAL_MACHINE;
               if Registry2.OpenKey('Software\Microsoft\Windows\CurrentVersion\Network\LanMan\' + valueName, False) then begin
                    valuePath:= Registry2.ReadString('Path');
                    valueRemark:= Registry2.ReadString('Remark');
                    ListItem:= ListView_Folder.Items.Add;
                    ListItem.Caption:= valueName;
                    ListItem.SubItems.Add(valuePath);
                    ListItem.SubItems.Add(valueRemark);
                    Registry2.CloseKey;
               end;
               Registry2.Free;
          end;
          sTemp.Free;
          Registry.CloseKey;
     end;
     Registry.Free;
end;

procedure TForm_Option.FormCreate(Sender: TObject);
//var
//     bCheck: Boolean;
begin
    //DDT
    LogID:=0;
    mainHWND:=self.Handle;
    WindowProc:=TrapMSG;//Change the WindowProc to User's proc.
    //DDT

     // 函荐 檬扁汲沥
     FDriverLoaded:= False;
     bPortScanning:= False;

     // 滚瓢 劝己拳 惑怕 檬扁拳
     BmBtnFolderView.Enabled:= False;
     BmBtnFolderInfo.Enabled:= False;
     BmBtnFolderStop.Enabled:= False;

     // 扁夯 其捞瘤 汲沥
     PageControl1.ActivePage:= TabSheet_FWRule;

     // OS 滚傈 沥焊 舅酒郴扁
     ZeroMemory(@OS,SizeOf(OS));
     OS.dwOSVersionInfoSize:=SizeOf(OS);
     GetVersionEx(OS);

     // 鸥捞赣 檬扁拳
     //Timer_Init.Enabled:= True;

     BmBtnApplySecurity.Enabled:=False;

     isLogStarted:=False;

     //Init log-image list.
     logImages:=TImageList.Create(Self);
     logPaths:=TStringList.Create;

     logImages.AddIcon(NIl);
     logPaths.Add('%$default$%');

     ListView_FWLog.SmallImages:= logImages;

     ServerSocket:=TServerSocket.Create(Form_Option);
end;

{
Initial