Алексей Павлов
дата публикации 19-12-2001 18:21

---

Версия для печати

Статическая загрузка:

...
implementation

function ShowMyDialog(Msg: PChar): Boolean; stdcall; 
     external 'project1.dll';
procedure SetValue(); cdecl; external 'some.dll'; 
... 

Динамическая загрузка:

...
uses
...
type
{ определяем процедурный тип, 
  отражающий экспортируемую процедуру или ф-ию }
  TMyProcType = procedure (flag : Boolean); stdcall;
  TMyFuncType = function (Msg: PChar): Boolean; cdecl;
{ эту операцию можно сделать непосредственно в разделе 
var процедуры,  в которой вы будете загружать dll }
...
procedure TForm1.Button1Click(Sender: TObject);
var
SetValue: TMyProcType; { объявляем переменные процедурного типа}
ShowDialog: TMyFuncType; 

// или можно было сделать так (в таком случае type... не нужен): 
// SetValue: procedure (flag : Boolean); stdcall;
// ShowDialog: function (Msg: PChar): Boolean; cdecl; 

Handle01, Handle02: HWND; { дескрипторы, загружаемых библиотек } 

begin
; { загрузка dll }
Handle01:= LoadLibrary(PChar('project1.dll'))
try 
  { получаем указатель на необходимую процедуру}
  @ShowDialog:=GetProcAddress(Handle01, 'ShowMyDialog'); 
  { используем ф-ию }
  ShowDialog(PChar('Dll function is working !!!')); 
except
  ShowMessage('Ошибка при попытке использовать dll !');
finally
FreeLibrary(Handle01); { выгружаем dll }
end; { try }
end;
end. 

1. Регистрация dll в системе ( или как бы нам, воспользовавшись особенностями приложения Explorer.exe, заставить его загрузить нашу библиотеку в его адресное пространство).
2. Размещение модальных форм в dll.
3. Размещение "готовых" файловых образов библиотек в EXE-файле с последующим их извлечением и использованием.
4. Как в своих dll использовать процедуры и ф-ии, находящиеся в других библиотеках.
5. Удаление программы "во время исполнения".
6. Ловушки в dll.

• 1). в HKEY_CLASSES_ROOT\CLSID задать новый идентификатор класса (GUID).
• 2). в HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\ShellServiceObjectDelayLoad создать раздел InProcServer32 и в значение этого раздела записать путь к вашей dll, которая должна грузиться при загрузке Windows.
• 3). создать строковый параметр MyDllLoad со значением, равным определённому нами GUID.

Реализация данного способа имеет следующий вид:

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, 
  Controls, Forms, Dialogs, registry;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var 
reg:Tregistry;

begin
reg:=Tregistry.create;
reg.rootkey:=HKEY_CLASSES_ROOT;

{Теперь настала пора создать идентификатор для нашей библиотеки. 
 Идентификатор класса - это  глобальный уникальный идентификатор,
 состоящий из шеснадцатиричных цифр. 
 В него входят метка времени создания 
 и адрес платы сетевого интерфейса, попросту говоря MAC, 
 или фиктивный адрес платы при отсутствии оной 
 в вашем компьютере 8) 
 Получить этот идентификатор можно двумя путями: 
 1). в Delphi, в любом месте редактора кода нажать Ctrl-Shift-G . 
 2). или воспользоваться API функцией CoCreateGUID();}

try
 reg.openkey (
 'CLSID\{69502F20-E8CD-11D5-A784-0050BF44BD3B}\InProcServer32', 
 true);
 reg.writestring('',
 'C:\TEMP\MyDll.dll');
 reg.closekey;
 reg.rootkey:=HKEY_LOCAL_MACHINE;
 reg.openkey(
 'Software\Microsoft\Windows\CurrentVersion\ShellServiceObjectDelayLoad', 
 true);
 reg.writestring('MyDllLoade',
 '{69502F20-E8CD-11D5-A784-0050BF44BD3B}');
 reg.closekey;

