На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! user posted image
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.

Соблюдайте общие правила форума

Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как запустить программу/файл? (и дождаться ее завершения)
5. Как перехватить API-функции, поставить hook? (перехват сообщений от мыши, клавиатуры - внедрение в удаленное адресное прстранство)
... (продолжение следует) ...

Внимание:
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки - бан.
Мат в разделе - бан на три месяца...

Полезные ссылки:
user posted image MSDN Library user posted image FAQ раздела user posted image Поиск по разделу user posted image Как правильно задавать вопросы


Выразить свое отношение к модераторам раздела можно здесь: user posted image Rouse_, user posted image Krid

Модераторы: Rouse_, Krid
  
> Перехват PrintScreen
    В целях повышения безопасности организации родилась идею сделать логгер клавиши printScreen.

    Какой самый просто способ перехвата? Уверен есть уже готовы код. Кто-то может показать пример?
      Цитата ^D^ima @
      логгер клавиши printScreen

      коду больше десятка лет, но только что проверил, под семеркой нормально ловит кнопки:
      dll:
      ExpandedWrap disabled
        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 - пардон, не помню).
      ExpandedWrap disabled
        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.
        Думал там 3 строки :o
        Спасибо

        Добавлено
        И зачем там бипы в библиотеке?
          Цитата ^D^ima @
          И зачем там бипы в библиотеке?

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

          Добавлено
          Цитата ^D^ima @
          Думал там 3 строки :o

          попробуй в DRKB разобраться не сломав ногу четрям. :D
          Собственно думал в ДРКБ отправить, посмотрел сам... короче понял, что наверное легче и надежней тебе будет от готового примера отталкиваться. :)
            Цитата ^D^ima @
            сделать логгер клавиши printScreen.
            Какой самый просто способ перехвата?

            В данном случае проще использовать глобальный низкоуровневый хук WH_KEYBOARD_LL, который не требует использования dll (хук срабатывает в самом приложении\потоке, установившем этот хук)
              leo
              Нашел такой пример:
              ExpandedWrap disabled
                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;

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

                В этом примере 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 -
                0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                0 пользователей:


                Рейтинг@Mail.ru
                [ Script execution time: 0,0378 ]   [ 17 queries used ]   [ Generated: 28.03.24, 21:56 GMT ]