AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi Mouse (Maus) Hook funktioniert nicht mehr (Windows 64 Bit)
Thema durchsuchen
Ansicht
Themen-Optionen

Mouse (Maus) Hook funktioniert nicht mehr (Windows 64 Bit)

Ein Thema von ecHo89 · begonnen am 12. Nov 2009 · letzter Beitrag vom 13. Nov 2009
Antwort Antwort
ecHo89

Registriert seit: 13. Apr 2008
97 Beiträge
 
#1

Mouse (Maus) Hook funktioniert nicht mehr (Windows 64 Bit)

  Alt 12. Nov 2009, 22:11
Hallo an alle da draußen

Problem: Mein Maus-Hook funktioniert unter XP 32 Bit ohne Probleme. Bei Windows 7 64 Bit registriert er aber einfach keinen Mausklick mehr.

Anmerkung: Der Keyboard-Hook läuft problemlos unter beiden (ist unten nicht als Quelltext zu finden!).

Frage: Was kann ich tun, dass er auch unter Windows 7 64 Bit läuft. Oder brauch ich einen komplett neuen/anderen?

Zitat:
Loading 16bit DLLs into 32bit processes and loading 32bit DLLs into 16bit
processes was supported by Win95.

This is different with 64bit and 32bit. It is not possible to load DLLs of one
type into the process of another.

Not having a 64bit Delphi compiler means it's not possible to support any DLL
based plugin/extension system into a 64bit process. E.g. it's not possible to
create shell extension, browser plugins and so forth for 64bit windows
currently.
Zitat:
Also, this affects any system wide hooks you might want to install (which
require the hook code to be in a DLL).
http://objectmix.com/delphi/727634-d...n64-party.html

Was kann ich tun? Nur warten bis Delphi endlich bereit ist für 64 Bit ist oder gibts irgendeinen anderen weg?

Letzte Anmerkung für alle die sich wundern: Es ist ein umgeschriebener KeyboardHook, in dem WH_KEYBOARD mit WH_MOUSE(!) ersetzt wurde. Also nicht ablenken lassen, wenn Methode und Variablen immer noch Keyboard heißen.

Vielen Dank im Voraus für alle Hilfen und rauchenden Köpfe

Quelltext aus meinem Programm:

Delphi-Quellcode:
{Functions prototypes for the hook dll}
type TGetHookRecPointer = function : pointer stdcall;

type TStartKeyBoardHook = procedure stdcall;

type TStopKeyBoardHook = procedure stdcall;

{The record type filled in by the hook dll}
type THookRec = packed record
  TheHookHandle : HHOOK;
  TheAppWinHandle : HWND;
  TheCtrlWinHandle : HWND;
  TheKeyCount : DWORD;
end;

{A pointer type to the hook record}
type PHookRec = ^THookRec;

var
  hHookLib : THANDLE; {A handle to the hook dll}
  GetHookRecPointer : TGetHookRecPointer; {Function pointer}
  StartKeyBoardHook : TStartKeyBoardHook; {Function pointer}
  StopKeyBoardHook : TStopKeyBoardHook; {Function pointer}
  LibLoadSuccess : bool; {If the hook lib was successfully loaded}
  lpHookRec : PHookRec; {A pointer to the hook record}
  EnterKeyCount : DWORD; {An internal count of the Enter Key}


procedure TFarmvilleBot.Button1KeyDown(Sender: TObject; var Key: Word; [b]// On LMouseButtonClick[/b]
  Shift: TShiftState);
begin

end;

procedure TFarmvilleBot.StartHookClick(Sender: TObject);
begin
  if not RegisterHotkey(self.Handle, HotKeyConst, 0, HotKeyConst)
  then ShowMessage(SysErrorMessage(GetLastError));

 {Set our initial variables}
  EnterKeyCount := 0;
  lpHookRec := NIL;
  LibLoadSuccess := FALSE;
  @GetHookRecPointer := NIL;
  @StartKeyBoardHook := NIL;
  @StopKeyBoardHook := NIL;
 {Try to load the hook dll}
  hHookLib := LoadLibrary('THEHOOK.DLL');
 {If the hook dll was loaded successfully}
  if hHookLib <> 0 then begin
   {Get the function addresses}
    @GetHookRecPointer :=
      GetProcAddress(hHookLib, 'GETHOOKRECPOINTER');
    @StartKeyBoardHook :=
      GetProcAddress(hHookLib, 'STARTKEYBOARDHOOK');
    @StopKeyBoardHook :=
      GetProcAddress(hHookLib, 'STOPKEYBOARDHOOK');
   {Did we find all the functions we need?}
    if ((@GetHookRecPointer <> NIL) AND
        (@StartKeyBoardHook <> NIL) AND
        (@StopKeyBoardHook <> NIL)) then begin
       LibLoadSuccess := TRUE;
      {Get a pointer to the hook record}
       lpHookRec := GetHookRecPointer;
      {Were we successfull in getting a ponter to the hook record}
       if (lpHookRec <> nil) then begin
        {Fill in our portion of the hook record}
         lpHookRec^.TheHookHandle := 0;
         lpHookRec^.TheCtrlWinHandle := Button1.Handle;
         lpHookRec^.TheKeyCount := 0;
        {Start the keyboard hook}
         StartKeyBoardHook;
        {Start the timer if the hook was successfully set}
         if (lpHookRec^.TheHookHandle <> 0) then begin
         end;
       end;
    end else begin
     {We failed to find all the functions we need}
      FreeLibrary(hHookLib);
      hHookLib := 0;
      @GetHookRecPointer := NIL;
      @StartKeyBoardHook := NIL;
      @StopKeyBoardHook := NIL;
    end;
  end;
