OS/2 Shareware BBS: 10 Tools/10-Tools.zip/sp15demo.zip/libsrc.zip/LIBSRC/STREAMS.PAS

Pascal/Delphi Source File | 1996-02-24 | 22KB | 654 lines

UNIT Streams;

{
╔═══════════════════════════════════════════════════════════════════════════╗
║                                                                           ║
║ Speed-Pascal/2 Version 2.0                                                ║
║                                                                           ║
║ Speed-Pascal Component Classes (SPCC)                                     ║
║                                                                           ║
║ This file: Streams class definitions                                      ║
║                                                                           ║
║ Last modified: September 1995                                             ║
║                                                                           ║
║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
║                                                                           ║
╚═══════════════════════════════════════════════════════════════════════════╝
}

INTERFACE

USES SysUtils;

TYPE
    EStreamReadError=CLASS(Exception);
    EStreamWriteError=CLASS(Exception);
    EStreamCreateError=CLASS(Exception);
    EStreamOpenError=CLASS(Exception);
    EStreamSeekError=CLASS(Exception);

CONST
    StreamReadErrorText   = 'TStream read error exception (EStreamReadError) occured';
    StreamWriteErrorText  = 'TStream write error exception (EStreamReadError) occured';
    StreamCreateErrorText = 'TStream create error exception (EStreamCreateError) occured';
    StreamOpenErrorText   = 'TStream open error exception (EStreamOpenError) occured';
    StreamSeekErrorText   = 'TStream seek error exception (EStreamSeekError) occured';

TYPE
    TStream name 'TStream'=CLASS(TObject)
                     PROTECTED
                            FUNCTION GetSize:LONGINT;VIRTUAL;
                            FUNCTION GetPosition:LONGINT;
                            PROCEDURE SetPosition(NewPos:Longint);
                     PUBLIC
                            PROCEDURE ReadBuffer(VAR Buffer;Count:LONGINT);
                            PROCEDURE WriteBuffer(CONST Buffer;Count:LONGINT);
                            FUNCTION Read(VAR Buffer;Count:LONGINT):LONGINT;
                                     VIRTUAL;ABSTRACT;
                            FUNCTION Write(CONST Buffer;Count:LONGINT):LONGINT;
                                     VIRTUAL;ABSTRACT;
                            FUNCTION Seek(Offset:LONGINT;Origin:WORD):LONGINT;
                                     VIRTUAL;ABSTRACT;
                            PROCEDURE ReadError;VIRTUAL;
                            PROCEDURE WriteError;VIRTUAL;
                            PROCEDURE CreateError;VIRTUAL;
                            PROCEDURE OpenError;VIRTUAL;
                            PROCEDURE SeekError;VIRTUAL;
                            PROCEDURE SetSize(NewSize:LONGINT);VIRTUAL;ABSTRACT;
                            DESTRUCTOR Destroy;OVERRIDE;

                            FUNCTION EndOfData: Boolean; virtual;

                            FUNCTION ReadLn: string; virtual;
                            PROCEDURE WriteLn(const S: string); virtual;

                            PROPERTY
                                     Position:LONGINT    read GetPosition
                                                         write SetPosition;
                            PROPERTY
                                     Size:LONGINT        read GetSize;
    END;
    TStreamClass=CLASS OF TStream;

CONST
    {FileStream Open modes}
    Stream_Create    = 1;
    Stream_Open      = 2;

TYPE
  THandleStream name 'THandleStream'= class(TStream)
                     PRIVATE
                            FHandle: LongInt;

                     PUBLIC
                          CONSTRUCTOR Create(AHandle: Integer);
                          FUNCTION Read(var Buffer; Count: Longint): Longint; override;
                          FUNCTION Write(CONST Buffer; Count: Longint): Longint; override;
                          FUNCTION Seek(Offset: Longint; Origin: Word): Longint; override;

                     PUBLIC
                          PROPERTY Handle: LongInt read FHandle;
  END;
  THandleStreamClass=CLASS OF THandleStream;

TYPE
  TFileHandleStream = class(THandleStream)
                     PUBLIC
                          CONSTRUCTOR Create(const FileName: string; Mode: LongInt);
                          DESTRUCTOR Destroy; virtual;
  END;
  TFileHandleStreamClass=CLASS OF TFileHandleStream;

