pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Add writing support for cell, sheet and workbook protection in xls files (biff2, biff5, biff8), opendocument and Excel XML files. Not complete, yet.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5795 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-03-06 23:30:59 +00:00
parent 20fcc57d97
commit 4505fb76cd
11 changed files with 635 additions and 176 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
components/fpspreadsheet/source/common/fpscrypto.pas
View File

@@ -10,13 +10,13 @@ type
function AlgorithmToStr(Algorithm: TsCryptoAlgorithm; AUsage: TsAlgorithmUsage): String;
function StrToAlgorithm(const AName: String): TsCryptoAlgorithm;
function ExcelPasswordHash(const APassword: String): String;
(*
function PasswordHash(const APassword: String; Algorithm: TsAlgorithm): String;
*)
implementation
uses
LazUTF8;
sha1, LazUTF8;
function AlgorithmToStr(Algorithm: TsCryptoAlgorithm; AUsage: TsAlgorithmUsage): String;
begin
@@ -100,5 +100,22 @@ begin
Result := IntToHex(PassHash, 4);
end;
(*
function SHA1Hash(const AText: String): String;
var
sha1: TSHA1Digest;
begin
sha1 := SHA1String(AText);
Result := PChar(sha1);
end;
function CalcPasswordHash(const APassword: String; Algorithm: TsAlgorithm): String;
begin
case Algorithm of
caExcel: Result := ExcelPasswordHash(APassword);
caSHA1 : Result := SHA1Hash(APassword);
else raise Exception.Create('Hashing algorithm not implemented.');
end;
end; *)
end.

27
components/fpspreadsheet/source/common/fpsopendocument.pas
View File

@@ -207,6 +207,7 @@ type
function WriteCommentXMLAsString(AComment: String): String;
function WriteDefaultFontXMLAsString: String;
function WriteDefaultGraphicStyleXMLAsString: String; overload;
function WriteDocumentProtectionXMLAsString: String;
function WriteFontStyleXMLAsString(const AFormat: TsCellFormat): String; overload;
function WriteFontStyleXMLAsString(AFont: TsFont): String; overload;
function WriteHeaderFooterFontXMLAsString(AFont: TsHeaderFooterFont): String;
@@ -4996,6 +4997,7 @@ end;
procedure TsSpreadOpenDocWriter.WriteContent;
var
i: Integer;
s: String;
begin
AppendToStream(FSContent,
XML_HEADER);
@@ -5089,7 +5091,7 @@ begin
// Body
AppendToStream(FSContent,
'<office:body>' +
'<office:spreadsheet>');
'<office:spreadsheet' + WriteDocumentProtectionXMLAsString + '>');
// Write all worksheets
for i := 0 to Workbook.GetWorksheetCount - 1 do
@@ -6589,6 +6591,29 @@ begin
'style:language-complex="hi" style:country-complex="IN" />';
end;
function TsSpreadOpenDocWriter.WriteDocumentProtectionXMLAsString: String;
var
cinfo: TsCryptoInfo;
pwd, algo: String;
begin
if bpLockStructure in Workbook.Protection then
begin
Result := ' table:structure-protected="true"';
cinfo := Workbook.CryptoInfo;
if cinfo.PasswordHash <> '' then
pwd := Format(' table:protection-key="%s"', [cinfo.PasswordHash])
else
pwd := '';
if cinfo.Algorithm <> caUnknown then
algo := Format(' table:protection-key-digest-algorithm="%s"',
[AlgorithmToStr(cinfo.Algorithm, auOpenDocument)])
else
algo := '';
Result := Result + pwd + algo;
end
else
Result := '';
end;
procedure TsSpreadOpenDocWriter.WriteError(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell);
var

9
components/fpspreadsheet/source/common/fpspreadsheet.pas
View File

@@ -6763,6 +6763,15 @@ begin
ChangedCell(ACell^.Row, ACell^.Col);
end;
{@@ ----------------------------------------------------------------------------
Defines how the cell at the specified row and column is protected: lock
cell modification and/or hide formulas. Note that this is activated only after
enabling worksheet protection (worksheet.Protect(true)).
NOTE:
FPSpreadsheet does not enforce these actions. They are only written
to the file for the Office application.
-------------------------------------------------------------------------------}
function TsWorksheet.WriteCellProtection(ARow, ACol: Cardinal;
AValue: TsCellProtections): PCell;
begin

8
components/fpspreadsheet/source/common/fpstypes.pas
View File

