COM 服务器应用程序和 GetObject - 重用正在运行的应用程序答案

【问题标题】：COM Server application and GetObject - reusing the running applicationCOM 服务器应用程序和 GetObject - 重用正在运行的应用程序
【发布时间】：2014-04-29 03:43:16
【问题描述】：

我正在尝试自动化应用程序（Windows 8、Delphi XE）。对于我的测试，我正在执行以下操作：

创建了一个小型测试应用程序，由一个表单和一个备忘录 (Form1) 组成
添加了一个新的 ActiveX 对象，CoClass 名称 TestOLE，线程模式 Apartment，Instancing Multiple（根据 this article。）
添加了一个方法Method1，它只在Form1的备忘录控件中添加了一些文本

然后我启动应用程序并双击一个名为test.vbs 的文件，其中包含以下代码：

dim obj
set obj = GetObject("", "Project1.TestOLE")
obj.AddSomeText "Hola mundo"

当应用程序运行时，我看到创建了一个新表单，添加了文本然后退出。

我想要完成的是打开的应用程序应该改变它的备忘录文本。

我反复使用 MultipleInstance 和 SingleInstance 创建新项目，并且在启发式愤怒的爆发中，我什至将线程模型更改为单，但无济于事。

我在类型库编辑器中看到两个标志：“可替换”和“可聚合”。但是，选择“可替换”最终会导致生成的 RIDL 文件出错。

我已经阅读了很多关于GetObject 的信息。看来它的文档甚至是错误的（它说您可以省略第一个参数，但我发现它不起作用）。

这是在 Delphi 中编写可重用的自动化服务器的正确方法吗？

【问题讨论】：

您的问题似乎是关于 VBScript 和 GetObject，而不是关于 Delphi。如果是关于 Delphi，您是否可以访问任何早期版本，例如 Delphi 5/7/2007？它们都包含 COM 自动化的示例（例如，在 2007 年，它们位于 Demos\DelphiWin32\VCLWin32\ActiveX\OleAuto 中）。
您说得有道理，但我不确定它是否与 GetObject 有关，因为文档和示例表明它应该重用正在运行的应用程序。我不是会为此编写客户端的人。
好吧，您的问题显示了 VBScript，谈到了 GetObject()（它不是 Delphi），并询问了为什么 VBScript 不重用正在运行的应用程序。您在这里问的具体 Delphi 相关 问题是什么？（您确实也看到了我在早期 Delphi 版本中提到的现有示例？）
得到它的工作（显然，一个永远不知道与 COM。）我会更新这个问题。
:-) 仅供参考，Delphi 中使用后期绑定的典型方法是首先使用 GetActiveOleObject 尝试连接到正在运行的实例，如果失败则使用 CreateOleObject 启动新实例。（两者都在 ComObj 单元中。）

标签： delphi com delphi-xe

【解决方案1】：

好吧，我让它工作了（我希望。）

阅读更多上面引用的同一篇文章，发现以下内容：

Know how to implement servers that support GetActiveObject。

添加一个全局对象，并在运行对象表 (ROT) 中注册即可完成将 COM 调用传递给正在运行的应用程序的预期任务：

项目文件：

program TestOLEProject3;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  TestOLEProject3_TLB in 'TestOLEProject3_TLB.pas',
  Unit2 in 'Unit2.pas' {TestOLE: CoClass},
  Unit3 in 'Unit3.pas';

{$R *.TLB}

{$R *.res}

begin
  Application.Initialize;
  RegisterGlobalTestOLE;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Unit2.pas：

unit Unit2;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, TestOLEProject3_TLB, StdVcl;

type
  TTestOLE = class(TAutoObject, ITestOLE)
  protected
    procedure Method1; safecall;
    procedure Quit; safecall;
  end;

implementation

uses ComServ, Unit1, Unit3;

procedure TTestOLE.Method1;
begin
  Form1.Memo1.Lines.Add('Wheeee');
end;

procedure TTestOLE.Quit;
begin
  RevokeGlobalTestOLE;
end;

initialization

TAutoObjectFactory.Create(ComServer, TTestOLE, CLASS_TestOLE, ciMultiInstance,
  tmApartment);

end.

Unit3.pas（注册和注销全局对象的函数）：

unit Unit3;

interface

procedure RegisterGlobalTestOLE;
procedure RevokeGlobalTestOLE;

implementation

uses TestOLEProject3_TLB, ComObj, ActiveX;

var
  GlobalTestOLEHandle: longint = 0;

procedure RegisterGlobalTestOLE;
var
  GlobalTestOLE: ITestOLE;
begin
  GlobalTestOLE := CoTestOLE.Create;
  OleCheck(RegisterActiveObject(GlobalTestOLE, CLASS_TestOLE,
    ACTIVEOBJECT_STRONG, GlobalTestOLEHandle));
end;

procedure RevokeGlobalTestOLE;
begin
  if (GlobalTestOLEHandle <> 0) then
  begin
    OleCheck(RevokeActiveObject(GlobalTestOLEHandle, nil));
    GlobalTestOLEHandle := 0;
  end;
end;

end.

【讨论】：