Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Los mejores trucos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 11-04-2014
Avatar de ElKurgan
[ElKurgan] ElKurgan is offline
Miembro Premium
 
Registrado: nov 2005
Posts: 1.235
Poder: 20
ElKurgan Va camino a la fama
Thumbs up

Gracias por el aporte
Responder Con Cita
  #2  
Antiguo 11-04-2014
Avatar de Neftali [Germán.Estévez]
Neftali [Germán.Estévez] Neftali [Germán.Estévez] is offline
[becario]
 
Registrado: jul 2004
Ubicación: Barcelona - España
Posts: 18.286
Poder: 10
Neftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en bruto
Buen aporte.
Gracias.
__________________
Germán Estévez => Web/Blog
Guía de estilo, Guía alternativa
Utiliza TAG's en tus mensajes.
Contactar con el Clubdelphi

P.D: Más tiempo dedicado a la pregunta=Mejores respuestas.
Responder Con Cita
  #3  
Antiguo 11-04-2014
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.044
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Responder Con Cita
  #4  
Antiguo 11-04-2014
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Poder: 36
ecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to behold
Hola FENIXadr.

Lo mismo digo, interesante aporte

Saludos
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....
Responder Con Cita
  #5  
Antiguo 30-04-2015
Luciano_f Luciano_f is offline
Registrado
NULL
 
Registrado: abr 2015
Posts: 2
Poder: 0
Luciano_f Va por buen camino
En primer lugar agradezco al colega "FENIXadr"
la excelente código.

* Hizo algunas alerações como está con problema caracteres japonês.

* que sigue a continuación.

Código Delphi [-]
library Hook;

uses
  Messages,
  Dialogs,
  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[1..10] of AnsiChar; // Trocado para não pegar Caracter Japonês
   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  // Aqui eu troquei <> 0  por = 0  para a Hook poder pegar o antes da Aplicação  "Before KeyDown"

    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[1], 0);
    ToAscii(VirtualKey, KeyStroke, KeyState1, @AryChar[1], 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[1] of
              ' ' : AryChar[1] := '´';
              'a' : AryChar[1] := 'á';
              'e' : AryChar[1] := 'é';
              'i' : AryChar[1] := 'í';
              'o' : AryChar[1] := 'ó';
              'u' : AryChar[1] := 'ú';

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

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

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

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

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

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

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

          end;          
          PostMessage(pFHandle^, KeyMsg, Ord(AryChar[1]), KeyStroke);
        end;
      2 :
        begin
          case AryChar[1] 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.
Responder Con Cita
  #6  
Antiguo 30-04-2015
Luciano_f Luciano_f is offline
Registrado
NULL
 
Registrado: abr 2015
Posts: 2
Poder: 0
Luciano_f Va por buen camino
Personalmente me hice más cambios en el código.

Ahora código consgue llegar precionar la tecla de repetición y mantenga.

Hay distinción entre KeyDown y KeyUp

siguiente


Código Delphi [-]
library HookTeclado;

uses
  Messages,
  Dialogs,
  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[1..10] of AnsiChar; // Trocado para não pegar Caracter Japonês
   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 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[1], 0);
    ToAscii(VirtualKey, KeyStroke, KeyState1, @AryChar[1], 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[1] of
              ' ' : AryChar[1] := '´';
              'a' : AryChar[1] := 'á';
              'e' : AryChar[1] := 'é';
              'i' : AryChar[1] := 'í';
              'o' : AryChar[1] := 'ó';
              'u' : AryChar[1] := 'ú';

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

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

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

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

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

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

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

          end;          

          SendMessage(pFHandle^, KeyMsg, Ord(AryChar[1]), KeyStroke); // Aqui foi trocado PostMessage por SendMessage para executar Antes da Aplicação
        end;
      2 :
        begin
          case AryChar[1] 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;




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.


Aplication Delphi

Código Delphi [-]
procedure TForm1.HookMsgKey(var Msg1: TMessage);
Var Acao : String;
begin
 if ((Msg1.lParam shr 31) and 1) = 1 then Begin
  Acao := 'Soltou';
 End else
 if ((Msg1.lParam shr 30) and 1) = 1 Then Begin
  Acao := 'Repetindo';
 End else Begin
  Acao := 'Precionou';
 End;

 Memo1.lines.Add(Acao + '      ' + Char(Msg1.wParam));

end;
Responder Con Cita
  #7  
Antiguo 26-12-2017
breadagast breadagast is offline
Miembro
 
Registrado: nov 2006
Posts: 10
Poder: 0
breadagast Va por buen camino
No consigo capturar las teclas de Función

Hola a todos, el código está genial pero no consigo capturar las teclas de Función F1, F2, F3, etc. Sabéis alguno porque??
Responder Con Cita
Respuesta



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 01:02:06
keylogger en delphi cmm07 Varios 2 10-04-2009 02:33:11
Haciendo mi propio keylogger jorgegetafe Varios 7 06-11-2007 01:44:23
Construir un KEYLOGGER SPARROW Varios 3 18-02-2004 14:27:00


La franja horaria es GMT +2. Ahora son las 12:28:37.


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