Блокирование системных клавиш и их комбинаций

[DannerDOS]

Исходя из статьи...
Цель: Блокировка системных клавишь и их комбинаций (хорошо было бы если всех).
Из исходника по указанной ссылке получилось вот это:

library HookDLL;

uses
  Windows,
  Messages;

var
  OldWndProc: Pointer;
  ThreadID: DWORD;

const
  CtrlAltDel_CODE = (VK_DELETE shl 16) or (MOD_CONTROL or MOD_ALT);
  CtrlShiftEsc_CODE = (VK_ESCAPE shl 16) or (MOD_CONTROL or  MOD_SHIFT);

function GethWnd: HWND;
begin
  Result := FindWindow('SAS Window class', 'SAS window');
end;

function NewWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM):
  LRESULT; stdcall;
begin
  if msg = WM_HOTKEY then begin
    if (lParam = CtrlAltDel_CODE) or (lParam = CtrlShiftEsc_CODE)  then
      Result := 0
    else
      Result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
  end else
    Result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
end;

procedure SetWndProc(hWnd: HWND);
begin
  OldWndProc:= Pointer(SetWindowLong(hWnd, GWL_WNDPROC, Cardinal(@NewWndProc)));
end;

{
procedure UnSetWndProc(hWnd: HWND);
begin
  SetWindowLong(hWnd, GWL_WNDPROC, Cardinal(OldWndProc));
end;
{}

function HookThread(PARAM1: DWORD): DWORD; stdcall;
//var
  //ThrID: DWORD;
begin
  Result := 0;
  SetWndProc(GethWnd);
  //sleep(60 * 1000);
  //UnSetWndProc(GethWnd);
  //sleep(10);
  //CreateThread(nil, 0, GetProcAddress(GetModuleHandle('kernel32'),
  //  'FreeLibrary'), Pointer(hInstance), 0, ThrID);
end;

begin
  CreateThread(nil, 0, @HookThread, nil, 0, ThreadID);
end.

library UnHookDLL;

uses
  Windows,
  Messages;

var
  OldWndProc: Pointer;
  ThreadID: DWORD;

const
  CtrlAltDel_CODE = (VK_DELETE shl 16) or (MOD_CONTROL or MOD_ALT);
  CtrlShiftEsc_CODE = (VK_ESCAPE shl 16) or (MOD_CONTROL or  MOD_SHIFT);

function GethWnd: HWND;
begin
  Result := FindWindow('SAS Window class', 'SAS window');
end;

function NewWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM):
  LRESULT; stdcall;
begin
  if msg = WM_HOTKEY then begin
    if (lParam = CtrlAltDel_CODE) or (lParam = CtrlShiftEsc_CODE)  then
      Result := 0
    else
      Result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
  end else
    Result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
end;

{
procedure SetWndProc(hWnd: HWND);
begin
  OldWndProc:= Pointer(SetWindowLong(hWnd, GWL_WNDPROC, Cardinal(@NewWndProc)));
end;
{}

procedure UnSetWndProc(hWnd: HWND);
begin
  SetWindowLong(hWnd, GWL_WNDPROC, Cardinal(OldWndProc));
end;

function HookThread(PARAM1: DWORD): DWORD; stdcall;
var
  ThrID: DWORD;
begin
  Result := 0;
  //SetWndProc(GethWnd);
  //sleep(60 * 1000);
  UnSetWndProc(GethWnd);
  //sleep(10);
  CreateThread(nil, 0, GetProcAddress(GetModuleHandle('kernel32'),
    'FreeLibrary'), Pointer(hInstance), 0, ThrID);
end;

begin
  CreateThread(nil, 0, @HookThread, nil, 0, ThreadID);
end.

[DannerDOS]

Сам проект:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ProcessID: Cardinal;
  DllName, ppp: String;
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;

implementation

{$R *.dfm}

function SetDebugPriv: Boolean;
var
  Token: THandle;
  tkp: TTokenPrivileges;
begin
  Result := false;
  if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Token) then begin
    if LookupPrivilegeValue(nil, PChar('SeDebugPrivilege'), tkp.Privileges[0].Luid) then begin
      tkp.PrivilegeCount := 1;
      tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      Result := AdjustTokenPrivileges(Token, false, tkp, 0, PTokenPrivileges(nil)^, PDWord(nil)^);
    end;
  end;