TYPE
    TFileStream name 'TFileStream'=CLASS(TStream)
                     PRIVATE
                           PStreamFile:FILE;
                     PUBLIC
                           CONSTRUCTOR Create(CONST FileName:STRING;Mode:WORD);
                           DESTRUCTOR Destroy;OVERRIDE;
                           FUNCTION Read(VAR Buffer;Count:LONGINT):LONGINT;OVERRIDE;
                           FUNCTION Write(CONST Buffer;Count:LONGINT):LONGINT;OVERRIDE;
                           FUNCTION Seek(Offset:LONGINT;Origin:WORD):LONGINT;OVERRIDE;
    END;
    TFileStreamClass=CLASS OF TFileStream;

CONST
    {Memory increase size for Write}
    MemoryDelta:LONGWORD=8192;

TYPE
    PMemoryStreamBuffer=^TMemoryStreamBuffer;
    TMemoryStreamBuffer=ARRAY[0..1] OF BYTE;

    TMemoryStream name 'TMemoryStream'=CLASS(TStream)
                     PROTECTED
                           PBuffer:PMemoryStreamBuffer;
                           PSize:LONGINT;
                           PCapacity:LONGINT;
                           PPosition:LONGINT;
                     PROTECTED
                           PROCEDURE SetCapacity(NewCapacity:LONGINT);
                           FUNCTION GetCapacity:LONGINT;
                           FUNCTION GetSize:LONGINT;OVERRIDE;
                           FUNCTION GetBuffer:PMemoryStreamBuffer;
                     PUBLIC
                           CONSTRUCTOR Create;
                           DESTRUCTOR Destroy;OVERRIDE;
                           PROCEDURE LoadFromStream(Stream: TStream);
                           PROCEDURE LoadFromFile(CONST FileName:STRING);
                           PROCEDURE SaveToStream(Stream:TStream);
                           FUNCTION SaveToFile(CONST FileName:STRING):BOOLEAN;
                           FUNCTION Read(VAR Buffer;Count:Longint):Longint;OVERRIDE;
                           FUNCTION Write(CONST Buffer;Count:Longint):Longint;OVERRIDE;
                           FUNCTION Seek(Offset:Longint;Origin:Word):LONGINT;OVERRIDE;
                           PROCEDURE Clear;
                           PROCEDURE SetSize(NewSize:LONGINT);OVERRIDE;
                           FUNCTION GetCurrentBufPtr:POINTER;
                     PROPERTY Memory:PMemoryStreamBuffer
                                                    read GetBuffer;
                     PROPERTY Capacity:LONGINT      read GetCapacity
                                                    write SetCapacity;
    END;
    TMemoryStreamClass=CLASS OF TMemoryStream;


FUNCTION CreateSCUStream(Memory:POINTER):TMemoryStream;
PROCEDURE DestroySCUStream(VAR Stream:TMemoryStream);

IMPLEMENTATION

{
╔═══════════════════════════════════════════════════════════════════════════╗
║                                                                           ║
║ Speed-Pascal/2 Version 2.0                                                ║
║                                                                           ║
║ Speed-Pascal Component Classes (SPCC)                                     ║
║                                                                           ║
║ This section: TStream class implementation                                ║
║                                                                           ║
║ Last modified: September 1995                                             ║
║                                                                           ║
║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
║                                                                           ║
╚═══════════════════════════════════════════════════════════════════════════╝
}

FUNCTION TStream.GetSize:LONGINT;
VAR
   OldPos:LONGINT;
   Result:LONGINT;
BEGIN
     OldPos:=GetPosition;
     result:=Seek(0,Seek_End);
     SetPosition(OldPos);
     GetSize:=result;
END;

FUNCTION TStream.EndOfData: Boolean;
BEGIN
  Result := (Position >= Size);
END;

FUNCTION TStream.GetPosition:LONGINT;
BEGIN
     GetPosition:=Seek(0,Seek_Current);
END;

PROCEDURE TStream.SetPosition(NewPos:Longint);
BEGIN
     Seek(NewPos,Seek_Begin);
END;

PROCEDURE TStream.ReadBuffer(VAR Buffer;Count:LONGINT);
BEGIN
     IF Count=0 THEN exit;  {Nothing to read}
     IF Read(Buffer,Count)<>Count THEN ReadError;
