Patch from Joshy, implements initial biff 8 support

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@782 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2009-04-21 15:08:43 +00:00
parent 8d5feeb061
commit 119b9f0bd4
4 changed files with 933 additions and 156 deletions

View File

@ -36,7 +36,7 @@ unit fpolestorage;
interface interface
{$ifdef Windows} {$ifdef Windows}
{.$define FPOLESTORAGE_USE_COM} {$define FPOLESTORAGE_USE_COM}
{$endif} {$endif}
uses uses
@ -75,7 +75,8 @@ type
{ Writer Helper routines } { Writer Helper routines }
procedure WriteOLEHeader(AStream: TStream); procedure WriteOLEHeader(AStream: TStream);
procedure WriteSectorAllocationTable(AStream: TStream); procedure WriteSectorAllocationTable(AStream: TStream);
procedure WriteDirectoryStream(AStream: TStream); procedure WriteDirectoryStream(AStream: TStream;
const ABookStreamName: string='Book');
procedure WriteDirectoryEntry(AStream: TStream; AName: widestring; procedure WriteDirectoryEntry(AStream: TStream; AName: widestring;
EntryType, EntryColor: Byte; AIsStorage: Boolean; EntryType, EntryColor: Byte; AIsStorage: Boolean;
AFirstSecID, AStreamSize: Cardinal); AFirstSecID, AStreamSize: Cardinal);
@ -93,7 +94,7 @@ type
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure WriteOLEFile(AFileName: string; AOLEDocument: TOLEDocument); procedure WriteOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AStreamName: UTF8String='Book');
procedure ReadOLEFile(AFileName: string; AOLEDocument: TOLEDocument); procedure ReadOLEFile(AFileName: string; AOLEDocument: TOLEDocument);
procedure FreeOLEDocumentData(AOLEDocument: TOLEDocument); procedure FreeOLEDocumentData(AOLEDocument: TOLEDocument);
end; end;
@ -195,7 +196,7 @@ begin
{ 68 4 SecID of first sector of the master sector allocation table (➜5.1), or –2 (End Of Chain { 68 4 SecID of first sector of the master sector allocation table (➜5.1), or –2 (End Of Chain
SecID, ➜3.1) if no additional sectors used } SecID, ➜3.1) if no additional sectors used }
AStream.WriteDWord(IntegerToLE(-2)); AStream.WriteDWord(DWORD(IntegerToLE(-2)));
{ 72 4 Total number of sectors used for the master sector allocation table (➜5.1) } { 72 4 Total number of sectors used for the master sector allocation table (➜5.1) }
AStream.WriteDWord(0); AStream.WriteDWord(0);
@ -392,7 +393,7 @@ begin
AStream.WriteDWord(DWordToLE($00000000)); AStream.WriteDWord(DWordToLE($00000000));
end; end;
procedure TOLEStorage.WriteDirectoryStream(AStream: TStream); procedure TOLEStorage.WriteDirectoryStream(AStream: TStream; const ABookStreamName: string='Book');
var var
FContainerSize: Cardinal; FContainerSize: Cardinal;
begin begin
@ -406,7 +407,7 @@ begin
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, $00000003, FContainerSize); True, $00000003, FContainerSize);
WriteDirectoryEntry(AStream, 'Book'#0, WriteDirectoryEntry(AStream, ABookStreamName+#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, 0, FOLEDocument.Stream.Size); False, 0, FOLEDocument.Stream.Size);
@ -424,7 +425,7 @@ begin
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, $FFFFFFFE, 0); True, $FFFFFFFE, 0);
WriteDirectoryEntry(AStream, 'Book'#0, WriteDirectoryEntry(AStream, ABookStreamName+#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, $00000002, FOLEDocument.Stream.Size); False, $00000002, FOLEDocument.Stream.Size);
@ -688,7 +689,8 @@ end;
if the file already exists, or if the directory where if the file already exists, or if the directory where
it should be placed doesn't exist. it should be placed doesn't exist.
} }
procedure TOLEStorage.WriteOLEFile(AFileName: string; AOLEDocument: TOLEDocument); procedure TOLEStorage.WriteOLEFile(AFileName: string;
AOLEDocument: TOLEDocument; const AStreamName: UTF8String);
var var
cbWritten: Cardinal; cbWritten: Cardinal;
AFileStream: TFileStream; AFileStream: TFileStream;
@ -722,8 +724,9 @@ begin
0, FStorage)); 0, FStorage));
{ Create a workbook stream in the storage. A BIFF5 file must { Create a workbook stream in the storage. A BIFF5 file must
have at least a workbook stream. This stream *must* be named 'Book' } have at least a workbook stream. This stream *must* be named 'Book',
OleCheck(FStorage.CreateStream('Book', in BIFF8 it is 'Workbook', so use AStreamName }
OleCheck(FStorage.CreateStream(PWideChar(UTF8Decode(AStreamName)),
STGM_READWRITE or STGM_SHARE_EXCLUSIVE or STGM_DIRECT, 0, 0, FStream)); STGM_READWRITE or STGM_SHARE_EXCLUSIVE or STGM_DIRECT, 0, 0, FStream));
{ Write all data } { Write all data }
@ -733,6 +736,7 @@ begin
{$else} {$else}
// Follows the behavior of LCL classes: Fails to write to existing file // Follows the behavior of LCL classes: Fails to write to existing file
if FileExists(AFileName) then Raise EStreamError.Createfmt('File already exists "%s"',[AFileName]);
AFileStream := TFileStream.Create(AFileName, fmCreate); AFileStream := TFileStream.Create(AFileName, fmCreate);
try try
// Header // Header
@ -742,7 +746,7 @@ begin
WriteSectorAllocationTable(AFileStream); WriteSectorAllocationTable(AFileStream);
// Record 1, the directory stream // Record 1, the directory stream
WriteDirectoryStream(AFileStream); WriteDirectoryStream(AFileStream,AStreamName);
// Record 2, the Short SAT // Record 2, the Short SAT
if FUseShortSectors then WriteShortSectorAllocationTable(AFileStream); if FUseShortSectors then WriteShortSectorAllocationTable(AFileStream);

