fpspreadsheet: OLE code fully working for big files too

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@654 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat 2009-01-08 08:44:34 +00:00
parent 111b3f819c
commit bbe2c54a49
4 changed files with 175 additions and 160 deletions

View File

@ -30,15 +30,15 @@
<PackageName Value="laz_fpspreadsheet"/> <PackageName Value="laz_fpspreadsheet"/>
</Item1> </Item1>
</RequiredPackages> </RequiredPackages>
<Units Count="19"> <Units Count="16">
<Unit0> <Unit0>
<Filename Value="excel5demo.lpr"/> <Filename Value="excel5demo.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="excel5demo"/> <UnitName Value="excel5demo"/>
<CursorPos X="1" Y="33"/> <CursorPos X="8" Y="21"/>
<TopLine Value="28"/> <TopLine Value="52"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<UsageCount Value="152"/> <UsageCount Value="196"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
@ -46,263 +46,227 @@
<UnitName Value="fpspreadsheet"/> <UnitName Value="fpspreadsheet"/>
<CursorPos X="32" Y="414"/> <CursorPos X="32" Y="414"/>
<TopLine Value="388"/> <TopLine Value="388"/>
<UsageCount Value="15"/> <UsageCount Value="10"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="..\xlsbiff5.pas"/> <Filename Value="..\xlsbiff5.pas"/>
<UnitName Value="xlsbiff5"/> <UnitName Value="xlsbiff5"/>
<CursorPos X="16" Y="320"/> <CursorPos X="16" Y="320"/>
<TopLine Value="300"/> <TopLine Value="300"/>
<UsageCount Value="15"/> <UsageCount Value="10"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="..\fpolestorage.pas"/> <Filename Value="..\fpolestorage.pas"/>
<UnitName Value="fpolestorage"/> <UnitName Value="fpolestorage"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="35"/> <UsageCount Value="30"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
<Filename Value="..\xlsbiff2.pas"/> <Filename Value="..\xlsbiff2.pas"/>
<UnitName Value="xlsbiff2"/> <UnitName Value="xlsbiff2"/>
<CursorPos X="20" Y="277"/> <CursorPos X="20" Y="277"/>
<TopLine Value="260"/> <TopLine Value="260"/>
<UsageCount Value="8"/> <UsageCount Value="3"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
<Filename Value="..\..\..\..\..\FPC220\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="22" Y="1602"/>
<TopLine Value="1598"/>
<UsageCount Value="1"/>
</Unit5>
<Unit6>
<Filename Value="..\..\..\..\..\FPC220\source\rtl\objpas\fgl.pp"/> <Filename Value="..\..\..\..\..\FPC220\source\rtl\objpas\fgl.pp"/>
<UnitName Value="fgl"/> <UnitName Value="fgl"/>
<CursorPos X="15" Y="86"/> <CursorPos X="15" Y="86"/>
<TopLine Value="55"/> <TopLine Value="55"/>
<UsageCount Value="8"/> <UsageCount Value="3"/>
</Unit6> </Unit5>
<Unit7> <Unit6>
<Filename Value="..\..\..\..\..\lazarus\lcl\interfaces\win32\win32wsstdctrls.pp"/> <Filename Value="..\..\..\..\..\lazarus\lcl\interfaces\win32\win32wsstdctrls.pp"/>
<UnitName Value="Win32WSStdCtrls"/> <UnitName Value="Win32WSStdCtrls"/>
<CursorPos X="11" Y="737"/> <CursorPos X="11" Y="737"/>
<TopLine Value="713"/> <TopLine Value="713"/>
<EditorIndex Value="9"/> <EditorIndex Value="7"/>
<UsageCount Value="66"/> <UsageCount Value="88"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit7> </Unit6>
<Unit8> <Unit7>
<Filename Value="..\..\..\..\..\lazarus\lcl\interfaces\win32\win32wscontrols.pp"/>
<UnitName Value="Win32WSControls"/>
<CursorPos X="13" Y="206"/>
<TopLine Value="199"/>
<UsageCount Value="2"/>
</Unit8>
<Unit9>
<Filename Value="..\..\..\..\..\lazarus\components\sqlite\registersqlite3.pas"/>
<UnitName Value="registersqlite3"/>
<CursorPos X="15" Y="5"/>
<TopLine Value="1"/>
<UsageCount Value="1"/>
</Unit9>
<Unit10>
<Filename Value="..\..\..\..\..\lazarus\ideintf\componenteditors.pas"/> <Filename Value="..\..\..\..\..\lazarus\ideintf\componenteditors.pas"/>
<UnitName Value="ComponentEditors"/> <UnitName Value="ComponentEditors"/>
<CursorPos X="54" Y="353"/> <CursorPos X="54" Y="353"/>
<TopLine Value="330"/> <TopLine Value="330"/>
<EditorIndex Value="8"/> <EditorIndex Value="6"/>
<UsageCount Value="64"/> <UsageCount Value="86"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit10> </Unit7>
<Unit11> <Unit8>
<Filename Value="..\..\..\..\..\FPC220\source\rtl\objpas\classes\cregist.inc"/>
<CursorPos X="17" Y="124"/>
<TopLine Value="121"/>
<UsageCount Value="1"/>
</Unit11>
<Unit12>
<Filename Value="..\..\xlsbiff5.pas"/> <Filename Value="..\..\xlsbiff5.pas"/>
<UnitName Value="xlsbiff5"/> <UnitName Value="xlsbiff5"/>
<CursorPos X="1" Y="224"/> <CursorPos X="1" Y="224"/>
<TopLine Value="215"/> <TopLine Value="215"/>
<EditorIndex Value="3"/> <EditorIndex Value="3"/>
<UsageCount Value="61"/> <UsageCount Value="83"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit12> </Unit8>
<Unit13> <Unit9>
<Filename Value="..\..\fpsutils.pas"/> <Filename Value="..\..\fpsutils.pas"/>
<UnitName Value="fpsutils"/> <UnitName Value="fpsutils"/>
<CursorPos X="1" Y="49"/> <CursorPos X="1" Y="49"/>
<TopLine Value="30"/> <TopLine Value="30"/>
<EditorIndex Value="2"/> <EditorIndex Value="2"/>
<UsageCount Value="61"/> <UsageCount Value="83"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit13> </Unit9>
<Unit14> <Unit10>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<UnitName Value="xlsbiff2"/> <UnitName Value="xlsbiff2"/>
<CursorPos X="1" Y="69"/> <CursorPos X="1" Y="69"/>
<TopLine Value="57"/> <TopLine Value="57"/>
<EditorIndex Value="4"/> <EditorIndex Value="4"/>
<UsageCount Value="61"/> <UsageCount Value="83"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="..\..\fpolestorage.pas"/>
<UnitName Value="fpolestorage"/>
<CursorPos X="48" Y="534"/>
<TopLine Value="520"/>
<EditorIndex Value="5"/>
<UsageCount Value="83"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="..\..\..\..\..\lazarus26\fpc\2.2.2\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="19" Y="562"/>
<TopLine Value="553"/>
<UsageCount Value="53"/>
</Unit12>
<Unit13>
<Filename Value="..\..\..\..\..\lazarus26\fpc\2.2.2\source\rtl\objpas\classes\streams.inc"/>
<CursorPos X="21" Y="158"/>
<TopLine Value="151"/>
<UsageCount Value="53"/>
</Unit13>
<Unit14>
<Filename Value="..\..\fpspreadsheet.pas"/>
<UnitName Value="fpspreadsheet"/>
<CursorPos X="40" Y="137"/>
<TopLine Value="129"/>
<EditorIndex Value="1"/>
<UsageCount Value="33"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit14> </Unit14>
<Unit15> <Unit15>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\..\..\..\lazarus26\fpc\2.2.2\source\rtl\objpas\classes\stringl.inc"/>
<UnitName Value="fpolestorage"/> <CursorPos X="20" Y="768"/>
<CursorPos X="37" Y="381"/> <TopLine Value="761"/>
<TopLine Value="367"/> <UsageCount Value="10"/>
<EditorIndex Value="5"/>
<UsageCount Value="61"/>
<Loaded Value="True"/>
</Unit15> </Unit15>
<Unit16>
<Filename Value="..\..\..\..\..\lazarus26\fpc\2.2.2\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="17" Y="724"/>
<TopLine Value="714"/>
<EditorIndex Value="6"/>
<UsageCount Value="31"/>
<Loaded Value="True"/>
</Unit16>
<Unit17>
<Filename Value="..\..\..\..\..\lazarus26\fpc\2.2.2\source\rtl\objpas\classes\streams.inc"/>
<CursorPos X="1" Y="159"/>
<TopLine Value="151"/>
<EditorIndex Value="7"/>
<UsageCount Value="31"/>
<Loaded Value="True"/>
</Unit17>
<Unit18>
<Filename Value="..\..\fpspreadsheet.pas"/>
<UnitName Value="fpspreadsheet"/>
<CursorPos X="1" Y="319"/>
<TopLine Value="309"/>
<EditorIndex Value="1"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit18>
</Units> </Units>
<JumpHistory Count="30" HistoryIndex="29"> <JumpHistory Count="27" HistoryIndex="26">
<Position1> <Position1>
<Filename Value="..\..\fpsutils.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="45" Column="5" TopLine="26"/> <Caret Line="246" Column="12" TopLine="237"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="150" Column="5" TopLine="131"/> <Caret Line="79" Column="16" TopLine="78"/>
</Position2> </Position2>
<Position3> <Position3>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\xlsbiff5.pas"/>
<Caret Line="191" Column="5" TopLine="172"/> <Caret Line="87" Column="16" TopLine="77"/>
</Position3> </Position3>
<Position4> <Position4>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\xlsbiff5.pas"/>
<Caret Line="49" Column="15" TopLine="39"/> <Caret Line="218" Column="24" TopLine="207"/>
</Position4> </Position4>
<Position5> <Position5>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="331" Column="45" TopLine="326"/> <Caret Line="235" Column="30" TopLine="224"/>
</Position5> </Position5>
<Position6> <Position6>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="24" Column="27" TopLine="19"/> <Caret Line="80" Column="28" TopLine="68"/>
</Position6> </Position6>
<Position7> <Position7>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="247" Column="1" TopLine="229"/> <Caret Line="40" Column="5" TopLine="31"/>
</Position7> </Position7>
<Position8> <Position8>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="224" Column="5" TopLine="205"/> <Caret Line="472" Column="49" TopLine="461"/>
</Position8> </Position8>
<Position9> <Position9>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="231" Column="1" TopLine="219"/> <Caret Line="405" Column="5" TopLine="386"/>
</Position9> </Position9>
<Position10> <Position10>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="377" Column="5" TopLine="358"/> <Caret Line="404" Column="14" TopLine="401"/>
</Position10> </Position10>
<Position11> <Position11>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="225" Column="1" TopLine="211"/> <Caret Line="79" Column="42" TopLine="72"/>
</Position11> </Position11>
<Position12> <Position12>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="246" Column="12" TopLine="237"/> <Caret Line="78" Column="31" TopLine="67"/>
</Position12> </Position12>
<Position13> <Position13>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="79" Column="16" TopLine="78"/> <Caret Line="314" Column="39" TopLine="296"/>
</Position13> </Position13>
<Position14> <Position14>
<Filename Value="..\..\xlsbiff5.pas"/> <Filename Value="excel5demo.lpr"/>
<Caret Line="87" Column="16" TopLine="77"/> <Caret Line="34" Column="1" TopLine="25"/>
</Position14> </Position14>
<Position15> <Position15>
<Filename Value="..\..\xlsbiff5.pas"/> <Filename Value="excel5demo.lpr"/>
<Caret Line="218" Column="24" TopLine="207"/> <Caret Line="35" Column="1" TopLine="25"/>
</Position15> </Position15>
<Position16> <Position16>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="235" Column="30" TopLine="224"/> <Caret Line="479" Column="1" TopLine="469"/>
</Position16> </Position16>
<Position17> <Position17>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="80" Column="28" TopLine="68"/> <Caret Line="470" Column="1" TopLine="460"/>
</Position17> </Position17>
<Position18> <Position18>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\xlsbiff5.pas"/>
<Caret Line="40" Column="5" TopLine="31"/> <Caret Line="217" Column="3" TopLine="205"/>
</Position18> </Position18>
<Position19> <Position19>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\xlsbiff5.pas"/>
<Caret Line="472" Column="49" TopLine="461"/> <Caret Line="218" Column="23" TopLine="208"/>
</Position19> </Position19>
<Position20> <Position20>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="405" Column="5" TopLine="386"/> <Caret Line="78" Column="10" TopLine="66"/>
</Position20> </Position20>
<Position21> <Position21>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="404" Column="14" TopLine="401"/> <Caret Line="375" Column="1" TopLine="367"/>
</Position21> </Position21>
<Position22> <Position22>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="79" Column="42" TopLine="72"/> <Caret Line="76" Column="17" TopLine="65"/>
</Position22> </Position22>
<Position23> <Position23>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="78" Column="31" TopLine="67"/> <Caret Line="363" Column="1" TopLine="357"/>
</Position23> </Position23>
<Position24> <Position24>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="314" Column="39" TopLine="296"/> <Caret Line="77" Column="7" TopLine="76"/>
</Position24> </Position24>
<Position25> <Position25>
<Filename Value="excel5demo.lpr"/> <Filename Value="excel5demo.lpr"/>
<Caret Line="34" Column="1" TopLine="25"/> <Caret Line="67" Column="21" TopLine="51"/>
</Position25> </Position25>
<Position26> <Position26>
<Filename Value="excel5demo.lpr"/> <Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="35" Column="1" TopLine="25"/> <Caret Line="137" Column="40" TopLine="129"/>
</Position26> </Position26>
<Position27> <Position27>
<Filename Value="..\..\fpolestorage.pas"/> <Filename Value="excel5demo.lpr"/>
<Caret Line="479" Column="1" TopLine="469"/> <Caret Line="21" Column="8" TopLine="6"/>
</Position27> </Position27>
<Position28>
<Filename Value="..\..\fpolestorage.pas"/>
<Caret Line="470" Column="1" TopLine="460"/>
</Position28>
<Position29>
<Filename Value="..\..\xlsbiff5.pas"/>
<Caret Line="217" Column="3" TopLine="205"/>
</Position29>
<Position30>
<Filename Value="..\..\xlsbiff5.pas"/>
<Caret Line="218" Column="23" TopLine="208"/>
</Position30>
</JumpHistory> </JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

