{ $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)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 Writer.Create(Self,1024); Writer.WriteRootComponent(Instance); Writer.Destroy; 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; if ReadWord<>$000a then raise EInvalidImage; { read name } while ReadByte<>0 do ; { check the access specifier } if ReadWord<>$1030 then raise EInvalidImage; { ignore the size } ReadDWord; except {///// on EInvalidImage do raise; else raise(EInvalidImage); } 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:=OSReadHandle(FHandle,Buffer,Count); If Result=-1 then Result:=0; end; function THandleStream.Write(const Buffer; Count: Longint): Longint; begin Result:=OSWriteHandle(FHandle,Buffer,Count); If Result=-1 then Result:=0; end; {****************************************************************************} {* TFileStream *} {****************************************************************************} constructor TFileStream.Create(const FileName: string; Mode: Word); begin FHandle:=OSCreateFile (Filename,Mode); If FHandle<0 then {$ifdef NoExceptions} RunError(255); {$else} raise EFCreateError; {$endif} end; destructor TFileStream.Destroy; begin OSCloseHandle(FHandle); end; Procedure TFileStream.SetSize(NewSize: Longint); begin OSSetHandleSize (FHandle,NewSize); end; function TFileStream.Seek(Offset: Longint; Origin: Word): Longint; begin Result:=OSSeekHandle (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 FPositionCount 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 S:=TFileStream.Create (FileName,fmCreate); SaveToStream(S); S.free; 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 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 S:=TFileStream.Create (FileName,fmOpenRead); LoadFromStream(S); S.free; 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.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. }