如何返回子接口 [已经放一年多了，真没有人知道吗？] (200分)

我使用的是 Delphi 6
[请看下面重新贴的帖子]

var
Fi:IMySubTest;
begin
fi:=MySubTest.create;//应该是COMySubTest吧，你写错了没有，看看TLB单元
fi.hello;
//不必释放，delphi会帮你处理得！
end;

能提供完整的程序吗？可以打包发给我， nkiller@hotidc.com
而且这是一个 ASP 调用的接口，要返回
Result := IMySubTest;

请高手研究一下 Scripting.FileSystemObject(FSO) 的 Type Library
(可以用 Delphi 导入)，文件名为 SCRRUN.DLL ，我的目的和它的一样，
它已经达到了，但我试验了 N 天，就是做不出来。

up

这个太简单了：
我想达到的目的：(ASP Code)
Set MyTest = Server.CreateObject("Project1.MyTest") //创建 Object
Set MySubTest = MyTest.GetCtrl //得到子接口
MySubTest.Hello //执行子接口方法
Set MyTest = Nothing //释放 Object
class MyTest 要求实现两个接口
TMyTest = class(TAutoObject, IMyTest ,iMySubTest )
TMyTest 的getcrtl 直接QueryInterface就搞定了实现如下
function MyTest.GetCtrl： iMySubTest
begin
result := IMyTest as iMySubTest

end

TAutoObjectFactory.Create(ComServer, TMyTest , Class_MyTest,
ciMultiInstance, tmApartment)

To： delphi浪客
我用你的方法试验过，报错，能否提供完整的代码？谢！

目前的分数是300，不够的话，可以再加哦。
这个帖子已经提前一万多遍了，愣是没有答案，不是吧？

请注意要求：
必须是由父接口的方法返回子接口，子接口不可被单独创建。
就是说，注册表中只能有父接口的注册，只能用
Set MySubCtrl = MyCtrl.SubCtrl 得到子接口
而不能用 Server.CreateObject("MyTest.MySubCtrl") 来创建。
如果觉得分给的少的话，我可以增加。希望高手指教，要源码。

按照 Delphi浪客 的方法重新贴一下

1. File -> New -> ActiveX Library (MyTest.dpr)
2. File -> New -> Active Server Object [Name: MyCtrl, Page-Level] (MyCtrl.pas)
程序自动创建 Interface:IMyCtrl, CoClass:MyCtrl
3. 在 Type Library 中增加 Interface:IMySubCtrl
4. 编辑 Type Library 中的 CoClass:MyCtrl，在 Implements 部分加入新的接口 IMySubCtrl
5. 在 Interface:IMyCtrl 中增加属性 SubCtrl
6. 在 Interface:IMySubCtrl 中加入属性 Name, Age
===============================================================================
Type Library 内容:
[
uuid(C3D48F50-6ED2-4AF6-A956-F9FF397557F9),
version(1.0),
helpstring("MyTest Library")

]
library MyTest
{

importlib("stdole2.tlb");
importlib("stdvcl40.dll");

[
uuid(29E2EC3B-E91A-4293-8682-B870BA042157),
version(1.0),
dual,
oleautomation
]
interface IMySubCtrl: IDispatch
{
[
propget,
id(0x00000001)
]
HRESULT _stdcall Name([out, retval] BSTR * Value );
[
propget,
id(0x00000002)
]
HRESULT _stdcall Age([out, retval] long * Value );
};

[
uuid(03C6DA4E-5567-4FAC-B6B6-4A9560A633C7),
version(1.0),
helpstring("MyCtrl Object")
]
coclass MyCtrl
{
[default] interface IMyCtrl;
interface IMySubCtrl;
};

[
uuid(B2780298-863F-41C9-8AF3-E84FC6E8B0A3),
version(1.0),
helpstring("Dispatch interface for MyCtrl Object"),
dual,
oleautomation
]
interface IMyCtrl: IDispatch
{
[
propget,
id(0x00000001)
]
HRESULT _stdcall SubCtrl([out, retval] IMySubCtrl ** Value );
};

};

===============================================================================
MyCtrl.pas 内容：

unit MyCtrl;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
ComObj, ActiveX, AspTlb, MyTest_TLB, StdVcl;

type
TMyCtrl = class(TASPMTSObject, IMyCtrl, IMySubCtrl) //实现两个接口
protected
function Get_SubCtrl: IMySubCtrl
safecall
//接口 IMyCtrl 的方法
function Get_Age: Integer
safecall
//接口 IMySubCtrl 的属性
function Get_Name: WideString
safecall
//接口 IMySubCtrl 的属性
end;