end;

procedure TFarmvilleBot.StopHookClick(Sender: TObject);
begin
 {Did we load the dll successfully?}

 UnRegisterHotKey(self.Handle, HotKeyConst);
 try
  if (LibLoadSuccess = TRUE) then begin
   {Did we sucessfully get a pointer to the hook record?}
    if (lpHookRec <> nil) then begin
     {Did the hook get set?}
      if (lpHookRec^.TheHookHandle <> 0) then begin
        //Timer1.Enabled := FALSE;
        StopKeyBoardHook;
      end;
    end;
   {Free the hook dll}
    FreeLibrary(hHookLib);
  end;
 except end;

end;
Quelltext aus der DLL:

Delphi-Quellcode:
library TheHook;

uses
  Windows,
  Messages,
  SysUtils;

{Define a record for recording and passing information process wide}
type
  PHookRec = ^THookRec;
  THookRec = packed record
    TheHookHandle : HHOOK;
    TheAppWinHandle : HWND;
    TheCtrlWinHandle : HWND;
    TheKeyCount : DWORD;
  end;

var
  hObjHandle : THandle; {Variable for the file mapping object}
  lpHookRec : PHookRec; {Pointer to our hook record}

procedure MapFileMemory(dwAllocSize : DWORD);
begin
 {Create a process wide memory mapped variable}
  hObjHandle := CreateFileMapping($FFFFFFFF,
                                  NIL,
                                  PAGE_READWRITE,
                                  0,
                                  dwAllocSize,
                                  'HookRecMemBlock');
   if (hObjHandle = 0) then begin
     MessageBox(0,
                'Hook DLL',
                'Could not create file map object',
                MB_OK);
     exit;
   end;
 {Get a pointer to our process wide memory mapped variable}
  lpHookRec := MapViewOfFile(hObjHandle,
                             FILE_MAP_WRITE,
                             0,
                             0,
                             dwAllocSize);
  if (lpHookRec = NIL) then begin
    CloseHandle(hObjHandle);
    MessageBox(0,
               'Hook DLL',
               'Could not map file',
               MB_OK);
    exit;
  end;
end;

procedure UnMapFileMemory;
begin
 {Delete our process wide memory mapped variable}
  if (lpHookRec <> NIL) then begin
    UnMapViewOfFile(lpHookRec);
    lpHookRec := NIL;
  end;
  if (hObjHandle > 0) then begin
    CloseHandle(hObjHandle);
    hObjHandle := 0;
  end;
end;

function GetHookRecPointer : pointer stdcall;
begin
 {Return a pointer to our process wide memory mapped variable}
  result := lpHookRec;
end;

{The function that actually processes the keystrokes for our hook}
function KeyBoardProc(Code : integer;
                      wParam : integer;
                      lParam : integer): integer; stdcall;
var
  KeyUp : bool;
 {Remove comments for additional functionability
  IsAltPressed : bool;
  IsCtrlPressed : bool;
  IsShiftPressed : bool;
}

begin
  result := 0;

  case Code of
    HC_ACTION :
    begin
     if (wParam = WM_LBUTTONDOWN) or (lparam=WM_LBUTTONDOWN) then
     begin
      Inc(lpHookRec^.TheKeyCount);
             PostMessage(lpHookRec^.TheCtrlWinHandle,
                         WM_KEYDOWN,
                         0,
                         0);
             PostMessage(lpHookRec^.TheCtrlWinHandle,
                         WM_KEYUP,
                         0,
                         0);
     end;
    end; {HC_ACTION}
    HC_NOREMOVE : begin
      {This is a keystroke message, but the keystroke message}
      {has not been removed from the message queue, since an}
      {application has called PeekMessage() specifying PM_NOREMOVE}
      result := 0;
      exit;
    end;
  end; {case code}
  if (Code < 0) then
   {Call the next hook in the hook chain}
    result :=
      CallNextHookEx(lpHookRec^.TheHookHandle,
                     Code,
                     wParam,
                     lParam);
