Plugin management framework for Delphi (2)

Unit untdllmanager;

Interface

Uses

Windows, classes, sysutils, forms;

Type

Edllerror = Class (exception );

Tdllclass = Class of tdll;

Tdll = Class;

Tdllevent = procedure (Sender: tobject; adll: tdll) of object;

{Tdllmanager

O provides DLL management functions;

O automatically creates a tdll object when adding, but does not try to load it;

O automatically destroys the tdll object during the delete operation;

}

Tdllmanager = Class (tlist)

Private

Flock: trtlcriticalsection;

Fdllclass: tdllclass;

Fondllload: tdllevent;

Fondllbeforeunloaded: tdllevent;

Function getdlls (const index: integer): tdll;

Function getdllsbyname (const filename: string): tdll;

Protected

Procedure week Y (PTR: pointer; Action: tlistnotification); override;

Public

Constructor create;

Destructor destroy; override;

Function add (const filename: string): integer; overload;

Function indexof (const filename: string): integer; overload;

Function remove (const filename: string): integer; overload;

Procedure lock;

Procedure unlock;

Property dllclass: tdllclass read fdllclass write fdllclass;

Property DLLs [const index: integer]: tdll read getdlls; default;

Property dllsbyname [const filename: String]: tdll read getdllsbyname;

Property ondllloaded: tdllevent read fondllload write fondllload;

Property ondllbeforeunloaded: tdllevent read fondllbeforeunloaded write fondllbeforeunloaded;

End;

{Tdll

O represents a DLL, windows. hmodule

O automatically deletes itself from the owner upon destruction;

O sub-classes can be extended by overwriting dodllloaded and dodllunloaded;

}

Tdll = Class (tobject)

Private

Fowner: tdllmanager;

Fmodule: hmodule;

Ffilename: string;

Fpermit: Boolean;

Procedure setfilename (const value: string );

Function getloaded: Boolean;

Procedure setloaded (const value: Boolean );

Procedure setpermit (const value: Boolean );

Protected

Procedure dodllloaded; virtual;

Procedure dobeforedllunloaded; virtual;

Procedure dodllunloaded; virtual;

Procedure dofilenamechange; virtual;

Procedure dopermitchange; virtual;

Public

Constructor create; virtual;

Destructor destroy; override;

Function getprocaddress (const order: longint): farproc; overload;

Function getprocaddress (const procname: string): farproc; overload;

Property filename: String read ffilename write setfilename;

Property loaded: Boolean read getloaded write setloaded;

Property Owner: tdllmanager read fowner;

Property permit: Boolean read fpermit write setpermit;

End;

Implementation

{Tdll}

Constructor tdll. Create;

Begin

Fowner: = nil;

Ffilename: = '';

Fmodule: = 0;

Fpermit: = true;

End;

Destructor tdll. Destroy;

VaR

MANAGER: tdllmanager;

Begin

Loaded: = false;

If fowner <> nil then

Begin

// Delete itself from the owner

MANAGER: = fowner;

// It is not prevented from being deleted repeatedly in tdllmanager. Therefore, you need

// Set fowner to nil; <-- this segmentCodeWork with tdllmanager. Notify

// Make sure that it is correct.

Fowner: = nil;

Manager. Remove (Self );

End;

Inherited;

End;

Function tdll. getloaded: Boolean;

Begin

Result: = fmodule <> 0;

End;

Function tdll. getprocaddress (const order: longint): farproc;

Begin

If loaded then

Result: = windows. getprocaddress (fmodule, pointer (Order ))

Else

Raise edllerror. createfmt ('Do load before getprocaddress of "% u" ', [DWORD (Order)]);

End;

Function tdll. getprocaddress (const procname: string): farproc;

Begin

If loaded then

Result: = windows. getprocaddress (fmodule, pchar (procname ))

Else

Raise edllerror. createfmt ('Do load before getprocaddress of "% s" ', [procname]);

End;

procedure tdll. setloaded (const value: Boolean );
begin
If loaded <> value then
begin
if not value then

begin
assert (fmodule <> 0 );
dobeforedllunloaded;
try
freelibrary (fmodule);
fmodule: = 0;
snapshot T
application. handleexception (Self);
end;
dodllunloaded;
end
else
begin
fmodule: = loadlibrary (pchar (ffilename ));
try
win32check (fmodule <> 0);
dodllloaded;
T
On E: exception DO
begin
If fmodule <> 0 then
begin
freelibrary (fmodule );
fmodule: = 0;
end;
raise edllerror. createfmt ('loadlibrary error: % s', [E. message]);
end;
end;

