1 Introduction
2 plug-in frame (unddllmanager)
2.2 Implementing code
Unit unpddllmanager;
Interface
Uses
Windows, Classes, Sysutils, Forms
Type
Edller = Class (Exception);
TDLLCLASS = Class of Tdll;
TDLL = Class;
TDLLEVENT = Procedure (Sender: Tobject; Adll: TDLL) OF Object;
{TDLLMANAGER
o Provide management functions to DLL;
o ADD automatically creates a TDLL object, but does not attempt to load;
O DELETE automatically destroys TDLL objects;
}
TDLLManager = Class (TLIST)
Private
FLOCK: TRTLCRITILSECTION;
FDLLCLASS: TDLCLASS;
Fondllload: TDLLEvent;
Fondllbeforeunlined: TDLLEvent;
Function Getdlls (const index: integer): TDLL;
Function getdllsbyName (const filename: string): TDLL;
protected
Procedure Notify (PTR: POINTER; ACTION: TLISTNOTIFICATION); OVERRIDE;
public
Constructor crete;
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 Fondlload Write Fondllload;
Property Ondllbeforeunloaded: Tdllevent Read Fondllbeforeunloaded Write Fondllbeforeunloaded;
END;
{TDLL
o represents a DLL, windows.hmodule
o Automatically remove itself during the Owner when destroy;
The O subclass can be extended by overriding Override 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 DODLLOAD;
Procedure DobeForedllunloaded; Virtual;
PROCEDURE DODLLUNLOAD;
PROCEDURE DOFILENAMECHANGE; Virtual;
Procedure DOPERMITCHANGE; Virtual;
public
Constructor create;
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 Readloaded 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
// Remove itself in the owner
Manager: = fowner;
// Do not prevent deletion in TDLLManager, so it is necessary to
// Fowner is set to nil; <- This code and TDLLManager.notify need to cooperate
// can ensure 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))
Else
Raise Edller.createfmt ('Do Load Before getProcaddress of "% u", [dword (order (order (order (order)]);
END;
Function TDLL.GETPROCADDRESS (Const Procname: String): FarProc;
Begin
IF loaded then
Result: = Windows.GetProcaddress (FModule, Pchar (Procname))
Else
Raise edller.createfmt ('Do Load Before getProcaddress of "% s", [procname]);
Procedure TDLL.SETLOADED (Const Value: Boolean);
Begin
If loading <> value kil
Begin
IF not value kil
Begin
ASSERT (FModule <> 0);
Dobeforedllunloaded;
Try
Freelibrary (FModule);
FModule: = 0;
Except
Application.handleException (Self);
END;
DODLLUNLOADED;
end
Else
Begin
FModule: = loadingLibrary (pchar (ffilename);
Try
Win32Check (FModule <> 0);
DODLLOADED;
Except
ON E: Exception DO
Begin
IF FModule <> 0 THEN
Begin
Freelibrary (FModule);
FModule: = 0;
END;
Raise edller.createfmt ('loadLibrary Error:% S', [E.MESSAGE]);
END;
END;
END;
END;
END;
Procedure TDLL.SetFileName (const value: string);
Begin
IF loaded then
Raise Edller.createfmt ('Do Unload Before Load Another Module Named: "% s",
[Value]);
IF ffilename <> value kil
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 kil
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 Edller.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' INTOSTR (GetCurrentThreadID) ' INTOSTR (DWORD (Self))))
ENTERCRITICALSECTION (FLOCK);
OutputDebugstring (Pchar ('Locked DM' INTOSTR (GetCurrentThreadID) ' INTOSTR (DWORD (Self))));
END;
Procedure TDLLManager.Notify (PTR: POINTER; ACTION: TLISTNOTIFICATION);
Begin
if an action = lndeleted the
Begin
// If TDLL (PTR) .Owner and Self are different,
// indicates that is triggered by TDLL.DESTROY;
IF TDLL (PTR) .OWNER = Self Thenbegin
/ / Prevents the relevant events 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' INTOSTR (GetCurrentThreadID) ' INTOSTR (DWORD (Self))));
END;
End.
