mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-23 14:32:32 +02:00
653 lines
14 KiB
PHP
653 lines
14 KiB
PHP
{
|
|
$Id$
|
|
This file is part of the Free Component Library (FCL)
|
|
Copyright (c) 1998 by the Free Pascal development team
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
{****************************************************************************}
|
|
{* TStream *}
|
|
{****************************************************************************}
|
|
|
|
function TStream.GetPosition: Longint;
|
|
|
|
begin
|
|
Result:=Seek(0,soFromCurrent);
|
|
end;
|
|
|
|
procedure TStream.SetPosition(Pos: Longint);
|
|
|
|
begin
|
|
Seek(pos,soFromBeginning);
|
|
end;
|
|
|
|
function TStream.GetSize: Longint;
|
|
|
|
var
|
|
p : longint;
|
|
|
|
begin
|
|
p:=GetPosition;
|
|
GetSize:=Seek(0,soFromEnd);
|
|
Seek(p,soFromBeginning);
|
|
end;
|
|
|
|
procedure TStream.SetSize(NewSize: Longint);
|
|
|
|
begin
|
|
// We do nothing. Pipe streams don't support this
|
|
// As wel as possible read-ony streams !!
|
|
end;
|
|
|
|
procedure TStream.ReadBuffer(var Buffer; Count: Longint);
|
|
|
|
begin
|
|
if Read(Buffer,Count)<Count then
|
|
Raise EReadError.Create(SReadError);
|
|
end;
|
|
|
|
procedure TStream.WriteBuffer(const Buffer; Count: Longint);
|
|
|
|
begin
|
|
if Write(Buffer,Count)<Count then
|
|
Raise EWriteError.Create(SWriteError);
|
|
end;
|
|
|
|
function TStream.CopyFrom(Source: TStream; Count: Longint): Longint;
|
|
|
|
var
|
|
i : longint;
|
|
buffer : array[0..1023] of byte;
|
|
|
|
begin
|
|
CopyFrom:=0;
|
|
while Count>0 do
|
|
begin
|
|
if (Count>sizeof(buffer)) then
|
|
i:=sizeof(Buffer)
|
|
else
|
|
i:=Count;
|
|
i:=Source.Read(buffer,i);
|
|
i:=Write(buffer,i);
|
|
dec(count,i);
|
|
CopyFrom:=CopyFrom+i;
|
|
if i=0 then
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
function TStream.ReadComponent(Instance: TComponent): TComponent;
|
|
|
|
var
|
|
Reader : TReader;
|
|
|
|
begin
|
|
Reader.Create(Self,1024);
|
|
if assigned(Instance) then
|
|
ReadComponent:=Reader.ReadRootComponent(Instance)
|
|
else
|
|
begin
|
|
{!!!!!}
|
|
end;
|
|
Reader.Destroy;
|
|
end;
|
|
|
|
function TStream.ReadComponentRes(Instance: TComponent): TComponent;
|
|
|
|
begin
|
|
{!!!!!}
|
|
end;
|
|
|
|
procedure TStream.WriteComponent(Instance: TComponent);
|
|
|
|
var
|
|
Writer : TWriter;
|
|
|
|
begin
|
|
Try
|
|
Writer.Create(Self,1024);
|
|
Writer.WriteRootComponent(Instance);
|
|
Finally
|
|
Writer.Destroy;
|
|
end;
|
|
end;
|
|
|
|
procedure TStream.WriteComponentRes(const ResName: string; Instance: TComponent);
|
|
|
|
var
|
|
startpos,s : longint;
|
|
|
|
begin
|
|
{$ifdef Win16Res}
|
|
{ Numeric resource type }
|
|
WriteByte($ff);
|
|
{ Application defined data }
|
|
WriteWord($0a);
|
|
{ write the name as asciiz }
|
|
// WriteBuffer(ResName[1],length(ResName));
|
|
WriteByte(0);
|
|
{ Movable, Pure and Discardable }
|
|
WriteWord($1030);
|
|
{ size isn't known yet }
|
|
WriteDWord(0);
|
|
startpos:=GetPosition;
|
|
WriteComponent(Instance);
|
|
{ calculate size }
|
|
s:=GetPosition-startpos;
|
|
{ back patch size }
|
|
SetPosition(startpos-4);
|
|
WriteDWord(s);
|
|
{$endif Win16Res}
|
|
end;
|
|
|
|
procedure TStream.WriteDescendent(Instance, Ancestor: TComponent);
|
|
|
|
begin
|
|
{!!!!!}
|
|
end;
|
|
|
|
procedure TStream.WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
|
|
|
|
begin
|
|
{!!!!!}
|
|
end;
|
|
|
|
procedure TStream.ReadResHeader;
|
|
|
|
begin
|
|
{$ifdef Win16Res}
|
|
try
|
|
{ application specific resource ? }
|
|
if ReadByte<>$ff then
|
|
raise EInvalidImage.Create('');
|
|
if ReadWord<>$000a then
|
|
raise EInvalidImage.Create('');
|
|
{ read name }
|
|
while ReadByte<>0 do
|
|
;
|
|
{ check the access specifier }
|
|
if ReadWord<>$1030 then
|
|
raise EInvalidImage.Create('');
|
|
{ ignore the size }
|
|
ReadDWord;
|
|
except
|
|
{/////
|
|
on EInvalidImage do
|
|
raise;
|
|
else
|
|
raise EInvalidImage.create(SInvalidImage);
|
|
}
|
|
end;
|
|
{$endif Win16Res}
|
|
end;
|
|
|
|
function TStream.ReadByte : Byte;
|
|
|
|
var
|
|
b : Byte;
|
|
|
|
begin
|
|
ReadBuffer(b,1);
|
|
ReadByte:=b;
|
|
end;
|
|
|
|
function TStream.ReadWord : Word;
|
|
|
|
var
|
|
w : Word;
|
|
|
|
begin
|
|
ReadBuffer(w,2);
|
|
ReadWord:=w;
|
|
end;
|
|
|
|
function TStream.ReadDWord : Cardinal;
|
|
|
|
var
|
|
d : Cardinal;
|
|
|
|
begin
|
|
ReadBuffer(d,4);
|
|
ReadDWord:=d;
|
|
end;
|
|
|
|
Function TStream.ReadAnsiString : String;
|
|
|
|
Type PByte = ^Byte;
|
|
|
|
Var TheSize : Longint;
|
|
P : PByte ;
|
|
|
|
|
|
begin
|
|
ReadBuffer (TheSize,SizeOf(TheSize));
|
|
SetLength(Result,Size);
|
|
// Illegal typecast if no AnsiStrings defined.
|
|
ReadBuffer (Pointer(Result)^,Size);
|
|
P:=Pointer(Result)+Size;
|
|
p^:=0;
|
|
end;
|
|
|
|
Procedure TStream.WriteAnsiString (S : String);
|
|
|
|
Var L : Longint;
|
|
|
|
begin
|
|
L:=Length(S);
|
|
WriteBuffer (L,SizeOf(L));
|
|
WriteBuffer (Pointer(S)^,L);
|
|
end;
|
|
|
|
procedure TStream.WriteByte(b : Byte);
|
|
|
|
begin
|
|
WriteBuffer(b,1);
|
|
end;
|
|
|
|
procedure TStream.WriteWord(w : Word);
|
|
|
|
begin
|
|
WriteBuffer(w,2);
|
|
end;
|
|
|
|
procedure TStream.WriteDWord(d : Cardinal);
|
|
|
|
begin
|
|
WriteBuffer(d,4);
|
|
end;
|
|
|
|
|
|
{****************************************************************************}
|
|
{* THandleStream *}
|
|
{****************************************************************************}
|
|
|
|
Constructor THandleStream.Create(AHandle: Integer);
|
|
|
|
begin
|
|
FHandle:=AHandle;
|
|
end;
|
|
|
|
|
|
function THandleStream.Read(var Buffer; Count: Longint): Longint;
|
|
|
|
begin
|
|
Result:=FileRead(FHandle,Buffer,Count);
|
|
If Result=-1 then Result:=0;
|
|
end;
|
|
|
|
|
|
function THandleStream.Write(const Buffer; Count: Longint): Longint;
|
|
|
|
begin
|
|
Result:=FileWrite (FHandle,Buffer,Count);
|
|
If Result=-1 then Result:=0;
|
|
end;
|
|
|
|
|
|
|
|
|
|
{****************************************************************************}
|
|
{* TFileStream *}
|
|
{****************************************************************************}
|
|
|
|
constructor TFileStream.Create(const FileName: string; Mode: Word);
|
|
|
|
begin
|
|
If Mode=fmcreate then
|
|
FHandle:=FileCreate(FileName)
|
|
else
|
|
FHAndle:=FileOpen(FileName,Mode);
|
|
If FHandle<0 then
|
|
If Mode=fmcreate then
|
|
raise EFCreateError.createfmt(SFCreateError,[FileName])
|
|
else
|
|
raise EFOpenError.Createfmt(SFOpenError,[Filename]);
|
|
end;
|
|
|
|
|
|
destructor TFileStream.Destroy;
|
|
|
|
begin
|
|
FileClose(FHandle);
|
|
end;
|
|
|
|
Procedure TFileStream.SetSize(NewSize: Longint);
|
|
|
|
begin
|
|
FileTruncate(FHandle,NewSize);
|
|
end;
|
|
|
|
|
|
function TFileStream.Seek(Offset: Longint; Origin: Word): Longint;
|
|
|
|
begin
|
|
Result:=FileSeek(FHandle,Offset,Origin);
|
|
end;
|
|
|
|
|
|
{****************************************************************************}
|
|
{* TCustomMemoryStream *}
|
|
{****************************************************************************}
|
|
|
|
procedure TCustomMemoryStream.SetPointer(Ptr: Pointer; Size: Longint);
|
|
|
|
begin
|
|
FMemory:=Ptr;
|
|
FSize:=Size;
|
|
end;
|
|
|
|
|
|
function TCustomMemoryStream.Read(var Buffer; Count: Longint): Longint;
|
|
|
|
begin
|
|
Result:=0;
|
|
If (FSize>0) and (FPosition<Fsize) then
|
|
begin
|
|
Result:=FSize-FPosition;
|
|
If Result>Count then Result:=Count;
|
|
Move ((FMemory+FPosition)^,Buffer,Result);
|
|
FPosition:=Fposition+Result;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TCustomMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
|
|
|
|
begin
|
|
Case Origin of
|
|
soFromBeginning : FPosition:=Offset;
|
|
soFromEnd : FPosition:=FSize+Offset;
|
|
soFromCurrent : FpoSition:=FPosition+Offset;
|
|
end;
|
|
Result:=FPosition;
|
|
end;
|
|
|
|
|
|
procedure TCustomMemoryStream.SaveToStream(Stream: TStream);
|
|
|
|
begin
|
|
if FSize>0 then Stream.WriteBuffer (FMemory^,FSize);
|
|
end;
|
|
|
|
|
|
procedure TCustomMemoryStream.SaveToFile(const FileName: string);
|
|
|
|
Var S : TFileStream;
|
|
|
|
begin
|
|
Try
|
|
S:=TFileStream.Create (FileName,fmCreate);
|
|
SaveToStream(S);
|
|
finally
|
|
S.free;
|
|
end;
|
|
end;
|
|
|
|
|
|
{****************************************************************************}
|
|
{* TMemoryStream *}
|
|
{****************************************************************************}
|
|
|
|
|
|
Const TMSGrow = 4096; { Use 4k blocks. }
|
|
|
|
procedure TMemoryStream.SetCapacity(NewCapacity: Longint);
|
|
|
|
begin
|
|
SetPointer (Realloc(NewCapacity),Fsize);
|
|
FCapacity:=NewCapacity;
|
|
end;
|
|
|
|
|
|
function TMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
|
|
|
|
Var MoveSize : Longint;
|
|
|
|
begin
|
|
If NewCapacity>0 Then // round off to block size.
|
|
NewCapacity := (NewCapacity + (TMSGrow-1)) and not (TMSGROW-1);
|
|
// Only now check !
|
|
If NewCapacity<>FCapacity then
|
|
If NewCapacity=0 then
|
|
FreeMem (FMemory,Fcapacity)
|
|
else
|
|
begin
|
|
GetMem (Result,NewCapacity);
|
|
If Result=Nil then
|
|
Raise EStreamError.Create(SMemoryStreamError);
|
|
If FCapacity>0 then
|
|
begin
|
|
MoveSize:=FSize;
|
|
If MoveSize>NewCapacity then MoveSize:=NewCapacity;
|
|
Move (Fmemory^,Result^,MoveSize);
|
|
FreeMem (FMemory,FCapacity);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
destructor TMemoryStream.Destroy;
|
|
|
|
begin
|
|
Clear;
|
|
Inherited Destroy;
|
|
end;
|
|
|
|
|
|
procedure TMemoryStream.Clear;
|
|
|
|
begin
|
|
FSize:=0;
|
|
FPosition:=0;
|
|
SetCapacity (0);
|
|
end;
|
|
|
|
|
|
procedure TMemoryStream.LoadFromStream(Stream: TStream);
|
|
|
|
begin
|
|
Stream.Position:=0;
|
|
SetSize(Stream.Size);
|
|
If FSize>0 then Stream.ReadBuffer(FMemory^,FSize);
|
|
end;
|
|
|
|
|
|
procedure TMemoryStream.LoadFromFile(const FileName: string);
|
|
|
|
Var S : TFileStream;
|
|
|
|
begin
|
|
Try
|
|
S:=TFileStream.Create (FileName,fmOpenRead);
|
|
LoadFromStream(S);
|
|
finally
|
|
S.free;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TMemoryStream.SetSize(NewSize: Longint);
|
|
|
|
begin
|
|
SetCapacity (NewSize);
|
|
If FSize>NewSize then FSize:=NewSize;
|
|
IF FPosition>FSize then FPosition:=FSize;
|
|
end;
|
|
|
|
|
|
function TMemoryStream.Write(const Buffer; Count: Longint): Longint;
|
|
|
|
Var NewPos : Longint;
|
|
|
|
begin
|
|
If Count=0 then
|
|
exit(0);
|
|
NewPos:=FPosition+Count;
|
|
If NewPos>Fsize then
|
|
begin
|
|
IF NewPos>FCapacity then
|
|
SetCapacity (NewPos);
|
|
FSize:=Newpos;
|
|
end;
|
|
System.Move (Buffer,(FMemory+FPosition)^,Count);
|
|
FPosition:=NewPos;
|
|
Result:=Count;
|
|
end;
|
|
|
|
|
|
{****************************************************************************}
|
|
{* TStringStream *}
|
|
{****************************************************************************}
|
|
|
|
procedure TStringStream.SetSize(NewSize: Longint);
|
|
|
|
begin
|
|
//!! Setlength(FDataString,NewSize);
|
|
If FPosition>NewSize then FPosition:=NewSize;
|
|
end;
|
|
|
|
|
|
constructor TStringStream.Create(const AString: string);
|
|
|
|
begin
|
|
Inherited create;
|
|
FDataString:=AString;
|
|
end;
|
|
|
|
|
|
function TStringStream.Read(var Buffer; Count: Longint): Longint;
|
|
|
|
begin
|
|
Result:=Length(FDataString)-FPosition;
|
|
If Result>Count then Result:=Count;
|
|
// This supposes FDataString to be of type AnsiString !
|
|
//!! Move (Pchar(FDataString)[FPosition],Buffer,Count);
|
|
FPosition:=FPosition+Count;
|
|
end;
|
|
|
|
|
|
function TStringStream.ReadString(Count: Longint): string;
|
|
|
|
Var NewLen : Longint;
|
|
|
|
begin
|
|
NewLen:=Length(FDataString)-FPosition;
|
|
If NewLen>Count then NewLen:=Count;
|
|
//!! SetLength(Result,NewLen);
|
|
//!! Read (Pointer(Result)^,NewLen);
|
|
end;
|
|
|
|
|
|
function TStringStream.Seek(Offset: Longint; Origin: Word): Longint;
|
|
|
|
begin
|
|
Case Origin of
|
|
soFromBeginning : FPosition:=Offset;
|
|
soFromEnd : FPosition:=Length(FDataString)+Offset;
|
|
soFromCurrent : FpoSition:=FPosition+Offset;
|
|
end;
|
|
If FPosition>Length(FDataString) then FPosition:=Length(FDataString);
|
|
If FPosition<0 then FPosition:=0;
|
|
Result:=FPosition;
|
|
end;
|
|
|
|
|
|
function TStringStream.Write(const Buffer; Count: Longint): Longint;
|
|
|
|
begin
|
|
Result:=Count;
|
|
SetSize(FPosition+Count);
|
|
// This supposes that FDataString is of type AnsiString)
|
|
//!! Move (Buffer,PCHar(FDataString)[Fposition],Count);
|
|
FPosition:=FPosition+Count;
|
|
end;
|
|
|
|
|
|
procedure TStringStream.WriteString(const AString: string);
|
|
|
|
begin
|
|
//!! Write (PChar(Astring)[0],Length(AString));
|
|
end;
|
|
|
|
|
|
|
|
{****************************************************************************}
|
|
{* TResourceStream *}
|
|
{****************************************************************************}
|
|
|
|
procedure TResourceStream.Initialize(Instance: THandle; Name, ResType: PChar);
|
|
|
|
begin
|
|
end;
|
|
|
|
|
|
constructor TResourceStream.Create(Instance: THandle; const ResName: string; ResType: PChar);
|
|
|
|
begin
|
|
end;
|
|
|
|
|
|
constructor TResourceStream.CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
|
|
|
|
begin
|
|
end;
|
|
|
|
|
|
destructor TResourceStream.Destroy;
|
|
|
|
begin
|
|
end;
|
|
|
|
|
|
function TResourceStream.Write(const Buffer; Count: Longint): Longint;
|
|
|
|
begin
|
|
end;
|
|
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.12 1999-02-10 14:12:26 michael
|
|
+ Some strange bug in writecoponentres
|
|
|
|
Revision 1.11 1999/02/06 07:16:48 michael
|
|
+ Fixed Stream.ReadAnsiString
|
|
|
|
Revision 1.10 1999/02/02 21:23:19 michael
|
|
+ only sysutils is used now
|
|
|
|
Revision 1.9 1999/01/28 23:55:42 florian
|
|
* made it compilable
|
|
|
|
Revision 1.8 1998/10/02 22:41:30 michael
|
|
+ Added exceptions for error handling
|
|
|
|
Revision 1.7 1998/08/24 12:38:24 michael
|
|
small fixes
|
|
|
|
Revision 1.6 1998/06/11 21:15:28 michael
|
|
+ Implemented (Custom)Memory and StringStream
|
|
|
|
Revision 1.5 1998/06/11 13:46:33 michael
|
|
+ Fixed some functions. TFileStream OK.
|
|
|
|
Revision 1.4 1998/06/10 21:53:07 michael
|
|
+ Implemented Handle/FileStreams
|
|
|
|
Revision 1.3 1998/05/06 12:58:35 michael
|
|
+ Added WriteAnsiString method to TStream
|
|
|
|
Revision 1.2 1998/05/05 15:25:04 michael
|
|
+ Fix to be able to compile from florian
|
|
|
|
Revision 1.1 1998/05/04 14:30:12 michael
|
|
* Split file according to Class; implemented dummys for all methods, so unit compiles.
|
|
|
|
}
|