View File

@ -10,9 +10,11 @@ uses
function WordToLE(AValue: Word): Word; function WordToLE(AValue: Word): Word;
function DWordToLE(AValue: Cardinal): Cardinal; function DWordToLE(AValue: Cardinal): Cardinal;
function IntegerToLE(AValue: Integer): Integer; function IntegerToLE(AValue: Integer): Integer;
function WideStringToLE(const AValue: WideString): WideString;
function WordLEtoN(AValue: Word): Word; function WordLEtoN(AValue: Word): Word;
function DWordLEtoN(AValue: Cardinal): Cardinal; function DWordLEtoN(AValue: Cardinal): Cardinal;
function WideStringLEToN(const AValue: WideString): WideString;
implementation implementation
@ -76,5 +78,41 @@ begin
{$ENDIF} {$ENDIF}
end; end;
function WideStringToLE(const AValue: WideString): WideString;
var
j: integer;
begin
{$IFDEF FPC}
{$IFDEF FPC_LITTLE_ENDIAN}
Result:=AValue;
{$ELSE}
Result:=AValue;
for j := 1 to Length(AValue) do begin
PWORD(@Result[j])^:=NToLE(PWORD(@Result[j])^);
end;
{$ENDIF}
{$ELSE}
Result:=AValue;
{$ENDIF}
end;
function WideStringLEToN(const AValue: WideString): WideString;
var
j: integer;
begin
{$IFDEF FPC}
{$IFDEF FPC_LITTLE_ENDIAN}
Result:=AValue;
{$ELSE}
Result:=AValue;
for j := 1 to Length(AValue) do begin
PWORD(@Result[j])^:=LEToN(PWORD(@Result[j])^);
end;
{$ENDIF}
{$ELSE}
Result:=AValue;
{$ENDIF}
end;
end. end.

View File

@ -661,9 +661,16 @@ var
L: Word; L: Word;
AnsiValue: ansistring; AnsiValue: ansistring;
begin begin
if AValue = '' then Exit; // Writing an empty text doesn't work
AnsiValue := UTF8ToAnsi(AValue); AnsiValue := UTF8ToAnsi(AValue);
if AnsiValue = '' then
begin
// Bad formatted UTF8String (maybe ANSI?)
if Length(AValue)<>0 then begin
//It was an ANSI string written as UTF8 quite sure, so raise exception.
Raise Exception.CreateFmt('Expected UTF8 text but probably ANSI text found in cell [%d,%d]',[ARow,ACol]);
end;
Exit;
end;
L := Length(AnsiValue); L := Length(AnsiValue);
{ BIFF Record header } { BIFF Record header }

File diff suppressed because it is too large Load Diff