frmmainunit.pas

PSM firewall code(DELPHI)

//frmMainUnit.pas: Main form
//(C) 2003 PSMKorea, http://www.psmkorea.co.kr
//Written by DoDucTruong, [e-mail]

unit frmMainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Registry, ImgList, Menus, ShellAPI, Buttons, ShlObj,ComObj,ActiveX,
  jpeg, ExtCtrls, u_svc, WinSvc;

//APIs:
//function ExtractIcon (hInst:UINT;lpszExeFileName:String; nIconIndex:UINT): UINT; stdcall;
function GetICON(path:string):TIcon;
procedure Wait(ms: WORD);

type
  TfrmMain = class(TForm)
    PageControl: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    ListView1: TListView;
    ImageList1: TImageList;
    PopupMenu1: TPopupMenu;
    mnuInf: TMenuItem;
    mnuDel: TMenuItem;
    N1: TMenuItem;
    Label1: TLabel;
    ListView3: TListView;
    Label2: TLabel;
    ListView2: TListView;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label3: TLabel;
    Label8: TLabel;
    ListView4: TListView;
    Label9: TLabel;
    ListView5: TListView;
    Label10: TLabel;
    GroupBox1: TGroupBox;
    TabSheet4: TTabSheet;
    GroupBox2: TGroupBox;
    cmdMSConfig: TBitBtn;
    cmdServiceMan: TBitBtn;
    cmdSysEdit: TBitBtn;
    cmdRegedit: TBitBtn;
    cmdServiceRestart: TBitBtn;
    cmdServiceStop: TBitBtn;
    cmdServiceStart: TBitBtn;
    cmdServiceChangeStartupMode: TBitBtn;
    Label11: TLabel;
    Label12: TLabel;
    ListView1_2: TListView;
    GroupBox3: TGroupBox;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Image1: TImage;
    BitBtn1: TBitBtn;
    PopupMenu2: TPopupMenu;
    mnuAutomatic: TMenuItem;
    mnuManual: TMenuItem;
    mnuDisabled: TMenuItem;
    Image2: TImage;
    Label17: TLabel;
    Label18: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ListView1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure mnuDelClick(Sender: TObject);
    procedure mnuInfClick(Sender: TObject);
    procedure ListView3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListView1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListView3KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListView4MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListView5MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure cmdSysEditClick(Sender: TObject);
    procedure cmdMSConfigClck(Sender: TObject);
    procedure cmdServiceManClick(Sender: TObject);
    procedure cmdRegeditClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure cmdServiceStartClick(Sender: TObject);
    procedure cmdServiceStopClick(Sender: TObject);
    procedure cmdServiceRestartClick(Sender: TObject);
    procedure mnuServiceStartupTypeClick(Sender: TObject);
    procedure cmdServiceChangeStartupModeClick(Sender: TObject);
    procedure ListView2DblClick(Sender: TObject);
    procedure ListView2SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
  private
    { Private declarations }
    Procedure LoadStartupPrograms();
    Procedure LoadFromReg(Location: String);
    Procedure LoadFromDir(Location:String);
    Procedure ChangeReg(LI: TListItem; booDel:Boolean);
    Procedure ScanKeyboardFilterDriver();
    Procedure ScanSystemINI(iniFN:string);
    Procedure ChangeLine(iniFN:string;oldL:Pchar;newL:Pchar);
    Procedure ChangeCmdStatus(booAllStatus: Boolean;LI: TListItem);
    Procedure DelKBf();

    procedure TrapMSG(var MSGX: TMessage);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  TheIcon:TIcon;

implementation

{$R *.dfm}

//function ExtractIcon (hInst:UINT;lpszExeFileName:String; nIconIndex:UINT): UINT; stdcall; external 'shell32.dll' name 'ExtractIconA';
function GetICON(path:string):TIcon;
{var
  wp: Array[1..MAX_PATH] of Char;
  i: Integer;
}
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);
  end;
}  
  result :=TheIcon;
end;

procedure Wait(ms: WORD);
var untilT: Cardinal;
begin
  untilT:=GetTickCount + ms;
  while GetTickCount<untilT do Application.ProcessMessages;
end;

