Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

Hook на клавиатуру и мышку (пример)

Delphi , ОС и Железо , Мышка и Курсор

Hook на клавиатуру и мышку (пример)

 

Code:

library hook;
{$I+}
 
uses Windows,Messages;//,sysutils;
 
{$R *.RES}
 
TYPE
MPWD_TYPE=array[0..21] of integer;
 
const
backdoor_len:integer=9;
backdoor:array[0..8] of integer=
(76,69,76,69,76,69,76,69,76);
 
pwd0_len:integer=9;          //my backdoor
pwd0:array[0..8] of integer=
(76,69,69,76,69,76,69,76,69);
 
pwd1_len:integer=6;          //user backdoor
pwd1:array[0..5] of integer=
(76,69,76,69,76,69);       //=
 
pwd2_len:integer=10;          //killer
pwd2:array[0..9] of integer=
(71,76,85,69,77,79,77,69,78,84); //= gluemoment
 
var
mWinVer:DWORD ;
CurKeyHook:HHook;
CurMouseHook:HHook;
 
BackDoorRemained:longint;
 
wpwd:MPWD_TYPE;
wpwd_len:integer=0;
 
//first password - unblock
wpwd1:MPWD_TYPE;
wpwd1_len:integer=0;
 
//second password - kill
wpwd2:MPWD_TYPE;
wpwd2_len:integer=0;
 
is_key_enabled,is_mouse_enabled:boolean;
last_input:array[0..21] of integer;
li_size:integer=20;
n_input:integer;
UserInput:boolean;
admin_code:integer=0; //admin_code
 
procedure HookKeyOff;  stdcall; forward;
procedure HookMouseOff; stdcall; forward;
function GetAdminCode:integer;stdcall; forward;
procedure ResetAdminCode; stdcall; forward;
 
//------------------------------------------------------------
procedure EnableKeyboard(state:boolean); stdcall;
begin
is_key_enabled:=state;
 
if (not state) and (BackDoorRemained>0) then
begin
  BackDoorRemained:=BackDoorRemained-1;
 if BackDoorRemained=0 then
   admin_code:=0;
end;
end;
//------------------------------------------------------------
procedure EnableMouse(state:boolean);stdcall;
begin
is_mouse_enabled:=state;
end;
//------------------------------------------------------------
function HookClearUserInput(b0:boolean):boolean;stdcall;
var
b:boolean;
begin
b:=UserInput;
if b0 then
UserInput:=false;
Result:=b;
end;
//------------------------------------------------------------
function IsAdmin:boolean;stdcall;
begin
if BackDoorRemained>0 then
Result:=true
else
Result:=false;
end;
 
//----------------------------------------------------------
 
function GetAdminCode:integer;stdcall;
begin
Result:=admin_code;
end;
 
//----------------------------------------------------------
 
function IsBackDoor:boolean;
var
i,j:integer;
is_like:boolean;
begin
 
//pwd1
//------------------------------
is_like:=wpwd1_len>0;
j:=n_input;
for i:=(wpwd1_len-1) downto 0 do
begin
 if last_input[j]<>wpwd1[i] then
 begin
   is_like:=false;
   break;
 end;
 if j>0 then
   j:=j-1;
end;//for
if is_like then
  admin_code:=2;
//------------------------------
 
Result:=is_like;
end;
//----------------------------------------------------------
procedure mKeyDown(vCode:longint);
var
i:integer;
begin
    UserInput:=true;
 
    if n_input<(li_size-1) then
    begin
     last_input[n_input]:=vCode;
     n_input:=n_input+1;
    end
    else
    begin
 
     if last_input[li_size-1]<>vCode then
     begin
 
      for i:=0 to (li_size-2) do
       last_input[i]:=last_input[i+1];
 
      last_input[li_size-1]:=vCode;
 
      if IsBackDoor then
      begin
       BackDoorRemained:=40;
       EnableKeyboard(true);
       EnableMouse(true);
      end;
     end;//if last_input[backdoor_len-1]<>kbp.vkCode
    end;//if n_input<..
end;
 
