winhook.dpr

delphi编程源代码

Program WinHook;

uses windows,messages,sysutils;
type
  TWin = record
    Msg:TMsg;
    wClass:TWndClass;
    hMain:integer;
    hLib:integer;
  end;
var
  Win:TWin;                     //结构变量
  WorkPath:string;
  hRun:procedure;stdcall;
  hStop:function:boolean;stdcall;
//
function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;
begin
  case Msg of
  wm_destroy:
    begin
      repeat
        if hStop=true then break;
      until false;
      freelibrary(win.hlib);
      halt;
    end;
  end;
  Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
end;

//主程序的执行函数
procedure run;stdcall;
begin
  if (findwindow('WinHook',nil)<>0) or (findwindow('Remote Server 2001',nil)<>0) then exit;
  win.wClass.hInstance:=     hInstance;
  with win.wclass do
  begin
    hIcon:=         LoadIcon(hInstance,'MAINICON');
    hCursor:=       LoadCursor(0,IDC_ARROW);
    hbrBackground:= COLOR_BTNFACE+1;
    Style:=         CS_PARENTDC;
    lpfnWndProc:=   @WindowProc;
    lpszClassName:='WinHook';
  end;
  RegisterClass(win.wClass);
  win.hmain:=CreateWindow(win.wClass.lpszClassName,'Delphi Hook Demo 2001',WS_OVERLAPPEDWINDOW,0,0,240,185,0,0,hInstance,nil);
  WorkPath:=ExtractFilePath(ParamStr(0));
  //
  win.hlib:=loadlibrary(pchar(WorkPath+'DemoHook.dll'));
  if win.hlib=0 then messagebox(win.hmain,'Error Open DemoHook.dll','',0);
  hrun:=GetProcAddress(win.hlib,'SetThreadHook');
  hstop:=GetProcAddress(win.hlib,'DeThreadHook');
  if @hrun<>nil then hrun;
  //
  while(GetMessage(win.Msg,win.hmain,0,0)) do
  begin
    TranslateMessage(win.Msg);
    DispatchMessage(win.Msg);
  end;
end;

begin
  run;   //开始运行主程序
end.