Procedure tdll. setfilename (const value: string );

Begin

If loaded then

Raise edllerror. createfmt ('Do unload before load another module named: "% s "',

[Value]);

If ffilename <> value then

Begin

Ffilename: = value;

Dofilenamechange;

End;

End;

Procedure tdll. dofilenamechange;

Begin

// Do nonthing.

End;

Procedure tdll. dodllloaded;

Begin

If assigned (fowner) and assigned (fowner. ondllloaded) then

Fowner. ondllloaded (fowner, self );

End;

Procedure tdll. dodllunloaded;

Begin

// Do nonthing.

End;

Procedure tdll. dopermitchange;

Begin

// Do nonthing.

End;

Procedure tdll. setpermit (const value: Boolean );

Begin

If fpermit <> value then

Begin

Fpermit: = value;

Dopermitchange;

End;

End;

Procedure tdll. dobeforedllunloaded;

Begin

If assigned (fowner) and assigned (fowner. ondllbeforeunloaded) then

Fowner. ondllbeforeunloaded (fowner, self );

End;

{Tdllmanager}

Function tdllmanager. Add (const filename: string): integer;

VaR

DLL: tdll;

Begin

Result: =-1;

Lock;

Try

If dllsbyname [filename] = nil then

Begin

DLL: = fdllclass. Create;

DLL. filename: = filename;

Result: = add (DLL );

End

Else

Result: =-1;

Finally

Unlock;

End;

End;

Constructor tdllmanager. Create;

Begin

Fdllclass: = tdll;

Initializecriticalsection (flock );

End;

Destructor tdllmanager. Destroy;

Begin

Deletecriticalsection (flock );

Inherited;

End;

Function tdllmanager. getdlls (const index: integer): tdll;

Begin

Lock;

Try

If (index> = 0) and (index <= count-1) then

Result: = items [Index]

Else

Raise edllerror. createfmt ('error index of getdlls, value: % d, total count: % d', [index, Count]);

Finally

Unlock;

End;

End;

Function tdllmanager. getdllsbyname (const filename: string): tdll;

VaR

I: integer;

Begin

Lock;

Try

I: = indexof (filename );

If I> = 0 then

Result: = DLLs [I]

Else

Result: = nil;

Finally

Unlock;

End;

End;

Function tdllmanager. indexof (const filename: string): integer;

VaR

I: integer;

Begin

Result: =-1;

Lock;

Try

For I: = 0 to count-1 do

If comparetext (filename, DLLs [I]. filename) = 0 then

Begin

Result: = I;

Break;

End;

Finally

Unlock;

End;

End;

Procedure tdllmanager. lock;

Begin

Outputdebugstring (pchar ('trlock dm' + inttostr (getcurrentthreadid) + ':' + inttostr (DWORD (Self ))));

Entercriticalsection (flock );

Outputdebugstring (pchar ('locked dm' + inttostr (getcurrentthreadid) + ':' + inttostr (DWORD (Self ))));

End;

Procedure tdllmanager. Y (PTR: pointer; Action: tlistnotification );

Begin

If action = lndeleted then

Begin

// If tdll (PTR). Owner is different from self

// Indicates that tdll. Destroy is triggered;

If tdll (PTR). Owner = self then

Begin

// Prevent related events from being triggered after the fowner is set to nil

Tdll (PTR). dobeforedllunloaded;

Tdll (PTR). fowner: = nil;

Tdll (PTR). Free;

End;

End

Else

If action = lnadded then

Tdll (PTR). fowner: = self;

Inherited;

End;

Function tdllmanager. Remove (const filename: string): integer;

VaR

I: integer;

Begin

Result: =-1;

Lock;

Try

I: = indexof (filename );

If I> = 0 then

Result: = remove (DLLs [I])

Else

Result: =-1;

Finally

Unlock;

End;

End;

Procedure tdllmanager. Unlock;

Begin

Leavecriticalsection (flock );

Outputdebugstring (pchar ('unlock dm' + inttostr (getcurrentthreadid) + ':' + inttostr (DWORD (Self ))));

End;

End.