@@ -663,9 +663,9 @@ type
spFormatCells, spFormatColumns, spFormatRows,
spDeleteColumns, spDeleteRows,
spInsertColumns, spInsertRows, spInsertHyperlinks,
spCells, spSort,
spCells, spSort, spObjects,
spSelectLockedCells, spSelectUnlockedCells
{spObjects, spPivotTables, spScenarios }
{spPivotTables, spScenarios }
);
TsWorksheetProtections = set of TsWorksheetProtection;
@@ -676,8 +676,8 @@ type
const
ALL_SHEET_PROTECTIONS = [spFormatCells, spFormatColumns, spFormatRows,
spDeleteColumns, spDeleteRows, spInsertColumns, spInsertRows, spInsertHyperlinks,
spCells, spSort, spSelectLockedCells, spSelectUnlockedCells
{, spObjects, spPivotTables, spScenarios} ];
spCells, spSort, spObjects, spSelectLockedCells, spSelectUnlockedCells
{spPivotTables, spScenarios} ];
DEFAULT_SHEET_PROTECTION = ALL_SHEET_PROTECTIONS - [spSelectLockedCells, spSelectUnlockedcells];

39
components/fpspreadsheet/source/common/xlsbiff2.pas
View File

@@ -63,6 +63,7 @@ type
procedure ReadIXFE(AStream: TStream);
procedure ReadLabel(AStream: TStream); override;
procedure ReadNumber(AStream: TStream); override;
procedure ReadPROTECT(AStream: TStream);
procedure ReadRowColXF(AStream: TStream; out ARow, ACol: Cardinal; out AXF: Word); override;
procedure ReadRowInfo(AStream: TStream); override;
function ReadRPNAttr(AStream: TStream; AIdentifier: Byte): Boolean; override;
@@ -616,10 +617,11 @@ begin
INT_EXCEL_ID_NOTE : ReadComment(AStream);
INT_EXCEL_ID_NUMBER : ReadNumber(AStream);
INT_EXCEL_ID_PANE : ReadPane(AStream);
INT_EXCEL_ID_OBJECTPROTECT : ReadObjectProtect(AStream);
INT_EXCEL_ID_PASSWORD : ReadPASSWORD(AStream, FWorksheet);
INT_EXCEL_ID_PRINTGRID : ReadPrintGridLines(AStream);
INT_EXCEL_ID_PRINTHEADERS : ReadPrintHeaders(AStream);
INT_EXCEL_ID_PROTECT : ReadPROTECT(AStream, FWorksheet);
INT_EXCEL_ID_PROTECT : ReadPROTECT(AStream);
INT_EXCEL_ID_RIGHTMARGIN : ReadMargin(AStream, 1);
INT_EXCEL_ID_ROW : ReadRowInfo(AStream);
INT_EXCEL_ID_SELECTION : ReadSELECTION(AStream);
@@ -866,6 +868,12 @@ begin
FPendingXFIndex := WordLEToN(AStream.ReadWord);
end;
procedure TsSpreadBIFF2Reader.ReadPROTECT(AStream: TStream);
begin
inherited ReadPROTECT(AStream);
FWorksheet.Protect(Workbook.IsProtected);
end;
{@@ ----------------------------------------------------------------------------
Reads the row, column and xf index from the stream
-------------------------------------------------------------------------------}
@@ -1194,8 +1202,8 @@ var
begin
fmt := Workbook.GetPointerToCellFormat(AFormatIndex);
if fmt^.UsedFormattingFields = [] then begin
Attrib1 := 15;
if (fmt^.UsedFormattingFields = []) and (fmt^.Protection = [cpLockCell]) then begin
Attrib1 := 15 + $40;
Attrib2 := 0;
Attrib3 := 0;
exit;
@@ -1206,6 +1214,8 @@ begin
// Mask $40: 1 = Cell is locked
// Mask $80: 1 = Formula is hidden
Attrib1 := Min(XFIndex, $3F) and $3F;
if cpLockCell in fmt^.Protection then Attrib1 := Attrib1 or $40;
if cpHideFormulas in fmt^.Protection then Attrib1 := Attrib1 or $80;
// 2nd byte:
// Mask $3F: Index to FORMAT record ("FORMAT" = number format!)
@@ -1346,13 +1356,17 @@ begin
rec.XFIndex_Locked_Hidden := 0; // to silence the compiler...
FillChar(rec, SizeOf(rec), 0);
if fmt^.UsedFormattingFields <> [] then
if (fmt^.UsedFormattingFields <> []) or (fmt^.Protection <> [cpLockCell]) then
begin
// 1st byte:
// Mask $3F: Index to XF record
// Mask $40: 1 = Cell is locked
// Mask $80: 1 = Formula is hidden
rec.XFIndex_Locked_Hidden := Min(XFIndex, $3F) and $3F;
if cpLockCell in fmt^.Protection then
rec.XFIndex_Locked_Hidden := rec.XFIndex_Locked_Hidden or $40;
if cpHideFormulas in fmt^.Protection then
rec.XFIndex_Locked_Hidden := rec.XFIndex_Locked_Hidden or $80;
// 2nd byte:
// Mask $3F: Index to FORMAT record
@@ -1601,6 +1615,11 @@ begin
WriteFormatCount(AStream);
WriteNumFormats(AStream);
if (bpLockStructure in Workbook.Protection) or FWorksheet.IsProtected then
WritePROTECT(AStream, true);
WriteWindowProtect(AStream, bpLockWindows in Workbook.Protection);
WriteObjectProtect(AStream, FWorksheet);
WriteXFRecords(AStream);
WriteDefaultColWidth(AStream, FWorksheet);
WriteColWidths(AStream);
@@ -1700,6 +1719,7 @@ var
rec: TBIFF2_XFRecord;
b: Byte;
formatIdx, fontIdx: Integer;
fmtProt: byte;
begin
Unused(XFType_Prot);
GetFormatAndFontIndex(AFormatRecord, formatIdx, fontIdx);
@@ -1720,8 +1740,15 @@ begin
5-0 $3F Index to (number) FORMAT record
6 $40 1 = Cell is locked
7 $80 1 = Formula is hidden }
rec.NumFormat_Prot := WordToLE(formatIdx);
// Cell flags not used, so far...
fmtProt := formatIdx + $40;
if AFormatRecord <> nil then
begin
if not (cpLockCell in AFormatRecord^.Protection) then
fmtProt := fmtProt and not $40;
if (cpHideFormulas in AFormatRecord^.Protection) then
fmtProt := fmtProt or $80;
end;
rec.NumFormat_Prot := WordToLE(fmtProt);
{Horizontal alignment, border style, and background
Bit Mask Contents

26
components/fpspreadsheet/source/common/xlsbiff5.pas
View File

@@ -534,6 +534,7 @@ begin
INT_EXCEL_ID_MULRK : ReadMulRKValues(AStream);
INT_EXCEL_ID_NOTE : ReadComment(AStream);
INT_EXCEL_ID_NUMBER : ReadNumber(AStream);
INT_EXCEL_ID_OBJECTPROTECT : ReadObjectProtect(AStream, FWorksheet);
INT_EXCEL_ID_PANE : ReadPane(AStream);
INT_EXCEL_ID_PAGESETUP : ReadPageSetup(AStream);
INT_EXCEL_ID_PASSWORD : ReadPASSWORD(AStream, FWorksheet);
@@ -1135,6 +1136,8 @@ begin
WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS);
WriteCODEPAGE(AStream, FCodePage);
WriteWindowProtect(AStream, bpLockWindows in Workbook.Protection);
WritePROTECT(AStream, bpLockStructure in Workbook.Protection);
WriteEXTERNCOUNT(AStream);
WriteEXTERNSHEET(AStream);
WriteDefinedNames(AStream);
@@ -1182,7 +1185,11 @@ begin
WriteMargin(AStream, 2); // 2 = top margin
WriteMargin(AStream, 3); // 3 = bottom margin
WritePageSetup(AStream);
if FWorksheet.IsProtected then begin
WritePROTECT(AStream, true);
// WriteScenarioProtect(AStream);
WriteObjectProtect(AStream, FWorksheet);
end;
WriteDefaultColWidth(AStream, FWorksheet);
WriteColInfos(AStream, FWorksheet);
WriteDimensions(AStream, FWorksheet);
@@ -1920,9 +1927,20 @@ begin
rec.NumFormatIndex := WordToLE(j);
{ XF type, cell protection and parent style XF }
rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT;
if XFType_Prot and MASK_XF_TYPE_PROT_STYLE_XF <> 0 then
rec.XFType_Prot_ParentXF := rec.XFType_Prot_ParentXF or MASK_XF_TYPE_PROT_PARENT;
if AFormatRecord = nil then
begin
rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT;
if XFType_Prot and MASK_XF_TYPE_PROT_STYLE_XF <> 0 then
rec.XFType_Prot_ParentXF := rec.XFType_Prot_ParentXF or MASK_XF_TYPE_PROT_PARENT;
end else
begin
rec.XFType_Prot_ParentXF := 0;
if cpLockCell in AFormatRecord^.Protection then
rec.XFType_Prot_ParentXF := rec.XFType_Prot_ParentXF or MASK_XF_TYPE_PROT_LOCKED;
if cpHideFormulas in AFormatRecord^.Protection then
rec.XFType_Prot_ParentXF := rec.XFType_Prot_ParentXF or MASK_XF_TYPE_PROT_FORMULA_HIDDEN;
end;
rec.XFType_Prot_ParentXF := WordToLE(rec.XFType_Prot_ParentXF);
{ Text alignment and text break }
if AFormatRecord = nil then

