Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi winhook.dll (https://www.delphipraxis.net/4013-winhook-dll.html)

aaron 11. Apr 2003 08:09


winhook.dll
 
Hi...
ich probiere auch grad die winhook.dll aus
gibt es hier:
http://people.freenet.de/Thomas.D/winhook.dll

funktioniert soweit echt gut, nur kann man keine zahlen mehr eingeben, diese tasten sind auch "gesperrt"...
weißt jemand zufällig warum?

Delphi-Quellcode:
unit FrmMainU;

interface

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

const
  HookDemo = 'WINHOOK.dll';

const
  WM_HOOKCREATE = WM_USER + 1;

type
  TFrmMain = class(TForm)
    Panel1: TPanel;
    BtnSetHook: TButton;
    BtnClearHook: TButton;
    procedure BtnSetHookClick(Sender: TObject);
    procedure BtnClearHookClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FHookSet: Boolean;
    procedure EnableButtons;
  public

  end;

var
  FrmMain: TFrmMain;

  function SetHook(WinHandle: HWND; MsgToSend: integer): boolean; stdcall; external HookDemo;
  function FreeHook: boolean; stdcall; external HookDemo;


implementation

{$R *.DFM} 


procedure TFrmMain.EnableButtons;
begin
  BtnSetHook.Enabled := not FHookSet;
  BtnClearHook.Enabled := FHookSet;
end;

procedure TFrmMain.BtnSetHookClick(Sender: TObject);
begin
  FHookSet := LongBool(SetHook(Handle,WM_HOOKCREATE));
  EnableButtons;
end;

procedure TFrmMain.BtnClearHookClick(Sender: TObject);
begin
  FHookSet := FreeHook;
  EnableButtons;
  BtnClearHook.Enabled := false;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  EnableButtons;
end;

end.

Luckie 11. Apr 2003 08:18

Meinst du nicht auch, dass es eventuell sinnvoller wäre den Code der DLL zu posten, anstatt deinen Aufruf? :roll:

aaron 11. Apr 2003 08:23

würde ich sofort machen wenn ich die *.dll selber gemacht hätte :) (bzw. den quellcode hätte)
vielleicht noch ein paar worte zu dem was ich machen will...
ich möchte alle windowstasten sperren, win +E, win +F usw., deshalb habe ich es mit der *.dll versucht.

Luckie 11. Apr 2003 08:34

Wie gesagt, der entscheidende Code liegt in der DLL und ohne den Code zusehen, kann man da nichts machen.

Ich sehe da drei Lösungen:
1. Kucken ob es eine Doku zu der DLL gibt.
2. Den Author anschreiben.
3. Selber einen low-level Tastatur-Hook schreiben.
Such dir was aus.

Darty 11. Apr 2003 08:35

Luckie hat doch sowas auch schon gemacht oder ? Da könntest Du doch nachschauen ..

aaron 11. Apr 2003 08:42

hat den jemand ein beispiel wie ich sowas ohne diese *.dll realisieren kann?
was ist ein low-level Tastatur-Hook ?

Luckie 11. Apr 2003 08:45

Ein low-level-Tastatur-Hook klickt sich noch vor den Tastaturtreiber in das System ein. Wenn du Glück hast reicht auch schon ein nromler Tastatur-Hook. Und so einen findest du auf meiner Seite.

aaron 11. Apr 2003 08:45

hab den quelltext der *.dll doch grad gefunden...


Delphi-Quellcode:
{ Interface unit for use with WINHOOK.DLL }
unit WHookDef;

interface

uses
  Windows;

  function SetHook(WinHandle: HWND; MsgToSend: integer): boolean; stdcall
  function FreeHook: boolean; stdcall;

implementation
  function SetHook ; external 'WINHOOK.DLL' index 1;
  function FreeHook ; external 'WINHOOK.DLL' index 2;
end.
Delphi-Quellcode:
unit WHookInt;

interface

uses
  Windows, Messages;

  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 ******************************
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;

function OpenMMF(Name: string) : THandle;
begin
  Result := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(Name));
end;

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

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;

  MMFName = 'winkeykiller';

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;


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;


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


{ See help on ==> GetMsgProc}
function MsgFilterFunc(Code: integer; wParam, lParam: longint): longint;
var
  MMFHandle : THandle;
  MMFData  : PMMFData;
  Kill     : boolean;
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
        Result := CallNextHookEx(MMFData.NextHook, Code, WParam, LParam)
      else
      begin
        Kill := False;
        case TPMsg(lParam)^.message of
          WM_SYSCOMMAND: // The Win Start Key (or Ctrl+ESC)
            if TPMsg(lParam)^.wParam = SC_TASKLIST then Kill := True;

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

aaron 11. Apr 2003 11:22

ich wollte eigentlich nur wissen warum mit dem source oben (WINHOOK.DLL) keine zahlen getippt werden können, weiß das vielleicht jemand hier?

Luckie 11. Apr 2003 11:29

Nein, sollte der Code eigentlich nicht unterbinden.


Alle Zeitangaben in WEZ +1. Es ist jetzt 05:56 Uhr.
Seite 1 von 2  1 2      

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