插件管理框架 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(FFileN