文件未正确压缩

Question

我正在创建一个类来直接从代码创建 docx 文档。 下面的代码显示了一个示例。使用此代码，MS WORD 打开文档，但 libreoffice、openoffice 显示文档已损坏。

但是，如果我使用 Windows 资源管理器将 docx 文档重命名为 zip 类型，并解压该文档，然后使用“发送到压缩（zipped）文件夹”选项并将文档类型更改为 docx，则所有提到的文本编辑器都会打开该文档。我哪里错了？

unit uWordX;

interface

uses
  System.Classes, Xml.xmldom, Xml.XMLIntf, Xml.XmlDoc;

    type
      TWordxClass = class
      private
        FOwner    : TComponent;
        procedure CreateXmlHeader(XmlDocument: TXmlDocument);
        function SaveXmlDocToStream(XmlDocument: TXmlDocument): TStream;
        function AddAttributes(RootAttribute: IXMLNode; NodeName: string; attrNames: Array of string; attrValues: array of string): IXMLNode;

    function CreateRelsRels: TStream;
    function CreateRelsDocumentXMLRels: TStream;
    function CreateContentTypes: TStream;

    function CreateSimpleDoc: TStream;
  public
    Constructor Create(AOwner: TComponent); virtual;

    procedure CreateFile(AFileName: string);
  end;

implementation

uses
  System.SysUtils, System.Zip;

{ TWordxClass }

function TWordxClass.AddAttributes(RootAttribute: IXMLNode; NodeName: string;
  attrNames, attrValues: array of string): IXMLNode;
begin
  Result  := RootAttribute.AddChild(NodeName);
  for var idx := Low(attrValues) to High(attrValues) do
    Result.Attributes[attrNames[idx]] := attrValues[idx];
end;

constructor TWordxClass.Create(AOwner: TComponent);
begin
  FOwner    := AOwner;
end;

function TWordxClass.CreateContentTypes: TStream;
begin
  var XmlDocument := TXmlDocument.Create(FOwner);
  try
    CreateXmlHeader(XmlDocument);
    // Root Node
    var Root := XmlDocument.addChild('Types',
      'http://schemas.openxmlformats.org/package/2006/content-types');
    var Def := AddAttributes(Root, 'Default', ['Extension', 'ContentType'],
                ['rels', 'application/vnd.openxmlformats-package.relationships+xml']);
    Def     := AddAttributes(Root, 'Default', ['Extension', 'ContentType'],
                ['xml', 'application/xml']);
    var Ovr := AddAttributes(Root, 'Override',
                ['PartName', 'ContentType'],
                ['/word/document.xml', 'application/vnd.openxmlformats-officedocument.wordprocessingml.document.main+xml']);

    Result := SaveXmlDocToStream(XmlDocument);
  finally
    XmlDocument.Free;
  end;
end;

procedure TWordxClass.CreateFile(AFileName: string);
begin
  var FZipFile := TZipFile.Create;
  try
    FZipFile.Open(AFileName, TZipMode.zmWrite);
    var CntType := CreateContentTypes();
    try

      FZipFile.Add(CntType, '[Content_Types].xml');
    finally
      CntType.Free;
    end;

    var RelsStream := CreateRelsRels();
    try

      FZipFile.Add(RelsStream, '_rels\.rels');
    finally
      RelsStream.Free;
    end;

    var RelsDocumentXMLRels := CreateRelsDocumentXMLRels();
    try
      FZipFile.Add(RelsDocumentXMLRels, 'word/_rels/document.xml.rels');
    finally
      RelsDocumentXMLRels.Free;
    end;

    var Document := CreateSimpleDoc();
    try
      FZipFile.Add(Document, 'word/document.xml');
    finally
      Document.Free;
    end;
    FZipFile.Close;
  finally
    FZipFile.Free;
  end;
end;

function TWordxClass.CreateRelsDocumentXMLRels: TStream;
begin
  var XmlDocument := TXmlDocument.Create(FOwner);
  try
    CreateXmlHeader(XmlDocument);
    // Root Node
    var Root := XmlDocument.addChild('Relationships',
      'http://schemas.openxmlformats.org/package/2006/relationships');
    Result := SaveXmlDocToStream(XmlDocument);
  finally
    XmlDocument.Free;
  end;
end;

function TWordxClass.CreateRelsRels: TStream;
begin
  var XmlDocument := TXmlDocument.Create(FOwner);
  try
    CreateXmlHeader(XmlDocument);
    // Root Node
    var Root := XmlDocument.addChild('Relationships',
      'http://schemas.openxmlformats.org/package/2006/relationships');
    // Relationship Definition
    var Rel := Root.addChild('Relationship');
    Rel.Attributes['Id'] := 'rId1';
    Rel.Attributes['Type'] :=
      'http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument';
    Rel.Attributes['Target'] := 'word/document.xml';
    Result := SaveXmlDocToStream(XmlDocument);
  finally
    XmlDocument.Free;
  end;
