在線程中使用TWordApplication

Question

Iam嘗試在後臺線程中使用TWordApplication。

主線程：

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

博伽螺紋：

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

主線程不同的形式：

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

WordApp.Documents使得訪問衝突。

當字連接時，當前bg線程向主線程發出信號。然後，Doc正在創建

Answer 1

您可以使用Global Interface Table共享線程之間的接口。有一個簡單的例子，使用這種方法（對不起，大碼塊）：

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.