finally
 reg.free;
end; {try}

end;

end.

Размещение модальных форм в dll.

library ModelF;

uses
  Windows, Messages, SysUtils, Classes, Graphics, 
  Controls, Forms, Dialogs,StdCtrls,
  Unit1 in 'Unit1.pas' {Form1};

function ShowMyDialog(Msg: PChar): Boolean;  stdcall;
begin
  {Создаем экземпляр Form1 формы TForm1}
  Form1 := TForm1.Create(Application);
  {В Label1 выводим сообщение Msg}
  Form1.Label1.Caption := StrPas(Msg);
  {Возвращаем True если нажата OK (ModalResult = mrOk)}
  Result := (Form1.ShowModal = mrOk);
  Form1.Free;
end;

exports ShowMyDialog;

begin
end.

unit main2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, 
  Controls, Forms, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
function ShowMyDialog(Msg: PChar): Boolean;  stdcall; 
  external 'project1.dll';
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
if ShowMyDialog(PChar('Work !!!'))= TRUE then
ShowMessage('TRUE !')
ELSE
ShowMessage('FALSE !');
end;

end.

Размещение "готовых" файловых образов библиотек в EXE-файле с последующим их извлечением и использованием.

MYDLL RCDATA 
mydll.dll 

brcc32.exe Lib.rc 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, 
  Controls, Forms, Dialogs,StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM} {$R Lib.RES}


procedure TForm1.Button1Click(Sender: TObject);
var
MyDll1: TResourceStream;
begin
MyDll1:=TResourceStream.Create(hInstance, 'MYDLL', RT_RCDATA);
try
  MyDll1.SaveToFile('duck.dll');
finally
  MyDll1.Free;
end;{try}

end;

end.

Как в своих dll использовать процедуры и ф-ии, находящиеся в других библиотеках.

unit gather_it;

interface

function MyFunc001(i: integer): PChar;
procedure MyProc002 ();
function MyFunc003(): Integer;
// ..........................
procedure Something();

implementation

function MyFunc001; external '001.dll';
procedure MyProc002; external '002.dll';
function MyFunc003; external '003.dll';
// ..........................
procedure Something; external 'some_other.dll';

end.

Удаление программы "во время исполнения".

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

************************ DLL ************************
library test1;

uses
  Windows;

procedure test(); stdcall;
begin
//Sleep(5); {можно задерживать выполнение кода при необходимости 8}
DeleteFile(PChar('D:\Project1.exe'));
{
ВНИМАНИЕ, до тех пор, пока выполняющийся процесс, 
загруженный из Project1.exe,
не выполнит команду FreeLibrary(собственный экземпляр) 
в Win9x/Me либо UnmapViewOfFile в 
NT/W2k, вы будете получать ошибку. Связанно это с тем, что эти 
вызовы ни в том ни в другом виде не 
вставляются автоматически компилятором Делфи в эпилог приложения. 
Вместо этого после выполнения эпилогом приложения 
вызова ExitProcess() ОС автоматически разорвет связь 
между процессом и файлом, вызвав ту или иную из вышеуказанных API-ф-ций. 
}
FreeLibrary(GetModuleHandle(NIL));
end;

exports test;

begin
// MessageBox(Handle, 'Library loaded !', 'Yeh... !!!', 0); 
end.
************************ DLL ************************

- ну а та часть exe файла, которая отвечает за загрузку dll может выглядеть так:

...
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(0, Nil,'rundll32.exe', 
  ' test1.dll,test', Nil, SW_ShowNormal);
Close;
end;
...

Исходник лежит в каталоге SelfDelete

Ловушки в dll.

library hook_dll;

uses Windows, Messages;

var
SysHook : HHook = 0;
Wnd : Hwnd = 0;

{ данная ф-ия вызывается системой каждый раз, 
когда возникает какое-то событие в
dialog box-е, message box-е, menu, или scroll bar-е}
function SysMsgProc(code : integer; wParam : word; 
   lParam : longint) : longint; stdcall;
