[sofrinov]

Привет! Помогите пожалуйста, надо сделать хук на запуск процессов без dll и желательно кто умеет с помощью jcl. я вот такой пользую (он сволочь не все процессы ловит):

Код:

procedure TForm1.WndProc(var Msg: TMessage);
var
I:INTEGER; I1:INTEGER;
I2:INTEGER; I3:INTEGER;
I4:INTEGER; I5:INTEGER;
I6:INTEGER; f: TextFile;
fName: String; buf: String;
begin
  inherited;
  if (Msg.Msg = MHSHELL_WINDOWCREATED) then
  begin
  try
  if ch1.Checked = true then
  begin
  if chm.Checked = true then
  begin
      opvir.Clear;
      all.Items.Add('+');
      fName := GetWndExePath(Msg.LParam);
      AssignFile(f, fName);
      {$I-}
      Reset(f);  // открыть для чтения
      {$I+}
  if IOResult <> 0 then
  begin
       da1.MessageText:= 'Не удалось проверить объект: '#13#10+GetWndExePath(Msg.LParam)+#13#10'Объект заблокирован!';
       da1.Execute;
       non.Items.Add(GetWndExePath(Msg.LParam));
       procs32.KillProcess(ExtractFileName(GetWndExePath(Msg.LParam)));
       exit;
  end;
  while not EOF(f) do
  begin
        readln(f, buf);       // прочитать строку из файла
        opvir.Lines.Add(buf); // добавить строку в поле Memo1
  end;
      CloseFile(f); // закрыть файл
  FOR I:= 5 TO v1.Lines.Count-2 DO
  BEGIN
  IF opvir.Lines.Strings[0] = v1.Lines.Strings[i] THEN
  BEGIN
        viruss.Items.Add(GetWndExePath(Msg.LParam));
        procs32.KillProcess(ExtractFileName(GetWndExePath(Msg.LParam)));
  END;
  END;
  FOR I1:= 0 TO v2.Lines.Count-2 DO
  BEGIN
  IF opvir.Lines.Strings[1] = v2.Lines.Strings[I1] THEN
  BEGIN
        viruss.Items.Add(GetWndExePath(Msg.LParam));
        procs32.KillProcess(ExtractFileName(GetWndExePath(Msg.LParam)));
  END;
  END;
  FOR I2:= 0 TO v3.Lines.Count-2 DO
  BEGIN
  IF opvir.Lines.Strings[2] = v3.Lines.Strings[I2] THEN
  BEGIN
        viruss.Items.Add(GetWndExePath(Msg.LParam));
        procs32.KillProcess(ExtractFileName(GetWndExePath(Msg.LParam)));
  END;
  END;
  FOR I3:= 0 TO v4.Lines.Count-2 DO
  BEGIN
  IF opvir.Lines.Strings[3] = v4.Lines.Strings[I3] THEN
  BEGIN
        viruss.Items.Add(GetWndExePath(Msg.LParam));
        procs32.KillProcess(ExtractFileName(GetWndExePath(Msg.LParam)));
  end;
  end;
  for I4:= 0 TO v5.Lines.Count-2 do
  begin
  if opvir.Lines.Strings[4] = v5.Lines.Strings[I4] then
  begin
        viruss.Items.Add(GetWndExePath(Msg.LParam));
        procs32.KillProcess(ExtractFileName(GetWndExePath(Msg.LParam)));
  end;
  end;
  for I5:= 0 TO v6.Lines.Count-2 do
  begin
  if opvir.Lines.Strings[5] = v6.Lines.Strings[I5] then
  begin
        viruss.Items.Add(GetWndExePath(Msg.LParam));
        procs32.KillProcess(ExtractFileName(GetWndExePath(Msg.LParam)));
  end;
  end;
  for I6:= 0 TO v7.Lines.Count-2 do
  begin
  if opvir.Lines.Strings[6] = v7.Lines.Strings[I6] then
  begin
        viruss.Items.Add(GetWndExePath(Msg.LParam));
        procs32.KillProcess(ExtractFileName(GetWndExePath(Msg.LParam)));
  end;
  end;
  if viruss.Items.Strings[viruss.Count-1] = viruss.Items.Strings[viruss.Count-2] then
  begin
    viruss.Items.Delete(viruss.Count-1);
  end;
  if viruss.Items.Strings[0] = '' then
  begin
  viruss.Items.Delete(0);
  end;
  end;
  end;except
end;
end;
end;

dll :

library SHELLHook;

uses
  SysUtils,
  Classes,
  Windows;

const
  MMFName: PChar = 'MMF';

type
  PGlobalDLLData = ^TGlobalDLLData;
  TGlobalDLLData = packed record
    HookWnd: HWND;
    Wnd: HWND;
  end;

var
  GlobalData: PGlobalDLLData;
  MMFHandle: THandle;
  MHSHELL_WINDOWACTIVATED: Cardinal;
  MHSHELL_WINDOWCREATED: Cardinal;
  MHSHELL_WINDOWDESTROYED: Cardinal;

function ShellProc(Code: Integer; wParam: DWORD; lParam: DWORD): Longint; stdcall;
begin
  Result:= CallNextHookEx(GlobalData.HookWnd, Code, wParam, lParam);
  if (Code = HSHELL_WINDOWACTIVATED) then
    SendMessage(GlobalData.Wnd, MHSHELL_WINDOWACTIVATED, 0, Integer(wParam));
  if (Code = HSHELL_WINDOWCREATED) then
    SendMessage(GlobalData.Wnd, MHSHELL_WINDOWCREATED, 0, Integer(wParam));
  if (Code = HSHELL_WINDOWDESTROYED) then
    SendMessage(GlobalData.Wnd, MHSHELL_WINDOWDESTROYED, 0, Integer(wParam));
