Archivado/Componentes.Terceros.jcl
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
master
Componentes.Terceros.jcl/official/1.104/source/common/JclStreams.pas
david 84299d30d6 Importación inicial 
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jcl@16 c37d764d-f447-7644-a108-883140d013fb
2009-02-27 12:18:04 +00:00

3174 lines
91 KiB
ObjectPascal
Raw Permalink Blame History

{**************************************************************************************************}
{ }
{ 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 }
{ Andreas Schmidt }
{ }
{**************************************************************************************************}
{ }
{ Stream-related functions and classes }
{ }
{**************************************************************************************************}
{ }
{ Last modified: $Date:: 2009-01-18 19:59:35 +0100 (dim., 18 janv. 2009) $ }
{ Revision: $Rev:: 2600 $ }
{ Author: $Author:: outchy $ }
{ }
{**************************************************************************************************}
unit JclStreams;
{$I jcl.inc}
interface
uses
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF MSWINDOWS}
{$IFDEF LINUX}
Libc,
{$ENDIF LINUX}
SysUtils, Classes,
{$IFDEF HAS_UNIT_CONTNRS}
Contnrs,
{$ENDIF HAS_UNIT_CONTNRS}
JclBase, JclStringConversions;
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
{$IFNDEF CLR}
procedure SetSize(NewSize: Longint); overload; override;
{$ENDIF ~CLR}
procedure SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64);
{$IFDEF COMPILER5} reintroduce; overload; virtual; {$ELSE} overload; override; {$ENDIF}
public
{$IFNDEF CLR}
function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
{$ENDIF ~CLR}
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
{$IFDEF COMPILER5} reintroduce; overload; virtual; {$ELSE} overload; override; {$ENDIF}
end;
//=== VCL stream replacements ===
{$IFNDEF CLR}
TJclHandleStream = class(TJclStream)
private
FHandle: THandle;
protected
procedure SetSize(const NewSize: Int64); override;
public
constructor Create(AHandle: THandle);
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: TFileName; Mode: Word; Rights: Cardinal = 0);
destructor Destroy; override;
end;
{$ENDIF ~CLR}
{
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({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64); override;
public
{$IFDEF CLR}
function Read(var Buffer: array of Byte; Offset, Count: Longint): Longint; override;
function Write(const Buffer: array of Byte; Offset, Count: Longint): Longint; override;
{$ELSE ~CLR}
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
{$ENDIF ~CLR}
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
end;
TJclNullStream = class(TJclStream)
private
FPosition: Int64;
FSize: Int64;
protected
procedure SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64); override;
public
{$IFDEF CLR}
function Read(var Buffer: array of Byte; Offset, Count: Longint): Longint; override;
function Write(const Buffer: array of Byte; Offset, Count: Longint): Longint; override;
{$ELSE ~CLR}
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
{$ENDIF ~CLR}
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
end;
TJclRandomStream = class(TJclNullStream)
{$IFDEF CLR}
private
FRandomGenerator: System.Random;
{$ENDIF CLR}
protected
function GetRandSeed: Longint; virtual;
procedure SetRandSeed(Seed: Longint); virtual;
public
{$IFDEF CLR}
constructor Create;
destructor Destroy; override;
{$ENDIF CLR}
function RandomData: Byte; virtual;
procedure Randomize; dynamic;
{$IFDEF CLR}
function Read(var Buffer: array of Byte; Offset, Count: Longint): Longint; override;
{$ELSE ~CLR}
function Read(var Buffer; Count: Longint): Longint; override;
{$ENDIF ~CLR}
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({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64); override;
public
constructor Create;
destructor Destroy; override;
{$IFDEF CLR}
function Read(var Buffer: array of Byte; Offset, Count: Longint): Longint; override;
function Write(const Buffer: array of Byte; Offset, Count: Longint): Longint; override;
{$ELSE ~CLR}
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
{$ENDIF ~CLR}
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({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64); override;
public
constructor Create(AStream: TStream; AOwnsStream: Boolean = False);
destructor Destroy; override;
{$IFDEF CLR}
function Read(var Buffer: array of Byte; Offset, Count: Longint): Longint; override;
function Write(const Buffer: array of Byte; Offset, Count: Longint): Longint; override;
{$ELSE ~CLR}
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
{$ENDIF ~CLR}
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; 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)
protected
FBuffer: array of Byte;
FBufferCurrentSize: Longint;
FBufferMaxModifiedPos: Longint;
FBufferSize: Longint;
FBufferStart: Int64; // position of the first byte of the buffer in stream
FPosition: Int64; // current position in stream
function BufferHit: Boolean;
function GetCalcedSize: Int64; virtual;
function LoadBuffer: Boolean; virtual;
{$IFDEF CLR}
function ReadFromBuffer(var Buffer: array of Byte; Count, Start: Longint): Longint;
function WriteToBuffer(const Buffer: array of Byte; Count, Start: Longint): Longint;
{$ELSE ~CLR}
function ReadFromBuffer(var Buffer; Count, Start: Longint): Longint;
function WriteToBuffer(const Buffer; Count, Start: Longint): Longint;
{$ENDIF ~CLR}
protected
procedure DoAfterStreamChange; override;
procedure DoBeforeStreamChange; override;
procedure SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64); override;
public
constructor Create(AStream: TStream; AOwnsStream: Boolean = False);
destructor Destroy; override;
procedure Flush; virtual;
{$IFDEF CLR}
function Read(var Buffer: array of Byte; Offset, Count: Longint): Longint; override;
function Write(const Buffer: array of Byte; Offset, Count: Longint): Longint; override;
{$ELSE ~CLR}
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
{$ENDIF ~CLR}
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
property BufferSize: Longint read FBufferSize write FBufferSize;
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({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64); override;
public
constructor Create(AStream: TStream; ANotification: TStreamNotifyEvent = nil;
AOwnsStream: Boolean = False);
{$IFDEF CLR}
function Read(var Buffer: array of Byte; Offset, Count: Longint): Longint; override;
function Write(const Buffer: array of Byte; Offset, Count: Longint): Longint; override;
{$ELSE ~CLR}
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
{$ENDIF ~CLR}
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; 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 ReadAnsiChar: AnsiChar;
function ReadWideChar: WideChar;
function ReadByte: Byte;
{$IFNDEF CLR}
function ReadCurrency: Currency;
function ReadDateTime: TDateTime;
function ReadExtended: Extended;
{$ENDIF ~CLR}
function ReadDouble: Double;
function ReadInt64: Int64;
function ReadInteger: Integer;
function ReadCString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function ReadCAnsiString: AnsiString;
function ReadCWideString: WideString;
function ReadShortString: string;
function ReadSingle: Single;
function ReadSizedString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function ReadSizedAnsiString: AnsiString;
function ReadSizedWideString: WideString;
procedure WriteBoolean(Value: Boolean);
procedure WriteChar(Value: Char);
procedure WriteAnsiChar(Value: AnsiChar);
procedure WriteWideChar(Value: WideChar);
procedure WriteByte(Value: Byte);
{$IFNDEF CLR}
procedure WriteCurrency(const Value: Currency);
procedure WriteDateTime(const Value: TDateTime);
procedure WriteExtended(const Value: Extended);
{$ENDIF ~CLR}
procedure WriteDouble(const Value: Double);
procedure WriteInt64(Value: Int64); overload;
procedure WriteInteger(Value: Integer); overload;
procedure WriteCString(const Value: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
procedure WriteCAnsiString(const Value: AnsiString);
procedure WriteCWideString(const Value: WideString);
{$IFDEF KEEP_DEPRECATED}
procedure WriteStringDelimitedByNull(const Value: string);
{$ENDIF KEEP_DEPRECATED}
procedure WriteShortString(const Value: ShortString);
procedure WriteSingle(const Value: Single);
procedure WriteSizedString(const Value: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
procedure WriteSizedAnsiString(const Value: AnsiString);
procedure WriteSizedWideString(const Value: WideString);
end;
TJclScopedStream = class(TJclStream)
private
FParentStream: TStream;
FStartPos: Int64;
FCurrentPos: Int64;
FMaxSize: Int64;
protected
procedure SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64); override;
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);
{$IFDEF CLR}
function Read(var Buffer: array of Byte; Offset, Count: Longint): Longint; override;
function Write(const Buffer: array of Byte; Offset, Count: Longint): Longint; override;
{$ELSE ~CLR}
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
{$ENDIF ~CLR}
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; 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; {$IFDEF CLR}Offset,{$ENDIF CLR} Count: Longint): Longint of object;
TJclStreamWriteEvent = function(Sender: TObject; const Buffer; {$IFDEF CLR}Offset,{$ENDIF CLR}Count: Longint): Longint of object;
TJclStreamSizeEvent = procedure(Sender: TObject; {$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64) of object;
TJclDelegatedStream = class(TJclStream)
private
FOnSeek: TJclStreamSeekEvent;
FOnRead: TJclStreamReadEvent;
FOnWrite: TJclStreamWriteEvent;
FOnSize: TJclStreamSizeEvent;
protected
procedure SetSize({$IFNDEF CLR}const{$ENDIF CLR} NewSize: Int64); override;
public
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
{$IFDEF CLR}
function Read(var Buffer: array of Byte; Offset, Count: Longint): Longint; override;
function Write(const Buffer: array of Byte; Offset, Count: Longint): Longint; override;
{$ELSE ~CLR}
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
{$ENDIF ~CLR}
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;
// ancestor classes for streams with checksums and encrypted streams
// data are stored in sectors: each BufferSize-d buffer is followed by FBlockOverHeader bytes
// containing the checksum. In case of an encrypted stream, there is no byte
// but sector is encrypted
// reusing some code from TJclBufferedStream
TJclSectoredStream = class(TJclBufferedStream)
protected
FSectorOverHead: Longint;
function FlatToSectored(const Position: Int64): Int64;
function SectoredToFlat(const Position: Int64): Int64;
function GetCalcedSize: Int64; override;
function LoadBuffer: Boolean; override;
procedure DoAfterStreamChange; override;
procedure AfterBlockRead; virtual; // override to check protection
procedure BeforeBlockWrite; virtual; // override to compute protection
procedure SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64); override;
public
constructor Create(AStorageStream: TStream; AOwnsStream: Boolean = False;
ASectorOverHead: Longint = 0);
procedure Flush; override;
end;
TJclCRC16Stream = class(TJclSectoredStream)
protected
procedure AfterBlockRead; override;
procedure BeforeBlockWrite; override;
public
constructor Create(AStorageStream: TStream; AOwnsStream: Boolean = False);
end;
TJclCRC32Stream = class(TJclSectoredStream)
protected
procedure AfterBlockRead; override;
procedure BeforeBlockWrite; override;
public
constructor Create(AStorageStream: TStream; AOwnsStream: Boolean = False);
end;
{$IFDEF CLR}
{$IFDEF BDS5_UP}
{$DEFINE SIZE64}
{$ENDIF ~BDS5_UP}
{$ELSE ~CLR}
{$IFDEF COMPILER7_UP}
{$DEFINE SIZE64}
{$ENDIF ~COMPILER7_UP}
{$ENDIF ~CLR}
TJclSplitStream = class(TJclStream)
private
FVolume: TStream;
FVolumeIndex: Integer;
FVolumeMaxSize: Int64;
FPosition: Int64;
FVolumePosition: Int64;
protected
function GetVolume(Index: Integer): TStream; virtual; abstract;
function GetVolumeMaxSize(Index: Integer): Int64; virtual; abstract;
function GetSize: Int64; {$IFDEF SIZE64}override;{$ENDIF SIZE64}
procedure SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64); override;
procedure InternalLoadVolume(Index: Integer);
public
constructor Create;
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
{$IFDEF CLR}
function Read(var Buffer: array of Byte; Offset, Count: Longint): Longint; override;
function Write(const Buffer: array of Byte; Offset, Count: Longint): Longint; override;
{$ELSE ~CLR}
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
{$ENDIF ~CLR}
end;
TJclVolumeEvent = function(Index: Integer): TStream of object;
TJclVolumeMaxSizeEvent = function(Index: Integer): Int64 of object;
TJclDynamicSplitStream = class(TJclSplitStream)
private
FOnVolume: TJclVolumeEvent;
FOnVolumeMaxSize: TJclVolumeMaxSizeEvent;
protected
function GetVolume(Index: Integer): TStream; override;
function GetVolumeMaxSize(Index: Integer): Int64; override;
public
property OnVolume: TJclVolumeEvent read FOnVolume write FOnVolume;
property OnVolumeMaxSize: TJclVolumeMaxSizeEvent read FOnVolumeMaxSize
write FOnVolumeMaxSize;
end;
TJclSplitVolume = class
public
MaxSize: Int64;
Stream: TStream;
OwnStream: Boolean;
end;
TJclStaticSplitStream = class(TJclSplitStream)
private
FVolumes: TObjectList;
function GetVolumeCount: Integer;
protected
function GetVolume(Index: Integer): TStream; override;
function GetVolumeMaxSize(Index: Integer): Int64; override;
public
constructor Create;
destructor Destroy; override;
function AddVolume(AStream: TStream; AMaxSize: Int64 = 0;
AOwnStream: Boolean = False): Integer;
property VolumeCount: Integer read GetVolumeCount;
property Volumes[Index: Integer]: TStream read GetVolume;
property VolumeMaxSizes[Index: Integer]: Int64 read GetVolumeMaxSize;
end;
TJclStringStream = class(TJclBufferedStream)
protected
FBOM: array of Byte;
FCharacterReader: TJclStreamGetNextCharFunc;
FCharacterWriter: TJclStreamSetNextCharFunc;
FPeekPosition: Int64;
function GetCalcedSize: Int64; override;
public
constructor Create(AStream: TStream; AOwnsStream: Boolean = False); virtual;
function ReadString(var Buffer: string; Start, Count: Longint): Longint;
function ReadAnsiString(var Buffer: AnsiString; Start, Count: Longint): Longint;
function ReadWideString(var Buffer: WideString; Start, Count: Longint): Longint;
function WriteString(const Buffer: string; Start, Count: Longint): Longint;
function WriteAnsiString(const Buffer: AnsiString; Start, Count: Longint): Longint;
function WriteWideString(const Buffer: WideString; Start, Count: Longint): Longint;
function PeekChar(var Buffer: Char): Boolean;
function PeekAnsiChar(var Buffer: AnsiChar): Boolean;
function PeekWideChar(var Buffer: WideChar): Boolean;
function ReadChar(var Buffer: Char): Boolean;
function ReadAnsiChar(var Buffer: AnsiChar): Boolean;
function ReadWideChar(var Buffer: WideChar): Boolean;
function WriteChar(Value: Char): Boolean;
function WriteAnsiChar(Value: AnsiChar): Boolean;
function WriteWideChar(Value: WideChar): Boolean;
function SkipBOM: LongInt; virtual;
function WriteBOM: Longint; virtual;
end;
TJclStringStreamClass = class of TJclStringStream;
TJclAnsiStream = class(TJclStringStream)
public
constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override;
end;
TJclUTF8Stream = class(TJclStringStream)
public
constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override;
end;
TJclUTF16Stream = class(TJclStringStream)
public
constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override;
end;
TJclStringEncoding = (seAnsi, seUTF8, seUTF16, seAuto);
TJclAutoStream = class(TJclStringStream)
private
FEncoding: TJclStringEncoding;
public
constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override;
function SkipBOM: LongInt; override;
property Encoding: TJclStringEncoding read FEncoding;
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;
// buffered copy of all available bytes from Source to Dest
// returns the number of bytes that were copied
function StreamCopy(Source: TStream; Dest: TStream; BufferSize: Longint = 4096): Int64;
// buffered copy of all available characters from Source to Dest
// retuns the number of characters (in specified encoding) that were copied
function StringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = 4096): Int64;
function AnsiStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = 4096): Int64;
function WideStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = 4096): Int64;
// compares 2 streams for differencies
function CompareStreams(A, B : TStream; BufferSize: Longint = 4096): Boolean;
// compares 2 files for differencies (calling CompareStreams)
function CompareFiles(const FileA, FileB: TFileName; BufferSize: Longint = 4096): Boolean;
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/source/common/JclStreams.pas $';
Revision: '$Revision: 2600 $';
Date: '$Date: 2009-01-18 19:59:35 +0100 (dim., 18 janv. 2009) $';
LogPath: 'JCL\source\common'
);
{$ENDIF UNITVERSIONING}
implementation
uses
{$IFDEF CLR}
System.Text,
{$ENDIF CLR}
JclResources, JclMath;
{$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;
function StreamCopy(Source: TStream; Dest: TStream; BufferSize: Longint): Int64;
var
Buffer: array of Byte;
ByteCount: Longint;
begin
Result := 0;
SetLength(Buffer, BufferSize);
repeat
{$IFDEF CLR}
ByteCount := Source.Read(Buffer, 0, BufferSize);
{$ELSE ~CLR}
ByteCount := Source.Read(Buffer[0], BufferSize);
{$ENDIF ~CLR}
Result := Result + ByteCount;
{$IFDEF CLR}
Dest.WriteBuffer(Buffer, ByteCount);
{$ELSE ~CLR}
Dest.WriteBuffer(Buffer[0], ByteCount);
{$ENDIF ~CLR}
until ByteCount < BufferSize;
end;
function StringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = 4096): Int64;
var
Buffer: string;
CharCount: Longint;
begin
Result := 0;
SetLength(Buffer, BufferLength);
repeat
CharCount := Source.ReadString(Buffer, 1, BufferLength);
Result := Result + CharCount;
CharCount := Dest.WriteString(Buffer, 1, CharCount);
until CharCount = 0;
end;
function AnsiStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = 4096): Int64;
var
Buffer: AnsiString;
CharCount: Longint;
begin
Result := 0;
SetLength(Buffer, BufferLength);
repeat
CharCount := Source.ReadAnsiString(Buffer, 1, BufferLength);
Result := Result + CharCount;
CharCount := Dest.WriteAnsiString(Buffer, 1, CharCount);
until CharCount = 0;
end;
function WideStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = 4096): Int64;
var
Buffer: WideString;
CharCount: Longint;
begin
Result := 0;
SetLength(Buffer, BufferLength);
repeat
CharCount := Source.ReadWideString(Buffer, 1, BufferLength);
Result := Result + CharCount;
CharCount := Dest.WriteWideString(Buffer, 1, CharCount);
until CharCount = 0;
end;
function CompareStreams(A, B : TStream; BufferSize: Longint = 4096): Boolean;
var
BufferA, BufferB: array of Byte;
ByteCountA, ByteCountB: Longint;
{$IFDEF CLR}
Index: Longint;
{$ENDIF CLR}
begin
SetLength(BufferA, BufferSize);
try
SetLength(BufferB, BufferSize);
try
repeat
{$IFDEF CLR}
ByteCountA := A.Read(BufferA, 0, BufferSize);
ByteCountB := A.Read(BufferB, 0, BufferSize);
{$ELSE ~CLR}
ByteCountA := A.Read(BufferA[0], BufferSize);
ByteCountB := B.Read(BufferB[0], BufferSize);
{$ENDIF ~CLR}
Result := (ByteCountA = ByteCountB);
{$IFDEF CLR}
if Result then
for Index := 0 to ByteCountA - 1 do
if BufferA[Index] <> BufferB[Index] then
begin
Result := False;
Break;
end;
{$ELSE CLR}
Result := Result and CompareMem(BufferA, BufferB, ByteCountA);
{$ENDIF ~CLR}
until (ByteCountA <> BufferSize) or (ByteCountB <> BufferSize) or not Result;
finally
SetLength(BufferB, 0);
end;
finally
SetLength(BufferA, 0);
end;
end;
function CompareFiles(const FileA, FileB: TFileName; BufferSize: Longint = 4096): Boolean;
var
A, B: TStream;
begin
A := TFileStream.Create(FileA, fmOpenRead or fmShareDenyWrite);
try
B := TFileStream.Create(FileB, fmOpenRead or fmShareDenyWrite);
try
Result := CompareStreams(A, B, BufferSize);
finally
B.Free;
end;
finally
A.Free;
end;
end;
//=== { TJclStream } =========================================================
{$IFNDEF CLR}
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;
{$ENDIF ~CLR}
function TJclStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
// override to customize
Result := -1;
end;
{$IFNDEF CLR}
procedure TJclStream.SetSize(NewSize: Longint);
begin
SetSize(Int64(NewSize));
end;
{$ENDIF ~CLR}
procedure TJclStream.SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64);
begin
// override to customize
end;
{$IFNDEF CLR}
//=== { 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
{$IFDEF KYLIX}
Result := __lseek(Handle, Offset, SeekOrigins[Origin]);
{$ELSE}
Result := lseek(Handle, Offset, SeekOrigins[Origin]);
{$ENDIF}
end;
{$ENDIF LINUX}
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: TFileName; Mode: Word; Rights: Cardinal);
var
H: THandle;
{$IFDEF LINUX}
const
INVALID_HANDLE_VALUE = -1;
{$ENDIF LINUX}
begin
if Mode = fmCreate then
begin
{$IFDEF LINUX}
{$IFDEF KYLIX}
H := __open(PChar(FileName), O_CREAT or O_RDWR, FileAccessRights);
{$ELSE ~KYLIX}
H := open(PChar(FileName), O_CREAT or O_RDWR, $666);
{$ENDIF}
{$ELSE ~LINUX}
H := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
{$ENDIF ~LINUX}
inherited Create(H);
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;
{$ENDIF ~CLR}
//=== { TJclEmptyStream } ====================================================
// a stream which stays empty no matter what you do
// so it is a Unix /dev/null equivalent
procedure TJclEmptyStream.SetSize({$IFNDEF CLR}const{$ENDIF CLR} NewSize: Int64);
begin
// nothing
end;
{$IFDEF CLR}
function TJclEmptyStream.Read(var Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclEmptyStream.Read(var Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
begin
// you cannot read anything
Result := 0;
end;
{$IFDEF CLR}
function TJclEmptyStream.Write(const Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclEmptyStream.Write(const Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
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({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64);
begin
if NewSize > 0 then
FSize := NewSize
else
FSize := 0;
if FPosition > FSize then
FPosition := FSize;
end;
{$IFDEF CLR}
function TJclNullStream.Read(var Buffer: array of Byte; Offset, Count: Longint): Longint;
var
Index: Longint;
{$ELSE ~CLR}
function TJclNullStream.Read(var Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
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
{$IFDEF CLR}
for Index := Offset to Offset + Count - 1 do
Buffer[Index] := 0;
{$ELSE ~CLR}
FillChar(Buffer, Count, 0);
{$ENDIF ~CLR}
FPosition := FPosition + Count;
end;
Result := Count;
end;
{$IFDEF CLR}
function TJclNullStream.Write(const Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclNullStream.Write(const Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
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
{$IFDEF CLR}
constructor TJclRandomStream.Create;
begin
inherited Create;
FRandomGenerator := System.Random.Create;
end;
destructor TJclRandomStream.Destroy;
begin
FRandomGenerator.Free;
inherited Destroy;
end;
{$ENDIF CLR}
function TJclRandomStream.GetRandSeed: Longint;
begin
{$IFDEF CLR}
Result := 0;
{$ELSE ~CLR}
Result := System.RandSeed;
{$ENDIF ~CLR}
end;
procedure TJclRandomStream.SetRandSeed(Seed: Longint);
begin
{$IFDEF CLR}
FRandomGenerator.Free;
FRandomGenerator := System.Random.Create(Seed);
{$ELSE ~CLR}
System.RandSeed := Seed;
{$ENDIF ~CLR}
end;
function TJclRandomStream.RandomData: Byte;
begin
{$IFDEF CLR}
Result := FRandomGenerator.Next(256);
{$ELSE ~CLR}
Result := System.Random(256);
{$ENDIF ~CLR}
end;
procedure TJclRandomStream.Randomize;
begin
{$IFNDEF CLR}
System.Randomize;
{$ENDIF ~CLR}
end;
{$IFDEF CLR}
function TJclRandomStream.Read(var Buffer: array of Byte; Offset, Count: Longint): Longint;
var
I: Longint;
begin
// this handles all necessary checks
Count := inherited Read(Buffer, Offset, Count);
for I := Offset to Offset + Count - 1 do
Buffer[I] := RandomData;
Result := Count;
end;
{$ELSE ~CLR}
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;
{$ENDIF ~CLR}
//=== { 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
{$IFDEF CLR}
Result := FStreams.Add(NewStream);
{$ELSE ~CLR}
Result := FStreams.Add(Pointer(NewStream));
{$ENDIF ~CLR}
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;
{$IFDEF CLR}
function TJclMultiplexStream.Read(var Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclMultiplexStream.Read(var Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
var
Stream: TStream;
begin
Stream := ReadStream;
if Assigned(Stream) then
Result := Stream.Read(Buffer, {$IFDEF CLR}Offset,{$ENDIF CLR} Count)
else
Result := 0;
end;
function TJclMultiplexStream.Remove(AStream: TStream): Integer;
begin
{$IFDEF CLR}
Result := FStreams.Remove(AStream);
{$ELSE ~CLR}
Result := FStreams.Remove(Pointer(AStream));
{$ENDIF ~CLR}
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
{$IFDEF CLR}
FReadStreamIndex := FStreams.IndexOf(Value);
{$ELSE ~CLR}
FReadStreamIndex := FStreams.IndexOf(Pointer(Value));
{$ENDIF ~CLR}
end;
procedure TJclMultiplexStream.SetReadStreamIndex(const Value: Integer);
begin
FReadStreamIndex := Value;
end;
procedure TJclMultiplexStream.SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64);
begin
// what should this function do?
end;
procedure TJclMultiplexStream.SetStream(Index: Integer; const Value: TStream);
begin
FStreams.Items[Index] := {$IFDEF CLR}Value;{$ELSE ~CLR}Pointer(Value){$ENDIF ~CLR};
end;
{$IFDEF CLR}
function TJclMultiplexStream.Write(const Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclMultiplexStream.Write(const Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
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, {$IFDEF CLR}Offset,{$ENDIF CLR} 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;
{$IFDEF CLR}
function TJclStreamDecorator.Read(var Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclStreamDecorator.Read(var Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
begin
if Assigned(FStream) then
Result := Stream.Read(Buffer, {$IFDEF CLR}Offset,{$ENDIF CLR} Count)
else
Result := 0;
end;
function TJclStreamDecorator.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
Result := StreamSeek(Stream, Offset, Origin);
end;
procedure TJclStreamDecorator.SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} 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;
{$IFDEF CLR}
function TJclStreamDecorator.Write(const Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclStreamDecorator.Write(const Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
begin
if Assigned(FStream) then
Result := Stream.Write(Buffer, {$IFDEF CLR}Offset,{$ENDIF CLR} Count)
else
Result := 0;
end;
//=== { TJclBufferedStream } =================================================
constructor TJclBufferedStream.Create(AStream: TStream; AOwnsStream: Boolean = False);
begin
inherited Create(AStream, AOwnsStream);
if Stream <> nil then
FPosition := Stream.Position;
BufferSize := 4096;
end;
destructor TJclBufferedStream.Destroy;
begin
Flush;
inherited Destroy;
end;
function TJclBufferedStream.BufferHit: Boolean;
begin
Result := (FBufferStart <= FPosition) and (FPosition < (FBufferStart + FBufferCurrentSize));
end;
procedure TJclBufferedStream.DoAfterStreamChange;
begin
inherited DoAfterStreamChange;
FBufferCurrentSize := 0; // invalidate buffer after stream is changed
FBufferStart := 0;
if Stream <> nil then
FPosition := Stream.Position;
end;
procedure TJclBufferedStream.DoBeforeStreamChange;
begin
inherited DoBeforeStreamChange;
Flush;
end;
procedure TJclBufferedStream.Flush;
begin
if (Stream <> nil) and (FBufferMaxModifiedPos > 0) then
begin
Stream.Position := FBufferStart;
{$IFDEF CLR}
Stream.WriteBuffer(FBuffer, FBufferMaxModifiedPos);
{$ELSE ~CLR}
Stream.WriteBuffer(FBuffer[0], FBufferMaxModifiedPos);
{$ENDIF ~CLR}
FBufferMaxModifiedPos := 0;
end;
end;
function TJclBufferedStream.GetCalcedSize: Int64;
begin
if Assigned(Stream) then
Result := Stream.Size
else
Result := 0;
if Result < FBufferMaxModifiedPos + FBufferStart then
Result := FBufferMaxModifiedPos + FBufferStart;
end;
function TJclBufferedStream.LoadBuffer: Boolean;
begin
Flush;
if Length(FBuffer) <> FBufferSize then
SetLength(FBuffer, FBufferSize);
if Stream <> nil then
begin
Stream.Position := FPosition;
{$IFDEF CLR}
FBufferCurrentSize := Stream.Read(FBuffer, FBufferSize);
{$ELSE ~CLR}
FBufferCurrentSize := Stream.Read(FBuffer[0], FBufferSize);
{$ENDIF ~CLR}
end
else
FBufferCurrentSize := 0;
FBufferStart := FPosition;
Result := (FBufferCurrentSize > 0);
end;
{$IFDEF CLR}
function TJclBufferedStream.Read(var Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclBufferedStream.Read(var Buffer; Count: Longint): Longint;
const
Offset = 0;
{$ENDIF ~CLR}
begin
Result := Count + Offset;
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 - Offset;
end;
{$IFDEF CLR}
function TJclBufferedStream.ReadFromBuffer(var Buffer: array of Byte; Count, Start: Longint): Longint;
{$ELSE ~CLR}
function TJclBufferedStream.ReadFromBuffer(var Buffer; Count, Start: Longint): Longint;
{$ENDIF ~CLR}
var
BufPos: Longint;
{$IFDEF CLR}
I: Longint;
{$ELSE ~CLR}
P: PAnsiChar;
{$ENDIF ~CLR}
begin
Result := Count;
BufPos := FPosition - FBufferStart;
if Result > FBufferCurrentSize - BufPos then
Result := FBufferCurrentSize - BufPos;
{$IFDEF CLR}
for I := 0 to Result - 1 do
Buffer[Start + I] := FBuffer[BufPos + I];
{$ELSE ~CLR}
P := @Buffer;
Move(FBuffer[BufPos], P[Start], Result);
{$ENDIF ~CLR}
Inc(FPosition, Result);
end;
function TJclBufferedStream.Seek(const Offset: Int64;
Origin: TSeekOrigin): Int64;
var
NewPos: Int64;
begin
NewPos := FPosition;
case Origin of
soBeginning:
NewPos := Offset;
soCurrent:
Inc(NewPos, Offset);
soEnd:
NewPos := GetCalcedSize + Offset;
else
NewPos := -1;
end;
if NewPos < 0 then
NewPos := -1
else
FPosition := NewPos;
Result := NewPos;
end;
procedure TJclBufferedStream.SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64);
begin
inherited SetSize(NewSize);
if NewSize < (FBufferStart + FBufferMaxModifiedPos) then
begin
FBufferMaxModifiedPos := NewSize - FBufferStart;
if FBufferMaxModifiedPos < 0 then
FBufferMaxModifiedPos := 0;
end;
if NewSize < (FBufferStart + FBufferCurrentSize) then
begin
FBufferCurrentSize := NewSize - FBufferStart;
if FBufferCurrentSize < 0 then
FBufferCurrentSize := 0;
end;
// fix from Marcelo Rocha
if Stream <> nil then
FPosition := Stream.Position;
end;
{$IFDEF CLR}
function TJclBufferedStream.Write(const Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclBufferedStream.Write(const Buffer; Count: Longint): Longint;
const
Offset = 0;
{$ENDIF ~CLR}
begin
Result := Count + Offset;
while Count > 0 do
begin
if not BufferHit then
begin
if (FBufferStart <= FPosition) and (FPosition < (FBufferStart + FBufferSize)) then
begin
if Length(FBuffer) <> FBufferSize then
SetLength(FBuffer, FBufferSize);
end
else
LoadBuffer;
end;
Dec(Count, WriteToBuffer(Buffer, Count, Result - Count));
end;
Result := Result - Count - Offset;
end;
{$IFDEF CLR}
function TJclBufferedStream.WriteToBuffer(const Buffer: array of Byte; Count, Start: Longint): Longint;
{$ELSE ~CLR}
function TJclBufferedStream.WriteToBuffer(const Buffer; Count, Start: Longint): Longint;
{$ENDIF ~CLR}
var
BufPos: Longint;
{$IFDEF CLR}
I: Longint;
{$ELSE ~CLR}
P: PAnsiChar;
{$ENDIF ~CLR}
begin
Result := Count;
BufPos := FPosition - FBufferStart;
if Result > Length(FBuffer) - BufPos then
Result := Length(FBuffer) - BufPos;
if FBufferCurrentSize < BufPos + Result then
FBufferCurrentSize := BufPos + Result;
{$IFDEF CLR}
for I := 0 to Result - 1 do
FBuffer[BufPos + I] := Buffer[Start + I];
{$ELSE ~CLR}
P := @Buffer;
Move(P[Start], FBuffer[BufPos], Result);
{$ENDIF ~CLR}
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;
{$IFDEF CLR}
function TJclEventStream.Read(var Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclEventStream.Read(var Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
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;
procedure TJclEventStream.SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64);
begin
inherited SetSize(NewSize);
DoNotification;
end;
{$IFDEF CLR}
function TJclEventStream.Write(const Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclEventStream.Write(const Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
begin
Result := inherited Write(Buffer, Count);
DoNotification;
end;
//=== { TJclEasyStream } =====================================================
function TJclEasyStream.IsEqual(Stream: TStream): Boolean;
var
SavePos, StreamSavePos: Int64;
begin
SavePos := Position;
StreamSavePos := Stream.Position;
try
Position := 0;
Stream.Position := 0;
Result := CompareStreams(Self, Stream);
finally
Position := SavePos;
Stream.Position := StreamSavePos;
end;
end;
function TJclEasyStream.ReadBoolean: Boolean;
begin
{$IFDEF CLR}
ReadBuffer(Result);
{$ELSE ~CLR}
ReadBuffer(Result, SizeOf(Result));
{$ENDIF ~CLR}
end;
function TJclEasyStream.ReadChar: Char;
begin
{$IFDEF CLR}
ReadBuffer(Result);
{$ELSE ~CLR}
ReadBuffer(Result, SizeOf(Result));
{$ENDIF ~CLR}
end;
function TJclEasyStream.ReadAnsiChar: AnsiChar;
begin
{$IFDEF CLR}
ReadBuffer(Result);
{$ELSE ~CLR}
ReadBuffer(Result, SizeOf(Result));
{$ENDIF ~CLR}
end;
function TJclEasyStream.ReadWideChar: WideChar;
begin
{$IFDEF CLR}
ReadBuffer(Result);
{$ELSE ~CLR}
ReadBuffer(Result, SizeOf(Result));
{$ENDIF ~CLR}
end;
function TJclEasyStream.ReadByte: Byte;
begin
{$IFDEF CLR}
ReadBuffer(Result);
{$ELSE ~CLR}
ReadBuffer(Result, SizeOf(Result));
{$ENDIF ~CLR}
end;
{$IFNDEF CLR}
function TJclEasyStream.ReadCurrency: Currency;
begin
ReadBuffer(Result, SizeOf(Result));
end;
function TJclEasyStream.ReadDateTime: TDateTime;
begin
ReadBuffer(Result, SizeOf(Result));
end;
{$ENDIF ~CLR}
function TJclEasyStream.ReadDouble: Double;
begin
{$IFDEF CLR}
ReadBuffer(Result);
{$ELSE ~CLR}
ReadBuffer(Result, SizeOf(Result));
{$ENDIF ~CLR}
end;
{$IFNDEF CLR}
function TJclEasyStream.ReadExtended: Extended;
begin
ReadBuffer(Result, SizeOf(Result));
end;
{$ENDIF ~CLR}
function TJclEasyStream.ReadInt64: Int64;
begin
{$IFDEF CLR}
ReadBuffer(Result);
{$ELSE ~CLR}
ReadBuffer(Result, SizeOf(Result));
{$ENDIF ~CLR}
end;
function TJclEasyStream.ReadInteger: Integer;
begin
{$IFDEF CLR}
ReadBuffer(Result);
{$ELSE ~CLR}
ReadBuffer(Result, SizeOf(Result));
{$ENDIF ~CLR}
end;
function TJclEasyStream.ReadCString: string;
begin
{$IFDEF SUPPORTS_UNICODE}
Result := ReadCWideString;
{$ELSE ~SUPPORTS_UNICODE}
Result := ReadCAnsiString;
{$ENDIF ~SUPPORTS_UNICODE}
end;
function TJclEasyStream.ReadCAnsiString: AnsiString;
var
{$IFDEF CLR}
SB: System.Text.StringBuilder;
Ch: AnsiChar;
{$ELSE ~CLR}
CurrPos: Longint;
StrSize: Integer;
{$ENDIF ~CLR}
begin
{$IFDEF CLR}
SB := System.Text.StringBuilder.Create;
repeat
Ch := ReadAnsiChar;
if Ch <> #0 then
SB.Append(Ch);
until Ch = #0;
Result := SB.ToString;
{$ELSE ~CLR}
CurrPos := Position;
repeat
until ReadAnsiChar = #0;
StrSize := Position - CurrPos - 1;
SetLength(Result, StrSize);
Position := CurrPos;
ReadBuffer(Result[1], StrSize * SizeOf(Result[1]));
Position := Position + 1;
{$ENDIF ~CLR}
end;
function TJclEasyStream.ReadCWideString: WideString;
var
{$IFDEF CLR}
SB: System.Text.StringBuilder;
Ch: WideChar;
{$ELSE ~CLR}
CurrPos: Integer;
StrSize: Integer;
{$ENDIF ~CLR}
begin
{$IFDEF CLR}
SB := System.Text.StringBuilder.Create;
repeat
Ch := ReadWideChar;
if Ch <> #0 then
SB.Append(Ch);
until Ch = #0;
Result := SB.ToString;
{$ELSE ~CLR}
CurrPos := Position;
repeat
until ReadWideChar = #0;
StrSize := Position - CurrPos - 1;
SetLength(Result, StrSize);
Position := CurrPos;
ReadBuffer(Result[1], StrSize * SizeOf(Result[1]));
Position := Position + 1;
{$ENDIF ~CLR}
end;
function TJclEasyStream.ReadShortString: string;
var
{$IFDEF CLR}
SB: System.Text.StringBuilder;
{$ENDIF CLR}
StrSize: Integer;
begin
StrSize := Ord(ReadChar);
{$IFDEF CLR}
SB := System.Text.StringBuilder.Create(StrSize);
while StrSize > 0 do
begin
SB.Append(ReadChar);
Dec(StrSize);
end;
Result := SB.ToString;
{$ELSE ~CLR}
SetString(Result, PChar(nil), StrSize);
ReadBuffer(Pointer(Result)^, StrSize);
{$ENDIF ~CLR}
end;
function TJclEasyStream.ReadSingle: Single;
begin
{$IFDEF CLR}
ReadBuffer(Result);
{$ELSE ~CLR}
ReadBuffer(Result, SizeOf(Result));
{$ENDIF ~CLR}
end;
function TJclEasyStream.ReadSizedString: string;
begin
{$IFDEF SUPPORTS_UNICODE}
Result := ReadSizedWideString;
{$ELSE ~SUPPORTS_UNICODE}
Result := ReadSizedAnsiString;
{$ENDIF ~SUPPORTS_UNICODE}
end;
function TJclEasyStream.ReadSizedAnsiString: AnsiString;
var
{$IFDEF CLR}
SB: System.Text.StringBuilder;
{$ENDIF CLR}
StrSize: Integer;
begin
StrSize := ReadInteger;
{$IFDEF CLR}
SB := System.Text.StringBuilder.Create(StrSize);
while StrSize > 0 do
begin
SB.Append(ReadAnsiChar);
Dec(StrSize);
end;
Result := SB.ToString;
{$ELSE ~CLR}
SetLength(Result, StrSize);
ReadBuffer(Result[1], StrSize * SizeOf(Result[1]));
{$ENDIF ~CLR}
end;
function TJclEasyStream.ReadSizedWideString: WideString;
var
{$IFDEF CLR}
SB: System.Text.StringBuilder;
{$ENDIF CLR}
StrSize: Integer;
begin
StrSize := ReadInteger;
{$IFDEF CLR}
SB := System.Text.StringBuilder.Create(StrSize);
while StrSize > 0 do
begin
SB.Append(ReadWideChar);
Dec(StrSize);
end;
Result := SB.ToString;
{$ELSE ~CLR}
SetLength(Result, StrSize);
ReadBuffer(Result[1], StrSize * SizeOf(Result[1]));
{$ENDIF ~CLR}
end;
procedure TJclEasyStream.WriteBoolean(Value: Boolean);
begin
{$IFDEF CLR}
WriteBuffer(Value);
{$ELSE ~CLR}
WriteBuffer(Value, SizeOf(Value));
{$ENDIF ~CLR}
end;
procedure TJclEasyStream.WriteChar(Value: Char);
begin
{$IFDEF CLR}
WriteBuffer(Value);
{$ELSE ~CLR}
WriteBuffer(Value, SizeOf(Value));
{$ENDIF ~CLR}
end;
procedure TJclEasyStream.WriteAnsiChar(Value: AnsiChar);
begin
{$IFDEF CLR}
WriteBuffer(Value);
{$ELSE ~CLR}
WriteBuffer(Value, SizeOf(Value));
{$ENDIF ~CLR}
end;
procedure TJclEasyStream.WriteWideChar(Value: WideChar);
begin
{$IFDEF CLR}
WriteBuffer(Value);
{$ELSE ~CLR}
WriteBuffer(Value, SizeOf(Value));
{$ENDIF ~CLR}
end;
procedure TJclEasyStream.WriteByte(Value: Byte);
begin
{$IFDEF CLR}
WriteBuffer(Value);
{$ELSE ~CLR}
WriteBuffer(Value, SizeOf(Value));
{$ENDIF ~CLR}
end;
{$IFNDEF CLR}
procedure TJclEasyStream.WriteCurrency(const Value: Currency);
begin
WriteBuffer(Value, SizeOf(Value));
end;
procedure TJclEasyStream.WriteDateTime(const Value: TDateTime);
begin
WriteBuffer(Value, SizeOf(Value));
end;
{$ENDIF ~CLR}
procedure TJclEasyStream.WriteDouble(const Value: Double);
begin
{$IFDEF CLR}
WriteBuffer(Value);
{$ELSE ~CLR}
WriteBuffer(Value, SizeOf(Value));
{$ENDIF ~CLR}
end;
{$IFNDEF CLR}
procedure TJclEasyStream.WriteExtended(const Value: Extended);
begin
WriteBuffer(Value, SizeOf(Value));
end;
{$ENDIF ~CLR}
procedure TJclEasyStream.WriteInt64(Value: Int64);
begin
{$IFDEF CLR}
WriteBuffer(Value);
{$ELSE ~CLR}
WriteBuffer(Value, SizeOf(Value));
{$ENDIF ~CLR}
end;
procedure TJclEasyStream.WriteInteger(Value: Integer);
begin
{$IFDEF CLR}
WriteBuffer(Value);
{$ELSE ~CLR}
WriteBuffer(Value, SizeOf(Value));
{$ENDIF ~CLR}
end;
procedure TJclEasyStream.WriteCString(const Value: string);
begin
{$IFDEF SUPPORTS_UNICODE}
WriteCWideString(Value);
{$ELSE ~SUPPORTS_UNICODE}
WriteCAnsiString(Value);
{$ENDIF ~SUPPORTS_UNICODE}
end;
procedure TJclEasyStream.WriteCAnsiString(const Value: AnsiString);
var
StrSize: Integer;
{$IFDEF CLR}
I: Longint;
{$ENDIF CLR}
begin
StrSize := Length(Value);
{$IFDEF CLR}
for I := 1 to StrSize do
WriteAnsiChar(Value[I]);
WriteAnsiChar(#0);
{$ELSE ~CLR}
WriteBuffer(Value[1], (StrSize + 1) * SizeOf(Value[1]));
{$ENDIF ~CLR}
end;
procedure TJclEasyStream.WriteCWideString(const Value: WideString);
var
StrSize: Integer;
{$IFDEF CLR}
I: Integer;
{$ENDIF CLR}
begin
StrSize := Length(Value);
{$IFDEF CLR}
for I := 1 to StrSize do
WriteWideChar(Value[I]);
WriteWideChar(#0);
{$ELSE ~CLR}
WriteBuffer(Value[1], (StrSize + 1) * SizeOf(Value[1]));
{$ENDIF ~CLR}
end;
{$IFDEF KEEP_DEPRECATED}
procedure TJclEasyStream.WriteStringDelimitedByNull(const Value: string);
begin
WriteCString(Value);
end;
{$ENDIF KEEP_DEPRECATED}
procedure TJclEasyStream.WriteShortString(const Value: ShortString);
{$IFDEF CLR}
var
I: Longint;
{$ENDIF CLR}
begin
{$IFDEF CLR}
for I := 0 to Length(Value) do
inherited WriteBuffer(Value[I]);
{$ELSE ~CLR}
WriteBuffer(Value[0], Length(Value) + 1);
{$ENDIF ~CLR}
end;
procedure TJclEasyStream.WriteSingle(const Value: Single);
begin
{$IFDEF CLR}
WriteBuffer(Value);
{$ELSE ~CLR}
WriteBuffer(Value, SizeOf(Value));
{$ENDIF ~~ CLR}
end;
procedure TJclEasyStream.WriteSizedString(const Value: string);
begin
{$IFDEF SUPPORTS_UNICODE}
WriteSizedWideString(Value);
{$ELSE ~SUPPORTS_UNICODE}
WriteSizedAnsiString(Value);
{$ENDIF ~SUPPORTS_UNICODE}
end;
procedure TJclEasyStream.WriteSizedAnsiString(const Value: AnsiString);
var
StrSize: Integer;
{$IFDEF CLR}
I: Longint;
{$ENDIF CLR}
begin
StrSize := Length(Value);
WriteInteger(StrSize);
{$IFDEF CLR}
for I := 1 to StrSize do
WriteAnsiChar(Value[I]);
{$ELSE ~CLR}
WriteBuffer(Value[1], StrSize * SizeOf(Value[1]));
{$ENDIF ~CLR}
end;
procedure TJclEasyStream.WriteSizedWideString(const Value: WideString);
var
StrSize: Integer;
{$IFDEF CLR}
I: Integer;
{$ENDIF CLR}
begin
StrSize := Length(Value);
WriteInteger(StrSize);
{$IFDEF CLR}
for I := 1 to StrSize do
WriteWideChar(Value[I]);
{$ELSE ~CLR}
WriteBuffer(Value[1], StrSize * SizeOf(Value[1]));
{$ENDIF ~CLR}
end;
//=== { TJclScopedStream } ===================================================
constructor TJclScopedStream.Create(AParentStream: TStream; AMaxSize: Int64);
begin
inherited Create;
FParentStream := AParentStream;
FStartPos := ParentStream.Position;
FCurrentPos := 0;
FMaxSize := AMaxSize;
end;
{$IFDEF CLR}
function TJclScopedStream.Read(var Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclScopedStream.Read(var Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
begin
if (MaxSize >= 0) and ((FCurrentPos + Count) > MaxSize) then
Count := MaxSize - FCurrentPos;
if (Count > 0) and Assigned(ParentStream) then
begin
Result := ParentStream.Read(Buffer, {$IFDEF CLR}Offset,{$ENDIF CLR} 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;
procedure TJclScopedStream.SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64);
var
ScopedNewSize: Int64;
begin
if (FMaxSize >= 0) and (NewSize >= (FStartPos + FMaxSize)) then
ScopedNewSize := FMaxSize + FStartPos
else
ScopedNewSize := NewSize;
inherited SetSize(ScopedNewSize);
end;
{$IFDEF CLR}
function TJclScopedStream.Write(const Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclScopedStream.Write(const Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
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({$IFNDEF CLR}const{$ENDIF ~CLR} 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;
{$IFDEF CLR}
function TJclDelegatedStream.Read(var Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclDelegatedStream.Read(var Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
begin
if Assigned(FOnRead) then
Result := FOnRead(Self, Buffer, {$IFDEF CLR}Offset,{$ENDIF CLR} Count)
else
Result := -1;
end;
{$IFDEF CLR}
function TJclDelegatedStream.Write(const Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclDelegatedStream.Write(const Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
begin
if Assigned(FOnWrite) then
Result := FOnWrite(Self, Buffer, {$IFDEF CLR}Offset,{$ENDIF CLR} Count)
else
Result := -1;
end;
//=== { TJclSectoredStream } =================================================
procedure TJclSectoredStream.AfterBlockRead;
begin
// override to customize (checks of protection)
end;
procedure TJclSectoredStream.BeforeBlockWrite;
begin
// override to customize (computation of protection)
end;
constructor TJclSectoredStream.Create(AStorageStream: TStream;
AOwnsStream: Boolean; ASectorOverHead: Integer);
begin
inherited Create(AStorageStream, AOwnsStream);
FSectorOverHead := ASectorOverHead;
if Stream <> nil then
FPosition := SectoredToFlat(Stream.Position);
end;
procedure TJclSectoredStream.DoAfterStreamChange;
begin
inherited DoAfterStreamChange;
if Stream <> nil then
FPosition := SectoredToFlat(Stream.Position);
end;
function TJclSectoredStream.FlatToSectored(const Position: Int64): Int64;
begin
Result := (Position div BufferSize) * (BufferSize + FSectorOverHead) // add overheads of previous buffers
+ Position mod BufferSize; // offset in sector
end;
procedure TJclSectoredStream.Flush;
begin
if (Stream <> nil) and (FBufferMaxModifiedPos > 0) then
begin
BeforeBlockWrite;
Stream.Position := FlatToSectored(FBufferStart);
{$IFDEF CLR}
Stream.WriteBuffer(FBuffer, FBufferCurrentSize + FSectorOverHead);
{$ELSE ~CLR}
Stream.WriteBuffer(FBuffer[0], FBufferCurrentSize + FSectorOverHead);
{$ENDIF ~CLR}
FBufferMaxModifiedPos := 0;
end;
end;
function TJclSectoredStream.GetCalcedSize: Int64;
var
VirtualSize: Int64;
begin
if Assigned(Stream) then
Result := SectoredToFlat(Stream.Size)
else
Result := 0;
VirtualSize := FBufferMaxModifiedPos + FBufferStart;
if Result < VirtualSize then
Result := VirtualSize;
end;
function TJclSectoredStream.LoadBuffer: Boolean;
var
TotalSectorSize: Longint;
begin
Flush;
TotalSectorSize := FBufferSize + FSectorOverHead;
if Length(FBuffer) <> TotalSectorSize then
SetLength(FBuffer, TotalSectorSize);
FBufferStart := (FPosition div BufferSize) * BufferSize;
if Stream <> nil then
begin
Stream.Position := FlatToSectored(FBufferStart);
{$IFDEF CLR}
FBufferCurrentSize := Stream.Read(FBuffer, TotalSectorSize);
{$ELSE ~CLR}
FBufferCurrentSize := Stream.Read(FBuffer[0], TotalSectorSize);
{$ENDIF ~CLR}
if FBufferCurrentSize > 0 then
begin
Dec(FBufferCurrentSize, FSectorOverHead);
AfterBlockRead;
end;
end
else
FBufferCurrentSize := 0;
Result := (FBufferCurrentSize > 0);
end;
function TJclSectoredStream.SectoredToFlat(const Position: Int64): Int64;
var
TotalSectorSize: Int64;
begin
TotalSectorSize := BufferSize + FSectorOverHead;
Result := (Position div TotalSectorSize) * BufferSize // remove previous overheads
+ Position mod TotalSectorSize; // offset in sector
end;
procedure TJclSectoredStream.SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64);
begin
inherited SetSize(FlatToSectored(NewSize));
end;
//=== { TJclCRC16Stream } ====================================================
procedure TJclCRC16Stream.AfterBlockRead;
var
CRC: Word;
begin
CRC := FBuffer[FBufferCurrentSize] + (FBuffer[FBufferCurrentSize + 1] shl 8);
if {$IFDEF COMPILER5}CheckCrc16D5{$ELSE}CheckCrc16{$ENDIF COMPILER5}(FBuffer, FBufferCurrentSize, CRC) < 0 then
{$IFDEF CLR}
raise EJclStreamError.Create(RsStreamsCRCError);
{$ELSE ~CLR}
raise EJclStreamError.CreateRes(@RsStreamsCRCError);
{$ENDIF ~CLR}
end;
procedure TJclCRC16Stream.BeforeBlockWrite;
var
CRC: Word;
begin
CRC := Crc16(FBuffer, FBufferCurrentSize);
FBuffer[FBufferCurrentSize] := CRC and $FF;
FBuffer[FBufferCurrentSize + 1] := CRC shr 8;
end;
constructor TJclCRC16Stream.Create(AStorageStream: TStream; AOwnsStream: Boolean);
begin
inherited Create(AStorageStream, AOwnsStream, 2);
end;
//=== { TJclCRC32Stream } ====================================================
procedure TJclCRC32Stream.AfterBlockRead;
var
CRC: Cardinal;
begin
CRC := FBuffer[FBufferCurrentSize] + (FBuffer[FBufferCurrentSize + 1] shl 8)
+ (FBuffer[FBufferCurrentSize + 2] shl 16) + (FBuffer[FBufferCurrentSize + 3] shl 24);
if {$IFDEF COMPILER5}CheckCrc32D5{$ELSE}CheckCrc32{$ENDIF COMPILER5}(FBuffer, FBufferCurrentSize, CRC) < 0 then
{$IFDEF CLR}
raise EJclStreamError.Create(RsStreamsCRCError);
{$ELSE ~CLR}
raise EJclStreamError.CreateRes(@RsStreamsCRCError);
{$ENDIF ~CLR}
end;
procedure TJclCRC32Stream.BeforeBlockWrite;
var
CRC: Cardinal;
begin
CRC := Crc32(FBuffer, FBufferCurrentSize);
FBuffer[FBufferCurrentSize] := CRC and $FF;
FBuffer[FBufferCurrentSize + 1] := (CRC shr 8) and $FF;
FBuffer[FBufferCurrentSize + 2] := (CRC shr 16) and $FF;
FBuffer[FBufferCurrentSize + 3] := (CRC shr 24) and $FF;
end;
constructor TJclCRC32Stream.Create(AStorageStream: TStream;
AOwnsStream: Boolean);
begin
inherited Create(AStorageStream, AOwnsStream, 4);
end;
//=== { TJclSplitStream } ====================================================
constructor TJclSplitStream.Create;
begin
inherited Create;
FVolume := nil;
FVolumeIndex := -1;
FVolumeMaxSize := 0;
FPosition := 0;
FVolumePosition := 0;
end;
function TJclSplitStream.GetSize: Int64;
var
OldVolumeIndex: Integer;
OldVolumePosition, OldPosition: Int64;
begin
OldVolumeIndex := FVolumeIndex;
OldVolumePosition := FVolumePosition;
OldPosition := FPosition;
Result := 0;
try
FVolumeIndex := -1;
repeat
InternalLoadVolume(FVolumeIndex + 1);
if not Assigned(FVolume) then
Break;
Result := Result + FVolume.Size;
until FVolume.Size = 0;
finally
InternalLoadVolume(OldVolumeIndex);
FPosition := OldPosition;
if Assigned(FVolume) then
FVolumePosition := StreamSeek(FVolume, OldVolumePosition, soBeginning);
end;
end;
procedure TJclSplitStream.InternalLoadVolume(Index: Integer);
begin
if Index = -1 then
Index := 0;
if Index <> FVolumeIndex then
begin
FVolumeIndex := Index;
FVolumePosition := 0;
FVolume := GetVolume(Index);
FVolumeMaxSize := GetVolumeMaxSize(Index);
if Assigned(FVolume) then
StreamSeek(FVolume, 0, soBeginning);
end;
end;
{$IFDEF CLR}
function TJclSplitStream.Read(var Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclSplitStream.Read(var Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
var
{$IFNDEF CLR}
Data: PByte;
{$ENDIF ~CLR}
Total, LoopRead: Longint;
begin
Result := 0;
InternalLoadVolume(FVolumeIndex);
if not Assigned(FVolume) then
Exit;
{$IFNDEF CLR}
Data := PByte(@Buffer);
{$ENDIF ~CLR}
Total := Count;
repeat
// try to read (Count) bytes from current stream
{$IFDEF CLR}
LoopRead := FVolume.Read(Buffer, Offset, Count);
{$ELSE ~CLR}
LoopRead := FVolume.Read(Data^, Count);
{$ENDIF ~CLR}
FVolumePosition := FVolumePosition + LoopRead;
FPosition := FPosition + LoopRead;
Inc(Result, LoopRead);
if Result = Total then
Break;
// with next volume
Dec(Count, Result);
{$IFDEF CLR}
Inc(Offset, Result);
{$ELSE ~CLR}
Inc(Data, Result);
{$ENDIF ~CLR}
InternalLoadVolume(FVolumeIndex + 1);
if not Assigned(FVolume) then
Break;
until False;
end;
function TJclSplitStream.Seek(const Offset: Int64;
Origin: TSeekOrigin): Int64;
var
ExpectedPosition, RemainingOffset: Int64;
begin
case TSeekOrigin(Origin) of
soBeginning:
ExpectedPosition := Offset;
soCurrent:
ExpectedPosition := FPosition + Offset;
soEnd:
ExpectedPosition := Size - Offset;
else
{$IFDEF CLR}
raise EJclStreamError.Create(RsStreamsSeekError);
{$ELSE ~CLR}
raise EJclStreamError.CreateRes(@RsStreamsSeekError);
{$ENDIF ~CLR}
end;
RemainingOffset := ExpectedPosition - FPosition;
Result := FPosition;
repeat
InternalLoadVolume(FVolumeIndex);
if not Assigned(FVolume) then
Break;
if RemainingOffset < 0 then
begin
// FPosition > ExpectedPosition, seek backward
if FVolumePosition >= -RemainingOffset then
begin
// seek in current volume
FVolumePosition := StreamSeek(FVolume, FVolumePosition + RemainingOffset, soBeginning);
Result := Result + RemainingOffset;
FPosition := Result;
RemainingOffset := 0;
end
else
begin
// seek to previous volume
if FVolumeIndex = 0 then
Exit;
// seek to the beginning of current volume
RemainingOffset := RemainingOffset + FVolumePosition;
Result := Result - FVolumePosition;
FPosition := Result;
FVolumePosition := StreamSeek(FVolume, 0, soBeginning);
// load previous volume
InternalLoadVolume(FVolumeIndex - 1);
if not Assigned(FVolume) then
Break;
Result := Result - FVolume.Size;
FPosition := Result;
RemainingOffset := RemainingOffset + FVolume.Size;
end;
end
else if RemainingOffset > 0 then
begin
// FPosition < ExpectedPosition, seek forward
if (FVolumeMaxSize = 0) or ((FVolumePosition + RemainingOffset) < FVolumeMaxSize) then
begin
// can seek in current volume
FVolumePosition := StreamSeek(FVolume, FVolumePosition + RemainingOffset, soBeginning);
Result := Result + RemainingOffset;
FPosition := Result;
RemainingOffset := 0;
end
else
begin
// seek to next volume
RemainingOffset := RemainingOffset - FVolumeMaxSize + FVolumePosition;
Result := Result + FVolumeMaxSize - FVolumePosition;
FPosition := Result;
InternalLoadVolume(FVolumeIndex + 1);
if not Assigned(FVolume) then
Break;
end;
end;
until RemainingOffset = 0;
end;
procedure TJclSplitStream.SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64);
var
OldVolumeIndex: Integer;
OldVolumePosition, OldPosition, RemainingSize, VolumeSize: Int64;
begin
OldVolumeIndex := FVolumeIndex;
OldVolumePosition := FVolumePosition;
OldPosition := FPosition;
RemainingSize := NewSize;
try
FVolumeIndex := 0;
repeat
InternalLoadVolume(FVolumeIndex);
if not Assigned(FVolume) then
Break;
if (FVolumeMaxSize > 0) and (RemainingSize > FVolumeMaxSize) then
VolumeSize := FVolumeMaxSize
else
VolumeSize := RemainingSize;
FVolume.Size := VolumeSize;
RemainingSize := RemainingSize - VolumeSize;
Inc(FVolumeIndex);
until RemainingSize = 0;
finally
InternalLoadVolume(OldVolumeIndex);
FPosition := OldPosition;
if Assigned(FVolume) then
FVolumePosition := StreamSeek(FVolume, OldVolumePosition, soBeginning);
end;
end;
{$IFDEF CLR}
function TJclSplitStream.Write(const Buffer: array of Byte; Offset, Count: Longint): Longint;
{$ELSE ~CLR}
function TJclSplitStream.Write(const Buffer; Count: Longint): Longint;
{$ENDIF ~CLR}
var
{$IFNDEF CLR}
Data: PByte;
{$ENDIF ~CLR}
Total, LoopWritten: Longint;
begin
Result := 0;
InternalLoadVolume(FVolumeIndex);
if not Assigned(FVolume) then
Exit;
{$IFNDEF CLR}
Data := PByte(@Buffer);
{$ENDIF ~CLR}
Total := Count;
repeat
// do not write more than (VolumeMaxSize) bytes in current stream
if (FVolumeMaxSize > 0) and ((Count + FVolumePosition) > FVolumeMaxSize) then
LoopWritten := FVolumeMaxSize - FVolumePosition
else
LoopWritten := Count;
// try to write (Count) bytes from current stream
{$IFDEF CLR}
LoopWritten := FVolume.Write(Buffer, Offset, LoopWritten);
{$ELSE ~CLR}
LoopWritten := FVolume.Write(Data^, LoopWritten);
{$ENDIF ~CLR}
FVolumePosition := FVolumePosition + LoopWritten;
FPosition := FPosition + LoopWritten;
Inc(Result, LoopWritten);
if Result = Total then
Break;
// with next volume
Dec(Count, LoopWritten);
{$IFDEF CLR}
Inc(Offset, LoopWritten);
{$ELSE ~CLR}
Inc(Data, LoopWritten);
{$ENDIF ~CLR}
InternalLoadVolume(FVolumeIndex + 1);
if not Assigned(FVolume) then
Break;
until False;
end;
//=== { TJclDynamicSplitStream } =============================================
function TJclDynamicSplitStream.GetVolume(Index: Integer): TStream;
begin
if Assigned(FOnVolume) then
Result := FOnVolume(Index)
else
Result := nil;
end;
function TJclDynamicSplitStream.GetVolumeMaxSize(Index: Integer): Int64;
begin
if Assigned(FOnVolumeMaxSize) then
Result := FOnVolumeMaxSize(Index)
else
Result := 0;
end;
//=== { TJclStaticSplitStream } ===========================================
constructor TJclStaticSplitStream.Create;
begin
inherited Create;
FVolumes := TObjectList.Create(True);
end;
destructor TJclStaticSplitStream.Destroy;
var
Index: Integer;
AVolumeRec: TJclSplitVolume;
begin
if Assigned(FVolumes) then
begin
for Index := 0 to FVolumes.Count - 1 do
begin
AVolumeRec := TJclSplitVolume(FVolumes.Items[Index]);
if AVolumeRec.OwnStream then
AVolumeRec.Stream.Free;
end;
FVolumes.Free;
end;
inherited Destroy;
end;
function TJclStaticSplitStream.AddVolume(AStream: TStream; AMaxSize: Int64;
AOwnStream: Boolean): Integer;
var
AVolumeRec: TJclSplitVolume;
begin
AVolumeRec := TJclSplitVolume.Create;
AVolumeRec.MaxSize := AMaxSize;
AVolumeRec.Stream := AStream;
AVolumeRec.OwnStream := AOwnStream;
Result := FVolumes.Add(AVolumeRec);
end;
function TJclStaticSplitStream.GetVolume(Index: Integer): TStream;
begin
Result := TJclSplitVolume(FVolumes.Items[Index]).Stream;
end;
function TJclStaticSplitStream.GetVolumeCount: Integer;
begin
Result := FVolumes.Count;
end;
function TJclStaticSplitStream.GetVolumeMaxSize(Index: Integer): Int64;
begin
Result := TJclSplitVolume(FVolumes.Items[Index]).MaxSize;
end;
//=== { TJclStringStream } ====================================================
constructor TJclStringStream.Create(AStream: TStream; AOwnsStream: Boolean);
begin
inherited Create(AStream, AOwnsStream);
end;
function TJclStringStream.GetCalcedSize: Int64;
begin
{$IFDEF CLR}
raise EJclStreamError.Create(RsStreamsSeekError);
{$ELSE ~CLR}
raise EJclStreamError.CreateRes(@RsStreamsSeekError);
{$ENDIF ~CLR}
end;
function TJclStringStream.PeekAnsiChar(var Buffer: AnsiChar): Boolean;
var
Pos: Int64;
Ch: UCS4;
begin
Pos := FPosition;
FPosition := FPeekPosition;
Result := FCharacterReader(Self, Ch);
if Result then
Buffer := UCS4ToAnsiChar(Ch);
FPosition := Pos;
FPeekPosition := FPeekPosition + 1;
end;
function TJclStringStream.PeekChar(var Buffer: Char): Boolean;
var
Pos: Int64;
Ch: UCS4;
begin
Pos := FPosition;
FPosition := FPeekPosition;
Result := FCharacterReader(Self, Ch);
if Result then
Buffer := UCS4ToChar(Ch);
FPosition := Pos;
FPeekPosition := FPeekPosition + 1;
end;
function TJclStringStream.PeekWideChar(var Buffer: WideChar): Boolean;
var
Pos: Int64;
Ch: UCS4;
begin
Pos := FPosition;
FPosition := FPeekPosition;
Result := FCharacterReader(Self, Ch);
if Result then
Buffer := UCS4ToWideChar(Ch);
FPosition := Pos;
FPeekPosition := FPeekPosition + 1;
end;
function TJclStringStream.ReadString(var Buffer: string; Start, Count: Longint): Longint;
var
Index, StrPos: Integer;
Ch: UCS4;
begin
Index := Start;
while Index < Start + Count - 1 do // avoid overflow on surrogate pairs for WideString
begin
if FCharacterReader(Self, Ch) then
begin
StrPos := Index;
if StringSetNextChar(Buffer, StrPos, Ch) and (StrPos > 0) then
Index := StrPos
else
Break; // end of string (write)
end
else
Break; // end of stream (read)
end;
Result := Index - Start;
FPeekPosition := FPosition;
end;
function TJclStringStream.ReadAnsiChar(var Buffer: AnsiChar): Boolean;
var
Ch: UCS4;
begin
Result := FCharacterReader(Self, Ch);
if Result then
Buffer := UCS4ToAnsiChar(Ch);
FPeekPosition := FPosition;
end;
function TJclStringStream.ReadAnsiString(var Buffer: AnsiString; Start, Count: Longint): Longint;
var
Index, StrPos: Integer;
Ch: UCS4;
begin
Index := Start;
while Index < Start + Count do
begin
if FCharacterReader(Self, Ch) then
begin
StrPos := Index;
if AnsiSetNextChar(Buffer, StrPos, Ch) and (StrPos > 0) then
Index := StrPos
else
Break; // end of string (write)
end
else
Break; // end of stream (read)
end;
Result := Index - Start;
FPeekPosition := FPosition;
end;
function TJclStringStream.ReadChar(var Buffer: Char): Boolean;
var
Ch: UCS4;
begin
Result := FCharacterReader(Self, Ch);
if Result then
Buffer := UCS4ToChar(Ch);
FPeekPosition := FPosition;
end;
function TJclStringStream.ReadWideChar(var Buffer: WideChar): Boolean;
var
Ch: UCS4;
begin
Result := FCharacterReader(Self, Ch);
if Result then
Buffer := UCS4ToWideChar(Ch);
FPeekPosition := FPosition;
end;
function TJclStringStream.ReadWideString(var Buffer: WideString; Start, Count: Longint): Longint;
var
Index, StrPos: Integer;
Ch: UCS4;
begin
Index := Start;
while Index < Start + Count - 1 do // avoid overflow on surrogate pairs
begin
if FCharacterReader(Self, Ch) then
begin
StrPos := Index;
if UTF16SetNextChar(Buffer, StrPos, Ch) and (StrPos > 0) then
Index := StrPos
else
Break; // end of string (write)
end
else
Break; // end of stream (read)
end;
Result := Index - Start;
FPeekPosition := FPosition;
end;
function TJclStringStream.SkipBOM: Longint;
var
Pos: Int64;
I: Integer;
BOM: array of Byte;
begin
if Length(FBOM) > 0 then
begin
SetLength(BOM, Length(FBOM));
Pos := Position;
{$IFDEF CLR}
Result := Read(BOM, Low(BOM), Length(BOM));
{$ELSE ~CLR}
Result := Read(BOM[0], Length(BOM) * SizeOf(BOM[0]));
{$ENDIF ~CLR}
if Result = Length(FBOM) * SizeOf(FBOM[0]) then
for I := Low(FBOM) to High(FBOM) do
if BOM[I - Low(FBOM)] <> FBOM[I] then
Result := 0;
if Result <> Length(FBOM) * SizeOf(FBOM[0]) then
Position := Pos;
end
else
Result := 0;
FPeekPosition := FPosition;
end;
function TJclStringStream.WriteBOM: Longint;
begin
if Length(FBOM) > 0 then
begin
{$IFDEF CLR}
Result := Write(FBOM, Low(FBOM), Length(FBOM));
{$ELSE ~CLR}
Result := Write(FBOM[0], Length(FBOM) * SizeOf(FBOM[0]));
{$ENDIF ~CLR}
end
else
Result := 0;
FPeekPosition := FPosition;
end;
function TJclStringStream.WriteChar(Value: Char): Boolean;
begin
Result := FCharacterWriter(Self, CharToUCS4(Value));
end;
function TJclStringStream.WriteString(const Buffer: string; Start, Count: Longint): Longint;
var
Index, StrPos: Integer;
Ch: UCS4;
begin
Index := Start;
while Index < Start + Count do
begin
StrPos := Index;
Ch := StringGetNextChar(Buffer, StrPos);
if (StrPos > 0) and FCharacterWriter(Self, Ch) then
Index := StrPos
else
Break; // end of string (read) or end of stream (write)
end;
Result := Index - Start;
FPeekPosition := FPosition;
end;
function TJclStringStream.WriteAnsiChar(Value: AnsiChar): Boolean;
begin
Result := FCharacterWriter(Self, AnsiCharToUCS4(Value));
FPeekPosition := FPosition;
end;
function TJclStringStream.WriteAnsiString(const Buffer: AnsiString; Start, Count: Longint): Longint;
var
Index, StrPos: Integer;
Ch: UCS4;
begin
Index := Start;
while Index < Start + Count do
begin
StrPos := Index;
Ch := AnsiGetNextChar(Buffer, StrPos);
if (StrPos > 0) and FCharacterWriter(Self, Ch) then
Index := StrPos
else
Break; // end of string (read) or end of stream (write)
end;
Result := Index - Start;
FPeekPosition := FPosition;
end;
function TJclStringStream.WriteWideChar(Value: WideChar): Boolean;
begin
Result := FCharacterWriter(Self, WideCharToUCS4(Value));
FPeekPosition := FPosition;
end;
function TJclStringStream.WriteWideString(const Buffer: WideString; Start, Count: Longint): Longint;
var
Index, StrPos: Integer;
Ch: UCS4;
begin
Index := Start;
while Index < Start + Count do
begin
StrPos := Index;
Ch := UTF16GetNextChar(Buffer, StrPos);
if (StrPos > 0) and FCharacterWriter(Self, Ch) then
Index := StrPos
else
Break; // end of string (read) or end of stream (write)
end;
Result := Index - Start;
FPeekPosition := FPosition;
end;
//=== { TJclAnsiStream } ======================================================
constructor TJclAnsiStream.Create(AStream: TStream; AOwnsStream: Boolean);
begin
inherited Create(AStream, AOwnsStream);
// not adding the @ character causes an internal error in Delphi 5 and C++Builder 5
FCharacterReader := {$IFNDEF CLR}@{$ENDIF ~CLR}AnsiGetNextCharFromStream;
FCharacterWriter := {$IFNDEF CLR}@{$ENDIF ~CLR}AnsiSetNextCharToStream;
SetLength(FBOM, 0);
end;
//=== { TJclUTF8Stream } ======================================================
constructor TJclUTF8Stream.Create(AStream: TStream; AOwnsStream: Boolean);
var
I: Integer;
begin
inherited Create(AStream, AOwnsStream);
FCharacterReader := {$IFNDEF CLR}@{$ENDIF ~CLR}UTF8GetNextCharFromStream;
FCharacterWriter := {$IFNDEF CLR}@{$ENDIF ~CLR}UTF8SetNextCharToStream;
SetLength(FBOM, Length(BOM_UTF8));
for I := Low(BOM_UTF8) to High(BOM_UTF8) do
FBOM[I - Low(BOM_UTF8)] := BOM_UTF8[I];
end;
//=== { TJclUTF16Stream } =====================================================
constructor TJclUTF16Stream.Create(AStream: TStream; AOwnsStream: Boolean);
var
I: Integer;
begin
inherited Create(AStream, AOwnsStream);
FCharacterReader := {$IFNDEF CLR}@{$ENDIF ~CLR}UTF16GetNextCharFromStream;
FCharacterWriter := {$IFNDEF CLR}@{$ENDIF ~CLR}UTF16SetNextCharToStream;
SetLength(FBOM, Length(BOM_UTF16_LSB));
for I := Low(BOM_UTF16_LSB) to High(BOM_UTF16_LSB) do
FBOM[I - Low(BOM_UTF16_LSB)] := BOM_UTF16_LSB[I];
end;
//=== { TJclAutoStream } ======================================================
constructor TJclAutoStream.Create(AStream: TStream; AOwnsStream: Boolean);
var
Pos: Int64;
I, MaxLength, ReadLength: Integer;
BOM: array of Byte;
begin
inherited Create(AStream, AOwnsStream);
MaxLength := Length(BOM_UTF8);
if MaxLength < Length(BOM_UTF16_LSB) then
MaxLength := Length(BOM_UTF16_LSB);
Pos := FPosition;
SetLength(BOM, MaxLength);
{$IFDEF CLR}
ReadLength := Read(BOM, Low(BOM), Length(BOM)) div SizeOf(BOM[0]);
{$ELSE ~CLR}
ReadLength := Read(BOM[0], Length(BOM) * SizeOf(BOM[0])) div SizeOf(BOM[0]);
{$ENDIF ~CLR}
FEncoding := seAuto;
// try UTF8 BOM
if (FEncoding = seAuto) and (ReadLength >= Length(BOM_UTF8) * SizeOf(BOM_UTF8[0])) then
begin
FEncoding := seUTF8;
for I := Low(BOM_UTF8) to High(BOM_UTF8) do
if BOM[I - Low(BOM_UTF8)] <> BOM_UTF8[I] then
begin
FEncoding := seAuto;
Break;
end;
end;
// try UTF16 BOM
if (FEncoding = seAuto) and (ReadLength >= Length(BOM_UTF16_LSB) * SizeOf(BOM_UTF16_LSB[0])) then
begin
FEncoding := seUTF16;
for I := Low(BOM_UTF16_LSB) to High(BOM_UTF16_LSB) do
if BOM[I - Low(BOM_UTF8)] <> BOM_UTF16_LSB[I] then
begin
FEncoding := seAuto;
Break;
end;
end;
case FEncoding of
seUTF8:
begin
SetLength(FBOM, Length(BOM_UTF8));
for I := Low(BOM_UTF8) to High(BOM_UTF8) do
FBOM[I - Low(BOM_UTF8)] := BOM_UTF8[I];
FCharacterReader := {$IFNDEF CLR}@{$ENDIF ~CLR}UTF8GetNextCharFromStream;
FCharacterWriter := {$IFNDEF CLR}@{$ENDIF ~CLR}UTF8SetNextCharToStream;
FPosition := Pos + Length(BOM_UTF8) * SizeOf(BOM_UTF8[0]);
end;
seUTF16:
begin
SetLength(FBOM, Length(BOM_UTF16_LSB));
for I := Low(BOM_UTF16_LSB) to High(BOM_UTF16_LSB) do
FBOM[I - Low(BOM_UTF16_LSB)] := BOM_UTF16_LSB[I];
FCharacterReader := {$IFNDEF CLR}@{$ENDIF ~CLR}UTF16GetNextCharFromStream;
FCharacterWriter := {$IFNDEF CLR}@{$ENDIF ~CLR}UTF16SetNextCharToStream;
FPosition := Pos + Length(BOM_UTF16_LSB) * SizeOf(BOM_UTF16_LSB[0]);
end;
seAuto,
seAnsi:
begin
// defaults to Ansi
FEncoding := seAnsi;
SetLength(FBOM, 0);
FCharacterReader := {$IFNDEF CLR}@{$ENDIF ~CLR}AnsiGetNextCharFromStream;
FCharacterWriter := {$IFNDEF CLR}@{$ENDIF ~CLR}AnsiSetNextCharToStream;
FPosition := Pos;
end;
end;
FPeekPosition := FPosition;
end;
function TJclAutoStream.SkipBOM: LongInt;
begin
// already skipped to determine encoding
Result := 0;
end;
{$IFDEF UNITVERSIONING}
initialization
RegisterUnitVersion(HInstance, UnitVersioning);
finalization
UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
end.
Reference in New Issue View Git Blame Copy Permalink