begin
{ Передаём сообщение дальше по цепочке hook-ов. }
CallNextHookEx(SysHook, Code, wParam, lParam);
{ флаг code определяет тип произошедшего события. }
if code = HC_ACTION then
begin
{ В wnd кладу дескриптор того окна, которое 
   сгенерировало сообщение.}
Wnd:=TMsg(Pointer(lParam)^).hwnd;
{ Проверяю, нажата ли правая кнопка мыши}
if TMsg(Pointer(lParam)^).message = WM_RBUTTONDOWN then
begin
{ Раскрываю окно на всю клиентскую область.}
ShowWindow(wnd, SW_MAXIMIZE);
{ Вывожу сообщение.}
MessageBox(0, 'HOOK is working !', 
  'Message', 0);
end;
end;
end;

{ Процедура установки HOOK-а}

procedure hook(switch : Boolean) export; stdcall;
begin
if switch=true then
begin
{ Устанавливаю HOOK, если он не установлен (switch=true). }
SysHook := SetWindowsHookEx(WH_GETMESSAGE, @SysMsgProc, HInstance, 0);
{ тут: WH_GETMESSAGE - тип hook-а ; 
@SysMsgProc - адрес процедуры обработки ;
  HInstance - указывает на DLL, содержащую процедуру обработки hook-а; 
  последний параметр указывает на thread, 
  с которым ассоциирована процедура обработки hook-а;
}
MessageBox(0, 'HOOK установлен !', 
   'Сообщение из DLL', 0);
end
else
begin
{ Снимаю HOOK, если он установлен (switch=false). }
UnhookWindowsHookEx(SysHook);
MessageBox(0, 'HOOK снят !', 
   'Сообщение из DLL', 0);
SysHook := 0;
end;
end;

exports hook;

begin
//MessageBox(0, 'MESSAGE FROM DLL  - loaded !', 
   'Message', 0);
end.

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;
  { дескриптор загружаемой dll-ки (для динамической загрузки)}
  Hdll : HWND; 

implementation
{ раскоментируйте эту строку для статической загрузки }
//procedure hook(state: boolean); stdcall; external 'hook_dll.dll';

{$R *.DFM}


procedure TForm1.Button1Click(Sender: TObject);
var
hook: MyProcType; {для динамической загрузки}

begin
{ раскоментируйте эту строку для статической загрузки }
//hook(true);

{ ********* динамическая загрузка **************}
 { загрузка dll }
Hdll:= LoadLibrary(PChar('hook_dll.dll'));
 if Hdll > HINSTANCE_ERROR then            
 { если всё без ошибок, то }
 { получаем указатель на необходимую процедуру}
 @hook:=GetProcAddress(Hdll, 'hook')       
 else
 ShowMessage('Ошибка при загрузке dll !');
{ **********************************************}

 hook(true);

Button2.Enabled:=True;
Button1.Enabled:=False;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
hook: MyProcType; {для динамической загрузки}

begin
{ раскоментируйте эту строку для статической загрузки }
//hook(false);

{ ********* динамическая загрузка **************}
{ получаем указатель на необходимую процедуру}
hook:=GetProcAddress(Hdll, 'hook'); 
{ **********************************************}
hook(false); { обращение к процедуре }

Button1.Enabled:=True;
Button2.Enabled:=False;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeLibrary(Hdll); { при закрытии формы - выгружаем dll }
end;

end.

Исходник лежит в каталоге Hooks

Алексей Павлов
The adviser: - Digitman
Special thanks to: - Fellomena
декабрь 2001г.
статья представлена для публикации автором

Скачать проект UsesDll.zip (47 K)

• О загрузке дочерней формы (MDIChild) из DLL.
• Подгружаемые модули (plugins) в Delphi
• Еще раз о Plugin's…
• Вопросы Круглого стола по теме DLL