end;

procedure StartKeyBoardHook; stdcall;
begin
 {If we have a process wide memory variable}
 {and the hook has not already been set...}
  if ((lpHookRec <> NIL) AND
      (lpHookRec^.TheHookHandle = 0)) then begin
   {Set the hook and remember our hook handle}
    lpHookRec^.TheHookHandle := SetWindowsHookEx(WH_MOUSE,
                                                 @KeyBoardProc,
                                                 hInstance,
                                                 0);
  end;
end;

procedure StopKeyBoardHook; stdcall;
begin
 {If we have a process wide memory variable}
 {and the hook has already been set...}
  if ((lpHookRec <> NIL) AND
      (lpHookRec^.TheHookHandle <> 0)) then begin
   {Remove our hook and clear our hook handle}
    if (UnHookWindowsHookEx(lpHookRec^.TheHookHandle) <> FALSE) then
begin
      lpHookRec^.TheHookHandle := 0;
    end;
  end;
end;

procedure DllEntryPoint(dwReason : DWORD);
begin
  case dwReason of
    Dll_Process_Attach : begin
     {If we are getting mapped into a process, then get}
     {a pointer to our process wide memory mapped variable}
      hObjHandle := 0;
      lpHookRec := NIL;
      MapFileMemory(sizeof(lpHookRec^));
    end;
    Dll_Process_Detach : begin
     {If we are getting unmapped from a process then, remove}
     {the pointer to our process wide memory mapped variable}
      UnMapFileMemory;
    end;
  end;
end;

exports
  KeyBoardProc name 'KEYBOARDPROC',
  GetHookRecPointer name 'GETHOOKRECPOINTER',
  StartKeyBoardHook name 'STARTKEYBOARDHOOK',
  StopKeyBoardHook name 'STOPKEYBOARDHOOK';

begin
 {Set our Dll's main entry point}
  DLLProc := @DllEntryPoint;
 {Call our Dll's main entry point}
  DllEntryPoint(Dll_Process_Attach);
end.
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#2

Re: Mouse (Maus) Hook funktioniert nicht mehr (Windows 64 Bi

  Alt 12. Nov 2009, 22:15
Das Problem ist doch in dem von dir zitierten text beschrieben, du brauchst einen 64-Bit Kompiler. Lazarus unterstützt zum beispiel 64-Bit.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
ecHo89

Registriert seit: 13. Apr 2008
97 Beiträge
 
#3

Re: Mouse (Maus) Hook funktioniert nicht mehr (Windows 64 Bi

  Alt 12. Nov 2009, 23:25
Naja, der Keyboard-Hook (in einer Delphi-Unit geschrieben) funktioniert noch unter 64 Bit. Nur der MouseHook (ausgelagert in eine DLL) funktioniert nicht, da die (32 Bit-)DLL vom 64 Bit System nicht geladen werden kann.
Gibt es jetzt nicht auch eine Möglichkeit einen Mouse-Hook in einer Delphi-Unit zu schreiben, der dann auch unter 64 Bit geht?

Zu Lazarus: Ist das viel Umstellung?

Edit: Mir fällt gerade ein: Ist es so, dass global Hooks nur mit einer DLL realisiert werden können?
Aber warum funktioniert dann der Keyboard Hook?
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#4

Re: Mouse (Maus) Hook funktioniert nicht mehr (Windows 64 Bi

  Alt 13. Nov 2009, 00:21
Zitat von ecHo89:
Naja, der Keyboard-Hook (in einer Delphi-Unit geschrieben) funktioniert noch unter 64 Bit.
Das kann nicht sein. 64-Bit kann keine 32-Bit DLLs laden, hast du ja selber zitiert.

Zitat:
Edit: Mir fällt gerade ein: Ist es so, dass global Hooks nur mit einer DLL realisiert werden können?
Jupp, globale Hooks müssen in einer DLL liegen, da diese in jeden Prozess injeziert wird.

Zitat:
Aber warum funktioniert dann der Keyboard Hook?
Er ist nicht global und liegt nicht in einer DLL? Aber das musst du doch wissen. Du hast das Programm doch geschrieben. Und außerdem steht das alles in jedem Hook Tutorial drin.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 05:20 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