Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Keyboardhook modifizieren (https://www.delphipraxis.net/88514-keyboardhook-modifizieren.html)

alleinherrscher 16. Mär 2007 15:25


Keyboardhook modifizieren
 
Liste der Anhänge anzeigen (Anzahl: 1)
Huhu@all!

Folgendes Problem (mal wieder):

Ich hab mal ein bisschen gesucht im Forum wie man bestimmte Windows Tastenkombinationen abfangen kann. Dann bin ich auf den Keyboardhook (siehe Anhang) gestoßen. Der unterbindet alle Tastenkombinationen mit der Windowstaste. Jetzt wollte ich die DLL so modifizieren, dass auch Tastenkombinationen mit ALT und STRG abgefangen werden können (im grunde sollen wirklich ALLE Windowstastenkombinationen außer ALT+STRG+ENTF) abgefangen werden.

Allerdings funktioniert die modifizierte Version hier nicht mehr, bzw die neue Tastenkombination, die gesperrt werden soll, wird nicht gesperrt:

Delphi-Quellcode:
unit WHookInt;

interface
//[...usw...]

        { Example to disable all the start-Key combinations }
        case TPMsg(lParam)^.message of
          WM_SYSCOMMAND: // The Win Start Key (or Ctrl+ESC)
            if TPMsg(lParam)^.wParam = SC_TASKLIST then Kill := True;

//neu hinzugefügt:

         WM_SYSKEYDOWN:
             case ((TPMsg(lParam)^.lParam and $00FF0000) shr 16) of
             VK_F4:     // Alt+F4 ==> Close Window

             Kill := True;
            end;
//bis hier

          WM_HOTKEY:
            case ((TPMsg(lParam)^.lParam and $00FF0000) shr 16) of
              VK_D,     // Win+D       ==> Desktop
              VK_E,     // Win+E       ==> Explorer
              VK_F,     // Win+F+(Ctrl) ==> Find:All (and Find: Computer)
              VK_M,     // Win+M       ==> Minimize all
              VK_R,     // Win+R       ==> Run program.
              VK_F1,    // Win+F1       ==> Windows Help
              VK_PAUSE: // Win+Pause   ==> Windows system properties

                Kill := True;
            end;
        end;
        if Kill then TPMsg(lParam)^.message := WM_NULL;
        Result := CallNextHookEx(MMFData.NextHook, Code, wParam, lParam)
      end;
      UnMapMMF(MMFData);
    end;
    CloseMMF(MMFHandle);
  end;
end;

//[...]
Ich weiß einfach nicht was ich da falsch gemacht habe? Muss ich mir mein VK_F4 irgendwie anders umdefinieren? Kann mir jemand helfen? Das wäre echt klasse!

Beste Grüße und schönes Wochenende!!!

alleinherrscher 17. Mär 2007 17:44

Re: Keyboardhook modifizieren
 
*push*

Ich hab nun folgende "Lösung" die allerdings zu Abstürzen beliebiger Programme führt (u.a. Explorer.exe, Icq.exe usw):

Delphi-Quellcode:
unit WHookInt;

interface

uses
  Windows, Messages, SysUtils,Dialogs;

function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall; export;
function FreeHook: Boolean; stdcall; export;
function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint stdcall; export;

implementation


// Memory map file stuff

{
  The CreateFileMapping function creates unnamed file-mapping object
  for the specified file.
}

function CreateMMF(Name: string; Size: Integer): THandle;
begin
  Result := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, Size, PChar(Name));
  if Result <> 0 then
  begin
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      CloseHandle(Result);
      Result := 0;
    end;
  end;
end;

{ The OpenFileMapping function opens a named file-mapping object. }

function OpenMMF(Name: string): THandle;
begin
  Result := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(Name));
  // The return value is an open handle to the specified file-mapping object.
end;

{
 The MapViewOfFile function maps a view of a file into
 the address space of the calling process.
}

function MapMMF(MMFHandle: THandle): Pointer;
begin
  Result := MapViewOfFile(MMFHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0);
end;

{
  The UnmapViewOfFile function unmaps a mapped view of a file
  from the calling process's address space.
}

function UnMapMMF(P: Pointer): Boolean;
begin
  Result := UnmapViewOfFile(P);
end;

function CloseMMF(MMFHandle: THandle): Boolean;
begin
  Result := CloseHandle(MMFHandle);
end;


// Actual hook stuff

type
  TPMsg = ^TMsg;

const
  VK_D = $44;
  VK_E = $45;
  VK_F = $46;
  VK_M = $4D;
  VK_R = $52;
  VK_F4= $73;
  VK_C = $43;
  //115
  MMFName = 'MsgFilterHookDemo';

type
  PMMFData = ^TMMFData;
  TMMFData = record
    NextHook: HHOOK;
    WinHandle: HWND;
    MsgToSend: Integer;
  end;

  // global variables, only valid in the process which installs the hook.
var
  MMFHandle: THandle;
  MMFData: PMMFData;

function UnMapAndCloseMMF: Boolean;
begin
  Result := False;
  if UnMapMMF(MMFData) then
  begin
    MMFData := nil;
    if CloseMMF(MMFHandle) then
    begin
      MMFHandle := 0;
      Result := True;
    end;
  end;