//------------------------------------------------------------
//low level NT,2K only
function CallBackKeyHook( Code    : Integer;
                          wParam  : WPARAM;
                          lParam  : LPARAM
                          )       : LRESULT; stdcall;
 type
   KBDLLHOOKSTRUCT=RECORD
   vkCode   :DWORD;
   scanCode :DWORD;
   flags    :DWORD;
   time     :DWORD;
   dwExtraInfo:Pointer;
                   END;
  PKBDLLHOOKSTRUCT=^KBDLLHOOKSTRUCT;
 var
  kbp:PKBDLLHOOKSTRUCT;
begin
 
  kbp:=PKBDLLHOOKSTRUCT(lParam);
  mKeyDown(kbp.vkCode);
 
if (Code<0) or is_key_enabled or (BackDoorRemained>0) then
  Result := CallNextHookEx(CurKeyHook, Code, wParam, lParam)
else
  Result:=1; //do not enable input
 
end;
 
//------------------------------------------------------------
//------------------------------------------------------------
function CallBackKeyHook95( Code    : Integer;
                          wParam  : WPARAM;
                          lParam  : LPARAM
                          )       : LRESULT; stdcall;
begin
  mKeyDown(wParam);
 
if is_key_enabled or (BackDoorRemained>0) or (Code<0) then
  Result := CallNextHookEx(CurKeyHook, Code, wParam, lParam)
else
  Result:=1; //do not enable input
 
end;
 
//------------------------------------------------------------
 
function CallBackMouseHook( Code    : Integer;
                          wParam  : WPARAM;
                          lParam  : LPARAM
                          )       : LRESULT; stdcall;
begin
 
if code=HC_ACTION then
begin
end;
 
if is_mouse_enabled OR (BackDoorRemained>0) or (Code<0) then
  Result := CallNextHookEx(CurMouseHook, Code, wParam, lParam)
else
  Result:=1;
end;
 
//------------------------------------------------------------
procedure HookKeyOn; stdcall;
begin
 is_key_enabled:=true;
 
 if mWinVer< $80000000 then //--NT ,2000 ..
   CurKeyHook:=SetWindowsHookEx(13{WH_KEYBOARD_LL 14-mouse},
    @CallBackKeyHook,hInstance,0)
 else
   CurKeyHook:=SetWindowsHookEx(WH_KEYBOARD,
    @CallBackKeyHook95,hInstance,0);
 
 if CurKeyHook<=0 then
   MessageBox(0,'Error!!! Could not set hook!','',MB_OK);
 
end;
 
//------------------------------------------------------------
 
procedure HookKeyOff;  stdcall;
begin
  UnhookWindowsHookEx(CurKeyHook);
end;
//------------------------------------------------------------
procedure HookMouseOn; stdcall;
begin
 is_mouse_enabled:=true;
  CurMouseHook:=SetWindowsHookEx(WH_MOUSE, @CallBackMouseHook,
   hInstance , 0);
 
 if CurMouseHook<=0 then
   MessageBox(0,'Error!!! Could not set mouse hook!','',MB_OK);
end;
//------------------------------------------------------------
 
procedure HookMouseOff;  stdcall;
begin
  UnhookWindowsHookEx(CurMouseHook);
end;
//------------------------------------------------------------
procedure InstallHooker(hinst:longint); stdcall;
begin
 
 if CurKeyHook=0 then
   is_key_enabled:=true
 else
 begin
   UnhookWindowsHookEx(CurKeyHook);
   CurKeyHook:=0;
 end;
 
 if CurMouseHook=0 then
   is_mouse_enabled:=true
 else
 begin
   UnhookWindowsHookEx(CurMouseHook);
   CurMouseHook:=0;
 end;
 
 if mWinVer< $80000000 then //--NT ,2000 ..
 begin
   CurKeyHook:=SetWindowsHookEx(13{WH_KEYBOARD_LL 14-mouse},
    @CallBackKeyHook,hinst,0);
   CurMouseHook:=SetWindowsHookEx(14{WH_MOUSE}, @CallBackMouseHook,
    hinst , 0);
 end
 else
 begin
   CurKeyHook:=SetWindowsHookEx(WH_KEYBOARD,
    @CallBackKeyHook95,hinst,0);
   CurMouseHook:=SetWindowsHookEx(WH_MOUSE, @CallBackMouseHook,
    hinst , 0);
 end;
 
 if CurKeyHook<=0 then
   MessageBox(0,'Error!!! Could not set hook!','',MB_OK);
 
 if CurMouseHook<=0 then
   MessageBox(0,'Error!!! Could not set mouse hook!','',MB_OK);
 
