You've already forked lazarus-ccr
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:
@ -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);
|
||||||
|
@ -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.
|
||||||
|
|
||||||
|
@ -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
Reference in New Issue
Block a user