روش کار با KBDHook.dll

[Mahdi_S_T]

دوستان کسی روش کار با KBDHook.dll رو بلده

[vesal]

باید یه DLL درست کنی که کدش اینه


library HookTeclado;

{
Demo de Hook de teclado a nivel de sistema, Radikal.
Como lo que queremos es capturar las teclas pulsadas en cualquier parte
de Windows, necesitamos instalar la funcion CallBack a la que llamar?
el Hook en una DLL, que es ésta misma.
}

uses
Windows,
Messages;

const
CM_MANDA_TECLA = WM_USER + $1000;

var
HookDeTeclado : HHook;
FicheroM : THandle;
PReceptor : ^Integer;

function CallBackDelHook( Code : Integer;
wParam : WPARAM;
lParam : LPARAM
) : LRESULT; stdcall;

{Esta es la funcion CallBack a la cual llamar? el hook.}
{This is the CallBack function called by he Hook}
begin
{Si una tecla fue pulsada o liberada}
{if a key was pressed/released}
if code=HC_ACTION then
begin
{Miramos si existe el fichero}
{if the mapfile exists}
FicheroM:=OpenFileMapping(FILE_MAP_READ,False,'ElR eceptor');
{Si no existe, no enviamos nada a la aplicacion receptora}
{If dont, send nothing to receiver application}
if FicheroM<>0 then
begin
PReceptor:=MapViewOfFile(FicheroM,FILE_MAP_READ,0, 0,0);
PostMessage(PReceptor^,CM_MANDA_TECLA,wParam,lPara m);
UnmapViewOfFile(PReceptor);
CloseHandle(FicheroM);
end;
end;
{Llamamos al siguiente hook de teclado de la cadena}
{call to next hook of the chain}
Result := CallNextHookEx(HookDeTeclado, Code, wParam, lParam)
end;

procedure HookOn; stdcall;
{Procedure que instala el hook}
{procedure for install the hook}
begin
HookDeTeclado:=SetWindowsHookEx(WH_KEYBOARD, @CallBackDelHook, HInstance , 0);
end;

procedure HookOff; stdcall;
begin
{procedure para desinstalar el hook}
{procedure to uninstall the hook}
UnhookWindowsHookEx(HookDeTeclado);
end;

exports
{Exportamos las procedures...}
{Export the procedures}
HookOn,
HookOff;

begin
end.




بعدش که DLL رو کامپایل کردی از این کد تو برنامت استفاده می کنی که البته من سورس کامل برنامه نمونه برات میزارم



unit Hook;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

const
NombreDLL = 'HookTeclado.dll';
CM_MANDA_TECLA = WM_USER + $1000;


type
THookTeclado=procedure; stdcall;


type
TForm1 = class(TForm)
Memo1: TMemo;
Label1: TLabel;
Memo2: TMemo;
Edit1: TEdit;
Edit2: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
Count :Integer;
FicheroM : THandle;
PReceptor : ^Integer;
HandleDLL : THandle;
HookOn,
HookOff : THookTeclado;
procedure LlegaDelHook(var message: TMessage); message CM_MANDA_TECLA;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
{No queremos que el Memo maneje el teclado...}
{We dont want that the memo read the keyboard...}
Count:=0;
Memo1.ReadOnly:=TRUE;

HandleDLL:=LoadLibrary( PChar(ExtractFilePath(Application.Exename)+
NombreDLL ) );
if HandleDLL = 0 then raise Exception.Create('No se pudo cargar la DLL');

@HookOn :=GetProcAddress(HandleDLL, 'HookOn');
@HookOff:=GetProcAddress(HandleDLL, 'HookOff');

IF not assigned(HookOn) or
not assigned(HookOff) then
raise Exception.Create('No se encontraron las funciones en la DLL'+#13+
'Cannot find the required DLL functions');

{Creamos el fichero de memoria}
FicheroM:=CreateFileMapping( $FFFFFFFF,
nil,
PAGE_READWRITE,
0,
SizeOf(Integer),
'ElReceptor');

{Si no se cre? el fichero, error}
if FicheroM=0 then
raise Exception.Create( 'Error al crear el fichero'+
'/Error while create file');

{Direccionamos nuestra estructura al fichero de memoria}
PReceptor:=MapViewOfFile(FicheroM,FILE_MAP_WRITE,0 ,0,0);

