unitmain.pas

来自「在delphi中实现windows核心编程.原书光盘代码核心编程.原书光盘代码」· PAS 代码 · 共 81 行

unit UnitMain;

interface

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

type
  TForm1 = class(TForm)
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    procedure WMMsg(var message:TMessage);Message wm_user;
    { Private declarations }
  public
    { Public declarations }
  end;
  procedure InstallDll(path:string;MainFormHandle,ExplorerProcessID:THandle);stdcall;external 'install.dll';
  procedure RemoveDll;stdcall;external 'install.dll';
var
  Form1: TForm1;

implementation

{$R *.dfm}

function FindProcessName:THandle;
var
  lppe: tprocessentry32;
  sshandle: thandle;
  found: boolean;
begin
  result:=0; 
  sshandle := createtoolhelp32snapshot(TH32CS_SNAPALL, 0);
  found := process32first(sshandle, lppe);
  while found do
  begin
    if ansiCompareText(ExtractFileName(lppe.szExefile),'EXPLORER.EXE') = 0 then
    begin
       result:=lppe.th32ProcessID;
       break;
    end;
    found := process32next(sshandle, lppe); {检索下一个进程}
  end;
  CloseHandle(sshandle);
end;

procedure TForm1.FormShow(Sender: TObject);
var
   h:THandle;
begin
   h:=FindProcessName;
   if h<>0 then
      InstallDll(extractfilepath(paramstr(0)),self.Handle,h);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   RemoveDll;
end;

procedure TForm1.WMMsg(var message:TMessage);
begin
   if message.WParam=1 then
   begin
      if message.LParam=1 then
      begin
         showmessage('安装OK');
         Close;
      end
      else if message.LParam=2 then
      begin
         showmessage('卸载OK');
         Close;
      end;
   end;
end;

end.