ODT/ODS import/export for Lazarus (no LibreOffice installed required)

OdtFilter.pas

unit OdtFilter;

interface

uses
  Classes, SysUtils, laz2_DOM, ZipUtils, Zip, Unzip, laz2_XMLRead, myXMLWrite;

Type
  // класс для преобразования одного документа ODF (OpenDocument format)
  // в другой (например, для модификации содержимого),
  // Читается файл, имя которого передано в конструктор, создаётся
  // выходной файл, имя которого указывается в команде Filter.
  // Для реальной работы, необходимо создать наследника и перекрыть один
  // (или более) из методов: FilterContent, FilterStyle, FilterSettings
  // для изменения соответствующих настроек.
  TOdtFilter=class
  private
    fTemplate:string;
  protected
    procedure FilterContent({%H-}Doc:TXMLDocument);virtual;
    procedure FilterStyle({%H-}Doc:TXMLDocument);virtual;
    procedure FilterSettings({%H-}Doc:TXMLDocument);virtual;
  public
    Constructor Create(const Template:string);
    procedure Filter(const Output:string);
  end;

  // класс для чтения и извлечения информации из документов ODF (OpenDocument Format)
  // Читает файл, переданный в процедуру Process. Для выполнения реальной работы,
  // необходимо создать наследника, в котором перекрыть один (или более) из методов
  // ProcessContent, ProcessStyle, ProcessSettings и в этих методах извлекать нужную
  // информацию
  TOdtProcess=class
  protected
    procedure ProcessContent({%H-}Doc:TXMLDocument);virtual;
    procedure ProcessStyle({%H-}Doc:TXMLDocument);virtual;
    procedure ProcessSettings({%H-}Doc:TXMLDocument);virtual;
  public
    procedure Process(const InName:string);
  end;

implementation

procedure CheckUnZipCode(Code:integer);
begin
  case Code of
    UNZ_OK:; // нет ошибки
    UNZ_END_OF_LIST_OF_FILE:
      raise Exception.Create('Конец списка файлов');
    UNZ_ERRNO:
      raise Exception.Create('Неизвестная ошибка');
    UNZ_PARAMERROR:
      raise Exception.Create('Неверный параметр');
    UNZ_BADZIPFILE:
      raise Exception.Create('Неверный формат ZIP архива');
    UNZ_INTERNALERROR:
      raise Exception.Create('Внутренняя ошибка');
    UNZ_CRCERROR:
      raise Exception.Create('Ошибка CRC32, файл повреждён!');
    else
      raise Exception.CreateFmt('Неизвестная ошибка: %d',[Code]);
  end;
end;

procedure CheckZipCode(Code:integer);
begin
  case Code of
    ZIP_OK:; // нет ошибки
    ZIP_ERRNO:
      raise Exception.Create('Неизвестная ошибка');
    ZIP_PARAMERROR:
      raise Exception.Create('Неверный параметр');
    ZIP_INTERNALERROR:
      raise Exception.Create('Внутренняя ошибка');
    Z_DEFLATED:;
  end;
end;

{ TOdtProcess }

procedure TOdtProcess.ProcessContent(Doc: TXMLDocument);
begin end;

procedure TOdtProcess.ProcessStyle(Doc: TXMLDocument);
begin end;

procedure TOdtProcess.ProcessSettings(Doc: TXMLDocument);
begin end;

procedure TOdtProcess.Process(const InName: string);
Const
  MaxFileName=4096;
  BufferSize=16*1024;
var
  unz:unzFile;
  FileInfo:unz_file_info;
  FileName:PChar;
  Status:longint;
  Buffer:pointer;
  Memory:TMemoryStream;
  XML:TXMLDocument;
begin
  unz:=nil;
  FileName:=nil;
  Buffer:=nil;
  try
    unz:=unzOpen(PChar(InName));
    if unz=nil then
      raise Exception.Create('Неверный формат ZIP архива: '+InName);
    GetMem(FileName,MaxFileName);
    GetMem(Buffer,BufferSize);
    Memory:=TMemoryStream.Create;
    CheckUnZipCode(unzGoToFirstFile(unz));
    repeat
      CheckUnZipCode(unzGetCurrentFileInfo(unz,@FileInfo,FileName,MaxFileName,nil,0,nil,0));
      if (FileName='styles.xml') or (FileName='settings.xml') or (FileName='content.xml') then begin
        CheckUnZipCode(unzOpenCurrentFile(unz));
        Memory.Clear;
        repeat
          Status:=unzReadCurrentFile(unz,Buffer,BufferSize);
          if Status=0 then break;
          if Status<0 then CheckUnZipCode(Status);
          Memory.Write(Buffer^,Status);
        until false;
        Memory.Position:=0;
        ReadXMLFile(Xml,Memory,[xrfPreserveWhiteSpace]);
        if FileName='styles.xml' then
          ProcessStyle(Xml)
        else if FileName='content.xml' then
          ProcessContent(Xml)
        else if FileName='settings.xml' then
          ProcessSettings(Xml);
        Memory.Clear;
        WriteXMLFile(Xml,Memory,[xwfPreserveWhiteSpace]);
        Xml.Free;
        CheckUnZipCode(unzCloseCurrentFile(unz));
      end;
      Status:=unzGoToNextFile(unz);
      if Status=UNZ_END_OF_LIST_OF_FILE then break;
      if Status<>0 then CheckUnZipCode(Status);
    until false;
  finally
  	Memory.Free;
    FreeMem(FileName);
    FreeMem(Buffer);
    if unz<>nil then CheckUnZipCode(unzClose(unz));
  end;
