Последние записи

made in programmersforum 5

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

10th
Окт

Вызвать из DLL в EXE процедуру

Posted by Chas under Delphi

Как один из способов генерации событий — в обработчик хука передаnm указатель на некую процедуру в своей проге, и хук вызывает ее при обработке.

Stilet
Есть вот такое у меня:
Описание типа каллбэка:

unit unitCallback;
{$mode objfpc}{$H+}
interface
type

  TCallback=procedure(nCode:longInt;wPara,lPara:integer);

implementation
end.

Сама ДЛЛ:

library hdll;
{$mode objfpc}{$H+}
uses

  Classes,windows, unitCallback

  { you can add units after this };
var h:HHOOK; f:textfile; cb:TCallback;
  function hEvent(nCode:longInt;wPara,lPara:integer):LRESULT; stdcall;

  var d:PCWPRETSTRUCT;

  begin

    if (nCode>=0)and(wPara=0) then begin

      // if and(d^.message in [WM_PAINT]) then

      //d:=PCWPRETSTRUCT(lPara);

      //WriteLn(f,'lPara');

      //WriteLn(f,d^.hwnd,#9#9,d^.message,#9#9,d^.lParam,#9#9,d^.wParam);

      if Assigned(cb) then cb(nCode,wPara,lPara);

    end;

   Result:=CallNextHookEx(h,nCode,wPara,lPara);

  end;
function Hook(acb:TCallback):Cardinal;   export;

var hp:HOOKPROC;

begin

   cb:=acb;

  //AssignFile(f,'c:\1.txt'); Rewrite(f);

  //WriteLn(f,'hwnd',#9#9,'message',#9#9,'LParam',#9#9,'WParam');

 // hp:=@hEvent;

  h:=SetWindowsHookEx(WH_CALLWNDPROCRET,@hEvent,HINSTANCE,0);

  Result:=h;

end;
procedure Unhook; export;

begin

 UnhookWindowsHookEx(h);

 //closefile(f);

end;
exports Hook,Unhook;

begin

end.

Главный модуль:

unit Unit1;
{$mode objfpc}{$H+}
interface
uses    windows,  unitCallback,

  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
  { TForm1 }
  TForm1 = class(TForm)

    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);

    procedure FormCreate(Sender: TObject);

  private

    { private declarations }

  public
    { public declarations }

  end;

 procedure callbackMe(nCode:longInt;wPara,lPara:integer);

 Function Hook(acb:TCallback):Cardinal; external 'hdll.dll';

 procedure Unhook; external 'hdll.dll';
var     st:TstringList;

  Form1: TForm1;
implementation
procedure callbackMe(nCode: longInt; wPara, lPara: integer);

var d:PCWPRETSTRUCT; c,t:array[1..100] of char;

begin

 d:=Pointer(lPara);

 if not (d^.message in [WM_PAINT,WM_ERASEBKGND]) then exit;

 FillChar(c,100,0);FillChar(t,100,0);

 GetClassName(d^.hwnd,@c[1],100);

 GetWindowText(d^.hwnd,@t[1],100);

 st.Append(format('hwnd=%20d  msg=%20d lParam=d%20d wParam=%20d ('+Trim(c)+') - ['+trim(t)+']'

  ,[d^.hwnd,d^.message,d^.lParam,d^.wParam]));

end;
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);

begin

  Unhook;

  st.SaveToFile(ExtractFilePath(ParamStr(0))+'hook.txt');

end;
procedure TForm1.FormCreate(Sender: TObject);

var h:Cardinal;

begin

  st:=TStringList.Create;

  h:=hook(@callbackMe);

  if h=0 then RaiseLastOSError else Caption:=IntToStr(h);

end;
end.