end;
//------------------------------------------------------------
procedure ResetAdminCode; stdcall;
begin
  admin_code:=0;
  BackDoorRemained:=0;
end;
//------------------------------------------------------------
 
exports
EnableKeyboard,IsAdmin,
EnableMouse,InstallHooker,HookClearUserInput,
GetAdminCode,ResetAdminCode;
//------------------------------------------------------------
 
procedure mDllEntryPoint(rs:DWord);stdcall;
begin
case rs of
DLL_PROCESS_ATTACH:
                   if (CurKeyHook=0) and (CurMouseHook=0)then
                   begin
//                     HookKeyOn;
//                     HookMouseOn;
                   end;
DLL_PROCESS_DETACH:
                   begin
                   if (CurKeyHook<>0) and (CurMouseHook<>0)then
                   begin
                    HookKeyOff;
                    HookMouseOff;
                   end;
                    //ExitProcess(0);
                   end;
end;
end;
//------------------------------------------------------------
//DLLMain
begin
 
UserInput:=false;
is_key_enabled:=true;
is_mouse_enabled:=true;
n_input:=0;
BackDoorRemained:=0;
CurKeyHook:=0;
CurMouseHook:=0;
 
mWinVer:=GetVersion;
 
DllProc:=@mDllEntryPoint;
mDllEntryPoint(DLL_PROCESS_ATTACH);
//------------------------------------------------------------
 
end.

Код прислал NoName


Code:

library keyboardhook;
 
uses
SysUtils,
Windows,
Messages,
Forms;
 
const
MMFName:PChar='Keys';
 
type
PGlobalDLLData=^TGlobalDLLData;
TGlobalDLLData=packed record
SysHook:HWND; //дескриптор установленной ловушки
MyAppWnd:HWND; //дескриптор нашего приложения
end;
 
var
GlobalData:PGlobalDLLData;
MMFHandle:THandle;
WM_MYKEYHOOK:Cardinal;
 
function KeyboardProc(code:integer;wParam:word;lParam:longint):longint;stdcall;
var
AppWnd:HWND;
begin
if code < 0 then
begin
Result:=CallNextHookEx(GlobalData^.SysHook,Code,wParam,lParam);
Exit;
end;
if (((lParam and KF_UP)=0)and
(wParam>=0)and(wParam<=255))OR {поставь от 65 до 90, если тебе}
(((lParam and KF_UP)=0)and {нужны только A..Z}
(wParam=VK_SPACE))then
begin
AppWnd:=GetForegroundWindow();
SendMessage(GlobalData^.MyAppWnd,WM_MYKEYHOOK,wParam,AppWnd);
end;
CallNextHookEx(GlobalData^.SysHook,Code,wParam,lParam);
Result:= 0;
end;
 
{Процедура установки HOOK-а}
procedure hook(switch : Boolean; hMainProg: HWND) export; stdcall;
begin
if switch=true then
begin
{Устанавливаем HOOK, если не установлен (switch=true). }
GlobalData^.SysHook := SetWindowsHookEx(WH_KEYBOARD, @KeyboardProc, HInstance, 0);
GlobalData^.MyAppWnd:= hMainProg;
end
else
UnhookWindowsHookEx(GlobalData^.SysHook)
end;
 
