..::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.
