插件管理框架 for Delphi（二）

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.