插件管理框架 for Delphi（二）

胡羽杨 發表於 2008-3-15 18:14:50

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: TDll read GetDlls; default;
     property DllsByName: 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"´, );
 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"´, );
 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´, );
         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"´,
       );
   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 = 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
     else
       raise EDllError.CreateFmt(´Error Index of GetDlls, Value: %d, Total Count: %d´, );
   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
     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.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)
     else
       result := -1;
   finally
     UnLock;
   end;
 end;
 procedure TDllManager.UnLock;
 begin
   LeaveCriticalSection(FLock);
   OutputDebugString(Pchar(´UnLock DM´ + IntToStr(GetCurrentThreadId) + ´:´ + IntToStr(DWORD(Self))));
 end;
 end.

 <div class="art_xg">

 </div>

 </div>

頁: [1]

琼殿技术论坛's Archiver

插件管理框架 for Delphi（二）