39
components/fpspreadsheet/source/common/xlsbiff8.pas
View File

@@ -875,6 +875,7 @@ begin
INT_EXCEL_ID_NOTE : ReadNOTE(AStream);
INT_EXCEL_ID_NUMBER : ReadNumber(AStream);
INT_EXCEL_ID_OBJ : ReadOBJ(AStream);
INT_EXCEL_ID_OBJECTPROTECT : ReadObjectProtect(AStream, FWorksheet);
INT_EXCEL_ID_PAGESETUP : ReadPageSetup(AStream);
INT_EXCEL_ID_PANE : ReadPane(AStream);
INT_EXCEL_ID_PASSWORD : ReadPASSWORD(AStream, FWorksheet);
@@ -2127,7 +2128,9 @@ begin
{ Write workbook globals }
WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS);
WriteCodePage(AStream, 'ucs2le'); // = utf-16
WriteWindow1(AStream);
WriteWindowProtect(AStream, bpLockWindows in Workbook.Protection);
WritePROTECT(AStream, bpLockStructure in Workbook.Protection);
WriteWINDOW1(AStream);
WriteFonts(AStream);
WriteNumFormats(AStream);
WritePalette(AStream);
@@ -2174,7 +2177,11 @@ begin
WriteMargin(AStream, 2); // 2 = top margin
WriteMargin(AStream, 3); // 3 = bottom margin
WritePageSetup(AStream);
if FWorksheet.IsProtected then begin
WritePROTECT(AStream, true);
// WriteScenarioProtect(AStream);
WriteObjectProtect(AStream, FWorksheet);
end;
WriteDefaultColWidth(AStream, FWorksheet);
WriteColInfos(AStream, FWorksheet);
WriteDimensions(AStream, FWorksheet);
@@ -3657,9 +3664,19 @@ begin
rec.NumFormatIndex := WordToLE(j);
{ XF type, cell protection and parent style XF }
rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT;
if XFType_Prot and MASK_XF_TYPE_PROT_STYLE_XF <> 0 then
rec.XFType_Prot_ParentXF := rec.XFType_Prot_ParentXF or MASK_XF_TYPE_PROT_PARENT;
if AFormatRecord = nil then begin
rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT;
if XFType_Prot and MASK_XF_TYPE_PROT_STYLE_XF <> 0 then
rec.XFType_Prot_ParentXF := rec.XFType_Prot_ParentXF or MASK_XF_TYPE_PROT_PARENT;
end else
begin
rec.XFType_Prot_ParentXF := 0;
if cpLockCell in AFormatRecord^.Protection then
rec.XFType_Prot_ParentXF := rec.XFType_Prot_ParentXF or MASK_XF_TYPE_PROT_LOCKED;
if cpHideFormulas in AFormatRecord^.Protection then
rec.XFType_Prot_ParentXF := rec.XFType_Prot_ParentXF or MASK_XF_TYPE_PROT_FORMULA_HIDDEN;
end;
rec.XFType_Prot_ParentXF := WordToLE(rec.XFType_Prot_ParentXF);
{ Text alignment and text break }
if AFormatRecord = nil then
@@ -3708,12 +3725,12 @@ begin
{ Used attributes }
rec.UsedAttrib :=
MASK_XF_USED_ATTRIB_NUMBER_FORMAT or
MASK_XF_USED_ATTRIB_FONT or
MASK_XF_USED_ATTRIB_TEXT or
MASK_XF_USED_ATTRIB_BORDER_LINES or
MASK_XF_USED_ATTRIB_BACKGROUND or
MASK_XF_USED_ATTRIB_CELL_PROTECTION;
MASK_XF_USED_ATTRIB_NUMBER_FORMAT or
MASK_XF_USED_ATTRIB_FONT or
MASK_XF_USED_ATTRIB_TEXT or
MASK_XF_USED_ATTRIB_BORDER_LINES or
MASK_XF_USED_ATTRIB_BACKGROUND or
MASK_XF_USED_ATTRIB_CELL_PROTECTION;
{ Cell border lines and background area }

