mytest_unit1.pas

一个delphi的使自己的进程不能被taskmgr杀掉的示范源码.

unit MyTest_Unit1;

interface

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

type
  TForm1 = class(TForm)
    btnHook: TBitBtn;
    btnUnhook: TBitBtn;
    btnClose: TBitBtn;
    edLibName: TEdit;
    btnLoadLib: TBitBtn;
    BitBtn1: TBitBtn;
    procedure btnHookClick(Sender: TObject);
    procedure btnUnhookClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnLoadLibClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);

  private
    { Private declarations }

  //GHook 01/05 S-----------------------------------------------
    SetHook: procedure; stdcall;
    UnSetHook: procedure; stdcall;
    IsHooking: function: boolean; stdcall;
    hLib: THandle;
  //GHook 01/05 S-----------------------------------------------

  //GHook 01/05 S-----------------------------------------------
    procedure GHook_DoLoadLib(p_dir:string);
    procedure GHook_DoHook;
  //GHook 01/05 E-----------------------------------------------

  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

//GHook 03/05 S-------------------------------------------------
procedure TForm1.GHook_DoLoadLib(p_dir:string);
begin
  if not FileExists(p_dir) then
     begin
       MessageDlg('File not found['+p_dir+']', mtError, [mbOK], 0);
       Exit;
     end
  else
     begin

        if hLib<>0 then
          begin
            if FreeLibrary(hLib) then
              begin
                hLib:=0;
                @SetHook:=nil;
                @UnSetHook:=nil;
                @IsHooking:=nil;

                btnLoadLib.Caption:='Load';
                btnHook.Enabled:=true;
                btnUnhook.Enabled:=false;
                btnClose.Enabled:=true;
              end
            else
              begin
                MessageDlg('cannot unload library', mtError, [mbOK], 0);
              end;

            Exit;
          end;

        hLib:=LoadLibrary( PChar(p_dir) );
        if hLib=0 then
          begin
            MessageDlg('Cannot load library', mtError, [mbOK], 0);
            Exit;
          end;

        @SetHook:=GetProcAddress(hLib, 'SetHook');
        @UnSetHook:=GetProcAddress(hLib, 'UnSetHook');
        @IsHooking:=GetProcAddress(hLib, 'IsHooking');
        if (@SetHook=nil) or (@UnSetHook=nil) or (@IsHooking=nil) then
          begin
            MessageDlg('Not a API hook library', mtError, [mbOK], 0);
            FreeLibrary(hLib);
            hLib:=0;
          end;

        if hLib<>0 then btnLoadLib.Caption:='UnLoad';
     end;

end;


procedure TForm1.GHook_DoHook;
begin
  if @SetHook=nil then
     begin
       MessageDlg('No library currently loaded', mtError, [mbOK], 0);
       Exit;
     end;

  btnHook.Enabled:=false;
  btnUnhook.Enabled:=true;
  btnClose.Enabled:=false;

  SetHook;
  if IsHooking
     then ShowMessage('Hook OK')
     else ShowMessage('Cannot Hook');
end;

//GHook 03/05 E-------------------------------------------------


procedure TForm1.btnHookClick(Sender: TObject);
begin
  if @SetHook=nil then
     begin
       MessageDlg('No library currently loaded', mtError, [mbOK], 0);
       Exit;
     end;
  btnHook.Enabled:=false;
  btnUnhook.Enabled:=true;
  btnClose.Enabled:=false;
  SetHook;
  if IsHooking
     then ShowMessage('Hook OK')
     else ShowMessage('Cannot Hook');
end;

procedure TForm1.btnUnhookClick(Sender: TObject);
begin
  if @UnSetHook=nil then
     begin
       MessageDlg('No library currently loaded', mtError, [mbOK], 0);
       Exit;
     end;
  btnHook.Enabled:=true;
  btnUnhook.Enabled:=false;
  btnClose.Enabled:=true;
  UnSetHook;
  if IsHooking
     then ShowMessage('Cannot Stop Hook')
     else ShowMessage('Stop Hook');
end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  //GHook 05/05 S-----------------------------------------------
  //必须：一但退出后，下次运行 DoHook 会失效果；
      CanClose:=false;
  //GHook 05/05 E-----------------------------------------------
end;

procedure TForm1.btnLoadLibClick(Sender: TObject);
begin
    GHook_DoLoadLib(edLibName.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //GHook 04/05 S-----------------------------------------------
  hLib:=0;

  GHook_DoLoadLib(trim(ExtractFileDir(Application.ExeName))+'\GHook_Dll\GHook_NoCloseDLL.dll');
  GHook_DoHook;
  //GHook 04/05 E-----------------------------------------------
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  With TOpenDialog.Create(Self) do
    begin
      Filter:='API Hook Dll (*.dll)|*.dll';
      if Execute then edLibName.Text:=FileName;
      Free;
    end;
end;

end.