delphi - 将 TWordApplication 与线程一起使用

Question

我尝试在后台线程中使用 TWordApplication。

主线程:

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

Bg线程:

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

主线程不同形式:

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

WordApp.Documents 导致访问冲突。

当然，当 word 连接时，bg 线程会向主线程发出信号。然后，Doc正在创建

Answer 1

您可以使用 Global Interface Table 在线程之间共享接口(interface).有一个使用这种方法的简单例子(对不起大代码块):

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.