插件管理框架 for Delphi（二）

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.