{$B-}   { Use fast boolean evaluation. }

unit Streams;

{ Unit to provide enhancements to TV Objects unit streams in the form
  of several filters, i.e. stream clients, and other streams. }

{ Version 1.2 - Adds TNulStream and TXMSStream, from suggestion and
                code by Stefan Boether; TBitFilter, from suggestion
                by Rene Seguin; added call to Flush to TFilter.Done;
                UseBuf and OwnMem to TRAMStream.
                TTextFilter fixed so that mixed access methods work.
          1.3 - Added TDupFilter, TSequential, CRCs and Checksums }

{$ifndef windows}
  {$O-}
  { Don't overlay this unit; it contains code that needs to participate
         in overlay management. }
{$endif

{  Hierarchy:

   TStream                  (from Objects)
     TFilter                Base type for filters
       TEncryptFilter       Encrypts as it writes; decrypts as it reads
       TLZWFilter           Compresses as it writes; expands as it reads
       TTextFilter          Provides text file interface to stream
       TLogFilter           Provides logging of text file activity
       TBitFilter           Allows reads & writes by the bit
       TDupFilter           Duplicates output, checks for matching input
       TSequential          Filter that doesn't allow Seek
         TChksumFilter      Calculates 16 bit checksum for reads and writes
         TCRC16Filter       Calculates XMODEM-style 16 bit CRC
         TCRCARCFilter      Calculates ARC-style 16 bit CRC
         TCRC32Filter       Calculates ZIP/ZModem-style 32 bit CRC
     TNulStream             Eats writes, returns constant on reads
     TRAMStream             Stream in memory
     TXMSStream             Stream in XMS
     TDOSStream             (from Objects)
       TBufStream           (from Objects)
         TNamedBufStream    Buffered file stream that knows its name
           TTempBufStream   Buffered file stream that erases itself when done

   Procedures & functions:

   TempStream      allocates a temporary stream
   OvrInitStream   like OvrInitEMS, but buffers overlays on a stream
                   May be called several times to buffer different
                   segments on different streams.
   OvrDetachStream detaches stream from overlay system
   OvrDisposeStreams detaches all streams from overlay system and disposes of
                   them
   OvrSizeNeeded   Calculates the size needed to load the rest of the segments
                   to a stream
   OvrLoadAll      immediately copies as many overlay segments to the stream
                   as will fit
   UpdateChkSum    updates a 16 bit checksum value
   UpdateCRC16     updates a CRC16 value
   UpdateCRCARC    updates a CRCARC value
   UpdateCRC32     updates a CRC32 value

}

interface

{$ifdef windows}
uses strings,windos,winprocs,wobjects;
{$else}
uses DOS, Overlay, Objects;
{$endif}

const
  stBadMode = 1;                  { Bad mode for stream - operation not supported
                                    info = mode }
  stStreamFail = 2;               { Stream init failed }
  stBaseError = 3;                { Error in base stream
                                    info = base error value }
  stMemError = 4;                 { Not enough memory for operation }
  stSigError = 5;                 { Problem with LZ file signature }
  stUsedAll = 6;                  { Used limit of allocation }
  stUnsupported = 7;              { Operation unsupported in this stream }
  stBase2Error = 8;               { Error in second base
                                    info = base2 error value }
  stMisMatch = 9;                 { Two bases don't match
                                    info = mismatch position in current buffer }
  stIntegrity = 10;               { Stream has detected an integrity error
                                    in a self check.  Info depends on
                                    stream type. }
type
  TOpenMode = $3C00..$3DFF;       { Allowable DOS stream open modes }
  {$ifdef windows}
  FNameStr = PChar;            { To make streams take names as in the manual }
  {$endif}

  PFilter = ^TFilter;
  TFilter =
    object(TStream)
    { Generic object to filter another stream.  TFilter just passes everything
      through, and mirrors the status of the base stream }

      Base : PStream;
      { Pointer to the base stream. }

      Startofs : LongInt;
      { The offset of the start of the filter in the base stream. }

      constructor Init(ABase : PStream);
        { Initialize the filter with the given base. }

      destructor Done; virtual;
        { Flush filter, then dispose of base. }

      function GetPos : LongInt; virtual;
      function GetSize : LongInt; virtual;
      procedure Read(var Buf; Count : Word); virtual;
      procedure Seek(Pos : LongInt); virtual;
      procedure Truncate; virtual;
      procedure Write(var Buf; Count : Word); virtual;
      procedure Flush; virtual;

      function CheckStatus : Boolean; virtual;
    { Return true if status is stOK.
      If status is stOK, but base is not, then reset the base.  This is a poor
      substitute for a virtual Reset method. }

      procedure CheckBase;
        { Check base stream for error, and copy status using own Error method. }
    end;

  PEncryptFilter = ^TEncryptFilter;
  TEncryptFilter =
    object(TFilter)
  { Filter which encrypts text going in or out; encrypting twice with the same
    key decrypts. Not very sophisticated encryption. }

      Key : LongInt;
      { Key is used as a Randseed replacement }

      constructor Init(Akey : LongInt; ABase : PStream);
        { Init with a given key }

      procedure Read(var Buf; Count : Word); virtual;
      procedure Seek(Pos : LongInt); virtual;
      procedure Write(var Buf; Count : Word); virtual;
    end;

const
  MaxStack = 4096;                { must match lzwstream.asm declaration! }

type
  PLZWTables = ^TLZWTables;
  TLZWTables =
    record
      Collision : array[0..MaxStack-1] of Byte; { Hash table entries }
      PrefixTable : array[0..MaxStack-1] of Word; { Code for preceding stringf }
      SuffixTable : array[0..MaxStack-1] of Byte; { Code for current character }
      ChildTable : array[0..MaxStack-1] of Word; { Next duplicate in collision
                                                 list }
      CharStack : array[0..MaxStack-1] of Byte; { Decompression stack }
      StackPtr : Word;            { Decompression stack depth }
      Prefix : Word;              { Previous code string }
      TableUsed : Word;           { # string table entries used }
      InputPos : Word;            { Index in input buffer }
      OutputPos : Word;           { Index in output buffer }
      LastHit : Word;             { Last empty slot in collision
                                                 table }
      CodeBuf : Word;
      SaveIP : Word;
      SaveAX : Word;
      SaveCX : Word;
      SaveDX : Word;

      NotFound : Byte;            { Character combination found
                                                 flag }
    end;

  PLZWFilter = ^TLZWFilter;
  TLZWFilter =
    object(TFilter)
      Mode : Word;                { Either stOpenRead or stOpenWrite. }
      Size,                       { The size of the expanded stream. }
      Position : LongInt;         { The current position in the expanded stream }
      Tables : PLZWTables;        { Tables holding the compressor state. }

      constructor Init(ABase : PStream; AMode : TOpenMode);
    {  Create new compressor stream, to use ABase as the source/destination
       for data.  Mode must be stOpenRead or stOpenWrite. }

      destructor Done; virtual;
    {  Flushes all data to the stream, and writes the uncompressed
       filesize to the head of it before calling TFilter.done. }

      procedure Flush; virtual;
      function GetPos : LongInt; virtual;
      function GetSize : LongInt; virtual;
      procedure Read(var Buf; Count : Word); virtual;

      procedure Seek(Pos : LongInt); virtual;
    {  Seek is not supported at all in Write mode.  In Read mode, it is
       slow for seeking forwards, and very slow for seeking backwards:
       it rewinds the file to the start and seeks forward from there. }

      procedure Truncate; virtual;
    {  Truncate is not supported in either mode, and always causes a
       call to Error. }

      procedure Write(var Buf; Count : Word); virtual;
    end;

type
  PTextFilter = ^TTextFilter;
  TTextFilter =
    object(TFilter)
  { A filter to provide ReadLn/WriteLn interface to a stream.  First
    open the stream and position it, then pass it to this filter;
    then Reset, Rewrite, or Append the Textfile variable, and do all
    reads and writes to it; they'll go to the stream through a TFDD. }

      Textfile : Text;
      { The fake text file to use with Read(ln)/Write(ln) }

      constructor Init(ABase : PStream; AName : String);
    { Initialize the interface to ABase; stores AName in the name field of
      Textfile. }

      destructor Done; virtual;
        { Flushes the Textfile, then closes and disposes of the base stream. }

      function GetPos : LongInt; virtual;
      function GetSize : LongInt; virtual;
      procedure Read(var Buf; Count : Word); virtual;
      procedure Seek(Pos : LongInt); virtual;
      procedure Truncate; virtual;
      procedure Write(var Buf; Count : Word); virtual;
    end;

  PLogFilter = ^TLogFilter;
  TLogFilter =
    object(TFilter)
      { A filter to log activity on a text file. }

      LogList : ^Text;            { A pointer to the first logged file }

      constructor init(ABase:PStream);
      { Initializes filter, but doesn't start logging anything }

      destructor Done; virtual;
      { Stops logging all files, and closes & disposes of the base stream }

      procedure Log(var F : Text);
    { Logs all input and output to F to the stream.  You must do the Assign to
      F first, and not do another Assign without closing F. }

      function Unlog(var F : Text) : Boolean;
    { Stops logging of F.  Called automatically if file is closed. Returns
      false and does nothing on error. }
    end;

  TBit = 0..1;                    { A single bit }

  PBitFilter = ^TBitFilter;
  TBitFilter =
    object(TFilter)
      BitPos : ShortInt;
      { Position of stream relative to base file.  Negative values signal
        that the buffer is unchanged from the file, positive values signal
        that the file needs to be updated.  Zero signals an empty buffer. }
      Mask : Byte;                { Mask to extract next bit from buffer }
      Buffer : Byte;              { Buffer of next 8 bits from stream }
      AtEnd : Boolean;            { Flag to signal that we're at the end
                                    of the base, and we shouldn't read
                                    it.  Bases that change in length should
                                    set this to false. }

      constructor Init(ABase : PStream);

      procedure Flush; virtual;   { Flush buffer to stream }
      procedure Seek(Pos : LongInt); virtual; { Seek to bit at start of
                                               pos byte }
      procedure Read(var Buf; Count : Word); virtual;
      procedure Write(var Buf; Count : Word); virtual;

      function GetBit : TBit;     { Get next bit from stream }
      function GetBits(Count : Byte) : LongInt; { Get up to 32 bits }
      procedure ReadBits(var Buf; Count : LongInt); { Read bits from stream }

      procedure PutBit(ABit : TBit); { Put one bit to stream }
      procedure PutBits(ABits : LongInt; Count : Byte); { Put up to 32 bits }
      procedure WriteBits(var Buf; Count : LongInt); { Write count bits to stream }

      procedure SeekBit(Pos : LongInt); { Seek to particular bit }
      function GetBitPos : LongInt;

      procedure CopyBits(var S : TBitFilter; Count : LongInt); { Copy bits from S }
      procedure ByteAlign;        { Seek forward to next byte boundary. }

      procedure PrepareBuffer(ForRead : Boolean);
        { Internal method to assure that buffer is valid }
    end;

  PDupFilter = ^TDupFilter;
  TDupFilter =
    object(TFilter)         { Duplicates output, confirms matching input }
      Base2 : PStream;
      { Pointer to the second base. }

      Startofs2 : LongInt;
      { The offset of the start of the filter in the second base. }

      constructor Init(ABase, ABase2 : PStream);
        { Initialize the filter with the given bases. }

      destructor Done; virtual;
        { Flush filter, then dispose of both bases. }

      function MisMatch(var buf1,buf2; count:word):word; virtual;
        { Checks for a mismatch between the two buffers.  Returns
          the byte number of the mismatch (1 based), or 0 if they
          test equal.  This default method checks for an exact match. }

      procedure Read(var Buf; Count : Word); virtual;
      procedure Seek(Pos : LongInt); virtual;
      procedure Truncate; virtual;
      procedure Write(var Buf; Count : Word); virtual;
      procedure Flush; virtual;

      function CheckStatus : Boolean; virtual;
    { Return true if status is stOK.
      If status is stOK, but base is not, then reset the base.  This is a poor
      substitute for a virtual Reset method. }

      procedure CheckBase2;
        { Check 2nd base stream for error, and copy status using own Error method. }
    end;

  PSequential = ^TSequential;
  TSequential =
    object(TFilter)                        { Filter for sequential access only }
      procedure Seek(pos:longint); virtual;{ Signals stUnsupported if a Seek is attempted }
    end;

  PChksumFilter = ^TChksumFilter;
  TChksumFilter =
    object(TSequential)                    { Calculates 16 bit checksum of
                                             bytes read/written. }
      Chksum : word;

      constructor Init(ABase : PStream;AChksum:word);
        { Initialize the filter with the given base and starting checksum. }

      procedure Read(var Buf; Count : Word); virtual;
      procedure Write(var Buf; Count : Word); virtual;
    end;

  PCRC16Filter = ^TCRC16Filter;
  TCRC16Filter =
    object(TSequential)      { Calculates XMODEM style 16 bit CRC }
      CRC16 : word;

      constructor Init(ABase : PStream;ACRC16:word);
        { Initialize the filter with the given base and starting CRC. }

      procedure Read(var Buf; Count : Word); virtual;
      procedure Write(var Buf; Count : Word); virtual;
    end;

  PCRCARCFilter = ^TCRCARCFilter;
  TCRCARCFilter =
    object(TSequential)      { Calculates ARC-style 16 bit CRC }
      CRCARC : word;

      constructor Init(ABase : PStream;ACRCARC:word);
        { Initialize the filter with the given base and starting CRC. }

      procedure Read(var Buf; Count : Word); virtual;
      procedure Write(var Buf; Count : Word); virtual;
    end;

  PCRC32Filter = ^TCRC32Filter;
  TCRC32Filter =
    object(TSequential)      { Calculates PKZIP and ZModem style 32 bit CRC }
      CRC32 : longint;

      constructor Init(ABase : PStream;ACRC32:longint);
        { Initialize the filter with the given base and starting CRC. }

      procedure Read(var Buf; Count : Word); virtual;
      procedure Write(var Buf; Count : Word); virtual;
    end;


  PNulStream = ^TNulStream;
  TNulStream =
    object(TStream)
      Position : LongInt;         { The current position for the stream. }
      Value : Byte;               { The value returned on reads. }

      constructor Init(AValue : Byte);
      function GetPos : LongInt; virtual;
      function GetSize : LongInt; virtual;
      procedure Read(var Buf; Count : Word); virtual;
      procedure Seek(Pos : LongInt); virtual;
      procedure Write(var Buf; Count : Word); virtual;
    end;

  Pbyte_array = ^Tbyte_array;
  Tbyte_array = array[0..65520] of Byte; { Type used as a buffer. }

  PRAMStream = ^TRAMStream;
  TRAMStream =
    object(TStream)
      Position : Word;            { The current position for the stream. }

      Size : Word;                { The current size of the stream. }
      Alloc : Word;               { The size of the allocated block of memory. }

      Buffer : Pbyte_array;       { Points to the stream data. }
      OwnMem : Boolean;           { Whether Done should dispose of data.}

      constructor Init(Asize : Word);
    { Attempt to initialize the stream to a block size of Asize;
       initial stream size and position are 0. }
      constructor UseBuf(ABuffer : Pointer; Asize : Word);
     { Initialize the stream using the specified buffer.  OwnMem is set
       to false, so the buffer won't be disposed of. }

      destructor Done; virtual;
        { Dispose of the stream. }

      function GetPos : LongInt; virtual;
      function GetSize : LongInt; virtual;
      procedure Read(var Buf; Count : Word); virtual;
      procedure Seek(Pos : LongInt); virtual;
      procedure Truncate; virtual;
      procedure Write(var Buf; Count : Word); virtual;
    end;

  PXMSStream = ^TXMSStream;
  TXMSStream =
    object(TStream)
      Handle : Word;              { XMS handle }
      MaxBlocks : Word;           { Max 1K blocks to allocate }
      BlocksUsed : Word;          { Number of 1K blocks used. Always allocates
                                    at least one byte more than Size. }
      Size : LongInt;             { The current size of the stream }
      Position : LongInt;         { Current position }

      constructor Init(AMaxBlocks : Word);
      destructor Done; virtual;

      function GetPos : LongInt; virtual;
      function GetSize : LongInt; virtual;
      procedure Read(var Buf; Count : Word); virtual;
      procedure Seek(Pos : LongInt); virtual;
      procedure Truncate; virtual;
      procedure Write(var Buf; Count : Word); virtual;

      procedure NewBlock;         { Internal method to allocate a block }
      procedure FreeBlock;        { Internal method to free one block }
    end;

function xms_MemAvail : Word;
  { Returns number of available XMS blocks. }
function xms_MaxAvail : Word;
  { Returns size of largest available XMS block. }

type
  PNamedBufStream = ^TNamedBufStream;
  TNamedBufStream =
    object(TBufStream)
      { A simple descendant of TBufStream which knows its own name. }

    {$ifdef windows}
    filename : PChar;
    {$else}
      Filename : PString;
    {$endif}
      { The name of the stream. }

      constructor Init(Name : FNameStr; Mode : TOpenMode; ABufSize : Word);
        { Open the file with the given name, and save the name. }

      destructor Done; virtual;
        { Close the file. }

    end;

  PTempBufStream = ^TTempBufStream;
  TTempBufStream =
    object(TNamedBufStream)
      { A temporary buffered file stream, which deletes itself when done.}

      constructor Init(ABufSize : Word);
  { Create a temporary file with a unique name, in the directory
    pointed to by the environment varable TEMP or in the current
    directory, and open it in read/write mode.   }

      destructor Done; virtual;
        { Close and delete the temporary file. }

    end;

type
  TStreamType = (NoStream, RAMStream, EMSStream, XMSStream, FileStream);
  { The type of stream that a tempstream might be. }

const
  NumTypes = Ord(FileStream);
  BufSize : Word = 2048;          { Buffer size if buffered stream is used. }

type
  TStreamRanking = array[1..NumTypes] of TStreamType;
  { A ranking of preference for a type of stream, from most to least preferred }

const ForSpeed : TStreamRanking = (RAMStream, EMSStream, XMSStream, FileStream);
  { Streams ordered for speed }

const ForSize : TStreamRanking = (FileStream, EMSStream, XMSStream, RAMStream);
  { Streams ordered for low impact on the heap }

const ForSizeInMem : TStreamRanking = (EMSStream, XMSStream, RAMStream, NoStream);
  { Streams in memory only, ordered as #ForSize#. }

const ForOverlays : TStreamRanking = (EMSStream, XMSStream, FileStream, NoStream);
  { Streams ordered for speed, but never in RAM. }

function TempStream(InitSize, MaxSize : LongInt;
                    Preference : TStreamRanking) : PStream;

{      This procedure returns a pointer to a temporary stream from a
       choice of 3, specified in the Preference array.  The first stream
       type listed in the Preference array which can be successfully
       created with the given sizes will be returned, or Nil if none can
       be made. }

{$ifndef windows}
procedure OvrInitStream(S : PStream);
{ Copies overlay segment code to S as new segments are loaded,
  and does reloads from there.  Allows multiple calls, to buffer
  different segments on different streams. }

procedure OvrDetachStream(BadS : PStream);
  { Makes sure that the overlay system makes no references to BadS. }

procedure OvrDisposeStreams;
  { Detaches and disposes of all streams being used by the overlay system }

function OvrSizeNeeded : LongInt;
{ Returns the size required to load any segments which still haven't
  been loaded to a stream. }

function OvrLoadAll : Boolean;
{ Forces all overlay segments to be copied into the stream; if successful
  (true) then no more references to the overlay file will be made. }
{$endif windows}

Function UpdateChksum(Initsum: Word; Var InBuf; InLen : Word) : Word;
{ Updates the checksum Initsum by adding InLen bytes from InBuf }

Function UpdateCRC16(InitCRC : Word; Var InBuf; InLen : Word) : Word;
{ I believe this is the CRC used by the XModem protocol.  The transmitting
  end should initialize with zero, UpdateCRC16 for the block, Continue the
  UpdateCRC16 for two nulls, and append the result (hi order byte first) to
  the transmitted block.  The receiver should initialize with zero and
  UpdateCRC16 for the received block including the two byte CRC.  The
  result will be zero (why?) if there were no transmission errors.  (I have
  not tested this function with an actual XModem implementation, though I
  did verify the behavior just described.  See TESTCRC.PAS.) }


Function UpdateCRCArc(InitCRC : Word; Var InBuf; InLen : Word) : Word;
{ This function computes the CRC used by SEA's ARC utility.  Initialize
  with zero. }

Function UpdateCRC32(InitCRC : LongInt; Var InBuf; InLen : Word) : LongInt;
{ This function computes the CRC used by PKZIP and Forsberg's ZModem.
  Initialize with high-values ($FFFFFFFF), and finish by inverting all bits
  (Not). }

implementation

  constructor TFilter.Init(ABase : PStream);
  begin
    TStream.Init;
    Base := ABase;
    CheckBase;
    if Status = stOK then
      Startofs := Base^.GetPos;
  end;

  destructor TFilter.Done;
  begin
    if Base <> nil then
    begin
      Flush;
      Dispose(Base, Done);
    end;
    TStream.Done;
  end;

  function TFilter.GetPos : LongInt;
  begin
    if CheckStatus then
    begin
      GetPos := Base^.GetPos-Startofs;
      CheckBase;
    end;
  end;

  function TFilter.GetSize : LongInt;
  begin
    if CheckStatus then
    begin
      GetSize := Base^.GetSize-Startofs;
      CheckBase;
    end;
  end;

  procedure TFilter.Read(var Buf; Count : Word);
  begin
    if CheckStatus then
    begin
      Base^.Read(Buf, Count);
      CheckBase;
    end;
  end;

  procedure TFilter.Seek(Pos : LongInt);
  begin
    if CheckStatus then
    begin
      Base^.Seek(Pos+Startofs);
      CheckBase;
    end;
  end;

  procedure TFilter.Truncate;
  begin
    if CheckStatus then
    begin
      Base^.Truncate;
      CheckBase;
    end;
  end;

  procedure TFilter.Write(var Buf; Count : Word);
  begin
    if CheckStatus then
    begin
      Base^.Write(Buf, Count);
      CheckBase;
    end;
  end;

  procedure TFilter.Flush;
  begin
    if CheckStatus then
    begin
      Base^.Flush;
      CheckBase;
    end;
  end;

  function TFilter.CheckStatus : Boolean;
  begin
    if (Status = stOK) and (Base^.Status <> stOK) then
      Base^.Reset;
    CheckStatus := Status = stOK;
  end;

  procedure TFilter.CheckBase;
  begin
    if Base^.Status <> stOK then
      Error(stBaseError, Base^.Status);
  end;

  constructor TEncryptFilter.Init(Akey : LongInt; ABase : PStream);
  begin
    TFilter.Init(ABase);
    Key := Akey;
  end;

  procedure TEncryptFilter.Read(var Buf; Count : Word);
  var
    i : Word;
    SaveSeed : LongInt;
    Bytes : Tbyte_array absolute Buf;
  begin
    SaveSeed := RandSeed;
    RandSeed := Key;
    TFilter.Read(Buf, Count);
    for i := 0 to Count-1 do
      Bytes[i] := Bytes[i] xor Random(256);
    Key := RandSeed;
    RandSeed := SaveSeed;
  end;

  procedure CycleKey(Key, Cycles : LongInt);
{ For cycles > 0, mimics cycles calls to the TP random number generator.
  For cycles < 0, backs it up the given number of calls. }
  var
    i : LongInt;
    Junk : Integer;
    SaveSeed : LongInt;
  begin
    if Cycles > 0 then
    begin
      SaveSeed := RandSeed;
      RandSeed := Key;
      for i := 1 to Cycles do
        Junk := Random(0);
      Key := RandSeed;
      RandSeed := Key;
    end
    else
      for i := -1 downto Cycles do
        Key := (Key-1)*(-649090867);
  end;

  procedure TEncryptFilter.Seek(Pos : LongInt);
  var
    OldPos : LongInt;
  begin
    OldPos := GetPos;
    TFilter.Seek(Pos);
    CycleKey(Key, Pos-OldPos);
  end;

  procedure TEncryptFilter.Write(var Buf; Count : Word);
  var
    i : Word;
    SaveSeed : LongInt;
    BufPtr : ^Byte;
    BufPtrOffset : Word absolute BufPtr;
    Buffer : array[0..255] of Byte;
  begin
    SaveSeed := RandSeed;
    RandSeed := Key;
    BufPtr := @Buf;
    while Count > 256 do
    begin
      Move(BufPtr^, Buffer, 256);
      for i := 0 to 255 do
        Buffer[i] := Buffer[i] xor Random(256);
      TFilter.Write(Buffer, 256);
      Dec(Count, 256);
      Inc(BufPtrOffset, 256);
    end;
    Move(BufPtr^, Buffer, Count);
    for i := 0 to Count-1 do
      Buffer[i] := Buffer[i] xor Random(256);
    TFilter.Write(Buffer, Count);
    Key := RandSeed;
    RandSeed := SaveSeed;
  end;


  { ******* LZW code ******* }

{$L LZWSTREAM.OBJ}

  procedure Initialise(Tables : PLZWTables); External;

  function PutSignature(Tables : PLZWTables) : Boolean; External;

  function Crunch(InBufSize, OutBufSize : Word;
                  var InBuffer, OutBuffer;
  Tables : PLZWTables) : Pointer; External;

{  Crunch some more text.  Stops when Inbufsize bytes are used up, or
   output buffer is full.   Returns bytes used in segment, bytes written
   in offset of result }

  function FlushLZW(var OutBuffer;
  Tables : PLZWTables) : Word; External;
{  Flush the remaining characters to signal EOF.  Needs space for up to
   3 characters. }

  function GetSignature(var InBuffer, Dummy;
  Tables : PLZWTables) : Boolean; External;
{ Initializes for reading, and checks for 'LZ' signature in start of compressed
  code.  Inbuffer must contain at least 3 bytes.  Dummy is just there to put the
  Inbuffer in the right spot }

  function Uncrunch(InBufSize, OutBufSize : Word;
                    var InBuffer, OutBuffer;
  Tables : PLZWTables) : Pointer; External;
{  Uncrunch some text.  Will stop when it has done Outbufsize worth or has
   exhausted Inbufsize worth.  Returns bytes used in segment, bytes written
   in offset of result }

  constructor TLZWFilter.Init(ABase : PStream; AMode : TOpenMode);
    {  Create new compressor stream, to use ABase as the source/destination
       for data.  Mode must be stOpenRead or stOpenWrite. }
  var
    Buffer : array[1..3] of Byte;
    Info : Integer;
  begin
    Info := stBadMode;
    if (AMode = stOpenRead) or (AMode = stOpenWrite) then
    begin
      Info := stStreamFail;
      if TFilter.Init(ABase) then
      begin
        if Status = stOK then
        begin
          Info := stMemError;
          Startofs := Base^.GetPos;
          Position := 0;
          Mode := AMode;

          if MaxAvail >= SizeOf(TLZWTables) then
          begin
            Info := stSigError;
            GetMem(Tables, SizeOf(TLZWTables));
            Initialise(Tables);
            if Mode = stOpenRead then
            begin
              Base^.Read(Size, SizeOf(Size));
              Base^.Read(Buffer, 3);
              CheckBase;
              if GetSignature(Buffer, Buffer, Tables) then
                Exit;             { Successfully opened for reading }
            end
            else if Mode = stOpenWrite then
            begin
              Size := 0;
              Base^.Write(Size, SizeOf(Size)); { Put a place holder }
              CheckBase;
              if PutSignature(Tables) then
                Exit;             { Successful construction for writing! }
            end;
          end;
        end;
      end;
    end;
    Error(stInitError, Info);
  end;

  destructor TLZWFilter.Done;
  begin
    Flush;
    FreeMem(Tables, SizeOf(TLZWTables));
    TFilter.Done;
  end;

  procedure TLZWFilter.Write(var Buf; Count : Word);
  var
    Inbuf : array[0..65520] of Byte absolute Buf;
    Outbuf : array[0..255] of Byte;
    Inptr : Word;
    Sizes : record
              OutSize, UsedSize : Word;
            end;
  begin
    if CheckStatus then
    begin
      if Mode <> stOpenWrite then
        Error(stBadMode, Mode);
      Inptr := 0;
      repeat
        Pointer(Sizes) := Crunch(Count, SizeOf(Outbuf),
                                 Inbuf[Inptr], Outbuf, Tables);
        with Sizes do
        begin
          Base^.Write(Outbuf, OutSize);

          Dec(Count, UsedSize);
          Inc(Inptr, UsedSize);
          Inc(Size, UsedSize);
          Inc(Position, UsedSize);
        end;
      until Count = 0;
      CheckBase;
    end;
  end;

  procedure TLZWFilter.Flush;
  var
    Outbuf : array[0..255] of Byte;
    Sizes : record
              OutSize, UsedSize : Word;
            end;
    Pos : LongInt;
  begin
    if CheckStatus then
    begin
      if Mode = stOpenWrite then
      begin
        Pointer(Sizes) := Crunch(1, SizeOf(Outbuf), Outbuf, Outbuf, Tables);
        { Push one more character to match JA bug }
        with Sizes do
    &n