Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: Сервис с хуком  (Прочитано 10928 раз)
0 Пользователей и 1 Гость смотрят эту тему.
NeferSky
Постоялец

ru
Offline Offline
Бессмертный


« : 06-02-2017 11:30 » 

Добрый день всем.
Собственно, а сервис может поставить хук в WinXP+? Вроде бы, обратной информации не встречалось, а не работает. В смысле, сервис запускается, все отлично. Хук в отдельном приложении ставится-работает. А вместе - не...
Записан

Не тронь налаженный механизм, и он тебя не подведет.
Делать надо хорошо, а плохо - само получится.
SCRIBE
Гость
« Ответ #1 : 06-02-2017 14:02 » 

А если хук вынести в dll?
Записан
NeferSky
Постоялец

ru
Offline Offline
Бессмертный


« Ответ #2 : 06-02-2017 14:13 » new

..::SCRIBE::.., пробовал. Прямо с msdn пример. И процедуру внутри exe тоже пробовал. Вопрос пока стоит такой: это, вообще, законно возможно? На форумах попадались намеки, что, дескать, в WinVista+ уже нельзя. Я испытываю сейчас все на WinXP и Win10 - результат одинаковый... отрицательный.

Добавлено через 8 минут и 24 секунды:
Дабы быть уверенным, что ничего не накосячено позаимствовал код у Великих  Отлично
Первый листинг - собственно, сервис. Второй - библиотека.
В сервисе реализовано два хука (в целях изучения и сравнения) - из библиотеки и не из библиотеки. Не работают оба...

Код:
unit ServiceHook;

// Сервис:
// http://www.delphikingdom.com/asp/viewitem.asp?catalogid=1348

// Хук с DLL:
// https://msdn.microsoft.com/ru-ru/library/windows/desktop/ms644960(v=vs.85).aspx

// Хук без DLL:
// http://delphimaster.net/view/4-1150801944/21

interface

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

type
  TsvcLogonScreenHook = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceExecute(Sender: TService);
    procedure ServiceShutdown(Sender: TService);
  private
    { Private declarations }
    hinstDLL: THandle;
    hhookSysMsg_DLL: HHOOK;
    hhookSysMsg_NoDLL: HHOOK;
  public
    { Public declarations }
    function GetServiceController: TServiceController; override;
  end;

  THookProc_DLL = function(nCode: Integer; W_Param: WPARAM; L_Param: LPARAM): LRESULT; stdcall;

var
  svcLogonScreenHook: TsvcLogonScreenHook;

implementation

{$R *.DFM}
   
//---------------------------------------------------------------------------

function HookProc2(nCode: Integer; w_Param: WPARAM; l_Param: LPARAM): LRESULT; stdcall;
type
  PKBDLLHookStruct = ^TKBDLLHookStruct;
  TKBDLLHookStruct = packed record
    vkCode, scanCode, flags, time: Cardinal;
    dwExtraInfo: PCardinal;
  end;

const
  MsgNames: array [0..4] of string = ('UNKNOWN', 'WM_KEYDOWN', 'WM_KEYUP', 'WM_SYSKEYDOWN', 'WM_SYSKEYUP');

var
  I: Integer;

begin
  if nCode = HC_ACTION then
  begin
    case w_Param of
      WM_KEYDOWN: I := 1;
      WM_KEYUP: I := 2;
      WM_SYSKEYDOWN: I := 3;
      WM_SYSKEYUP: I := 4;
    else
      I := 0
    end;

    with PKBDLLHookStruct(l_Param)^ do
      Application.MessageBox(PChar(Format('Message: %s  Virtual code: %d  Scan code: %d',
        [MsgNames[I], vkCode, scanCode])), '', 0);
  end;

  Result := CallNextHookEx(0, nCode, w_Param, l_Param)
end;

//---------------------------------------------------------------------------

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

//---------------------------------------------------------------------------

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

//---------------------------------------------------------------------------

procedure TsvcLogonScreenHook.ServiceStart(Sender: TService;
  var Started: Boolean);
const
  WH_KEYBOARD_LL = 13;
 
var
  hkprcSysMsg: THookProc_DLL;

begin
  Status := csStartPending;

  hinstDLL := LoadLibrary('SysMsg.dll');
  hkprcSysMsg := GetProcAddress(hinstDLL, 'KeyboardProc');
  hhookSysMsg_DLL := SetWindowsHookEx(WH_KEYBOARD_LL, @hkprcSysMsg, hinstDLL, 0);

  hhookSysMsg_NoDLL := SetWindowsHookEx(WH_KEYBOARD_LL, @HookProc2, HInstance, 0);

  Started := True;
end;

//---------------------------------------------------------------------------

procedure TsvcLogonScreenHook.ServiceStop(Sender: TService;
  var Stopped: Boolean);
begin
  UnhookWindowsHookEx(hhookSysMsg_DLL);
  UnhookWindowsHookEx(hhookSysMsg_NoDLL);
  FreeLibrary(hinstDLL);
  Stopped := True;
end;

//---------------------------------------------------------------------------

procedure TsvcLogonScreenHook.ServiceExecute(Sender: TService);
begin
  while not Terminated do
  begin
    ServiceThread.ProcessRequests(False);
    Sleep(1);
  end;
end;

//---------------------------------------------------------------------------