end;

function StartMouseHook(State: Boolean; Wnd: HWND): Boolean; export; stdcall;
begin
  Result:= False;
  if State = True then
  begin
    GlobalData^.HookWnd:= SetWindowsHookEx(WH_SHELL, @ShellProc, hInstance, 0);
    GlobalData^.Wnd:= Wnd;
    if GlobalData^.HookWnd <> 0 then
      Result:= True;
  end
  else
  begin
    UnhookWindowsHookEx(GlobalData^.HookWnd);
    Result:= False;
  end;
end;

function StopMouseHook(): Boolean; export; stdcall;
begin
  UnhookWindowsHookEx(GlobalData^.HookWnd);
  if GlobalData^.HookWnd = 0 then
    Result:= False
  else
    Result:= True;
end;

procedure OpenGlobalData();
begin
  MHSHELL_WINDOWACTIVATED:= RegisterWindowMessage('MHSHELL_WINDOWACTIVATED');
  MHSHELL_WINDOWCREATED:= RegisterWindowMessage('MHSHELL_WINDOWCREATED');
  MHSHELL_WINDOWDESTROYED:= RegisterWindowMessage('MHSHELL_WINDOWDESTROYED');

  MMFHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TGlobalDLLData), MMFName);
  GlobalData:= MapViewOfFile(MMFHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TGlobalDLLData));
  if GlobalData = nil then
    CloseHandle(MMFHandle);
end;

procedure CloseGlobalData();
begin
  UnmapViewOfFile(GlobalData);
  CloseHandle(MMFHandle);
end;

procedure DLLEntryPoint(Reason: DWORD);
begin
  case Reason of
    DLL_PROCESS_ATTACH: OpenGlobalData;
    DLL_PROCESS_DETACH: CloseGlobalData;
  end;
end;

exports StartMouseHook, StopMouseHook;
begin
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

Admin: Пользуемся тегами, иначе последуют санкции!

[vinni]

> надо сделать хук на запуск процессов без dll
Хуки могут располагаться ТОЛЬКО в dll

[Ferra]

Я конечно извиняюсь, может и я чего-то не знаю, но кто тебе сказал что ловушки (aslo known as hooks) можно ставить только в dll?

[Karsh]

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

Я конечно извиняюсь, может и я чего-то не знаю, но кто тебе сказал что ловушки (aslo known as hooks) можно ставить только в dll?

А вы встречали рабочие хуки не длл?

[Ferra]

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

Вот держи, ~10 строк кода, думаю тут всё понятно будет.. Ну и?

[Ferra]

Хотелось бы ещё добавить что это очень кривая реализация. Например там нежелательно пользоваться CallNextHookEx как это делал я. Иногда может выключать чужие приложения, иногда может этого и не делать. Усовершенствуй код - получишь то что спрашиваешь, я лишь показываю что такое реально.

[Karsh]

Ferra, странно, но у меня твоя программа не работает. Она ловит нажатие клавиш только если ее окно активно, а если я нажимаю клавиши, скажем в блокноте, то прога ничего не ловит.

[Ferra]

Попробуй вставить в конце модуля

Код:

exports MsgProc;

Но я не уверен. Не знаю как убедить, но у меня ловит. С проблемами и иногда, но ловит.

Не стану спорить что много писанины про то что делать так нельзя(!) В MSDN именно так написано, но я специально для тебя постараюсь и найду приложение (видел я, видел ) которое работало без длл.

[Ferra]

Видоизменил

Код:

function MsgProc(Code: integer; wParam: Word; lParam: Longint): Longint; stdcall;
var
 c   : char;
 f   : text;
 key : array [0..16] of Char;
begin
Showmessage('HELLO FROM MY EXE HOOK');
 if (Code=HC_ACTION) and (((lParam shr 16) and KF_UP)=0) then
   begin
   Assign(f,'D:\log.txt');
    if FileExists('D:\log.txt') then Append(f) else Rewrite(f);
   GetKeyNameText(lParam,key,SizeOf(key));
   Writeln(f,key);
   CloseFile(f);
   //result:=CallNextHookEx(myHook,Code,wParam,lParam);
   end;
result:=CallNextHookEx(myHook,Code,wParam,lParam);
end;

Работает. Но очень нехорошо - приложение в котором нажата клавиша (кроме нашего) - уходит по английски. Выкидывает его.

Я пока что не знаю причину столь странного поведения, надо будет почитать, поискать как это обойти. Ошибка возникает при CallNextHookEx - это очевидно. Как обойти - это уже отдельный вопрос, если он столь остро стоит, могу поискать. Засим откланюсь, думаю тема исчерпана.

[Aristarh Dark]

Господа...!
Да не может не dll'ный хук ловить события системы. Не бывает так. Почитайте литературу сами или я, блин, вам примеры приведу как это работает.

[Ferra]

Да, я видел что написано в литературе. и в MSDN тоже.
Ну что поделать если данный пример ловит . Выдаёт сообщение что ловушка получила сообщение. Всё остальное читай выше.

PS> для особо недоверчивых могу выложить видюшку, продемонстрирую что код тот же и что при нажатии клавиши в "чужом приложении" - данный пример выводит сообщение, а "чужое приложение" вылетает.