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 提供对 Dll 的管理功能；
o Add 时自动创建 TDll 对象，但不尝试装载；
o Delete 时自动销毁 TDll 对象；
}
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 Notify(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 代表一个 Dll, Windows.HModule
o 销毁时自动在 Owner 中删除自身；
o 子类可通过覆盖override DoDllLoaded, 以及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
//在拥有者中删除自身
Manager := FOwner;
//未防止在 TDllManager中重复删除，因此需要将
//FOwner设置为 nil; <-- 此段代码和 TDllManager.Notify 需要配合
//才能确保正确。
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;
except
Application.HandleException(Self);
end;
DoDllUnLoaded;
end
else
begin
FModule := LoadLibrary(PChar(FFileName));
try
Win32Check(FModule <> 0);
DoDllLoaded;
except
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;
end;
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.Notify(Ptr: Pointer; Action: TListNotification);
begin
if Action = lnDeleted then
begin
//若TDll(Ptr).Owner和Self不同，则
//表明由 TDll.Destroy 触发；
if TDll(Ptr).Owner = Self then
begin
//防止FOwner设置为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.