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

Adopted new WriteToFile parameters and better handling of open OLE streams.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1003 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
Joshy
2009-11-12 20:28:21 +00:00
parent 8c0fa3a08d
commit 707600eeba
1 changed files with 32 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

46
components/fpspreadsheet/fpolebasic.pas
View File

@ -30,7 +30,7 @@ type
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure WriteOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AStreamName: UTF8String='Book'); procedure WriteOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AOverwriteExisting: Boolean = False; const AStreamName: UTF8String='Book');
procedure ReadOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AStreamName: UTF8String='Book'); procedure ReadOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AStreamName: UTF8String='Book');
procedure FreeOLEDocumentData(AOLEDocument: TOLEDocument); procedure FreeOLEDocumentData(AOLEDocument: TOLEDocument);
end; end;
@ -54,7 +54,8 @@ end;
it should be placed doesn't exist. it should be placed doesn't exist.
} }
procedure TOLEStorage.WriteOLEFile(AFileName: string; procedure TOLEStorage.WriteOLEFile(AFileName: string;
AOLEDocument: TOLEDocument; const AStreamName: UTF8String); AOLEDocument: TOLEDocument; const AOverwriteExisting: Boolean;
const AStreamName: UTF8String);
var var
RealFile: TFileStream; RealFile: TFileStream;
fsOLE: TVirtualLayer_OLE; fsOLE: TVirtualLayer_OLE;
@ -62,6 +63,9 @@ var
VLAbsolutePath: UTF8String; VLAbsolutePath: UTF8String;
begin begin
VLAbsolutePath:='/'+AStreamName; //Virtual layer always use absolute paths. VLAbsolutePath:='/'+AStreamName; //Virtual layer always use absolute paths.
if not AOverwriteExisting and FileExists(AFileName) then begin
Raise EStreamError.Createfmt('File already exists "%s"',[AFileName]);
end;
RealFile:=TFileStream.Create(AFileName,fmCreate); RealFile:=TFileStream.Create(AFileName,fmCreate);
fsOLE:=TVirtualLayer_OLE.Create(RealFile); fsOLE:=TVirtualLayer_OLE.Create(RealFile);
fsOLE.Format(); //Initialize and format the OLE container. fsOLE.Format(); //Initialize and format the OLE container.
@ -85,19 +89,33 @@ var
VLAbsolutePath: UTF8String; VLAbsolutePath: UTF8String;
begin begin
VLAbsolutePath:='/'+AStreamName; //Virtual layer always use absolute paths. VLAbsolutePath:='/'+AStreamName; //Virtual layer always use absolute paths.
RealFile:=TFileStream.Create(AFileName,fmOpenRead); try
fsOLE:=TVirtualLayer_OLE.Create(RealFile); RealFile:=nil;
fsOLE.Initialize(); //Initialize the OLE container. RealFile:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
OLEStream:=fsOLE.CreateStream(VLAbsolutePath,fmOpenRead); try
if not Assigned(AOLEDocument.Stream) then begin fsOLE:=nil;
AOLEDocument.Stream:=TMemoryStream.Create; fsOLE:=TVirtualLayer_OLE.Create(RealFile);
end else begin fsOLE.Initialize(); //Initialize the OLE container.
AOLEDocument.Stream.Clear; try
OLEStream:=nil;
OLEStream:=fsOLE.CreateStream(VLAbsolutePath,fmOpenRead);
if Assigned(OLEStream) then begin
if not Assigned(AOLEDocument.Stream) then begin
AOLEDocument.Stream:=TMemoryStream.Create;
end else begin
AOLEDocument.Stream.Clear;
end;
AOLEDocument.Stream.CopyFrom(OLEStream,OLEStream.Size);
end;
finally
OLEStream.Free;
end;
finally
fsOLE.Free;
end;
finally
RealFile.Free;
end; end;
AOLEDocument.Stream.CopyFrom(OLEStream,OLEStream.Size);
OLEStream.Free;
fsOLE.Free;
RealFile.Free;
end; end;
{@@ {@@