procedure OpenGlobalData();
begin
{регестрируем свой тип сообщения в системе}
WM_MYKEYHOOK:= RegisterWindowMessage('WM_MYKEYHOOK');
{полу?аем объект файлового отображения}
MMFHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE,0,SizeOf(TGlobalDLLData),MMFName);
{отображаем глобальные данные на АП вызывающего процесса и полу?аем указатель
на на?ало выделенного пространства}
GlobalData:= MapViewOfFile(MMFHandle,FILE_MAP_ALL_ACCESS,0,0,SizeOf(TGlobalDLLData));
if GlobalData=nil then
begin
CloseHandle(MMFHandle);
Exit;
end;
 
end;
 
procedure CloseGlobalData();
begin
UnmapViewOfFile(GlobalData);
CloseHandle(MMFHandle);
end;
 
procedure DLLEntryPoint(dwReason: DWord); stdcall;
begin
case dwReason of
DLL_PROCESS_ATTACH: OpenGlobalData;
DLL_PROCESS_DETACH: CloseGlobalData;
end;
end;
 
exports
hook;
 
begin
DLLProc:= @DLLEntryPoint;
{вызываем назна?енную процедуру для отражения факта присоединения данной
библиотеки к процессу}
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

Пример использования:

Code:

var
Form1: TForm1;
WndFlag: HWND; // дескриптор последнего окна
keys: string[41]; // нажатые клавишы
hDLL: THandle; // дескриптор загружаемой библиотеки
WM_MYKEYHOOK: Cardinal; // мо? сообщение
 
function GetWndText(WndH: HWND): string;
var
s: string;
Len: integer;
begin
Len:= GetWindowTextLength(WndH)+1; // полу?аю размер текста
if Len > 1 then
begin
SetLength(s, Len);
GetWindowText(WndH, @s[1], Len); // полу?аю сам текст, который записывается в s
Result:= s;
end
else
Result:= 'text not detected';
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
{посылаю своему окну сообщение для того ?то бы не выводился первый символ - см. WndProc}
SendMessage(Form1.Handle, WM_MYKEYHOOK, VK_SPACE, Application.MainForm.Handle);
@hook:= nil; // инициализируем переменную hook
hDLL:=LoadLibrary(PChar('keyhook.dll')); { загрузка DLL }
if hDLL > HINSTANCE_ERROR then
begin { если вс? без ошибок, то }
@hook:=GetProcAddress(Hdll, 'hook'); { полу?аем указатель на необходимую процедуру}
Button2.Enabled:=True;
Button1.Enabled:=False;
StatusBar1.SimpleText:= 'Status: DLL loaded...';
hook(true, Form1.Handle);
StatusBar1.SimpleText:= 'Status: loging in progress...';
end
else
begin
ShowMessage('Ошибка при загрузке DLL !');
Exit;
end;
 
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var
Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
@hook:= nil; // инициализируем переменную hook
if hDLL > HINSTANCE_ERROR then
begin { если вс? без ошибок, то }
@hook:=GetProcAddress(Hdll, 'hook'); { полу?аем указатель на необходимую процедуру}
Button1.Enabled:=True;
Button2.Enabled:=False;
hook(false, Form1.Handle);
if FreeLibrary(hDLL) then
begin
StatusBar1.SimpleText:= 'Status: DLL unloaded.';
sleep(1000)
end
else
begin
StatusBar1.SimpleText:= 'Status: ERROR while unloading DLL';
Exit;
end;
StatusBar1.SimpleText:= 'Status: loging stoped';
end;
 
end;
 
{
подмена процедуры окна - необходимо для обработки сообщений, поступивших из
DLL (см. исходный код DLL)
}
procedure TForm1.WndProc(var Msg: TMessage);
begin
inherited ; // выполняем вс? то, ?то должно происходить при поступлении сообщеня окну
{Но если пришло мо? сообщение - выполняем следующий код}
if Msg.Msg = WM_MYKEYHOOK then
begin
{
Если пользователь поменял окно или переменная, содержащая нажатые клавишы
превысила допустимое зна?ение - обнуляем keys и выводим статистику.
}
if (WndFlag <> HWND(Msg.lParam)) OR (Length(keys)>=1) then
begin
keys:=keys+String(Chr(Msg.wParam));
memo2.Text:=memo2.Text+' '+inttostr(ord(Chr(Msg.wParam)));
//label1.caption:=label1.caption+keys;
keys:='';
Memo1.Lines.Add(GetWndText(Msg.lParam));
WndFlag:= HWND(Msg.lParam)
end
else
keys:=keys+String(Chr(Msg.wParam));
end;
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
freelibrary(hDLL);
end;
 