View File

@ -17,6 +17,8 @@ var
MyWorksheet: TsWorksheet; MyWorksheet: TsWorksheet;
MyFormula: TRPNFormula; MyFormula: TRPNFormula;
MyDir: string; MyDir: string;
i: Integer;
a: TStringList;
begin begin
// Open the output file // Open the output file
MyDir := ExtractFilePath(ParamStr(0)); MyDir := ExtractFilePath(ParamStr(0));
@ -31,6 +33,16 @@ begin
MyWorksheet.WriteNumber(0, 2, 3.0); MyWorksheet.WriteNumber(0, 2, 3.0);
MyWorksheet.WriteNumber(0, 3, 4.0); MyWorksheet.WriteNumber(0, 3, 4.0);
{ Uncommend this to test large XLS files
for i := 2 to 20 do
begin
MyWorksheet.WriteAnsiText(i, 0, ParamStr(0));
MyWorksheet.WriteAnsiText(i, 1, ParamStr(0));
MyWorksheet.WriteAnsiText(i, 2, ParamStr(0));
MyWorksheet.WriteAnsiText(i, 3, ParamStr(0));
end;
}
// Write the formula E1 = A1 + B1 // Write the formula E1 = A1 + B1
// or, in RPN: A1, B1, + // or, in RPN: A1, B1, +
SetLength(MyFormula, 3); SetLength(MyFormula, 3);