{Escribimos datos en el fichero de memoria}
PReceptor^:=Handle;
HookOn;

end;

procedure TForm1.LlegaDelHook(var message: TMessage);
var
NombreTecla : array[0..100] of char;
Accion : string;
begin
// If Count > 5 Then
// Exit;
Edit1.Text:=IntToStr(message.WParam);
Edit2.Text:=IntToStr(message.lParam);
{Traducimos de Virtual key Code a TEXTO}
{Virtual key code to Key Name}
GetKeyNameText(Message.LParam,@NombreTecla,100);
{Miramos si la tecla fué pulsada, soltada o repetida}
{Look if the key was pressed, released o re-pressed}
if ((Message.lParam shr 31) and 1)=1
then Accion:='Soltada' {Released}
else
if ((Message.lParam shr 30) and 1)=1
then Accion:='Repetida' {repressed}
else Accion:='Pulsada'; {pressed}

Memo1.Lines.Append( Accion+
' tecla: '+
String(NombreTecla) );
//------------------------------------------------------------------------------

//Musa Expreess
//VESAL Agar Dast Be Source Zadi Camputeret Monfager Mishe

If message.WParam = 65 Then
// If ((Message.lParam shr 31) and 1)=1 Then
begin
keybd_event(VK_BACK,0,0,0);
keybd_event(VK_BACK,0,KEYEVENTF_KEYUP,0);
//------------------------
keybd_event(66,0,0,0);
keybd_event(66,0,KEYEVENTF_KEYUP,0);
End;
//------------------------------------------------------------------------------

// PostMessage(Handle,Ms.Msg,Ms.WParam,Ms.LParam);
//------------------------------------------------------------------------------
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
{Desactivamos el Hook}
{Uninstall the Hook}
if Assigned(HookOff) then HookOff;

{Liberamos la DLL}
{Free the DLL}
if HandleDLL<>0 then
FreeLibrary(HandleDLL);

{Cerramos la vista del fichero y el fichero}
{Close the memfile and the View}
if FicheroM<>0 then
begin
UnmapViewOfFile(PReceptor);
CloseHandle(FicheroM);
end;

End;


procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Memo2.Lines.Add(IntToStr(Key));
end;

end.



و این هم محتویات فرم



object Form1: TForm1
Left = 546
Top = 514
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
KeyPreview = True
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyDown = FormKeyDown
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
Top = 232
Width = 32
Height = 13
Caption = 'Label1'
end
object Memo1: TMemo
Left = 0
Top = 0
Width = 289
Height = 225
Lines.Strings = (
'Memo1')
TabOrder = 0
end
object Memo2: TMemo
Left = 312
Top = 0
Width = 289
Height = 225
Lines.Strings = (
'Memo1')
TabOrder = 1
end
object Edit1: TEdit
Left = 128
Top = 280
Width = 121
Height = 21
TabOrder = 2
Text = 'Edit1'
end
object Edit2: TEdit
Left = 128
Top = 312
Width = 121
Height = 21
TabOrder = 3
Text = 'Edit2'
end
end

[Mahdi_S_T]

آقا vesal گل کاشتی !؟
خیلی ممنون . میرم تست کنم .

[Mahdi_S_T]

دوست من اگه امکان داره سورس اون رو به صورت برنامه کامل آپلود کن . ممنونم

[vesal]

دوست من اگه امکان داره سورس اون رو به صورت برنامه کامل آپلود کن . ممنونم

اگه حوصله Upload کرن داشتم حتما این کار رو میکردم. ولی اگه مشکلی داری من یه توضیح کوچیک میدم.
یک پروژه جدید بساز و روی فرم راست کلیک کن و گزینه View az text رو بزن و اون کدهایی رو که با عنوان کدهای فرم گذاشتم اینجا Paste کن.
بعدش کدهای یونیت رو هم یکجا تو یونیت Paste کن همین.

[SoftDevCo]

میبینم که عین خودم عاشقه Copy و Paste هستی.

[vesal]

میبینم که عین خودم عاشقه Copy و Paste هستی.

Copy و Paste آره ولی پست الکی دادن نه

[Mahdi_S_T]

آقا vesal ممنون
میشه در مورد این مثال من را راهنمایی کنی :

