分享
 
 
 

插件管理框架 for Delphi(二)

王朝delphi·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

1 前言

2 插件框架(untDllManager)

2.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 提供对 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.

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有