end;

{
  The SetWindowsHookEx function installs an application-defined
  hook procedure into a hook chain.

  WH_GETMESSAGE Installs a hook procedure that monitors messages
  posted to a message queue.
  For more information, see the GetMsgProc hook procedure.
}

function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall;
begin
  Result := False;
  if (MMFData = nil) and (MMFHandle = 0) then
  begin
    MMFHandle := CreateMMF(MMFName, SizeOf(TMMFData));
    if MMFHandle <> 0 then
    begin
      MMFData := MapMMF(MMFHandle);
      if MMFData <> nil then
      begin
        MMFData.WinHandle := WinHandle;
        MMFData.MsgToSend := MsgToSend;
        MMFData.NextHook := SetWindowsHookEx(WH_GETMESSAGE, MsgFilterFunc, HInstance, 0);

        if MMFData.NextHook = 0 then
          UnMapAndCloseMMF
        else
          Result := True;
      end
      else
      begin
        CloseMMF(MMFHandle);
        MMFHandle := 0;
      end;
    end;
  end;
end;


{
  The UnhookWindowsHookEx function removes the hook procedure installed
  in a hook chain by the SetWindowsHookEx function.
}

function FreeHook: Boolean; stdcall;
begin
  Result := False;
  if (MMFData <> nil) and (MMFHandle <> 0) then
    if UnHookWindowsHookEx(MMFData^.NextHook) then
      Result := UnMapAndCloseMMF;
end;



(*
    GetMsgProc(
    nCode: Integer; {the hook code}
    wParam: WPARAM; {message removal flag}
    lParam: LPARAM {a pointer to a TMsg structure}
    ): LRESULT; {this function should always return zero}

    { See help on ==> GetMsgProc}
*)

function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint;
var
  MMFHandle: THandle;
  MMFData: PMMFData;
  Kill: boolean;
  KeyState: TKeyboardState;
begin
  Result := 0;
  MMFHandle := OpenMMF(MMFName);
  if MMFHandle <> 0 then
  begin
    MMFData := MapMMF(MMFHandle);
    if MMFData <> nil then
    begin
      if (Code < 0) or (wParam = PM_NOREMOVE) then
        {
          The CallNextHookEx function passes the hook information to the
          next hook procedure in the current hook chain.
        }
        Result := CallNextHookEx(MMFData.NextHook, Code, wParam, lParam)
      else
      begin
        Kill := False;

        with TMsg(Pointer(lParam)^) do
        begin
          if (wParam = VK_TAB) then Kill := True;
        end;

        case TPMsg(lParam)^.message of
          WM_SYSCOMMAND: // The Win Start Key (or Ctrl+ESC)
            if TPMsg(lParam)^.wParam = SC_TASKLIST then Kill := True;

        WM_SYSKEYDOWN:
         begin
        //  showmessage(inttostr(((TPMsg(lParam)^.lParam and $00FF0000) shr 16)));
          case ((TPMsg(lParam)^.lParam and $00FF0000) shr 16) of
             62:Kill:=True; // ==> ALT+F4
           end;
         end;

        WM_SYSKEYUP:
         case ((TPMsg(lParam)^.lParam and $00FF0000) shr 16) of
           62:Kill:=True; // ==> ALT+F4
         end;

      {   WM_KEYDOWN:
         begin                             //Alles mit STRG töten

          GetKeyboardState(KeyState);
           If KeyState[VK_CONTROL]>1 then kill:=True;
         end;

         WM_KEYUP:
         begin                             //Alles mit STRG töten
          GetKeyboardState(KeyState);
           If KeyState[VK_CONTROL]>1 then kill:=True;
         end;   }

         WM_HOTKEY:
           case ((TPMsg(lParam)^.lParam and $00FF0000) shr 16) of
              VK_D,     // Win+D       ==> Desktop
              VK_E,     // Win+E       ==> Explorer
              VK_F,     // Win+F+(Ctrl) ==> Find:All (and Find: Computer)
              VK_M,     // Win+M       ==> Minimize all
              VK_R,     // Win+R       ==> Run program.
              VK_F1,    // Win+F1       ==> Windows Help
              VK_PAUSE: // Win+Pause   ==> Windows system properties

                Kill := True;
           end;
        end;
        if Kill then TPMsg(lParam)^.message := WM_NULL;
        Result := CallNextHookEx(MMFData.NextHook, Code, wParam, lParam)
      end;
      UnMapMMF(MMFData);
    end;
    CloseMMF(MMFHandle);
  end;
end;


initialization
  begin
    MMFHandle := 0;
    MMFData  := nil;
  end;

finalization
  FreeHook;
end.

alleinherrscher 27. Mär 2007 19:43

Re: Keyboardhook modifizieren
 
*push* ? niemand ne idee? :(

Yakumo500 14. Mär 2009 07:29

Re: Keyboardhook modifizieren
 
Wenn du nur verhindern willst das dein eigenes Programm mit Alt + F4 beendet wird dann schreib doch einfach bei OnClose deiner Form:

Delphi-Quellcode:
Action := caNone;


Alle Zeitangaben in WEZ +1. Es ist jetzt 10:49 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz