插件管理框架 for Delphi(二)

原创 2004年05月24日 13:32:00

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).OwnerSelf不同,则
    //表明由 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.
 

Delphi插件管理框架的简单实现

1 前言 1.1 插件技术许多软件采用“插件”(PlugIns)来扩展其功能,比如PhotoShop所支持的各类滤镜就是插件;我们所熟知的Winamp,也有许多皮肤以及可视效果插件。...
  • xieyunc
  • xieyunc
  • 2017年03月19日 13:34
  • 1238

Delphi通用插件框架

近期打算抽时间看点OO,UML的书,电脑里的martin fowler的5本书一直没怎么看过,学编程这么多年,其实水平一直不高,工作性质是一个原因,做一个古董系统的维护工作,不如那些一年到头在外做项目...
  • jackhatedance
  • jackhatedance
  • 2006年08月23日 07:20
  • 3413

插件管理框架 for Delphi(二)

  • zgqtxwd
  • zgqtxwd
  • 2008年04月30日 11:05
  • 123

插件管理框架 for Delphi

http://blog.csdn.net/musicwind/article/details/7136 1       前言 1.1   插件技术 许多软件采用“插件”(PlugIns)来扩...
  • l799623787
  • l799623787
  • 2013年08月29日 15:41
  • 922

插件管理框架 for Delphi(一)

  • zgqtxwd
  • zgqtxwd
  • 2008年04月30日 11:02
  • 160

插件管理框架 for Delphi(三)

1       前言 2       插件框架(untDllManager) 3       使用举例 3.1   类图 3.2   客户端组件 从TDll派生出TClientDll; 根据真实的...
  • Musicwind
  • Musicwind
  • 2004年05月25日 10:44
  • 4059

delphi bpl插件系统开发(转)

半路出家的delphier一如我,对于win32api式的调用有着近乎厌恶的抵触情绪,我很早以前看c++的教程时看到lptrXXXXX的变量就头大,以至于到现在都不会用c++,都不曾写成功过那怕一个h...
  • gjtao1130
  • gjtao1130
  • 2016年04月12日 14:39
  • 821

构建插件式的应用程序框架

http://www.cnblogs.com/guanjinke/archive/2007/02/13/649805.html   说起插件(plug-in)式的应用程序大家应该不陌生吧,记得很早以前...
  • l799623787
  • l799623787
  • 2013年08月29日 14:55
  • 1185

DedeCMS基本操作说明---广告管理

广告是一个网站盈利不可缺少的部分,在网站中广告通常以很多形式出现,例如:文字链接、图片链接、视频等;一般中小型 站长喜欢使用各种联盟广告。这里我们将告诉您如何在织梦建设的网站中使用广告插件来管理您的...
  • chenyujing5678
  • chenyujing5678
  • 2012年07月31日 23:01
  • 4535

Java并发框架——AQS阻塞队列管理(二)——自旋锁优化

看Craig, Landin, and Hagersten发明的CLH锁如何优化同步带来的花销,其核心思想是:通过一定手段将所有线程对某一共享变量轮询竞争转化为一个线程队列且队列中的线程各自轮询自己的...
  • wangyangzhizhou
  • wangyangzhizhou
  • 2014年12月21日 21:49
  • 2659
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:插件管理框架 for Delphi(二)
举报原因:
原因补充:

(最多只允许输入30个字)