Перехват PrintScreen

[^D^ima]

В целях повышения безопасности организации родилась идею сделать логгер клавиши printScreen.

Какой самый просто способ перехвата? Уверен есть уже готовы код. Кто-то может показать пример?

[Руслан]

Цитата ^D^ima @ 14.02.18, 10:23

логгер клавиши printScreen

коду больше десятка лет, но только что проверил, под семеркой нормально ловит кнопки:
dll:

library KeyboardHookDll;
 
uses
  SysUtils,
  Messages,
  Classes,
  Windows;
 
type
  PGlobalDLLData = ^TGlobalDLLData;
  TGlobalDLLData = packed record
    Wnd:          HWND;     // Установившая программа
    HKeyHook:     hHook;    // Handle установленой ловушки
    WMKeyHookID:      Integer;  // ID WinMessage (для Send\Post Message)
  end;
 
var
  GlobalData: PGlobalDLLData=nil;
  FMHandle: THandle=0;
 
const FMName: PChar='HookKeyboardDll__001';
 
 
 
{$R *.res}
 
 
 
procedure OpenGlobalData;
begin
  FMHandle:=CreateFileMapping
      (
      INVALID_HANDLE_VALUE,
      nil,
      PAGE_READWRITE,
      0,
      SizeOf(TGlobalDLLData),
      FMName
      );
  if FMHandle <> 0 then
  begin
    GlobalData:=MapViewOfFile
        (
        FMHandle,
        FILE_MAP_ALL_ACCESS,
        0,
        0,
        SizeOf(TGlobalDLLData)
        );
    if GlobalData = nil then
    begin
      CloseHandle(FMHandle);
      FMHandle := 0;
    end;
  end;
end;
 
 
procedure CloseGlobalData;
begin
  if GlobalData <> nil then
    UnmapViewOfFile(GlobalData);
  if FMHandle <> 0 then
    CloseHandle(FMHandle);
  GlobalData:= nil;
  FMHandle := 0;
end;
 
 
Function RemoveKeyHook:Boolean;stdcall;
begin
  if GlobalData<>nil then
  begin
    if GlobalData.HKeyHook<>0 then
    begin
      UnhookWindowsHookEx(GlobalData.HKeyHook);
      Result:=True;
    end else result:=false;
    GlobalData.HKeyHook:=0;
    CloseGlobalData;
  end;
end;
 
 
 
function IntegerToString(prm01:integer):string;
var lts:string;
begin
  lts:=IntToStr(prm01);
  while length(lts)<10 do
  begin
    lts:='0'+lts;
  end;
  result:=lts;
end;
 
 
 
function Hook_KeyHook(code:Integer; wParam:Integer; lParam:Integer):Integer; stdcall;
begin
  OpenGlobalData;
  if code<0 then
  begin
    Result := CallNextHookEx(GlobalData.HKeyHook, code, wParam, lParam);
    Beep(1000,1000);
  end else
      begin
        case code of
          HC_ACTION:
          begin
//            lts:=IntToStr(wParam)+';'+IntToStr(lParam);
          end;
          HC_NOREMOVE:
          begin
//            lts:='HC_NOREMOVE - whot this?!';
          end;
        end;
        PostMessage(GlobalData.Wnd, GlobalData.WMKeyHookID, wParam, lParam );
        Result:=CallNextHookEx(GlobalData.HKeyHook, code, wParam, lParam);
      end;
end;
 
 
 
function SetKeyHook(aWnd: HWND; WMKeyHookID:Integer): Boolean;stdcall;
begin
  OpenGlobalData;
  if GlobalData <> nil then
  begin
    GlobalData.Wnd:=aWnd;
    GlobalData.WMKeyHookID:=WMKeyHookID;
    if (GlobalData.WMKeyHookID<$C000) or (GlobalData.WMKeyHookID>$FFFF) then
    begin
//      MessageBox(GlobalData.Wnd, pchar(inttostr(GlobalData.WMKeyHookID)), pchar('Value'), ID_OK);
      Beep(1000,1000);
      Result:=False;
      Exit;
    end;
    GlobalData.HKeyHook:=SetWindowsHookEx(WH_KEYBOARD, @Hook_KeyHook, hInstance, 0);
    Result:=GlobalData.HKeyHook<>0;
  end
  else
    Result := false;
end;
 
 
 
exports
  SetKeyHook,
  RemoveKeyHook,
  Hook_KeyHook;
 
begin
 
end.