end;

function Start(ProcessID: Cardinal; DllFileName: string): Boolean;
var
  hProcess, hTh: THandle;
  BytesWritten, ThreadID, DllNameLen: Cardinal;
  LoadLibraryProc, MemPtr: Pointer;
  ExitCode: DWord;
begin
  Result := false;
  SetDebugPriv();
  hProcess := OpenProcess(PROCESS_CREATE_THREAD or PROCESS_VM_OPERATION or PROCESS_VM_WRITE,true, ProcessID);
  if hProcess = 0 then exit;
  DllNameLen := Length(DllFileName) + 1;
  MemPtr := VirtualAllocEx(hProcess, nil, DllNameLen, MEM_COMMIT, PAGE_READWRITE);
  if MemPtr <> nil then begin
    if WriteProcessMemory(hProcess, MemPtr, PChar(DllFileName), DllNameLen, BytesWritten) then begin
      LoadLibraryProc := GetProcAddress(GetModuleHandle('kernel32.dll'), 'LoadLibraryA');
      hTh := CreateRemoteThread(hProcess, nil, 0, LoadLibraryProc, MemPtr, 0, ThreadID);
      if hTh <> 0 then begin
        if (WaitForSingleObject(hTh, INFINITE) = WAIT_OBJECT_0) and GetExitCodeThread(hTh, ExitCode) then
          Result := ExitCode <> 0;
        CloseHandle(hTh);
      end;
    end;
    VirtualFreeEx(hProcess, MemPtr, 0, MEM_RELEASE);
  end;
  CloseHandle(hProcess);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  ProcessID := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  while Integer(ContinueLoop) <> 0 do begin
    ppp := FProcessEntry32.szExeFile;
    if (pos('WINLOGON', UpperCase(ppp)) > 0) then  ProcessID := FProcessEntry32.th32ProcessID;
    ContinueLoop := Process32Next(FSnapshotHandle,  FProcessEntry32);
   end;
  CloseHandle(FSnapshotHandle);
  DllName := ExtractFilePath(ParamStr(0)) + 'HookDLL.dll';
  if ProcessID <> 0 then Start(ProcessID, DllName);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ProcessID := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  while Integer(ContinueLoop) <> 0 do begin
    ppp := FProcessEntry32.szExeFile;
    if (pos('WINLOGON', UpperCase(ppp)) > 0) then  ProcessID := FProcessEntry32.th32ProcessID;
    ContinueLoop := Process32Next(FSnapshotHandle,  FProcessEntry32);
   end;
  CloseHandle(FSnapshotHandle);
  DllName := ExtractFilePath(ParamStr(0)) + 'UnHookDLL.dll';
  if ProcessID <> 0 then Start(ProcessID, DllName);
end;

end.

Вопрос #1:
Программа работает только при первом тестировании, видимо нужно дллки выгружать... Как исправить?
Вопрос #2:
О каких других системных комбинация говориться в статье, и соответственно как их включить в модули?
Вопрос #3:
Видимо можно значительно сократить код, что урезать?

Автору статьи большая благодарность...

[rpy3uH]

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

О каких других системных комбинация говориться в статье, и соответственно как их включить в модули?

а какие тебе нужно заблокировать? Проверка комбинации происходит в функции NewWndProc, надо просто добавить ещё одну проверку

function NewWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM):
  LRESULT; stdcall;
begin
  if msg = WM_HOTKEY then begin
    if (lParam = CtrlAltDel_CODE) or (lParam = CtrlShiftEsc_CODE) or (lParam = <ещё одна комбинация>)  then
      Result := 0
    else
      Result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
  end else
    Result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
