◆◆◆为何使用VBA调用包含窗体的进程内自动化服务器(in-process Automation server，DLL)出错? ( 积分: 200 )

为了200分，恳请耐着性子看完代码

◆关于
如何编写包含窗体的进程内自动化服务器(in-process Automation server)，也就是dll类型的，请指点一下出错的地方。
◆练习程序要实现的目的
dll在被控制器调用时弹出一个类似口令输入窗口，编辑框内显示的是由控制器设定的初始值，用户可以更改，关闭窗体则控制器获得编辑框当前值。
◆dll编写步骤
1、File->New->Other->ActiveX Library
2、File->New->Other->Automation Object，添加名称、属性、方法
3、File->New->Form
4、完善Automation Object代码
5、编译、注册
◆问题
使用Excel内VBA调用dll时提示“方法'AString'作用于对象'IGetString'时失败”
◆初步分析
1、是不是建立Form2对象的方法不正宗？有何其他方法？
2、在vba代码中注释掉auto.AString = "Hello"，则可以顺利运行。感觉数据只能从dll向控制器单向传递
3、我编写过类似的进程外自动化服务器（exe），没有出现问题，当然，out-of-process Automation Server不需要手动建立窗体对象。

◆◆◆Activex Library代码

library InProcess;

uses
ComServ,
InProcess_TLB in 'InProcess_TLB.pas',
Unit1 in 'Unit1.pas',
Unit2 in 'Unit2.pas' {Form2};

exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin
end.



◆◆◆Automation Object代码（TLB）

unit InProcess_TLB;

// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //

// PASTLWTR : 1.2
// File generated on 2005-7-22 17:51:26 from Type Library described below.

// ************************************************************************ //
// Type Lib: C:/Documents and Settings/Administrator/My Documents/Borland Studio Projects/iii/InProcess.tlb (1)
// LIBID: {15AA1A1D-5DF1-44BF-A77B-3D54CA5B9136}
// LCID: 0
// Helpfile:
// HelpString: InProcess Library
// DepndLst:
// (1) v2.0 stdole, (C:/WINDOWS/system32/stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;


// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
InProcessMajorVersion = 1;
InProcessMinorVersion = 0;

LIBID_InProcess: TGUID = '{15AA1A1D-5DF1-44BF-A77B-3D54CA5B9136}';

IID_IGetString: TGUID = '{3BEDC749-4A38-4D2C-942E-D716B00B545F}';
CLASS_GetString: TGUID = '{49717AAD-2820-4972-A855-D9D7D73059F9}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IGetString = interface;
IGetStringDisp = dispinterface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
GetString = IGetString;


// *********************************************************************//
// Interface: IGetString
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {3BEDC749-4A38-4D2C-942E-D716B00B545F}
// *********************************************************************//
IGetString = interface(IDispatch)
['{3BEDC749-4A38-4D2C-942E-D716B00B545F}']
function Get_AString: WideString; safecall;
procedure Set_AString(const Value: WideString); safecall;
procedure ShowForm; safecall;
procedure FreeForm; safecall;
property AString: WideString read Get_AString write Set_AString;
end;

// *********************************************************************//
// DispIntf: IGetStringDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {3BEDC749-4A38-4D2C-942E-D716B00B545F}
// *********************************************************************//
IGetStringDisp = dispinterface
['{3BEDC749-4A38-4D2C-942E-D716B00B545F}']
property AString: WideString dispid 201;
procedure ShowForm; dispid 202;
procedure FreeForm; dispid 203;
end;

// *********************************************************************//
// The Class CoGetString provides a Create and CreateRemote method to
// create instances of the default interface IGetString exposed by
// the CoClass GetString. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoGetString = class
class function Create: IGetString;
class function CreateRemote(const MachineName: string): IGetString;
end;

implementation

uses ComObj;

class function CoGetString.Create: IGetString;
begin
Result := CreateComObject(CLASS_GetString) as IGetString;
end;

class function CoGetString.CreateRemote(const MachineName: string): IGetString;
begin
Result := CreateRemoteComObject(MachineName, CLASS_GetString) as IGetString;
end;

end.



◆◆◆Automation Object代码