.pas (на форме две tbutton, один label и memo. Нафига прикручивал timer - пардон, не помню).

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    procedure OnAnyMessage(var Msg: TMsg; var Handled: Boolean);
//    procedure ReceiveMessage(var Msg: TMessage); message WM_COPYDATA;
    { Private declarations }
  public
    { Public declarations }
  end;
 
 
const WMKeyHookTextID: PChar='HookKeyboardDll__001';
 
var
  Form1: TForm1;
  WMKeyHookId: Integer;
  timer_1:integer;
  Hook: Boolean;
 
implementation
 
{$R *.dfm}
 
 
 
//Загрузка DLL
function SetKeyHook(aWnd: HWND; WMKeyHookId: Integer): Boolean;stdcall; external 'KeyboardHookDll.dll' name 'SetKeyHook';
function RemoveKeyHook:Boolean;stdcall; external 'KeyboardHookDll.dll' name 'RemoveKeyHook';
 
 
 
procedure TForm1.OnAnyMessage(var Msg: TMsg; var Handled: Boolean);
var
  Buffer: array[0..50] of Char;
  S: String;
  Flags: Word;
  SCode: Word;
begin
//  if Hook then memo1.lines.Add(inttostr(msg.message));
  if Msg.Message = WMKeyHookId then
  begin
    //ScanCode
//    SCode:=
    // Получаем наименование нажатой клавиши
    GetKeyNameText(Msg.lParam, @Buffer, SizeOf(Buffer));
    S:=StrPas(Buffer)+IntToStr(Msg.wParam);
    Flags := Msg.lParam shr 16;
    if (Flags and KF_UP) <> 0 then
      S := S + ' down'
    else if (Flags and KF_REPEAT) <> 0 then
      S := S + ' repeat'
    else S := S + ' up';
    Memo1.Lines.Add(S);
//    Handled := TRUE;
  end;
end;
 
 
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  if SetKeyHook(Application.Handle, WMKeyHookId) then
  begin
    Hook:=True;
    Label1.Caption:='Set: Ok'
  end else
      begin
        Label1.Caption:='Set: Error';
      end;
end;
 
 
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  if RemoveKeyHook then
  begin
    Hook:=False;
    Label1.Caption:='Del: Ok';
  end else
      Label1.Caption:='Del: Error';
