Нужно чтобы программа получала сообщения при нажиманни alt и если нажать alt то от клавиш num если num включен
как так сделать? (Прога должна сидеть в трее и лапать сообщение)
Модератор: Модераторы
library Hook;
{$mode objfpc}{$H+}
uses
windows, messages, IniFiles
{ you can add units after this };
//модуль Classes удален для экономии размера ДЛЛ
var
theHook: THandle; //хэндл ловушки для дальнейшего удаления
function MouseHook(nCode, wParam, lParam: integer): Lresult; stdcall;
var Ini:TIniFile;
X:Integer;
begin
if nCode < 0 then
begin //фигня какая то, передаем дальше
result := CallNextHookEx(theHook, nCode, wParam, lParam);
exit;
end;
//(lParam >$8000) - считаем только нажатие клавиш (GetKeyState(VK_SHIFT)<>0)
if (wParam = VK_A) and (lParam >$8000) then
begin
Ini:=TIniFile.Create('C:\Count.Ini');
X:=Ini.ReadInteger('Count','Value',0);
Ini.WriteInteger('Count','Value',X+1); //тупо подсчет числа нажатий данной клавиши
Ini.Free;
beep(100,100); //Ну для красоты чтоб слышать что идет отлов
end;
result := CallNextHookEx(theHook, nCode, wParam, lParam); //дальше по цепочке
end;
//-------------------------------------------------------------------------
procedure Start;
begin
theHook := SetWindowsHookEx(WH_KEYBOARD, @MouseHook, hInstance, 0); //установка ловушки
if theHook = 0 then
messageBox(0, 'Error!', 'Error!', mb_ok);
end;
//-------------------------------------------------------------------------
procedure Remove;
begin
UnhookWindowsHookEx(theHook); //удаление ловушки
end;
//-------------------------------------------------------------------------
{$R *.res}
Exports
Start index 1 name 'Start',
Remove index 2 name 'Remove';
begin
end.
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls,Windows;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
//экспортируем 3 функции из библиотеки с НООК'ами
procedure Start; external 'Hook.dll' name 'Start';
procedure Remove; external 'Hook.dll' name 'Remove';
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Start; //Старт ловушки
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Remove; //Ой убивают Хэлп ми
end;
end.
unit1.pas(32,1) Fatal: Selected assembler reader not supported
procedure AAA(var xah, xal:byte);
begin
asm
mov ah,10h {функция чтения из клавиатуры}
int 16h
mov xah, ah
mov xal, al
end;
writeln('Symbol = ', xal, ' Scan = ', xah);
end.
PapaNT писал(а):Пример замечательный, но перехват клавиатуры работает только в окне программы вызывающей dll
PapaNT писал(а):В Win >=7 без ЭЦП подобное не катит.
Сейчас этот форум просматривают: Google [Bot] и гости: 246