من میخوام مثلا در word وقتی کاربر حرف A رو فشار داد حرف B تایپ بشه یا برای فارسی وقتی حرف "ب" فشار داده بشه حرف "ت" تایپ بشه .
حالا چطور اینکارو انجام بدم ؟

[vesal]

آقا vesal ممنون
میشه در مورد این مثال من را راهنمایی کنی :

من میخوام مثلا در word وقتی کاربر حرف A رو فشار داد حرف B تایپ بشه یا برای فارسی وقتی حرف "ب" فشار داده بشه حرف "ت" تایپ بشه .
حالا چطور اینکارو انجام بدم ؟

راستش من تو این هفته خیلی سرم شلوغه ولی در اولین فرصت برات سورس کدی رو که لازم داری میزارم

[Mahdi_S_T]

پس منتظر می مونم یادت نشه .

[Mahdi_S_T]

vesal عزیز من همچنان منتظرم .

[vesal]

سلام.
آقا مهدی شرمنده. همونطور که گفتم سرم وحشتناک شلوغ بود. روی تمام کارهام ایجاد یک وب سایت جدید تخصصی دلفی هم اضافه شد که الحمدلله نسبتا تموم شد. به هر حال اینم اون کدی که قولش رو داده بودم

این کد DLL






library TheHook;

uses
Windows,
Messages,
SysUtils,
Dialogs;

var
TheHookHandle : HHOOK;

function TheHookProc(Code : integer; wParam : DWORD; lParam : DWORD): longint; stdcall;
begin
result := 0;
if (Code = HC_ACTION) then begin
if (tagMSG(Ptr(lParam)^).Message = WM_KEYUP) or (tagMSG(Ptr(lParam)^).Message = WM_KEYDOWN) then begin
// change 'A' to 'B' system wide
if tagMSG(Ptr(lParam)^).wParam = 65 then begin
tagMSG(Ptr(lParam)^).wParam := 66;
end;
end;
end;
// Call the next hook in the hook chain
if (Code < 0) then
result := CallNextHookEx(TheHookHandle, Code, wParam, lParam);
end;

procedure StartTheHook; stdcall;
begin
if (TheHookHandle = 0) then begin
TheHookHandle := SetWindowsHookEx(WH_GETMESSAGE, @TheHookProc, hInstance, 0);
end;
end;

procedure StopTheHook; stdcall;
begin
if (TheHookHandle <> 0) then begin
{Remove our hook and clear our hook handle}
if (UnhookWindowsHookEx(TheHookHandle) <> FALSE) then begin
TheHookHandle := 0;
end;
end;
end;



اینک کد فرم اصلی برنامه




type
TForm1 = class(TForm)
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

// Functions prototypes for the hook dll
type
TStartTheHook = procedure; stdcall;
TStopTheHook = procedure; stdcall;

var
hHookLib : THANDLE; // A handle to the hook dll
StartTheHook : TStartTheHook; // Function pointer
StopTheHook : TStopTheHook; // Function pointer
LibLoadSuccess : boolean; // If the hook lib was successfully loaded

procedure TForm1.FormActivate(Sender: TObject);
begin
LibLoadSuccess := false;
@StartTheHook := nil;
@StopTheHook:= nil;
{Try to load the hook dll}
hHookLib := LoadLibrary('THEHOOK.DLL');
{ If the hook dll was loaded successfully}
if hHookLib <> 0 then begin
{Get the function addresses}
@StartTheHook := GetProcAddress(hHookLib, 'StartTheHook');
@StopTheHook := GetProcAddress(hHookLib, 'StopTheHook');
{Did we find all the functions we need?}
if ((@StartTheHook <> nil) and (@StopTheHook <> nil)) then begin
LibLoadSuccess := true;
{Start the app and the hook}
StartTheHook;
end else begin
{We failed to find all the functions we need}
FreeLibrary(hHookLib);
hHookLib := 0;
@StartTheHook := nil;
@StopTheHook := nil;
end;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Did we load the dll successfully?
if (LibLoadSuccess = TRUE) then begin
StopTheHook;
// Free the hook dll
FreeLibrary(hHookLib);
end;
end;

[Mahdi_S_T]

دوست من متاسفانه برنامه جواب نمیده !