delphi应用GetClass与RegisterClass的例子

利用GetClass与RegisterClass可以实现根据字符串来实例化具体的子类，这对于某些需 要动态配置程序的场合是很有用的。其他的应用如子窗体切换，算法替换等都能得到应用。

unit Example1;
interface
uses
　Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
　Dialogs, StdCtrls;
type
　TForm1 = class(TForm)
　　Button1: TButton;
　　procedure Button1Click(Sender: TObject);
　private
　public
　end;
　ILog = interface(IUnknown)
　　['{A65044FC-644C-482A-BBFF-50A618835FC6}']
　　procedure WriteMessage;
　end;
　TLog = class(TInterfacedPersistent, ILog)
　public
　　class function CreateInstance(Name: string): TLog; overload;
　　procedure WriteMessage; virtual; abstract;
　end;
　TTextLog = class(TLog)
　public
　　procedure WriteMessage; override;
　end;
　TXMLLog = class(TLog)
　public
　　procedure WriteMessage; override;
　end;
　TNullLog = class(TLog)
　public
　　procedure WriteMessage; override;
　end;
var
　Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
　Log: TLog;
begin
　{ 实际应用中可以从配置中读取字符串来决定实例化具体的子类 }
　Log := TLog.CreateInstance('TXMLLog');
　if Assigned(Log) then
　begin
　　Log.WriteMessage;
　　Log.Free;
　end;
end;
class function TLog.CreateInstance(Name: string): TLog;
var
　AClass: TPersistentClass;
begin
　Result := nil;
　AClass := GetClass(Name);
　if Assigned(AClass) then
　begin
　　Result := AClass.NewInstance as TLog;
　　Result.Create;
　end
　else
　　{ error handle }
end;
{ TTextLog }
procedure TTextLog.WriteMessage;
begin
　//写入到文本文件
end;
{ TXMLLog }
procedure TXMLLog.WriteMessage;
begin
　//写入到XML文件
end;
{ TNullLog }
procedure TNullLog.WriteMessage;
begin
　{ nothing need to do }
end;
initialization
　RegisterClass(TTextLog);
　RegisterClass(TXMLLog);
　RegisterClass(TNullLog);
finalization
　UnRegisterClass(TTextLog);
　UnRegisterClass(TXMLLog);
　UnRegisterClass(TNullLog);
end.