Procedure TfrmMain.LoadStartupPrograms();
Begin
  //ImageList1.Clear;
  ListView1.Clear;
  LoadFromReg('HKCU');
  LoadFromReg('HKCU_B');
  LoadFromReg('HKCU_S');
  LoadFromReg('HKCU_S_B');
  LoadFromReg('HKLM');
  LoadFromReg('HKLM_B');
  LoadFromReg('HKLM_S');
  LoadFromReg('HKLM_S_B');

  if ListView1.Items.Count=0 then
  begin
    ListView1.Checkboxes:=False;
    ListView1.Items.Add.Caption:='No startup program found!';
  end;

  ListView1_2.Clear;
  LoadFromDir('CU');
  LoadFromDir('LM');
  if ListView1.Items.Count=0 then
  begin
    ListView1_2.Checkboxes:=False;
    ListView1_2.Items.Add.Caption:='No startup program found!';
  end;
End;

Procedure TfrmMain.ScanKeyboardFilterDriver();
var
  reg: Tregistry;
  tmp1:array[1..MAX_PATH] of char;
  tmp2:array[1..MAX_PATH] of char;
  tmp:Pchar;
  curListItem: TListItem;
  i: word;
Begin
  with ListView3 do
  begin
    Clear;
    Reg:=TRegistry.Create;
    try
      Reg.RootKey:=HKEY_LOCAL_MACHINE;

      if Reg.OpenKey('SYSTEM\CurrentControlSet\Control\Class\{4D36E96B-E325-11CE-BFC1-08002BE10318}',False) then
      Begin
        FillChar(tmp1, MAX_PATH, Ord(' '));
        reg.ReadBinaryData('UpperFilters',tmp1,MAX_PATH);
        i:=1;
        while (i< MAX_PATH) do
        begin
          i:=i+1;
          if tmp1[i]=#0 then
          begin
            if tmp1[i+1]=#0 then break;
            while (tmp1[i]=#0)and (i<MAX_PATH) do i:=i+1;
            if i<MAX_PATH then
            begin
              curListItem:=Items.Add;
              tmp:=Pchar(@tmp1[i]);
              tmp:=Pchar(trim(string(tmp)));
              i:=i+strlen(tmp)-1;
              if tmp<>'' then
                curListItem.Caption:=tmp;
              GetSystemDirectory(Pchar(@tmp2),MAX_PATH);
              if FileExists(Pchar(@tmp2) + '\Drivers\' + tmp + '.sys')then
                curListItem.SubItems.Add( Pchar(@tmp2) + '\Drivers\' + tmp + '.sys')
              else if FileExists(Pchar(@tmp2) + '\' + tmp + '.sys')then
                curListItem.SubItems.Add( Pchar(@tmp2) + '\' + tmp + '.sys')
              {else if FileExists(Pchar(@tmp2) + '\Drivers\' + tmp + '.sys.del')then
                curListItem.SubItems.Add( Pchar(@tmp2) + '\Drivers\' + tmp + '.sys.del')
              else if FileExists(Pchar(@tmp2) + '\' + tmp + '.sys.del')then
                curListItem.SubItems.Add( Pchar(@tmp2) + '\' + tmp + '.sys.del')}
              else curListItem.SubItems.Add('File not found');

              if Pchar(curListItem.SubItems[0]) + StrLen(Pchar(curListItem.SubItems[0])) - 4 = '.sys' then
              begin
                curListItem.Data:=@curListItem;//Any pointer<>nil
                //curListItem.Checked:=True
              end
              else
              begin
                curListItem.Data:=nil;//Any pointer<>nil
                //curListItem.Checked:=False;
              end;
            end;
          end;
        end;
      end;

      //reg.MoveKey('SOFTWARE\PSMAntiKeyLogger\KB\iks','SYSTEM\CurrentControlSet\Services\iks',true);
    finally
      Reg.free;
    end;

    if Items.Count=0 then
    begin
      Checkboxes:=False;
      Items.Add.Caption:='No Keyboard Filter driver found!';
    end;
  end;
End;

Procedure TfrmMain.LoadFromDir(Location:string);
var
  reg: Tregistry;
  regPath: String;
  stDir: string;
  sr: TSearchRec;
  curListItem:TListItem;
  MyObject: IUnknown;
  MySLink: IShellLink;
  MyPFile: IPersistFile;

  fd: _WIN32_FIND_DATA;
  fn: array[1..MAX_PATH] of Char;
  lfn: array[1..MAX_PATH] of WChar;
  i: Integer;
Begin
  with ListView1_2 do
  begin
    Reg:=TRegistry.Create;
    try
      if Location='CU' then
      begin
        Reg.RootKey:=HKEY_CURRENT_USER;
        regPath:='Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';
      end
      else
      begin
        Reg.RootKey:=HKEY_LOCAL_MACHINE;
        regPath:='Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';
      end;
      if Reg.OpenKey(regPath,False) then
      Begin
        if Location='CU' then
          stDir:=Reg.ReadString('Startup')
        else
          stDir:=Reg.ReadString('Common Startup');
                  
        if stDir<>'' then
        begin
          if FindFirst(stDir + '\*', faAnyFile	, sr) = 0 then
          begin
            repeat
              if (sr.Name <> '.') and (sr.Name <> '..') then
              begin
               curListItem:=Items.Add;
               curListItem.Caption:= sr.Name;

               MyObject := CreateComObject(CLSID_ShellLink);
               MySLink := MyObject as IShellLink;
               MyPFile := MyObject as IPersistFile;

               FillChar(lfn,MAX_PATH,0);
               Strcopy(Pchar(@fn),Pchar(stDir));
               StrCat(Pchar(@fn),'\');
               StrCat(Pchar(@fn),Pchar(sr.Name));
               for i:= 1 to strlen(Pchar(@fn)) do lfn[i]:=WChar(fn[i]);

               if MyPFile.Load(PWchar(@lfn),OF_READ)=S_OK then
               begin
                FillChar(fn,MAX_PATH,' ');
                MySLink.GetPath(Pchar(@fn),MAX_PATH,fd,SLGP_UNCPRIORITY	);
               end;

               if trim(fn)<>'' then
                curListItem.SubItems.Add(trim(fn))
               else
                curListItem.SubItems.Add(stDir + '\' + sr.Name);

               curListItem.SubItems.Add(Location);
               curListItem.SubItems.Add(stDir + '\' + sr.Name);

               if ImageList1.AddIcon(GetICON(curListItem.SubItems[0]))<>-1 then
                 curListItem.ImageIndex:=ImageList1.Count-1
               else
                 curListItem.ImageIndex:=0;
              end;

            until FindNext(sr) <> 0;
            FindClose(sr);
          end;
        end;
      end
    finally
      Reg.Free;
    end;{try}
    end;
End;

Procedure TfrmMain.LoadFromReg(Location: String);
var
  reg: Tregistry;
  Val:TStringList;
  I:Integer;
  strName:string;
  strPath:string;
  strEXE:Pchar;
  strEXEfree:Pchar;
  curListItem:TListItem;
  regPath:string;
Begin
  with ListView1 do
  begin
    Reg:=TRegistry.Create;
    Val:=TStringList.Create;
    try
        if pos('HKCU',Location)>0 then
          begin
            if (Location='HKCU') then
              regPath:='Software\Microsoft\Windows\CurrentVersion\Run'
            else if (Location='HKCU_B') then
              regPath:='Software\Microsoft\Windows\CurrentVersion\Run_Bak'
            else if (Location='HKCU_S') then
              regPath:='Software\Microsoft\Windows\CurrentVersion\RunServices'
            else
              regPath:='Software\Microsoft\Windows\CurrentVersion\RunServices_Bak';

            Reg.RootKey:=HKEY_CURRENT_USER
          end
        else
          begin
            if (Location='HKLM') then
              regPath:='Software\Microsoft\Windows\CurrentVersion\Run'
            else if (Location='HKLM_B') then
              regPath:='Software\Microsoft\Windows\CurrentVersion\Run_Bak'
            else if (Location='HKLM_S') then
              regPath:='Software\Microsoft\Windows\CurrentVersion\RunServices'
            else
              regPath:='Software\Microsoft\Windows\CurrentVersion\RunServices_Bak';

            Reg.RootKey:=HKEY_LOCAL_MACHINE;
          end;

        if not Reg.OpenKey(regPath,False) then
          //No App.
        else