end;

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

Вопрос #3:
Видимо можно значительно сократить код, что урезать?

там и так ничего лишнего

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

Вопрос #1:
Программа работает только при первом тестировании, видимо нужно дллки выгружать... Как исправить?

самый главный вопрос: зачем нужна UnHookDLL?

[DannerDOS]

#1:
Мне например нужно функцию клавиши "Win", Alt+Tab, Ctrl+F4 заблокировать... Как их описать?
AltTab_CODE = (VK_ALT shl 16) or MOD_TAB;
и переменную AltTab_CODE указываем в функцию NewWndProc???
#3
UnHookDLL нужна для того что бы "разблокировать комбинации клавиш" (выгрузка модуля блокирования HookDLL), так как у вас в статье через определенное время происходила операция разблокирования а как по команде из программы (т.е. в ходе работы программы)? (поэтому я и предумал на два модуля разбить, конечно лучше было бы если все в одном и из другого процесса можно было бы контролировать процесс блокирования, разблокирования).
#2
Отсюда и вытекает что код на 40 процентов сократить можно...

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

Точно, как сделать что при вызове дллки он проверял, загружен ли он, если нет то загружался, если да то выгружался, тем самым блокировал бы и разблокировал функциональные клавиши системы...

Признаюсь, идея с двумя дллками глупа...

[rpy3uH]

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

#1:
Мне например нужно функцию клавиши "Win", Alt+Tab, Ctrl+F4 заблокировать... Как их описать?
AltTab_CODE = (VK_ALT shl 16) or MOD_TAB;
и переменную AltTab_CODE указываем в функцию NewWndProc???

надо так
AltTab_CODE = (VK_TAB shl 16) or MOD_ALT;

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

#3
UnHookDLL нужна для того что бы "разблокировать комбинации клавиш" (выгрузка модуля блокирования HookDLL), так как у вас в статье через определенное время происходила операция разблокирования а как по команде из программы (т.е. в ходе работы программы)? (поэтому я и предумал на два модуля разбить, конечно лучше было бы если все в одном и из другого процесса можно было бы контролировать процесс блокирования, разблокирования).

можно например, ожидать мьютекс (Mutex) или событие (Event), а в приложении-сервере в тот момент когда надо отключить блокировку вызвать ReleaseMutex или SetEvent

function HookThread(PARAM1: DWORD): DWORD; stdcall;
var
  ThrID: DWORD;
  H:Thandle;
begin
  Result := 0;
  SetWndProc(GethWnd);
  h:=OpenMutex(); (или OpenEvent)
  WaitForSingleObject(h,INFINITE);
  UnSetWndProc(GethWnd);
  //sleep(10);
  CreateThread(nil, 0, GetProcAddress(GetModuleHandle('kernel32'),
    'FreeLibrary'), Pointer(hInstance), 0, ThrID);
end;

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

#2
Отсюда и вытекает что код на 40 процентов сократить можно...

всё от тебя зависит

[DannerDOS]

function HookThread(PARAM1: DWORD): DWORD; stdcall;
var
  ThrID: DWORD;
  Listen: THandle;
begin
  Result := 0;
  SetWndProc(GethWnd);
  Listen := OpenEvent(EVENT_MODIFY_STATE, TRUE, <А ЗДЕСЬ ЧТО ДОЛЖНО БЫТЬ???>);
  WaitForSingleObject(Listen, INFINITE);
  UnSetWndProc(GethWnd);
  //sleep(10);
  CreateThread(nil, 0, GetProcAddress(GetModuleHandle('kernel32'),
    'FreeLibrary'), Pointer(hInstance), 0, ThrID);
end;

Так все же что лучше использовать в данном случае (что бы только серверное приложение могло получить доступ к объекту) OpenMutex или OpenEvent?***
И еще вопрос, объект зарание создать нужно (CreateEvent к примеру)?

