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