END;

PROCEDURE TStream.WriteBuffer(CONST Buffer;Count:LONGINT);
BEGIN
     IF Count=0 THEN exit;
     IF Write(Buffer,Count)<>Count THEN WriteError;
END;

PROCEDURE TStream.ReadError;
BEGIN
     RAISE EStreamReadError.Create(StreamReadErrorText);
END;

PROCEDURE TStream.WriteError;
BEGIN
     RAISE EStreamWriteError.Create(StreamWriteErrorText);
END;

PROCEDURE TStream.CreateError;
BEGIN
     RAISE EStreamCreateError.Create(StreamCreateErrorText);
END;

PROCEDURE TStream.OpenError;
BEGIN
     RAISE EStreamOpenError.Create(StreamOpenErrorText);
END;

PROCEDURE TStream.SeekError;
BEGIN
     RAISE EStreamSeekError.Create(StreamSeekErrorText);
END;

DESTRUCTOR TStream.Destroy;
BEGIN
     Inherited Destroy;
END;


FUNCTION TStream.ReadLn: STRING;
VAR
  Buffer: cstring[260];
  OldPos, Count, Temp: LongInt;
BEGIN
  OldPos := Position;

  Count := Read(Buffer[0], 257);
  Buffer[Count] := #0;

  Temp := 0;
  while not (Buffer[Temp] in [#10, #13, #26])
    and (Temp < Count) and (Temp < 255) do Inc (Temp);

  Move(Buffer[0], Result[1], Temp);
  SetLength(Result, Temp);
  Inc(Temp);

  if (Buffer[Temp - 1] = #13) and (Buffer[Temp] = #10) then Inc(Temp);

  Position := OldPos + Temp;
END;

PROCEDURE TStream.WriteLn(const S: string);
VAR
  CRLF: Word;
BEGIN
  CRLF := $0A0D;
  WriteBuffer(S[1], Length(S));
  WriteBuffer(CRLF, 2);
END;

{
╔═══════════════════════════════════════════════════════════════════════════╗
║                                                                           ║
║ Speed-Pascal/2 Version 2.0                                                ║
║                                                                           ║
║ Speed-Pascal Component Classes (SPCC)                                     ║
║                                                                           ║
║ This section: THandleStream class implementation                          ║
║                                                                           ║
║ Last modified: September 1995                                             ║
║                                                                           ║
║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
║                                                                           ║
╚═══════════════════════════════════════════════════════════════════════════╝
}

constructor THandleStream.Create(AHandle: Integer);
begin
  FHandle := AHandle;
end;

function THandleStream.Read(var Buffer; Count: Longint): Longint;
begin
  Result := FileRead(Handle, Buffer, Count);
  if Result = -1 then Result := 0;
end;

function THandleStream.Write(CONST Buffer; Count: Longint): Longint;
var temp:^BYTE;
begin
  Temp:=@Buffer;
  Result := FileWrite(Handle, Temp^, Count);
  if Result = -1 then Result := 0;
end;

function THandleStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  Result := FileSeek(Handle, Offset, Origin);
  if Result < 0 then SeekError;
end;

{
╔═══════════════════════════════════════════════════════════════════════════╗
║                                                                           ║
║ Speed-Pascal/2 Version 2.0                                                ║
║                                                                           ║
║ Speed-Pascal Component Classes (SPCC)                                     ║
║                                                                           ║
║ This section: TFileHandleStream class implementation                      ║
║                                                                           ║
║ Last modified: September 1995                                             ║
║                                                                           ║
║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
║                                                                           ║
╚═══════════════════════════════════════════════════════════════════════════╝
}

constructor TFileHandleStream.Create(const FileName: string; Mode: LongInt);
begin
  if Mode = Stream_Create then
  begin
    FHandle := FileCreate(FileName);
    if FHandle = -1 then CreateError;
  end
  else
  begin
    FHandle := FileOpen(FileName, Mode);
    if FHandle = -1 then OpenError;
  end;
end;

destructor TFileHandleStream.Destroy;
begin
  if FHandle > 0 then FileClose(FHandle);
end;


{
╔═══════════════════════════════════════════════════════════════════════════╗
║                                                                           ║
║ Speed-Pascal/2 Version 2.0                                                ║
║                                                                           ║
║ Speed-Pascal Component Classes (SPCC)                                     ║
║                                                                           ║
║ This section: TFileStream class implementation                            ║
║                                                                           ║
║ Last modified: September 1995                                             ║
║                                                                           ║
║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
║                                                                           ║
╚═══════════════════════════════════════════════════════════════════════════╝
}

CONSTRUCTOR TFileStream.Create(CONST FileName:STRING;Mode:WORD);
BEGIN
     Inherited Create;

     Assign(PStreamFile,FileName);
     CASE Mode OF
        Stream_Open:
        BEGIN
             {$i-}
             Reset(PStreamFile,1);
             {$i+}
             IF IoResult<>0 THEN OpenError;
        END;
        Stream_Create:
        BEGIN
             {$i-}
             Rewrite(PStreamFile,1);
             {$i+}
             IF IoResult<>0 THEN CreateError;
        END;
     END; {case}
END;

DESTRUCTOR TFileStream.Destroy;
BEGIN
     {$i-}
     Close(PStreamFile);
     {$i+}
END;

FUNCTION TFileStream.Read(VAR Buffer;Count:LONGINT):LONGINT;
VAR
   Result:LONGINT;
BEGIN
     {$i-}
     BlockRead(PStreamFile,Buffer,Count,Result);
     {$i+}
     IF IoResult<>0 THEN ReadError;
     Read:=Result;
END;

FUNCTION TFileStream.Write(CONST Buffer;Count:LONGINT):LONGINT;
VAR
   pb:POINTER;
   Result:LONGINT;
BEGIN
     pb:=@Buffer;
     {$i-}
     BlockWrite(PStreamFile,pb^,Count,Result);
     {$i+}
     IF IoResult<>0 THEN WriteError;
     Write:=Result;
END;

FUNCTION TFileStream.Seek(Offset:LONGINT;Origin:WORD):LONGINT;
VAR
   SaveSeekMode:LONGWORD;
BEGIN
     SaveSeekMode:=SeekMode;
     SeekMode:=Origin;
     {$i-}
     SYSTEM.Seek(PStreamFile,Offset);
     {$i+}
     IF IoResult<>0 THEN SeekError;
     SeekMode:=SaveSeekMode;
     {$i-}
     Seek:=FilePos(PStreamFile);
     {$i+}
     IF IoResult<>0 THEN SeekError;
END;


{
╔═══════════════════════════════════════════════════════════════════════════╗
║                                                                           ║
║ Speed-Pascal/2 Version 2.0                                                ║
║                                                                           ║
║ Speed-Pascal Component Classes (SPCC)                                     ║
║                                                                           ║
║ This section: TMemoryStream class implementation                          ║
║                                                                           ║
║ Last modified: September 1995                                             ║
║                                                                           ║
║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
║                                                                           ║
╚═══════════════════════════════════════════════════════════════════════════╝
}

FUNCTION TMemoryStream.GetBuffer:PMemoryStreamBuffer;
BEGIN
     GetBuffer:=PBuffer;
END;

PROCEDURE TMemoryStream.SetCapacity(NewCapacity:LONGINT);
VAR
   p:POINTER;
BEGIN
     IF NewCapacity=PCapacity THEN exit;
     IF NewCapacity=0 THEN
     BEGIN
          IF PBuffer<>NIL THEN FreeMem(PBuffer,PCapacity);
          PSize:=0;
          PPosition:=0;
          PBuffer:=NIL;
     END
     ELSE
     BEGIN
          Getmem(p,NewCapacity);
          IF PBuffer<>NIL THEN
          BEGIN
               IF NewCapacity<PCapacity THEN
               BEGIN
                   move(PBuffer^,p^,NewCapacity);
                   PSize:=NewCapacity;
                   IF PPosition>PSize THEN PPosition:=PSize;
               END
               ELSE move(PBuffer^,p^,PCapacity);
               FreeMem(PBuffer,PCapacity);
          END
          ELSE
          BEGIN
               PSize:=0;
               PPosition:=0;
          END;
          PBuffer:=p;
     END;

     PCapacity:=NewCapacity;
END;

FUNCTION TMemoryStream.GetCapacity:LONGINT;
BEGIN
     GetCapacity:=Capacity;
END;

PROCEDURE TMemoryStream.SetSize(NewSize:LONGINT);
BEGIN
     Clear;
     SetCapacity(NewSize);
     PSize:=NewSize;
END;

FUNCTION TMemoryStream.GetSize:LONGINT;
BEGIN
     GetSize:=PSize;
END;

CONSTRUCTOR TMemoryStream.Create;
BEGIN
     Inherited Create;

     PSize:=0;
     PCapacity:=0;
     PPosition:=0;
     PBuffer:=NIL;
END;

DESTRUCTOR TMemoryStream.Destroy;
BEGIN
     Clear;
     Inherited Destroy;
END;

FUNCTION TMemoryStream.Read(VAR Buffer;Count:Longint):Longint;
VAR
   result:LONGINT;
LABEL l;
BEGIN
     Result:=0;
     IF PBuffer=NIL THEN goto l;
     IF PPosition+Count>PSize THEN Count:=PSize-PPosition;
     IF Count<=0 THEN goto l;

     move(PBuffer^[PPosition],Buffer,Count);
     inc(PPosition,Count);
     result:=Count;
l:
     Read:=result;
END;

FUNCTION TMemoryStream.GetCurrentBufPtr:POINTER;
BEGIN
     result:=PBuffer;
     inc(result,PPosition);
END;

FUNCTION TMemoryStream.Write(CONST Buffer;Count:Longint):Longint;
VAR
   Result:LONGINT;
   pb:POINTER;
LABEL l;
BEGIN
     Result:=0;
     IF Count<=0 THEN goto l;
     IF PBuffer=NIL THEN goto l;

     pb:=@Buffer;
     IF PPosition+Count>PCapacity THEN SetCapacity(PPosition+Count+MemoryDelta);
     move(pb^,PBuffer^[PPosition],Count);
     inc(PPosition,Count);
     IF PPosition>PSize THEN PSize:=PPosition;
     result:=Count;
l:
     Write:=Result;
END;

FUNCTION TMemoryStream.Seek(Offset:Longint;Origin:Word):LONGINT;
BEGIN
     CASE Origin OF
        Seek_Begin:IF Offset<=PSize THEN PPosition:=Offset;
        Seek_Current:IF PPosition+Offset<=PSize THEN PPosition:=PPosition+Offset;
        Seek_End:IF PSize+Offset<=PSize THEN PPosition:=PSize+Offset;
     END; {case}

     Seek:=PPosition;
END;

PROCEDURE TMemoryStream.LoadFromStream(Stream: TStream);
BEGIN
     IF PBuffer=NIL THEN exit;
     Stream.Position:=0;
     SetSize(Stream.Size);
     IF PSize=0 THEN exit;  {nothing to read}
     Stream.ReadBuffer(PBuffer^,PSize);
END;

PROCEDURE TMemoryStream.LoadFromFile(CONST FileName:STRING);
VAR
   FileStream:TFileStream;
BEGIN
     FileStream.Create(FileName,Stream_Open);
     TRY
        LoadFromStream(FileStream);
     FINALLY
        FileStream.Destroy;
     END;
END;

PROCEDURE TMemoryStream.SaveToStream(Stream:TStream);
BEGIN
     IF PBuffer=NIL THEN exit;
     IF PSize=0 THEN exit; {Nothing to write}
     Stream.WriteBuffer(PBuffer^,PSize);
END;

FUNCTION TMemoryStream.SaveToFile(CONST FileName:STRING):BOOLEAN;
VAR
   FileStream:TFileStream;
BEGIN
     result:=TRUE;

     TRY
        FileStream.Create(FileName,Stream_Create);
        SaveToStream(FileStream);
     EXCEPT
        result:=FALSE;
     END;

     FileStream.Destroy;
END;

PROCEDURE TMemoryStream.Clear;
BEGIN
     SetCapacity(0);
END;

FUNCTION CreateSCUStream(Memory:POINTER):TMemoryStream;
BEGIN
     result.Create;
     result.PBuffer:=Memory;
     result.PSize:=MaxLongInt;
     result.PCapacity:=MaxLongInt;
     result.PPosition:=0;
END;

PROCEDURE DestroySCUStream(VAR Stream:TMemoryStream);
BEGIN
     Stream.PBuffer:=NIL;
     Stream.PSize:=0;
     Stream.PCapacity:=0;
     Stream.Destroy;
END;

END.