procedure TsvcLogonScreenHook.ServiceShutdown(Sender: TService);
begin
  UnhookWindowsHookEx(hhookSysMsg_DLL);
  UnhookWindowsHookEx(hhookSysMsg_NoDLL);
  FreeLibrary(hinstDLL);
end;

end.

Код:
library SysMsg;

uses
  SysUtils,
  Classes,
  Windows,
  Messages,
  Forms;

{$R *.res}

function KeyboardProc(nCode: Integer; W_Param: WPARAM; L_Param: LPARAM): LRESULT; export; stdcall;
var
  c: Integer;

begin
  if nCode < 0 then
  begin
    Result := CallNextHookEx(0, nCode, W_Param, L_Param);
    Exit;
  end;

  Inc(c);
  Application.MessageBox(PChar(Format('KEYBOARD - nCode: %d, vk: %d, %d times', [nCode, w_Param, c])), '');
  Result := CallNextHookEx(0, nCode, W_Param, L_Param);
end;

exports
  KeyboardProc;

begin
end.
« Последнее редактирование: 06-02-2017 14:21 от NeferSky » Записан

Не тронь налаженный механизм, и он тебя не подведет.
Делать надо хорошо, а плохо - само получится.
Ochkarik
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #3 : 06-02-2017 14:57 » 

ERROR_ACCESS_DENIED?

Добавлено через 7 минут и 55 секунд:
оно?
« Последнее редактирование: 06-02-2017 15:05 от Ochkarik » Записан

RTFM уже хоть раз наконец!  RTFM :[ ну или хотя бы STFW...
NeferSky
Постоялец

ru
Offline Offline
Бессмертный


« Ответ #4 : 07-02-2017 06:32 » 

Ochkarik, не оно.
Ошибка наблюдается при загрузке библиотеки. При не-библиотечном варианте ошибок как бы нет...

Код:
// С библиотекой
Log('Prepare: ' + IntToStr(GetLastError)); // Prepare: 0
hinstDLL := LoadLibrary(PChar(GetAppDir + 'SysMsg.dll'));
Log('LoadLibrary: ' + IntToStr(GetLastError)); // LoadLibrary: 1813
hkprcSysMsg := GetProcAddress(hinstDLL, 'KeyboardProc');
Log('GetProcAddress: ' + IntToStr(GetLastError)); // GetProcAddress: 0
hhookSysMsg_DLL := SetWindowsHookEx(WH_KEYBOARD_LL, @hkprcSysMsg, hinstDLL, 0);
Log('SetWindowsHookEx DLL: ' + IntToStr(GetLastError)); // SetWindowsHookEx DLL: 0

// Без библиотеки
hhookSysMsg_NoDLL := SetWindowsHookEx(WH_KEYBOARD_LL, @HookProc2, HInstance, 0);
Log('SetWindowsHookEx NoDLL: ' + IntToStr(GetLastError)); // SetWindowsHookEx NoDLL: 0

Добавлено через 1 час, 23 минуты и 5 секунд:
Примечательно также то, что при выносе всего этого в не-сервисный exe-шник GetLastError показывает ту же ошибку, но хуки работают.
« Последнее редактирование: 07-02-2017 07:55 от NeferSky » Записан

Не тронь налаженный механизм, и он тебя не подведет.
Делать надо хорошо, а плохо - само получится.
zubr
Гость
« Ответ #5 : 07-02-2017 09:59 » 

1. Ошибка при загрузке длл никак не связана с сервисом и хуком. Судя по коду ошибки какие то проблемы с ресурсами приаттачиваемыми в длл. Попробуй в длл закоментировать строку {$R *.res}, собрать длл и после этого загружать длл.
2. А зачем вообще делать глобальный хук через загрузку из дополнительной длл. Для глобального хука можно сам код хука сделать в длл, там же создается процедура создания хука (SetWindowsHookEx), которая вызывается уже из процесса.
3. У тебя сервис без окна и соответственно обработчика очереди сообщений Windows, естественно он не может передавать-получать хуки.
Записан
NeferSky
Постоялец

ru
Offline Offline
Бессмертный


« Ответ #6 : 07-02-2017 10:27 » 

zubr,
1) Ну, да, ERROR_RESOURCE_TYPE_NOT_FOUND - ресурсов там, и вправду, нет.
2)
Для глобального хука можно сам код хука сделать в длл, там же создается процедура создания хука (SetWindowsHookEx), которая вызывается уже из процесса.
Так а... из какого процесса? Из сервиса, если я правильно понял?
3) А. Ну, все-таки, ответ на изначальный вопрос - "не может". И, опережая свой следующий вопрос, сам себе и отвечу - надо добавить в сервис TForm. Наверное.
Записан

Не тронь налаженный механизм, и он тебя не подведет.
Делать надо хорошо, а плохо - само получится.
zubr
Гость
« Ответ #7 : 07-02-2017 12:47 » 

Цитата
Так а... из какого процесса? Из сервиса, если я правильно понял?
В общем смысле из любого, имеющего цикл обработки сообщений. В том числе и сервиса, если он имеет таковой. Сервис с окном должен быть как минимум интерактивным, но там свои заморочки, насколко я помню, особенно в системах более поздних чем хрюша.

Добавлено через 16 минут и 16 секунд:
Вообще, если задача хука - только перехватывать сообщения мыши и клавиатуры, то можно не заморачиваться с глобальным хуком, для этого есть WH_KEYBOARD_LL и WH_MOUSE_LL
« Последнее редактирование: 07-02-2017 13:03 от zubr » Записан
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines