装载BPL中的类,数据模块,窗体控件

{*
单元说明 ： 装载BPL中的类,数据模块,窗体控件作者 ：
笔名 ： 易 一 英文名：yeeyee
E-Mail ： jane1437@163.com
My Blog : http://blog.csdn.net/yeeyee/
QQ : 282624758创建时间 ： 2005年10月18日
及最后修改时间：修改人修改时间：
修改说明：
版权声明： 版权所有，转载请注明本人邮箱，笔名，
并保证文章的完整性。
调用说明：
*}unit LoadClass;
interface
uses
SysUtils, Windows, Classes, Forms;
type
TLoadClass = class(TComponent)
private
{ Private declarations }
FPkgPath:string;
FPkgName:string;
FPkgPathName:string;
FClassName:string;
procedure SetPkgPath(const AValue:string);
procedure SetPkgName(const AValue:string);
procedure SetPkgPathName(const AValue:string);
procedure SetClassName(const AValue:string);
function FnIsFormExist(const AFormName:string):boolean;
function GetExistForm(const AFormName:string):TCustomForm;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function CreateSingleTonForm(AOwner: TComponent;const APkgName:string;const AClassName:string):TCustomForm;

procedure ShowModalForm(const APkgName:string;const AClassName:string;ATag:integer=0);reintroduce;overload;
procedure ShowModalForm(AOwner: TComponent;const APkgName:string;const AClassName:string;ATag:integer=0);reintroduce;overload;
procedure ShowModalLessForm(const APkgName:string;const AClassName:string;ATag:integer=0);reintroduce;overload;
procedure ShowModalLessForm(AOwner: TComponent;const APkgName:string;const AClassName:string;ATag:integer=0);reintroduce;overload;

function CreateDataModule(AOwner: TComponent;const APkgName:string;const AClassName:string):TDataModule;
procedure CreateComponent(const APkgName:string;const AClassName:string);
published
{ Published declarations }
property YPkgPath:string read FPkgPath write SetPkgPath;
property YPkgName:string read FPkgName write SetPkgName;
property YPkgPathName:string read FPkgName write SetPkgPathName;
property YClassName:string read FClassName write SetClassName;
end;
//procedure Register;
implementation
uses TestComp;
{
procedure Register;
begin
RegisterComponents('Yeeyee', [TLoadClass]);
end;
}
constructor TLoadClass.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPkgPath:='D:/Projects/TestAutoUpdate/Bin/';
end;
destructor TLoadClass.Destroy;
begin
inherited Destroy;
end;
procedure TLoadClass.SetPkgPath(const AValue:string);
begin
if FPkgPath<>AValue then
begin
FPkgPath:=AValue;
end;
end;
procedure TLoadClass.SetPkgName(const AValue:string);
begin
if FPkgName<>AValue then
begin
FPkgName:=AValue;
end;
end;
procedure TLoadClass.SetPkgPathName(const AValue:string);
begin
if FPkgName<>AValue then
begin
FPkgName:=AValue;
end;
end;
procedure TLoadClass.SetClassName(const AValue:string);
begin
if FClassName<>AValue then
begin
FClassName:=AValue;
end;
end;
function TLoadClass.FnIsFormExist(const AFormName:string):boolean;
var
I:integer;
begin
Result:=False;
for I := 0 to (Application.ComponentCount - 1) do
begin
if (Application.Components[I] is TCustomForm) then
begin
//注意，关键判断这个类型名称是否存在。
if (Application.Components[I] as TCustomForm).ClassType.ClassName = AFormName then
begin
Result:=True;
exit;
end
end;
end;
end;
function TLoadClass.GetExistForm(const AFormName:string):TCustomForm;
var
I:integer;
begin
Result:=nil;
for I := 0 to (Application.ComponentCount - 1) do
begin
if (Application.Components[I] is TCustomForm) then
begin
//注意，关键判断这个类型名称是否存在。
if (Application.Components[I] as TCustomForm).ClassType.ClassName = AFormName then
begin
Result:=(Application.Components[I] as TCustomForm);
exit;
end
end;
end;
end;
procedure TLoadClass.ShowModalForm(const APkgName:string;const AClassName:string;ATag:integer=0);
var
hPkgModule: HModule;
AClass: TPersistentClass;
LCustForm:TCustomForm;
begin
FClassName:=AClassName;
FPkgName:=APkgName;
FPkgPathName:=FPkgPath+FPkgName;
hPkgModule := LoadPackage(FPkgPathName);
try
if hPkgModule <> 0 then
begin
AClass := GetClass(FClassName);
if AClass <> nil then
begin
LCustForm:=(TComponentClass(AClass).Create(nil) as TCustomForm);
try
LCustForm.Tag:=ATag;
LCustForm.ShowModal;
finally
LCustForm.Free;
end;
end; //End if if AClass <> nil then
end; //End if hPkgModule <> 0 then
finally
UnloadPackage(hPkgModule);
end;
end;
procedure TLoadClass.ShowModalForm(AOwner: TComponent;const APkgName:string;const AClassName:string;ATag:integer=0);
var
hPkgModule: HModule;
AClass: TPersistentClass;
LCustForm:TCustomForm;
begin
FClassName:=AClassName;
FPkgName:=APkgName;
FPkgPathName:=FPkgPath+FPkgName;
hPkgModule := LoadPackage(FPkgPathName);
try
if hPkgModule <> 0 then
begin
AClass := GetClass(FClassName);
if AClass <> nil then
begin
LCustForm:=(TComponentClass(AClass).Create(AOwner) as TCustomForm);
try
LCustForm.Tag:=ATag;
LCustForm.ShowModal;
finally
LCustForm.Free;
end;
end; //End if if AClass <> nil then
end; //End if hPkgModule <> 0 then
finally
UnloadPackage(hPkgModule);
end;
end;
function TLoadClass.CreateSingleTonForm(AOwner: TComponent;const APkgName:string;const AClassName:string):TCustomForm;
var
hPkgModule: HModule;
AClass: TPersistentClass;
//LCustForm:TCustomForm;
LCustForm:TCustomForm;
begin
FClassName:=AClassName;
FPkgName:=APkgName;
FPkgPathName:=FPkgPath+FPkgName;
hPkgModule := LoadPackage(FPkgPathName);
try
if hPkgModule <> 0 then
begin
AClass := GetClass(FClassName);
if AClass <> nil then
begin
//窗体不存在，则创建。
if not FnIsFormExist(FClassName) then
begin
LCustForm:=(TComponentClass(AClass).Create(Application) as TCustomForm);
end
else
begin
//存在，则得到窗体。带到最前头。
LCustForm:=GetExistForm(FClassName);
LCustForm.BringToFront;
end;
Result:=LCustForm;
end; //End if if AClass <> nil then
end; //End if hPkgModule <> 0 then
finally
UnloadPackage(hPkgModule);
end;
end;
procedure TLoadClass.ShowModalLessForm(AOwner: TComponent;const APkgName:string;const AClassName:string;ATag:integer=0);
var
hPkgModule: HModule;
AClass: TPersistentClass;
LCustForm:TCustomForm;
begin
FClassName:=AClassName;
FPkgName:=APkgName;
FPkgPathName:=FPkgPath+FPkgName;
hPkgModule := LoadPackage(FPkgPathName);
try
if hPkgModule <> 0 then
begin
AClass := GetClass(FClassName);
if AClass <> nil then
begin
//窗体不存在，则创建。
if not FnIsFormExist(FClassName) then
begin
LCustForm:=(TComponentClass(AClass).Create(AOwner) as TCustomForm);
LCustForm.Tag:=ATag;
LCustForm.Show;
end
else
begin
//存在，则得到窗体。带到最前头。
LCustForm:=GetExistForm(FClassName);
LCustForm.BringToFront;
end;
end; //End if if AClass <> nil then
end; //End if hPkgModule <> 0 then
finally
UnloadPackage(hPkgModule);
end;
end;

