Новичок
Профиль
Группа: Участник
Сообщений: 8
Регистрация: 20.12.2007
Репутация: нет
Всего: нет
|
нашел исходник: тутя попытался сделать чтоб он работал без Dll(скопировал все функции и процедуры в основную программу) Но возникли какието ошибки: Что не так? помогите плз код DLL:| Код |
library hook_dll2;
uses Windows,Messages,Forms;
var
SysHook : HHook = 0;
Wnd : Hwnd = 0;
function SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
begin
if code = HC_ACTION then
begin
Wnd:=TMsg(Pointer(lParam)^).hwnd;
if TMsg(Pointer(lParam)^).message = WM_RBUTTONDOWN then
MessageBox(0, 'HOOK2 working !', 'Message from Exampel1/Process2', 0);
end;
Result:=CallNextHookEx(SysHook, Code, wParam, lParam);
end;
procedure hook(switch : Boolean) export; stdcall;
begin
if switch=true then
begin
if SysHook <> 0 then
MessageBox(0, 'HOOK2 установлен !', 'Message from Exampel1/Process2', 0)
else
MessageBox(0, 'HOOK2 установить не удалось !', 'Message from Exampel1/Process2', 0);
end
else
begin
if UnhookWindowsHookEx(SysHook) then
MessageBox(0, 'HOOK2 снят !', 'Message from Exampel1/Process2', 0)
else
MessageBox(0, 'HOOK2 снять не удалось !', 'Message from Exampel1/Process2', 0);
SysHook := 0;
end;
end;
exports hook;
begin
MessageBox(0, PChar(Application.ExeName), 'Message from Exampel1/Process2', 0);
end.
|
| Код |
// Example1, Process2 //
// @Aleksey Pavlov //
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
{для динамической загрузки функций из DLL}
type
MyProcType = procedure (flag : Boolean); stdcall;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Hdll : HWND; { дескриптор загружаемой DLL (для динамической загрукзки)}
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
hook: MyProcType;
begin
@hook:= nil; // инициализируем переменную hook
{ ********* динамическая загрузка **************}
Hdll:= LoadLibrary(PChar('hook_dll2.dll')); { загрузка DLL }
if Hdll > HINSTANCE_ERROR then { если всё без ошибок, то }
begin
@hook:=GetProcAddress(Hdll, 'hook'); { получаем указатель на необходимую процедуру}
Button2.Enabled:=True;
Button1.Enabled:=False;
hook(true);
end
else
ShowMessage('Ошибка при загрузке DLL !');
{ **********************************************}
end;
procedure TForm1.Button2Click(Sender: TObject);
var
hook: MyProcType;
begin
@hook:= nil; // инициализируем переменную hook
if Hdll > HINSTANCE_ERROR then
begin { если всё без ошибок, то }
@hook:=GetProcAddress(Hdll, 'hook'); { получаем указатель на необходимую процедуру}
Button1.Enabled:=True;
Button2.Enabled:=False;
hook(false); {вызываем нужную процедуру из DLL}
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeLibrary(Hdll); { при закрытии формы - освобождаем DLL }
end;
end.
|
[B]Вот что я сделал:B] | Код |
// Example1, Process2 //
// @Aleksey Pavlov //
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
MyProcType = procedure (flag : Boolean);
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Hdll : HWND; { дескриптор загружаемой DLL (для динамической загрукзки)}
SysHook : HHook = 0; // ОШИБКА !!!
Wnd : Hwnd = 0;
implementation
function SysMsgProc(code : integer; wParam : word; lParam : longint) : longint;
begin
if code = HC_ACTION then
begin
{В wnd кладу дескриптор того окна, которое сгенерировало сообщение, т.е.
окна, которое вызвало GetMessage или PeekMessage - это может пригодиться при
ведении файла диагностики }
Wnd:=TMsg(Pointer(lParam)^).hwnd;
{Проверяю, нажата ли правая кнопка мыши}
if TMsg(Pointer(lParam)^).message = WM_RBUTTONDOWN then
{Вывожу сообщение.}
MessageBox(0, 'HOOK2 working !', 'Message from Exampel1/Process2', 0);
end;
{Пытаемся передать сообщение дальше по цепочке hook-ов. }
Result:=CallNextHookEx(SysHook, Code, wParam, lParam);
end;
{Процедура установки HOOK-а}
procedure hook(switch : Boolean);
begin
if switch=true then
begin
{Устанавливаю HOOK, если он не установлен (switch=true). }
SysHook := SetWindowsHookEx(WH_GETMESSAGE, @SysMsgProc, HInstance, 0);
{здесь: WH_GETMESSAGE - тип hook-а ; @SysMsgProc - адресс функции-фильтра ;
HInstance - указывает на DLL, содержащую процедуру обработки ловушки; последний
параметр указывает на поток(thread), с которым ассоциирована функция-фильтр;
}
if SysHook <> 0 then
MessageBox(0, 'HOOK2 установлен !', 'Message from Exampel1/Process2', 0)
else
MessageBox(0, 'HOOK2 установить не удалось !', 'Message from Exampel1/Process2', 0);
end
else
begin
{Удаляю функцию-фильтр, если она установлена (т.е. switch=false). }
if UnhookWindowsHookEx(SysHook) then
MessageBox(0, 'HOOK2 снят !', 'Message from Exampel1/Process2', 0)
else
MessageBox(0, 'HOOK2 снять не удалось !', 'Message from Exampel1/Process2', 0);
SysHook := 0;
end;
end;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
hook: MyProcType;
begin
@hook:= nil; // инициализируем переменную hook
hook(true);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
hook: MyProcType;
begin
@hook:= nil; // инициализируем переменную hook
hook(false); {вызываем нужную процедуру из DLL}
end;
end.
|
Я просто переписал функцию и процедуру из dll в основную программу,но что -то не работает,помогите плз что не так? Ошибка Access violation of adress 0000000 read of adress 0000000указывает на Wnd:=TMsg(Pointer(lParam)^).hwnd; |
hook, hook 
Загрузка ...
