delphi中关于包的使用，请指正在用包时为何又启动一APP(100分)

主main

type
TCallBPLForm = function(AOwner, AParent: TWinControl;
AParam: OleVariant): TForm; stdcall ;
TForm1 = class(TForm)
Button1: TButton;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FPackageList: TStringList;
//动态加载BPL窗体***********************************************************
function DynaLoadBPLPackage(APackageFile: string): THandle;
procedure ExecBPLFunc(AOwner, AParent: TWinControl; AParam: OleVariant);
{ AParam参数说明：
AParam[1]=BPL内含窗体名
AParam[2]=BPL文件名
AParam[3]=BPL文件.过程函数名
AParam[n]=其他参数
}

public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses SyncObjs;

{$R *.dfm}
function TForm1.DynaLoadBPLPackage(APackageFile: string): THandle;
var
index: integer;
begin
//从程序包列表中按APackageFile查找，如果找到直接返回程序包的句柄
if FPackageList.Find(APackageFile, index) then
begin
Result := THandle(FPackageList.Objects[index]);
end
else
begin
//如果没找到，从硬盘加载
Result := LoadPackage(Pchar(APackageFile));
FPackageList.AddObject(APackageFile, Pointer(Result));
end;
end;

procedure TForm1.ExecBPLFunc(AOwner, AParent: TWinControl;
AParam: OleVariant);
//判断选择的功能是否存在
function FuncExist: Boolean;
begin
Result := True;
if (trim(AParam[1])='') or //AxObjName
(trim(AParam[2])='') or //AxObjPackage
(trim(AParam[3])='') then //StartProcName
begin
//Application.MessageBox(Pchar(''),Pchar(''),48);
Result := False;
end;
end;
var
package: THandle;
proc: TFarProc;
CallBPL: TCallBPLForm;
form: TForm;
begin
//判断选择的功能是否存在
//if not FuncExist then exit;
form := nil;
try
//从程序包中创建
package := DynaLoadBPLPackage(AParam[2]);
if package > 0 then
begin
proc := GetProcAddress(package, PChar(string(AParam[3])));
if Assigned(proc) then
begin
try
CallBPL := TCallBPLForm(proc);
form := CallBPL(AOwner, AParent, AParam);
except
if Assigned(form) then form.Free;
end;
end;
end;
finally
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Param: OleVariant;
begin
param := VarArrayCreate([0,10], varVariant);
param[1] := 'Form1';
param[2] := 'Package1.bpl';
param[3] := 'DoDemo';
ExecBPLFunc(Self,nil , param);
//param := VarArrayCreate([0,10], varVariant);
//param[1] := trim('Form1');
// param[2] := trim('Package1.bpl');
// param[3] := trim('DoDemo');
// ExecBPLFunc(Self,NIL,param);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(FPackageList) then
FPackageList.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FPackageList := TStringList.Create;
end;

end.
包中入口函数
function DoDemo(AOwner,AAParent: TWinControl;AParm :OleVariant): TForm1;stdcall;

exports DoDemo;


implementation

{$R *.dfm}
function DoDemo(AOwner,AAParent: TWinControl;AParm :OleVariant): TForm1;
begin
//if Assigned(Result) then
// Result.Free;
Result := TForm1.Create(AOwner);
Result.Parent := AAParent;
Result.BorderStyle := bsToolWindow;
//Result.Align := alClient;
//Result.KeyPreview := True;
Result.Show;
end;
谢谢

顶