fpc/fcl/inc/streams.inc

{
    $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.

}