From 2d76afb541078fd415de5a2cc662ba329f15d566 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 8 Mar 2015 00:50:10 +0000 Subject: [PATCH] fpspreadsheet: Unit tests for hyperlinks. Some issues left. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4002 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpsopendocument.pas | 95 ++++++++++++------- components/fpspreadsheet/fpspreadsheet.pas | 70 +++++++------- components/fpspreadsheet/fpsreaderwriter.pas | 9 +- components/fpspreadsheet/fpsstrings.pas | 4 +- components/fpspreadsheet/fpstypes.pas | 4 +- components/fpspreadsheet/fpsutils.pas | 49 ++++++++++ .../fpspreadsheet/tests/commenttests.pas | 7 +- .../fpspreadsheet/tests/spreadtestgui.lpi | 7 +- .../fpspreadsheet/tests/spreadtestgui.lpr | 3 +- components/fpspreadsheet/xlsbiff8.pas | 78 ++++++++------- components/fpspreadsheet/xlsxooxml.pas | 23 +++-- 11 files changed, 218 insertions(+), 131 deletions(-) diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 5366031e7..31bc4c7de 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -23,7 +23,7 @@ AUTHORS: Felipe Monteiro de Carvalho / Jose Luis Jurado Rincon unit fpsopendocument; {$ifdef fpc} - {$mode delphi}{$H+} + {$mode objfpc}{$H+} {$endif} {.$define FPSPREADDEBUG} //used to be XLSDEBUG @@ -205,7 +205,7 @@ type implementation uses - StrUtils, Variants, URIParser, + StrUtils, Variants, LazFileUtils, URIParser, fpsPatches, fpsStrings, fpsStreams, fpsExprParser; const @@ -383,7 +383,7 @@ function TsSpreadOpenDocNumFormatParser.BuildDateTimeXMLAsString(ASection: Integ var el: Integer; s: String; - prevToken: TsNumFormatToken; + prevTok: TsNumFormatToken; begin Result := ''; AIsTimeOnly := true; @@ -396,7 +396,7 @@ begin case Elements[el].Token of nftYear: begin - prevToken := Elements[el].Token; + prevTok := Elements[el].Token; AIsTimeOnly := false; s := IfThen(Elements[el].IntValue > 2, 'number:style="long" ', ''); Result := Result + @@ -405,7 +405,7 @@ begin nftMonth: begin - prevToken := Elements[el].Token; + prevTok := Elements[el].Token; AIsTimeOnly := false; case Elements[el].IntValue of 1: s := ''; @@ -419,7 +419,7 @@ begin nftDay: begin - prevToken := Elements[el].Token; + prevTok := Elements[el].Token; AIsTimeOnly := false; case Elements[el].IntValue of 1: s := 'day '; @@ -433,7 +433,7 @@ begin nftHour, nftMinute, nftSecond: begin - prevToken := Elements[el].Token; + prevTok := Elements[el].Token; case Elements[el].Token of nftHour : s := 'hours '; nftMinute: s := 'minutes '; @@ -460,7 +460,7 @@ begin s := Elements[el].TextValue; if (s = '/') then begin - if prevToken in [nftYear, nftMonth, nftDay] then + if prevTok in [nftYear, nftMonth, nftDay] then s := FWorkbook.FormatSettings.DateSeparator else s := FWorkbook.FormatSettings.TimeSeparator; @@ -1461,52 +1461,51 @@ var styleName: String; childnode: TDOMNode; subnode: TDOMNode; - spanNode: TDOMNode; nodeName: String; s: String; cell: PCell; hyperlink: string; + + procedure AddToCellText(AText: String); + begin + if cellText = '' + then cellText := AText + else cellText := cellText + AText; + end; + begin { We were forced to activate PreserveWhiteSpace in the DOMParser in order to catch the spaces inserted in formatting texts. However, this adds lots of garbage into the cellText if is is read by means of above statement. Done like below is much better: } cellText := ''; + hyperlink := ''; childnode := ACellNode.FirstChild; while Assigned(childnode) do begin nodeName := childNode.NodeName; - hyperlink := ''; if nodeName = 'text:p' then begin + // Each 'text:p' node is a paragraph --> we insert a line break after the first paragraph + if cellText <> '' then + cellText := cellText + LineEnding; subnode := childnode.FirstChild; while Assigned(subnode) do begin nodename := subnode.NodeName; - if nodename = 'text:a' then begin - s := GetAttrValue(subnode, 'xlink:type'); - if s = 'simple' then - hyperlink := GetAttrValue(subnode, 'xlink:href'); + case nodename of + '#text' : + AddToCellText(subnode.TextContent); + 'text:a': // "hyperlink anchor" + begin + hyperlink := GetAttrValue(subnode, 'xlink:href'); + AddToCellText(subnode.TextContent); + end; + 'text:span': + AddToCellText(subnode.TextContent); end; subnode := subnode.NextSibling; end; - - s := childNode.TextContent; - if s <> '' then - begin - if cellText = '' then cellText := s else cellText := cellText + LineEnding + s; - end; - spanNode := childNode.FirstChild; - while spanNode <> nil do begin - nodeName := spanNode.NodeName; - if nodeName = 'text:span' then - begin - s := spanNode.TextContent; - if cellText = '' then cellText := s else cellText := cellText + ' ' + s; - end; - spanNode := spanNode.NextSibling; - end; end; - childnode := childnode.NextSibling; end; @@ -1519,7 +1518,14 @@ begin FWorkSheet.WriteUTF8Text(cell, cellText); if hyperlink <> '' then + begin + // ODS sees relative paths relative to the internal own file structure + // --> we must remove 1 level-up to be at the same level where fps expects + // the file. + if pos('../', hyperlink) = 1 then + Delete(hyperlink, 1, Length('../')); FWorksheet.WriteHyperlink(cell, hyperlink); + end; styleName := GetAttrValue(ACellNode, 'table:style-name'); ApplyStyleToCell(cell, stylename); @@ -4153,7 +4159,7 @@ var spannedStr: String; r1,c1,r2,c2: Cardinal; txt: ansistring; - textp, target, comment: String; + textp, target, bookmark, comment: String; fmt: TsCellFormat; hyperlink: PsHyperlink; u: TUri; @@ -4191,6 +4197,30 @@ begin if FWorksheet.HasHyperlink(ACell) then begin hyperlink := FWorksheet.FindHyperlink(ACell); + SplitHyperlink(hyperlink^.Target, target, bookmark); + + if (target = '') and (bookmark <> '') then + target := '#' + bookmark + else + if (pos('file:', target) = 0) then + begin + u := ParseURI(target); + if u.Protocol = '' then + target := '../' + target; + end; + + + { + u := ParseURI(hyperlink^.Target); + if u.Protocol = '' then // relative file name, or internal link + begin + if target <> '' then target := '../' + target; + if bookmark <> '' then target := target + '#' + bookmark; + end else + target := hyperlink^.Target; + } + ValidXMLText(target); + { target := hyperlink^.Target; if target[1] <> '#' then begin @@ -4202,6 +4232,7 @@ begin // if not IsAbsoluteURI(target) then target := '..\' + target; end; end; + } textp := Format( ''+ '%s'+ diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 5848fb578..6500d5a36 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -593,8 +593,6 @@ type class function GetFormatFromFileHeader(const AFileName: TFileName; out SheetType: TsSpreadsheetFormat): Boolean; - class function GetFormatFromFileName(const AFileName: TFileName; - out SheetType: TsSpreadsheetFormat): Boolean; function CreateSpreadReader(AFormat: TsSpreadsheetFormat): TsBasicSpreadReader; function CreateSpreadWriter(AFormat: TsSpreadsheetFormat): TsBasicSpreadWriter; procedure ReadFromFile(AFileName: string; AFormat: TsSpreadsheetFormat); overload; @@ -781,7 +779,7 @@ procedure DumpFontsToFile(AWorkbook: TsWorkbook; AFileName: String); implementation uses - Math, StrUtils, TypInfo, lazutf8, URIParser, + Math, StrUtils, TypInfo, lazutf8, lazFileUtils, URIParser, fpsPatches, fpsStrings, uvirtuallayer_ole, fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser, fpsNumFormat, fpsNumFormatParser; @@ -1464,13 +1462,14 @@ end; Checks whether the passed string represents a valid hyperlink target @param AValue String to be checked. Must be either a fully qualified URI, - or a # followed by a cell address in the current workbook + a local relative (!) file name, or a # followed by a cell + address in the current workbook @param AErrMsg Error message in case that the string is not correct. @returns TRUE if the string is correct, FALSE otherwise -------------------------------------------------------------------------------} function TsWorksheet.ValidHyperlink(AValue: String; out AErrMsg: String): Boolean; var - uri: TUri; + u: TUri; sheet: TsWorksheet; r, c: Cardinal; begin @@ -1491,12 +1490,24 @@ begin end; end else begin - uri := ParseURI(AValue); - if SameText(uri.Protocol, 'mailto') then + u := ParseURI(AValue); + if SameText(u.Protocol, 'mailto') then begin Result := true; // To do: Check email address here... exit; end else + if SameText(u.Protocol, 'file') then + begin + if FilenameIsAbsolute(u.Path + u.Document) then + begin + Result := true; + exit; + end else + begin + AErrMsg := Format(rsLocalfileHyperlinkAbs, [AValue]); + exit; + end; + end else begin Result := true; exit; @@ -1530,8 +1541,9 @@ end; @param ACell Pointer to the cell considered @param ATarget Hyperlink address given as a fully qualitifed URI for external links, or as a # followed by a cell address - for internal links. An existing hyperlink is removed if - ATarget is empty. + for internal links. Local files can be specified also + by their name relative to the workbook. + An existing hyperlink is removed if ATarget is empty. @param ATooltip Text for popup tooltip hint used by Excel -------------------------------------------------------------------------------} procedure TsWorksheet.WriteHyperlink(ACell: PCell; ATarget: String; @@ -1539,7 +1551,7 @@ procedure TsWorksheet.WriteHyperlink(ACell: PCell; ATarget: String; var hyperlink: PsHyperlink; fmt: TsCellFormat; - fn: String; + target, bm, fn, displayTxt: String; begin if ACell = nil then exit; @@ -1554,11 +1566,15 @@ begin if ACell^.ContentType = cctEmpty then begin + SplitHyperlink(ATarget, target, bm); + displayTxt := ATarget; + if pos('file:', lowercase(displayTxt))=1 then + begin + Delete(displayTxt, 1, Length('file:///')); + if bm <> '' then displayTxt := fn + '#' + bm; + end; ACell^.ContentType := cctUTF8String; - if (hyperlink^.Target[1] <> '#') and UriToFileName(hyperlink^.Target, fn) then - ACell^.UTF8StringValue := fn - else - ACell^.UTF8StringValue := hyperlink^.Target; + ACell^.UTF8StringValue := displayTxt; end; fmt := ReadCellFormat(ACell); @@ -3622,6 +3638,8 @@ begin begin hyperlink := ReadHyperlink(ACell); AText := hyperlink.Target; + if pos('file:', hyperlink.Target)=1 then + Delete(AText, 1, Length('file:///')); end; if (AText = '') then @@ -6238,30 +6256,6 @@ begin end; end; - -{@@ ---------------------------------------------------------------------------- - Helper method for determining the spreadsheet type from the file type extension - - @param AFileName Name of the file to be considered - @param SheetType File format found from analysis of the extension (output) - @return True if the file matches any of the known formats, false otherwise --------------------------------------------------------------------------------} -class function TsWorkbook.GetFormatFromFileName(const AFileName: TFileName; - out SheetType: TsSpreadsheetFormat): Boolean; -var - suffix: String; -begin - Result := True; - suffix := Lowercase(ExtractFileExt(AFileName)); - if suffix = STR_EXCEL_EXTENSION then SheetType := sfExcel8 - else if suffix = STR_OOXML_EXCEL_EXTENSION then SheetType := sfOOXML - else if suffix = STR_OPENDOCUMENT_CALC_EXTENSION then SheetType := sfOpenDocument - else if suffix = STR_COMMA_SEPARATED_EXTENSION then SheetType := sfCSV - else if suffix = STR_WIKITABLE_PIPES then SheetType := sfWikiTable_Pipes - else if suffix = STR_WIKITABLE_WIKIMEDIA then SheetType := sfWikiTable_WikiMedia - else Result := False; -end; - {@@ ---------------------------------------------------------------------------- Convenience method which creates the correct reader object for a given spreadsheet format. diff --git a/components/fpspreadsheet/fpsreaderwriter.pas b/components/fpspreadsheet/fpsreaderwriter.pas index 6a25132c1..60c4104b5 100644 --- a/components/fpspreadsheet/fpsreaderwriter.pas +++ b/components/fpspreadsheet/fpsreaderwriter.pas @@ -123,15 +123,8 @@ type public constructor Create(AWorkbook: TsWorkbook); override; destructor Destroy; override; + { General writing methods } - { - procedure IterateThroughCells(AStream: TStream; ACells: TsCells; - ACallback: TCellsCallback); - procedure IterateThroughComments(AStream: TStream; AComments: TsComments; - ACallback: TCommentsCallback); - procedure IterateThroughHyperlinks(AStream: TStream; AHyperlinks: TsHyperlinks; - ACallback: THyperlinksCallback); - } procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); override; procedure WriteToStream(AStream: TStream); override; diff --git a/components/fpspreadsheet/fpsstrings.pas b/components/fpspreadsheet/fpsstrings.pas index df12df086..27e442c01 100644 --- a/components/fpspreadsheet/fpsstrings.pas +++ b/components/fpspreadsheet/fpsstrings.pas @@ -51,13 +51,15 @@ resourcestring rsInvalidCharacterInCell = 'Invalid character(s) in cell %s.'; rsInvalidCharacterInCellComment = 'Invalid character(s) in cell comment "%s".'; rsUTF8TextExpectedButANSIFoundInCell = 'Expected UTF8 text but probably ANSI '+ - 'text found in cell %s.'; + 'text found in cell %s.'; rsIndexInSSTOutOfRange = 'Index %d in SST out of range (0-%d).'; rsAmbiguousDecThouSeparator = 'Assuming usage of decimal separator in "%s".'; rsCodePageNotSupported = 'Code page "%s" is not supported. Using "cp1252" (Latin 1) instead.'; rsNoValidHyperlinkInternal = 'The hyperlink "%s" is not a valid cell address.'; rsNoValidHyperlinkURI = 'The hyperlink "%s" is not a valid URI.'; + rsLocalFileHyperlinkAbs = 'The hyperlink "%s" points to a local file. ' + + 'In case of an absolute path the protocol "file:" must be specified.'; rsEmptyHyperlink = 'The hyperlink is not specified.'; rsODSHyperlinksOfTextCellsOnly = 'Cell %s: OpenDocument supports hyperlinks for text cells only.'; rsStdHyperlinkTooltip = 'Press the left mouse button a bit longer to activate the hyperlink.'; diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index 330e255fc..5774b0467 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -29,9 +29,9 @@ const {@@ Default extension of comma-separated-values file } STR_COMMA_SEPARATED_EXTENSION = '.csv'; {@@ Default extension of wikitable files in pipes format} - STR_WIKITABLE_PIPES = '.wikitable_pipes'; + STR_WIKITABLE_PIPES_EXTENSION = '.wikitable_pipes'; {@@ Default extension of wikitable files in wikimedia format } - STR_WIKITABLE_WIKIMEDIA = '.wikitable_wikimedia'; + STR_WIKITABLE_WIKIMEDIA_EXTENSION = '.wikitable_wikimedia'; {@@ Maximum count of worksheet columns} MAX_COL_COUNT = 65535; diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 3c219a4dc..42baacf68 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -88,6 +88,9 @@ function GetCellRangeString(ARange: TsCellRange; function GetErrorValueStr(AErrorValue: TsErrorValue): String; function GetFileFormatName(AFormat: TsSpreadsheetFormat): string; +function GetFileFormatExt(AFormat: TsSpreadsheetFormat): String; +function GetFormatFromFileName(const AFileName: TFileName; + out SheetType: TsSpreadsheetFormat): Boolean; function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload; @@ -866,6 +869,52 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Returns the default extension of each spreadsheet file format + + @param AFormat Identifier of the file format + @retur File extension +-------------------------------------------------------------------------------} +function GetFileFormatExt(AFormat: TsSpreadsheetFormat): String; +begin + case AFormat of + sfExcel2, + sfExcel5, + sfExcel8 : Result := STR_EXCEL_EXTENSION; + sfOOXML : Result := STR_OOXML_EXCEL_EXTENSION; + sfOpenDocument : Result := STR_OPENDOCUMENT_CALC_EXTENSION; + sfCSV : Result := STR_COMMA_SEPARATED_EXTENSION; + sfWikiTable_Pipes : Result := STR_WIKITABLE_PIPES_EXTENSION; + sfWikiTable_WikiMedia : Result := STR_WIKITABLE_WIKIMEDIA_EXTENSION; + else raise Exception.Create(rsUnknownSpreadsheetFormat); + end; +end; + +{@@ ---------------------------------------------------------------------------- + Determines the spreadsheet type from the file type extension + + @param AFileName Name of the file to be considered + @param SheetType File format found from analysis of the extension (output) + @return True if the file matches any of the known formats, false otherwise +-------------------------------------------------------------------------------} +function GetFormatFromFileName(const AFileName: TFileName; + out SheetType: TsSpreadsheetFormat): Boolean; +var + suffix: String; +begin + Result := true; + suffix := Lowercase(ExtractFileExt(AFileName)); + case suffix of + STR_EXCEL_EXTENSION : SheetType := sfExcel8; + STR_OOXML_EXCEL_EXTENSION : SheetType := sfOOXML; + STR_OPENDOCUMENT_CALC_EXTENSION : SheetType := sfOpenDocument; + STR_COMMA_SEPARATED_EXTENSION : SheetType := sfCSV; + STR_WIKITABLE_PIPES_EXTENSION : SheetType := sfWikiTable_Pipes; + STR_WIKITABLE_WIKIMEDIA_EXTENSION : SheetType := sfWikiTable_WikiMedia; + else Result := False; + end; +end; + {@@ ---------------------------------------------------------------------------- Helper function to reduce typing: "if a conditions is true return the first number format, otherwise return the second format" diff --git a/components/fpspreadsheet/tests/commenttests.pas b/components/fpspreadsheet/tests/commenttests.pas index 08f529cbd..2f8354dbd 100644 --- a/components/fpspreadsheet/tests/commenttests.pas +++ b/components/fpspreadsheet/tests/commenttests.pas @@ -1,11 +1,12 @@ +{ Comment tests + These unit tests are writing out to and reading back from file. +} + unit commenttests; {$mode objfpc}{$H+} interface -{ Color tests -This unit tests writing out to and reading back from files. -} uses // Not using Lazarus package as the user may be working with multiple versions diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index b55a3691e..9dd3c52f1 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -40,7 +40,7 @@ - + @@ -140,6 +140,11 @@ + + + + + diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpr b/components/fpspreadsheet/tests/spreadtestgui.lpr index f30e5276d..f94872cc7 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpr +++ b/components/fpspreadsheet/tests/spreadtestgui.lpr @@ -12,7 +12,8 @@ uses manualtests, testsutility, internaltests, formattests, colortests, fonttests, optiontests, numformatparsertests, formulatests, rpnFormulaUnit, emptycelltests, errortests, virtualmodetests, insertdeletetests, - celltypetests, sortingtests, copytests, commenttests, enumeratortests; + celltypetests, sortingtests, copytests, commenttests, enumeratortests, + hyperlinktests; begin {$IFDEF HEAPTRC} diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index b140afb7d..0bc7705a0 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -119,9 +119,6 @@ type { TsSpreadBIFF8Writer } TsSpreadBIFF8Writer = class(TsSpreadBIFFWriter) - private - procedure WriteHyperlinksCallback(AHyperlink: PsHyperlink; AStream: TStream); - protected { Record writing methods } procedure WriteBOF(AStream: TStream; ADataType: Word); @@ -261,7 +258,7 @@ var implementation uses - Math, lconvencoding, URIParser, + Math, lconvencoding, LazFileUtils, URIParser, fpsStrings, fpsStreams, fpsReaderWriter, fpsExprParser, xlsEscher; const @@ -1496,12 +1493,12 @@ begin SetLength(ansiStr, len); AStream.ReadBuffer(ansiStr[1], len*SizeOf(ansiChar)); SetLength(ansistr, len-1); // Remove trailing zero - linkDos := AnsiToUTF8(ansiStr); while dirUpCount > 0 do begin - linkDos := '..\' + linkDos; + ansistr := '..' + PathDelim + ansistr; dec(dirUpCount); end; + linkDos := AnsiToUTF8(ansiStr); // 6 unknown DWord values AStream.ReadDWord; AStream.ReadDWord; @@ -1523,11 +1520,13 @@ begin // no Unicode string header, always 16-bit characters, not zero-terminated SetLength(wideStr, len); AStream.ReadBuffer(wideStr[1], size); - SetLength(link, size); - len := System.UnicodeToUTF8(PChar(link), PWideChar(widestr), size); - SetLength(link, len); + link := UTF8Encode(wideStr); end else link := linkDos; + + // An absolute path must be a fully qualified URI to be compatible with fps + if flags and MASK_HLINK_ABSOLUTE <> 0 then + link := 'file:///' + link; end; end; @@ -2395,8 +2394,10 @@ var flags: DWord; size: Integer; cell: PCell; - isInternal: Boolean; target, bookmark: String; + u: TUri; + isInternal: Boolean; + dirUpCounter: Integer; begin cell := AWorksheet.FindCell(AHyperlink^.Row, AHyperlink^.Col); if (cell = nil) or (AHyperlink^.Target='') then @@ -2404,7 +2405,17 @@ begin descr := AWorksheet.ReadAsUTF8Text(cell); // Hyperlink description SplitHyperlink(AHyperlink^.Target, target, bookmark); - isInternal := (target = ''); + u := ParseURI(AHyperlink^.Target); + isInternal := (target = '') and (bookmark <> ''); + fn := ''; // Name of local file + if target <> '' then + begin + if (u.Protocol='') then + fn := target + else + UriToFileName(target, fn); + ForcePathDelims(fn); + end; // Since the length of the record is not known in the first place we write // the data to a temporary stream at first. @@ -2428,7 +2439,9 @@ begin if isInternal then flags := MASK_HLINK_TEXTMARK or MASK_HLINK_DESCRIPTION else - flags := MASK_HLINK_LINK or MASK_HLINK_ABSOLUTE; + flags := MASK_HLINK_LINK; + if SameText(u.Protocol, 'file') then + flags := flags or MASK_HLINK_ABSOLUTE; if descr <> AHyperlink^.Target then flags := flags or MASK_HLINK_DESCRIPTION; // has description if bookmark <> '' then @@ -2447,16 +2460,22 @@ begin if target <> '' then begin - if URIToFilename(target, fn) then // URI is a local file + if (fn <> '') then // URI is a local file begin { GUID of file moniker } guid := StringToGuid('{00000303-0000-0000-C000-000000000046}'); temp.WriteBuffer(guid, SizeOf(guid)); - { Directory-up level counter - we only use absolute paths. } - temp.WriteWord(WordToLE(0)); - { Convert to DOS 8.3 format } - ansistr := UTF8ToAnsi(fn); // Don't use FCodePage here - this is utf8 in case of BIFF8, but we need at true ansi string - //GetShortName(ansistr); + { Convert to ansi - should be DOS 8.3, but this is not necessary } + ansistr := UTF8ToAnsi(fn); + { Directory-up level counter } + dirUpCounter := 0; + if not FileNameIsAbsolute(ansistr) then + while (pos ('..' + PathDelim, ansistr) = 1) do + begin + inc(dirUpCounter); + Delete(ansistr, 1, Length('..'+PathDelim)); + end; + temp.WriteWord(WordToLE(dirUpCounter)); { Character count of file name incl trailing zero } temp.WriteDWord(DWordToLe(Length(ansistr)+1)); { Character array of file name (8-bit characters), plus trailing zero } @@ -2525,24 +2544,13 @@ procedure TsSpreadBIFF8Writer.WriteHyperlinks(AStream: TStream; var hyperlink: PsHyperlink; begin - for hyperlink in AWorksheet.Hyperlinks do + for hyperlink in AWorksheet.Hyperlinks do begin + { Write HYPERLINK record } WriteHyperlink(AStream, hyperlink, AWorksheet); -// IterateThroughHyperlinks(AStream, AWorksheet.Hyperlinks, WriteHyperlinksCallback); -end; - -{@@ ---------------------------------------------------------------------------- - Callback procedure called for each hyperlink of the current worksheet when - all hyperlinks are written out --------------------------------------------------------------------------------} -procedure TsSpreadBIFF8Writer.WriteHyperlinksCallback(AHyperlink: PsHyperlink; - AStream: TStream); -begin - { Write HYPERLINK record } - WriteHyperlink(AStream, AHyperlink, FWorksheet); - - { Write HYPERLINK TOOLTIP record } - if AHyperlink^.Tooltip <> '' then - WriteHyperlinkTooltip(AStream, AHyperlink^.Row, AHyperlink^.Col, AHyperlink^.Tooltip); + { Write HYPERLINK TOOLTIP record } + if hyperlink^.Tooltip <> '' then + WriteHyperlinkTooltip(AStream, hyperlink^.Row, hyperlink^.Col, hyperlink^.Tooltip); + end; end; {@@ ---------------------------------------------------------------------------- diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 8c6156950..7b9b0396f 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -109,10 +109,6 @@ type TsSpreadOOXMLWriter = class(TsCustomSpreadWriter) private FNext_rId: Integer; - { - procedure WriteCommentsCallback(AComment: PsComment; - ACommentIndex: Integer; AStream: TStream); - } procedure WriteVmlDrawingsCallback(AComment: PsComment; ACommentIndex: Integer; AStream: TStream); @@ -209,7 +205,7 @@ var implementation uses - variants, fileutil, strutils, math, lazutf8, + variants, fileutil, strutils, math, lazutf8, uriparser, {%H-}fpsPatches, fpsStrings, fpsStreams, fpsNumFormatParser; const @@ -2281,13 +2277,16 @@ begin s := Format('%s r:id="rId%d"', [s, FNext_rId]); inc(FNext_rId); end; - if target = '' then + if bookmark <> '' then //target = '' then s := Format('%s location="%s"', [s, bookmark]); txt := AWorksheet.ReadAsUTF8Text(hyperlink^.Row, hyperlink^.Col); if (txt <> '') and (txt <> hyperlink^.Target) then s := Format('%s display="%s"', [s, txt]); - if hyperlink^.ToolTip <> '' then - s := Format('%s tooltip="%s"', [s, hyperlink^.Tooltip]); + if hyperlink^.ToolTip <> '' then begin + txt := hyperlink^.Tooltip; + ValidXMLText(txt); + s := Format('%s tooltip="%s"', [s, txt]); + end; AppendToStream(AStream, ''); AVLNode := AWorksheet.Hyperlinks.FindSuccessor(AVLNode); @@ -2767,6 +2766,7 @@ var AVLNode: TAVLTreeNode; hyperlink: PsHyperlink; s: String; + target, bookmark: String; begin // Extend stream array SetLength(FSSheetRels, FCurSheetNum + 1); @@ -2808,10 +2808,13 @@ begin while Assigned(AVLNode) do begin hyperlink := PsHyperlink(AVLNode.Data); - if hyperlink^.Target <> '' then + SplitHyperlink(hyperlink^.Target, target, bookmark); + if target <> '' then begin + if (pos('file:', target) = 0) and FileNameIsAbsolute(target) then + target := 'file:///' + target; s := Format('Id="rId%d" Type="%s" Target="%s" TargetMode="External"', - [FNext_rId, SCHEMAS_HYPERLINKS, hyperlink^.Target]); + [FNext_rId, SCHEMAS_HYPERLINKS, target]); AppendToStream(FSSheetRels[FCurSheetNum], ''); inc(FNext_rId);