怎么在DELPHI中打开WORD文档，关闭文档后，自动释放资源

Question

怎么在DELPHI中打开WORD文档，关闭文档后，自动释放资源？我用SHELLEXECUTE 打开后，关闭WORD 系统资源没有完全释放，如果反复打开，资源会越占越多，只有关闭程序，才能释放。

Answer 1

procedure TForm1.Button1Click(Sender: TObject);
var
  H:THandle;
  P:DWORD;
begin
  H:=FindWindow(nil,'word的文件标题');
  if H<>0 then
  begin
    GetWindowThreadProcessId(H,@P);
    if P<>0 then
      TerminateProcess(OpenProcess(PROCESS_TERMINATE,False,P),$FFFFFFFF);
  end;
end;

Answer 2

procedure towordsave(sourcetablename: string;sourceid:integer;dataset:tadodataset) ;
var
    sCommandLine: string;
    bCreateProcess: boolean;
    lpStartupInfo: TStartupInfo;
    lpProcessInformation: TProcessInformation;
    MemSize: Integer;
    Buffer: PChar;
    MyFile: TFileStream;
    Stream: TADOBlobStream;
    RegF:TRegistry;
begin
    RegF:=TRegistry.Create;    //查看.doc文档的打开程序
    RegF.RootKey:=HKEY_classes_root;
    try
       RegF.OpenKey('worddocument\protocol\stdfileediting\server',True);
       sCommandLine:=regf.ReadString('')+' '+ExtractFilePath(Application.EXEName)+'temp.doc';
    except
    End;
    RegF.CloseKey;
    RegF.Free;
    dataset.Close;
    dataset.commandtext :='select * from 二进制文档 where 来源=''' +sourcetablename+''' and 来源id='+inttostr(sourceid);
    dataset.open;
    if not dataset.eof then
        begin
        MyFile:=TFileStream.Create(ExtractFilePath(Application.EXEName)+'temp.tmp',fmCreate);
        Stream:=TADOBlobStream.Create(dataset.FieldByName('内容') as TBlobField, bmRead);
        MemSize := Stream.Size;
        Inc(MemSize);
        Buffer := AllocMem(MemSize);
        try
            Stream.Read(Buffer^,MemSize);
            MyFile.Write(Buffer^,MemSize);
        finally
            MyFile.Free;Stream.Free;
        end;
        if FileExists(ExtractFilePath(Application.EXEName)+'temp.DOC') then DeleteFile(ExtractFilePath(Application.EXEName)+'temp.DOC');
        if FileExists(ExtractFilePath(Application.EXEName)+'temp.tmp') then RenameFile(ExtractFilePath(Application.EXEName)+'temp.tmp', ExtractFilePath(Application.EXEName)+'temp.DOC');
        end
    else
        begin
           if FileExists(ExtractFilePath(Application.EXEName)+'empty.DOC') then
                copyfile(pchar(ExtractFilePath(Application.EXEName)+'empty.DOC'),pchar(ExtractFilePath(Application.EXEName)+'temp.DOC'),false)
           else begin
                ShowMessage('<'+ExtractFilePath(Application.EXEName)+'empty.DOC>不存在!');
                dataset.close ;
                exit;
           end;
        end;
    dataset.close ;
    //sCommandLine :='C:\Program Files\Microsoft Office\Office\winword.exe '+ExtractFilePath(Application.EXEName)+'temp.doc';    FillChar(lpStartupInfo, Sizeof(TStartupInfo), #0);
    lpStartupInfo.cb := Sizeof(TStartupInfo);
    lpStartupInfo.dwFlags := STARTF_USESHOWWINDOW;
    lpStartupInfo.wShowWindow := SW_NORMAL;
    bCreateProcess := CreateProcess(nil, PChar(sCommandLine),nil, nil, True, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,nil, nil, lpStartupInfo, lpProcessInformation);
    //ShellExecute(zxdcc.Handle,'save',pchar(ExtractFilePath(Application.EXEName)+'empty.doc') ,'','',SW_SHOWNORMAL);    if bCreateProcess then
    WaitForSingleObject(lpProcessInformation.hProcess, INFINITE);
    dataset.Close;
    dataset.commandtext:='select * from 二进制文档 where 来源=''' +sourcetablename+''' and 来源id='+inttostr(sourceid);
    dataset.open;
    if not dataset.eof then
        dataset.Edit
    else begin
        dataset.close;
        dataset.commandtext:='select * from 二进制文档';
        dataset.open;
        dataset.append;
        end;
    dataset.FieldValues['来源']:=sourcetablename;
    dataset.FieldValues['来源id']:=sourceid;
    MyFile:=TFileStream.Create(ExtractFilePath(Application.EXEName)+'temp.doc',fmOpenRead);
    Stream := TADOBlobStream.Create(dataset.FieldByName('内容') as TBlobField, bmWrite);{‘Doc’为BLOB字段名}
    MemSize := MyFile.Size;
    Inc(MemSize);//增加的一字节给结尾的null
    Buffer := AllocMem(MemSize);
    try
        Stream.Seek(0, soFromBeginning);//流指针位置放到最前
        MyFile.Read(Buffer^,MemSize);
        Stream.Write(Buffer^,MemSize);
    finally
        MyFile.Free;
        Stream.Free;
    end;
    dataset.post;
    dataset.close;
end;

Answer 3

MSWord := GetActiveOleObject('Word.Application');
或
MSWord := CreateOleObject('Word.Application');
...
...
....
if (MSWord.Documents.Count = 0) then // 所有的Word文都已被关闭，关闭Word进程
      MSWord.Application.Quit(0);

Answer 4

procedure TForm1.Button1Click(Sender: TObject);
var
  H:THandle;
  P:DWORD;
begin
  H:=FindWindow('winword.exe',nil);
  if H<>0 then
  begin
    GetWindowThreadProcessId(H,@P);
    if P<>0 then
      TerminateProcess(OpenProcess(PROCESS_TERMINATE,False,P),$FFFFFFFF);
  end;
end;

Answer 5

好象还是不行，我搞不定了。系统并没有WORD进程。我用的语句是：
ShellExecute(handleform.handle, 'open', StrPCopy(zFile,sFileName),nil,nil,SW_SHOWNORMAL);

Answer 6

还有什么可以在程序打开WORD文档的方法吗

Answer 7

我找到原因了，是我借用了DEMO中的virtuallistview例子中的语句，造成占用资源不能释放。但是我没有找到解决的办法。各位有没有看过这个例子？？两天后结贴