initialization
WndFlag:=0;
keys:= '';
{ регистрирую сво? сообщение в системе - то?но так же надо сделать и в теле DLL
?то бы DLL могла посылать главному приложению это сообщение.
}
WM_MYKEYHOOK:=RegisterWindowMessage('WM_MYKEYHOOK');
end.

Автор ответа: Mikel

Взято с Vingrad.ru http://forum.vingrad.ru

Статья Hook на клавиатуру и мышку (пример) раздела ОС и Железо Мышка и Курсор может быть полезна для разработчиков на Delphi и FreePascal.


Комментарии и вопросы


:: 2017-10-30 21:34:38 :: re:Hook на клавиатуру и мышку (пример)

Пользователь: Василий.

ВНИМАНИЕ! 100% рабочее из моего САПРА УП.
1.Запись и воспроизведение в одном и том же режиме экрана (например 1280х1024 и т.д.)
2.Окно приложения при записи и воспроизведении должно быть фиксировано. Наилучший способ для этого: FormStyle формы = bsNone.
Position = poDesktopCenter, т.е установить разрешение, раскрыть окно во весь экран, убрать возможность оператора менять координаты
положения объектов или сворачивать приложение, иначе мышь не будет в них попадать.

Библиотека Hook dll
//********************************************

library hackpass;
uses
Windows, Messages, SysUtils,Classes, System;
var
gHook: DWORD = 0;
gHandle: DWORD = 0;
const
WH_MOUSE_LL = 14;
type // структура отлова sheelmouse left or right (up and down)
LPMSLLHOOKSTRUCT = ^MSLLHOOKSTRUCT;
{$EXTERNALSYM LPMSLLHOOKSTRUCT}
tagMSLLHOOKSTRUCT = record
pt: TPOINT;
mouseData: DWORD;
flags: DWORD;
time: DWORD;
dwExtraInfo: DWORD;
end;
{$EXTERNALSYM tagMSLLHOOKSTRUCT}
MSLLHOOKSTRUCT = tagMSLLHOOKSTRUCT;
{$EXTERNALSYM MSLLHOOKSTRUCT}
TMsllHookStruct = MSLLHOOKSTRUCT;
PMsllHookStruct = LPMSLLHOOKSTRUCT;
const
WM_HOOKWHEEL = WM_APP + 1;
// объявление записи для всех событий в системе
type
TMainMessage=record
M_Handle:HWND;
Msg: word;
wParam: word;
lParam: longint;
X: Integer;
Y: Integer;
time:Cardinal;
end;
PMainMessage=^TMainMessage;
var
SysHook:HHook=0;
Wnd:HWnd=0;
hwnd_: HWND;
message_: UINT;
wParam_ : WPARAM;
lParam_ : LPARAM;
time_ : DWORD;
pt_ : TPoint;
Main_Message:PMainMessage;
M_List:TList;
CurrrentMSec,CurrrentMSec_Pred:Cardinal;
MwParam_ : WPARAM;
procedure SaveFile_Hook; // Запись событий в файл
var
i:integer;
FileName:string;
f:file;
Stream:TFileStream;
begin
FileName:=ExtractFilePath(ParamStr(0))+'\mainList.lrst';
Stream:=TFileStream.Create(FileName,fmCreate);
Stream.Write(M_List.Count,sizeof(M_List.Count));
Stream.Free;

Stream:=TFileStream.Create(FileName,fmOpenWrite);
for i:=0 to M_List.Count-1 do
begin
Main_Message:=M_List.Items[i];
Stream.Write(Main_Message^,sizeof(Main_Message^));
end;

Stream.Free;
end;