end;

function TWordxClass.CreateSimpleDoc: TStream;
begin
  var XmlDocument := TXmlDocument.Create(FOwner);
  try
    CreateXmlHeader(XmlDocument);
    // Root Node
    var Doc := XmlDocument.AddChild('w:document');
    Doc.DeclareNamespace('wpc', 'http://schemas.microsoft.com/office/word/2010/wordprocessingCanvas');
    Doc.DeclareNamespace('mc', 'http://schemas.openxmlformats.org/markup-compatibility/2006');
    Doc.DeclareNamespace('o', 'urn:schemas-microsoft-com:office:office');
    Doc.DeclareNamespace('r', 'http://schemas.openxmlformats.org/officeDocument/2006/relationships');
    Doc.DeclareNamespace('m', 'http://schemas.openxmlformats.org/officeDocument/2006/math');
    Doc.DeclareNamespace('v', 'urn:schemas-microsoft-com:vml');
    Doc.DeclareNamespace('wp14', 'http://schemas.microsoft.com/office/word/2010/wordprocessingDrawing');
    Doc.DeclareNamespace('wp', 'http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing');
    Doc.DeclareNamespace('w10', 'urn:schemas-microsoft-com:office:word');
    Doc.DeclareNamespace('w', 'http://schemas.openxmlformats.org/wordprocessingml/2006/main');
    Doc.DeclareNamespace('w14', 'http://schemas.microsoft.com/office/word/2010/wordml');
    Doc.DeclareNamespace('wpg', 'http://schemas.microsoft.com/office/word/2010/wordprocessingGroup');
    Doc.DeclareNamespace('wpi', 'http://schemas.microsoft.com/office/word/2010/wordprocessingInk');
    Doc.DeclareNamespace('wne', 'http://schemas.microsoft.com/office/word/2006/wordml');
    Doc.DeclareNamespace('wps', 'http://schemas.microsoft.com/office/word/2010/wordprocessingShape');
    Doc.Attributes['mc:Ignorable']  := 'w14 wp14';

    var Body  := Doc.AddChild('w:body');
    var Paragraf  := AddAttributes(Body, 'w:p', ['w:rsidR', 'w:rsidRDefault'], ['005F670F', '005F79F5']);
    var Text  := Paragraf.AddChild('w:r').AddChild('w:t');
    Text.NodeValue    := 'Tekst';


    var bookmarkStart := AddAttributes(Paragraf, 'w:bookmarkStart', ['w:id', 'w:name'], ['0', '_GoBack']);
    var bookmarkEnd := AddAttributes(Paragraf, 'w:bookmarkEnd', ['w:id'], ['0']);

    var SectPtr := AddAttributes(Body, 'w:sectPr', ['w:rsidR'], ['005F670F']);
    var PageSize  := AddAttributes(SectPtr, 'w:pgSz', ['w:w', 'w:h'], ['12240', '15840']);
    var PageMargine := AddAttributes(SectPtr, 'w:pgMar', ['w:top', 'w:right', 'w:bottom', 'w:left', 'w:header', 'w:footer', 'w:gutter'],
                                                         ['1440', '1440', '1440', '1440', '720', '720', '0']);
    var Cols    := AddAttributes(SectPtr, 'w:cols', ['w:space'], ['720']);
    var DocGrid := AddAttributes(SectPtr, 'w:docGrid', ['w:linePitch'], ['360']);

    Result := SaveXmlDocToStream(XmlDocument);
  finally
    XmlDocument.Free;
  end;
end;

procedure TWordxClass.CreateXmlHeader(XmlDocument: TXmlDocument);
begin
  XmlDocument.Options := [doNodeAutoIndent];
  XmlDocument.Active := True;
  XmlDocument.Encoding := 'UTF-8';
  XmlDocument.Version := '1.0';
  XmlDocument.StandAlone := 'yes';
end;

function TWordxClass.SaveXmlDocToStream(XmlDocument: TXmlDocument): TStream;
begin
  Result  := TMemoryStream.Create;
  XmlDocument.SaveToStream(Result);
  Result.Seek(0, soBeginning);
end;

end.

文档上传地址：https://drive.google.com/drive/u/0/folders/1GPfLjMYPwaI-E5ZEEwxlORy_b_PZI1cJ

文档 TestSimple.docx 是由代码生成的，[Content_Types].docx 是重新压缩的文档。 MSWord和Mac的TextEdit可以打开TestSimple.docx，而应用程序OpenOffice和LibreOffice无法打开它。解压原始文档、使用 Windows 资源管理器重新压缩并重命名为 docx 扩展名后，所有提到的应用程序都会打开新文档。

提前致谢，

博扬