300
components/fpspreadsheet/source/common/xlscommon.pas
View File

@@ -37,6 +37,7 @@ const
INT_EXCEL_ID_PANE = $0041;
INT_EXCEL_ID_CODEPAGE = $0042;
INT_EXCEL_ID_DEFCOLWIDTH = $0055;
INT_EXCEL_ID_OBJECTPROTECT = $0063;
{ RECORD IDs which did not changed across versions 2-5 }
INT_EXCEL_ID_EXTERNCOUNT = $0016; // does not exist in BIFF8
@@ -133,7 +134,7 @@ const
{ XF_TYPE_PROT - XF Type and Cell protection (3 Bits) - BIFF3-BIFF8 }
MASK_XF_TYPE_PROT_LOCKED = $0001;
MASK_XF_TYPE_PROT_FORMULA_HIDDEN = $0002;
MASK_XF_TYPE_PROT_STYLE_XF = $0004; // 0 = CELL XF
MASK_XF_TYPE_PROT_STYLE_XF = $0005; // was: 4 (wp)
MASK_XF_TYPE_PROTECTION = $0007;
@@ -450,6 +451,8 @@ type
procedure ReadMulRKValues(const AStream: TStream);
// Read floating point number
procedure ReadNumber(AStream: TStream); override;
// Read OBJECTPROTECT record
procedure ReadObjectProtect(AStream: TStream; AWorksheet: TsWorksheet = nil);
// Read palette
procedure ReadPalette(AStream: TStream);
// Read page setup
@@ -585,6 +588,8 @@ type
// Writes out a floating point NUMBER record
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Double; ACell: PCell); override;
// Writes an OBJECTPROTECT record
procedure WriteObjectProtect(AStream: TStream; ASheet: TsWorksheet);
procedure WritePageSetup(AStream: TStream);
// Writes out a PALETTE record containing all colors defined in the workbook
procedure WritePalette(AStream: TStream);
@@ -594,6 +599,7 @@ type
// Writes out whether grid lines are printed
procedure WritePrintGridLines(AStream: TStream);
procedure WritePrintHeaders(AStream: TStream);
procedure WritePROTECT(AStream: TStream; AEnable: Boolean);
// Writes out a ROW record
procedure WriteRow(AStream: TStream; ASheet: TsWorksheet;
ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); virtual;
@@ -632,6 +638,7 @@ type
procedure WriteVirtualCells(AStream: TStream; ASheet: TsWorksheet);
// Writes out a WINDOW1 record
procedure WriteWindow1(AStream: TStream); virtual;
procedure WriteWindowProtect(AStream: TStream; AEnable: Boolean);
// Writes an XF record
procedure WriteXF(AStream: TStream; ACellFormat: PsCellFormat;
XFType_Prot: Byte = 0); virtual;
@@ -1903,6 +1910,24 @@ begin
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
{@@ ----------------------------------------------------------------------------
Reads the OBJECTPROTECT record. It determines whether the objects (drawings,
etc) of the current sheet are protected.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.ReadObjectProtect(AStream: TStream;
AWorksheet: TsWorksheet = nil);
var
w: Word;
sp: TsWorksheetProtections;
begin
if AWorksheet = nil then
AWorksheet := FWorksheet;
w := WordLEToN(AStream.ReadWord);
sp := AWorksheet.Protection;
if w = 0 then Exclude(sp, spObjects) else Include(sp, spObjects);
AWorksheet.Protection := sp;
end;
{@@ ----------------------------------------------------------------------------
Reads the color palette
-------------------------------------------------------------------------------}
@@ -2092,16 +2117,22 @@ var
p: Word;
begin
p := WordLEToN(AStream.ReadWord);
if p = 0 then // not protected
exit;
if AWorksheet = nil then
begin
// Workbook protection
FWorkbook.Protection := FWorkbook.Protection + [bpLockStructure]
else begin
if p = 1 then
FWorkbook.Protection := FWorkbook.Protection + [bpLockStructure]
else
FWorkbook.Protection := FWorkbook.Protection - [bpLockStructure];
end else
begin
// Worksheet protection
AWorksheet.Protection := FWorksheet.Protection + [spCells];
AWorksheet.Protect(true);
if p = 1 then begin
AWorksheet.Protection := AWorksheet.Protection + [spCells];
AWorksheet.Protect(true);
end else
AWorksheet.Protect(false);
end;
end;
@@ -3833,6 +3864,24 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Writes an OBJECTPROTECT record. It determines whether the objects (drawings,
etc.) of the current worksheet are protected. Omitted if object
protection is not active.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteObjectProtect(AStream: TStream;
ASheet: TsWorksheet);
var
w: Word;
begin
if not ASheet.IsProtected then
exit;
WriteBIFFHeader(AStream, INT_EXCEL_ID_OBJECTPROTECT, 2);
w := IfThen(spObjects in ASheet.Protection, 1, 0);
AStream.WriteWord(WordToLE(w));
end;
{@@ ----------------------------------------------------------------------------
Writes a PAGESETUP record containing information on printing
Valid for BIFF5-8
@@ -4019,6 +4068,125 @@ begin
AStream.WriteWord(WordToLE(w));
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel PROTECT record
Valid for BIFF2-BIFF8
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WritePROTECT(AStream: TStream; AEnable: Boolean);
var
w: Word;
begin
{ BIFF Header }
WriteBiffHeader(AStream, INT_EXCEL_ID_PROTECT, 2);
w := IfThen(AEnable, 1, 0);
AStream.WriteWord(WordToLE(w));
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel 3-8 ROW record
Valid for BIFF3-BIFF8
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteRow(AStream: TStream; ASheet: TsWorksheet;
ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow);
var
w: Word;
dw: DWord;
cell: PCell;
spaceabove, spacebelow: Boolean;
colindex: Cardinal;
rowheight: Word;
fmt: PsCellFormat;
begin
if (ARowIndex >= FLimitations.MaxRowCount) or
(AFirstColIndex >= FLimitations.MaxColCount) or
(ALastColIndex >= FLimitations.MaxColCount)
then
exit;
// Check for additional space above/below row
spaceabove := false;
spacebelow := false;
colindex := AFirstColIndex;
while colindex <= ALastColIndex do
begin
cell := ASheet.FindCell(ARowindex, colindex);
if (cell <> nil) then
begin
fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex);
if (uffBorder in fmt^.UsedFormattingFields) then
begin
if (cbNorth in fmt^.Border) and (fmt^.BorderStyles[cbNorth].LineStyle = lsThick)
then spaceabove := true;
if (cbSouth in fmt^.Border) and (fmt^.BorderStyles[cbSouth].LineStyle = lsThick)
then spacebelow := true;
end;
end;
if spaceabove and spacebelow then break;
inc(colindex);
end;
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_ROW, 16);;
{ Index of row }
AStream.WriteWord(WordToLE(Word(ARowIndex)));
{ Index to column of the first cell which is described by a cell record }
AStream.WriteWord(WordToLE(Word(AFirstColIndex)));
{ Index to column of the last cell which is described by a cell record, increased by 1 }
AStream.WriteWord(WordToLE(Word(ALastColIndex) + 1));
{ Row height (in twips, 1/20 point) and info on custom row height }
if (ARow = nil) or (ARow^.RowHeightType = rhtDefault) then
rowheight := PtsToTwips(ASheet.ReadDefaultRowHeight(suPoints))
else
rowheight := PtsToTwips(FWorkbook.ConvertUnits(ARow^.Height, FWorkbook.Units, suPoints));
w := rowheight and $7FFF;
AStream.WriteWord(WordToLE(w));
{ 2 words not used }
AStream.WriteDWord(0);
{ Option flags }
dw := $00000100; // bit 8 is always 1
if spaceabove then dw := dw or $10000000;
if spacebelow then dw := dw or $20000000;
if (ARow <> nil) and (ARow^.RowHeightType = rhtCustom) then // Custom row height
dw := dw or $00000040; // Row height and font height do not match
if ARow^.FormatIndex > 0 then begin
dw := dw or $00000080; // Row has custom format
dw := dw or DWord(FindXFIndex(ARow^.FormatIndex) shl 16); // xf index
end;
{ Write out }
AStream.WriteDWord(DWordToLE(dw));
end;
{@@ ----------------------------------------------------------------------------
Writes all ROW records for the given sheet.
Note that the OpenOffice documentation says that rows must be written in
groups of 32, followed by the cells on these rows, etc. THIS IS NOT NECESSARY!
Valid for BIFF2-BIFF8.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteRows(AStream: TStream; ASheet: TsWorksheet);
var
row: PRow;
i: Integer;
cell1, cell2: PCell;
begin
for i := 0 to ASheet.Rows.Count-1 do begin
row := ASheet.Rows[i];
cell1 := ASheet.Cells.GetFirstCellOfRow(row^.Row);
if cell1 <> nil then begin
cell2 := ASheet.Cells.GetLastCellOfRow(row^.Row);
WriteRow(AStream, ASheet, row^.Row, cell1^.Col, cell2^.Col, row);
end else
WriteRow(AStream, ASheet, row^.Row, 0, 0, row);
end;
end;
{@@ ----------------------------------------------------------------------------
Writes the address of a cell as used in an RPN formula and returns the
count of bytes written.
@@ -4421,110 +4589,6 @@ begin
AStream.WriteWord(WordToLE(ASize));
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel 3-8 ROW record
Valid for BIFF3-BIFF8
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteRow(AStream: TStream; ASheet: TsWorksheet;
ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow);
var
w: Word;
dw: DWord;
cell: PCell;
spaceabove, spacebelow: Boolean;
colindex: Cardinal;
rowheight: Word;
fmt: PsCellFormat;
begin
if (ARowIndex >= FLimitations.MaxRowCount) or
(AFirstColIndex >= FLimitations.MaxColCount) or
(ALastColIndex >= FLimitations.MaxColCount)
then
exit;
// Check for additional space above/below row
spaceabove := false;
spacebelow := false;
colindex := AFirstColIndex;
while colindex <= ALastColIndex do
begin
cell := ASheet.FindCell(ARowindex, colindex);
if (cell <> nil) then
begin
fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex);
if (uffBorder in fmt^.UsedFormattingFields) then
begin
if (cbNorth in fmt^.Border) and (fmt^.BorderStyles[cbNorth].LineStyle = lsThick)
then spaceabove := true;
if (cbSouth in fmt^.Border) and (fmt^.BorderStyles[cbSouth].LineStyle = lsThick)
then spacebelow := true;
end;
end;
if spaceabove and spacebelow then break;
inc(colindex);
end;
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_ROW, 16);;
{ Index of row }
AStream.WriteWord(WordToLE(Word(ARowIndex)));
{ Index to column of the first cell which is described by a cell record }
AStream.WriteWord(WordToLE(Word(AFirstColIndex)));
{ Index to column of the last cell which is described by a cell record, increased by 1 }
AStream.WriteWord(WordToLE(Word(ALastColIndex) + 1));
{ Row height (in twips, 1/20 point) and info on custom row height }
if (ARow = nil) or (ARow^.RowHeightType = rhtDefault) then
rowheight := PtsToTwips(ASheet.ReadDefaultRowHeight(suPoints))
else
rowheight := PtsToTwips(FWorkbook.ConvertUnits(ARow^.Height, FWorkbook.Units, suPoints));
w := rowheight and $7FFF;
AStream.WriteWord(WordToLE(w));
{ 2 words not used }
AStream.WriteDWord(0);
{ Option flags }
dw := $00000100; // bit 8 is always 1
if spaceabove then dw := dw or $10000000;
if spacebelow then dw := dw or $20000000;
if (ARow <> nil) and (ARow^.RowHeightType = rhtCustom) then // Custom row height
dw := dw or $00000040; // Row height and font height do not match
if ARow^.FormatIndex > 0 then begin
dw := dw or $00000080; // Row has custom format
dw := dw or DWord(FindXFIndex(ARow^.FormatIndex) shl 16); // xf index
end;
{ Write out }
AStream.WriteDWord(DWordToLE(dw));
end;
{@@ ----------------------------------------------------------------------------
Writes all ROW records for the given sheet.
Note that the OpenOffice documentation says that rows must be written in
groups of 32, followed by the cells on these rows, etc. THIS IS NOT NECESSARY!
Valid for BIFF2-BIFF8.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteRows(AStream: TStream; ASheet: TsWorksheet);
var
row: PRow;
i: Integer;
cell1, cell2: PCell;
begin
for i := 0 to ASheet.Rows.Count-1 do begin
row := ASheet.Rows[i];
cell1 := ASheet.Cells.GetFirstCellOfRow(row^.Row);
if cell1 <> nil then begin
cell2 := ASheet.Cells.GetLastCellOfRow(row^.Row);
WriteRow(AStream, ASheet, row^.Row, cell1^.Col, cell2^.Col, row);
end else
WriteRow(AStream, ASheet, row^.Row, 0, 0, row);
end;
end;
{@@ ----------------------------------------------------------------------------
Writes the SCL record - this is the current magnification factor of the sheet
-------------------------------------------------------------------------------}
@@ -4898,6 +4962,18 @@ begin
AStream.WriteWord(WordToLE(600));
end;
procedure TsSpreadBIFFWriter.WriteWindowProtect(AStream: TStream;
AEnable: Boolean);
var
w: Word;
begin
{ BIFF Header }
WriteBiffHeader(AStream, INT_EXCEL_ID_WINDOWPROTECT, 2);
w := IfThen(AEnable, 1, 0);
AStream.WriteWord(WordToLE(w));
end;
{@@ ----------------------------------------------------------------------------
Writes an XF record needed for cell formatting.
Is called from WriteXFRecords.
@@ -4949,7 +5025,7 @@ begin
// XF14
WriteXF(AStream, nil, MASK_XF_TYPE_PROT_STYLE_XF);
// XF15 - Default, no formatting
WriteXF(AStream, nil, 0);
WriteXF(AStream, nil, MASK_XF_TYPE_PROT_LOCKED);
// Add all further non-standard format records
// The first style was already added --> begin loop with 1

46
components/fpspreadsheet/source/common/xlsxml.pas
View File

@@ -143,6 +143,8 @@ const
2
);
FALSE_TRUE: array[boolean] of string = ('False', 'True');
function GetCellContentTypeStr(ACell: PCell): String;
begin
case ACell^.ContentType of
@@ -428,16 +430,23 @@ end;
procedure TsSpreadExcelXMLWriter.WriteExcelWorkbook(AStream: TStream);
var
datemodeStr: String;
protectStr: String;
begin
if FDateMode = dm1904 then
datemodeStr := INDENT2 + '<Date1904/>' + LF else
datemodeStr := '';
protectStr := Format(
'<ProtectStructure>%s</ProtectStructure>' + LF + INDENT2 +
'<ProtectWindows>%s</ProtectWindows>' + LF, [
FALSE_TRUE[bpLockStructure in Workbook.Protection],
FALSE_TRUE[bpLockWindows in Workbook.Protection]
]);
AppendToStream(AStream, INDENT1 +
'<ExcelWorkbook xmlns="urn:schemas-microsoft-com:office:excel">' + LF +
datemodeStr + INDENT2 +
'<ProtectStructure>False</ProtectStructure>' + LF + INDENT2 +
'<ProtectWindows>False</ProtectWindows>' + LF + INDENT1 +
protectStr + INDENT1 +
'</ExcelWorkbook>' + LF);
end;
@@ -653,6 +662,18 @@ begin
'</Borders>' + LF);
end;
// Protection
s := '';
if FWorkbook.IsProtected then begin
if not (cpLockCell in fmt^.Protection) then
s := s + 'ss:Protected="0" ';
if cpHideFormulas in fmt^.Protection then
s := s + 'x:HideFormula="1" ';
end;
if s <> '' then
AppendToStream(AStream, INDENT3 +
'<Protection ' + s + '/>' + LF);
AppendToStream(AStream, INDENT2 +
'</Style>' + LF);
end;
@@ -784,10 +805,20 @@ end;
procedure TsSpreadExcelXMLWriter.WriteWorksheet(AStream: TStream;
AWorksheet: TsWorksheet);
var
protectedStr: String;
begin
FWorksheet := AWorksheet;
if FWorksheet.IsProtected then
protectedStr := ' ss:Protected="1"' else
protectedStr := '';
AppendToStream(AStream, Format(
' <Worksheet ss:Name="%s">' + LF, [UTF8TextToXMLText(AWorksheet.Name)]) );
' <Worksheet ss:Name="%s"%s>' + LF, [
UTF8TextToXMLText(AWorksheet.Name),
protectedStr
]) );
WriteTable(AStream, AWorksheet);
WriteWorksheetOptions(AStream, AWorksheet);
AppendToStream(AStream,
@@ -805,6 +836,7 @@ var
layoutStr: String;
marginStr: String;
selectedStr: String;
protectStr: String;
begin
// Orientation, some PageLayout.Options
layoutStr := GetLayoutStr(AWorksheet);
@@ -839,6 +871,13 @@ begin
// Frozen panes
frozenStr := GetFrozenPanesStr(AWorksheet, INDENT3);
// Protection
protectStr := Format(INDENT3 + '<ProtectObjects>%s</ProtectObjects>' + LF +
INDENT3 + '<ProtectScenarios>%s</ProtectScenarios>' + LF, [
AWorksheet.IsProtected and (spObjects in AWorksheet.Protection),
AWorksheet.IsProtected {and [spScenarios in AWorksheet.Protection])}
]);
// Put it all together...
AppendToStream(AStream, INDENT2 +
'<WorksheetOptions xmlns="urn:schemas-microsoft-com:office:excel">' + LF + INDENT3 +
@@ -849,6 +888,7 @@ begin
marginStr + INDENT3 +
'</PageSetup>' + LF +
selectedStr +
protectStr +
frozenStr +
hideGridStr +
hideHeadersStr + INDENT2 +

12
components/fpspreadsheet/source/common/xlsxooxml.pas
View File

@@ -2051,12 +2051,12 @@ begin
if (s = '1') then Include(shp, spSelectUnlockedCells) else
if (s = '') or (s = '0') then Exclude(shp, spSelectUnlockedCells);
// these options are currently not supported by fpspreadsheet
{
s := GetAttrValue(ANode, 'objects');
if (s = '1') then Include(shp, spObjects) else
if (s = '') or (s = '0') then Exclude(shp, spObjects);
// these options are currently not supported by fpspreadsheet
{
s := GetAttrValue(ANode, 'scenarios');
if (s = '1') then Include(shp, spScenarios) else
if (s = '') or (s = '0') then Exclude(shp, spScenarios);
@@ -3423,7 +3423,7 @@ begin
// No attribute -> attr="0"
if AWorksheet.IsProtected then
s := ' sheet="1" objects="1" scenarios="1"'
s := ' sheet="1" scenarios="1"'
else
Exit; //exit if sheet not protected
@@ -3445,11 +3445,11 @@ begin
end;
end;
{
if spObjects in AWorksheet.Protection then // to do: Remove from default above
if spObjects in AWorksheet.Protection then
s := s + ' objects="1"';
if spScenarios in AWorksheet.Protection then
{
if spScenarios in AWorksheet.Protection then // to do: Remove from default above
s := s + ' scenarios="1"';
}