郁闷很久啦，各位高手帮帮忙。系统模块化，在释放接口时出现异常，帮帮忙啊。
我想将这个功能子模块封装成插件形式供主程序调用，在主程序退出释放接口时没有问题，
但是如果加载一个插件，然后又释放他的时候就出现了异常。这个一个公共的接口，主程序和DLL都引用的：unit uPlugin;interface
type
IPlugin = interface
['{9E353E0D-F861-4731-9E53-FBBA7EF631B6}']
function Getname: string;
procedure SetName(Value: string);
{显示模块窗体}
function ShowForm(AHandle: THandle) : Boolean;
{关闭窗体}
function CloseForm(AHandle: THandle) : Boolean;
{插件名称}
property Name: string read GetName write SetName;
end;const
Reg_Plugin = 'RegMyPlugin'; //DLL输出函数
implementation
end.DLL的实现方法如下：
library Project1;{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }uses
ShareMem,
uPlugin in 'uPlugin.pas',
uhsPlugin in 'uhsPlugin.pas',
Unit2 in 'Unit2.pas' {Form2};{$R *.res}function RegMyPlugin: IPlugin;
begin
Result := Tplugin.Create;
result.Name := 'Project1';
end;
exports
RegMyPlugin;
begin
end.这个是实现接口的类：
unit uhsPlugin;interface
uses Windows, SysUtils, Graphics, Forms, uPlugin, Unit2;
type
Tplugin = class(TInterfacedObject, IPlugin)
private
FName: string;
function Getname: string;
procedure SetName(Value: string);
public
constructor Create;
destructor Destroy; override;
function ShowForm(AHandle: THandle): Boolean;
function CloseForm(AHandle: THandle): Boolean;
property Name: string read GetName write SetName;
end;implementation{ Tplugin }{
*********************************** Tplugin ************************************
}constructor Tplugin.Create;
begin
inherited;
end;destructor Tplugin.Destroy;
begin
inherited;
end;function Tplugin.CloseForm(AHandle: THandle): Boolean;
begin
Result := True;
try
Application.Handle := AHandle;
if Form2 <> nil then
Form2.Free;
except
Result := False;
end;end;function Tplugin.ShowForm(AHandle: THandle): Boolean;
begin
Result := True;
try
Application.Handle := AHandle;
Application.CreateForm(Tform2, Form2);
try
Form2.ShowModal;
finally
Form2.Free;
end;
except
Result := False;
end;end;function Tplugin.GetName: string;
begin
Result := Fname;
end;
procedure Tplugin.SetName(Value: string);
begin
if Fname <> Value then
FName := Value;
end;
end.主程序我主要通过一个插件管理器来进行管理：
unit uhsPluginManager;interface
uses Windows, SysUtils, Classes, Forms, Menus, uPlugin;type
TRegMyPlugin = function: IPlugin; stdcall;
//插件管理类
ThsPluginManager = class(TComponent)
private
FPluginFolder: string;
FPluginHandles: TStringList;
FPlugins: TInterfaceList;
function GetPluginCount: Integer;
function GetPlugin(index: integer): IPlugIn;
procedure SetPluginFolder(Value: string);
procedure SetPlugin(index: integer; const Value: IPlugin);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
//增加单个插件
procedure AddPlugin(FileName: string); virtual;
//增加指定目录下的所有插件
procedure AddPlugins; virtual;
//卸载单个插件
procedure UnLoadPlugin(index: integer); virtual;
//返回插件个数
property PluginCount: Integer read GetPluginCount;
//指向某个插件
property Plugins[index: integer]: IPlugin read GetPlugin write SetPlugin;
published
//插进目录
property PluginFolder: string read FPluginFolder write SetPluginFolder;
end;
var
hsPluginManager: ThsPluginManager;
implementation
{
******************************* ThsPluginManager *******************************
}constructor ThsPluginManager.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPlugins := TInterfaceList.Create;
FPluginHandles := TStringList.Create;
end; procedure ThsPluginManager.AddPlugin(FileName: string);
var
LibHandle: Integer;
RegPlugin: TRegMyPlugin;
hsPlugin: IPlugin;
begin
LibHandle := LoadLibrary(pchar(FileName));
if LibHandle = 0 then exit; RegPlugin := GetProcAddress(LibHandle, Reg_Plugin); if @RegPlugin = nil then
begin
FreeLibrary(LibHandle);
exit;
end; hsPlugin := TRegMyPlugin(RegPlugin);
if hsPlugin = nil then Exit; FPlugins.Add(hsPlugin);
FPluginHandles.Add(IntToStr(LibHandle));
end;procedure ThsPluginManager.AddPlugins;
var
filePath: string; procedure GetPathPulgin(Path: string);
var
AllowLoad: Boolean;
Found: Integer;
Filename: string;
sr: TSearchRec;
begin
Found := FindFirst(path + '*.*', faAnyFile, sr);
while Found = 0 do
begin
if (sr.Attr and faDirectory = sr.Attr) and (sr.Name <> '.') and (sr.Name <> '..') then
GetPathPulgin(Path + sr.Name + '\')
else
begin
if Pos('.' + UpperCase('dll'), UpperCase(sr.Name)) <> 0 then
begin
Filename := sr.Name;
AllowLoad := true;
if AllowLoad then
begin
AddPlugin(Path + Filename);
end;
end;
end;
Found := FindNext(sr);
end;
FindClose(sr);
end;begin
if FPluginFolder = '' then
filePath := ExtractFilePath(Application.Exename)
else
filePath := FPluginFolder;
if filePath[length(filePath)] <> '\' then
filePath := filePath + '\';
//遍历目录
GetPathPulgin(filePath);
end;
function ThsPluginManager.GetPluginCount: Integer;
begin
result := FPlugins.Count;
end;function ThsPluginManager.GetPlugin(index: integer): IPlugIn;
begin
Result := IPlugIn(FPlugins.Items[index]);
end;procedure ThsPluginManager.SetPluginFolder(Value: string);
begin
if FPluginFolder <> Value then
FPluginFolder := Value;
end;procedure ThsPluginManager.UnLoadPlugin(index: integer);
var
Handle: THandle;
begin
FPlugins.Delete(Index);
Handle := StrToInt(FpluginHandles.strings[Index]);
FreeLibrary(Handle); FPluginHandles.Delete(Index);
end;destructor ThsPluginManager.Destroy;
var
j: Integer;
begin
//释放插件及句柄
for j := FPlugins.Count - 1 downto 0 do
begin
UnLoadPlugin(j);
end;
Fplugins.Free;
FPluginHandles.Free; inherited Destroy;
end;procedure ThsPluginManager.SetPlugin(index: integer; const Value: IPlugin);
begin
FPlugins.Items[Index] := Value;
end;initialization
hsPluginManager := ThsPluginManager.Create(nil);
hsPluginManager.PluginFolder := ExtractFilePath(Application.ExeName);
finalization
hsPluginManager.Free;
end.
然后我在主界面调用的时候就出错了
procedure TForm1.Button1Click(Sender: TObject);
begin
try
hsPluginManager.AddPlugins;
hsPluginManager.Plugins[0].ShowForm(Application.Handle);
hsPluginManager.UnLoadPlugin(0);//问题出现在这里。
except
raise;
end
end;
我想将这个功能子模块封装成插件形式供主程序调用，在主程序退出释放接口时没有问题，
但是如果加载一个插件，然后又释放他的时候就出现了异常。这个一个公共的接口，主程序和DLL都引用的：unit uPlugin;interface
type
IPlugin = interface
['{9E353E0D-F861-4731-9E53-FBBA7EF631B6}']
function Getname: string;
procedure SetName(Value: string);
{显示模块窗体}
function ShowForm(AHandle: THandle) : Boolean;
{关闭窗体}
function CloseForm(AHandle: THandle) : Boolean;
{插件名称}
property Name: string read GetName write SetName;
end;const
Reg_Plugin = 'RegMyPlugin'; //DLL输出函数
implementation
end.DLL的实现方法如下：
library Project1;{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }uses
ShareMem,
uPlugin in 'uPlugin.pas',
uhsPlugin in 'uhsPlugin.pas',
Unit2 in 'Unit2.pas' {Form2};{$R *.res}function RegMyPlugin: IPlugin;
begin
Result := Tplugin.Create;
result.Name := 'Project1';
end;
exports
RegMyPlugin;
begin
end.这个是实现接口的类：
unit uhsPlugin;interface
uses Windows, SysUtils, Graphics, Forms, uPlugin, Unit2;
type
Tplugin = class(TInterfacedObject, IPlugin)
private
FName: string;
function Getname: string;
procedure SetName(Value: string);
public
constructor Create;
destructor Destroy; override;
function ShowForm(AHandle: THandle): Boolean;
function CloseForm(AHandle: THandle): Boolean;
property Name: string read GetName write SetName;
end;implementation{ Tplugin }{
*********************************** Tplugin ************************************
}constructor Tplugin.Create;
begin
inherited;
end;destructor Tplugin.Destroy;
begin
inherited;
end;function Tplugin.CloseForm(AHandle: THandle): Boolean;
begin
Result := True;
try
Application.Handle := AHandle;
if Form2 <> nil then
Form2.Free;
except
Result := False;
end;end;function Tplugin.ShowForm(AHandle: THandle): Boolean;
begin
Result := True;
try
Application.Handle := AHandle;
Application.CreateForm(Tform2, Form2);
try
Form2.ShowModal;
finally
Form2.Free;
end;
except
Result := False;
end;end;function Tplugin.GetName: string;
begin
Result := Fname;
end;
procedure Tplugin.SetName(Value: string);
begin
if Fname <> Value then
FName := Value;
end;
end.主程序我主要通过一个插件管理器来进行管理：
unit uhsPluginManager;interface
uses Windows, SysUtils, Classes, Forms, Menus, uPlugin;type
TRegMyPlugin = function: IPlugin; stdcall;
//插件管理类
ThsPluginManager = class(TComponent)
private
FPluginFolder: string;
FPluginHandles: TStringList;
FPlugins: TInterfaceList;
function GetPluginCount: Integer;
function GetPlugin(index: integer): IPlugIn;
procedure SetPluginFolder(Value: string);
procedure SetPlugin(index: integer; const Value: IPlugin);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
//增加单个插件
procedure AddPlugin(FileName: string); virtual;
//增加指定目录下的所有插件
procedure AddPlugins; virtual;
//卸载单个插件
procedure UnLoadPlugin(index: integer); virtual;
//返回插件个数
property PluginCount: Integer read GetPluginCount;
//指向某个插件
property Plugins[index: integer]: IPlugin read GetPlugin write SetPlugin;
published
//插进目录
property PluginFolder: string read FPluginFolder write SetPluginFolder;
end;
var
hsPluginManager: ThsPluginManager;
implementation
{
******************************* ThsPluginManager *******************************
}constructor ThsPluginManager.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPlugins := TInterfaceList.Create;
FPluginHandles := TStringList.Create;
end; procedure ThsPluginManager.AddPlugin(FileName: string);
var
LibHandle: Integer;
RegPlugin: TRegMyPlugin;
hsPlugin: IPlugin;
begin
LibHandle := LoadLibrary(pchar(FileName));
if LibHandle = 0 then exit; RegPlugin := GetProcAddress(LibHandle, Reg_Plugin); if @RegPlugin = nil then
begin
FreeLibrary(LibHandle);
exit;
end; hsPlugin := TRegMyPlugin(RegPlugin);
if hsPlugin = nil then Exit; FPlugins.Add(hsPlugin);
FPluginHandles.Add(IntToStr(LibHandle));
end;procedure ThsPluginManager.AddPlugins;
var
filePath: string; procedure GetPathPulgin(Path: string);
var
AllowLoad: Boolean;
Found: Integer;
Filename: string;
sr: TSearchRec;
begin
Found := FindFirst(path + '*.*', faAnyFile, sr);
while Found = 0 do
begin
if (sr.Attr and faDirectory = sr.Attr) and (sr.Name <> '.') and (sr.Name <> '..') then
GetPathPulgin(Path + sr.Name + '\')
else
begin
if Pos('.' + UpperCase('dll'), UpperCase(sr.Name)) <> 0 then
begin
Filename := sr.Name;
AllowLoad := true;
if AllowLoad then
begin
AddPlugin(Path + Filename);
end;
end;
end;
Found := FindNext(sr);
end;
FindClose(sr);
end;begin
if FPluginFolder = '' then
filePath := ExtractFilePath(Application.Exename)
else
filePath := FPluginFolder;
if filePath[length(filePath)] <> '\' then
filePath := filePath + '\';
//遍历目录
GetPathPulgin(filePath);
end;
function ThsPluginManager.GetPluginCount: Integer;
begin
result := FPlugins.Count;
end;function ThsPluginManager.GetPlugin(index: integer): IPlugIn;
begin
Result := IPlugIn(FPlugins.Items[index]);
end;procedure ThsPluginManager.SetPluginFolder(Value: string);
begin
if FPluginFolder <> Value then
FPluginFolder := Value;
end;procedure ThsPluginManager.UnLoadPlugin(index: integer);
var
Handle: THandle;
begin
FPlugins.Delete(Index);
Handle := StrToInt(FpluginHandles.strings[Index]);
FreeLibrary(Handle); FPluginHandles.Delete(Index);
end;destructor ThsPluginManager.Destroy;
var
j: Integer;
begin
//释放插件及句柄
for j := FPlugins.Count - 1 downto 0 do
begin
UnLoadPlugin(j);
end;
Fplugins.Free;
FPluginHandles.Free; inherited Destroy;
end;procedure ThsPluginManager.SetPlugin(index: integer; const Value: IPlugin);
begin
FPlugins.Items[Index] := Value;
end;initialization
hsPluginManager := ThsPluginManager.Create(nil);
hsPluginManager.PluginFolder := ExtractFilePath(Application.ExeName);
finalization
hsPluginManager.Free;
end.
然后我在主界面调用的时候就出错了
procedure TForm1.Button1Click(Sender: TObject);
begin
try
hsPluginManager.AddPlugins;
hsPluginManager.Plugins[0].ShowForm(Application.Handle);
hsPluginManager.UnLoadPlugin(0);//问题出现在这里。
except
raise;
end
end;
begin
Result := True;
try
Application.Handle := AHandle;
Application.CreateForm(Tform2, Form2);
try
Form2.ShowModal;
finally
Application.Handle := 0;//加入这个试试
Form2.Free;
end;
except
Result := False;
end;end;本人认为关键在于FreeLibrary这个函数执行时的操作
给你个示例，看看：procedure DLLUnloadProc(Reason: Integer); register;
begin
if Reason = 0 then
begin
Application.CancelHint;
application.Handle := 0;
if Assigned(frmMain) then FreeAndNil(frmMain);
end;
end;begin
DLLProc := @DLLUnloadProc;
end.
try
Form2.ShowModal;
在这个Form2 中的 onClose 事件中加入：
Action := caFree;