И кстате "sleep(10);" в функции не нужен? (для чего он предназначен был, для чего пауза между разблокированием и созданием потока?).

[DannerDOS]

Сделал следующим образом:

library HookDLL;

uses
  Windows,
  Messages;

var
  OldWndProc: Pointer;
  ThreadID: DWORD;

const
  CtrlAltDel_CODE = (VK_DELETE shl 16) or (MOD_CONTROL or MOD_ALT);
  CtrlShiftEsc_CODE = (VK_ESCAPE shl 16) or (MOD_CONTROL or  MOD_SHIFT);
  CtrlAlt_CODE = (VK_TAB shl 16) or MOD_ALT;

function GethWnd: HWND;
begin
  Result := FindWindow('SAS Window class', 'SAS window');
end;

function NewWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM):
  LRESULT; stdcall;
begin
  if msg = WM_HOTKEY then begin
    if (lParam = CtrlAltDel_CODE) or (lParam = CtrlShiftEsc_CODE) or (lParam = CtrlAlt_CODE)  then
      Result := 0
    else
      Result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
  end else
    Result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
end;

procedure SetWndProc(hWnd: HWND);
begin
  OldWndProc:= Pointer(SetWindowLong(hWnd, GWL_WNDPROC, Cardinal(@NewWndProc)));
end;

procedure UnSetWndProc(hWnd: HWND);
begin
  SetWindowLong(hWnd, GWL_WNDPROC, Cardinal(OldWndProc));
end;

function HookThread(PARAM1: DWORD): DWORD; stdcall;
var
  ThrID: DWORD;
  Listen: THandle;
begin
  Result := 0;
  SetWndProc(GethWnd);
  Listen := OpenEvent(EVENT_MODIFY_STATE, TRUE, 'HookListenDLL');
  WaitForSingleObject(Listen, INFINITE);
  UnSetWndProc(GethWnd);
  CreateThread(nil, 0, GetProcAddress(GetModuleHandle('kernel32'),
    'FreeLibrary'), Pointer(hInstance), 0, ThrID);
end;

begin
  CreateThread(nil, 0, @HookThread, nil, 0, ThreadID);
end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Listen: THandle;
  ProcessID: Cardinal;
  DllName, ppp: String;
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;

implementation

{$R *.dfm}

function SetDebugPriv: Boolean;
var
  Token: THandle;
  tkp: TTokenPrivileges;
begin
  Result := false;
  if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Token) then begin
    if LookupPrivilegeValue(nil, PChar('SeDebugPrivilege'), tkp.Privileges[0].Luid) then begin
      tkp.PrivilegeCount := 1;
      tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      Result := AdjustTokenPrivileges(Token, false, tkp, 0, PTokenPrivileges(nil)^, PDWord(nil)^);
    end;
  end;
end;

function Start(ProcessID: Cardinal; DllFileName: string): Boolean;
var
  hProcess, hTh: THandle;
  BytesWritten, ThreadID, DllNameLen: Cardinal;
  LoadLibraryProc, MemPtr: Pointer;
  ExitCode: DWord;