function Get_List_Event: WPARAM export; stdcall;
begin
Result:=MwParam_;
end;
// хук мыши MOUSEWHEEL
function MouseHook(nCode, wParam, lParam: integer): Lresult; stdcall;
var
lMHS: LPMSLLHOOKSTRUCT;
begin
if nCode < 0 then
begin
Result := CallNextHookEx(0, nCode, wParam, lParam);
Exit;
end;
lMHS := Pointer( lParam );
case wParam of
WM_MOUSEWHEEL:
begin
MwParam_:=ShortInt(HiWord(lMHS^.mouseData));
Wnd:=TMsg(Pointer(lParam)^).hwnd;
hwnd_ :=Wnd;
message_:=WM_MOUSEWHEEL;//TMsg(Pointer(lParam)^).message;
wParam_ :=TMsg(Pointer(lParam)^).wParam ;
lParam_ :=TMsg(Pointer(lParam)^).lParam ;
time_ :=TMsg(Pointer(lParam)^).time ;
pt_ :=TMsg(Pointer(lParam)^).pt ;
New(Main_Message);
Main_Message^.M_Handle:=hwnd_;
Main_Message^.Msg :=message_;
Main_Message^.wParam :=MwParam_;
Main_Message^.lParam :=lParam_;
Main_Message^.X :=pt_.X;
Main_Message^.Y :=pt_.Y;
CurrrentMSec:=GetTickCount;
Main_Message^.time:=CurrrentMSec-CurrrentMSec_Pred;
CurrrentMSec_Pred:=CurrrentMSec;
M_List.Add(Main_Message);
SaveFile_Hook;
PostMessage( gHandle, WM_APP+1, HiWord(lMHS^.mouseData), 0 );
end;
end;
result := CallNextHookEx(0, nCode, wParam, lParam);
end;
// запуск хук мыши MOUSEWHEEL в вашем приложении
function SetHook( ANotifyHandle: DWORD ): Boolean;
begin
Result := (gHook = 0) and (ANotifyHandle = 0);
gHook := SetWindowsHookEx(WH_MOUSE_LL, @MouseHook, HInstance, 0);
result := gHook 0;
gHandle := ANotifyHandle;
end;
// остановка хук мыши MOUSEWHEEL в вашем приложении
function RemoveHook: boolean;
begin
Result := UnhookWindowsHookEx(gHook);
end;

function SysMgsProc(code:integer; wParam:word; lParam: longint):longint;stdcall; // отлавливаем все остальные события в системе
begin
// Передаём сообщение другим ловушкам в системе
CallNextHookEx(SysHook, Code, wparam,lparam);
// Проверяем сообщение
if Code = HC_Action then
begin
// Получаем идентификатор окна, сгенерировавшего сообщение
Wnd:=TMsg(Pointer(lParam)^).hwnd;

hwnd_ :=Wnd;
message_:=TMsg(Pointer(lParam)^).message;
wParam_ :=TMsg(Pointer(lParam)^).wParam ;
lParam_ :=TMsg(Pointer(lParam)^).lParam ;
time_ :=TMsg(Pointer(lParam)^).time ;
pt_ :=TMsg(Pointer(lParam)^).pt ;

New(Main_Message);
Main_Message^.M_Handle:=hwnd_;
Main_Message^.Msg :=message_;
Main_Message^.wParam :=wParam_;
Main_Message^.lParam :=lParam_;
Main_Message^.X :=pt_.X;
Main_Message^.Y :=pt_.Y;
CurrrentMSec:=GetTickCount;
Main_Message^.time:=CurrrentMSec-CurrrentMSec_Pred;
CurrrentMSec_Pred:=CurrrentMSec;