end;
 
 
 
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  RemoveKeyHook;
end;
 
 
{
procedure TForm1.ReceiveMessage;
var MessageFromDll: PCopyDataStruct;
    lts,lts1:string;
    cmd:integer;
    wParam:integer;
begin
//  GetMem(MsgFromDll_01, SizeOf(TMessage01));
  MessageFromDll:=PCopyDataStruct(Msg.LParam);
//  move(MessageFromDll.lpData,PZWMessage,SizeOf(TZWMessage));
  lts:=PChar(MessageFromDll.lpData);
  Memo1.Lines.Add(lts);
//  lts:=chr(strtoint(lts));
//  Memo2.Lines.Add(lts);
 
{
  if length(lts)<10 then
  begin
//    Errors.Lines.Add('ERROR 20');
    lts:='0';
  end else
      begin
//        lts1:=copy(WndName,1,10);
//        delete(WndName,1,10);
      end;
  try
    wParam:=StrToInt(lts1);
  except
//    Errors.Lines.Add('ERROR 20.1');
    wParam:=0;
  end;
  cmd:=MessageFromDll.dwData;
  Memo1.Lines.Add('command: '+IntToStr(cmd)+' = '+lts+'; wParam: '+IntToStr(wParam)+'; '+WndName+'   '+TimeToStr(Now));
//  RefreshWinBtnFlag:=True;
//  CreateWinBtn(WndName, FindWindow(nil,Pchar(WndName)));
//  PZWMessage:=nil;
//  FreeMem(MsgFromDll_01, SizeOf(TMessage01));
end;
}
 
 
procedure TForm1.FormCreate(Sender: TObject);
var ProcessID,ProcessHandle:THandle;
begin
  ProcessID:=GetCurrentProcessID;
  ProcessHandle:=OpenProcess(PROCESS_SET_INFORMATION, false, ProcessID);
  if Application.Handle<>ProcessHandle then ShowMessage('<>') else ShowMessage('=');
  WMKeyHookId:=RegisterWindowMessage(WMKeyHookTextID);
  Memo1.Lines.Add(inttostr(WMKeyHookId));
  Application.OnMessage:=OnAnyMessage;
end;
 
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if Timer_1>1 then dec(Timer_1) else begin timer_1:=0;end;
end;
 
end.

[^D^ima]

Думал там 3 строки
Спасибо

Добавлено 14.02.18, 17:50
И зачем там бипы в библиотеке?

[Руслан]

Цитата ^D^ima @ 14.02.18, 17:49

И зачем там бипы в библиотеке?

Весь пример - базовая конструкция, от которой я писал в своё далекое время программу(типа черновик, которому присвоен статус "базовый рабочий"). К чему там бип - я не могу помнить, пардон. Я даже не понимаю нафига там таймер, и собственно смотреть довольно таки лениво. Протестировал лишь под семеркой, убедившись что функционал не потерял актуальность, и ловит требуемые кнопки.

Добавлено 14.02.18, 18:15

Цитата ^D^ima @ 14.02.18, 17:49

Думал там 3 строки

попробуй в DRKB разобраться не сломав ногу четрям.
Собственно думал в ДРКБ отправить, посмотрел сам... короче понял, что наверное легче и надежней тебе будет от готового примера отталкиваться.

[leo]

Цитата ^D^ima @ 14.02.18, 10:23

сделать логгер клавиши printScreen.
Какой самый просто способ перехвата?

В данном случае проще использовать глобальный низкоуровневый хук WH_KEYBOARD_LL, который не требует использования dll (хук срабатывает в самом приложении\потоке, установившем этот хук)

[^D^ima]

leo
Нашел такой пример:

const
  LLKHF_ALTDOWN: Cardinal = KF_ALTDOWN shr 8;
  LLKHF_UP: Cardinal = KF_UP shr 8;
 
function LLKeyHook( Code: Integer; WParam: wParam; Msg: PKbdDllHookStrukt ): Longint; stdcall;
const
  {$J+}
  CodeStr: Cardinal = 0;
  {$J-}
var
  Key: Cardinal;
  IsAltDown: Boolean;
  SelPos, SelLen: Integer;
  Str: string;
begin
   case Code of
      HC_ACTION: begin
         if Form2.ActiveControl = Form2.Edit1 then
         begin
            // LLKHF_ALTDOWN - Кнопка ALT нажата
            // 0 - Кнопка ALT отжата
            IsAltDown := Msg.flags and LLKHF_ALTDOWN = LLKHF_ALTDOWN;
 
            if IsAltDown then
            begin
               if Msg.flags and LLKHF_UP = 0 then
               begin
                  if Msg^.vkCode in [96..105] then
                     CodeStr := CodeStr * 10 + Msg^.vkCode - 96;
               end;
            end
            else
            begin
               if CodeStr > 0 then
               begin
                  SelPos := Form2.Edit1.SelStart + 1;
                  SelLen := Form2.Edit1.SelLength;
                  Str := Form2.Edit1.Text;
 
                  if SelLen > 0 then
                     Delete( Str, SelPos, SelLen );
                  Insert( Chr( CodeStr ), Str, SelPos );
 
                  Form2.Edit1.Text := Str;
                  Form2.Edit1.SelStart := SelPos;
               end;
 
               CodeStr := 0;
 
               if Msg^.vkCode in [VK_LMENU, VK_RMENU] then
               begin
                  keybd_event( VK_MENU, 0, 0, 0 );
                  keybd_event( VK_MENU, 0, KEYEVENTF_KEYUP, 0 );
                  Result := 1;
                  Exit;
               end;
            end;
         end;
      end;
   end;
   Result := CallNextHookEx( LLKeybHook, Code, WParam, Longint( Msg ) );
end;

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

[leo]

Цитата ^D^ima @ 15.02.18, 09:29

Нашел такой пример: ...
Насколько это пример верный и можно ли брать за основу

В этом примере 99% процентов какой-то частной специфики, не имеющей отношения к делу.
А ключевых моментов всего несколько:
1) проверяем Code = HC_ACTION, код клавиши Msg.vkCode = VK_SNAPSHOT и признак нажатия\отжатия по Msg.Flags and LLKHF_UP (выбираем что-то одно, чтобы не дублировать срабатывания)
2) если нужно мониторить программные нажатия какими-нить шпионскими зловредами, то проверяем флаг Msg.Flags and LLKHF_INJECTED
3) выполняем свои действия, но не "слишком\чересчур" долго, т.к. на обработку LL-хуков устанавливается некий тайм-аут (при превышении которого ОС может просто снять твой хук, чтобы он не тормозил всю систему).
4) В конце вызываем Result := CallNextHookEx (в качестве первого параметра можно передавать 0, т.к. он просто игнорируется).
Ну и разумеется для того, чтобы все это работало, поток, установивший хук, должен крутить цикл обработки виндовых сообщений (т.к. срабатывание хука происходит внутри Cet\PeakMessage).

Сообщение отредактировано: leo - 17.02.18, 05:26