end;

{ TOdtFilter }

procedure TOdtFilter.FilterContent(Doc: TXMLDocument);
begin

end;

procedure TOdtFilter.FilterStyle(Doc: TXMLDocument);
begin

end;

procedure TOdtFilter.FilterSettings(Doc: TXMLDocument);
begin

end;

constructor TOdtFilter.Create(const Template: string);
begin
  inherited Create;
  fTemplate:=Template;
end;

procedure TOdtFilter.Filter(const Output: string);
Const
  MaxFileName=4096;
  BufferSize=16*1024;
var
  unz:unzFile;
  zzz:zipFile;
  FileInfo:unz_file_info;
  FileInfoZip:zip_fileinfo;
  FileName:PChar;
  Status:longint;
  Buffer:pointer;
  Memory:TMemoryStream;
  XML:TXMLDocument;
  CurrentDate:TDateTime;
  a,b,c,d:word;
  tmu_now:tm_zip;
begin
  unz:=nil;
  zzz:=nil;
  FileName:=nil;
  Buffer:=nil;
  CurrentDate:=Now;
  DecodeDate(CurrentDate,a,b,c);
  tmu_now.tm_year:=a;
  tmu_now.tm_mon:=b;
  tmu_now.tm_mday:=c;
  DecodeTime(CurrentDate,a,b,c,d);
  tmu_now.tm_hour:=a;
  tmu_now.tm_min:=b;
  tmu_now.tm_sec:=c;
  try
    unz:=unzOpen(PChar(fTemplate));
    if unz=nil then
      raise Exception.Create('Неверный формат ZIP архива: '+fTemplate);
    zzz:=zipOpen(PChar(Output),0);
    if zzz=nil then
      raise Exception.Create('Не могу создать ZIP архив: '+Output);
    GetMem(FileName,MaxFileName);
    GetMem(Buffer,BufferSize);
    Memory:=TMemoryStream.Create;
    CheckUnZipCode(unzGoToFirstFile(unz));
    repeat
      CheckUnZipCode(unzGetCurrentFileInfo(unz,@FileInfo,FileName,MaxFileName,nil,0,nil,0));
      FileInfoZip.dosDate:=FileInfo.dosDate;
      FileInfoZip.external_fa:=FileInfo.external_fa;
      FileInfoZip.internal_fa:=FileInfo.internal_fa;
      FileInfoZip.tmz_date:=FileInfo.tmu_date;
      if (FileName='styles.xml') or (FileName='settings.xml') or (FileName='content.xml') then begin
        FileInfoZip.tmz_date:=tmu_now;
        FileInfoZip.dosDate:=0;
        CheckUnZipCode(unzOpenCurrentFile(unz));
        Memory.Clear;
        repeat
          Status:=unzReadCurrentFile(unz,Buffer,BufferSize);
          if Status=0 then break;
          if Status<0 then CheckUnZipCode(Status);
          Memory.Write(Buffer^,Status);
        until false;
        Memory.Position:=0;
        ReadXMLFile(Xml,Memory,[xrfPreserveWhiteSpace]);
        if FileName='styles.xml' then
          FilterStyle(Xml)
        else if FileName='content.xml' then
          FilterContent(Xml)
        else if FileName='settings.xml' then
          FilterSettings(Xml);
        Memory.Clear;
        WriteXMLFile(Xml,Memory,[xwfPreserveWhiteSpace]);
        Xml.Free;
        CheckZipCode(zipOpenNewFileInZip(zzz,FileName,@FileInfoZip,nil,0,nil,0,nil,Z_DEFLATED,Z_DEFAULT_COMPRESSION));
        CheckZipCode(zipWriteInFileInZip(zzz,Memory.Memory,Memory.Size));
        CheckZipCode(zipCloseFileInZip(zzz));
        CheckUnZipCode(unzCloseCurrentFile(unz));
      end else begin
        CheckUnZipCode(unzOpenCurrentFile(unz));
        CheckZipCode(zipOpenNewFileInZip(zzz,FileName,@FileInfoZip,nil,0,nil,0,nil,Z_DEFLATED,Z_DEFAULT_COMPRESSION));
        repeat
          Status:=unzReadCurrentFile(unz,Buffer,BufferSize);
          if Status=0 then break;
          if Status<0 then CheckUnZipCode(Status);
          CheckZipCode(zipWriteInFileInZip(zzz,Buffer,Status));
        until false;
        CheckZipCode(zipCloseFileInZip(zzz));
        CheckUnZipCode(unzCloseCurrentFile(unz));
      end;
      Status:=unzGoToNextFile(unz);
      if Status=UNZ_END_OF_LIST_OF_FILE then break;
      if Status<>0 then CheckUnZipCode(Status);
    until false;
  finally
    Memory.Free;
    FreeMem(FileName);
    FreeMem(Buffer);
    if unz<>nil then CheckUnZipCode(unzClose(unz));
    if zzz<>nil then CheckZipCode(zipClose(zzz,'Created by Python'));
  end;
end;

{procedure TMyObject.DOMFromStream(AStream: TStream);
var
  Parser: TDOMParser;
  Src: TXMLInputSource;
  TheDoc: TXMLDocument;
begin
  try
    Parser := TDOMParser.Create;
    Src := TXMLInputSource.Create(AStream);
    Parser.Options.PreserveWhitespace := True;
    Parser.Parse(Src, TheDoc);
  finally
    Src.Free;
    Parser.Free;
  end;
end;}

end.