lazarus-ccr/components/fpspreadsheet/uvirtuallayer_stream.pas
Joshy 181a1e0a98 New implementation to read and write OLE documents (Excel BIFF 5 & 8).
Now BIFF 5 & 8 should be possible to be generated in non Windows environment but this fact has not been tested.
To use the older mode replace uses "fpolebasic" by "fpolestorage".
Extensive tests are needed.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@792 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2009-05-09 15:41:38 +00:00

112 lines
2.8 KiB
ObjectPascal

unit uvirtuallayer_stream;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uvirtuallayer_types;
type
{ TVirtualLayer_Stream }
TVirtualLayer_Stream=class(TStream)
private
FRootVirtualLayer: Pointer;
FHandle: TvlHandle;
protected
FFilename: UTF8String;
function GetPosition: Int64; override;
procedure SetPosition(const Pos: Int64); override;
{ function GetSize: Int64; virtual;
procedure SetSize64(const NewSize: Int64); virtual;
procedure SetSize(NewSize: Longint); virtual;overload;
procedure SetSize(const NewSize: Int64); virtual;overload;
}
public
property Filename: UTF8String Read FFilename;
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override; overload;
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; overload;
Constructor Create(const AVirtualLayer: Pointer; const AFileName: UTF8String;const AMode: cardinal);
Destructor Destroy(); override;
end;
implementation
uses uvirtuallayer;
function VL(L: Pointer): TVirtualLayer; inline;
begin
Result:=TVirtualLayer(L);
end;
{ TVirtualLayer_Stream }
function TVirtualLayer_Stream.GetPosition: Int64;
begin
Result:=VL(FRootVirtualLayer).Seek(FHandle,0,fsFromCurrent);
end;
procedure TVirtualLayer_Stream.SetPosition(const Pos: Int64);
var
NewPos: int64;
begin
NewPos:=VL(FRootVirtualLayer).Seek(FHandle,Pos,fsFromBeginning);
if NewPos<0 Then begin
//Raise exception ??? which one :-?
end;
end;
function TVirtualLayer_Stream.Read(var Buffer; Count: Longint): Longint;
begin
Result:=VL(FRootVirtualLayer).Read(FHandle,@Buffer,Count);
end;
function TVirtualLayer_Stream.Write(const Buffer; Count: Longint): Longint;
begin
Result:=VL(FRootVirtualLayer).Write(FHandle,@Buffer,Count);
end;
function TVirtualLayer_Stream.Seek(Offset: Longint; Origin: Word): Longint;
begin
Result:=VL(FRootVirtualLayer).Seek(FHandle,Offset,Origin);
end;
function TVirtualLayer_Stream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
var
Org: Word;
begin
Case Origin of
soCurrent: Org:=fsFromCurrent;
soEnd: Org:=fsFromEnd;
soBeginning:Org:=fsFromBeginning;
end;
Result:=VL(FRootVirtualLayer).Seek(FHandle,Offset,Org);
end;
constructor TVirtualLayer_Stream.Create(const AVirtualLayer: Pointer;
const AFileName: UTF8String; const AMode: cardinal);
begin
FRootVirtualLayer:=AVirtualLayer;
FHandle:=VL(FRootVirtualLayer).OpenFile(AFileName,AMode);
if FHandle=nil Then begin
Raise EStreamError.Create('Unable to open '+AFileName);
end;
FFilename:=AFileName;
end;
destructor TVirtualLayer_Stream.Destroy();
begin
if FHandle<>nil Then begin
VL(FRootVirtualLayer).CloseFile(FHandle);
end;
inherited Destroy();
end;
end.