DLL<->Exe

Народ такая ситуация Есть прога и к ней прикручена DLL. Когда программа загружается, она динамически подгружает DLL и устанавливает хук на клаву. По нажатию определённой клавиши и срабатывании хука мне нужно чтобы сработала процедура и передала данные в программу ИЛИ при срабатывании хука DLL просто передала(не важно как он будет выглядеть, главное чтобы прога смогла его уволить) сигнал в главную программу и там процедура сработала. Не знаю как это реализовать( работать когда из программы вызывается процедура в DLL я научился, а вот наоборот нет( подскажите хотя бы в какую сторону копать, а то уже куча инфы перерыл и что-то нифига.
9 ответов

Изучай это: http://ru.wikipedia.org/wiki/Callbac...E0%ED%E8%E5%29 Как один из способов генерации событий - в обработчик хука передаешь указатель на некую процедуру в своей проге, и хук вызывает ее при обработке.


Спасибо, буду изучать.


Чета пошарил по интернету, но так и не получилось вызвать из DLL в EXE процедуру. Подскажите, может есть какие примеры?


Есть вот такое у меня: Описание типа каллбэка:
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.
Оно конечно кривовасто, но так для наглядности пойдетъ. h:=hook(@callbackMe); - Сюда передается указатель на каллбэк-процедуру if Assigned(cb) then cb(nCode,wPara,lPara); - это вызов каллбэка.


Вообщем что-то он у меня её не вызывает(( Код DLL
library KeyHook;

uses
 System.Classes,
 System.SysUtils,
 Windows;

 Type TCallback = procedure();
var
 hook: HHOOK;
 CallBack: TCallback;

function KeyboardHook(Code: integer; wParam: word; lParam: longint): longint; stdcall;
begin
 if (Code = HC_ACTION) then
 if wParam = VK_SNAPSHOT then
 if Assigned(CallBack) then
 begin
 CallBack();
 end;
 result := CallNextHookEx(hook, Code, wParam, lParam); // Обязательный result
end;

Function SetKeyHook(aCallBack: TCallback): Cardinal; export;
begin
 CallBack := aCallBack;
 if hook=0 then
 hook := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHook, hInstance, 0);
 Result := hook;
end;

procedure DelKeyHook; export;
begin
 if (hook <> 0) then UnhookWindowsHookEx(hook);
 hook := 0;
end;

exports DelKeyHook, SetKeyHook;
begin
end.
Код главной формы. Весь лишний код убрал, оставил лишь самое главное
unit MainForm;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.AppEvnts, Vcl.Menus,
 Vcl.ExtDlgs, Vcl.ActnList, Vcl.StdActns, ShlObj, ShellAPI, Vcl.ImgList, SettingsForm,
 Vcl.Mask, Vcl.Buttons, System.Actions, System.UITypes;

type
 TMain = class(TForm)
 procedure FormCreate(Sender: TObject);
 procedure FormDestroy(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }

 end;

 Type TCallback=procedure();

const
 CSIDL_MYPICTURES = $27; //мои картинки
 CSIDL_MYDOCUMENTS = $0005; //мои документы

 procedure Call;

var
 Main: TMain;
 DLLRoutine: procedure;
 DLLHandle: THandle;

implementation

uses CaptureForm;

 function SetKeyHook(acb:TCallback):Cardinal; external 'KeyHook.dll';

procedure Call;
begin
 ShowMessage('Процедура сработала');
end;

procedure TMain.FormCreate(Sender: TObject);
var
 CBPoint: Cardinal;
begin
 DLLHandle := LoadLibrary('KeyHook.dll');
 try
 DLLRoutine := GetProcAddress(DLLHandle, 'SetKeyHook');
 if Assigned(DLLRoutine) then
 begin
 CBPoint := SetKeyHook(@Call);
 Caption := IntToStr(CBPoint); //чтобы посмотреть работает или нет
 DLLRoutine;
 end;
 except
 MessageDlg('Невозможно установить хук. Продолжение работы программы невозможно.', mtError,[mbOK], 0);
 FreeLibrary(DLLHandle);
 Application.Terminate();
 end;
 aeMainMinimize(Sender);
end;

procedure TMain.FormDestroy(Sender: TObject);
begin
 try
 DLLRoutine := GetProcAddress(DLLHandle, 'DelKeyHook');
 if Assigned(DLLRoutine) then
 DLLRoutine;
 finally
 MessageDlg('Невозможно удалить хук.', mtError,[mbOK], 0);
 FreeLibrary(DLLHandle);
 end;
end;

end.
Так вот всё норм грузиться и работает, но когда я нажимаю на клавишу PrintScreen у меня не появляется сообщение, но этот код
CBPoint := SetKeyHook(@Call);
 Caption := IntToStr(CBPoint); //чтобы посмотреть работает или нет
вроде как работает, т.к. Caption меняется. Где что я делаю не так?


Есть подозрение, что клавиша PrintScreen неудачная, она ведь обрабатывается системой.


1)что за двойной вызов одной и той же процедуры то с параметрами то без?(причем один со статической загрузкой, второй с динамической) 2)при хуках длл грузится в другие приложения, и из них колбэк уже не работает, причем на практике даже переменная колбэка пустует. для межпроцессного взаимодействия нужен иной метод.
Есть подозрение, что клавиша PrintScreen неудачная, она ведь обрабатывается системой.
приложения получают её(игры же получают, обычно сохраняя файл в папку скриншотов, а не в буфер)


приложения получают её(игры же получают, обычно сохраняя файл в папку скриншотов, а не в буфер)
Иногда нужно давать неправильные ответы, чтобы получить правильный.


Народ но это нифига не весело, какие ещё могут быть варианты, как можно реализовать?