1404 lines
40 KiB
ObjectPascal
1404 lines
40 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is JclStreams.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Robert Marquardt. Portions created by }
|
|
{ Robert Marquardt are Copyright (C) Robert Marquardt (robert_marquardt att gmx dott de) }
|
|
{ All rights reserved. }
|
|
{ }
|
|
{ Contributors: }
|
|
{ Florent Ouchet (outchy) }
|
|
{ Heinz Zastrau }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
// Last modified: $Date: 2006-12-30 10:04:59 +0100 (sam., 30 déc. 2006) $
|
|
|
|
unit JclStreams;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
{$IFDEF MSWINDOWS}
|
|
Windows,
|
|
{$ENDIF MSWINDOWS}
|
|
{$IFDEF LINUX}
|
|
Libc,
|
|
{$ENDIF LINUX}
|
|
SysUtils, Classes,
|
|
JclBase;
|
|
|
|
type
|
|
{$IFDEF COMPILER5}
|
|
TSeekOrigin = (soBeginning, soCurrent, soEnd);
|
|
{$ENDIF COMPILER5}
|
|
|
|
EJclStreamError = class(EJclError);
|
|
|
|
// abstraction layer to support Delphi 5 and C++Builder 5 streams
|
|
// 64 bit version of overloaded functions are introduced
|
|
TJclStream = class(TStream)
|
|
protected
|
|
procedure SetSize(NewSize: Longint); overload; override;
|
|
procedure SetSize(const NewSize: Int64);
|
|
{$IFDEF COMPILER5} reintroduce; overload; virtual; {$ELSE} overload; override; {$ENDIF}
|
|
public
|
|
function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
|
|
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
|
{$IFDEF COMPILER5} reintroduce; overload; virtual; {$ELSE} overload; override; {$ENDIF}
|
|
end;
|
|
|
|
//=== VCL stream replacements ===
|
|
|
|
TJclHandleStream = class(TJclStream)
|
|
private
|
|
FHandle: THandle;
|
|
protected
|
|
procedure SetSize(NewSize: Longint); override;
|
|
procedure SetSize(const NewSize: Int64); override;
|
|
public
|
|
constructor Create(AHandle: THandle); virtual;
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
|
|
property Handle: THandle read FHandle;
|
|
end;
|
|
|
|
TJclFileStream = class(TJclHandleStream)
|
|
public
|
|
constructor Create(const FileName: string; Mode: Word; Rights: Cardinal = 0); reintroduce; virtual;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{
|
|
TJclCustomMemoryStream = class(TJclStream)
|
|
end;
|
|
|
|
TJclMemoryStream = class(TJclCustomMemoryStream)
|
|
end;
|
|
|
|
TJclStringStream = class(TJclStream)
|
|
end;
|
|
|
|
TJclResourceStream = class(TJclCustomMemoryStream)
|
|
end;
|
|
}
|
|
|
|
//=== new stream ideas ===
|
|
|
|
TJclEmptyStream = class(TJclStream)
|
|
protected
|
|
procedure SetSize(NewSize: Longint); overload; override;
|
|
procedure SetSize(const NewSize: Int64); overload; override;
|
|
public
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
|
|
end;
|
|
|
|
TJclNullStream = class(TJclStream)
|
|
private
|
|
FPosition: Int64;
|
|
FSize: Int64;
|
|
protected
|
|
procedure SetSize(const NewSize: Int64); override;
|
|
public
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
|
|
end;
|
|
|
|
TJclRandomStream = class(TJclNullStream)
|
|
protected
|
|
function GetRandSeed: Longint; virtual;
|
|
procedure SetRandSeed(Seed: Longint); virtual;
|
|
public
|
|
function RandomData: Byte; virtual;
|
|
procedure Randomize; dynamic;
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|
property RandSeed: Longint read GetRandSeed write SetRandSeed;
|
|
end;
|
|
|
|
TJclMultiplexStream = class(TJclStream)
|
|
private
|
|
FStreams: TList;
|
|
FReadStreamIndex: Integer;
|
|
function GetStream(Index: Integer): TStream;
|
|
function GetCount: Integer;
|
|
procedure SetStream(Index: Integer; const Value: TStream);
|
|
function GetReadStream: TStream;
|
|
procedure SetReadStream(const Value: TStream);
|
|
procedure SetReadStreamIndex(const Value: Integer);
|
|
protected
|
|
procedure SetSize(const NewSize: Int64); override;
|
|
public
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
|
|
|
|
function Add(NewStream: TStream): Integer;
|
|
procedure Clear;
|
|
function Remove(AStream: TStream): Integer;
|
|
procedure Delete(const Index: Integer);
|
|
|
|
property Streams[Index: Integer]: TStream read GetStream write SetStream;
|
|
property ReadStreamIndex: Integer read FReadStreamIndex write SetReadStreamIndex;
|
|
property ReadStream: TStream read GetReadStream write SetReadStream;
|
|
property Count: Integer read GetCount;
|
|
end;
|
|
|
|
TJclStreamDecorator = class(TJclStream)
|
|
private
|
|
FAfterStreamChange: TNotifyEvent;
|
|
FBeforeStreamChange: TNotifyEvent;
|
|
FOwnsStream: Boolean;
|
|
FStream: TStream;
|
|
procedure SetStream(Value: TStream);
|
|
protected
|
|
procedure DoAfterStreamChange; virtual;
|
|
procedure DoBeforeStreamChange; virtual;
|
|
procedure SetSize(NewSize: Longint); overload; override;
|
|
procedure SetSize(const NewSize: Int64); overload; override;
|
|
public
|
|
constructor Create(AStream: TStream; AOwnsStream: Boolean = False); virtual;
|
|
destructor Destroy; override;
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
|
|
function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|
property AfterStreamChange: TNotifyEvent read FAfterStreamChange write FAfterStreamChange;
|
|
property BeforeStreamChange: TNotifyEvent read FBeforeStreamChange write FBeforeStreamChange;
|
|
property OwnsStream: Boolean read FOwnsStream write FOwnsStream;
|
|
property Stream: TStream read FStream write SetStream;
|
|
end;
|
|
|
|
TJclBufferedStream = class(TJclStreamDecorator)
|
|
private
|
|
FBuffer: array of Byte;
|
|
FBufferCurrentSize: Longint;
|
|
FBufferMaxModifiedPos: Longint;
|
|
FBufferSize: Longint;
|
|
FBufferStart: Longint;
|
|
FPosition: Longint;
|
|
FSize: Longint;
|
|
function BufferHit: Boolean;
|
|
function GetCalcedSize: Longint;
|
|
function LoadBuffer: Boolean;
|
|
procedure SetBufferSize(Value: Longint);
|
|
function ReadFromBuffer(var Buffer; Count, Start: Longint): Longint;
|
|
function WriteToBuffer(const Buffer; Count, Start: Longint): Longint;
|
|
protected
|
|
procedure DoAfterStreamChange; override;
|
|
procedure DoBeforeStreamChange; override;
|
|
procedure SetSize(NewSize: Longint); override;
|
|
public
|
|
constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override;
|
|
destructor Destroy; override;
|
|
procedure Flush;
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|
function Seek(Offset: Longint; Origin: Word): Longint; override;
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|
property BufferSize: Longint read FBufferSize write SetBufferSize;
|
|
end;
|
|
|
|
TStreamNotifyEvent = procedure(Sender: TObject; Position: Int64; Size: Int64) of object;
|
|
|
|
TJclEventStream = class(TJclStreamDecorator)
|
|
private
|
|
FNotification: TStreamNotifyEvent;
|
|
procedure DoNotification;
|
|
protected
|
|
procedure DoBeforeStreamChange; override;
|
|
procedure DoAfterStreamChange; override;
|
|
procedure SetSize(NewSize: Longint); overload; override;
|
|
procedure SetSize(const NewSize: Int64); overload; override;
|
|
public
|
|
constructor Create(AStream: TStream; ANotification: TStreamNotifyEvent = nil;
|
|
AOwnsStream: Boolean = False); reintroduce; virtual;
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
|
|
function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|
property OnNotification: TStreamNotifyEvent read FNotification write FNotification;
|
|
end;
|
|
|
|
TJclEasyStream = class(TJclStreamDecorator)
|
|
public
|
|
function IsEqual(Stream: TStream): Boolean;
|
|
function ReadBoolean: Boolean;
|
|
function ReadChar: Char;
|
|
function ReadCurrency: Currency;
|
|
function ReadDateTime: TDateTime;
|
|
function ReadDouble: Double;
|
|
function ReadExtended: Extended;
|
|
function ReadInt64: Int64;
|
|
function ReadInteger: Integer;
|
|
function ReadCString: string;
|
|
function ReadShortString: string;
|
|
function ReadSingle: Single;
|
|
function ReadSizedString: string;
|
|
procedure WriteBoolean(Value: Boolean);
|
|
procedure WriteChar(Value: Char);
|
|
procedure WriteCurrency(const Value: Currency);
|
|
procedure WriteDateTime(const Value: TDateTime);
|
|
procedure WriteDouble(const Value: Double);
|
|
procedure WriteExtended(const Value: Extended);
|
|
procedure WriteInt64(Value: Int64); overload;
|
|
procedure WriteInteger(Value: Integer); overload;
|
|
procedure WriteStringDelimitedByNull(const Value: string);
|
|
procedure WriteShortString(const Value: ShortString);
|
|
procedure WriteSingle(const Value: Single);
|
|
procedure WriteSizedString(const Value: string);
|
|
end;
|
|
|
|
TJclScopedStream = class(TJclStream)
|
|
private
|
|
FParentStream: TStream;
|
|
FStartPos: Int64;
|
|
FCurrentPos: Int64;
|
|
FMaxSize: Int64;
|
|
public
|
|
// scopedstream starting at the current position of the ParentStream
|
|
// if MaxSize is positive or null, read and write operations cannot overrun this size or the ParentStream limitation
|
|
// if MaxSize is negative, read and write operations are unlimited (up to the ParentStream limitation)
|
|
constructor Create(AParentStream: TStream; AMaxSize: Int64 = -1); reintroduce;
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|
|
|
property ParentStream: TStream read FParentStream;
|
|
property StartPos: Int64 read FStartPos;
|
|
property MaxSize: Int64 read FMaxSize write FMaxSize;
|
|
end;
|
|
|
|
TJclStreamSeekEvent = function(Sender: TObject; const Offset: Int64;
|
|
Origin: TSeekOrigin): Int64 of object;
|
|
TJclStreamReadEvent = function(Sender: TObject; var Buffer; Count: Longint): Longint of object;
|
|
TJclStreamWriteEvent = function(Sender: TObject; const Buffer; Count: Longint): Longint of object;
|
|
TJclStreamSizeEvent = procedure(Sender: TObject; const NewSize: Int64) of object;
|
|
|
|
TJclDelegatedStream = class(TJclStream)
|
|
private
|
|
FOnSeek: TJclStreamSeekEvent;
|
|
FOnRead: TJclStreamReadEvent;
|
|
FOnWrite: TJclStreamWriteEvent;
|
|
FOnSize: TJclStreamSizeEvent;
|
|
protected
|
|
procedure SetSize(const NewSize: Int64); override;
|
|
public
|
|
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|
property OnSeek: TJclStreamSeekEvent read FOnSeek write FOnSeek;
|
|
property OnRead: TJclStreamReadEvent read FOnRead write FOnRead;
|
|
property OnWrite: TJclStreamWriteEvent read FOnWrite write FOnWrite;
|
|
property OnSize: TJclStreamSizeEvent read FOnSize write FOnSize;
|
|
end;
|
|
|
|
// call TStream.Seek(Int64,TSeekOrigin) if present (TJclStream or COMPILER6_UP)
|
|
// otherwize call TStream.Seek(LongInt,Word) with range checking
|
|
function StreamSeek(Stream: TStream; const Offset: Int64;
|
|
const Origin: TSeekOrigin): Int64;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jcl.svn.sourceforge.net:443/svnroot/jcl/tags/JCL-1.100-Build2646/jcl/source/common/JclStreams.pas $';
|
|
Revision: '$Revision: 1856 $';
|
|
Date: '$Date: 2006-12-30 10:04:59 +0100 (sam., 30 déc. 2006) $';
|
|
LogPath: 'JCL\source\common'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
JclResources;
|
|
|
|
{$IFDEF KYLIX}
|
|
function __open(PathName: PChar; Flags: Integer; Mode: Integer): Integer; cdecl;
|
|
external 'libc.so.6' name 'open';
|
|
{$ENDIF KYLIX}
|
|
|
|
function StreamSeek(Stream: TStream; const Offset: Int64;
|
|
const Origin: TSeekOrigin): Int64; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
|
|
begin
|
|
if Assigned(Stream) then
|
|
begin
|
|
{$IFDEF COMPILER5}
|
|
if Stream is TJclStream then
|
|
Result := TJclStream(Stream).Seek(Offset, Origin)
|
|
else
|
|
if (Offset <= MaxLongint) or (Offset > -MaxLongint) then
|
|
Result := Stream.Seek(Longint(Offset), Ord(Origin))
|
|
else
|
|
Result := -1;
|
|
{$ELSE}
|
|
Result := Stream.Seek(Offset, Origin);
|
|
{$ENDIF COMPILER5}
|
|
end
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
//=== { TJclStream } =========================================================
|
|
|
|
function TJclStream.Seek(Offset: Longint; Origin: Word): Longint;
|
|
var
|
|
Result64: Int64;
|
|
begin
|
|
case Origin of
|
|
soFromBeginning:
|
|
Result64 := Seek(Int64(Offset), soBeginning);
|
|
soFromCurrent:
|
|
Result64 := Seek(Int64(Offset), soCurrent);
|
|
soFromEnd:
|
|
Result64 := Seek(Int64(Offset), soEnd);
|
|
else
|
|
Result64 := -1;
|
|
end;
|
|
if (Result64 < 0) or (Result64 > High(Longint)) then
|
|
Result64 := -1;
|
|
Result := Result64;
|
|
end;
|
|
|
|
function TJclStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
|
begin
|
|
// override to customize
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TJclStream.SetSize(NewSize: Longint);
|
|
begin
|
|
SetSize(Int64(NewSize));
|
|
end;
|
|
|
|
procedure TJclStream.SetSize(const NewSize: Int64);
|
|
begin
|
|
// override to customize
|
|
end;
|
|
|
|
//=== { TJclHandleStream } ===================================================
|
|
|
|
constructor TJclHandleStream.Create(AHandle: THandle);
|
|
begin
|
|
inherited Create;
|
|
FHandle := AHandle;
|
|
end;
|
|
|
|
function TJclHandleStream.Read(var Buffer; Count: Longint): Longint;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
if (Count <= 0) or not ReadFile(Handle, Buffer, DWORD(Count), DWORD(Result), nil) then
|
|
Result := 0;
|
|
{$ENDIF MSWINDOWS}
|
|
{$IFDEF LINUX}
|
|
Result := __read(Handle, Buffer, Count);
|
|
{$ENDIF LINUX}
|
|
end;
|
|
|
|
function TJclHandleStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
if (Count <= 0) or not WriteFile(Handle, Buffer, DWORD(Count), DWORD(Result), nil) then
|
|
Result := 0;
|
|
{$ENDIF MSWINDOWS}
|
|
{$IFDEF LINUX}
|
|
Result := __write(Handle, Buffer, Count);
|
|
{$ENDIF LINUX}
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function TJclHandleStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
|
const
|
|
INVALID_SET_FILE_POINTER = -1;
|
|
type
|
|
TLarge = record
|
|
case Boolean of
|
|
False:
|
|
(OffsetLo: Longint;
|
|
OffsetHi: Longint);
|
|
True:
|
|
(Offset64: Int64);
|
|
end;
|
|
var
|
|
Offs: TLarge;
|
|
begin
|
|
Offs.Offset64 := Offset;
|
|
Offs.OffsetLo := SetFilePointer(Handle, Offs.OffsetLo, @Offs.OffsetHi, Ord(Origin));
|
|
if (Offs.OffsetLo = INVALID_SET_FILE_POINTER) and (GetLastError <> NO_ERROR) then
|
|
Result := -1
|
|
else
|
|
Result := Offs.Offset64;
|
|
end;
|
|
{$ENDIF MSWINDOWS}
|
|
{$IFDEF LINUX}
|
|
function TJclHandleStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
|
const
|
|
SeekOrigins: array [TSeekOrigin] of Cardinal = ( SEEK_SET {soBeginning}, SEEK_CUR {soCurrent}, SEEK_END {soEnd} );
|
|
begin
|
|
Result := __lseek(Handle, Offset, SeekOrigins[Origin]);
|
|
end;
|
|
{$ENDIF LINUX}
|
|
|
|
procedure TJclHandleStream.SetSize(NewSize: Longint);
|
|
begin
|
|
SetSize(Int64(NewSize));
|
|
end;
|
|
|
|
procedure TJclHandleStream.SetSize(const NewSize: Int64);
|
|
begin
|
|
Seek(NewSize, soBeginning);
|
|
{$IFDEF MSWINDOWS}
|
|
if not SetEndOfFile(Handle) then
|
|
RaiseLastOSError;
|
|
{$ENDIF MSWINDOWS}
|
|
{$IFDEF LINUX}
|
|
if ftruncate(Handle, Position) = -1 then
|
|
raise EJclStreamError.CreateRes(@RsStreamsSetSizeError);
|
|
{$ENDIF LINUX}
|
|
end;
|
|
|
|
//=== { TJclFileStream } =====================================================
|
|
|
|
constructor TJclFileStream.Create(const FileName: string; Mode: Word; Rights: Cardinal);
|
|
var
|
|
H: THandle;
|
|
{$IFDEF KYLIX}
|
|
const
|
|
INVALID_HANDLE_VALUE = 0;
|
|
{$ENDIF KYLIX}
|
|
begin
|
|
if Mode = fmCreate then
|
|
begin
|
|
{$IFDEF KYLIX}
|
|
H := __open(PChar(FileName), O_CREAT or O_RDWR, FileAccessRights);
|
|
inherited Create(H);
|
|
{$ELSE ~KYLIX}
|
|
H := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
|
|
0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
|
|
inherited Create(H);
|
|
{$ENDIF ~KYLIX}
|
|
if Handle = INVALID_HANDLE_VALUE then
|
|
{$IFDEF CLR}
|
|
raise EJclStreamError.CreateFmt(RsStreamsCreateError, [FileName]);
|
|
{$ELSE}
|
|
raise EJclStreamError.CreateResFmt(@RsStreamsCreateError, [FileName]);
|
|
{$ENDIF CLR}
|
|
end
|
|
else
|
|
begin
|
|
H := THandle(FileOpen(FileName, Mode));
|
|
inherited Create(H);
|
|
if Handle = INVALID_HANDLE_VALUE then
|
|
{$IFDEF CLR}
|
|
raise EJclStreamError.CreateFmt(RsStreamsOpenError, [FileName]);
|
|
{$ELSE}
|
|
raise EJclStreamError.CreateResFmt(@RsStreamsOpenError, [FileName]);
|
|
{$ENDIF CLR}
|
|
end;
|
|
end;
|
|
|
|
destructor TJclFileStream.Destroy;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
if Handle <> INVALID_HANDLE_VALUE then
|
|
CloseHandle(Handle);
|
|
{$ENDIF MSWINDOWS}
|
|
{$IFDEF LINUX}
|
|
__close(Handle);
|
|
{$ENDIF LINUX}
|
|
inherited Destroy;
|
|
end;
|
|
|
|
//=== { TJclEmptyStream } ====================================================
|
|
|
|
// a stream which stays empty no matter what you do
|
|
// so it is a Unix /dev/null equivalent
|
|
|
|
procedure TJclEmptyStream.SetSize(NewSize: Longint);
|
|
begin
|
|
// nothing
|
|
end;
|
|
|
|
procedure TJclEmptyStream.SetSize(const NewSize: Int64);
|
|
begin
|
|
// nothing
|
|
end;
|
|
|
|
function TJclEmptyStream.Read(var Buffer; Count: Longint): Longint;
|
|
begin
|
|
// you cannot read anything
|
|
Result := 0;
|
|
end;
|
|
|
|
function TJclEmptyStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
// you cannot write anything
|
|
Result := 0;
|
|
end;
|
|
|
|
function TJclEmptyStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
|
begin
|
|
if Offset <> 0 then
|
|
// seeking to anywhere except the position 0 is an error
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
//=== { TJclNullStream } =====================================================
|
|
|
|
// a stream which only keeps position and size, but no data
|
|
// so it is a Unix /dev/zero equivalent (?)
|
|
|
|
procedure TJclNullStream.SetSize(const NewSize: Int64);
|
|
begin
|
|
if NewSize > 0 then
|
|
FSize := NewSize
|
|
else
|
|
FSize := 0;
|
|
if FPosition > FSize then
|
|
FPosition := FSize;
|
|
end;
|
|
|
|
function TJclNullStream.Read(var Buffer; Count: Longint): Longint;
|
|
begin
|
|
if Count < 0 then
|
|
Count := 0;
|
|
// FPosition > FSize is possible!
|
|
if FSize - FPosition < Count then
|
|
Count := FSize - FPosition;
|
|
// does not read if beyond EOF
|
|
if Count > 0 then
|
|
begin
|
|
FillChar(Buffer, Count, 0);
|
|
FPosition := FPosition + Count;
|
|
end;
|
|
Result := Count;
|
|
end;
|
|
|
|
function TJclNullStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
if Count < 0 then
|
|
Count := 0;
|
|
FPosition := FPosition + Count;
|
|
// writing when FPosition > FSize is possible!
|
|
if FPosition > FSize then
|
|
FSize := FPosition;
|
|
Result := Count;
|
|
end;
|
|
|
|
function TJclNullStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
|
var
|
|
Rel: Int64;
|
|
begin
|
|
case Origin of
|
|
soBeginning:
|
|
Rel := 0;
|
|
soCurrent:
|
|
Rel := FPosition;
|
|
soEnd:
|
|
Rel := FSize;
|
|
else
|
|
// force Rel + Offset = -1 (code is never reached)
|
|
Rel := Offset - 1;
|
|
end;
|
|
if Rel + Offset >= 0 then
|
|
begin
|
|
// all non-negative destination positions including beyond EOF are valid
|
|
FPosition := Rel + Offset;
|
|
Result := FPosition;
|
|
end
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
//=== { TJclRandomStream } ===================================================
|
|
|
|
// A TJclNullStream decendant which returns random data when read
|
|
// so it is a Unix /dev/random equivalent
|
|
|
|
function TJclRandomStream.GetRandSeed: Longint;
|
|
begin
|
|
Result := System.RandSeed;
|
|
end;
|
|
|
|
procedure TJclRandomStream.SetRandSeed(Seed: Longint);
|
|
begin
|
|
System.RandSeed := Seed;
|
|
end;
|
|
|
|
function TJclRandomStream.RandomData: Byte;
|
|
begin
|
|
Result := Byte(System.Random(256));
|
|
end;
|
|
|
|
procedure TJclRandomStream.Randomize;
|
|
begin
|
|
System.Randomize;
|
|
end;
|
|
|
|
function TJclRandomStream.Read(var Buffer; Count: Longint): Longint;
|
|
var
|
|
I: Longint;
|
|
BufferPtr: PByte;
|
|
begin
|
|
// this handles all necessary checks
|
|
Count := inherited Read(Buffer, Count);
|
|
BufferPtr := @Buffer;
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
BufferPtr^ := RandomData;
|
|
Inc(BufferPtr);
|
|
end;
|
|
Result := Count;
|
|
end;
|
|
|
|
//=== { TJclMultiplexStream } ================================================
|
|
|
|
constructor TJclMultiplexStream.Create;
|
|
begin
|
|
inherited Create;
|
|
FStreams := TList.Create;
|
|
FReadStreamIndex := -1;
|
|
end;
|
|
|
|
destructor TJclMultiplexStream.Destroy;
|
|
begin
|
|
FStreams.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJclMultiplexStream.Add(NewStream: TStream): Integer;
|
|
begin
|
|
Result := FStreams.Add(Pointer(NewStream));
|
|
end;
|
|
|
|
procedure TJclMultiplexStream.Clear;
|
|
begin
|
|
FStreams.Clear;
|
|
FReadStreamIndex := -1;
|
|
end;
|
|
|
|
procedure TJclMultiplexStream.Delete(const Index: Integer);
|
|
begin
|
|
FStreams.Delete(Index);
|
|
if ReadStreamIndex = Index then
|
|
FReadStreamIndex := -1
|
|
else
|
|
if ReadStreamIndex > Index then
|
|
Dec(FReadStreamIndex);
|
|
end;
|
|
|
|
function TJclMultiplexStream.GetReadStream: TStream;
|
|
begin
|
|
if FReadStreamIndex >= 0 then
|
|
Result := TStream(FStreams.Items[FReadStreamIndex])
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TJclMultiplexStream.GetStream(Index: Integer): TStream;
|
|
begin
|
|
Result := TStream(FStreams.Items[Index]);
|
|
end;
|
|
|
|
function TJclMultiplexStream.GetCount: Integer;
|
|
begin
|
|
Result := FStreams.Count;
|
|
end;
|
|
|
|
function TJclMultiplexStream.Read(var Buffer; Count: Longint): Longint;
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := ReadStream;
|
|
if Assigned(Stream) then
|
|
Result := Stream.Read(Buffer, Count)
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TJclMultiplexStream.Remove(AStream: TStream): Integer;
|
|
begin
|
|
Result := FStreams.Remove(Pointer(AStream));
|
|
if FReadStreamIndex = Result then
|
|
FReadStreamIndex := -1
|
|
else
|
|
if FReadStreamIndex > Result then
|
|
Dec(FReadStreamIndex);
|
|
end;
|
|
|
|
function TJclMultiplexStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
|
begin
|
|
// what should this function do?
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TJclMultiplexStream.SetReadStream(const Value: TStream);
|
|
begin
|
|
FReadStreamIndex := FStreams.IndexOf(Pointer(Value));
|
|
end;
|
|
|
|
procedure TJclMultiplexStream.SetReadStreamIndex(const Value: Integer);
|
|
begin
|
|
FReadStreamIndex := Value;
|
|
end;
|
|
|
|
procedure TJclMultiplexStream.SetSize(const NewSize: Int64);
|
|
begin
|
|
// what should this function do?
|
|
end;
|
|
|
|
procedure TJclMultiplexStream.SetStream(Index: Integer; const Value: TStream);
|
|
begin
|
|
FStreams.Items[Index] := Pointer(Value);
|
|
end;
|
|
|
|
function TJclMultiplexStream.Write(const Buffer; Count: Longint): Longint;
|
|
var
|
|
Index: Integer;
|
|
ByteWritten, MinByteWritten: Longint;
|
|
begin
|
|
MinByteWritten := Count;
|
|
for Index := 0 to Self.Count - 1 do
|
|
begin
|
|
ByteWritten := TStream(FStreams.Items[Index]).Write(Buffer, Count);
|
|
if ByteWritten < MinByteWritten then
|
|
MinByteWritten := ByteWritten;
|
|
end;
|
|
Result := MinByteWritten;
|
|
end;
|
|
|
|
//=== { TJclStreamDecorator } ================================================
|
|
|
|
constructor TJclStreamDecorator.Create(AStream: TStream; AOwnsStream: Boolean = False);
|
|
begin
|
|
inherited Create;
|
|
FStream := AStream;
|
|
FOwnsStream := AOwnsStream;
|
|
end;
|
|
|
|
destructor TJclStreamDecorator.Destroy;
|
|
begin
|
|
if OwnsStream then
|
|
FStream.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJclStreamDecorator.DoAfterStreamChange;
|
|
begin
|
|
if Assigned(FAfterStreamChange) then
|
|
FAfterStreamChange(Self);
|
|
end;
|
|
|
|
procedure TJclStreamDecorator.DoBeforeStreamChange;
|
|
begin
|
|
if Assigned(FBeforeStreamChange) then
|
|
FBeforeStreamChange(Self);
|
|
end;
|
|
|
|
function TJclStreamDecorator.Read(var Buffer; Count: Longint): Longint;
|
|
begin
|
|
if Assigned(FStream) then
|
|
Result := Stream.Read(Buffer, Count)
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TJclStreamDecorator.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
|
begin
|
|
Result := StreamSeek(Stream, Offset, Origin);
|
|
end;
|
|
|
|
function TJclStreamDecorator.Seek(Offset: Longint; Origin: Word): Longint;
|
|
begin
|
|
if Assigned(FStream) then
|
|
Result := Stream.Seek(Offset, Origin)
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TJclStreamDecorator.SetSize(NewSize: Longint);
|
|
begin
|
|
if Assigned(FStream) then
|
|
Stream.Size := NewSize;
|
|
end;
|
|
|
|
procedure TJclStreamDecorator.SetSize(const NewSize: Int64);
|
|
begin
|
|
if Assigned(FStream) then
|
|
Stream.Size := NewSize;
|
|
end;
|
|
|
|
procedure TJclStreamDecorator.SetStream(Value: TStream);
|
|
begin
|
|
if Value <> FStream then
|
|
try
|
|
DoBeforeStreamChange;
|
|
finally
|
|
if OwnsStream then
|
|
FStream.Free;
|
|
FStream := Value;
|
|
DoAfterStreamChange;
|
|
end;
|
|
end;
|
|
|
|
function TJclStreamDecorator.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
if Assigned(FStream) then
|
|
Result := Stream.Write(Buffer, Count)
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
//=== { TJclBufferedStream } =================================================
|
|
|
|
constructor TJclBufferedStream.Create(AStream: TStream; AOwnsStream: Boolean = False);
|
|
begin
|
|
inherited Create(AStream, AOwnsStream);
|
|
FSize := -1;
|
|
FPosition := Stream.Position;
|
|
BufferSize := 4096;
|
|
end;
|
|
|
|
destructor TJclBufferedStream.Destroy;
|
|
begin
|
|
Flush;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJclBufferedStream.BufferHit: Boolean;
|
|
begin
|
|
Result := (FBufferStart <= FPosition) and (FPosition < FBufferCurrentSize);
|
|
end;
|
|
|
|
procedure TJclBufferedStream.DoAfterStreamChange;
|
|
begin
|
|
inherited DoAfterStreamChange;
|
|
if Stream <> nil then
|
|
FPosition := Stream.Position;
|
|
end;
|
|
|
|
procedure TJclBufferedStream.DoBeforeStreamChange;
|
|
begin
|
|
inherited DoBeforeStreamChange;
|
|
Flush;
|
|
end;
|
|
|
|
procedure TJclBufferedStream.Flush;
|
|
begin
|
|
if Stream = nil then
|
|
Exit;
|
|
if FBufferMaxModifiedPos > 0 then
|
|
begin
|
|
Stream.Position := FBufferStart;
|
|
Stream.WriteBuffer(FBuffer[0], FBufferMaxModifiedPos);
|
|
FSize := Stream.Size;
|
|
FBufferMaxModifiedPos := 0;
|
|
end;
|
|
end;
|
|
|
|
function TJclBufferedStream.GetCalcedSize: Longint;
|
|
begin
|
|
if FSize < 0 then
|
|
FSize := Stream.Size;
|
|
if FSize < FBufferMaxModifiedPos + FBufferStart then
|
|
FSize := FBufferMaxModifiedPos + FBufferStart;
|
|
Result := FSize;
|
|
end;
|
|
|
|
function TJclBufferedStream.LoadBuffer: Boolean;
|
|
begin
|
|
Flush;
|
|
if Length(FBuffer) <> FBufferSize then
|
|
SetLength(FBuffer, FBufferSize);
|
|
FStream.Position := FPosition;
|
|
FBufferCurrentSize := FStream.Read(FBuffer[0], FBufferSize);
|
|
FBufferStart := FPosition;
|
|
Result := (FBufferCurrentSize > 0);
|
|
end;
|
|
|
|
function TJclBufferedStream.Read(var Buffer; Count: Longint): Longint;
|
|
begin
|
|
Result := Count;
|
|
while Count > 0 do
|
|
begin
|
|
if not BufferHit then
|
|
if not LoadBuffer then
|
|
Break;
|
|
Dec(Count, ReadFromBuffer(Buffer, Count, Result - Count));
|
|
end;
|
|
Result := Result - Count;
|
|
end;
|
|
|
|
function TJclBufferedStream.ReadFromBuffer(var Buffer; Count, Start: Longint): Longint;
|
|
var
|
|
BufPos: Longint;
|
|
P: PChar;
|
|
begin
|
|
Result := Count;
|
|
BufPos := FPosition - FBufferStart;
|
|
if Result > FBufferCurrentSize - BufPos then
|
|
Result := FBufferCurrentSize - BufPos;
|
|
P := @Buffer;
|
|
Move(FBuffer[BufPos], P[Start], Result);
|
|
Inc(FPosition, Result);
|
|
end;
|
|
|
|
function TJclBufferedStream.Seek(Offset: Longint; Origin: Word): Longint;
|
|
var
|
|
NewPos: Longint;
|
|
begin
|
|
NewPos := FPosition;
|
|
case Origin of
|
|
soFromBeginning:
|
|
NewPos := Offset;
|
|
soFromCurrent:
|
|
Inc(NewPos, Offset);
|
|
soFromEnd:
|
|
NewPos := GetCalcedSize + Offset;
|
|
else
|
|
NewPos := -1;
|
|
end;
|
|
if NewPos < 0 then
|
|
NewPos := -1
|
|
else
|
|
FPosition := NewPos;
|
|
Result := NewPos;
|
|
end;
|
|
|
|
procedure TJclBufferedStream.SetBufferSize(Value: Longint);
|
|
begin
|
|
if FBufferSize <> Value then
|
|
FBufferSize := Value;
|
|
end;
|
|
|
|
procedure TJclBufferedStream.SetSize(NewSize: Longint);
|
|
begin
|
|
inherited SetSize(NewSize);
|
|
end;
|
|
|
|
function TJclBufferedStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
Result := Count;
|
|
while Count > 0 do
|
|
begin
|
|
if not BufferHit then
|
|
LoadBuffer;
|
|
Dec(Count, WriteToBuffer(Buffer, Count, Result - Count));
|
|
end;
|
|
Result := Result - Count;
|
|
end;
|
|
|
|
function TJclBufferedStream.WriteToBuffer(const Buffer; Count, Start: Longint): Longint;
|
|
var
|
|
BufPos: Longint;
|
|
P: PChar;
|
|
begin
|
|
Result := Count;
|
|
BufPos := FPosition - FBufferStart;
|
|
if Result > Length(FBuffer) - BufPos then
|
|
Result := Length(FBuffer) - BufPos;
|
|
if FBufferCurrentSize < BufPos + Result then
|
|
FBufferCurrentSize := BufPos + Result;
|
|
P := @Buffer;
|
|
Move(P[Start], FBuffer[BufPos], Result);
|
|
FBufferMaxModifiedPos := BufPos + Result;
|
|
Inc(FPosition, Result);
|
|
end;
|
|
|
|
//=== { TJclEventStream } ====================================================
|
|
|
|
constructor TJclEventStream.Create(AStream: TStream; ANotification:
|
|
TStreamNotifyEvent = nil; AOwnsStream: Boolean = False);
|
|
begin
|
|
inherited Create(AStream, AOwnsStream);
|
|
FNotification := ANotification;
|
|
end;
|
|
|
|
procedure TJclEventStream.DoAfterStreamChange;
|
|
begin
|
|
inherited DoAfterStreamChange;
|
|
if Stream <> nil then
|
|
DoNotification;
|
|
end;
|
|
|
|
procedure TJclEventStream.DoBeforeStreamChange;
|
|
begin
|
|
inherited DoBeforeStreamChange;
|
|
if Stream <> nil then
|
|
DoNotification;
|
|
end;
|
|
|
|
procedure TJclEventStream.DoNotification;
|
|
begin
|
|
if Assigned(FNotification) then
|
|
FNotification(Self, Stream.Position, Stream.Size);
|
|
end;
|
|
|
|
function TJclEventStream.Read(var Buffer; Count: Longint): Longint;
|
|
begin
|
|
Result := inherited Read(Buffer, Count);
|
|
DoNotification;
|
|
end;
|
|
|
|
function TJclEventStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
|
begin
|
|
Result := inherited Seek(Offset, Origin);
|
|
DoNotification;
|
|
end;
|
|
|
|
function TJclEventStream.Seek(Offset: Longint; Origin: Word): Longint;
|
|
begin
|
|
Result := inherited Seek(Offset, Origin);
|
|
DoNotification;
|
|
end;
|
|
|
|
procedure TJclEventStream.SetSize(NewSize: Longint);
|
|
begin
|
|
inherited SetSize(NewSize);
|
|
DoNotification;
|
|
end;
|
|
|
|
procedure TJclEventStream.SetSize(const NewSize: Int64);
|
|
begin
|
|
inherited SetSize(NewSize);
|
|
DoNotification;
|
|
end;
|
|
|
|
function TJclEventStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
Result := inherited Write(Buffer, Count);
|
|
DoNotification;
|
|
end;
|
|
|
|
//=== { TJclEasyStream } =====================================================
|
|
|
|
function TJclEasyStream.IsEqual(Stream: TStream): Boolean;
|
|
const
|
|
BUFSIZE = 65536;
|
|
var
|
|
SavePos, StreamSavePos: Integer;
|
|
ReadCount, StreamReadCount: Integer;
|
|
Buffer, StreamBuffer: PChar;
|
|
TestSize: Integer;
|
|
begin
|
|
Result := False;
|
|
SavePos := Position;
|
|
StreamSavePos := Stream.Position;
|
|
if Size <> Stream.Size then
|
|
Exit;
|
|
Buffer := nil;
|
|
try
|
|
GetMem(Buffer, 2*BUFSIZE);
|
|
StreamBuffer := Buffer + BUFSIZE;
|
|
Position := 0;
|
|
Stream.Position := 0;
|
|
TestSize := Size;
|
|
while Position < TestSize do
|
|
begin
|
|
ReadCount := Read(Buffer^, BUFSIZE);
|
|
StreamReadCount := Stream.Read(StreamBuffer^, BUFSIZE);
|
|
if ReadCount <> StreamReadCount then
|
|
Exit;
|
|
if not CompareMem(Buffer, StreamBuffer, ReadCount) then
|
|
Exit;
|
|
end;
|
|
finally
|
|
Position := SavePos;
|
|
Stream.Position := StreamSavePos;
|
|
if Buffer <> nil then
|
|
FreeMem(Buffer);
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
function TJclEasyStream.ReadBoolean: Boolean;
|
|
begin
|
|
ReadBuffer(Result, SizeOf(Result));
|
|
end;
|
|
|
|
function TJclEasyStream.ReadChar: Char;
|
|
begin
|
|
ReadBuffer(Result, SizeOf(Result));
|
|
end;
|
|
|
|
function TJclEasyStream.ReadCurrency: Currency;
|
|
begin
|
|
ReadBuffer(Result, SizeOf(Result));
|
|
end;
|
|
|
|
function TJclEasyStream.ReadDateTime: TDateTime;
|
|
begin
|
|
ReadBuffer(Result, SizeOf(Result));
|
|
end;
|
|
|
|
function TJclEasyStream.ReadDouble: Double;
|
|
begin
|
|
ReadBuffer(Result, SizeOf(Result));
|
|
end;
|
|
|
|
function TJclEasyStream.ReadExtended: Extended;
|
|
begin
|
|
ReadBuffer(Result, SizeOf(Result));
|
|
end;
|
|
|
|
function TJclEasyStream.ReadInt64: Int64;
|
|
begin
|
|
ReadBuffer(Result, SizeOf(Result));
|
|
end;
|
|
|
|
function TJclEasyStream.ReadInteger: Integer;
|
|
begin
|
|
ReadBuffer(Result, SizeOf(Result));
|
|
end;
|
|
|
|
function TJclEasyStream.ReadCString: string;
|
|
var
|
|
CurrPos: Integer;
|
|
StrSize: Integer;
|
|
begin
|
|
CurrPos := Position;
|
|
repeat
|
|
until ReadChar = #0;
|
|
StrSize := Position - CurrPos - 1;
|
|
SetString(Result, PChar(nil), StrSize);
|
|
Position := CurrPos;
|
|
ReadBuffer(Pointer(Result)^, StrSize);
|
|
Position := Position + 1;
|
|
end;
|
|
|
|
function TJclEasyStream.ReadShortString: string;
|
|
var
|
|
StrSize: Integer;
|
|
begin
|
|
StrSize := Ord(ReadChar);
|
|
SetString(Result, PChar(nil), StrSize);
|
|
ReadBuffer(Pointer(Result)^, StrSize);
|
|
end;
|
|
|
|
function TJclEasyStream.ReadSingle: Single;
|
|
begin
|
|
ReadBuffer(Result, SizeOf(Result));
|
|
end;
|
|
|
|
function TJclEasyStream.ReadSizedString: string;
|
|
var
|
|
StrSize: Integer;
|
|
begin
|
|
StrSize := ReadInteger;
|
|
SetString(Result, PChar(nil), StrSize);
|
|
ReadBuffer(Pointer(Result)^, StrSize);
|
|
end;
|
|
|
|
procedure TJclEasyStream.WriteBoolean(Value: Boolean);
|
|
begin
|
|
WriteBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure TJclEasyStream.WriteChar(Value: Char);
|
|
begin
|
|
WriteBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure TJclEasyStream.WriteCurrency(const Value: Currency);
|
|
begin
|
|
WriteBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure TJclEasyStream.WriteDateTime(const Value: TDateTime);
|
|
begin
|
|
WriteBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure TJclEasyStream.WriteDouble(const Value: Double);
|
|
begin
|
|
WriteBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure TJclEasyStream.WriteExtended(const Value: Extended);
|
|
begin
|
|
WriteBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure TJclEasyStream.WriteInt64(Value: Int64);
|
|
begin
|
|
WriteBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure TJclEasyStream.WriteInteger(Value: Integer);
|
|
begin
|
|
WriteBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure TJclEasyStream.WriteStringDelimitedByNull(const Value: string);
|
|
begin
|
|
WriteBuffer(PChar(Value)^, Length(Value) + 1);
|
|
end;
|
|
|
|
procedure TJclEasyStream.WriteShortString(const Value: ShortString);
|
|
begin
|
|
WriteBuffer(Value[0], Length(Value) + 1);
|
|
end;
|
|
|
|
procedure TJclEasyStream.WriteSingle(const Value: Single);
|
|
begin
|
|
WriteBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure TJclEasyStream.WriteSizedString(const Value: string);
|
|
var
|
|
StrSize: Integer;
|
|
begin
|
|
StrSize := Length(Value);
|
|
WriteInteger(StrSize);
|
|
WriteBuffer(Pointer(Value)^, StrSize);
|
|
end;
|
|
|
|
//=== { TJclScopedStream } ===================================================
|
|
|
|
constructor TJclScopedStream.Create(AParentStream: TStream; AMaxSize: Int64);
|
|
begin
|
|
inherited Create;
|
|
|
|
FParentStream := AParentStream;
|
|
FStartPos := ParentStream.Position;
|
|
FCurrentPos := 0;
|
|
FMaxSize := AMaxSize;
|
|
end;
|
|
|
|
function TJclScopedStream.Read(var Buffer; Count: Longint): Longint;
|
|
begin
|
|
if (MaxSize >= 0) and ((FCurrentPos + Count) > MaxSize) then
|
|
Count := MaxSize - FCurrentPos;
|
|
|
|
if (Count > 0) and Assigned(ParentStream) then
|
|
begin
|
|
Result := ParentStream.Read(Buffer, Count);
|
|
Inc(FCurrentPos, Result);
|
|
end
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TJclScopedStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
|
begin
|
|
case Origin of
|
|
soBeginning:
|
|
begin
|
|
if (Offset < 0) or ((MaxSize >= 0) and (Offset > MaxSize)) then
|
|
Result := -1 // low and high bound check
|
|
else
|
|
Result := StreamSeek(ParentStream, StartPos + Offset, soBeginning) - StartPos;
|
|
end;
|
|
soCurrent:
|
|
begin
|
|
if Offset = 0 then
|
|
Result := FCurrentPos // speeding the Position property up
|
|
else if ((FCurrentPos + Offset) < 0) or ((MaxSize >= 0)
|
|
and ((FCurrentPos + Offset) > MaxSize)) then
|
|
Result := -1 // low and high bound check
|
|
else
|
|
Result := StreamSeek(ParentStream, Offset, soCurrent) - StartPos;
|
|
end;
|
|
soEnd:
|
|
begin
|
|
if (MaxSize >= 0) then
|
|
begin
|
|
if (Offset > 0) or (MaxSize < -Offset) then // low and high bound check
|
|
Result := -1
|
|
else
|
|
Result := StreamSeek(ParentStream, StartPos + MaxSize + Offset, soBeginning) - StartPos;
|
|
end
|
|
else
|
|
begin
|
|
Result := StreamSeek(ParentStream, Offset, soEnd);
|
|
if (Result <> -1) and (Result < StartPos) then // low bound check
|
|
begin
|
|
Result := -1;
|
|
StreamSeek(ParentStream, StartPos + FCurrentPos, soBeginning);
|
|
end;
|
|
end;
|
|
end;
|
|
else
|
|
Result := -1;
|
|
end;
|
|
if Result <> -1 then
|
|
FCurrentPos := Result;
|
|
end;
|
|
|
|
function TJclScopedStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
if (MaxSize >= 0) and ((FCurrentPos + Count) > MaxSize) then
|
|
Count := MaxSize - FCurrentPos;
|
|
|
|
if (Count > 0) and Assigned(ParentStream) then
|
|
begin
|
|
Result := ParentStream.Write(Buffer, Count);
|
|
Inc(FCurrentPos, Result);
|
|
end
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
//=== { TJclDelegateStream } =================================================
|
|
|
|
procedure TJclDelegatedStream.SetSize(const NewSize: Int64);
|
|
begin
|
|
if Assigned(FOnSize) then
|
|
FOnSize(Self, NewSize);
|
|
end;
|
|
|
|
function TJclDelegatedStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
|
begin
|
|
if Assigned(FOnSeek) then
|
|
Result := FOnSeek(Self, Offset, Origin)
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJclDelegatedStream.Read(var Buffer; Count: Longint): Longint;
|
|
begin
|
|
if Assigned(FOnRead) then
|
|
Result := FOnRead(Self, Buffer, Count)
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJclDelegatedStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
if Assigned(FOnWrite) then
|
|
Result := FOnWrite(Self, Buffer, Count)
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|