View File

@ -0,0 +1,3 @@
del test.xls
excel5demo.exe
pause

View File

@ -75,7 +75,7 @@ type
procedure WriteDirectoryStream(AStream: TStream); procedure WriteDirectoryStream(AStream: TStream);
procedure WriteDirectoryEntry(AStream: TStream; AName: widestring; procedure WriteDirectoryEntry(AStream: TStream; AName: widestring;
EntryType, EntryColor: Byte; AIsStorage: Boolean; EntryType, EntryColor: Byte; AIsStorage: Boolean;
AStreamSize: Cardinal); AFirstSecID, AStreamSize: Cardinal);
procedure WriteShortSectorAllocationTable(AStream: TStream); procedure WriteShortSectorAllocationTable(AStream: TStream);
procedure WriteUserStream(ADest, ASource: TStream); procedure WriteUserStream(ADest, ASource: TStream);
public public
@ -193,7 +193,7 @@ begin
end; end;
{ {
The file is organized as following: The file is organized as following using Short Sectors:
HEADER HEADER
SECTOR 0 - SAT SECTOR 0 - SAT
@ -211,6 +211,13 @@ end;
As expected, sector 0 is marked with the special SAT SecID (3.1). As expected, sector 0 is marked with the special SAT SecID (3.1).
Sector 1 and all sectors starting with sector 5 are Sector 1 and all sectors starting with sector 5 are
not used (special Free SecID with value 1). not used (special Free SecID with value 1).
Without Short Sectors the file will be similar, but more compact:
HEADER
SECTOR 0 - SAT
SECTOR 1 - Directory stream
SECTOR 2 and on - User data
} }
procedure TOLEStorage.WriteSectorAllocationTable(AStream: TStream); procedure TOLEStorage.WriteSectorAllocationTable(AStream: TStream);
var var
@ -225,14 +232,22 @@ begin
AStream.WriteDWord(DWordToLE($FFFFFFFD)); // SAT AStream.WriteDWord(DWordToLE($FFFFFFFD)); // SAT
AStream.WriteDWord($FFFFFFFF); // Empty AStream.WriteDWord($FFFFFFFF); // Empty
AStream.WriteDWord(DWordToLE($FFFFFFFE)); // Start and End of Short SAT
// If we don't use short sectors we won't write a section for their SSAT
if FUseShortSectors then
begin
AStream.WriteDWord(DWordToLE($FFFFFFFE)); // Start and End of Short SAT
CurrentPos := $200 + 12; CurrentPos := $200 + 12;
NextSecID := $00000004;
end
else
begin
CurrentPos := $200 + 8;
NextSecID := $00000003;
end;
// Now write the user data // Now write the user data
NextSecID := $00000004;
for i := 2 to FNumStreamSectors do for i := 2 to FNumStreamSectors do
begin begin
AStream.WriteDWord(DWordToLE(NextSecID)); AStream.WriteDWord(DWordToLE(NextSecID));
@ -257,7 +272,7 @@ dir_entry_pos(DirID) = DirID ∙ 128
} }
procedure TOLEStorage.WriteDirectoryEntry(AStream: TStream; AName: widestring; procedure TOLEStorage.WriteDirectoryEntry(AStream: TStream; AName: widestring;
EntryType, EntryColor: Byte; AIsStorage: Boolean; EntryType, EntryColor: Byte; AIsStorage: Boolean;
AStreamSize: Cardinal); AFirstSecID, AStreamSize: Cardinal);
var var
i: Integer; i: Integer;
EntryName: array[0..31] of WideChar; EntryName: array[0..31] of WideChar;
@ -345,9 +360,9 @@ begin
First 4 bytes still with the timestamp. First 4 bytes still with the timestamp.
116 4 SecID of first sector or short-sector, if this entry refers to a stream (7.2.2), SecID of first 116 4 SecID of first sector or short-sector, if this entry refers to a stream (7.2.2),
sector of the short-stream container stream (6.1), if this is the root storage entry, 0 SecID of first sector of the short-stream container stream (6.1),
otherwise if this is the root storage entry, 0 otherwise
120 4 Total stream size in bytes, if this entry refers to a stream (7.2.2), 120 4 Total stream size in bytes, if this entry refers to a stream (7.2.2),
total size of the short-stream container stream (6.1), total size of the short-stream container stream (6.1),
@ -356,8 +371,7 @@ begin
124 4 Not used 124 4 Not used
} }
if AIsStorage then AStream.WriteDWord(DWordToLE($00000003)) AStream.WriteDWord(DWordToLE(AFirstSecID));
else AStream.WriteDWord(0);
AStream.WriteDWord(DWordToLE(AStreamSize)); AStream.WriteDWord(DWordToLE(AStreamSize));
@ -372,21 +386,42 @@ begin
FContainerSize := Ceil(FOLEDocument.Stream.Size / INT_OLE_SECTOR_SIZE) * INT_OLE_SECTOR_SIZE; FContainerSize := Ceil(FOLEDocument.Stream.Size / INT_OLE_SECTOR_SIZE) * INT_OLE_SECTOR_SIZE;
if FUseShortSectors then
begin
WriteDirectoryEntry(AStream, 'Root Entry'#0, WriteDirectoryEntry(AStream, 'Root Entry'#0,
INT_OLE_DIR_ENTRY_TYPE_ROOT_STORAGE, INT_OLE_DIR_COLOR_RED, INT_OLE_DIR_ENTRY_TYPE_ROOT_STORAGE, INT_OLE_DIR_COLOR_RED,
True, FContainerSize); True, $00000003, FContainerSize);
WriteDirectoryEntry(AStream, 'Book'#0, WriteDirectoryEntry(AStream, 'Book'#0,
INT_OLE_DIR_ENTRY_TYPE_USER_STREAM, INT_OLE_DIR_COLOR_BLACK, INT_OLE_DIR_ENTRY_TYPE_USER_STREAM, INT_OLE_DIR_COLOR_BLACK,
False, FOLEDocument.Stream.Size); False, 0, FOLEDocument.Stream.Size);
WriteDirectoryEntry(AStream, #0, WriteDirectoryEntry(AStream, #0,
INT_OLE_DIR_ENTRY_TYPE_EMPTY, INT_OLE_DIR_COLOR_RED, INT_OLE_DIR_ENTRY_TYPE_EMPTY, INT_OLE_DIR_COLOR_RED,
False, $00000000); False, 0, $00000000);
WriteDirectoryEntry(AStream, #0, WriteDirectoryEntry(AStream, #0,
INT_OLE_DIR_ENTRY_TYPE_EMPTY, INT_OLE_DIR_COLOR_RED, INT_OLE_DIR_ENTRY_TYPE_EMPTY, INT_OLE_DIR_COLOR_RED,
False, $00000000); False, 0, $00000000);
end
else
begin
WriteDirectoryEntry(AStream, 'Root Entry'#0,
INT_OLE_DIR_ENTRY_TYPE_ROOT_STORAGE, INT_OLE_DIR_COLOR_RED,
True, $FFFFFFFE, 0);
WriteDirectoryEntry(AStream, 'Book'#0,
INT_OLE_DIR_ENTRY_TYPE_USER_STREAM, INT_OLE_DIR_COLOR_BLACK,
False, $00000002, FOLEDocument.Stream.Size);
WriteDirectoryEntry(AStream, #0,
INT_OLE_DIR_ENTRY_TYPE_EMPTY, INT_OLE_DIR_COLOR_RED,
False, 0, $00000000);
WriteDirectoryEntry(AStream, #0,
INT_OLE_DIR_ENTRY_TYPE_EMPTY, INT_OLE_DIR_COLOR_RED,
False, 0, $00000000);
end;
end; end;
{ {
@ -496,7 +531,8 @@ begin
{$else} {$else}
AFileStream := TFileStream.Create(AFileName, fmOpenWrite or fmCreate); // Follows the behavior of LCL classes: Fails to write to existing file
AFileStream := TFileStream.Create(AFileName, fmCreate);
try try
// Header // Header
WriteOLEHeader(AFileStream); WriteOLEHeader(AFileStream);
@ -508,9 +544,9 @@ begin
WriteDirectoryStream(AFileStream); WriteDirectoryStream(AFileStream);
// Record 2, the Short SAT // Record 2, the Short SAT
WriteShortSectorAllocationTable(AFileStream); if FUseShortSectors then WriteShortSectorAllocationTable(AFileStream);
// Records 3 and on, the user data // Records 3 and on (or 2 and on without Short Sectors), the user data
WriteUserStream(AFileStream, FOLEDocument.Stream); WriteUserStream(AFileStream, FOLEDocument.Stream);
finally finally
AFileStream.Free; AFileStream.Free;