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