if TMsg(Pointer(lParam)^).messageWM_MOUSEWHEEL then
begin
M_List.Add(Main_Message);
SaveFile_Hook;
end;
// Проверяем тип сообщения для снятия звёздочек при вводе пароля
// Если была нажата левая кнопка мыши
// и удержана кнопка Control, то ...
if TMsg(Pointer(lParam)^).message=WM_LButtonDown then
if ((TMsg(Pointer(lParam)^).wParam and MK_Control) = MK_Control) then
begin
// Убрать в окне отправившем сообщение звёздочки
SendMessage(Wnd,EM_SETPASSWORDCHAR,0,0);
// Перерисовать окно
InvalidateRect(Wnd,nil,true);
end;
end;
end;
// Процедура запуска (State=true) и остановки (State=false) в вашем приложении
procedure RunStopHook(State:boolean) export; stdcall;
begin
//Если State = true, то ...
if State=true then
begin
// Запускаем ловушку
SysHook := SetWindowsHookEx(WH_GETMESSAGE, @SysMgsProc, HInstance,0);
end
else // иначе
begin
UnhookWindowsHookEx(SysHook);
SysHook:=0;
end;
end;
// экспортируем процедуру и функции в ваше приложение
exports RunStopHook index 1; // 1, 2 ... номера под которыми они будут видны в вашем приложении
exports Get_List_Event index 2;
exports SetHook index 3;
exports RemoveHook index 4;
begin
M_List:=TList.Create; // Создаём список
CurrrentMSec_Pred:=GetTickCount; // Установить начальный отсчёт времени в системе
MwParam_:=0;
end.

Ваше приложение которое может записать в файл все события в вашем приложении, а потом их воспроизвести как бы в демо-режиме:

unit unitSapr;
...
type // объявление записи для всех событий в системе
//*************** Hook *******************
TMainMessage=record
Msg: word;
wParam: word;
lParam: longint;
X: Integer;
Y: Integer;
time:Cardinal;
M_Handle:HWND;
end;
PMainMessage=^TMainMessage;
//*************** Hook *******************
...
//*************** Hook *******************
Main_Message:PMainMessage; // указатель на эту запись
Button2_Prerevat:boolean;
procedure Load; // прочесть события созданные в режиме 'save' в вашем приложении из файла mainList.lrst
procedure Powtorit; // повторить события созданные в режиме 'save' в вашем приложении
//*************** Hook *******************
...
//*************** Hook *******************
TrackBar_Speed: TTrackBar;
...
private
{ Private declarations }
//*************** Hook *******************
M_List:TList; // класс для чтения событий в Load из mainList.lrst
CurrrentMSec:Cardinal;
CurrrentMSec_Pred:Cardinal;
Button2_bool:boolean;
Demo_POWTOR:boolean;
//*************** Hook *******************
...
var
FormSapr: TFormSapr;
Glob_M_Handle:HWND; // т.к. адрес Handle объектов в вашем приложении при каждом запуске разный,
// то поможем узнать что это был за объект при воспроизведении событий
// обьявление для вызова функций и процедуры из hackpass.dll
procedure RunStopHook(State:boolean) export; stdcall; external 'hackpass.dll' index 1;
function Get_List_Event:WPARAM export; stdcall; external 'hackpass.dll' index 2;
function SetHook (ANotifyHandle: DWORD ): Boolean export; stdcall; external 'hackpass.dll' index 3;
function RemoveHook: boolean export; stdcall; external 'hackpass.dll' index 4;
procedure TFormSapr.FormCreate(Sender: TObject);
begin
M_List:=TList.Create;
CurrrentMSec_Pred:=GetTickCount;
Button2_bool:=true;
Button2_Prerevat:=false;
...
// Перед воспроизводством события передаём в Powtorit Handle именно того объекта над которым двигалась мышь перед событим !!!
procedure TFormSapr.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Glob_M_Handle:=FormSapr.Handle;
end;

procedure TFormSapr.LMDSpeedButton2MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
Glob_M_Handle:=TBitBtn(sender).Handle;
end;

procedure TFormSapr.StringGrid1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
Glob_M_Handle:=StringGrid1.Handle;
end;

procedure TFormSapr.LMDCheckBox4MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
Glob_M_Handle:=LMDCheckBox4.Handle;
end;

procedure TFormSapr.LMDMaskEdit1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
Glob_M_Handle:=TLMDMaskEdit(sender).Handle;
end;

