GetClass与RegisterClass的应用一例

 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.