在只知道基类类名的情况下如何复制子类的实例？(200分)

我有一个基类TA，里面有一个纯虚的公有方法Show；子类TB重载了该方法。
二者的定义及实现大致如下——
{ TA }
TA = class
public
procedure Show
virtual
abstract;
end;

{ TB }
TB = class(TA)
private
Content: TStrings;
public
constructor Create;
destructor Destroy
override;
procedure Show
override;
end;

constructor TB.Create;
begin
inherited;
Content := TStringList.Create;
Content.Add('B');
end;

destructor TB.Destroy;
begin
Content.Free;
inherited;
end;

procedure TB.Show;
begin
ShowMessage(Content[0]);
end;

现在由于某种客观原因，我的一个程序不知道有TB这个类，它只知道TA；
它有一个公有方法接收一个TB类的实例（用一个TA类型的变量接收），
又出于某种原因，该程序不能直接调用该实例的Show方法，
而必须重新创建一个本地的TB实例，然后再调用它的Show，怎么做？


附带先说说我目前的进展情况——
为了简化测试，我把TA、TB都写在同一个Form文件的pas单元里，
然后用Form上一个Button的OnClick事件来代替那个公有方法。
Form1的主体代码如下（略去TA和TB的声明和实现部分）——

TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
procedure Clone(X: TA
var V);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
A: TA;
B: TB;
begin
B := TB.Create;
Clone(B, A);
try
A.Show;//报错！
finally
A.Free;
B.Free;
end;
end;

procedure TForm1.Clone(X: TA
var V);
var
A: TA;
begin
A := TA(X.ClassType.NewInstance);
TA(V) := A;
A.Create;
end;

——这样写法在执行A.Show;的时候可以跟进TB的Show中去，
但关键是A在创建的时候没有执行TB的构造函数，即它的Content是nil，
所以在执行那句ShowMessage的时候会报错。

因此我觉得问题就是如何完整地复制一个B出来？
即这个Clone函数到底应该怎么写？

procedure TForm1.Button1Click(Sender: TObject);
var
A: TA;
B: TB;
begin
A := TB.Create;
try
A.Show;//OK!!
finally
A.Free;
end;
end;

to yhaochuan：
不好意思，你没有看清我的问题，我说了——
“现在由于某种客观原因，我的一个程序[red]不知道有TB这个类[/red]，它只知道TA；”
我也说过——
“[red]为了简化测试[/red]，我把TA、TB都写在同一个Form文件的pas单元里，”
也就是说在实际情况下，这个Form里是看不到TB的，绝对不能出现TB.xxxx这样的语句。

Waiting……

恩... 5rain6sky让我来看这个帖子，不过我要仔细想想看看能不能想明白.....

多谢曹大侠捧场！[]

同一个单元里的类互为友元，存取级别没有用，你分开写在两个单元里看看。

to 雁孤行：
我在实际环境下是分开写的，这只是个测试程序，所以写在了一起。
不过你说的“存取级别没有用”我不明白是什么意思，我先试试分开写行不行吧……

就是说在同一个单元里的类private、public部分的变量都可访问，只有写在不
同单元里才有私有、公有的区别。

哦，明白，不过我的问题似乎并不涉及这个方面，我刚把程序拆开试了试，还是不行的。
鉴于我一开始的写法比较容易引起误会，我把拆开后的完整程序贴出来——

{ 这是包含TA的Unit }
unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TAClass = class of TA;
TA = class
public
procedure Show
virtual
abstract;
end;

TForm2 = class(TForm)
private
procedure Clone(X: TA
var V);
public
procedure ShowIt(B: TA);
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

{ TForm2 }

procedure TForm2.ShowIt(B: TA);
var
A: TA;
begin
try
Clone(B, A);
A.Show;
finally
A.Free;
end;
end;

procedure TForm2.Clone(X: TA
var V);
var
A: TA;
begin
A := TA(X.ClassType.NewInstance);
TA(V) := A;
A.Create;
end;

end.

{ 这是包含TB的Unit }
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, [red]Unit2[/red];//事实上还应该再拆出一个来，不过这样已经可以说明问题了：）