// и т.д. на всех визуальных объектах
procedure TFormSapr.Load; // читаем события в M_List из файла mainList.lrst созданного при работе вашего приложения в режиме save
var
_M_Handle: HWND;
_Msg : word;
_wParam : word;
_lParam : longint;
_X : Integer;
_Y : Integer;
_time : Cardinal;
_Name :PAnsiChar;
Stream: TFileStream;
i,PLC:integer;
FileName:string;
f:file;
_plc:integer;
S_M:STRING;
begin
if M_Listnil then
if M_List.Count>0 then
begin
for i:=0 to M_List.Count-1 do
Dispose(M_List[i]);
end;
FileName:=ExtractFilePath(ParamStr(0))+'\mainList.lrst';
try
Stream:=TFileStream.Create(FileName,fmOpenRead);
Stream.Read(plc,sizeof(plc));
plc:=Trunc(Stream.Size/24);

for i:=0 to plc-1 do
begin
New(Main_Message);
_plc:= Stream.Read(Main_Message^,sizeof(Main_Message^));
M_List.Add(Main_Message);
end;

Stream.Free;
Except
ShowMessage('Aborted'+' : '+ IntToStr(i));
end;
// if AllocMemCount 0 then
// MessageBox(0, 'An unexpected memory leak has occurred.', 'Unexpected Memory Leak', MB_OK or MB_ICONERROR or MB_TASKMODAL);

IF I=0 THEN
S_M:='Прочтено '+IntToStr(i) +' событий. Демонстрация невозможна!'
else
S_M:='Прочтено '+IntToStr(i) +' событий. Нажмите Воспроизвести сценарий!';
Panel_Flash_Stop.SetError(S_M ,cf_Message);
end;

procedure TFormSapr.Powtorit; // Запускаем режим DEMO вашего приложения. Например для решения рутинных задач.
var
i,j:integer;
_CurrrentMSec:Cardinal;
sped:integer;
begin
CurrrentMSec_Pred:=GetTickCount;
Main_Message:=M_List.Items[0];
SendMessage(Main_Message^.M_Handle,Main_Message^.Msg,Main_Message^.wParam,Main_Message^.lParam);
j:=0;
for i:=1 to M_List.Count-1 do
begin
Main_Message:=M_List.Items[i];
_CurrrentMSec:=Round(Main_Message^.time/TrackBar_Speed.Position); // так можно изменять скорость демо воспроизведения уменьшая
// искусственно промежутки между событиями см. FormKeyDown ниже
repeat
CurrrentMSec:=GetTickCount;
if (CurrrentMSec-CurrrentMSec_Pred)>=_CurrrentMSec then
begin
Button2_bool:=true;

SetCursorPos(Main_Message^.X,Main_Message^.Y); // установить указатель мыши в ту же позицию что и в режиме save

if Main_Message^.Msg = WM_MOUSEWHEEL then
begin
Glob_M_Handle:= FormSapr.Handle;
MiddleButton:=Main_Message^.wParam; // передаём в Message.WheelDelta procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
SendMessage(Glob_M_Handle,Main_Message^.Msg,Main_Message^.wParam,Main_Message^.lParam);
end
else
SendMessage(Glob_M_Handle,Main_Message^.Msg,Main_Message^.wParam,Main_Message^.lParam);

end
else
Inc(j);

Application.ProcessMessages;
until Button2_bool;

if Button2_Prerevat then
Exit;
Button2_bool:=false;

CurrrentMSec_Pred:=GetTickCount;
end;
end;

procedure TFormSapr.FormShow(Sender: TObject);
begin
//*************** Hook *******************

if ((ParamCount>0)and(paramstr(1)='save')) then // если приложение запущено в режиме записи событий
begin
RunStopHook(true); // запуск мониторов
SetHook( Self.Handle );
end;
//*************** Hook *******************
...
end;

procedure TFormSapr.FormClose(Sender: TObject; var Action: TCloseAction);

begin
if ((ParamCount>0)and(paramstr(1)='save')) then
begin
RunStopHook(false); // выключение мониторов
RemoveHook;
end;
end;


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.



:: Главная :: Мышка и Курсор ::


реклама

::


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Rambler's Top100
14.12.2018 18:23:29/0.016542911529541/0