Frage

I'm trying to automate an application (Windows 8, Delphi XE.) For my testing I'm doing the following:

  • Created a small test application, consisting of a form and a memo (Form1)
  • Added a new ActiveX Object, CoClass name TestOLE, Threading mode Apartment, Instancing Multiple (as per this article.)
  • Added one method Method1 which only adds some text to the memo control in Form1

I then start the application and double click on a file named test.vbs which contains the following code:

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

When the application is running, I see that a new form is created, the text is added and then it exits.

What I want to accomplish is that the opened application should have its memo text changed.

I've repeated creating new projects with both MultipleInstance and SingleInstance, and in an outburst of heuristic anger, I even changed the threading model to single, to no avail.

I see two flags in the type library editor: "Replaceable" and "Aggregatable." However, selecting "Replaceable" ends up in an error in the generated RIDL file.

I've been reading a lot about GetObject. It appears that its documentation is even wrong (it says you can omit the first parameter but I've found that doesn't work).

Is this the right way to write an automation server in Delphi that can be reused?

War es hilfreich?

Lösung

Well, I got it working (I hope.)

Reading more of the same article cited above, found the following:

Know how to implement servers that support GetActiveObject.

Adding a global object, and registering in the Running Object Table (ROT) accomplishes the desired task of having the COM call passed to the running application:

Project file:

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 (functions to register and unregister the global object):

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.
Lizenziert unter: CC-BY-SA mit Zuschreibung
Nicht verbunden mit StackOverflow
scroll top