type
TB = class(TA)
private
Content: TStrings;
public
constructor Create;
destructor Destroy
override;
procedure Show
override;
end;

TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TB }

constructor TB.Create;
begin
inherited;
Content := TStringList.Create;
Content.Add('B');
end;

destructor TB.Destroy;
begin
Content.Free;
inherited;
end;

procedure TB.Show;
begin
ShowMessage(Content[0]);
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
B: TB;
begin
B := TB.Create;
try
Form2.ShowIt(B);
finally
B.Free;
end;
end;

end.

——大家再帮忙看看……

如果没有B这东西的话，A肯定调用不到在B中实现的方法。
看看下面的代码有没有帮助：
procedure TForm1.Button2Click(Sender: TObject);
var
s:tstrings;
ss:tstringlist;
begin
s:=tstrings.Create;
ss:=tstringlist.Create;
s:=ss;

end;

procedure TForm2.ShowIt(B: TA);
var
A: TA;
begin
A:=B;
A.Show;//应该可以
end;

改成下面的代码后正常。
procedure TB.Show;
begin
ShowMessage(Content[0]);
// inherited;

end;

procedure TForm2.ShowIt(B: TA);
//var
// A: TA;
begin
b.show;
{ try
Clone(B, A);
A.Show;
finally
A.Free;
end
}
end;

关于过程procedure TForm2.ShowIt(B: TA);
此时可以直接调用B.show的，
这是因为你传过来的B已经是继承至A的了，所以已经有了show的实作。

就象
procedure TForm2.Button1Click(Sender: TObject);
begin
　TButton(Sender).caption:= 'new caption';
end;
一样。

to yhaochuan：
用A := B;是不会报错，但同样不符合我的要求——
“又出于某种原因，该程序[red]不能直接调用[/red]该实例的Show方法”
——因为那个B我还要在调用者程序里接着用，我不想在被调用程序里改变它的任何属性，
所以要“复制”一个B出来，而不是直接引用它。

>>如果没有B这东西的话，A肯定调用不到在B中实现的方法。
你试试就知道，是可以的，因为二者用虚方法联系了起来。
即虽然被调用者不知道TB的属性结构等信息，但它知道B肯定有Main方法。

那你得再把你要做的功能说详细些，不能让我们去猜啊。

呵呵，好吧。
（不过我觉得我已经把要求表述得很明确了，问题的实质就是——
任意给你一个未知类的实例指针，复制一个完全相同的实例出来。）

我在做一个多线程的程序，TA这个基类有许多子类，为了在线程中进行统一处理，
同时可以不修改线程相关的代码，我定义了一个纯虚方法Main（这样线程的处理是一致的）。

而TA的各个子类对Main的处理完全不同，并且这些子类还有一些功能不需要在线程中调用。
我的主线程在收到一个操作请求时，先用子类的一个实例做一些判断工作，如果该子类可以处理，
则以该实例为参数启动一个线程进行实际的处理。

如果此时还用同一个实例，则丧失了多线程的好处，因为主线程不能同时利用该实例进行前期的工作。
——大概情况就是这样，再有不清楚的地方请大家指出。

能不能在此控件加一属性，线程根据此属性里的值去判断要做的工作？

你这个问题实际上牵涉到一个复制策略的问题，bitwise or not bitwise。
如果你的类里面只有非动态数据类型，如Integer等等，bitwise直接按位复制就ok
但如果牵涉到如指针、对象等动态类型，就必须使用特点的代码提供支持。
bitwise的方法很简单，TObject本身就提供了足够的支持，例如
type
TBitwiseCopy = class
private
FName: ShortString;
public
constructor Create(const AName: string);

procedure Hello;

property Name: ShortString read FName write FName;
end;
...
function BitwiseCopy(Obj: TObject): TObject;
begin
Result := Obj.NewInstance;
Move(Pointer(Obj)^, Pointer(Result)^, Obj.InstanceSize);
end;
...
var
Obj, NewObj: TBitwiseCopy;
begin
Obj := TBitwiseCopy.Create('Flier');
try
NewObj := TBitwiseCopy(BitwiseCopy(Obj));
try
Obj.Name := 'Unknown';
Obj.Hello;

