AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen FreePascal Tastaturhook 64bit von Delphi -> FPC (Lazarus)
Thema durchsuchen
Ansicht
Themen-Optionen

Tastaturhook 64bit von Delphi -> FPC (Lazarus)

Ein Thema von erich.wanker · begonnen am 9. Apr 2010 · letzter Beitrag vom 10. Apr 2010
Antwort Antwort
Benutzerbild von erich.wanker
erich.wanker

Registriert seit: 31. Jan 2008
Ort: im schönen Salzburger Land
460 Beiträge
 
Delphi XE4 Professional
 
#1

Tastaturhook 64bit von Delphi -> FPC (Lazarus)

  Alt 9. Apr 2010, 15:01
Hallo Leute,

ich hab eine 32bit DLL "Versatile.dll", um auf eine Eingabe vom Barcode-scanner (und F4) zu reagieren.
(Barcodescanner schickt als erstes "HardwareDevice4" als Ascii zur Indentifizierung)
Um das ganze auf einem 64bit Windows zu betreiben, hab ich mir jetzt Lazarus (v0.9.28.2 Beta) installiert -
und versuch grad, das ganze als "Versatile64.dll" zum laufen zu bringen Leider ohne Erfolg ..

Kann mir jemand sagen, was bei PHookRec1, AryChar, KeyHookFunc und DLLProc falsch ist?

Vielen Dank

Erich



Delphi-Quellcode:
library Versatile64;

{$mode objfpc}{$H+}

uses
 Classes,
 Windows,
 ActiveX,
 ShlObj,
 Messages,
 SysUtils;

type

  THookRec = record
    AppHnd: Integer;
    MemoHnd: Integer;
  end;
  PHookRec = ^THookRec;

var
  Hooked: Boolean;
  hKeyHook, hMemo, hMemFile, hApp: HWND;
  PHookRec1: PHookRec;




function KeyHookFunc(Code, VirtualKey, KeyStroke: Integer): LRESULT; stdcall;
var
  KeyState1: TKeyBoardState;
  AryChar: array[0..1] of Char;
  Count: Integer;
begin


  Result := 0;

  if Code = HC_NOREMOVE then Exit;
  Result := CallNextHookEx(hKeyHook, Code, VirtualKey, KeyStroke);
  if Code < 0 then Exit;

  if Code = HC_ACTION then
  begin

    if ((KeyStroke and (1 shl 30)) <> 0) then
      if not IsWindow(hMemo) then
      begin
        hMemFile := OpenFileMapping(FILE_MAP_WRITE, False, 'Versatile_mapping');
        PHookRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);

        if PHookRec1 <> nil then
        begin
         hMemo := PHookRec1.MemoHnd;
         hApp := PHookRec1.AppHnd;
        end;
      end;




    if ((KeyStroke and (1 shl 30)) <> 0) then
    begin
      GetKeyboardState(KeyState1);
      Count := ToAscii(VirtualKey, KeyStroke, KeyState1, AryChar, 0);

      if VirtualKey = VK_F4 then
      begin
        PostMessage(hApp, WM_USER + 8765, 300 , 0);
      end;

      if Count = 1 then
      begin
         PostMessage(hApp, WM_USER + 8765, Ord(AryChar[0]), 0);
      end;
    end;
  end;

  // ........

end; // procedure




function StartHook(MemoHandle, AppHandle: HWND): Byte; export;
begin
  Result := 0;
  if Hooked then
  begin
    Result := 1;
    Exit;
  end;
  if not IsWindow(MemoHandle) then
  begin
    Result := 4;
    Exit;
  end;
  hKeyHook := SetWindowsHookEx(WH_KEYBOARD, KeyHookFunc, hInstance, 0);
  if hKeyHook > 0 then
  begin

    hMemFile := CreateFileMapping($FFFFFFFF, // $FFFFFFFF gets a page memory file
      nil, // no security attributes
      PAGE_READWRITE, // read/write access
      0, // size: high 32-bits
      SizeOf(THookRec), // size: low 32-bits
      //SizeOf(Integer),
      'Versatile_mapping'); // name of map object
    PHookRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
    hMemo := MemoHandle;
    PHookRec1.MemoHnd := MemoHandle;
    hApp := AppHandle;
    PHookRec1.AppHnd := AppHandle;
    {set the Memo and App handles to the mapped file}
    Hooked := True;
  end
  else
    Result := 2;
end;



function StopHook: Boolean; export;
begin
  if PHookRec1 <> nil then
  begin
    UnmapViewOfFile(PHookRec1);
    CloseHandle(hMemFile);
    PHookRec1 := nil;
  end;
  if Hooked then
    Result := UnhookWindowsHookEx(hKeyHook)
  else
    Result := True;
  Hooked := False;
end;

