Using TWordApplication with threads

Iam try to use TWordApplication in background thread.

Main thread:

WordApp:=TWordApplication.Create(self);
StartBgThread(WordApp);

Bg thread:

CoInitializeEx(nil, COINIT_MULTITHREADED);
WordApp.ConnectKind := ckNewInstance;
WordApp.Connect;

Main thread different form:

Doc := (WordApp.Documents.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam ));

WordApp.Documents makes access violation.

Ofcourse bg thread make sig开发者_Python百科nal to main thread when word is connected. Then, Doc is creating

You can share interface between threads using Global Interface Table. There is simple example of using this method (sorry for large code block):

unit IntfThread;

interface

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

const

CLSID_StdGlobalInterfaceTable : TGUID = '{00000323-0000-0000-C000-000000000046}';
IID_IGlobalInterfaceTable : TGUID = '{00000146-0000-0000-C000-000000000046}';

type

IGlobalInterfaceTable = interface(IUnknown)
  ['{00000146-0000-0000-C000-000000000046}']
  function RegisterInterfaceInGlobal(const pUnk: IUnknown; const riid: TIID;
    out dwCookie: DWORD): HResult; stdcall;
  function RevokeInterfaceFromGlobal(const riid: TIID): HResult; stdcall;
  function GetInterfaceFromGlobal(dwCookie: DWORD; const riid: TIID;
    out ppv): HResult; stdcall;
end;

type
  TTestForm = class(TForm)
    btnClose: TButton;
    btnRun: TButton;
    procedure btnCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnRunClick(Sender: TObject);
  private
    { Private declarations }
    GIT: IGlobalInterfaceTable;
    FWordIntf: _Application;
    FCookie: DWORD;
    procedure Run;
  public
    { Public declarations }
  end;

  TWorkThread = class(TThread)
  protected
    FCookie: DWORD;
    FWordApp: TWordApplication;
    procedure Execute; override;
  public
    constructor Create(Cookie: DWORD);
  end;

var
  TestForm: TTestForm;

implementation

{$R *.dfm}

procedure TTestForm.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TTestForm.FormCreate(Sender: TObject);
begin
  OleCheck(CoCreateInstance(CLSID_StdGlobalInterfaceTable, nil, CLSCTX_INPROC_SERVER,
    IID_IGlobalInterfaceTable, GIT));
end;

procedure TTestForm.FormDestroy(Sender: TObject);
begin
  FWordIntf.Quit(EmptyParam, EmptyParam, EmptyParam);
  GIT.RevokeInterfaceFromGlobal(IID__Application);
  GIT:= nil;
end;

procedure TTestForm.Run;
var
  WorkThread: TWorkThread;
begin
  FWordIntf:= CoWordApplication.Create;
  GIT.RegisterInterfaceInGlobal(FWordIntf, IID__Application, FCookie);
  WorkThread:= TWorkThread.Create(FCookie);
  WorkThread.Resume;
end;

procedure TTestForm.btnRunClick(Sender: TObject);
begin
  Run;
end;

{ TWorkThread }

constructor TWorkThread.Create(Cookie: DWORD);
begin
  FCookie:= Cookie;
  FreeOnTerminate:= True;
  inherited Create(True);
end;

procedure TWorkThread.Execute;
var
  WordIntf: _Application;
  GIT: IGlobalInterfaceTable;
  FileName: OleVariant;
begin
  CoInitialize(nil);
  FWordApp:= TWordApplication.Create(nil);
  try
    OleCheck(CoCreateInstance(CLSID_StdGlobalInterfaceTable, nil, CLSCTX_INPROC_SERVER,
      IID_IGlobalInterfaceTable, GIT));
    OleCheck(GIT.GetInterfaceFromGlobal(FCookie, IID__Application, WordIntf));
    GIT:= nil;
    FWordApp.ConnectTo(WordIntf);
    FWordApp.Documents.Add(EmptyParam, EmptyParam, EmptyParam, EmptyParam);
    FWordApp.Selection.Font.Size:= 22;
    FWordApp.Selection.Font.Bold:= 1;
    FWordApp.Selection.TypeText('Hello world!');
    FileName:= 'TestDoc.docx';
    FWordApp.ActiveDocument.SaveAs(FileName, EmptyParam, EmptyParam,
      EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
      EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
      EmptyParam, EmptyParam, EmptyParam);
  finally
    FWordApp.Free;
  end;
  CoUninitialize;
end;

end.