NewObj.Hello;
finally
NewObj.Free;
end;
finally
Obj.Free;
end;
end;
这里TBitwiseCopy的成员变量必须都是非动态分配的，如我这里用ShortString
替代string就是因为后者是使用引用机制，否则复制后的对象会和以前对象使用同一个
动态内存块，在析构时会出现多次析构的问题。
BitwiseCopy是实现的代码，很简单，NewInstance和InstanceSize都是类方法
可以任意调用，前者分配一块足够大的内存，然后调用InitInstance初始化之
（处理VTable等），后者返回对象的大小，然后直接内存bitwise copy即可。
但如果类成员变量中有动态分配的内存指针或者其他对象时，就必须提供诸如拷贝构造函数
或者特定的IClonable接口等方法实现，例如
type
IClonable = interface
['{95A301F6-9194-4661-993C-7EA44D4DBB0C}']
function Clone: TInterfacedObject;
end;

IHello = interface
['{D6F51926-969C-4C99-9425-CFA24B17C12E}']
procedure Hello;

function GetName: string;
procedure SetName(const Value: string);
property Name: string read GetName write SetName;
end;

TNoBitwiseCopyClass = class of TNoBitwiseCopy;
TNoBitwiseCopy = class(TInterfacedObject, IHello, IClonable)
private
FName: string;
protected
function Clone: TInterfacedObject;

procedure Hello;
function GetName: string;
procedure SetName(const Value: string);
public
constructor Create(const AName: string);
end;
...
{ TNoBitwiseCopy }

constructor TNoBitwiseCopy.Create(const AName: string);
begin
FName := AName;
end;

procedure TNoBitwiseCopy.Hello;
begin
ShowMessage('Hello ' + FName);
end;

function TNoBitwiseCopy.GetName: string;
begin
Result := FName;
end;

procedure TNoBitwiseCopy.SetName(const Value: string);
begin
FName := Value;
end;

function TNoBitwiseCopy.Clone: TInterfacedObject;
begin
Result := TNoBitwiseCopy.Create(GetName);
end;
这里提供的实现是基于接口的，通过IClonable接口实现复制，使用起来有两种方法
procedure TForm1.Button2Click(Sender: TObject);
var
Obj, NewObj: TNoBitwiseCopy;
begin
Obj := TNoBitwiseCopy.Create('Flier');
try
NewObj := Obj.Clone as TNoBitwiseCopy;
try
Obj.SetName('Unknown');
Obj.Hello;

NewObj.Hello;
finally
NewObj.Free;
end;
finally
Obj.Free;
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
Obj, NewObj: IClonable;
begin
Obj := TNoBitwiseCopy.Create('Flier');
NewObj := Obj.Clone as IClonable;
(Obj as IHello).Name := 'Unknown';
(Obj as IHello).Hello;
(NewObj as IHello).Hello;
end;
前者完全通过类使用，这需要一个完整的类树的支持，如在哪一级加入Clone方法的支持等等
后者基于接口，效率较低但是接口继承，更灵活，可以在需要的类实现IClonable接口，然后
通过Support等方法检测是否提供接口支持等等，可以动态判定，更加灵活。
此外还有基于虚拷贝构造函数的方法，类似基于类的Clone的实现，只是将Clone变成
constructor Create(const Obj: TObject)
virtual
而已，实现方法类似，
这里就不罗嗦了……

子类可赋值给父类！！！

to yhaochuan：
那样的话，线程本身的工作量加大了，并且我最重要的目的之一就是不修改线程的代码。
因为我的程序中存在着大量不同的子类，如果用户需求有变，我只改那些子类的代码就可以了，而主流程可以保持一致。
否则一有新的变动我就要改线程，而线程又是要适用于所有子类的，所以此法不可取。

to wlmmlw：什么意思？[?]

to flier：等我试一下先， 有问题再请教。

to All：有没有更简洁的办法？……