procedure EntryProc(dwReason: DWORD);
begin
  if (dwReason = Dll_Process_Detach) then
  begin
    if PHookRec1 <> nil then
    begin
      UnmapViewOfFile(PHookRec1);
      CloseHandle(hMemFile);
    end;
    UnhookWindowsHookEx(hKeyHook);
  end;
end;

exports
  StartHook,
  StopHook;

begin
  PHookRec1 := nil;
  Hooked := False;
  hKeyHook := 0;
  hMemo := 0;
  DLLProc := @EntryProc;
  EntryProc(Dll_Process_Attach);
end.
Erich Wanker - for life:=1971 to lebensende do begin ..
  Mit Zitat antworten Zitat
mkinzler
(Moderator)

Registriert seit: 9. Dez 2005
Ort: Heilbronn
39.858 Beiträge
 
Delphi 11 Alexandria
 
#2

Re: Tastaturhook 64bit von Delphi -> FPC (Lazarus)

  Alt 9. Apr 2010, 15:06
http://cc.embarcadero.com/Item/27667
Markus Kinzler
  Mit Zitat antworten Zitat
Benutzerbild von erich.wanker
erich.wanker

Registriert seit: 31. Jan 2008
Ort: im schönen Salzburger Land
460 Beiträge
 
Delphi XE4 Professional
 
#3

Re: Tastaturhook 64bit von Delphi -> FPC (Lazarus)

  Alt 9. Apr 2010, 15:55
Ich hab Delphi7 ...

Hab mir uBridge32 organisiert. Wenn ich nun "CustardBridge:= TD2X64Bridge.create(true,false);" einbaue -mekert die uBridge32.pas beim compieren ..
Erich Wanker - for life:=1971 to lebensende do begin ..
  Mit Zitat antworten Zitat
Delphi-Laie

Registriert seit: 25. Nov 2005
1.474 Beiträge
 
Delphi 10.1 Berlin Starter
 
#4

Re: Tastaturhook 64bit von Delphi -> FPC (Lazarus)

  Alt 9. Apr 2010, 16:39
Zitat von erich.wanker:
Hallo Leute,

ich hab eine 32bit DLL "Versatile.dll", um auf eine Eingabe vom Barcode-scanner (und F4) zu reagieren.
(Barcodescanner schickt als erstes "HardwareDevice4" als Ascii zur Indentifizierung)
Um das ganze auf einem 64bit Windows zu betreiben, hab ich mir jetzt Lazarus (v0.9.28.2 Beta) installiert -
und versuch grad, das ganze als "Versatile64.dll" zum laufen zu bringen Leider ohne Erfolg ..
Ein kleiner Aufmunterungsversuch: Bei meinem Hookprogramm (konkret der DLL) funktionierte die Portierung nach 64 Bit problemlos. Am DLL-Quelltext mußte nach meiner vorsichtigen Erinnerung nur sehr wenig verändert werden, um ihn von Delphi nach Lazarus 32 Bit zu migrieren: Es waren nur der Delphi-Modus-Schalter und einzelne Semikola (die nach Objektpascalsyntax nicht nötig waren und die Lazarus demnach zusätzlich benötigte) hinzuzufügen. Die Portierung nach 64 Bit war dann ohne jeden Zusatzaufwand, denn Lazarus 64 Bit compilierte den Quelltext, den auch das 32-Bit-Lazarus akzeptierte, problemlos und mit funktionierendem Ergebnis!
  Mit Zitat antworten Zitat
hoika

Registriert seit: 5. Jul 2006
Ort: Magdeburg
8.275 Beiträge
 
Delphi 10.4 Sydney
 
#5

Re: Tastaturhook 64bit von Delphi -> FPC (Lazarus)

  Alt 9. Apr 2010, 16:39
Hallo,

da nicht alle den Quellcode der Unit nicht haben,
wäre die genaue Compiler-Fehlermeldung + die Definition des Konstruktors sinnvoll.


Heiko
Heiko
  Mit Zitat antworten Zitat
PhiS

Registriert seit: 10. Apr 2010
1 Beiträge
 
RAD-Studio 2010 Pro
 
#6

Re: Tastaturhook 64bit von Delphi -> FPC (Lazarus)

  Alt 10. Apr 2010, 21:31
constructor TD2X64Bridge.create (TryUseTSC: boolean=true; TryUseAVX: boolean=false); Der Konstruktor setzt nur ein paar private Felder und macht einen Call zu GetSystemInfo.

Hab kein funktionierendes D7 mehr, aber versucht, ubridge32 mit meiner ältesten funktionierenden Version (D2006) kompilierbar zu halten. Ich wäre auch daran interessiert, zu wissen, welchen Teil D7 nicht kompilieren will. Vielleicht irgendwelche Typen, die da noch nicht von Haus aus deklariert sind?

Philipp
  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 16:13 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