implementation

uses ComServ;

function TMyCtrl.Get_SubCtrl: IMySubCtrl;
begin
Result := IMyCtrl as IMySubCtrl
//按照 Delphi浪客 的方法写的，报错
// Result := TMyCtrl.Create as IMySubCtrl
//编译通过，在 ASP 里 IMySubCtrl 无法用
// Result := CreateComObject(CLASS_MyCtrl) as IMySubCtrl
//同样编译通过，在 ASP 里 IMySubCtrl 无法用
end;

function TMyCtrl.Get_Age: Integer;
begin
Result := 26;
end;

function TMyCtrl.Get_Name: WideString;
begin
Result := 'nkiller';
end;

initialization
TAutoObjectFactory.Create(ComServer, TMyCtrl, Class_MyCtrl,
ciMultiInstance, tmApartment);
end.

===============================================================================
我想达到的目的：(ASP Code)
Set MyCtrl = Server.CreateObject("MyTest.MyCtrl") //创建 Object
Set MySubCtrl = MyCtrl.SubCtrl //得到子接口
Response.Write MySubCtrl.Name //输出子接口的属性值
Response.Write MySubCtrl.Age //输出子接口的属性值
Set MySubCtrl = Nothing //释放 Object
Set MyCtrl = Nothing //释放 Object

===============================================================================
再放一段脚本代码 (Test.vbs)
Set MyCtrl = CreateObject("MyTest.MyCtrl") //创建 Object
Set MySubCtrl = MyCtrl.SubCtrl //得到子接口
WScript.Echo MySubCtrl.Name //输出子接口的属性值
WScript.Echo MySubCtrl.Age //输出子接口的属性值
Set MySubCtrl = Nothing //释放 Object
Set MyCtrl = Nothing //释放 Object
上面这段代码存到一个文本文件，改成.vbs 就行了，用这个的好处是不用安装 IIS，只要有
WSH（Windows Scripting Host）就行了。

想达到上面的目的，不知道应该怎样写，请高手指教，请提供源码供研究，谢谢。

关键问题在这里

procedure TForm1.Button1Click(Sender: TObject);
Var
MyTest, MyCtrl, MySubCtrl : Variant;
Str : String;
begin
MyTest := CreateOleObject('MyTest.MyCtrl');
MyCtrl := MyTest.SubCtrl
// 正确执行
MySubCtrl := MyCtrl.SubCtrl
// 这个居然也正确执行
// Str := MyCtrl.Name
// 这个就不可以，返回的信息是“不支持”
// Str := MySubCtrl.Name
// 这个就不可以，返回的信息是“不支持”
end;

也就是说，MyTest.SubCtrl 返回的是 IMyCtrl 而不是 IMySubCtrl，可我的代码明明返回的是 IMySubCtrl 啊！！！费解.....

返回Result := CreateComObject(CLASS_MyCtrl) as IMyCtrl
是正确的。
另外一个接口应该通过QueryInterface获得。
var
v: IMyCtrl;
v1: IMySubCtrl;
begin
CreateComObject(CLASS_MyCtrl) as IMyCtrl;
QueryInterface(IID_MyCtrl, v1);
...

function TMyCtrl.Get_SubCtrl: IMySubCtrl;
begin
Result := self as IMySubCtrl
//该为这样试试
// Result := TMyCtrl.Create as IMySubCtrl
//编译通过，在 ASP 里 IMySubCtrl 无法用
// Result := CreateComObject(CLASS_MyCtrl) as IMySubCtrl
//同样编译通过，在 ASP 里 IMySubCtrl 无法用
end;

Result := Self as IMySubCtrl
// 失败
==============================================================
function TMyCtrl.Get_SubCtrl: IMySubCtrl;
Var
FTMyCtrl : TMyCtrl;
FIMySubCtrl : IMySubCtrl;
begin
FTMyCtrl := TMyCtrl.Create;
FTMyCtrl.QueryInterface(IID_IMyCtrl,FIMySubCtrl);
Result := FIMySubCtrl;
end;
// 失败
==============================================================
function TMyCtrl.Get_SubCtrl: IMySubCtrl;
Var
FIMyCtrl : IMyCtrl;
FIMySubCtrl : IMySubCtrl;
begin
FIMyCtrl := CoMyCtrl.Create;
FIMyCtrl.QueryInterface(IID_IMyCtrl,FIMySubCtrl);
Result := FIMySubCtrl;
end;
// 继续失败
还有别的办法吗？