procedure TLoadClass.ShowModalLessForm(const APkgName:string;const AClassName:string;ATag:integer=0);
var
hPkgModule: HModule;
AClass: TPersistentClass;
LCustForm:TCustomForm;
begin
FClassName:=AClassName;
FPkgName:=APkgName;
FPkgPathName:=FPkgPath+FPkgName;
hPkgModule := LoadPackage(FPkgPathName);
try
if hPkgModule <> 0 then
begin
AClass := GetClass(FClassName);
if AClass <> nil then
begin
//窗体不存在，则创建。
if not FnIsFormExist(FClassName) then
begin
LCustForm:=(TComponentClass(AClass).Create(Application) as TCustomForm);
LCustForm.Tag:=ATag;
LCustForm.Show;
end
else
begin
//存在，则得到窗体。带到最前头。
LCustForm:=GetExistForm(FClassName);
LCustForm.BringToFront;
end;
end; //End if if AClass <> nil then
end; //End if hPkgModule <> 0 then
finally
UnloadPackage(hPkgModule);
end;
end;
function TLoadClass.CreateDataModule(AOwner: TComponent;const APkgName:string;const AClassName:string):TDataModule;
var
hPkgModule: HModule;
AClass: TPersistentClass;
LDataModule:TDataModule;
begin
FClassName:=AClassName;
FPkgName:=APkgName;
FPkgPathName:=FPkgPath+FPkgName;
hPkgModule := LoadPackage(FPkgPathName);
try
if hPkgModule <> 0 then
begin
AClass := GetClass(FClassName);
if AClass <> nil then
begin
Result:=(TComponentClass(AClass).Create(AOwner) as TDataModule);
end;
end;
finally
UnloadPackage(hPkgModule);
end;
end;
procedure TLoadClass.CreateComponent(const APkgName:string;const AClassName:string);
var
hPkgModule: HModule;
AClass: TPersistentClass;
LComponent:TComponent;
begin
FClassName:=AClassName;
FPkgName:=APkgName;
FPkgPathName:=FPkgPath+FPkgName;
hPkgModule := LoadPackage(FPkgPathName);
try
if hPkgModule <> 0 then
begin
AClass := GetClass(FClassName);
if AClass <> nil then
begin
LComponent:=(TComponentClass(AClass).Create(Application) as TComponent);
end;
end;
finally
UnloadPackage(hPkgModule);
end;
end;
end.