- Initial import from internal repository
This commit is contained in:
@@ -0,0 +1,542 @@
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2007 Andreas Schneider
|
||||
*)
|
||||
|
||||
{@abstract(This unit contains procedures and classes to help with stream handling.
|
||||
It can be used to ease copying of streams and to assist in writing and reading
|
||||
specialized types to/from streams.)
|
||||
|
||||
@bold(Warning!!!)@br
|
||||
Due to a problem with generics in FPC 2.2.0 I introduced @link(TStreamType) as
|
||||
workaround to reference the actual type of stream used inside the
|
||||
@link(TStreamWrapper).
|
||||
|
||||
@author(Andreas Schneider <aksdb@gmx.de>)
|
||||
@created(2007-07-08)
|
||||
@lastmod(2007-11-14)}
|
||||
unit UStreamHelper;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, RtlConsts, SysUtils, UIStream;
|
||||
|
||||
type
|
||||
{@name is the stub for the method which will handle the OnProgress callbacks.
|
||||
@param(ATotal Specifies the complete size of the operation.)
|
||||
@param(ACurrent Specifies the current position during the operation.)}
|
||||
TOnProgressEvent = procedure(ATotal, ACurrent: Cardinal) of object;
|
||||
|
||||
{ TFifoStream }
|
||||
|
||||
{@abstract(The @name contains special handling for queuing and dequeing. It is
|
||||
meant to be used as a network queue.)}
|
||||
TFifoStream = class(TStream)
|
||||
destructor Destroy; override;
|
||||
protected
|
||||
FMemory: Pointer;
|
||||
FSize, FRealSize, FPosition, FLockOffset: Longint;
|
||||
FCapacity: Longint;
|
||||
procedure SetCapacity(ANewCapacity: Longint);
|
||||
procedure SetPointer(APtr: Pointer; ASize: Longint);
|
||||
function GetOptimalCapacity(ANewCapacity: Longint): Longint;
|
||||
function Realloc(var NewCapacity: Longint): Pointer; virtual;
|
||||
property Capacity: Longint read FCapacity write SetCapacity;
|
||||
public
|
||||
function GetSize: Int64; override;
|
||||
function Read(var Buffer; ACount: Longint): Longint; override;
|
||||
function Write(const Buffer; ACount: Longint): Longint; override;
|
||||
function Seek(AOffset: Longint; AOrigin: Word): Longint; override;
|
||||
procedure LoadFromStream(AStream: TStream);
|
||||
procedure SaveToStream(AStream: TStream);
|
||||
procedure LoadFromFile(const FileName: string);
|
||||
procedure SaveToFile(const FileName: string);
|
||||
procedure SetSize(ANewSize: Longint); override;
|
||||
procedure Clear;
|
||||
procedure Dequeue(ACount: Longint); //<Removes a specified number of bytes from the queue. @param(ACount The number of bytes to remove from the queue.)
|
||||
procedure Enqueue(const Buffer; ACount: Longint); //<Adds a specified number of bytes from a given buffer to the end of the queue. @param(Buffer The buffer containing the data to enqueue.) @param(ACount The number of bytes to enqueue from the buffer.)
|
||||
procedure Lock(AOffset, ASize: Longint); //<Restricts the visible area of the stream. @param(AOffset is the starting position of the area.) @param(ASize The size of the area.)
|
||||
procedure Unlock; //<Removes the restrictions from the stream and resets the visible area to the original size.
|
||||
property Memory: Pointer read FMemory;
|
||||
end;
|
||||
|
||||
|
||||
{ TStreamWrapper }
|
||||
|
||||
{The @name is just a placeholder for the type used in the
|
||||
@link(TStreamWrapper). It is currently in place to work around a problem with
|
||||
generics in fpc 2.2.0}
|
||||
TStreamType = TFifoStream;
|
||||
//generic TStreamWrapper<TStreamType> = class(TObject{, IStream})
|
||||
{@abstract(@name implements @link(IStream) and offers a bunch of functions to
|
||||
ease reading and writing special types (like @link(Integer)s or @link(String)s.))}
|
||||
TStreamWrapper = class(TObject, IStream)
|
||||
constructor Create(AStream: TStreamType; AOwnsStream: Boolean = True); //<Creates a new instance of @classname. @param(AStream The underlying stream to perform the actual operations on.) @param(AOwnsStream Defines wheather to free the stream on destruction of @classname or not. Defaults to @false.)
|
||||
destructor Destroy; override; //<Is called when the current instance of @classname is destroyed. If it owns the underlying stream it is destroyed aswell.
|
||||
protected
|
||||
FStream: TStream;
|
||||
FOwnsStream: Boolean;
|
||||
function GetStream: TStreamType;
|
||||
procedure SetStream(AStream: TStreamType);
|
||||
public
|
||||
property Raw: TStreamType read GetStream write SetStream; //<Provides raw access to the underlying stream. Useful for manipulation of the stream position and other class specific calls.
|
||||
|
||||
function ReadBoolean: Boolean; //<Implementation of @link(IStream.ReadBoolean).
|
||||
function ReadByte: Byte; //<Implementation of @link(IStream.ReadByte).
|
||||
function ReadCardinal: Cardinal; //<Implementation of @link(IStream.ReadCardinal).
|
||||
function ReadInteger: Integer; //<Implementation of @link(IStream.ReadInteger).
|
||||
function ReadInt64: Int64; //<Implementation of @link(IStream.ReadInt64).
|
||||
function ReadSmallInt: SmallInt; //<Implementation of @link(IStream.ReadSmallInt).
|
||||
function ReadWord: Word; //<Implementation of @link(IStream.ReadWord).
|
||||
function ReadString: string; //<Implementation of @link(IStream.ReadString).
|
||||
function ReadStringFixed(ALength: Integer): string; //<Implementation of @link(IStream.ReadStringFixed).
|
||||
procedure WriteBoolean(AValue: Boolean); //<Implementation of @link(IStream.WriteBoolean).
|
||||
procedure WriteByte(AValue: Byte); //<Implementation of @link(IStream.WriteByte).
|
||||
procedure WriteCardinal(AValue: Cardinal); //<Implementation of @link(IStream.WriteCardinal).
|
||||
procedure WriteInteger(AValue: Integer); //<Implementation of @link(IStream.WriteInteger).
|
||||
procedure WriteInt64(AValue: Int64); //<Implementation of @link(IStream.WriteInt64).
|
||||
procedure WriteSmallInt(AValue: SmallInt); //<Implementation of @link(IStream.WriteSmallInt).
|
||||
procedure WriteWord(AValue: Word); //<Implementation of @link(IStream.WriteWord).
|
||||
procedure WriteString(AValue: string); //<Implementation of @link(IStream.WriteString).
|
||||
procedure WriteStringFixed(AValue: string; ALength: Integer); //<Implementation of @link(IStream.WriteStringFixed).
|
||||
|
||||
function Read(ABuffer: PByte; ACount: Cardinal): Cardinal; //<Implementation of @link(IStream.Read).
|
||||
function Write(ABuffer: PByte; ACount: Cardinal): Cardinal; //<Implementation of @link(IStream.Write).
|
||||
|
||||
procedure Skip(ACount: Cardinal); //<Implementation of @link(IStream.Skip).
|
||||
end;
|
||||
|
||||
{@name is used to have a progress (see @link(TOnProgressEvent)) for a copy
|
||||
action of the content of one stream into another. This is especially useful
|
||||
for writing and reading to @link(TFileStream).
|
||||
@param(ASource The stream from which the content is copied.)
|
||||
@param(ATarget The stream to which the content is copied.)
|
||||
@param(ACount Specifies the amount to copy. 0 means, that the whole stream is processed.)
|
||||
@param(AOnProgress The callback for the @link(TOnProgressEvent). Defaults to @nil.)
|
||||
@returns(The amount of bytes copied.)}
|
||||
function StreamCopy(ASource, ATarget: TStream; ACount: Int64; AOnProgress: TOnProgressEvent = nil): Int64;
|
||||
|
||||
implementation
|
||||
|
||||
function StreamCopy(ASource, ATarget: TStream; ACount: Int64; AOnProgress: TOnProgressEvent = nil): Int64;
|
||||
var
|
||||
i, targetSize: Int64;
|
||||
buffer: array[0..4095] of byte;
|
||||
begin
|
||||
Result := 0;
|
||||
if (ACount = 0) then
|
||||
begin
|
||||
//This WILL fail for non-seekable streams...
|
||||
ASource.Position := 0;
|
||||
ACount := ASource.Size;
|
||||
end;
|
||||
targetSize := ACount;
|
||||
while ACount > 0 do
|
||||
begin
|
||||
if (ACount > SizeOf(buffer)) then
|
||||
i := SizeOf(Buffer)
|
||||
else
|
||||
i := ACount;
|
||||
i := ASource.Read(buffer, i);
|
||||
i := ATarget.Write(buffer, i);
|
||||
if i = 0 then break;
|
||||
Dec(ACount, i);
|
||||
Inc(Result, i);
|
||||
if Assigned(AOnProgress) then
|
||||
AOnProgress(targetSize, Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TFifoStream }
|
||||
|
||||
const TMSGrow = 4096; { Use 4k blocks. }
|
||||
|
||||
destructor TFifoStream.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFifoStream.SetCapacity(ANewCapacity: Longint);
|
||||
begin
|
||||
SetPointer(Realloc(ANewCapacity), FSize);
|
||||
FCapacity := ANewCapacity;
|
||||
end;
|
||||
|
||||
procedure TFifoStream.SetPointer(APtr: Pointer; ASize: Longint);
|
||||
begin
|
||||
FMemory := APtr;
|
||||
FSize := ASize;
|
||||
end;
|
||||
|
||||
function TFifoStream.GetOptimalCapacity(ANewCapacity: Longint): Longint;
|
||||
begin
|
||||
Result := ANewCapacity;
|
||||
if Result <= 0 then
|
||||
Result := 0
|
||||
else
|
||||
begin
|
||||
// if growing, grow at least a quarter
|
||||
if (Result > FCapacity) and (Result < (5 * FCapacity) div 4) then
|
||||
Result := (5 * FCapacity) div 4;
|
||||
// round off to block size.
|
||||
Result := (Result + (TMSGrow-1)) and not (TMSGROW-1);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFifoStream.Realloc(var NewCapacity: Longint): Pointer;
|
||||
begin
|
||||
NewCapacity := GetOptimalCapacity(NewCapacity);
|
||||
// Only now check !
|
||||
if NewCapacity = FCapacity then
|
||||
Result := FMemory
|
||||
else
|
||||
begin
|
||||
Result := ReAllocMem(FMemory, NewCapacity);
|
||||
if (Result = nil) and (NewCapacity > 0) then
|
||||
raise EStreamError.Create(SMemoryStreamError);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFifoStream.GetSize: Int64;
|
||||
begin
|
||||
Result := FSize;
|
||||
end;
|
||||
|
||||
function TFifoStream.Read(var Buffer; ACount: Longint): Longint;
|
||||
begin
|
||||
Result := 0;
|
||||
If (FSize > 0) and (FPosition - FLockOffset < FSize) then
|
||||
begin
|
||||
Result := FSize - (FPosition - FLockOffset);
|
||||
if Result > ACount then Result := ACount;
|
||||
Move((FMemory + FPosition)^, Buffer, Result);
|
||||
FPosition := FPosition + Result;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFifoStream.Write(const Buffer; ACount: Longint): Longint;
|
||||
var
|
||||
NewPos: Longint;
|
||||
begin
|
||||
Unlock;
|
||||
if ACount = 0 then
|
||||
Exit(0);
|
||||
NewPos := FPosition + ACount;
|
||||
if NewPos > FSize then
|
||||
begin
|
||||
if NewPos > FCapacity then
|
||||
SetCapacity(NewPos);
|
||||
FSize := NewPos;
|
||||
end;
|
||||
System.Move(Buffer, (FMemory + FPosition)^, ACount);
|
||||
FPosition := NewPos;
|
||||
Result := ACount;
|
||||
end;
|
||||
|
||||
function TFifoStream.Seek(AOffset: Longint; AOrigin: Word): Longint;
|
||||
begin
|
||||
case AOrigin of
|
||||
soFromBeginning : FPosition := AOffset + FLockOffset;
|
||||
soFromEnd : FPosition := FSize + AOffset + FLockOffset;
|
||||
soFromCurrent : FPosition := FPosition + AOffset;
|
||||
end;
|
||||
Result := FPosition - FLockOffset;
|
||||
end;
|
||||
|
||||
procedure TFifoStream.LoadFromStream(AStream: TStream);
|
||||
begin
|
||||
Unlock;
|
||||
AStream.Position := 0;
|
||||
SetSize(AStream.Size);
|
||||
If FSize > 0 then AStream.ReadBuffer(FMemory^,FSize);
|
||||
end;
|
||||
|
||||
procedure TFifoStream.SaveToStream(AStream: TStream);
|
||||
begin
|
||||
if FSize > 0 then AStream.WriteBuffer((FMemory + FLockOffset)^, FSize);
|
||||
end;
|
||||
|
||||
procedure TFifoStream.LoadFromFile(const FileName: string);
|
||||
var
|
||||
S: TFileStream;
|
||||
begin
|
||||
S := TFileStream.Create(FileName, fmOpenRead);
|
||||
try
|
||||
LoadFromStream(S);
|
||||
finally
|
||||
S.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFifoStream.SaveToFile(const FileName: string);
|
||||
var
|
||||
S: TFileStream;
|
||||
begin
|
||||
S := TFileStream.Create(FileName, fmCreate);
|
||||
try
|
||||
SaveToStream(S);
|
||||
finally
|
||||
S.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFifoStream.SetSize(ANewSize: Longint);
|
||||
begin
|
||||
Unlock;
|
||||
SetCapacity(ANewSize);
|
||||
FSize := ANewSize;
|
||||
if FPosition > FSize then
|
||||
FPosition := FSize;
|
||||
end;
|
||||
|
||||
procedure TFifoStream.Clear;
|
||||
begin
|
||||
FSize := 0;
|
||||
FRealSize := 0;
|
||||
FPosition := 0;
|
||||
FLockOffset := 0;
|
||||
SetCapacity(0);
|
||||
end;
|
||||
|
||||
procedure TFifoStream.Dequeue(ACount: Longint);
|
||||
var
|
||||
newCapacity, newSize: Longint;
|
||||
queue, newMemory: Pointer;
|
||||
begin
|
||||
Unlock;
|
||||
if ACount >= FSize then
|
||||
begin
|
||||
Size := 0;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
queue := FMemory + ACount;
|
||||
newSize := FSize - ACount;
|
||||
|
||||
newCapacity := GetOptimalCapacity(newSize);
|
||||
if newCapacity <> FCapacity then
|
||||
begin
|
||||
newMemory := GetMem(newCapacity);
|
||||
System.Move(queue^, newMemory^, newSize);
|
||||
if (newMemory = nil) and (newCapacity > 0) then
|
||||
raise EStreamError.Create(SMemoryStreamError);
|
||||
FreeMem(FMemory);
|
||||
FMemory := newMemory;
|
||||
FCapacity := newCapacity;
|
||||
end else
|
||||
System.Move(queue^, FMemory^, newSize);
|
||||
|
||||
FSize := newSize;
|
||||
if FPosition > ACount then
|
||||
Dec(FPosition, ACount)
|
||||
else
|
||||
FPosition := 0;
|
||||
end;
|
||||
|
||||
procedure TFifoStream.Enqueue(const Buffer; ACount: Longint);
|
||||
var
|
||||
oldPos: Int64;
|
||||
begin
|
||||
Unlock;
|
||||
oldPos := FPosition;
|
||||
FPosition := FSize;
|
||||
Write(Buffer, ACount);
|
||||
FPosition := oldPos;
|
||||
end;
|
||||
|
||||
procedure TFifoStream.Lock(AOffset, ASize: Longint);
|
||||
begin
|
||||
if (FLockOffset <> 0) or (FRealSize <> 0) then Exit;
|
||||
FLockOffset := AOffset;
|
||||
FRealSize := FSize;
|
||||
FSize := ASize;
|
||||
end;
|
||||
|
||||
procedure TFifoStream.Unlock;
|
||||
begin
|
||||
if (FLockOffset = 0) and (FRealSize = 0) then Exit;
|
||||
FLockOffset := 0;
|
||||
FSize := FRealSize;
|
||||
FRealSize := 0;
|
||||
end;
|
||||
|
||||
{ TStreamWrapper }
|
||||
|
||||
constructor TStreamWrapper.Create(AStream: TStreamType; AOwnsStream: Boolean);
|
||||
begin
|
||||
inherited Create;
|
||||
FStream := TStream(AStream);
|
||||
FOwnsStream := AOwnsStream;
|
||||
end;
|
||||
|
||||
destructor TStreamWrapper.Destroy;
|
||||
begin
|
||||
if FOwnsStream and Assigned(FStream) then FreeAndNil(FStream);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TStreamWrapper.GetStream: TStreamType;
|
||||
begin
|
||||
Result := TStreamType(FStream);
|
||||
end;
|
||||
|
||||
procedure TStreamWrapper.SetStream(AStream: TStreamType);
|
||||
begin
|
||||
FStream := TStream(AStream);
|
||||
end;
|
||||
|
||||
function TStreamWrapper.ReadBoolean: Boolean;
|
||||
begin
|
||||
if not Assigned(FStream) then Exit(False);
|
||||
FStream.Read(Result, SizeOf(Boolean));
|
||||
end;
|
||||
|
||||
function TStreamWrapper.ReadByte: Byte;
|
||||
begin
|
||||
if not Assigned(FStream) then Exit(0);
|
||||
FStream.Read(Result, SizeOf(Byte));
|
||||
end;
|
||||
|
||||
function TStreamWrapper.ReadCardinal: Cardinal;
|
||||
begin
|
||||
if not Assigned(FStream) then Exit(0);
|
||||
FStream.Read(Result, SizeOf(Cardinal));
|
||||
end;
|
||||
|
||||
function TStreamWrapper.ReadInteger: Integer;
|
||||
begin
|
||||
if not Assigned(FStream) then Exit(0);
|
||||
FStream.Read(Result, SizeOf(Integer));
|
||||
end;
|
||||
|
||||
function TStreamWrapper.ReadInt64: Int64;
|
||||
begin
|
||||
if not Assigned(FStream) then Exit(0);
|
||||
FStream.Read(Result, SizeOf(Int64));
|
||||
end;
|
||||
|
||||
function TStreamWrapper.ReadSmallInt: SmallInt;
|
||||
begin
|
||||
if not Assigned(FStream) then Exit(0);
|
||||
FStream.Read(Result, SizeOf(SmallInt));
|
||||
end;
|
||||
|
||||
function TStreamWrapper.ReadWord: Word;
|
||||
begin
|
||||
if not Assigned(FStream) then Exit(0);
|
||||
FStream.Read(Result, SizeOf(Word));
|
||||
end;
|
||||
|
||||
function TStreamWrapper.ReadString: string;
|
||||
begin
|
||||
if not Assigned(FStream) then Exit('');
|
||||
Result := ReadStringFixed(ReadInteger);
|
||||
end;
|
||||
|
||||
function TStreamWrapper.ReadStringFixed(ALength: Integer): string;
|
||||
begin
|
||||
if not Assigned(FStream) then Exit('');
|
||||
SetLength(Result, ALength);
|
||||
FStream.Read(PChar(Result)^, ALength);
|
||||
end;
|
||||
|
||||
procedure TStreamWrapper.WriteBoolean(AValue: Boolean);
|
||||
begin
|
||||
if not Assigned(FStream) then Exit;
|
||||
FStream.Write(AValue, SizeOf(Boolean));
|
||||
end;
|
||||
|
||||
procedure TStreamWrapper.WriteByte(AValue: Byte);
|
||||
begin
|
||||
if not Assigned(FStream) then Exit;
|
||||
FStream.Write(AValue, SizeOf(Byte));
|
||||
end;
|
||||
|
||||
procedure TStreamWrapper.WriteCardinal(AValue: Cardinal);
|
||||
begin
|
||||
if not Assigned(FStream) then Exit;
|
||||
FStream.Write(AValue, SizeOf(Cardinal));
|
||||
end;
|
||||
|
||||
procedure TStreamWrapper.WriteInteger(AValue: Integer);
|
||||
begin
|
||||
if not Assigned(FStream) then Exit;
|
||||
FStream.Write(AValue, SizeOf(Integer));
|
||||
end;
|
||||
|
||||
procedure TStreamWrapper.WriteInt64(AValue: Int64);
|
||||
begin
|
||||
if not Assigned(FStream) then Exit;
|
||||
FStream.Write(AValue, SizeOf(Int64));
|
||||
end;
|
||||
|
||||
procedure TStreamWrapper.WriteSmallInt(AValue: SmallInt);
|
||||
begin
|
||||
if not Assigned(FStream) then Exit;
|
||||
FStream.Write(AValue, SizeOf(SmallInt));
|
||||
end;
|
||||
|
||||
procedure TStreamWrapper.WriteWord(AValue: Word);
|
||||
begin
|
||||
if not Assigned(FStream) then Exit;
|
||||
FStream.Write(AValue, SizeOf(Word));
|
||||
end;
|
||||
|
||||
procedure TStreamWrapper.WriteString(AValue: string);
|
||||
var
|
||||
stringLength: Integer;
|
||||
begin
|
||||
if not Assigned(FStream) then Exit;
|
||||
stringLength := Length(AValue);
|
||||
WriteInteger(stringLength);
|
||||
WriteStringFixed(AValue, stringLength);
|
||||
end;
|
||||
|
||||
procedure TStreamWrapper.WriteStringFixed(AValue: string; ALength: Integer);
|
||||
begin
|
||||
if not Assigned(FStream) then Exit;
|
||||
FStream.Write(PChar(AValue)^, ALength);
|
||||
end;
|
||||
|
||||
function TStreamWrapper.Read(ABuffer: PByte; ACount: Cardinal): Cardinal;
|
||||
begin
|
||||
Result := FStream.Read(ABuffer^, ACount);
|
||||
end;
|
||||
|
||||
function TStreamWrapper.Write(ABuffer: PByte; ACount: Cardinal): Cardinal;
|
||||
begin
|
||||
Result := FStream.Write(ABuffer^, ACount);
|
||||
end;
|
||||
|
||||
procedure TStreamWrapper.Skip(ACount: Cardinal);
|
||||
begin
|
||||
FStream.Seek(ACount, soFromCurrent);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user