begin
  Result := false;
  SetDebugPriv();
  hProcess := OpenProcess(PROCESS_CREATE_THREAD or PROCESS_VM_OPERATION or PROCESS_VM_WRITE,true, ProcessID);
  if hProcess = 0 then exit;
  DllNameLen := Length(DllFileName) + 1;
  MemPtr := VirtualAllocEx(hProcess, nil, DllNameLen, MEM_COMMIT, PAGE_READWRITE);
  if MemPtr <> nil then begin
    if WriteProcessMemory(hProcess, MemPtr, PChar(DllFileName), DllNameLen, BytesWritten) then begin
      LoadLibraryProc := GetProcAddress(GetModuleHandle('kernel32.dll'), 'LoadLibraryA');
      hTh := CreateRemoteThread(hProcess, nil, 0, LoadLibraryProc, MemPtr, 0, ThreadID);
      if hTh <> 0 then begin
        if (WaitForSingleObject(hTh, INFINITE) = WAIT_OBJECT_0) and GetExitCodeThread(hTh, ExitCode) then
          Result := ExitCode <> 0;
        CloseHandle(hTh);
      end;
    end;
    VirtualFreeEx(hProcess, MemPtr, 0, MEM_RELEASE);
  end;
  CloseHandle(hProcess);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  Listen := CreateEvent(NIL, TRUE, FALSE, 'HookListenDLL');
  if not Listen = NULL then begin
    ProcessID := 0;
    FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
    ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
    while Integer(ContinueLoop) <> 0 do begin
      ppp := FProcessEntry32.szExeFile;
      if (pos('WINLOGON', UpperCase(ppp))>0) then  ProcessID := FProcessEntry32.th32ProcessID;
      ContinueLoop := Process32Next(FSnapshotHandle,  FProcessEntry32);
    end;
    CloseHandle(FSnapshotHandle);
    DllName:=ExtractFilePath(ParamStr(0)) + 'HookDLL.dll';
    if ProcessID <> 0 then Start(ProcessID, DllName)
  end else exit;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if not SetEvent(Listen) then
    ResetEvent(Listen);
end;

end.

[DannerDOS]

Разобрался! Спасибо вам большое за ваш код, вы настоящий хакер!
Теперь осталось разобраться в самом механизме, которым блокируються функции системных вызавов, и еще какие можно заблокировать? (мне бы еще Win, CtrlF4, AltTab...)

Вот проект:

[rpy3uH]

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

Теперь осталось разобраться в самом механизме, которым блокируються функции системных вызавов

в статье всё написано, чего непонятного?

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

и еще какие можно заблокировать? (мне бы еще Win, CtrlF4, AltTab...)

просто добавь ещё проверки в функцию NewWndProc

[DannerDOS]

просто добавь ещё проверки в функцию NewWndProc

Непонял, какие проверки?
Сам механизм указание горячих клавишь ясен.
Только что то не выходит:

library HookDLL;

uses
  Windows, Messages;

var
  OldWndProc: Pointer;
  ThreadID: DWORD;

const
  CtrlAltDel_CODE = (VK_DELETE shl 16) or (MOD_CONTROL or MOD_ALT);
  CtrlShiftEsc_CODE = (VK_ESCAPE shl 16) or (MOD_CONTROL or  MOD_SHIFT);
  CtrlEscape_CODE = (VK_ESCAPE shl 16) or MOD_CONTROL;

function GethWnd: HWND;
begin
  Result := FindWindow('SAS Window class', 'SAS window');
end;

function NewWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM):
  LRESULT; stdcall;
begin
  if msg = WM_HOTKEY then begin
    if (lParam = CtrlAltDel_CODE) or (lParam = CtrlShiftEsc_CODE)
      or (lParam = CtrlEscape_CODE) then
      Result := 0
    else
      Result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
  end else
    Result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
end;

procedure SetWndProc(hWnd: HWND);
begin
  OldWndProc:= Pointer(SetWindowLong(hWnd, GWL_WNDPROC, Cardinal(@NewWndProc)));
end;

procedure UnSetWndProc(hWnd: HWND);
begin
  SetWindowLong(hWnd, GWL_WNDPROC, Cardinal(OldWndProc));
end;

function HookThread(PARAM1: DWORD): DWORD; stdcall;
var
  ThrID: DWORD;
  Listen: THandle;
begin
  Result := 0;
  SetWndProc(GethWnd);
  Listen := OpenEvent(EVENT_ALL_ACCESS, TRUE,
    'HookListenDLL');
  WaitForSingleObject(Listen, INFINITE);
  UnSetWndProc(GethWnd);
  CreateThread(nil, 0, GetProcAddress(GetModuleHandle('kernel32'),
    'FreeLibrary'), Pointer(hInstance), 0, ThrID);
end;

begin
  CreateThread(nil, 0, @HookThread, nil, 0, ThreadID);
end.