unit Unit1;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
ComObj, ActiveX, InProcess_TLB, StdVcl,unit2;

type
TGetString = class(TAutoObject, IGetString)
protected
function Get_AString: WideString; safecall;
procedure FreeForm; safecall;
procedure Set_AString(const Value: WideString); safecall;
procedure ShowForm; safecall;

end;

implementation

uses ComServ;

function TGetString.Get_AString: WideString;
begin
Result:=Form2.Edit1.Text;
end;

procedure TGetString.FreeForm;
begin
Form2.Free;
end;

procedure TGetString.Set_AString(const Value: WideString);
begin
Form2.Edit1.Text:=Value;
end;

procedure TGetString.ShowForm;
begin
Form2:=TForm2.Create(nil);
Form2.ShowModal;
end;

initialization
TAutoObjectFactory.Create(ComServer, TGetString, Class_GetString,
ciMultiInstance, tmApartment);
end.



◆◆◆窗体Form2的代码：

unit Unit2;

interface

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

type
TForm2 = class(TForm)
Edit1: TEdit;
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

end.



◆◆◆使用Excel内VBA调用dll的代码：

Private Sub CommandButton1_Click()
Dim auto
Dim returnstr
Set auto = CreateObject("InProcess.GetString&quot
auto.AString = "Hello"
auto.ShowForm
returnstr = auto.AString
MsgBox returnstr
End Sub

感谢您的阅读，期待您的解答

为了200分，恳请耐着性子看完代码

◆关于
如何编写包含窗体的进程内自动化服务器(in-process Automation server)，也就是dll类型的，请指点一下出错的地方。
◆练习程序要实现的目的
dll在被控制器调用时弹出一个类似口令输入窗口，编辑框内显示的是由控制器设定的初始值，用户可以更改，关闭窗体则控制器获得编辑框当前值。
◆dll编写步骤
1、File->New->Other->ActiveX Library
2、File->New->Other->Automation Object，添加名称、属性、方法
3、File->New->Form
4、完善Automation Object代码
5、编译、注册
◆问题
使用Excel内VBA调用dll时提示“方法'AString'作用于对象'IGetString'时失败”
◆初步分析
1、是不是建立Form2对象的方法不正宗？有何其他方法？
2、在vba代码中注释掉auto.AString = "Hello"，则可以顺利运行。感觉数据只能从dll向控制器单向传递
3、我编写过类似的进程外自动化服务器（exe），没有出现问题，当然，out-of-process Automation Server不需要手动建立窗体对象。

◆◆◆Activex Library代码

library InProcess;

uses
ComServ,
InProcess_TLB in 'InProcess_TLB.pas',
Unit1 in 'Unit1.pas',
Unit2 in 'Unit2.pas' {Form2};

exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin
end.



◆◆◆Automation Object代码（TLB）

unit InProcess_TLB;

// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //

// PASTLWTR : 1.2
// File generated on 2005-7-22 17:51:26 from Type Library described below.

// ************************************************************************ //
// Type Lib: C:/Documents and Settings/Administrator/My Documents/Borland Studio Projects/iii/InProcess.tlb (1)
// LIBID: {15AA1A1D-5DF1-44BF-A77B-3D54CA5B9136}
// LCID: 0
// Helpfile:
// HelpString: InProcess Library
// DepndLst:
// (1) v2.0 stdole, (C:/WINDOWS/system32/stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;


// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
InProcessMajorVersion = 1;
InProcessMinorVersion = 0;

LIBID_InProcess: TGUID = '{15AA1A1D-5DF1-44BF-A77B-3D54CA5B9136}';

IID_IGetString: TGUID = '{3BEDC749-4A38-4D2C-942E-D716B00B545F}';
CLASS_GetString: TGUID = '{49717AAD-2820-4972-A855-D9D7D73059F9}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IGetString = interface;
IGetStringDisp = dispinterface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
GetString = IGetString;


// *********************************************************************//
// Interface: IGetString
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {3BEDC749-4A38-4D2C-942E-D716B00B545F}
// *********************************************************************//
IGetString = interface(IDispatch)
['{3BEDC749-4A38-4D2C-942E-D716B00B545F}']
function Get_AString: WideString; safecall;
procedure Set_AString(const Value: WideString); safecall;
procedure ShowForm; safecall;
procedure FreeForm; safecall;
property AString: WideString read Get_AString write Set_AString;
end;

// *********************************************************************//
// DispIntf: IGetStringDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {3BEDC749-4A38-4D2C-942E-D716B00B545F}
// *********************************************************************//
IGetStringDisp = dispinterface
['{3BEDC749-4A38-4D2C-942E-D716B00B545F}']
property AString: WideString dispid 201;
procedure ShowForm; dispid 202;
procedure FreeForm; dispid 203;
end;

// *********************************************************************//
// The Class CoGetString provides a Create and CreateRemote method to
// create instances of the default interface IGetString exposed by
// the CoClass GetString. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoGetString = class
class function Create: IGetString;
class function CreateRemote(const MachineName: string): IGetString;
end;

implementation

uses ComObj;

class function CoGetString.Create: IGetString;
begin
Result := CreateComObject(CLASS_GetString) as IGetString;
end;

class function CoGetString.CreateRemote(const MachineName: string): IGetString;
begin
Result := CreateRemoteComObject(MachineName, CLASS_GetString) as IGetString;
end;

end.



◆◆◆Automation Object代码

unit Unit1;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
ComObj, ActiveX, InProcess_TLB, StdVcl,unit2;

type
TGetString = class(TAutoObject, IGetString)
protected
function Get_AString: WideString; safecall;
procedure FreeForm; safecall;
procedure Set_AString(const Value: WideString); safecall;
procedure ShowForm; safecall;

end;

implementation

uses ComServ;

function TGetString.Get_AString: WideString;
begin
Result:=Form2.Edit1.Text;
end;

procedure TGetString.FreeForm;
begin
Form2.Free;
end;

procedure TGetString.Set_AString(const Value: WideString);
begin
Form2.Edit1.Text:=Value;
end;

procedure TGetString.ShowForm;
begin
Form2:=TForm2.Create(nil);
Form2.ShowModal;
end;

initialization
TAutoObjectFactory.Create(ComServer, TGetString, Class_GetString,
ciMultiInstance, tmApartment);
end.



◆◆◆窗体Form2的代码：

unit Unit2;

interface

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

type
TForm2 = class(TForm)
Edit1: TEdit;
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

end.



◆◆◆使用Excel内VBA调用dll的代码：

Private Sub CommandButton1_Click()
Dim auto
Dim returnstr
Set auto = CreateObject("InProcess.GetString&quot
auto.AString = "Hello"
auto.ShowForm
returnstr = auto.AString
MsgBox returnstr
End Sub

感谢您的阅读，期待您的解答

这是个很明显的错误:
Dim auto
Dim returnstr
Set auto = CreateObject("InProcess.GetString&quot
auto.AString = "Hello"
// Form2 尚未创建
auto.ShowForm
//Form2已经创建
把这两句顺序颠倒就行了。

xeen老兄似曾相识，以前解答过我的其他问题？

把VBA的语句顺序颠倒一下，程序的确可以运行。但是，为了使口令窗口停留，给用户修改的机会，dll服务器中使用的是ShowModel方法，VBA控制器一旦执行到auto.ShowForm这一句，在弹出的dll窗体被关闭之前是不会执行下一句auto.AString = "Hello"的，因此，
用户根本看不到口令窗体显示的初始值！

xeen和你说的都有道理，这样推论不知对不对：
对于自动化服务器，如果在dll中使用ShowModel，那么就别打算利用服务器的属性向服务器传递数据了。

不过，办法是有的，可以利用方法（method）

利用贷参数的方法
procedure Tgetstring.showmodelform(const str: WideString);
begin
form2:=TForm2.Create(nil);
form2.Edit1.Text:=str;
form2.ShowModal;//注意，和上一句顺序不能颠倒
end;

想出一个妙招，将
Form2:=TForm2.Create(nil);
Form2.ShowModal;
拆成m1和m2两个method，控制器先调用m1，然后就可以通过属性向服务器传递数据了，然后再调用m2。

哈哈哈。。。
谁还有高招，放马过来

多人接受答案了。