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.