You've already forked lazarus-ccr
fpspreadsheet: Add metadata support. Add metadata reader/writer for XLSX.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7577 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@@ -0,0 +1,68 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="demo_metadata"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<RequiredPackages>
|
||||
<Item>
|
||||
<PackageName Value="laz_fpspreadsheet"/>
|
||||
</Item>
|
||||
</RequiredPackages>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="demo_metadata.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="demo_metadata"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
@@ -0,0 +1,101 @@
|
||||
program demo_metadata;
|
||||
|
||||
uses
|
||||
{$IFDEF MSWINDOWS}
|
||||
windows,
|
||||
{$ENDIF}
|
||||
SysUtils,
|
||||
fpspreadsheet, fpstypes, xlsxooxml, fpsopendocument;
|
||||
|
||||
function GetUserName: String;
|
||||
// http://forum.lazarus.freepascal.org/index.php/topic,23171.msg138057.html#msg138057
|
||||
{$IFDEF WINDOWS}
|
||||
const
|
||||
MaxLen = 256;
|
||||
var
|
||||
Len: DWORD;
|
||||
WS: WideString = '';
|
||||
Res: windows.BOOL;
|
||||
{$ENDIF}
|
||||
begin
|
||||
Result := '';
|
||||
{$IFDEF UNIX}
|
||||
{$IF (DEFINED(LINUX)) OR (DEFINED(FREEBSD))}
|
||||
Result := SysToUtf8(users.GetUserName(fpgetuid)); //GetUsername in unit Users, fpgetuid in unit BaseUnix
|
||||
{$ELSE Linux/BSD}
|
||||
Result := GetEnvironmentVariableUtf8('USER');
|
||||
{$ENDIF UNIX}
|
||||
{$ELSE}
|
||||
{$IFDEF WINDOWS}
|
||||
Len := MaxLen;
|
||||
{$IFnDEF WINCE}
|
||||
if Win32MajorVersion <= 4 then begin
|
||||
SetLength(Result,MaxLen);
|
||||
Res := Windows.GetuserName(@Result[1], Len);
|
||||
//writeln('GetUserNameA = ',Res);
|
||||
if Res then begin
|
||||
SetLength(Result,Len-1);
|
||||
// Result := SysToUtf8(Result);
|
||||
end else
|
||||
SetLength(Result,0);
|
||||
end
|
||||
else
|
||||
{$ENDIF NOT WINCE}
|
||||
begin
|
||||
SetLength(WS, MaxLen-1);
|
||||
Res := Windows.GetUserNameW(@WS[1], Len);
|
||||
//writeln('GetUserNameW = ',Res);
|
||||
if Res then begin
|
||||
SetLength(WS, Len - 1);
|
||||
Result := ws;
|
||||
end else
|
||||
SetLength(Result,0);
|
||||
end;
|
||||
{$ENDIF WINDOWS}
|
||||
{$ENDIF UNIX}
|
||||
end;
|
||||
|
||||
var
|
||||
book: TsWorkbook;
|
||||
sheet: TsWorksheet;
|
||||
begin
|
||||
book := TsWorkbook.Create;
|
||||
try
|
||||
book.MetaData.CreatedBy := 'Donald Duck';
|
||||
book.MetaData.CreatedAt := EncodeDate(2020, 1, 1) + EncodeTime(12, 30, 40, 20);
|
||||
book.MetaData.Title := 'Test of metadata äöü';
|
||||
book.MetaData.Comments.Add('This is a test of spreadsheet metadata.');
|
||||
book.MetaData.Comments.Add('Assign the author to the field CreatedBy.');
|
||||
book.MetaData.Comments.Add('Assign the creation date to the field CreatedAt.');
|
||||
book.MetaData.Keywords.Add('Test');
|
||||
book.MetaData.Keywords.Add('FPSpreadsheet');
|
||||
|
||||
sheet := book.AddWorksheet('Test');
|
||||
sheet.WriteText(2, 3, 'abc');
|
||||
sheet.WriteBackgroundColor(2, 3, scYellow);
|
||||
book.WriteToFile('test.xlsx', true);
|
||||
book.WritetoFile('test.ods', true);
|
||||
finally
|
||||
book.Free;
|
||||
end;
|
||||
|
||||
book := TsWorkbook.Create;
|
||||
try
|
||||
book.ReadFromFile('test.xlsx');
|
||||
book.MetaData.ModifiedAt := Now();
|
||||
book.MetaData.ModifiedBy := GetUserName;
|
||||
WriteLn('CreatedBy : ', book.MetaData.CreatedBy);
|
||||
WriteLn('CreatedAt : ', DateTimeToStr(book.MetaData.CreatedAt));
|
||||
WriteLn('ModifiedBy : ', book.MetaData.ModifiedBy);
|
||||
WriteLn('ModifiedAt : ', DateTimeToStr(book.MetaData.ModifiedAt));
|
||||
WriteLn('Title : ', book.MetaData.Title);
|
||||
WriteLn('Comments : ');
|
||||
WriteLn(book.MetaData.Comments.Text);
|
||||
WriteLn('Keywords : ', book.MetaData.Keywords.CommaText);
|
||||
finally
|
||||
book.Free;
|
||||
end;
|
||||
|
||||
ReadLn;
|
||||
end.
|
||||
|
@@ -752,6 +752,7 @@ type
|
||||
FOnReadCellData: TsWorkbookReadCellDataEvent;
|
||||
FSearchEngine: TObject;
|
||||
FCryptoInfo: TsCryptoInfo;
|
||||
FMetaData: TsMetaData;
|
||||
{FrevisionsCrypto: TsCryptoInfo;} // Commented out because it needs revision handling
|
||||
|
||||
{ Callback procedures }
|
||||
@@ -920,6 +921,9 @@ type
|
||||
property CryptoInfo: TsCryptoInfo read FCryptoInfo write FCryptoInfo;
|
||||
{property RevisionsCrypto: TsCryptoInfo read FRevisionsCrypto write FRevisionsCrypto;}
|
||||
|
||||
{@@ Meta data}
|
||||
property MetaData: TsMetaData read FMetaData write FMetaData;
|
||||
|
||||
{@@ This event fires whenever a new worksheet is added }
|
||||
property OnAddWorksheet: TsWorksheetEvent read FOnAddWorksheet write FOnAddWorksheet;
|
||||
{@@ This event fires whenever a worksheet is changed }
|
||||
@@ -6329,6 +6333,9 @@ begin
|
||||
|
||||
// Protection
|
||||
InitCryptoInfo(FCryptoInfo);
|
||||
|
||||
// Metadata
|
||||
FMetaData := TsMetaData.Create;
|
||||
end;
|
||||
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
@@ -6341,6 +6348,7 @@ begin
|
||||
EnableNotifications;
|
||||
FWorksheets.Free;
|
||||
|
||||
FMetaData.Free;
|
||||
FConditionalFormatList.Free;
|
||||
FCellFormatList.Free;
|
||||
FNumFormatList.Free;
|
||||
|
@@ -965,6 +965,29 @@ type
|
||||
{@@ Set of option flags for the workbook }
|
||||
TsWorkbookOptions = set of TsWorkbookOption;
|
||||
|
||||
{@@ Meta data for the workbook}
|
||||
TsMetaData = class
|
||||
private
|
||||
FCreatedBy: String;
|
||||
FCreatedAt: TDateTime;
|
||||
FModifiedBy: String;
|
||||
FModifiedAt: TDateTime;
|
||||
FTitle: String;
|
||||
FComments: TStrings;
|
||||
FKeywords: TStrings;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy;
|
||||
function IsEmpty: Boolean;
|
||||
property CreatedBy: String read FCreatedBy write FCreatedBy;
|
||||
property CreatedAt: TDateTime read FCreatedAt write FCreatedAt;
|
||||
property ModifiedBy: String read FModifiedBy write FModifiedBy;
|
||||
property ModifiedAt: TDatetime read FModifiedAt write FModifiedAt;
|
||||
property Title: String read FTitle write FTitle;
|
||||
property Comments: TStrings read FComments write FComments;
|
||||
property Keywords: TStrings read FKeywords write FKeywords;
|
||||
end;
|
||||
|
||||
{@@ Basic worksheet class to avoid circular unit references. It has only those
|
||||
properties and methods which do not require any other unit than fpstypes. }
|
||||
TsBasicWorksheet = class
|
||||
@@ -1167,7 +1190,32 @@ end;
|
||||
|
||||
|
||||
{-------------------------------------------------------------------------------
|
||||
sBasicWorksheet
|
||||
TsMetaData
|
||||
-------------------------------------------------------------------------------}
|
||||
constructor TsMetaData.Create;
|
||||
begin
|
||||
inherited;
|
||||
FComments := TStringList.Create;
|
||||
FKeywords := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TsMetaData.Destroy;
|
||||
begin
|
||||
FComments.Free;
|
||||
FKeywords.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TsMetaData.IsEmpty: Boolean;
|
||||
begin
|
||||
Result := (FCreatedBy = '') and (FModifiedBy = '') and (FTitle = '') and
|
||||
(FComments.Count = 0) and (FKeywords.Count = 0) and
|
||||
(FCreatedAt = 0) and (FModifiedAt = 0);
|
||||
end;
|
||||
|
||||
|
||||
{-------------------------------------------------------------------------------
|
||||
TsBasicWorksheet
|
||||
-------------------------------------------------------------------------------}
|
||||
|
||||
constructor TsBasicWorksheet.Create;
|
||||
|
@@ -238,7 +238,7 @@ function CellBorderStyle(const AColor: TsColor = scBlack;
|
||||
|
||||
function GetFontAsString(AFont: TsFont): String;
|
||||
|
||||
//function GetUniqueTempDir(Global: Boolean): String;
|
||||
function ISO8601StrToDateTime(s: String): TDateTime;
|
||||
|
||||
procedure AppendToStream(AStream: TStream; const AString: String); inline; overload;
|
||||
procedure AppendToStream(AStream: TStream; const AString1, AString2: String); inline; overload;
|
||||
@@ -2695,6 +2695,7 @@ begin
|
||||
Index := -1;
|
||||
end;
|
||||
end;
|
||||
|
||||
(*
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
Copies the value of a cell to another one. Does not copy the formula, erases
|
||||
@@ -3144,6 +3145,81 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
Converts an ISO8601-formatted date/time to TDateTime
|
||||
-------------------------------------------------------------------------------}
|
||||
function ISO8601StrToDateTime(s: String): TDateTime;
|
||||
// example: 2020-07-28T11:07:36Z
|
||||
var
|
||||
p: Integer;
|
||||
fs: TFormatSettings;
|
||||
isUTC: Boolean;
|
||||
hours, mins, days: integer;
|
||||
secs: Double;
|
||||
hrPos, minPos, secPos: integer;
|
||||
begin
|
||||
Result := 0;
|
||||
|
||||
fs := DefaultFormatSettings;
|
||||
fs.DecimalSeparator := '.';
|
||||
fs.ShortDateFormat := 'yyyy-mm-dd';
|
||||
fs.DateSeparator := '-';
|
||||
fs.LongTimeFormat := 'hh:nn:ss';
|
||||
fs.Timeseparator := ':';
|
||||
|
||||
if s[Length(s)] = 'Z' then
|
||||
begin
|
||||
isUTC := true;
|
||||
Delete(s, Length(s), 1);
|
||||
end else
|
||||
isUTC := false;
|
||||
|
||||
p := pos('T', s);
|
||||
if p > 0 then
|
||||
begin
|
||||
s[p] := ' ';
|
||||
// Strip milliseconds?
|
||||
p := Pos('.', s);
|
||||
if (p > 1) then
|
||||
s := Copy(s, 1, p-1);
|
||||
Result := StrToDateTime(s, fs);
|
||||
exit;
|
||||
end;
|
||||
|
||||
p := pos('PT', s);
|
||||
if p = 1 then
|
||||
begin
|
||||
// Get hours
|
||||
hrPos := pos('H', s);
|
||||
if (hrPos > 0) then
|
||||
hours := StrToInt(Copy(s, 3, hrPos-3))
|
||||
else
|
||||
hours := 0;
|
||||
|
||||
// Get minutes
|
||||
minPos := pos('M', s);
|
||||
if (p > 0) and (minPos > hrPos) then
|
||||
mins := StrToInt(Copy(s, hrPos+1, minPos-hrPos-1))
|
||||
else
|
||||
mins := 0;
|
||||
|
||||
// Get seconds
|
||||
secPos := pos('S', s);
|
||||
if (secPos > 0) and (secPos > minPos) then
|
||||
secs := StrToFloat(Copy(s, minPos+1, secPos-minPos-1), fs)
|
||||
else
|
||||
secs := 0;
|
||||
|
||||
days := hours div 24;
|
||||
hours := hours mod 24;
|
||||
Result := days + (hours + (mins + secs/60) / 60) / 24;
|
||||
end;
|
||||
|
||||
if isUTC then
|
||||
Result := Result + GetLocalTimeOffset / (60*24);
|
||||
end;
|
||||
|
||||
|
||||
{$PUSH}{$HINTS OFF}
|
||||
{@@ Silence warnings due to an unused parameter }
|
||||
procedure Unused(const A1);
|
||||
|
@@ -104,6 +104,7 @@ type
|
||||
procedure ReadFonts(ANode: TDOMNode);
|
||||
procedure ReadHeaderFooter(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
|
||||
procedure ReadHyperlinks(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
|
||||
procedure ReadMetaData(ANode: TDOMNode);
|
||||
procedure ReadMergedCells(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
|
||||
procedure ReadNumFormats(ANode: TDOMNode);
|
||||
procedure ReadPageMargins(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
|
||||
@@ -182,6 +183,7 @@ type
|
||||
procedure WriteFontList(AStream: TStream);
|
||||
procedure WriteHeaderFooter(AStream: TStream; AWorksheet: TsBasicWorksheet);
|
||||
procedure WriteHyperlinks(AStream: TStream; AWorksheet: TsBasicWorksheet; rId: Integer);
|
||||
procedure WriteMetadata(AStream: TStream);
|
||||
procedure WriteMergedCells(AStream: TStream; AWorksheet: TsBasicWorksheet);
|
||||
procedure WriteNumFormatList(AStream: TStream);
|
||||
procedure WritePalette(AStream: TStream);
|
||||
@@ -212,6 +214,7 @@ type
|
||||
FSRelsRels: TStream;
|
||||
FSWorkbook: TStream;
|
||||
FSWorkbookRels: TStream;
|
||||
FSMetaData: TStream;
|
||||
FSStyles: TStream;
|
||||
FSSharedStrings: TStream;
|
||||
FSSharedStrings_complete: TStream;
|
||||
@@ -273,7 +276,7 @@ procedure InitOOXMLLimitations(out ALimitations: TsSpreadsheetFormatLimitations)
|
||||
implementation
|
||||
|
||||
uses
|
||||
variants, strutils, math, lazutf8, LazFileUtils, uriparser, typinfo,
|
||||
variants, strutils, dateutils, math, lazutf8, LazFileUtils, uriparser, typinfo,
|
||||
{%H-}fpsPatches, fpSpreadsheet, fpsCrypto, fpsExprParser,
|
||||
fpsStrings, fpsStreams, fpsClasses, fpsImages;
|
||||
|
||||
@@ -301,12 +304,14 @@ const
|
||||
OOXML_PATH_XL_DRAWINGS_RELS = 'xl/drawings/_rels/';
|
||||
OOXML_PATH_XL_THEME = 'xl/theme/theme1.xml';
|
||||
OOXML_PATH_XL_MEDIA = 'xl/media/';
|
||||
OOXML_PATH_DOCPROPS_CORE = 'docProps/core.xml';
|
||||
|
||||
{ OOXML schemas constants }
|
||||
SCHEMAS_TYPES = 'http://schemas.openxmlformats.org/package/2006/content-types';
|
||||
SCHEMAS_RELS = 'http://schemas.openxmlformats.org/package/2006/relationships';
|
||||
SCHEMAS_DOC_RELS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships';
|
||||
SCHEMAS_DOCUMENT = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument';
|
||||
SCHEMAS_META_CORE = 'http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties';
|
||||
SCHEMAS_WORKSHEET = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/worksheet';
|
||||
SCHEMAS_STYLES = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/styles';
|
||||
SCHEMAS_STRINGS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/sharedStrings';
|
||||
@@ -316,12 +321,13 @@ const
|
||||
SCHEMAS_HYPERLINK = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink';
|
||||
SCHEMAS_IMAGE = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/image';
|
||||
SCHEMAS_SPREADML = 'http://schemas.openxmlformats.org/spreadsheetml/2006/main';
|
||||
SCHEMAS_CORE = 'http://schemas.openxmlformats.org/package/2006/metadata/core-properties';
|
||||
|
||||
{ OOXML mime types constants }
|
||||
{%H-}MIME_XML = 'application/xml';
|
||||
MIME_XML = 'application/xml';
|
||||
MIME_RELS = 'application/vnd.openxmlformats-package.relationships+xml';
|
||||
MIME_OFFICEDOCUMENT = 'application/vnd.openxmlformats-officedocument';
|
||||
{%H-}MIME_CORE = 'application/vnd.openxmlformats-package.core-properties+xml';
|
||||
MIME_CORE = 'application/vnd.openxmlformats-package.core-properties+xml';
|
||||
MIME_SPREADML = MIME_OFFICEDOCUMENT + '.spreadsheetml';
|
||||
MIME_SHEET = MIME_SPREADML + '.sheet.main+xml';
|
||||
MIME_WORKSHEET = MIME_SPREADML + '.worksheet+xml';
|
||||
@@ -2634,6 +2640,56 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TsSpreadOOXMLReader.ReadMetaData(ANode: TDOMNode);
|
||||
var
|
||||
nodeName: string;
|
||||
book: TsWorkbook;
|
||||
s: String;
|
||||
dt: TDateTime;
|
||||
fs: TFormatSettings;
|
||||
begin
|
||||
if ANode = nil then
|
||||
exit;
|
||||
|
||||
book := TsWorkbook(FWorkbook);
|
||||
fs := DefaultFormatSettings;
|
||||
fs.DateSeparator := '-';
|
||||
|
||||
ANode := ANode.FirstChild;
|
||||
while ANode <> nil do
|
||||
begin
|
||||
nodeName := ANode.NodeName;
|
||||
s := GetNodeValue(ANode);
|
||||
case nodeName of
|
||||
'dc:title':
|
||||
book.MetaData.Title := s;
|
||||
'dc:creator':
|
||||
book.MetaData.CreatedBy := s;
|
||||
'cp:lastModifiedBy':
|
||||
book.MetaData.ModifiedBy := s;
|
||||
'dc:description':
|
||||
if s <> '' then
|
||||
begin
|
||||
s := StringReplace(s, '_x000d_', Lineending, [rfReplaceAll]);
|
||||
book.MetaData.Comments.Text := s;
|
||||
end else
|
||||
book.MetaData.Comments.Clear;
|
||||
'cp:keywords':
|
||||
if s <> '' then
|
||||
book.MetaData.Keywords.CommaText := s
|
||||
else
|
||||
book.MetaData.Keywords.Clear;
|
||||
'dcterms:created':
|
||||
if s <> '' then
|
||||
book.MetaData.CreatedAt := ISO8601StrToDateTime(s);
|
||||
'dcterms:modified':
|
||||
if s <> '' then
|
||||
book.MetaData.ModifiedAt :=ISO8601StrToDateTime(s);
|
||||
end;
|
||||
ANode := ANode.NextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TsSpreadOOXMLReader.ReadMergedCells(ANode: TDOMNode;
|
||||
AWorksheet: TsBasicWorksheet);
|
||||
var
|
||||
@@ -3465,6 +3521,7 @@ procedure TsSpreadOOXMLReader.ReadFromStream(AStream: TStream;
|
||||
APassword: String = ''; AParams: TsStreamParams = []);
|
||||
var
|
||||
Doc : TXMLDocument;
|
||||
metadataNode: TDOMNode;
|
||||
RelsNode: TDOMNode;
|
||||
i, j: Integer;
|
||||
fn: String;
|
||||
@@ -3674,6 +3731,19 @@ begin
|
||||
XMLStream.Free;
|
||||
end;
|
||||
|
||||
// MetaData
|
||||
XMLStream := CreateXMLStream;
|
||||
try
|
||||
if UnzipToStream(AStream, OOXML_PATH_DOCPROPS_CORE, XMLStream) then
|
||||
begin
|
||||
ReadXMLStream(Doc, XMLStream);
|
||||
ReadMetaData(Doc.DocumentElement);
|
||||
FreeandNil(Doc);
|
||||
end;
|
||||
finally
|
||||
XMLStream.Free;
|
||||
end;
|
||||
|
||||
finally
|
||||
FreeAndNil(Doc);
|
||||
end;
|
||||
@@ -5933,13 +6003,19 @@ begin
|
||||
// Will be written at the end of WriteToStream when all Sheet.rels files are
|
||||
// known
|
||||
|
||||
{ --- meta data ---- }
|
||||
WriteMetaData(FSMetaData);
|
||||
|
||||
{ --- _rels/.rels --- }
|
||||
AppendToStream(FSRelsRels,
|
||||
XML_HEADER + LineEnding);
|
||||
AppendToStream(FSRelsRels, Format(
|
||||
'<Relationships xmlns="%s">' + LineEnding, [SCHEMAS_RELS]));
|
||||
AppendToStream(FSRelsRels, Format(
|
||||
' <Relationship Id="rId1" Target="xl/workbook.xml" Type="%s" />' + LineEnding,
|
||||
'<Relationship Id="rId2" Target="docProps/core.xml" Type="%s" />' + LineEnding,
|
||||
[SCHEMAS_META_CORE]));
|
||||
AppendToStream(FSRelsRels, Format(
|
||||
'<Relationship Id="rId1" Target="xl/workbook.xml" Type="%s" />' + LineEnding,
|
||||
[SCHEMAS_DOCUMENT]));
|
||||
AppendToStream(FSRelsRels,
|
||||
'</Relationships>');
|
||||
@@ -6012,6 +6088,87 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TsSpreadOOXMLWriter.WriteMetaData(AStream: TStream);
|
||||
{<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
|
||||
<cp:coreProperties xmlns:cp="http://schemas.openxmlformats.org/package/2006/metadata/core-properties" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:dcterms="http://purl.org/dc/terms/" xmlns:dcmitype="http://purl.org/dc/dcmitype/" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
|
||||
<dc:title>test file meta data äöü</dc:title>
|
||||
<dc:creator>Donald Duck</dc:creator>
|
||||
<dc:description>this is a comment_x000d_ in two lines äöü.</dc:description>
|
||||
<cp:lastModifiedBy>Donald Duck</cp:lastModifiedBy>
|
||||
<dcterms:created xsi:type="dcterms:W3CDTF">2015-06-05T18:19:34Z</dcterms:created>
|
||||
<dcterms:modified xsi:type="dcterms:W3CDTF">2020-07-27T21:23:27Z</dcterms:modified>
|
||||
</cp:coreProperties> }
|
||||
var
|
||||
book: TsWorkbook;
|
||||
s: String;
|
||||
begin
|
||||
book := TsWorkbook(FWorkbook);
|
||||
|
||||
if book.MetaData.IsEmpty then
|
||||
exit;
|
||||
|
||||
AppendToStream(AStream,
|
||||
XML_HEADER);
|
||||
|
||||
AppendToStream(AStream,
|
||||
'<cp:coreProperties '+
|
||||
'xmlns:cp="http://schemas.openxmlformats.org/package/2006/metadata/core-properties" '+
|
||||
'xmlns:dc="http://purl.org/dc/elements/1.1/" '+
|
||||
'xmlns:dcterms="http://purl.org/dc/terms/" '+
|
||||
'xmlns:dcmitype="http://purl.org/dc/dcmitype/" '+
|
||||
'xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">');
|
||||
|
||||
if book.MetaData.Title <> '' then
|
||||
AppendToStream(AStream, Format(
|
||||
'<dc:title>%s</dc:title>', [UTF8TextToXMLText(book.MetaData.Title)]));
|
||||
|
||||
if book.MetaData.CreatedBy <> '' then
|
||||
AppendToStream(AStream, Format(
|
||||
'<dc:creator>%s</dc:creator>', [UTF8TextToXMLText(book.MetaData.CreatedBy)]));
|
||||
|
||||
if book.MetaData.Keywords.Count > 0 then
|
||||
begin
|
||||
s := book.MetaData.KeyWords.CommaText;
|
||||
AppendToStream(AStream, Format(
|
||||
'<cp:keywords>%s</cp:keywords>', [s]));
|
||||
end;
|
||||
|
||||
if book.MetaData.Comments.Count > 0 then
|
||||
begin
|
||||
s := book.MetaData.Comments.Text;
|
||||
while (s <> '') and (s[Length(s)] in [#10, #13]) do
|
||||
Delete(s, Length(s), 1);
|
||||
s := StringReplace(s, LineEnding, '_x000d_', [rfReplaceAll]);
|
||||
AppendToStream(AStream, Format(
|
||||
'<dc:description>%s</dc:description>', [s]));
|
||||
end;
|
||||
|
||||
if book.MetaData.ModifiedBy = '' then
|
||||
s := book.MetaData.CreatedBy
|
||||
else
|
||||
s := book.MetaData.ModifiedBy;
|
||||
AppendToStream(AStream, Format(
|
||||
'<cp:lastModifiedBy>%s</cp:lastModifiedBy>', [s])); // to do: check xml entities
|
||||
|
||||
if book.MetaData.CreatedAt > 0 then
|
||||
begin
|
||||
s := FormatDateTime(ISO8601FormatExtended, book.MetaData.CreatedAt) + 'Z';
|
||||
AppendToStream(AStream, Format(
|
||||
'<dcterms:created xsi:type="dcterms:W3CDTF">%s</dcterms:created>', [s]));
|
||||
end;
|
||||
|
||||
if book.MetaData.ModifiedAt = 0 then
|
||||
s := FormatDateTime(ISO8601FormatExtended, book.MetaData.CreatedAt) + 'Z'
|
||||
else
|
||||
s := FormatDateTime(ISO8601FormatExtended, book.MetaData.ModifiedAt) + 'Z';
|
||||
AppendToStream(AStream, Format(
|
||||
'<dcterms:modified xsi:type="dcterms:W3CDTF">%s</dcterms:modified>', [s]));
|
||||
|
||||
AppendToStream(AStream,
|
||||
'</cp:coreProperties>');
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
|
||||
<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">
|
||||
@@ -6134,10 +6291,10 @@ begin
|
||||
'<Override PartName="/xl/styles.xml" ContentType="' + MIME_STYLES + '" />' + LineEnding);
|
||||
AppendToStream(FSContentTypes,
|
||||
'<Override PartName="/xl/sharedStrings.xml" ContentType="' + MIME_STRINGS + '" />' + LineEnding);
|
||||
{
|
||||
|
||||
AppendToStream(FSContentTypes,
|
||||
'<Override PartName="/docProps/core.xml" ContentType="' + MIME_CORE + '" />');
|
||||
}
|
||||
|
||||
AppendToStream(FSContentTypes,
|
||||
'</Types>');
|
||||
end;
|
||||
@@ -6567,6 +6724,7 @@ begin
|
||||
FSStyles := CreateTempStream(FWorkbook, 'fpsSTY');
|
||||
FSSharedStrings := CreateTempStream(FWorkbook, 'fpsSS');
|
||||
FSSharedStrings_complete := CreateTempStream(FWorkbook, 'fpsSSC');
|
||||
FSMetaData := CreateTempStream(FWorkbook, 'fpsMETA');
|
||||
{
|
||||
if boFileStream in FWorkbook.Options then
|
||||
begin
|
||||
@@ -6607,6 +6765,7 @@ procedure TsSpreadOOXMLWriter.DestroyStreams;
|
||||
var
|
||||
stream: TStream;
|
||||
begin
|
||||
DestroyTempStream(FSMetaData);
|
||||
DestroyTempStream(FSContentTypes);
|
||||
DestroyTempStream(FSRelsRels);
|
||||
DestroyTempStream(FSWorkbookRels);
|
||||
@@ -6654,6 +6813,7 @@ begin
|
||||
ResetStream(FSWorkbook);
|
||||
ResetStream(FSStyles);
|
||||
ResetStream(FSSharedStrings_complete);
|
||||
ResetStream(FSMetaData);
|
||||
for i:=0 to High(FSSheets) do ResetStream(FSSheets[i]);
|
||||
for i:=0 to High(FSSheetRels) do ResetStream(FSSheetRels[i]);
|
||||
for i:=0 to High(FSComments) do ResetStream(FSComments[i]);
|
||||
@@ -6720,6 +6880,7 @@ begin
|
||||
FZip.Entries.AddFileEntry(FSStyles, OOXML_PATH_XL_STYLES);
|
||||
if FSSharedStrings_complete.Size > 0 then
|
||||
FZip.Entries.AddFileEntry(FSSharedStrings_complete, OOXML_PATH_XL_STRINGS);
|
||||
FZip.Entries.AddFileEntry(FSMetaData, OOXML_PATH_DOCPROPS_CORE);
|
||||
|
||||
// Write embedded images
|
||||
WriteMedia(FZip);
|
||||
|
Reference in New Issue
Block a user