你这个写法有问题，子接口在一个单独的类中创建，然后通过Set_SubCtrl建立实例
我没写过asp对象，不知道怎么用，你和我说说你测试用的.vbs文件怎么用，我给你试试吧

为了测试方便，我把所有 ASP 的测试部分都换成用 Delphi 来测试，效果是一样的。
测试部分代码：（新建一个Application，放个 Button 和 Lable就行了）
procedure TForm1.Button1Click(Sender: TObject);
Var
MyCtrl, MySubCtrl : Variant;
Str : String;
begin
MyCtrl := CreateOleObject('MyTest.MyCtrl');
MySubCtrl := MyCtrl.SubCtrl;
Str := MySubCtrl.Name;
end;
==========================================================================

是这样的，一个 CoClass 对应一个 Interface 的方法我已经解决（在 TypeLibrary 只要有一个Interface 就有一个 CoClass 与之对应）。实现很容易，如：
function TMyCtrl.Get_SubCtrl: IMySubCtrl;
begin
Result := CoMyCtrl.Create
//这样就行了，一点问题都没有
Result :＝ TMyCtrl.Create as IMySubCtrl； //这样也可以
end;
==========================================================================

但这样有一个弊端，就是:
procedure TForm1.Button1Click(Sender: TObject);
Var
MyCtrl, MySubCtrl : Variant;
Str : String;
begin
MyCtrl := CreateOleObject('MyTest.MyCtrl');
MySubCtrl := MyCtrl.SubCtrl;
Str := MySubCtrl.Name;
// 以上正确执行
MyCtrl := CreateOleObject('MyTest.MySubCtrl')
//这个也能执行
end;
我的目的是只能 CreateOleObject('MyTest.MyCtrl')，而不允许用这种方法创建 CreateOleObject('MyTest.MySubCtrl')，只能通过MySubCtrl := MyCtrl.SubCtrl来获得子接口 IMySubCtrl，我说清楚了吗？

还有一个比较有意思的事情，用我上面提供的完整代码的工程，增加一个 CoClass，用来实现 IMySubCtrl,（一个CoClass对应一个Interface），新加入的CoClass没有任何代码，只有一个Create 方法
class function CoMySubCtrl.Create: IMySubCtrl;
begin
Result := CreateComObject(CLASS_MySubCtrl) as IMySubCtrl;
end;

class function CoMySubCtrl.CreateRemote(const MachineName: string): IMySubCtrl;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MySubCtrl) as IMySubCtrl;
end;
而实现部分依然是
type
TMyCtrl = class(TASPMTSObject, IMyCtrl, IMySubCtrl) //实现两个接口
protected
function Get_SubCtrl: IMySubCtrl
safecall
//接口 IMyCtrl 的方法
function Get_Age: Integer
safecall
//接口 IMySubCtrl 的属性
function Get_Name: WideString
safecall
//接口 IMySubCtrl 的属性
end；
这样就可以成功地用 MySubCtrl := MyCtrl.SubCtrl
创建子接口 IMySubCtrl，头大中......

不对头啊。
TMyCtrl = class(TASPMTSObject, IMyCtrl, IMySubCtrl)
protected
function Get_SubCtrl: IMySubCtrl
safecall;
function Get_Age: Integer
safecall;
function Get_Name: WideString
safecall;
end;
这个用来建立接口的类是无法承载接口的建立的啊。
你需要使用“程序自动创建 Interface:IMyCtrl, CoClass:MyCtrl”中的 CoClass 来建立
接口的啊。

我看了一下你的代码，发现你在程序内没有自动产生imysubctrl接口，按理说可以把
IMyCtrl转为IMySubCtrl接口，但不知为何，我这样做不行。
我觉得你可以做一个进程内comobject，在tmyCtrl.create中产生一个接口实例，然后通过
IMyctrl.subctrl属性输出接口，我这么做了，可以通过编译但执行时报非法内存访问
错误，也许是我写的不对，你可以试一试

你试试使用 Result := TMyCtrl.Create as IMySubCtrl 这句，并在紧接着对 IMySubCtrl
的记数值加一试试。类似下面
function TMyCtrl.Get_SubCtrl: IMySubCtrl;
var
A:IMyCtrl;
begin
A:=(TMyCtrl.Create) as IMyCtrl;
if A.QueryInterface(IID_IMySubCtrl,Result)=0 then
Result._AddRef
// 手工增加引用记数
end;
我怀疑需要自己增加引用记数。

我试了，不行
如a:ImyCtrl 不能通过编译
a:IMySubCtrl能通过但执行出错