Unit Objects;
{$IFDEF MSDOS}
{$O+,F+,X+,I-,S-}

Interface

Const

  { Cyrillics keys flags }

  Cyrillics : Boolean = True;

  { TStream access modes }

  stCreate    = $3C00;           { Create new file }
  stOpenRead  = $3D00;           { Read access only }
  stOpenWrite = $3D01;           { Write access only }
  stOpen      = $3D02;           { Read and write access }

  { TStream error codes }

  stOk         =  0;              { No error }
  stError      = - 1;              { Access error }
  stInitError  = - 2;              { Cannot initialize stream }
  stReadError  = - 3;              { Read beyond end of stream }
  stWriteError = - 4;              { Cannot expand stream }
  stGetError   = - 5;              { Get of unregistered object type }
  stPutError   = - 6;              { Put of unregistered object type }

  { Maximum TCollection size }

  MaxCollectionSize = 65520 Div SizeOf (Pointer);

  { TCollection error codes }

  coIndexError = - 1;              { Index out of range }
  coOverflow   = - 2;              { Overflow }

  { VMT header size }

  vmtHeaderSize = 8;

Type

  { Type conversion records }

  WordRec = Record
              Lo, Hi: Byte;
            End;

  LongRec = Record
              Lo, Hi: Word;
            End;

  PtrRec = Record
             Ofs, Seg: Word;
           End;

  { String pointers }

  PString = ^String;

  { Character set type }

  PCharSet = ^TCharSet;
  TCharSet = Set Of Char;

  { General arrays }

  PByteArray = ^TByteArray;
  TByteArray = Array [0..32767] Of Byte;

  PWordArray = ^TWordArray;
  TWordArray = Array [0..16383] Of Word;

  { TObject base object }

  PObject = ^TObject;
  TObject = Object
              Constructor Init;
              Procedure Free;
              Destructor Done; Virtual;
            End;

  { TStreamRec }

  PStreamRec = ^TStreamRec;
  TStreamRec = Record
                 ObjType: Word;
                 VmtLink: Word;
                 Load: Pointer;
                 Store: Pointer;
                 Next: Word;
               End;

  { TStream }

  PStream = ^TStream;
  TStream = Object (TObject)
              Status: Integer;
              ErrorInfo: Integer;
              Constructor Init;
              Procedure CopyFrom (Var S: TStream; Count: LongInt);
              Procedure Error (Code, Info: Integer); Virtual;
              Procedure Flush; Virtual;
              Function Get: PObject;
              Function GetPos: LongInt; Virtual;
              Function GetSize: LongInt; Virtual;
              Procedure Put (P: PObject);
              Procedure Read (Var Buf; Count: Word); Virtual;
              Function ReadStr: PString;
              Procedure Reset;
              Procedure Seek (Pos: LongInt); Virtual;
              Function StrRead: PChar;
              Procedure StrWrite (P: PChar);
              Procedure Truncate; Virtual;
              Procedure Write (Var Buf; Count: Word); Virtual;
              Procedure WriteStr (P: PString);
            End;

  { DOS file name string }

  {$IFDEF Windows}
  FNameStr = PChar;
  {$ELSE}
  FNameStr = String [79];
  {$ENDIF}

  { TDosStream }

  PDosStream = ^TDosStream;
  TDosStream = Object (TStream)
                 Handle: Word;
                 Constructor Init (FileName: FNameStr; Mode: 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 ReadBlock (Var Buf; Count: Word; Var BytesRead: Word);
               End;

  { TBufStream }

  PBufStream = ^TBufStream;
  TBufStream = Object (TDosStream)
                 Buffer: Pointer;
                 BufSize: Word;
                 BufPtr: Word;
                 BufEnd: Word;
                 Constructor Init (FileName: FNameStr; Mode, Size: Word);
                 Destructor Done; Virtual;
                 Procedure Flush; 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;
               End;

  { TEmsStream }

  PEmsStream = ^TEmsStream;
  TEmsStream = Object (TStream)
                 Handle: Word;
                 PageCount: Word;
                 Size: LongInt;
                 Position: LongInt;
                 Constructor Init (MinSize, MaxSize: LongInt);
                 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;
               End;

  { TMemoryStream }

  PMemoryStream = ^TMemoryStream;
  TMemoryStream = Object (TStream)
                    SegCount: Integer;
                    SegList: PWordArray;
                    CurSeg: Integer;
                    BlockSize: Integer;
                    Size: LongInt;
                    Position: LongInt;
                    Constructor Init (ALimit: LongInt; ABlockSize: 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;
                    Private
                    Function ChangeListSize (ALimit: Word): Boolean;
                  End;

  { TCollection types }

  PItemList = ^TItemList;
  TItemList = Array [0..MaxCollectionSize - 1] Of Pointer;

  { TCollection object }

  PCollection = ^TCollection;
  TCollection = Object (TObject)
                  Items: PItemList;
                  Count: Integer;
                  Limit: Integer;
                  Delta: Integer;
                  Constructor Init (ALimit, ADelta: Integer);
                  Constructor Load (Var S: TStream);
                  Destructor Done; Virtual;
                  Function At (Index: Integer): Pointer;
                  Procedure AtDelete (Index: Integer);
                  Procedure AtFree (Index: Integer);
                  Procedure AtInsert (Index: Integer; Item: Pointer);
                  Procedure AtPut (Index: Integer; Item: Pointer);
                  Procedure Delete (Item: Pointer);
                  Procedure DeleteAll;
                  Procedure Error (Code, Info: Integer); Virtual;
                  Function FirstThat (Test: Pointer): Pointer;
                  Procedure ForEach (Action: Pointer);
                  Procedure Free (Item: Pointer);
                  Procedure FreeAll;
                  Procedure FreeItem (Item: Pointer); Virtual;
                  Function GetItem (Var S: TStream): Pointer; Virtual;
                  Function IndexOf (Item: Pointer): Integer; Virtual;
                  Procedure Insert (Item: Pointer); Virtual;
                  Function LastThat (Test: Pointer): Pointer;
                  Procedure Pack;
                  Procedure PutItem (Var S: TStream; Item: Pointer); Virtual;
                  Procedure SetLimit (ALimit: Integer); Virtual;
                  Procedure Store (Var S: TStream);
                End;

  { TSortedCollection object }

  PSortedCollection = ^TSortedCollection;
  TSortedCollection = Object (TCollection)
                        Duplicates: Boolean;
                        Constructor Init (ALimit, ADelta: Integer);
                        Constructor Load (Var S: TStream);
                        Function Compare (Key1, Key2: Pointer): Integer; Virtual;
                        Function IndexOf (Item: Pointer): Integer; Virtual;
                        Procedure Insert (Item: Pointer); Virtual;
                        Function KeyOf (Item: Pointer): Pointer; Virtual;
                        Function Search (Key: Pointer; Var Index: Integer): Boolean; Virtual;
                        Procedure Store (Var S: TStream);
                      End;

  { TStringCollection object }

  PStringCollection = ^TStringCollection;
  TStringCollection = Object (TSortedCollection)
                        Function Compare (Key1, Key2: Pointer): Integer; Virtual;
                        Procedure FreeItem (Item: Pointer); Virtual;
                        Function GetItem (Var S: TStream): Pointer; Virtual;
                        Procedure PutItem (Var S: TStream; Item: Pointer); Virtual;
                      End;

  { TStrCollection object }

  PStrCollection = ^TStrCollection;
  TStrCollection = Object (TSortedCollection)
                     Function Compare (Key1, Key2: Pointer): Integer; Virtual;
                     Procedure FreeItem (Item: Pointer); Virtual;
                     Function GetItem (Var S: TStream): Pointer; Virtual;
                     Procedure PutItem (Var S: TStream; Item: Pointer); Virtual;
                   End;

  {$IFNDEF Windows}

  { TResourceCollection object }

  PResourceCollection = ^TResourceCollection;
  TResourceCollection = Object (TStringCollection)
                          Procedure FreeItem (Item: Pointer); Virtual;
                          Function GetItem (Var S: TStream): Pointer; Virtual;
                          Function KeyOf (Item: Pointer): Pointer; Virtual;
                          Procedure PutItem (Var S: TStream; Item: Pointer); Virtual;
                        End;

  { TResourceFile object }

  PResourceFile = ^TResourceFile;
  TResourceFile = Object (TObject)
                    Stream: PStream;
                    Modified: Boolean;
                    Constructor Init (AStream: PStream);
                    Destructor Done; Virtual;
                    Function Count: Integer;
                    Procedure Delete (Key: String);
                    Procedure Flush;
                    Function Get (Key: String): PObject;
                    Function KeyAt (I: Integer): String;
                    Procedure Put (Item: PObject; Key: String);
                    Function SwitchTo (AStream: PStream; Pack: Boolean): PStream;
                    Private
                    BasePos: LongInt;
                    IndexPos: LongInt;
                    Index: TResourceCollection;
                  End;

  { TStringList object }

  TStrIndexRec = Record
                   Key, Count, Offset: Word;
                 End;

  PStrIndex = ^TStrIndex;
  TStrIndex = Array [0..9999] Of TStrIndexRec;

  PStringList = ^TStringList;
  TStringList = Object (TObject)
                  Constructor Load (Var S: TStream);
                  Destructor Done; Virtual;
                  Function Get (Key: Word): String;
                  Private
                  Stream: PStream;
                  BasePos: LongInt;
                  IndexSize: Integer;
                  Index: PStrIndex;
                  Procedure ReadStr (Var S: String; Offset, Skip: Word);
                End;

  { TStrListMaker object }

  PStrListMaker = ^TStrListMaker;
  TStrListMaker = Object (TObject)
                    Constructor Init (AStrSize, AIndexSize: Word);
                    Destructor Done; Virtual;
                    Procedure Put (Key: Word; S: String);
                    Procedure Store (Var S: TStream);
                    Private
                    StrPos: Word;
                    StrSize: Word;
                    Strings: PByteArray;
                    IndexPos: Word;
                    IndexSize: Word;
                    Index: PStrIndex;
                    Cur: TStrIndexRec;
                    Procedure CloseCurrent;
                  End;

  { TPoint object }

  TPoint = Object
             X, Y: Integer;
           End;

  { Rectangle object }

  TRect = Object
            A, B: TPoint;
            Procedure Assign (XA, YA, XB, YB: Integer);
            Procedure Copy (R: TRect);
            Procedure Move (ADX, ADY: Integer);
            Procedure Grow (ADX, ADY: Integer);
            Procedure Intersect (R: TRect);
            Procedure Union (R: TRect);
            Function Contains (P: TPoint): Boolean;
            Function Equals (R: TRect): Boolean;
            Function Empty: Boolean;
          End;

  {$ENDIF}

  { Dynamic string handling routines }

Function NewStr (Const S: String): PString;
Procedure DisposeStr (P: PString);

{ Longint routines }

Function LongMul (X, Y: Integer): LongInt;
Inline ($5A / $58 / $F7 / $EA);

Function LongDiv (X: LongInt; Y: Integer): Integer;
Inline ($59 / $58 / $5A / $F7 / $F9);

{ Stream routines }

Procedure RegisterType (Var S: TStreamRec);

{ Abstract notification procedure }

Procedure Abstract;

{ Objects registration procedure }

Procedure RegisterObjects;

Const

  { Stream error procedure }

  StreamError: Pointer = Nil;

  { EMS stream state variables }

  EmsCurHandle: Word = $FFFF;
  EmsCurPage: Word = $FFFF;

  { Stream registration records }

Const
  RCollection: TStreamRec = (
  ObjType: 50;
  VmtLink: Ofs (TypeOf (TCollection)^);
  Load: @TCollection. Load;
  Store: @TCollection. Store);

Const
  RStringCollection: TStreamRec = (
  ObjType: 51;
  VmtLink: Ofs (TypeOf (TStringCollection)^);
  Load: @TStringCollection. Load;
  Store: @TStringCollection. Store);

Const
  RStrCollection: TStreamRec = (
  ObjType: 69;
  VmtLink: Ofs (TypeOf (TStrCollection)^);
  Load:    @TStrCollection. Load;
  Store:   @TStrCollection. Store);

  {$IFNDEF Windows }

Const
  RStringList: TStreamRec = (
  ObjType: 52;
  VmtLink: Ofs (TypeOf (TStringList)^);
  Load: @TStringList. Load;
  Store: Nil);

Const
  RStrListMaker: TStreamRec = (
  ObjType: 52;
  VmtLink: Ofs (TypeOf (TStrListMaker)^);
  Load: Nil;
  Store: @TStrListMaker. Store);

  {$ENDIF}

Implementation

{$IFDEF Windows}
Uses WinProcs, Strings, OMemory;
{$ELSE}
Uses Memory, Strings;
{$ENDIF}

{$IFDEF Windows}
  {$DEFINE NewExeFormat}
{$ENDIF}

{$IFDEF DPMI}
  {$DEFINE NewExeFormat}
{$ENDIF}

Procedure Abstract;
Begin
  RunError (211);
End;

{ TObject }

Constructor TObject. Init;
Type
  Image = Record
            Link: Word;
            Data: Record End;
          End;
Begin
  {$IFNDEF Windows}
  FillChar (Image (Self).Data, SizeOf (Self) - SizeOf (TObject), 0);
  {$ENDIF}
End;

{ Shorthand procedure for a done/dispose }

Procedure TObject. Free;
Begin
  Dispose (PObject (@Self), Done);
End;

Destructor TObject. Done;
Begin
End;

{ TStream type registration routines }

Const
  StreamTypes: Word = 0;

Procedure RegisterError;
Begin
  RunError (212);
End;

Procedure RegisterType (Var S: TStreamRec); Assembler;
Asm
  MOV     AX, DS
  CMP     AX, S. Word [2]
  JNE     @@1
  MOV     SI, S. Word [0]
  MOV     AX, [SI].TStreamRec. ObjType
  Or      AX, AX
  JE      @@1
  MOV     DI, StreamTypes
  MOV     [SI].TStreamRec. Next, DI
  JMP     @@3
  @@1:    JMP     RegisterError
  @@2:    CMP     AX, [DI].TStreamRec. ObjType
  JE      @@1
  MOV     DI, [DI].TStreamRec. Next
  @@3:    Or      DI, DI
  JNE     @@2
  MOV     StreamTypes, SI
End;

{ TStream support routines }

Const
  TStream_Error = vmtHeaderSize + $04;
  TStream_Flush = vmtHeaderSize + $08;
  TStream_Read  = vmtHeaderSize + $14;
  TStream_Write = vmtHeaderSize + $20;

  { Stream error handler                                  }
  { In    AX    = Error info                              }
  {       DX    = Error code                              }
  {       ES:DI = Stream object pointer                   }
  { Uses  AX,BX,CX,DX,SI                                  }

Procedure DoStreamError; Near; Assembler;
Asm
  PUSH    ES
  PUSH    DI
  PUSH    DX
  PUSH    AX
  PUSH    ES
  PUSH    DI
  MOV     DI, ES: [DI]
  Call    DWord Ptr [DI].TStream_Error
  POP     DI
  POP     ES
End;

{ TStream }

Constructor TStream. Init;
Begin
  TObject. Init;
  Status := 0;
  ErrorInfo := 0;
End;

Procedure TStream. CopyFrom (Var S: TStream; Count: LongInt);
Var
  N: Word;
  Buffer: Array [0..1023] Of Byte;
Begin
  While Count > 0 Do
  Begin
    If Count > SizeOf (Buffer) Then N := SizeOf (Buffer) Else N := Count;
    S. Read (Buffer, N);
    Write (Buffer, N);
    Dec (Count, N);
  End;
End;

Procedure TStream. Error (Code, Info: Integer);
Type
  TErrorProc =
Procedure (Var S: TStream);
Begin
  Status := Code;
  ErrorInfo := Info;
  If StreamError <> Nil Then TErrorProc (StreamError) (Self);
End;

Procedure TStream. Flush;
Begin
End;

Function TStream. Get: PObject; Assembler;
Asm
  PUSH    AX
  MOV     AX, SP
  PUSH    SS
  PUSH    AX
  MOV     AX, 2
  PUSH    AX
  LES     DI, Self
  PUSH    ES
  PUSH    DI
  MOV     DI, ES: [DI]
  Call    DWord Ptr [DI].TStream_Read
  POP     AX
  Or      AX, AX
  JE      @@3
  MOV     BX, StreamTypes
  JMP     @@2
  @@1:    CMP     AX, [BX].TStreamRec. ObjType
  JE      @@4
  MOV     BX, [BX].TStreamRec. Next
  @@2:    Or      BX, BX
  JNE     @@1
  LES     DI, Self
  MOV     DX, stGetError
  Call    DoStreamError
  @@3:    XOr     AX, AX
  MOV     DX, AX
  JMP     @@5
  @@4:    LES     DI, Self
  PUSH    ES
  PUSH    DI
  PUSH    [BX].TStreamRec. VmtLink
  XOr     AX, AX
  PUSH    AX
  PUSH    AX
  Call    [BX].TStreamRec. Load
  @@5:
End;

Function TStream. GetPos: LongInt;
Begin
  Abstract;
End;

Function TStream. GetSize: LongInt;
Begin
  Abstract;
End;

Procedure TStream. Put (P: PObject); Assembler;
Asm
  LES     DI, P
  MOV     CX, ES
  Or      CX, DI
  JE      @@4
  MOV     AX, ES: [DI]
  MOV     BX, StreamTypes
  JMP     @@2
  @@1:    CMP     AX, [BX].TStreamRec. VmtLink
  JE      @@3
  MOV     BX, [BX].TStreamRec. Next
  @@2:    Or      BX, BX
  JNE     @@1
  LES     DI, Self
  MOV     DX, stPutError
  Call    DoStreamError
  JMP     @@5
  @@3:    MOV     CX, [BX].TStreamRec. ObjType
  @@4:    PUSH    BX
  PUSH    CX
  MOV     AX, SP
  PUSH    SS
  PUSH    AX
  MOV     AX, 2
  PUSH    AX
  LES     DI, Self
  PUSH    ES
  PUSH    DI
  MOV     DI, ES: [DI]
  Call    DWord Ptr [DI].TStream_Write
  POP     CX
  POP     BX
  JCXZ    @@5
  LES     DI, Self
  PUSH    ES
  PUSH    DI
  PUSH    P. Word [2]
  PUSH    P. Word [0]
  Call    [BX].TStreamRec. Store
  @@5:
End;

Procedure TStream. Read (Var Buf; Count: Word);
Begin
  Abstract;
End;

Function TStream. ReadStr: PString;
Var
  L: Byte;
  P: PString;
Begin
  Read (L, 1);
  If L > 0 Then
  Begin
    GetMem (P, L + 1);
    P^ [0] := Char (L);
    Read (P^ [1], L);
    ReadStr := P;
  End Else ReadStr := Nil;
End;

Procedure TStream. Reset;
Begin
  Status := 0;
  ErrorInfo := 0;
End;

Procedure TStream. Seek (Pos: LongInt);
Begin
  Abstract;
End;

Function TStream. StrRead: PChar;
Var
  L: Word;
  P: PChar;
Begin
  Read (L, SizeOf (Word));
  If L = 0 Then StrRead := Nil Else
  Begin
    GetMem (P, L + 1);
    Read (P [0], L);
    P [L] := #0;
    StrRead := P;
  End;
End;

Procedure TStream. StrWrite (P: PChar);
Var
  L: Word;
Begin
  If P = Nil Then L := 0 Else L := StrLen (P);
  Write (L, SizeOf (Word));
  If P <> Nil Then Write (P [0], L);
End;

Procedure TStream. Truncate;
Begin
  Abstract;
End;

Procedure TStream. Write (Var Buf; Count: Word);
Begin
  Abstract;
End;

Procedure TStream. WriteStr (P: PString);
Const
  Empty: String [1] = '';
Begin
  If P <> Nil Then Write (P^, Length (P^) + 1) Else Write (Empty, 1);
End;

{ TDosStream }

Constructor TDosStream. Init (FileName: FNameStr; Mode: Word); Assembler;
Var
  NameBuf: Array [0..79] Of Char;
  Asm
    XOr     AX, AX
    PUSH    AX
    LES     DI, Self
    PUSH    ES
    PUSH    DI
    Call    TStream. Init
    {$IFDEF Windows}
    LEA DI, NameBuf
    PUSH        SS
    PUSH        DI
    LES DI, FileName
    PUSH        ES
    PUSH        DI
    MOV AX, 79
    PUSH        AX
    Call        StrLCopy
    PUSH        DX
    PUSH        AX
    PUSH        DX
    PUSH        AX
    Call        AnsiToOem
    PUSH        DS
    LEA DX, NameBuf
    {$ELSE}
    PUSH    DS
    LDS     SI, FileName
    LEA     DI, NameBuf
    MOV     DX, DI
    PUSH    SS
    POP     ES
    CLD
    LODSB
    CMP     AL, 79
    JB      @@1
    MOV     AL, 79
    @@1:    CBW
    XCHG    AX, CX
    REP     MOVSB
    XCHG    AX, CX
    STOSB
    {$ENDIF}
    PUSH    SS
    POP     DS
    XOr     CX, CX
    MOV     AX, Mode
    Int     21H
    POP     DS
    JNC     @@2
    LES     DI, Self
    MOV     DX, stInitError
    Call    DoStreamError
    MOV     AX, - 1
    @@2:    LES     DI, Self
    MOV     ES: [DI].TDosStream. Handle, AX
  End;

  Destructor TDosStream. Done; Assembler;
  Asm
    LES     DI, Self
    MOV     BX, ES: [DI].TDosStream. Handle
    CMP     BX, - 1
    JE      @@1
    MOV     AH, 3EH
    Int     21H
    @@1:    XOr     AX, AX
    PUSH    AX
    PUSH    ES
    PUSH    DI
    Call    TStream. Done
  End;

Function TDosStream. GetPos: LongInt; Assembler;
Asm
  LES     DI, Self
  XOr     DX, DX
  CMP     DX, ES: [DI].TDosStream. Status
  JNE     @@1
  MOV     CX, DX
  MOV     BX, ES: [DI].TDosStream. Handle
  MOV     AX, 4201H
  Int     21H
  JNC     @@2
  MOV     DX, stError
  Call    DoStreamError
  @@1:    MOV     AX, - 1
  CWD
  @@2:
End;

Function TDosStream. GetSize: LongInt; Assembler;
Asm
  LES     DI, Self
  XOr     DX, DX
  CMP     DX, ES: [DI].TDosStream. Status
  JNE     @@1
  MOV     CX, DX
  MOV     BX, ES: [DI].TDosStream. Handle
  MOV     AX, 4201H
  Int     21H
  PUSH    DX
  PUSH    AX
  XOr     DX, DX
  MOV     CX, DX
  MOV     AX, 4202H
  Int     21H
  POP     SI
  POP     CX
  PUSH    DX
  PUSH    AX
  MOV     DX, SI
  MOV     AX, 4200H
  Int     21H
  POP     AX
  POP     DX
  JNC     @@2
  MOV     DX, stError
  Call    DoStreamError
  @@1:    MOV     AX, - 1
  CWD
  @@2:
End;

Procedure TDosStream. Read (Var Buf; Count: Word); Assembler;
Asm
  LES     DI, Self
  CMP     ES: [DI].TDosStream. Status, 0
  JNE     @@2
  PUSH    DS
  LDS     DX, Buf
  MOV     CX, Count
  MOV     BX, ES: [DI].TDosStream. Handle
  MOV     AH, 3FH
  Int     21H
  POP     DS
  MOV     DX, stError
  JC      @@1
  CMP     AX, CX
  JE      @@3
  XOr     AX, AX
  MOV     DX, stReadError
  @@1:    Call    DoStreamError
  @@2:    LES     DI, Buf
  MOV     CX, Count
  XOr     AL, AL
  CLD
  REP     STOSB
  @@3:
End;

Procedure TDOSStream. ReadBlock (Var Buf; Count: Word; Var BytesRead: Word); Assembler;
Asm
  LES     DI,Self
  CMP     ES:[DI].TDosStream.Status,0
  JNE     @@2
  PUSH    DS
  LDS     DX,Buf
  MOV     CX,Count
  MOV     BX,ES:[DI].TDosStream.Handle
  MOV     AH,3FH
  INT     21H
  POP     DS
  MOV     DX,stError
  JC      @@1
  PUSH    ES
  LES     BX,BytesRead
  MOV     ES:[BX],AX
  POP     ES
  JMP     @@3
@@1:
  CALL    DoStreamError
@@2:
  LES     DI,Buf
  MOV     CX,Count
  XOR     AL,AL
  CLD
  REP     STOSB
@@3:
End;

Procedure TDosStream. Seek (Pos: LongInt); Assembler;
Asm
  LES     DI, Self
  CMP     ES: [DI].TDosStream. Status, 0
  JNE     @@2
  MOV     DX, Pos. Word [0]
  MOV     CX, Pos. Word [2]
  Or      CX, CX
  JNS     @@1
  XOr     DX, DX
  XOr     CX, CX
  @@1:    MOV     BX, ES: [DI].TDosStream. Handle
  MOV     AX, 4200H
  Int     21H
  JNC     @@2
  MOV     DX, stError
  Call    DoStreamError
  @@2:
End;

Procedure TDosStream. Truncate; Assembler;
Asm
  LES     DI, Self
  XOr     CX, CX
  CMP     CX, ES: [DI].TDosStream. Status
  JNE     @@1
  MOV     BX, ES: [DI].TDosStream. Handle
  MOV     AH, 40H
  Int     21H
  JNC     @@1
  MOV     DX, stError
  Call    DoStreamError
  @@1:
End;

Procedure TDosStream. Write (Var Buf; Count: Word); Assembler;
Asm
  LES     DI, Self
  CMP     ES: [DI].TDosStream. Status, 0
  JNE     @@2
  PUSH    DS
  LDS     DX, Buf
  MOV     CX, Count
  MOV     BX, ES: [DI].TDosStream. Handle
  MOV     AH, 40H
  Int     21H
  POP     DS
  MOV     DX, stError
  JC      @@1
  CMP     AX, CX
  JE      @@2
  XOr     AX, AX
  MOV     DX, stWriteError
  @@1:    Call    DoStreamError
  @@2:
End;

{ TBufStream }

{ Flush TBufStream buffer                               }
{ In    AL    = Flush mode (0=Read, 1=Write, 2=Both)    }
{       ES:DI = TBufStream pointer                      }
{ Out   ZF    = Status test                             }

Procedure FlushBuffer; Near; Assembler;
Asm
  MOV     CX, ES: [DI].TBufStream. BufPtr
  SUB     CX, ES: [DI].TBufStream. BufEnd
  JE      @@3
  MOV     BX, ES: [DI].TDosStream. Handle
  JA      @@1
  CMP     AL, 1
  JE      @@4
  MOV     DX, CX
  MOV     CX, - 1
  MOV     AX, 4201H
  Int     21H
  JMP     @@3
  @@1:    CMP     AL, 0
  JE      @@4
  PUSH    DS
  LDS     DX, ES: [DI].TBufStream. Buffer
  MOV     AH, 40H
  Int     21H
  POP     DS
  MOV     DX, stError
  JC      @@2
  CMP     AX, CX
  JE      @@3
  XOr     AX, AX
  MOV     DX, stWriteError
  @@2:    Call    DoStreamError
  @@3:    XOr     AX, AX
  MOV     ES: [DI].TBufStream. BufPtr, AX
  MOV     ES: [DI].TBufStream. BufEnd, AX
  CMP     AX, ES: [DI].TStream. Status
  @@4:
End;

Constructor TBufStream. Init (FileName: FNameStr; Mode, Size: Word);
Begin
  TDosStream. Init (FileName, Mode);
  BufSize := Size;
  If Size = 0 Then Error (stInitError, 0)
  Else GetMem (Buffer, Size);
  BufPtr := 0;
  BufEnd := 0;
End;

Destructor TBufStream. Done;
Begin
  TBufStream. Flush;
  TDosStream. Done;
  If Buffer <> Nil Then FreeMem (Buffer, BufSize);
  Buffer := Nil;
End;

Procedure TBufStream. Flush; Assembler;
Asm
  LES     DI, Self
  CMP     ES: [DI].TBufStream. Status, 0
  JNE     @@1
  MOV     AL, 2
  Call    FlushBuffer
  @@1:
End;

Function TBufStream. GetPos: LongInt; Assembler;
Asm
  LES     DI, Self
  PUSH    ES
  PUSH    DI
  Call    TDosStream. GetPos
  Or      DX, DX
  JS      @@1
  LES     DI, Self
  SUB     AX, ES: [DI].TBufStream. BufEnd
  SBB     DX, 0
  ADD     AX, ES: [DI].TBufStream. BufPtr
  ADC     DX, 0
  @@1:
End;

Function TBufStream. GetSize: LongInt; Assembler;
Asm
  LES     DI, Self
  PUSH    ES
  PUSH    DI
  PUSH    ES
  PUSH    DI
  Call    TBufStream. Flush
  Call    TDosStream. GetSize
End;

Procedure TBufStream. Read (Var Buf; Count: Word); Assembler;
Asm
  LES     DI, Self
  CMP     ES: [DI].TBufStream. Status, 0
  JNE     @@6
  MOV     AL, 1
  Call    FlushBuffer
  JNE     @@6
  XOr     BX, BX
  @@1:    MOV     CX, Count
  SUB     CX, BX
  JE      @@7
  LES     DI, Self
  MOV     AX, ES: [DI].TBufStream. BufEnd
  SUB     AX, ES: [DI].TBufStream. BufPtr
  JA      @@2
  PUSH    DS
  PUSH    CX
  PUSH    BX
  LDS     DX, ES: [DI].TBufStream. Buffer
  MOV     CX, ES: [DI].TBufStream. BufSize
  MOV     BX, ES: [DI].TBufStream. Handle
  MOV     AH, 3FH
  Int     21H
  POP     BX
  POP     CX
  POP     DS
  MOV     DX, stError
  JC      @@5
  MOV     ES: [DI].TBufStream. BufPtr, 0
  MOV     ES: [DI].TBufStream. BufEnd, AX
  Or      AX, AX
  JE      @@4
  @@2:    CMP     CX, AX
  JB      @@3
  MOV     CX, AX
  @@3:    PUSH    DS
  LDS     SI, ES: [DI].TBufStream. Buffer
  ADD     SI, ES: [DI].TBufStream. BufPtr
  ADD     ES: [DI].TBufStream. BufPtr, CX
  LES     DI, Buf
  ADD     DI, BX
  ADD     BX, CX
  CLD
  REP     MOVSB
  POP     DS
  JMP     @@1
  @@4:    MOV     DX, stReadError
  @@5:    Call    DoStreamError
  @@6:    LES     DI, Buf
  MOV     CX, Count
  XOr     AL, AL
  CLD
  REP     STOSB
  @@7:
End;

Procedure TBufStream. Seek (Pos: LongInt); Assembler;
Asm
  LES     DI, Self
  PUSH    ES
  PUSH    DI
  Call    TDosStream. GetPos
  Or      DX, DX
  JS      @@2
  LES     DI, Self
  SUB     AX, Pos. Word [0]
  SBB     DX, Pos. Word [2]
  JNE     @@1
  Or      AX, AX
  JE      @@1
  MOV     DX, ES: [DI].TBufStream. BufEnd
  SUB     DX, AX
  JB      @@1
  MOV     ES: [DI].TBufStream. BufPtr, DX
  JMP     @@2
  @@1:    PUSH    Pos. Word [2]
  PUSH    Pos. Word [0]
  PUSH    ES
  PUSH    DI
  PUSH    ES
  PUSH    DI
  Call    TBufStream. Flush
  Call    TDosStream. Seek
  @@2:
End;

Procedure TBufStream. Truncate;
Begin
  TBufStream. Flush;
  TDosStream. Truncate;
End;

Procedure TBufStream. Write (Var Buf; Count: Word); Assembler;
Asm
  LES     DI, Self
  CMP     ES: [DI].TBufStream. Status, 0
  JNE     @@4
  MOV     AL, 0
  Call    FlushBuffer
  JNE     @@4
  XOr     DX, DX
  @@1:    MOV     CX, Count
  SUB     CX, DX
  JE      @@4
  LES     DI, Self
  MOV     AX, ES: [DI].TBufStream. BufSize
  SUB     AX, ES: [DI].TBufStream. BufPtr
  JA      @@2
  PUSH    CX
  PUSH    DX
  MOV     AL, 1
  Call    FlushBuffer
  POP     DX
  POP     CX
  JNE     @@4
  MOV     AX, ES: [DI].TBufStream. BufSize
  @@2:    CMP     CX, AX
  JB      @@3
  MOV     CX, AX
  @@3:    PUSH    DS
  MOV     AX, ES: [DI].TBufStream. BufPtr
  ADD     ES: [DI].TBufStream. BufPtr, CX
  LES     DI, ES: [DI].TBufStream. Buffer
  ADD     DI, AX
  LDS     SI, Buf
  ADD     SI, DX
  ADD     DX, CX
  CLD
  REP     MOVSB
  POP     DS
  JMP     @@1
  @@4:
End;

{ TEmsStream }

Const
  EmsPageSize = $4000;

Var
  EmsBaseSeg: Word;
  EmsVersion: Byte;

Procedure EmsSelectPage; Near; Assembler;
Asm
  MOV     AX, ES: [DI].TEmsStream. Position. Word [0]
  MOV     DX, ES: [DI].TEmsStream. Position. Word [2]
  MOV     CX, EmsPageSize
  Div     CX
  SUB     CX, DX
  MOV     SI, DX
  MOV     DX, ES: [DI].TEmsStream. Handle
  CMP     DX, EmsCurHandle
  JNE     @@1
  CMP     AX, EmsCurPage
  JE      @@3
  @@1:    MOV     BX, AX
  MOV     AX, 4400H
  Int     67H
  MOV     AL, AH
  And     AX, 0FFH
  JE      @@2
  MOV     DX, stError
  JMP     @@3
  @@2:    MOV     EmsCurHandle, DX
  MOV     EmsCurPage, BX
  @@3:
End;

Procedure EmsSetPages; Near; Assembler;
Asm
  CMP     EmsVersion, 40H
  JAE     @@1
  MOV     AX, 84H
  JMP     @@2
  @@1:    MOV     DX, ES: [DI].TEmsStream. Handle
  MOV     BX, AX
  MOV     AH, 51H
  Int     67H
  MOV     AL, AH
  And     AX, 0FFH
  JNE     @@2
  MOV     ES: [DI].TEmsStream. PageCount, BX
  MOV     EmsCurPage, $FFFF
  @@2:
End;

Constructor TEmsStream. Init (MinSize, MaxSize: LongInt); Assembler;
Const
  EmsDeviceLen = 8;
  EmsDeviceStr: Array [1..EmsDeviceLen] Of Char = 'EMMXXXX0';
  Asm
    XOr     AX, AX
    PUSH    AX
    LES     DI, Self
    PUSH    ES
    PUSH    DI
    Call    TStream. Init
    MOV     AX, 3567H
    Int     21H
    MOV     CX, EmsDeviceLen
    MOV     SI, Offset EmsDeviceStr
    MOV     DI, 0AH
    CLD
    REP     CMPSB
    LES     DI, Self
    MOV     AX, - 1
    JNE     @@3
    MOV     AH, 41H
    Int     67H
    MOV     EmsBaseSeg, BX
    MOV     AH, 46H
    Int     67H
    MOV     EmsVersion, AL
    MOV     CX, EmsPageSize
    MOV     AX, MinSize. Word [0]
    MOV     DX, MinSize. Word [2]
    ADD     AX, EmsPageSize - 1
    ADC     DX, 0
    Div     CX
    MOV     BX, AX
    CMP     EmsVersion, 40H
    JAE     @@2
    PUSH    AX
    MOV     AX, MaxSize. Word [0]
    MOV     DX, MaxSize. Word [2]
    ADD     AX, EmsPageSize - 1
    ADC     DX, 0
    Div     CX
    MOV     CX, AX
    MOV     AH, 42H
    Int     67H
    POP     AX
    CMP     BX, CX
    JB      @@1
    MOV     BX, CX
    @@1:    CMP     BX, AX
    JA      @@2
    MOV     BX, AX
    @@2:    MOV     AH, 43H
    Int     67H
    MOV     AL, AH
    And     AX, 0FFH
    JE      @@4
    @@3:    MOV     DX, stInitError
    Call    DoStreamError
    MOV     DX, - 1
    XOr     BX, BX
    @@4:    MOV     ES: [DI].TEmsStream. Handle, DX
    MOV     ES: [DI].TEmsStream. PageCount, BX
    XOr AX, AX
    ADD DI, Offset TEmsStream. Size
    MOV CX, 4
    REP STOSW
  End;

  Destructor TEmsStream. Done; Assembler;
  Asm
    LES     DI, Self
    MOV     DX, ES: [DI].TEmsStream. Handle
    CMP     DX, - 1
    JE      @@1
    MOV     AH, 45H
    Int     67H
    @@1:    XOr     AX, AX
    PUSH    AX
    PUSH    ES
    PUSH    DI
    Call    TStream. Done
  End;

Function TEmsStream. GetPos: LongInt; Assembler;
Asm
  LES     DI, Self
  CMP     ES: [DI].TEmsStream. Status, 0
  JNE     @@1
  MOV     AX, ES: [DI].TEmsStream. Position. Word [0]
  MOV     DX, ES: [DI].TEmsStream. Position. Word [2]
  JMP     @@2
  @@1:    MOV     AX, - 1
  CWD
  @@2:
End;

Function TEmsStream. GetSize: LongInt; Assembler;
Asm
  LES     DI, Self
  CMP     ES: [DI].TEmsStream. Status, 0
  JNE     @@1
  MOV     AX, ES: [DI].TEmsStream. Size. Word [0]
  MOV     DX, ES: [DI].TEmsStream. Size. Word [2]
  JMP     @@2
  @@1:    MOV     AX, - 1
  CWD
  @@2:
End;

Procedure TEmsStream. Read (Var Buf; Count: Word); Assembler;
Asm
  LES     DI, Self
  XOr     BX, BX
  CMP     BX, ES: [DI].TEmsStream. Status
  JNE     @@3
  MOV     AX, ES: [DI].TEmsStream. Position. Word [0]
  MOV     DX, ES: [DI].TEmsStream. Position. Word [2]
  ADD     AX, Count
  ADC     DX, BX
  CMP     DX, ES: [DI].TEmsStream. Size. Word [2]
  JA      @@1
  JB      @@7
  CMP     AX, ES: [DI].TEmsStream. Size. Word [0]
  JBE     @@7
  @@1:    XOr     AX, AX
  MOV     DX, stReadError
  @@2:    Call    DoStreamError
  @@3:    LES     DI, Buf
  MOV     CX, Count
  XOr     AL, AL
  CLD
  REP     STOSB
  JMP     @@8
  @@5:    PUSH    BX
  Call    EmsSelectPage
  POP     BX
  JNE     @@2
  MOV     AX, Count
  SUB     AX, BX
  CMP     CX, AX
  JB      @@6
  MOV     CX, AX
  @@6:    ADD     ES: [DI].TEmsStream. Position. Word [0], CX
  ADC     ES: [DI].TEmsStream. Position. Word [2], 0
  PUSH    ES
  PUSH    DS
  PUSH    DI
  LES     DI, Buf
  ADD     DI, BX
  ADD     BX, CX
  MOV     DS, EmsBaseSeg
  CLD
  REP     MOVSB
  POP     DI
  POP     DS
  POP     ES
  @@7:    CMP     BX, Count
  JB      @@5
  @@8:
End;

Procedure TEmsStream. Seek (Pos: LongInt); Assembler;
Asm
  LES     DI, Self
  MOV     AX, Pos. Word [0]
  MOV     DX, Pos. Word [2]
  Or      DX, DX
  JNS     @@1
  XOr     AX, AX
  CWD
  @@1:    MOV     ES: [DI].TEmsStream. Position. Word [0], AX
  MOV     ES: [DI].TEmsStream. Position. Word [2], DX
End;

Procedure TEmsStream. Truncate; Assembler;
Asm
  LES     DI, Self
  XOr     BX, BX
  CMP     ES: [DI].TEmsStream. Status, BX
  JNE     @@2
  CMP     EmsVersion, 40H
  JB      @@1
  MOV     AX, ES: [DI].TEmsStream. Position. Word [0]
  MOV     DX, ES: [DI].TEmsStream. Position. Word [2]
  ADD     AX, EmsPageSize - 1
  ADC     DX, BX
  MOV     CX, EmsPageSize
  Div     CX
  Call    EmsSetPages
  JE      @@1
  MOV     DX, stError
  Call    DoStreamError
  JMP     @@2
  @@1:    MOV     AX, ES: [DI].TEmsStream. Position. Word [0]
  MOV     DX, ES: [DI].TEmsStream. Position. Word [2]
  MOV     ES: [DI].TEmsStream. Size. Word [0], AX
  MOV     ES: [DI].TEmsStream. Size. Word [2], DX
  @@2:
End;

Procedure TEmsStream. Write (Var Buf; Count: Word); Assembler;
Asm
  LES     DI, Self
  XOr     BX, BX
  CMP     BX, ES: [DI].TEmsStream. Status
  JNE     @@7
  MOV     AX, ES: [DI].TEmsStream. Position. Word [0]
  MOV     DX, ES: [DI].TEmsStream. Position. Word [2]
  ADD     AX, Count
  ADC     DX, BX
  ADD     AX, EmsPageSize - 1
  ADC     DX, BX
  MOV     CX, EmsPageSize
  Div     CX
  CMP     AX, ES: [DI].TEmsStream. PageCount
  JBE     @@4
  PUSH    BX
  Call    EmsSetPages
  POP     BX
  JE      @@4
  @@1:    MOV     DX, stWriteError
  Call    DoStreamError
  JMP     @@7
  @@2:    PUSH    BX
  Call    EmsSelectPage
  POP     BX
  JNE     @@1
  MOV     AX, Count
  SUB     AX, BX
  CMP     CX, AX
  JB      @@3
  MOV     CX, AX
  @@3:    ADD     ES: [DI].TEmsStream. Position. Word [0], CX
  ADC     ES: [DI].TEmsStream. Position. Word [2], 0
  PUSH    ES
  PUSH    DS
  PUSH    DI
  MOV     DI, SI
  MOV     ES, EmsBaseSeg
  LDS     SI, Buf
  ADD     SI, BX
  ADD     BX, CX
  CLD
  REP     MOVSB
  POP     DI
  POP     DS
  POP     ES
  @@4:    CMP     BX, Count
  JB      @@2
  @@5:    MOV     AX, ES: [DI].TEmsStream. Position. Word [0]
  MOV     DX, ES: [DI].TEmsStream. Position. Word [2]
  CMP     DX, ES: [DI].TEmsStream. Size. Word [2]
  JB      @@7
  JA      @@6
  CMP     AX, ES: [DI].TEmsStream. Size. Word [0]
  JBE     @@7
  @@6:    MOV     ES: [DI].TEmsStream. Size. Word [0], AX
  MOV     ES: [DI].TEmsStream. Size. Word [2], DX
  @@7:
End;

{ TMemoryStream }

Const
  MaxSegArraySize = 16384;

  {$IFDEF NewExeFormat}

  DefaultBlockSize = $2000;

  {$ELSE}

  DefaultBlockSize = $0800;

  {$ENDIF}

Procedure MemSelectSeg; Near; Assembler;
Asm
  MOV     AX, ES: [DI].TMemoryStream. Position. Word [0]
  MOV     DX, ES: [DI].TMemoryStream. Position. Word [2]
  MOV     CX, ES: [DI].TMemoryStream. BlockSize
  Div     CX
  SUB     CX, DX
  MOV     SI, DX
  ShL     AX, 1
  MOV     ES: [DI].TMemoryStream. CurSeg, AX
End;

Const
  MemStreamSize = (SizeOf (TMemoryStream) - SizeOf (TStream) ) Div 2;

  Constructor TMemoryStream. Init (ALimit: LongInt; ABlockSize: Word); Assembler;
  Asm
    XOr     AX, AX
    PUSH    AX
    LES     DI, Self
    PUSH    ES
    PUSH    DI
    Call    TStream. Init
    LES     DI, Self
    {$IFDEF Windows}
    XOr     AX, AX
    PUSH    DI
    ADD     DI, Offset TMemoryStream. SegCount
    MOV     CX, MemStreamSize
    REP     STOSW
    POP     DI
    {$ENDIF}
    CMP     ABlockSize, 0
    JNZ     @@1
    MOV     ABlockSize, DefaultBlockSize
    @@1:    MOV     AX, ALimit. Word [0]
    MOV     DX, ALimit. Word [2]
    Div     ABlockSize
    NEG     DX
    ADC     AX, 0
    MOV     DX, ABlockSize
    MOV     ES: [DI].TMemoryStream. BlockSize, DX
    PUSH    AX
    PUSH    ES
    PUSH    DI
    Call    ChangeListSize
    LES     DI, Self
    Or      AX, AX
    JNZ     @@2
    MOV     DX, stInitError
    Call    DoStreamError
    MOV     ALimit. Word [0], 0
    MOV     ALimit. Word [2], 0
    @@2:    MOV     AX, ALimit. Word [0]
    MOV     DX, ALimit. Word [2]
    MOV     ES: [DI].TMemoryStream. Size. Word [0], AX
    MOV     ES: [DI].TMemoryStream. Size. Word [2], DX
  End;

  Destructor TMemoryStream. Done;
Begin
  ChangeListSize (0);
  Inherited Done;
End;

Function TMemoryStream. ChangeListSize (ALimit: Word): Boolean;
Var
  AItems: PWordArray;
  Dif, Term: Word;
  NewBlock: Pointer;
Begin
  ChangeListSize := False;
  If ALimit > MaxSegArraySize Then ALimit := MaxSegArraySize;
  If ALimit <> SegCount Then
  Begin
    If ALimit = 0 Then AItems := Nil Else
    Begin
      AItems := MemAlloc (ALimit * SizeOf (Word) );
      If AItems = Nil Then Exit;
      If (SegCount <> 0) And (SegList <> Nil) Then
        If SegCount > ALimit Then
          Move (SegList^, AItems^, ALimit * SizeOf (Word) )
        Else
          Move (SegList^, AItems^, SegCount * SizeOf (Word) );
    End;
    If ALimit < SegCount Then
    Begin
      Dif  := ALimit;
      Term := SegCount - 1;
      While Dif <= Term Do
      Begin
        FreeMem (Ptr (SegList^ [Dif], 0), BlockSize);
        SegList^ [Dif] := 0;
        Inc (Dif);
      End;
    End
    Else
    Begin
      Dif := SegCount;
      Term := ALimit - 1;
      While Dif <= Term Do
      Begin
        NewBlock := MemAllocSeg (BlockSize);
        If NewBlock = Nil Then Exit
        Else AItems^ [Dif] := PtrRec (NewBlock).Seg;
        Inc (Dif);
      End;
    End;
    If SegCount <> 0 Then FreeMem (SegList, SegCount * SizeOf (Word) );
    SegList := AItems;
    SegCount := ALimit;
  End;
  ChangeListSize := True;
End;

Function TMemoryStream. GetPos: LongInt; Assembler;
Asm
  LES     DI, Self
  CMP     ES: [DI].TMemoryStream. Status, 0
  JNE     @@1
  MOV     AX, ES: [DI].TMemoryStream. Position. Word [0]
  MOV     DX, ES: [DI].TMemoryStream. Position. Word [2]
  JMP     @@2
  @@1:    MOV     AX, - 1
  CWD
  @@2:
End;

Function TMemoryStream. GetSize: LongInt; Assembler;
Asm
  LES     DI, Self
  CMP     ES: [DI].TMemoryStream. Status, 0
  JNE     @@1
  MOV     AX, ES: [DI].TMemoryStream. Size. Word [0]
  MOV     DX, ES: [DI].TMemoryStream. Size. Word [2]
  JMP     @@2
  @@1:    MOV     AX, - 1
  CWD
  @@2:
End;

Procedure TMemoryStream. Read (Var Buf; Count: Word); Assembler;
Asm
  LES     DI, Self
  XOr     BX, BX
  CMP     BX, ES: [DI].TMemoryStream. Status
  JNE     @@3
  MOV     AX, ES: [DI].TMemoryStream. Position. Word [0]
  MOV     DX, ES: [DI].TMemoryStream. Position. Word [2]
  ADD     AX, Count
  ADC     DX, BX
  CMP     DX, ES: [DI].TMemoryStream. Size. Word [2]
  JA      @@1
  JB      @@7
  CMP     AX, ES: [DI].TMemoryStream. Size. Word [0]
  JBE     @@7
  @@1:    XOr     AX, AX
  MOV     DX, stReadError
  @@2:    Call    DoStreamError
  @@3:    LES     DI, Buf
  MOV     CX, Count
  XOr     AL, AL
  CLD
  REP     STOSB
  JMP     @@8
  @@5:    Call    MemSelectSeg
  MOV     AX, Count
  SUB     AX, BX
  CMP     CX, AX
  JB      @@6
  MOV     CX, AX
  @@6:    ADD     ES: [DI].TMemoryStream. Position. Word [0], CX
  ADC     ES: [DI].TMemoryStream. Position. Word [2], 0
  PUSH    ES
  PUSH    DS
  PUSH    DI
  MOV     DX, ES: [DI].TMemoryStream. CurSeg
  LES     DI, ES: [DI].TMemoryStream. SegList
  ADD     DI, DX
  MOV     DS, Word Ptr ES: [DI]
  LES     DI, Buf
  ADD     DI, BX
  ADD     BX, CX
  CLD
  REP     MOVSB
  POP     DI
  POP     DS
  POP     ES
  @@7:    CMP     BX, Count
  JB      @@5
  @@8:
End;

Procedure TMemoryStream. Seek (Pos: LongInt); Assembler;
Asm
  LES     DI, Self
  MOV     AX, Pos. Word [0]
  MOV     DX, Pos. Word [2]
  Or      DX, DX
  JNS     @@1
  XOr     AX, AX
  CWD
  @@1:    MOV     ES: [DI].TMemoryStream. Position. Word [0], AX
  MOV     ES: [DI].TMemoryStream. Position. Word [2], DX
End;

Procedure TMemoryStream. Truncate; Assembler;
Asm
  LES     DI, Self
  XOr     BX, BX
  CMP     ES: [DI].TMemoryStream. Status, BX
  JNE     @@2
  MOV     AX, ES: [DI].TMemoryStream. Position. Word [0]
  MOV     DX, ES: [DI].TMemoryStream. Position. Word [2]
  Div     ES: [DI].TMemoryStream. BlockSize
  NEG     DX
  ADC     AX, BX
  PUSH    AX
  PUSH    ES
  PUSH    DI
  Call    ChangeListSize
  Or      AX, AX
  JNZ     @@1
  MOV     DX, stError
  Call    DoStreamError
  JMP     @@2
  @@1:    LES     DI, Self
  MOV     AX, ES: [DI].TMemoryStream. Position. Word [0]
  MOV     DX, ES: [DI].TMemoryStream. Position. Word [2]
  MOV     ES: [DI].TMemoryStream. Size. Word [0], AX
  MOV     ES: [DI].TMemoryStream. Size. Word [2], DX
  @@2:
End;

Procedure TMemoryStream. Write (Var Buf; Count: Word); Assembler;
Asm
  LES     DI, Self
  XOr     BX, BX
  CMP     BX, ES: [DI].TMemoryStream. Status
  JNE     @@7
  MOV     AX, ES: [DI].TMemoryStream. Position. Word [0]
  MOV     DX, ES: [DI].TMemoryStream. Position. Word [2]
  ADD     AX, Count
  ADC     DX, BX
  Div     ES: [DI].TMemoryStream. BlockSize
  NEG     DX
  ADC     AX, BX
  CMP     AX, ES: [DI].TMemoryStream. SegCount
  JBE     @@4
  PUSH    BX
  PUSH    ES
  PUSH    DI
  PUSH    AX
  PUSH    ES
  PUSH    DI
  Call    ChangeListSize
  POP     DI
  POP     ES
  POP     BX
  Or      AX, AX
  JNZ     @@4
  @@1:    MOV     DX, stWriteError
  Call    DoStreamError
  JMP     @@7
  @@2:    Call    MemSelectSeg
  MOV     AX, Count
  SUB     AX, BX
  CMP     CX, AX
  JB      @@3
  MOV     CX, AX
  @@3:    ADD     ES: [DI].TMemoryStream. Position. Word [0], CX
  ADC     ES: [DI].TMemoryStream. Position. Word [2], 0
  PUSH    ES
  PUSH    DS
  PUSH    DI
  MOV     DX, ES: [DI].TMemoryStream. CurSeg
  LES     DI, ES: [DI].TMemoryStream. SegList
  ADD     DI, DX
  MOV     ES, Word Ptr ES: [DI]
  MOV     DI, SI
  LDS     SI, Buf
  ADD     SI, BX
  ADD     BX, CX
  CLD
  REP     MOVSB
  POP     DI
  POP     DS
  POP     ES
  @@4:    CMP     BX, Count
  JB      @@2
  @@5:    MOV     AX, ES: [DI].TMemoryStream. Position. Word [0]
  MOV     DX, ES: [DI].TMemoryStream. Position. Word [2]
  CMP     DX, ES: [DI].TMemoryStream. Size. Word [2]
  JB      @@7
  JA      @@6
  CMP     AX, ES: [DI].TMemoryStream. Size. Word [0]
  JBE     @@7
  @@6:    MOV     ES: [DI].TMemoryStream. Size. Word [0], AX
  MOV     ES: [DI].TMemoryStream. Size. Word [2], DX
  @@7:
End;

{ TCollection }

Const
  TCollection_Error    = vmtHeaderSize + $04;
  TCollection_SetLimit = vmtHeaderSize + $1C;

Procedure CollectionError; Near; Assembler;
Asm
  PUSH    AX
  PUSH    BX
  PUSH    ES
  PUSH    DI
  MOV     DI, ES: [DI]
  Call    DWord Ptr [DI].TCollection_Error
End;

Constructor TCollection. Init (ALimit, ADelta: Integer);
Begin
  TObject. Init;
  Items := Nil;
  Count := 0;
  Limit := 0;
  Delta := ADelta;
  SetLimit (ALimit);
End;

Constructor TCollection. Load (Var S: TStream);
Var
  C, I  : Integer;
Begin
  S. Read (Count, SizeOf (Integer) * 3);
  Items := Nil;
  C := Count;
  I := Limit;
  Count := 0;
  Limit := 0;
  SetLimit (I);
  Count := C;
  For I := 0 To C - 1 Do AtPut (I, GetItem (S) );
End;

Destructor TCollection. Done;
Begin
  FreeAll;
  SetLimit (0);
End;

Function TCollection. At (Index: Integer): Pointer; Assembler;
Asm
  LES     DI, Self
  MOV     BX, Index
  Or      BX, BX
  JL      @@1
  CMP     BX, ES: [DI].TCollection. Count
  JGE     @@1
  LES     DI, ES: [DI].TCollection. Items
  ShL     BX, 1
  ShL     BX, 1
  MOV   AX, ES: [DI + BX]
  MOV   DX, ES: [DI + BX + 2]
  JMP     @@2
  @@1:    MOV     AX, coIndexError
  Call    CollectionError
  XOr     AX, AX
  MOV     DX, AX
  @@2:
End;

Procedure TCollection. AtDelete (Index: Integer); Assembler;
Asm
  LES     DI, Self
  MOV     BX, Index
  Or      BX, BX
  JL      @@1
  CMP     BX, ES: [DI].TCollection. Count
  JGE     @@1
  Dec     ES: [DI].TCollection. Count
  MOV     CX, ES: [DI].TCollection. Count
  SUB     CX, BX
  JE      @@2
  CLD
  LES     DI, ES: [DI].TCollection. Items
  ShL     BX, 1
  ShL     BX, 1
  ADD     DI, BX
  LEA     SI, [DI + 4]
  ShL     CX, 1
  PUSH    DS
  PUSH    ES
  POP     DS
  REP     MOVSW
  POP     DS
  JMP     @@2
  @@1:    MOV     AX, coIndexError
  Call    CollectionError
  @@2:
End;

Procedure TCollection. AtFree (Index: Integer);
Var
  Item: Pointer;
Begin
  Item := At (Index);
  AtDelete (Index);
  FreeItem (Item);
End;

Procedure TCollection. AtInsert (Index: Integer; Item: Pointer); Assembler;
Asm
  LES     DI, Self
  MOV     BX, Index
  Or      BX, BX
  JL      @@3
  MOV     CX, ES: [DI].TCollection. Count
  CMP     BX, CX
  JG      @@3
  CMP     CX, ES: [DI].TCollection. Limit
  JNE     @@1
  PUSH    CX
  PUSH    BX
  ADD     CX, ES: [DI].TCollection. Delta
  PUSH    CX
  PUSH    ES
  PUSH    DI
  MOV     DI, ES: [DI]
  Call    DWord Ptr [DI].TCollection_SetLimit
  POP     BX
  POP     CX
  LES     DI, Self
  CMP     CX, ES: [DI].TCollection. Limit
  JE      @@4
  @@1:    Inc     ES: [DI].TCollection. Count
  STD
  LES     DI, ES: [DI].TCollection. Items
  ShL     CX, 1
  ADD     DI, CX
  ADD     DI, CX
  Inc     DI
  Inc     DI
  ShL     BX, 1
  SUB     CX, BX
  JE      @@2
  LEA     SI, [DI - 4]
  PUSH    DS
  PUSH    ES
  POP     DS
  REP     MOVSW
  POP     DS
  @@2:    MOV     AX, Word Ptr [Item + 2]
  STOSW
  MOV     AX, Word Ptr [Item]
  STOSW
  CLD
  JMP     @@6
  @@3:    MOV     AX, coIndexError
  JMP     @@5
  @@4:    MOV     AX, coOverflow
  MOV     BX, CX
  @@5:    Call    CollectionError
  @@6:
End;

Procedure TCollection. AtPut (Index: Integer; Item: Pointer); Assembler;
Asm
  MOV   AX, Item. Word [0]
  MOV   DX, Item. Word [2]
  LES   DI, Self
  MOV     BX, Index
  Or      BX, BX
  JL      @@1
  CMP     BX, ES: [DI].TCollection. Count
  JGE     @@1
  LES     DI, ES: [DI].TCollection. Items
  ShL     BX, 1
  ShL     BX, 1
  MOV     ES: [DI + BX], AX
  MOV     ES: [DI + BX + 2], DX
  JMP     @@2
  @@1:    MOV     AX, coIndexError
  Call    CollectionError
  @@2:
End;

Procedure TCollection. Delete (Item: Pointer);
Begin
  AtDelete (IndexOf (Item) );
End;

Procedure TCollection. DeleteAll;
Begin
  Count := 0;
End;

Procedure TCollection. Error (Code, Info: Integer);
Begin
  RunError (212 - Code);
End;

Function TCollection. FirstThat (Test: Pointer): Pointer; Assembler;
Asm
  LES     DI, Self
  MOV     CX, ES: [DI].TCollection. Count
  JCXZ    @@2
  LES     DI, ES: [DI].TCollection. Items
  @@1:    PUSH    ES
  PUSH    DI
  PUSH    CX
  PUSH    Word Ptr ES: [DI + 2]
  PUSH    Word Ptr ES: [DI]
  {$IFDEF Windows}
  MOV   AX, [BP]
  And   AL, 0FEH
  PUSH  AX
  {$ELSE}
  PUSH    Word Ptr [BP]
  {$ENDIF}
  Call    Test
  POP     CX
  POP     DI
  POP     ES
  Or      AL, AL
  JNE     @@3
  ADD     DI, 4
  LOOP    @@1
  @@2:    XOr     AX, AX
  MOV     DX, AX
  JMP     @@4
  @@3:  MOV     AX, ES: [DI]
  MOV   DX, ES: [DI + 2]
  @@4:
End;

Procedure TCollection. ForEach (Action: Pointer); Assembler;
Asm
  LES     DI, Self
  MOV     CX, ES: [DI].TCollection. Count
  JCXZ    @@2
  LES     DI, ES: [DI].TCollection. Items
  @@1:    PUSH    ES
  PUSH    DI
  PUSH    CX
  PUSH    Word Ptr ES: [DI + 2]
  PUSH    Word Ptr ES: [DI]
  {$IFDEF Windows}
  MOV   AX, [BP]
  And   AL, 0FEH
  PUSH  AX
  {$ELSE}
  PUSH    Word Ptr [BP]
  {$ENDIF}
  Call    Action
  POP     CX
  POP     DI
  POP     ES
  ADD     DI, 4
  LOOP    @@1
  @@2:
End;

Procedure TCollection. Free (Item: Pointer);
Begin
  Delete (Item);
  FreeItem (Item);
End;

Procedure TCollection. FreeAll;
Var
  I: Integer;
Begin
  For I := 0 To Count - 1 Do FreeItem (At (I) );
  Count := 0;
End;

Procedure TCollection. FreeItem (Item: Pointer);
Begin
  If Item <> Nil Then Dispose (PObject (Item), Done);
  Item := nil;
End;

Function TCollection. GetItem (Var S: TStream): Pointer;
Begin
  GetItem := S. Get;
End;

Function TCollection. IndexOf (Item: Pointer): Integer; Assembler;
Asm
  MOV   AX, Item. Word [0]
  MOV   DX, Item. Word [2]
  LES     DI, Self
  MOV     CX, ES: [DI].TCollection. Count
  JCXZ    @@3
  LES     DI, ES: [DI].TCollection. Items
  MOV     BX, DI
  ShL     CX, 1
  CLD
  @@1:    REPNE   SCASW
  JCXZ    @@3
  Test    CX, 1
  JE      @@1
  XCHG    AX, DX
  SCASW
  XCHG    AX, DX
  LOOPNE  @@1
  JNE     @@3
  MOV     AX, DI
  SUB     AX, BX
  ShR     AX, 1
  ShR     AX, 1
  Dec     AX
  JMP     @@2
  @@3:    MOV     AX, - 1
  @@2:
End;

Procedure TCollection. Insert (Item: Pointer);
Begin
  AtInsert (Count, Item);
End;

Function TCollection. LastThat (Test: Pointer): Pointer; Assembler;
Asm
  LES     DI, Self
  MOV     CX, ES: [DI].TCollection. Count
  JCXZ    @@2
  LES     DI, ES: [DI].TCollection. Items
  MOV     AX, CX
  ShL     AX, 1
  ShL     AX, 1
  ADD     DI, AX
  @@1:    SUB     DI, 4
  PUSH    ES
  PUSH    DI
  PUSH    CX
  PUSH    Word Ptr ES: [DI + 2]
  PUSH    Word Ptr ES: [DI]
  {$IFDEF Windows}
  MOV   AX, [BP]
  And   AL, 0FEH
  PUSH  AX
  {$ELSE}
  PUSH    Word Ptr [BP]
  {$ENDIF}
  Call    Test
  POP     CX
  POP     DI
  POP     ES
  Or      AL, AL
  JNE     @@3
  LOOP    @@1
  @@2:    XOr     AX, AX
  MOV     DX, AX
  JMP     @@4
  @@3:  MOV     AX, ES: [DI]
  MOV   DX, ES: [DI + 2]
  @@4:
End;

Procedure TCollection. Pack; Assembler;
Asm
  LES     DI, Self
  MOV     CX, ES: [DI].TCollection. Count
  JCXZ    @@3
  LES     DI, ES: [DI].TCollection. Items
  MOV     SI, DI
  PUSH    DS
  PUSH    ES
  POP     DS
  CLD
  @@1:    LODSW
  XCHG    AX, DX
  LODSW
  MOV     BX, AX
  Or      BX, DX
  JE      @@2
  XCHG    AX, DX
  STOSW
  XCHG    AX, DX
  STOSW
  @@2:    LOOP    @@1
  POP     DS
  LES     BX, Self
  SUB     DI, Word Ptr ES: [BX].TCollection. Items
  ShR     DI, 1
  ShR     DI, 1
  MOV     ES: [BX].TCollection. Count, DI
  @@3:
End;

Procedure TCollection. PutItem (Var S: TStream; Item: Pointer);
Begin
  S. Put (Item);
End;

Procedure TCollection. SetLimit (ALimit: Integer);
Var
  AItems: PItemList;
Begin
  If ALimit < Count Then ALimit := Count;
  If ALimit > MaxCollectionSize Then ALimit := MaxCollectionSize;
  If ALimit <> Limit Then
  Begin
    If ALimit = 0 Then AItems := Nil Else
    Begin
      GetMem (AItems, ALimit * SizeOf (Pointer) );
      If (Count <> 0) And (Items <> Nil) Then
        Move (Items^, AItems^, Count * SizeOf (Pointer) );
    End;
    If Limit <> 0 Then FreeMem (Items, Limit * SizeOf (Pointer) );
    Items := AItems;
    Limit := ALimit;
  End;
End;

Procedure TCollection. Store (Var S: TStream);

Procedure DoPutItem (P: Pointer); Far;
Begin
  PutItem (S, P);
End;

Begin
  S. Write (Count, SizeOf (Integer) * 3);
  ForEach (@DoPutItem);
End;

{ TSortedCollection }

Constructor TSortedCollection. Init (ALimit, ADelta: Integer);
Begin
  TCollection. Init (ALimit, ADelta);
  Duplicates := False;
End;

Constructor TSortedCollection. Load (Var S: TStream);
Begin
  TCollection. Load (S);
  S. Read (Duplicates, SizeOf (Boolean));
End;

Function TSortedCollection. Compare (Key1, Key2: Pointer): Integer;
Begin
  Abstract;
End;

Function TSortedCollection. IndexOf (Item: Pointer): Integer;
Var
  I: Integer;
Begin
  IndexOf := - 1;
  If Search (KeyOf (Item), I) Then
  Begin
    If Duplicates Then
      While (I < Count) And (Item <> Items^ [I] ) Do Inc (I);
    If I < Count Then IndexOf := I;
  End;
End;

Procedure TSortedCollection. Insert (Item: Pointer);
Var
  I: Integer;
Begin
  If Not Search (KeyOf (Item), I) Or Duplicates Then AtInsert (I, Item);
End;

Function TSortedCollection. KeyOf (Item: Pointer): Pointer;
Begin
  KeyOf := Item;
End;

Function TSortedCollection. Search (Key: Pointer; Var Index: Integer): Boolean;
Var
  L, H, I, C: Integer;
Begin
  Search := False;
  L := 0;
  H := Count - 1;
  While L <= H Do
  Begin
    I := (L + H) ShR 1;
    C := Compare (KeyOf (Items^ [I] ), Key);
    If C < 0 Then L := I + 1 Else
    Begin
      H := I - 1;
      If C = 0 Then
      Begin
        Search := True;
        If Not Duplicates Then L := I;
      End;
    End;
  End;
  Index := L;
End;

Procedure TSortedCollection. Store (Var S: TStream);
Begin
  TCollection. Store (S);
  S. Write (Duplicates, SizeOf (Boolean));
End;

{ TStringCollection }

Function TStringCollection. Compare (Key1, Key2: Pointer): Integer;
Assembler;
Asm
  PUSH    DS
  CLD
  LDS     SI, Key1
  LES     DI, Key2
  LODSB
  MOV     AH, ES: [DI]
  Inc     DI
  MOV     CL, AL
  CMP     CL, AH
  JBE     @@1
  MOV     CL, AH
  @@1:    XOr     CH, CH
  REP     CMPSB
  JE      @@2
  MOV     AL, DS: [SI - 1]
  MOV     AH, ES: [DI - 1]
  @@2:    SUB     AL, AH
  SBB     AH, AH
  POP     DS
End;

Procedure TStringCollection. FreeItem (Item: Pointer);
Begin
  DisposeStr (Item);
End;

Function TStringCollection. GetItem (Var S: TStream): Pointer;
Begin
  GetItem := S. ReadStr;
End;

Procedure TStringCollection. PutItem (Var S: TStream; Item: Pointer);
Begin
  S. WriteStr (Item);
End;

{ TStrCollection }

Function TStrCollection. Compare (Key1, Key2: Pointer): Integer;
Begin
  Compare := StrComp (Key1, Key2);
End;

Procedure TStrCollection. FreeItem (Item: Pointer);
Begin
  StrDispose (Item);
End;

Function TStrCollection. GetItem (Var S: TStream): Pointer;
Begin
  GetItem := S. StrRead;
End;

Procedure TStrCollection. PutItem (Var S: TStream; Item: Pointer);
Begin
  S. StrWrite (Item);
End;

{$IFNDEF Windows }

{ Private resource manager types }

Const
  RStreamMagic: LongInt = $52504246; { 'FBPR' }
  RStreamBackLink: LongInt = $4C424246; { 'FBBL' }

Type
  PResourceItem = ^TResourceItem;
  TResourceItem = Record
                    Pos: LongInt;
                    Size: LongInt;
                    Key: String;
                  End;

  { TResourceCollection }

Procedure TResourceCollection. FreeItem (Item: Pointer);
Begin
  If Item <> Nil Then
    FreeMem (Item, Length (PResourceItem (Item)^. Key) +
    (SizeOf (TResourceItem) - SizeOf (String) + 1) );
  Item := Nil;
End;

Function TResourceCollection. GetItem (Var S: TStream): Pointer;
Var
  Pos: LongInt;
  Size: LongInt;
  L: Byte;
  P: PResourceItem;
Begin
  S. Read (Pos, SizeOf (LongInt));
  S. Read (Size, SizeOf (LongInt));
  S. Read (L, 1);
  GetMem (P, L + (SizeOf (TResourceItem) - SizeOf (String) + 1) );
  P^. Pos := Pos;
  P^. Size := Size;
  P^. Key [0] := Char (L);
  S. Read (P^. Key [1], L);
  GetItem := P;
End;

Function TResourceCollection. KeyOf (Item: Pointer): Pointer; Assembler;
Asm
  MOV     AX, Item. Word [0]
  MOV     DX, Item. Word [2]
  ADD     AX, Offset TResourceItem. Key
End;

Procedure TResourceCollection. PutItem (Var S: TStream; Item: Pointer);
Begin
  S. Write (PResourceItem (Item)^, Length (PResourceItem (Item)^. Key) +
  (SizeOf (TResourceItem) - SizeOf (String) + 1) );
End;

{ TResourceFile }

Constructor TResourceFile. Init (AStream: PStream);
Type

  {$IFDEF NewExeFormat}

  TExeHeader = Record
                 eHdrSize:   Word;
                 eMinAbove:  Word;
                 eMaxAbove:  Word;
                 eInitSS:    Word;
                 eInitSP:    Word;
                 eCheckSum:  Word;
                 eInitPC:    Word;
                 eInitCS:    Word;
                 eRelocOfs:  Word;
                 eOvlyNum:   Word;
                 eRelocTab:  Word;
                 eSpace:     Array [1..30] Of Byte;
                 eNewHeader: Word;
               End;

  {$ENDIF}

  THeader = Record
              Signature: Word;
              Case Integer Of
                0: (
                     LastCount: Word;
                PageCount: Word;
                ReloCount: Word);
                1: (
                     InfoType: Word;
                InfoSize: LongInt);
              End;
              Var
                Found, Stop: Boolean;
                Header: THeader;

                {$IFDEF NewExeFormat}

                ExeHeader: TExeHeader;

                {$ENDIF}

              Begin
                TObject. Init;
                Stream := AStream;
                BasePos := Stream^. GetPos;
                Found := False;
                Repeat
                  Stop := True;
                  If BasePos <= Stream^. GetSize - SizeOf (THeader) Then
                  Begin
                    Stream^. Seek (BasePos);
                    Stream^. Read (Header, SizeOf (THeader));
                    Case Header. Signature Of

                      {$IFDEF NewExeFormat}

                      $5A4D:
                            Begin
                              Stream^. Read (ExeHeader, SizeOf (TExeHeader));
                              BasePos := ExeHeader. eNewHeader;
                              Stop := False;
                            End;
                      $454E:
                            Begin
                              BasePos := Stream^. GetSize - 8;
                              Stop := False;
                            End;
                      $4246:
                            Begin
                              Stop := False;
                              Case Header. Infotype Of
                                $5250:                                    {Found Resource}
                                                                          Begin
                                                                            Found := True;
                                                                            Stop := True;
                                                                          End;
                                $4C42: Dec (BasePos, Header. InfoSize - 8); {Found BackLink}
                                $4648: Dec (BasePos, SizeOf (THeader) * 2); {Found HelpFile}
                                Else
                                  Stop := True;
                              End;
                            End;
                      $424E:
                              If Header. InfoType = $3230 Then               {Found Debug Info}
                              Begin
                                Dec (BasePos, Header. InfoSize);
                                Stop := False;
                              End;

                      {$ELSE}

                      $5A4D:
                            Begin
                              Inc (BasePos, LongMul (Header. PageCount, 512) -
                              ( - Header. LastCount And 511) );
                              Stop := False;
                            End;
                      $4246:
                              If Header. InfoType = $5250 Then Found := True Else
                              Begin
                                Inc (BasePos, Header. InfoSize + 8);
                                Stop := False;
                              End;

                      {$ENDIF}

                    End;
                  End;
                Until Stop;
                If Found Then
                Begin
                  Stream^. Seek (BasePos + SizeOf (LongInt) * 2);
                  Stream^. Read (IndexPos, SizeOf (LongInt));
                  Stream^. Seek (BasePos + IndexPos);
                  Index. Load (Stream^);
                End Else
                Begin
                  IndexPos := SizeOf (LongInt) * 3;
                  Index. Init (0, 8);
                End;
              End;

              Destructor TResourceFile. Done;
            Begin
              Flush;
              Index. Done;
              Dispose (Stream, Done);
            End;

Function TResourceFile. Count: Integer;
Begin
  Count := Index. Count;
End;

Procedure TResourceFile. Delete (Key: String);
Var
  I: Integer;
Begin
  If Index. Search (@Key, I) Then
  Begin
    Index. Free (Index. At (I) );
    Modified := True;
  End;
End;

Procedure TResourceFile. Flush;
Var
  ResSize: LongInt;
  LinkSize: LongInt;
Begin
  If Modified Then
  Begin
    Stream^. Seek (BasePos + IndexPos);
    Index. Store (Stream^);
    ResSize := Stream^. GetPos - BasePos;
    LinkSize := ResSize + SizeOf (LongInt) * 2;
    Stream^. Write (RStreamBackLink, SizeOf (LongInt));
    Stream^. Write (LinkSize, SizeOf (LongInt));
    Stream^. Seek (BasePos);
    Stream^. Write (RStreamMagic, SizeOf (LongInt) );
    Stream^. Write (ResSize, SizeOf (LongInt) );
    Stream^. Write (IndexPos, SizeOf (LongInt) );
    Stream^. Flush;
    Modified := False;
  End;
End;

Function TResourceFile. Get (Key: String): PObject;
Var
  I: Integer;
Begin
  If Not Index. Search (@Key, I) Then Get := Nil Else
  Begin
    Stream^. Seek (BasePos + PResourceItem (Index. At (I) )^. Pos);
    Get := Stream^. Get;
  End;
End;

Function TResourceFile. KeyAt (I: Integer): String;
Begin
  KeyAt := PResourceItem (Index. At (I) )^. Key;
End;

Procedure TResourceFile. Put (Item: PObject; Key: String);
Var
  I: Integer;
  P: PResourceItem;
Begin
  If Index. Search (@Key, I) Then P := Index. At (I) Else
  Begin
    GetMem (P, Length (Key) + (SizeOf (TResourceItem) - SizeOf (String) + 1) );
    P^. Key := Key;
    Index. AtInsert (I, P);
  End;
  P^. Pos := IndexPos;
  Stream^. Seek (BasePos + IndexPos);
  Stream^. Put (Item);
  IndexPos := Stream^. GetPos - BasePos;
  P^. Size := IndexPos - P^. Pos;
  Modified := True;
End;

Function TResourceFile. SwitchTo (AStream: PStream; Pack: Boolean): PStream;
Var
  NewBasePos: LongInt;

Procedure DoCopyResource (Item: PResourceItem); Far;
Begin
  Stream^. Seek (BasePos + Item^. Pos);
  Item^. Pos := AStream^. GetPos - NewBasePos;
  AStream^. CopyFrom (Stream^, Item^. Size);
End;

Begin
  SwitchTo := Stream;
  NewBasePos := AStream^. GetPos;
  If Pack Then
  Begin
    AStream^. Seek (NewBasePos + SizeOf (LongInt) * 3);
    Index. ForEach (@DoCopyResource);
    IndexPos := AStream^. GetPos - NewBasePos;
  End Else
  Begin
    Stream^. Seek (BasePos);
    AStream^. CopyFrom (Stream^, IndexPos);
  End;
  Stream := AStream;
  Modified := True;
  BasePos := NewBasePos;
End;

{ TStringList }

Constructor TStringList. Load (Var S: TStream);
Var
  Size: Word;
Begin
  Stream := @S;
  S. Read (Size, SizeOf (Word));
  BasePos := S. GetPos;
  S. Seek (BasePos + Size);
  S. Read (IndexSize, SizeOf (Integer));
  GetMem (Index, IndexSize * SizeOf (TStrIndexRec) );
  S. Read (Index^, IndexSize * SizeOf (TStrIndexRec));
End;

Destructor TStringList. Done;
Begin
  If Index <> Nil Then FreeMem (Index, IndexSize * SizeOf (TStrIndexRec) );
  Index := Nil;
End;

Function TStringList. Get (Key: Word): String; Assembler;
Asm
  PUSH    DS
  LDS     SI, Self
  LES     DI, @Result
  CLD
  MOV     CX, DS: [SI].TStringList. IndexSize
  JCXZ    @@2
  MOV     BX, Key
  LDS     SI, DS: [SI].TStringList. Index
  @@1:    MOV     DX, BX
  LODSW
  SUB     DX, AX
  LODSW
  CMP     DX, AX
  LODSW
  JB      @@3
  LOOP    @@1
  @@2:    POP     DS
  XOr     AL, AL
  STOSB
  JMP     @@4
  @@3:    POP     DS
  PUSH    ES
  PUSH    DI
  PUSH    AX
  PUSH    DX
  LES     DI, Self
  PUSH    ES
  PUSH    DI
  Call    TStringList. ReadStr
  @@4:
End;

Procedure TStringList. ReadStr (Var S: String; Offset, Skip: Word);
Begin
  Stream^. Seek (BasePos + Offset);
  Inc (Skip);
  Repeat
    Stream^. Read (S [0], 1);
    Stream^. Read (S [1], Ord (S [0] ) );
    Dec (Skip);
  Until Skip = 0;
End;

{ TStrListMaker }

Constructor TStrListMaker. Init (AStrSize, AIndexSize: Word);
Begin
  TObject. Init;
  StrSize := AStrSize;
  IndexSize := AIndexSize;
  GetMem (Strings, AStrSize);
  GetMem (Index, AIndexSize * SizeOf (TStrIndexRec) );
End;

Destructor TStrListMaker. Done;
Begin
  If Index <> Nil Then FreeMem (Index, IndexSize * SizeOf (TStrIndexRec) );
  If Strings <> Nil Then FreeMem (Strings, StrSize);
  Index := Nil;
  Strings := Nil;
End;

Procedure TStrListMaker. CloseCurrent;
Begin
  If Cur. Count <> 0 Then
  Begin
    Index^ [IndexPos] := Cur;
    Inc (IndexPos);
    Cur. Count := 0;
  End;
End;

Procedure TStrListMaker. Put (Key: Word; S: String);
Begin
  If (Cur. Count = 16) Or (Key <> Cur. Key + Cur. Count) Then CloseCurrent;
  If Cur. Count = 0 Then
  Begin
    Cur. Key := Key;
    Cur. Offset := StrPos;
  End;
  Inc (Cur. Count);
  Move (S, Strings^ [StrPos], Length (S) + 1);
  Inc (StrPos, Length (S) + 1);
End;

Procedure TStrListMaker. Store (Var S: TStream);
Begin
  CloseCurrent;
  S. Write (StrPos, SizeOf (Word));
  S. Write (Strings^, StrPos);
  S. Write (IndexPos, SizeOf (Word));
  S. Write (Index^, IndexPos * SizeOf (TStrIndexRec));
End;

{ TRect }

Procedure CheckEmpty; Near; Assembler;
Asm
  MOV     AX, ES: [DI].TRect. A. X
  CMP     AX, ES: [DI].TRect. B. X
  JGE     @@1
  MOV     AX, ES: [DI].TRect. A. Y
  CMP     AX, ES: [DI].TRect. B. Y
  JL      @@2
  @@1:    CLD
  XOr     AX, AX
  STOSW
  STOSW
  STOSW
  STOSW
  @@2:
End;

Procedure TRect. Assign (XA, YA, XB, YB: Integer); Assembler;
Asm
  LES     DI, Self
  CLD
  MOV     AX, XA
  STOSW
  MOV     AX, YA
  STOSW
  MOV     AX, XB
  STOSW
  MOV     AX, YB
  STOSW
End;

Procedure TRect. Copy (R: TRect); Assembler;
Asm
  PUSH    DS
  LDS     SI, R
  LES     DI, Self
  CLD
  MOVSW
  MOVSW
  MOVSW
  MOVSW
  POP     DS
End;

Procedure TRect. Move (ADX, ADY: Integer); Assembler;
Asm
  LES     DI, Self
  MOV     AX, ADX
  ADD     ES: [DI].TRect. A. X, AX
  ADD     ES: [DI].TRect. B. X, AX
  MOV     AX, ADY
  ADD     ES: [DI].TRect. A. Y, AX
  ADD     ES: [DI].TRect. B. Y, AX
End;

Procedure TRect. Grow (ADX, ADY: Integer); Assembler;
Asm
  LES     DI, Self
  MOV     AX, ADX
  SUB     ES: [DI].TRect. A. X, AX
  ADD     ES: [DI].TRect. B. X, AX
  MOV     AX, ADY
  SUB     ES: [DI].TRect. A. Y, AX
  ADD     ES: [DI].TRect. B. Y, AX
  Call    CheckEmpty
End;

Procedure TRect. Intersect (R: TRect); Assembler;
Asm
  PUSH    DS
  LDS     SI, R
  LES     DI, Self
  CLD
  LODSW
  SCASW
  JLE     @@1
  Dec     DI
  Dec     DI
  STOSW
  @@1:    LODSW
  SCASW
  JLE     @@2
  Dec     DI
  Dec     DI
  STOSW
  @@2:    LODSW
  SCASW
  JGE     @@3
  Dec     DI
  Dec     DI
  STOSW
  @@3:    LODSW
  SCASW
  JGE     @@4
  Dec     DI
  Dec     DI
  STOSW
  @@4:    POP     DS
  SUB     DI, 8
  Call    CheckEmpty
End;

Procedure TRect. Union (R: TRect); Assembler;
Asm
  PUSH    DS
  LDS     SI, R
  LES     DI, Self
  CLD
  LODSW
  SCASW
  JGE     @@1
  Dec     DI
  Dec     DI
  STOSW
  @@1:    LODSW
  SCASW
  JGE     @@2
  Dec     DI
  Dec     DI
  STOSW
  @@2:    LODSW
  SCASW
  JLE     @@3
  Dec     DI
  Dec     DI
  STOSW
  @@3:    LODSW
  SCASW
  JLE     @@4
  Dec     DI
  Dec     DI
  STOSW
  @@4:    POP     DS
End;

Function TRect. Contains (P: TPoint): Boolean; Assembler;
Asm
  LES     DI, Self
  MOV     AL, 0
  MOV     DX, P. X
  CMP     DX, ES: [DI].TRect. A. X
  JL      @@1
  CMP     DX, ES: [DI].TRect. B. X
  JGE     @@1
  MOV     DX, P. Y
  CMP     DX, ES: [DI].TRect. A. Y
  JL      @@1
  CMP     DX, ES: [DI].TRect. B. Y
  JGE     @@1
  Inc     AX
  @@1:
End;

Function TRect. Equals (R: TRect): Boolean; Assembler;
Asm
  PUSH    DS
  LDS     SI, R
  LES     DI, Self
  MOV     CX, 4
  CLD
  REP     CMPSW
  MOV     AL, 0
  JNE     @@1
  Inc     AX
  @@1:    POP     DS
End;

Function TRect. Empty: Boolean; Assembler;
Asm
  LES     DI, Self
  MOV     AL, 1
  MOV     DX, ES: [DI].TRect. A. X
  CMP     DX, ES: [DI].TRect. B. X
  JGE     @@1
  MOV     DX, ES: [DI].TRect. A. Y
  CMP     DX, ES: [DI].TRect. B. Y
  JGE     @@1
  Dec     AX
  @@1:
End;

{$ENDIF}

{ Dynamic string handling routines }

Function NewStr (Const S: String): PString;
Var
  P: PString;
Begin
  GetMem (P, Length (S) + 1);
  P^ := S;
  NewStr := P;
End;

Procedure DisposeStr (P: PString);
Begin
  If P <> Nil Then FreeMem (P, Length (P^) + 1);
  P := Nil;
End;

{ Objects registration procedure }

Procedure RegisterObjects;
Begin
  RegisterType (RCollection);
  RegisterType (RStringCollection);
  RegisterType (RStrCollection);
End;

{$ENDIF}

{$IFDEF OS2}
{OS/2 OBJECTS}

{$X+,I-,S-,B-,Cdecl-}

interface

uses Use32;

const

{ TStream access modes }

  stCreate    = $3C00;           { Create new file }
  stOpenRead  = $3D00;           { Read access only }
  stOpenWrite = $3D01;           { Write access only }
  stOpen      = $3D02;           { Read and write access }

{ TStream error codes }

  stOk         =  0;              { No error }
  stError      = -1;              { Access error }
  stInitError  = -2;              { Cannot initialize stream }
  stReadError  = -3;              { Read beyond end of stream }
  stWriteError = -4;              { Cannot expand stream }
  stGetError   = -5;              { Get of unregistered object type }
  stPutError   = -6;              { Put of unregistered object type }

{ Maximum TCollection size }

  MaxCollectionSize = 512*1024*1024 div SizeOf(Pointer);

{ TCollection error codes }

  coIndexError = -1;              { Index out of range }
  coOverflow   = -2;              { Overflow }

{ VMT header size }

  vmtHeaderSize = 12;

type

{ Type conversion records }

  WordRec = record
    Lo, Hi: Byte;
  end;

  LongRec = record
    Lo, Hi: SmallWord;
  end;

  PtrRec = record
    Ofs: Longint;
  end;

{ String pointers }

  PString = ^String;

{ Character set type }

  PCharSet = ^TCharSet;
  TCharSet = set of Char;

{ General arrays }

  PByteArray = ^TByteArray;
  TByteArray = array[0..512*1024*1024] of Byte;

  PWordArray = ^TWordArray;
  TWordArray = array[0..512*1024*1024 div 2] of SmallWord;

  PLongArray = ^TLongArray;
  TLongArray = array[0..512*1024*1024 div 4] of Longint;

  PPtrArray = ^TPtrArray;
  TPtrArray = array[0..512*1024*1024 div 4] of Pointer;

{ TObject base object }

  PObject = ^TObject;
  TObject = object
    constructor Init;
    procedure Free;
    destructor Done; virtual;
  end;

{ TStreamRec }

  PStreamRec = ^TStreamRec;
  TStreamRec = record
    ObjType: Word;
    VmtLink: Word;
    Load: Pointer;
    Store: Pointer;
    Next: PStreamRec;
  end;

{ TStream }

  PStream = ^TStream;
  TStream = object(TObject)
    Status: Integer;
    ErrorInfo: Integer;
    constructor Init;
    procedure CopyFrom(var S: TStream; Count: Longint);
    procedure Error(Code, Info: Integer); virtual;
    procedure Flush; virtual;
    function Get: PObject;
    function GetPos: Longint; virtual;
    function GetSize: Longint; virtual;
    procedure Put(P: PObject);
    procedure Read(var Buf; Count: Word); virtual;
    function ReadStr: PString;
    procedure Reset;
    procedure Seek(Pos: Longint); virtual;
    function StrRead: PChar;
    procedure StrWrite(P: PChar);
    procedure Truncate; virtual;
    procedure Write(var Buf; Count: Word); virtual;
    procedure WriteStr(P: PString);
  end;

{ DOS file name string }

  FNameStr = String;

{ TDosStream }

  PDosStream = ^TDosStream;
  TDosStream = object(TStream)
    Handle: Word;
    constructor Init(FileName: FNameStr; Mode: 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 ReadBlock (Var Buf; Count: Word; Var BytesRead: Word);
  end;

{ TBufStream }

  PBufStream = ^TBufStream;
  TBufStream = object(TDosStream)
    Buffer: Pointer;
    BufSize: Word;
    BufPtr: Word;
    BufEnd: Word;
    constructor Init(const FileName: FNameStr; Mode, Size: Word);
    destructor Done; virtual;
    procedure Flush; 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;
  end;

{ TMemoryStream }

  PMemoryStream = ^TMemoryStream;
  TMemoryStream = object(TStream)
    BlockCount: Integer;
    BlockList: PPtrArray;
    CurBlock: Integer;
    BlockSize: Integer;
    Size: Longint;
    Position: Longint;
    constructor Init(ALimit: Longint; ABlockSize: 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;
  private
    function ChangeListSize(ALimit: Word): Boolean;
  end;

{ TCollection types }

  PItemList = ^TItemList;
  TItemList = array[0..MaxCollectionSize - 1] of Pointer;

{ TCollection object }

  PCollection = ^TCollection;
  TCollection = object(TObject)
    Items: PItemList;
    Count: Integer;
    Limit: Integer;
    Delta: Integer;
    constructor Init(ALimit, ADelta: Integer);
    constructor Load(var S: TStream);
    destructor Done; virtual;
    function At(Index: Integer): Pointer;
    procedure AtDelete(Index: Integer);
    procedure AtFree(Index: Integer);
    procedure AtInsert(Index: Integer; Item: Pointer);
    procedure AtPut(Index: Integer; Item: Pointer);
    procedure Delete(Item: Pointer);
    procedure DeleteAll;
    procedure Error(Code, Info: Integer); virtual;
    function FirstThat(Test: Pointer): Pointer;
    procedure ForEach(Action: Pointer);
    procedure Free(Item: Pointer);
    procedure FreeAll;
    procedure FreeItem(Item: Pointer); virtual;
    function GetItem(var S: TStream): Pointer; virtual;
    function IndexOf(Item: Pointer): Integer; virtual;
    procedure Insert(Item: Pointer); virtual;
    function LastThat(Test: Pointer): Pointer;
    procedure Pack;
    procedure PutItem(var S: TStream; Item: Pointer); virtual;
    procedure SetLimit(ALimit: Integer); virtual;
    procedure Store(var S: TStream);
  end;

{ TSortedCollection object }

  PSortedCollection = ^TSortedCollection;
  TSortedCollection = object(TCollection)
    Duplicates: Boolean;
    constructor Init(ALimit, ADelta: Integer);
    constructor Load(var S: TStream);
    function Compare(Key1, Key2: Pointer): Integer; virtual;
    function IndexOf(Item: Pointer): Integer; virtual;
    procedure Insert(Item: Pointer); virtual;
    function KeyOf(Item: Pointer): Pointer; virtual;
    function Search(Key: Pointer; var Index: Integer): Boolean; virtual;
    procedure Store(var S: TStream);
  end;

{ TStringCollection object }

  PStringCollection = ^TStringCollection;
  TStringCollection = object(TSortedCollection)
    function Compare(Key1, Key2: Pointer): Integer; virtual;
    procedure FreeItem(Item: Pointer); virtual;
    function GetItem(var S: TStream): Pointer; virtual;
    procedure PutItem(var S: TStream; Item: Pointer); virtual;
  end;

{ TStrCollection object }

  PStrCollection = ^TStrCollection;
  TStrCollection = object(TSortedCollection)
    function Compare(Key1, Key2: Pointer): Integer; virtual;
    procedure FreeItem(Item: Pointer); virtual;
    function GetItem(var S: TStream): Pointer; virtual;
    procedure PutItem(var S: TStream; Item: Pointer); virtual;
  end;

{ TResourceCollection object }

  PResourceCollection = ^TResourceCollection;
  TResourceCollection = object(TStringCollection)
    procedure FreeItem(Item: Pointer); virtual;
    function GetItem(var S: TStream): Pointer; virtual;
    function KeyOf(Item: Pointer): Pointer; virtual;
    procedure PutItem(var S: TStream; Item: Pointer); virtual;
  end;

{ TResourceFile object }

  PResourceFile = ^TResourceFile;
  TResourceFile = object(TObject)
    Stream: PStream;
    Modified: Boolean;
    constructor Init(AStream: PStream);
    destructor Done; virtual;
    function Count: Integer;
    procedure Delete(Key: String);
    procedure Flush;
    function Get(Key: String): PObject;
    function KeyAt(I: Integer): String;
    procedure Put(Item: PObject; Key: String);
    function SwitchTo(AStream: PStream; Pack: Boolean): PStream;
  private
    BasePos: Longint;
    IndexPos: Longint;
    Index: TResourceCollection;
  end;

{ TStringList object }

  TStrIndexRec = record
    Key, Count, Offset: Word;
  end;

  PStrIndex = ^TStrIndex;
  TStrIndex = array[0..9999] of TStrIndexRec;

  PStringList = ^TStringList;
  TStringList = object(TObject)
    constructor Load(var S: TStream);
    destructor Done; virtual;
    function Get(Key: Word): String;
  private
    Stream: PStream;
    BasePos: Longint;
    IndexSize: Integer;
    Index: PStrIndex;
    procedure ReadStr(var S: String; Offset, Skip: Word);
  end;

{ TStrListMaker object }

  PStrListMaker = ^TStrListMaker;
  TStrListMaker = object(TObject)
    constructor Init(AStrSize, AIndexSize: Word);
    destructor Done; virtual;
    procedure Put(Key: Word; S: String);
    procedure Store(var S: TStream);
  private
    StrPos: Word;
    StrSize: Word;
    Strings: PByteArray;
    IndexPos: Word;
    IndexSize: Word;
    Index: PStrIndex;
    Cur: TStrIndexRec;
    procedure CloseCurrent;
  end;

{ TPoint object }

  TPoint = object
    X, Y: Integer;
  end;

{ Rectangle object }

  TRect = object
    A, B: TPoint;
    procedure Assign(XA, YA, XB, YB: Integer);
    procedure Copy(R: TRect);
    procedure Move(ADX, ADY: Integer);
    procedure Grow(ADX, ADY: Integer);
    procedure Intersect(R: TRect);
    procedure Union(R: TRect);
    function Contains(P: TPoint): Boolean;
    function Equals(R: TRect): Boolean;
    function Empty: Boolean;
  end;

{ Dynamic string handling routines }

function NewStr(const S: String): PString;
procedure DisposeStr(P: PString);

{ Stream routines }

procedure RegisterType(var S: TStreamRec);

{ Abstract notification procedure }

procedure Abstract;

{ Objects registration procedure }

procedure RegisterObjects;

{ Analog to DOS int 21h I/O functions }

procedure DosFn;

const

{ Stream error procedure }

  StreamError: Pointer = nil;

{ Stream registration records }

const
  RCollection: TStreamRec = (
    ObjType: 50;
    VmtLink: Ofs(TypeOf(TCollection)^);
    Load: @TCollection.Load;
    Store: @TCollection.Store);

const
  RStringCollection: TStreamRec = (
    ObjType: 51;
    VmtLink: Ofs(TypeOf(TStringCollection)^);
    Load: @TStringCollection.Load;
    Store: @TStringCollection.Store);

const
  RStrCollection: TStreamRec = (
    ObjType: 69;
    VmtLink: Ofs(TypeOf(TStrCollection)^);
    Load:    @TStrCollection.Load;
    Store:   @TStrCollection.Store);

const
  RStringList: TStreamRec = (
    ObjType: 52;
    VmtLink: Ofs(TypeOf(TStringList)^);
    Load: @TStringList.Load;
    Store: nil);

const
  RStrListMaker: TStreamRec = (
    ObjType: 52;
    VmtLink: Ofs(TypeOf(TStrListMaker)^);
    Load: nil;
    Store: @TStrListMaker.Store);

implementation

uses Memory, Strings, Os2Base;

procedure Abstract;
begin
  RunError(211);
end;

{ TObject }

constructor TObject.Init;
type
  Image = record
    Link: Word;
    Data: record end;
  end;
begin
  FillChar(Image(Self).Data, SizeOf(Self) - SizeOf(TObject), 0);
end;

{ Shorthand procedure for a done/dispose }

procedure TObject.Free;
begin
  Dispose(PObject(@Self), Done);
end;

destructor TObject.Done;
begin
end;

{ TStream type registration routines }

const
  StreamTypes: PStreamRec = nil;

procedure RegisterError;
begin
  RunError(212);
end;

procedure RegisterType(var S: TStreamRec);
var
  P: PStreamRec;
begin
  P := StreamTypes;
  while (P <> nil) and (P^.ObjType <> S.ObjType) do P := P^.Next;
  if (P <> nil) or (S.ObjType = 0) then RegisterError;
  S.Next := StreamTypes;
  StreamTypes := @S;
end;

{ TStream support routines }

const
  TStream_Error = vmtHeaderSize + $04;
  TStream_Flush = vmtHeaderSize + $08;
  TStream_Read  = vmtHeaderSize + $14;
  TStream_Write = vmtHeaderSize + $20;

{ Stream error handler                                  }
{ In    eax   = Error info                              }
{       dl    = Error code                              }
{       ecx   = Stream object pointer                   }
{ Uses  eax,edx                                         }

procedure DoStreamError; assembler; {$USES ecx} {$FRAME-}
asm
                movsx   edx,dl
                push    edx             { [1]:Integer = Code    }
                push    eax             { [2]:Integer = Info    }
                push    ecx             { [3]:Pointer = Self    }
                mov     eax,[ecx]
                Call    DWord Ptr [eax].TStream_Error
end;

{ TStream }

constructor TStream.Init;
begin
  TObject.Init;
  Status := 0;
  ErrorInfo := 0;
end;

procedure TStream.CopyFrom(var S: TStream; Count: Longint);
var
  N: Word;
  Buffer: array[0..1023] of Byte;
begin
  while Count > 0 do
  begin
    if Count > SizeOf(Buffer) then N := SizeOf(Buffer) else N := Count;
    S.Read(Buffer, N);
    Write(Buffer, N);
    Dec(Count, N);
  end;
end;

procedure TStream.Error(Code, Info: Integer);
type
  TErrorProc = procedure(var S: TStream);
begin
  Status := Code;
  ErrorInfo := Info;
  if StreamError <> nil then TErrorProc(StreamError)(Self);
end;

procedure TStream.Flush;
begin
end;

function TStream.Get: PObject; assembler; {$USES None} {$FRAME+}
asm
                push    eax
                mov     eax,esp
                push    eax                     { [1]:Pointer = Buf   }
                push    4                       { [2]:DWord   = Count }
                mov     eax,Self
                push    eax                     { [3]:Pointer = Self  }
                mov     eax,[eax]
                Call    DWord Ptr [eax].TStream_Read
                pop     eax
                test    eax,eax                 { Return nil }
                jz      @@4
                mov     edx,StreamTypes
                jmp     @@2
              @@1:
                cmp     eax,[edx].TStreamRec.ObjType
                je      @@3
                mov     edx,[edx].TStreamRec.Next
              @@2:
                test    edx,edx
                jnz     @@1
                mov     ecx,Self
                mov     dl,stGetError
                Call    DoStreamError
                xor     eax,eax                 { Return nil }
                jmp     @@4
              @@3:
                push    Self                    { [1]:Pointer = TStream }
                push    [edx].TStreamRec.VmtLink{ [2]:DWord   = VMT     }
                push    0                       { [3]:Pointer = Self = nil: allocate in dynamic memory }
                Call    [edx].TStreamRec.Load
              @@4:                              { Return Self or nil }
end;

function TStream.GetPos: Longint;
begin
  Abstract;
end;

function TStream.GetSize: Longint;
begin
  Abstract;
end;

procedure TStream.Put(P: PObject); assembler; {$USES None} {$FRAME+}
asm
                mov     ecx,P
                jecxz   @@4
                mov     eax,[ecx]               { VMT pointer }
                mov     edx,StreamTypes
                jmp     @@2
              @@1:
                cmp     eax,[edx].TStreamRec.VmtLink
                je      @@3
                mov     edx,[edx].TStreamRec.Next
              @@2:
                test    edx,edx
                jne     @@1
                mov     ecx,Self
                mov     dl,stPutError
                Call    DoStreamError
                jmp     @@5
              @@3:
                mov     ecx,[edx].TStreamRec.ObjType
              @@4:
                push    edx
                push    ecx                     { Write object type  }
                mov     eax,esp
                push    eax                     { [1]:Pointer = Buf  }
                push    4                       { [2]:DWord   = Size }
                mov     eax,Self                { [3]:Pointer = Self }
                push    eax
                mov     eax,[eax]
                Call    DWord Ptr [eax].TStream_Write
                pop     ecx
                pop     edx
                jecxz   @@5
                push    Self                    { [1]:Pointer = TStream }
                push    P                       { [2]:Pointer = Self    }
                Call    [edx].TStreamRec.Store
              @@5:
end;

procedure TStream.Read(var Buf; Count: Word);
begin
  Abstract;
end;

function TStream.ReadStr: PString;
var
  L: Byte;
  P: PString;
begin
  Read(L, 1);
  if L > 0 then
  begin
    GetMem(P, L + 1);
    P^[0] := Char(L);
    Read(P^[1], L);
    ReadStr := P;
  end else ReadStr := nil;
end;

procedure TStream.Reset;
begin
  Status := 0;
  ErrorInfo := 0;
end;

procedure TStream.Seek(Pos: Longint);
begin
  Abstract;
end;

function TStream.StrRead: PChar;
var
  L: Word;
  P: PChar;
begin
  Read(L, SizeOf(Word));
  if L = 0 then StrRead := nil else
  begin
    GetMem(P, L + 1);
    Read(P[0], L);
    P[L] := #0;
    StrRead := P;
  end;
end;

procedure TStream.StrWrite(P: PChar);
var
  L: Word;
begin
  if P = nil then L := 0 else L := StrLen(P);
  Write(L, SizeOf(Word));
  if P <> nil then Write(P[0], L);
end;

procedure TStream.Truncate;
begin
  Abstract;
end;

procedure TStream.Write(var Buf; Count: Word);
begin
  Abstract;
end;

procedure TStream.WriteStr(P: PString);
const
  Empty: String[1] = '';
begin
  if P <> nil then Write(P^, Length(P^) + 1) else Write(Empty, 1);
end;

{ TDosStream }

{$USES ebx,esi,edi} {$FRAME+}

constructor TDosStream.Init(FileName: FNameStr; Mode: Word); assembler;
var
  NameBuf: array[0..79] of Char;
asm
                push    0                       { [1]:DWord = VMT       }
                push    Self                    { [2]:Pointer = Self    }
                Call    TStream.Init            { Inherited Init;       }
                mov     esi,FileName
                lea     edi,NameBuf
                mov     edx,edi                 { edx = @FName (ASCIIZ) }
                xor     eax,eax
                cld
                lodsb
                cmp     al,79
                jb      @@1
                mov     al,79
              @@1:
                xchg    ecx,eax
                rep     movsb                   { File name             }
                xchg    eax,ecx
                stosb                           { Null terminator       }
                xor     ecx,ecx                 { ecx = File attribute  }
                mov     eax,Mode                { ah=DosFn,al=Open mode }
                Call    DosFn
                jnc     @@2                     { eax = File Handle     }
                mov     ecx,Self
                mov     dl,stInitError
                Call    DoStreamError
                or      eax,-1
              @@2:
                mov     ecx,Self
                mov     [ecx].TDosStream.Handle,eax
end;

destructor TDosStream.Done; assembler; {$USES ebx} {$FRAME+}
asm
                mov     eax,Self
                mov     ebx,[eax].TDosStream.Handle
                cmp     ebx,-1
                je      @@1
                mov     ah,3Eh                  { Close file            }
                Call    DosFn
              @@1:
                push    0                       { [1]:DWord = VMT       }
                push    Self                    { [2]:Pointer = Self    }
                Call    TStream.Done            { Inherited Done;       }
end;

function TDosStream.GetPos: Longint; assembler; {$USES ebx} {$FRAME-}
asm
                mov     eax,Self
                cmp     [eax].TDosStream.Status,stOk
                jne     @@1
                xor     ecx,ecx                 { ecx = Distance        }
                mov     ebx,[eax].TDosStream.Handle { ebx = File Handle }
                mov     ax,4201h                { Get current position  }
                Call    DosFn
                jnc     @@2
                mov     ecx,Self
                mov     dl,stError
                Call    DoStreamError           { eax = Current FilePtr }
              @@1:
                or      eax,-1
              @@2:
end;

function TDosStream.GetSize: Longint; assembler; {$USES ebx} {$FRAME-}
asm
                mov     eax,Self
                cmp     [eax].TDosStream.Status,stOk
                jne     @@1
                xor     ecx,ecx                 { ecx = Distance        }
                mov     ebx,[eax].TDosStream.Handle
                mov     ax,4201h                { ebx = Handle          }
                Call    DosFn
                push    eax                     { Save current position }
                xor     ecx,ecx
                mov     ax,4202h                { Move to the EOF       }
                Call    DosFn
                pop     ecx
                push    eax
                mov     ax,4200h                { Restore old position  }
                Call    DosFn
                pop     eax
                jnc     @@2
                mov     ecx,Self
                mov     dl,stError
                Call    DoStreamError
              @@1:
                or      eax,-1
              @@2:
end;

procedure TDosStream. Read (var Buf; Count: Word); assembler; {$USES ebx,edi} {$FRAME-}
asm
                mov     edi,Self
                cmp     [edi].TDosStream.Status,stOk
                jne     @@2
                mov     edx,Buf                 { edx = Buffer@         }
                mov     ecx,Count               { ecx = Count           }
                mov     ebx,[edi].TDosStream.Handle { ebx = File Handle }
                mov     ah,3Fh                  { Read file             }
                Call    DosFn
                mov     dl,stError
                jc      @@1
                cmp     eax,ecx
                je      @@3
                xor     eax,eax
                mov     dl,stReadError
              @@1:
                mov     ecx,edi
                Call    DoStreamError
              @@2:
                mov     edi,Buf
                mov     ecx,Count
                xor     al,al
                cld
                rep     stosb
              @@3:
end;

Procedure TDosStream. ReadBlock (Var Buf; Count: Word; Var BytesRead: Word);
Begin
  BytesRead := GetSize-GetPos;
  If BytesRead > Count Then BytesRead := Count;
  Read (Buf, BytesRead);
End;

procedure TDosStream. Seek (Pos: Longint); Assembler; {$USES ebx} {$FRAME-}
Asm
                mov     eax,Self
                cmp     [eax].TDosStream.Status,stOk
                jne     @@2
                mov     ecx,Pos
                test    ecx,ecx
                jns     @@1
                xor     ecx,ecx
              @@1:
                mov     ebx,[eax].TDosStream.Handle
                mov     ax,4200h
                Call    DosFn
                jnc     @@2
                mov     ecx,Self
                mov     dl,stError
                Call    DoStreamError
              @@2:
End;

Procedure TDosStream. Truncate; Assembler; {$USES ebx} {$FRAME-}
Asm
                mov     eax,Self
                cmp     [eax].TDosStream.Status,stOk
                jne     @@1
                xor     ecx,ecx                 { ecx=0: Truncate file  }
                mov     ebx,[eax].TDosStream.Handle
                mov     ah,40h                  { Write file            }
                Call    DosFn
                jnc     @@1
                mov     ecx,Self
                mov     dl,stError
                Call    DoStreamError
              @@1:
end;

procedure TDosStream.Write(var Buf; Count: Word); assembler; {$USES ebx} {$FRAME-}
asm
                mov     eax,Self
                cmp     [eax].TDosStream.Status,stOk
                jne     @@2
                mov     edx,Buf
                mov     ecx,Count
                mov     ebx,[eax].TDosStream.Handle
                mov     ah,40h
                Call    DosFn
                mov     dl,stError
                jc      @@1
                cmp     eax,ecx
                je      @@2
                xor     eax,eax
                mov     dl,stWriteError
              @@1:
                mov     ecx,Self
                Call    DoStreamError
              @@2:
end;

{ TBufStream }

{ Flush TBufStream buffer                               }
{ In    AL    = Flush mode (0=Read, 1=Write, 2=Both)    }
{       edi   = TBufStream pointer                      }
{ Out   ZF    = Status test                             }

procedure FlushBuffer; assembler; {$USES ebx} {$FRAME-}
asm
                mov     ecx,[edi].TBufStream.BufPtr
                sub     ecx,[edi].TBufStream.BufEnd
                je      @@3
                mov     ebx,[edi].TDosStream.Handle
                ja      @@1
                cmp     al,1
                je      @@4
                mov     ax,4201h                { Seek from current position }
                Call    DosFn
                jmp     @@3
              @@1:
                cmp     al,0
                je      @@4
                mov     edx,[edi].TBufStream.Buffer
                mov     ah,40h
                Call    DosFn
                mov     dl,stError
                jc      @@2
                cmp     eax,ecx
                je      @@3
                xor     eax,eax
                mov     dl,stWriteError
              @@2:
                mov     ecx,edi
                Call    DoStreamError
              @@3:
                xor     eax,eax
                mov     [edi].TBufStream.BufPtr,eax
                mov     [edi].TBufStream.BufEnd,eax
                cmp     [edi].TStream.Status,stOk
              @@4:
end;

constructor TBufStream.Init(const FileName: FNameStr; Mode, Size: Word);
begin
  TDosStream.Init(FileName, Mode);
  BufSize := Size;
  if Size = 0 then Error(stInitError, 0)
  else GetMem(Buffer, Size);
  BufPtr := 0;
  BufEnd := 0;
end;

destructor TBufStream.Done;
begin
  TBufStream.Flush;
  TDosStream.Done;
  If Buffer <> Nil Then FreeMem(Buffer, BufSize);
  Buffer := Nil;
end;

procedure TBufStream.Flush; assembler;  {$USES edi} {$FRAME-}
asm
                mov     edi,Self
                cmp     [edi].TBufStream.Status,stOk
                jne     @@1
                mov     al,2                    { Read/Write mode }
                Call    FlushBuffer
              @@1:
end;

function TBufStream.GetPos: Longint; assembler; {$USES edi} {$FRAME-}
asm
                mov     edi,Self
                push    edi
                Call    TDosStream.GetPos
                test    eax,eax
                js      @@1
                sub     eax,[edi].TBufStream.BufEnd
                add     eax,[edi].TBufStream.BufPtr
              @@1:
end;

function TBufStream.GetSize: Longint; assembler; {$USES None} {$FRAME-}
asm
                mov     eax,Self
                push    eax
                push    eax
                Call    TBufStream.Flush
                Call    TDosStream.GetSize
end;

procedure TBufStream.Read(var Buf; Count: Word); assembler; {$USES ebx,esi,edi} {$FRAME-}
asm
                mov     edi,Self
                cmp     [edi].TBufStream.Status,stOk
                jne     @@6
                mov     al,1                    { Write mode }
                Call    FlushBuffer
                jne     @@6
                xor     ebx,ebx
              @@1:
                mov     ecx,Count
                sub     ecx,ebx
                je      @@7
                mov     edi,Self
                mov     eax,[edi].TBufStream.BufEnd
                sub     eax,[edi].TBufStream.BufPtr
                ja      @@2
                push    ecx
                push    ebx
                mov     edx,[edi].TBufStream.Buffer
                mov     ecx,[edi].TBufStream.BufSize
                mov     ebx,[edi].TBufStream.Handle
                mov     ah,3Fh
                Call    DosFn
                pop     ebx
                pop     ecx
                mov     dl,stError
                jc      @@5
                and     [edi].TBufStream.BufPtr,0
                mov     [edi].TBufStream.BufEnd,eax
                test    eax,eax
                je      @@4
              @@2:
                cmp     ecx,eax
                jb      @@3
                mov     ecx,eax
              @@3:
                mov     esi,[edi].TBufStream.Buffer
                add     esi,[edi].TBufStream.BufPtr
                add     [edi].TBufStream.BufPtr,ecx
                mov     edi,Buf
                add     edi,ebx
                add     ebx,ecx
                cld
                rep     movsb
                jmp     @@1
              @@4:
                mov     dl,stReadError
              @@5:
                mov     ecx,edi
                Call    DoStreamError
              @@6:
                mov     edi,Buf
                mov     ecx,Count
                xor     al,al
                cld
                rep     stosb
              @@7:
end;

procedure TBufStream.Seek(Pos: Longint); assembler; {$USES edi} {$FRAME-}
asm
                mov     edi,Self
                push    edi
                Call    TDosStream.GetPos
                test    eax,eax
                js      @@2
                sub     eax,Pos
                jne     @@1
                test    eax,eax
                je      @@1
                mov     edx,[edi].TBufStream.BufEnd
                sub     edx,eax
                jb      @@1
                mov     [edi].TBufStream.BufPtr,edx
                jmp     @@2
              @@1:
                push    edi
                Call    TBufStream.Flush
                push    Pos
                push    edi
                Call    TDosStream.Seek
              @@2:
end;

procedure TBufStream.Truncate;
begin
  TBufStream.Flush;
  TDosStream.Truncate;
end;

procedure TBufStream.Write(var Buf; Count: Word); assembler; {$USES esi,edi} {$FRAME-}
asm
                mov     edi,Self
                cmp     [edi].TBufStream.Status,stOk
                jne     @@4
                mov     al,0                    { Read mode }
                Call    FlushBuffer
                jne     @@4
                xor     edx,edx
              @@1:
                mov     ecx,Count
                sub     ecx,edx
                je      @@4
                mov     edi,Self
                mov     eax,[edi].TBufStream.BufSize
                sub     eax,[edi].TBufStream.BufPtr
                ja      @@2
                push    ecx
                push    edx
                mov     al,1                    { Write mode }
                Call    FlushBuffer
                pop     edx
                pop     ecx
                jne     @@4
                mov     eax,[edi].TBufStream.BufSize
              @@2:
                cmp     ecx,eax
                jb      @@3
                mov     ecx,eax
              @@3:
                mov     eax,[edi].TBufStream.BufPtr
                add     [edi].TBufStream.BufPtr,ecx
                mov     edi,[edi].TBufStream.Buffer
                add     edi,eax
                mov     esi,Buf
                add     esi,edx
                add     edx,ecx
                cld
                rep     movsb
                jmp     @@1
              @@4:
end;

{ TMemoryStream }

const
  MaxBlockArraySize = 512 * 1024 * 1024 div 4;
  DefaultBlockSize = 8 * 1024;

{ Selects TMemoryStream memory block                            }
{ In    edi   = TMemoryStream pointer                           }
{ Out   ecx   = Distance between position and end of block      }
{       esi   = Position within the selected block              }

procedure MemSelectBlock; assembler; {$USES None} {$FRAME-}
asm
                mov     eax,[edi].TMemoryStream.Position
                xor     edx,edx
                mov     ecx,[edi].TMemoryStream.BlockSize
                div     ecx
                sub     ecx,edx
                mov     esi,edx
                shl     eax,2
                mov     [edi].TMemoryStream.CurBlock,eax
end;

const
  MemStreamSize = (SizeOf(TMemoryStream) - SizeOf(TStream)) div 2;

constructor TMemoryStream.Init(ALimit: Longint; ABlockSize: Word); assembler; {$USES edi} {$FRAME+}
asm
                push    0
                push    Self
                Call    TStream.Init
                mov     edi,Self
                cmp     ABlockSize,0
                jnz     @@1
                mov     ABlockSize,DefaultBlockSize
              @@1:
                mov     ecx,ABlockSize
                mov     eax,ALimit
                xor     edx,edx
                div     ecx
                neg     edx
                adc     eax,0
                mov     [edi].TMemoryStream.BlockSize,ecx
                push    eax                     { [1]:DWord = ALimit    }
                push    edi                     { [2]:Pointer = Self    }
                Call    ChangeListSize
                test    al,al
                jnz     @@2
                mov     dl,stInitError
                mov     ecx,edi
                Call    DoStreamError
                and     ALimit,0
              @@2:
                mov     eax,ALimit
                mov     [edi].TMemoryStream.Size,eax
end;

destructor TMemoryStream.Done;
begin
  ChangeListSize(0);
  inherited Done;
end;

function TMemoryStream.ChangeListSize(ALimit: Word): Boolean;
var
  AItems: PPtrArray;
  Dif, Term: Word;
  NewBlock: Pointer;
begin
  ChangeListSize := False;
  if ALimit > MaxBlockArraySize then ALimit := MaxBlockArraySize;
  if ALimit <> BlockCount then
  begin
    if ALimit = 0 then AItems := nil else
    begin
      AItems := MemAlloc(ALimit * SizeOf(Pointer));
      if AItems = nil then Exit;
      FillChar(AItems^, ALimit * SizeOf(Pointer), 0);
      if (BlockCount <> 0) and (BlockList <> nil) then
        if BlockCount > ALimit then
          Move(BlockList^, AItems^, ALimit * SizeOf(Pointer))
        else
          Move(BlockList^, AItems^, BlockCount * SizeOf(Pointer));
    end;
    if ALimit < BlockCount then
    begin
      Dif  := ALimit;
      Term := BlockCount - 1;
      while Dif <= Term do
      begin
        if BlockList^[Dif] <> nil Then Begin
          FreeMem(BlockList^[Dif], BlockSize);
          BlockList^[Dif] := Nil;
        End;
        Inc(Dif);
      end;
    end
    else
    begin
      Dif := BlockCount;
      Term := ALimit - 1;
      while Dif <= Term do
      begin
        NewBlock := MemAlloc(BlockSize);
        if NewBlock = nil then Break
        else AItems^[Dif] := NewBlock;
        Inc(Dif);
      end;
      if Dif = ALimit then
        ChangeListSize := True;
    end;
    if BlockCount <> 0 then FreeMem(BlockList, BlockCount * SizeOf(Pointer));
    BlockList := AItems;
    BlockCount := ALimit;
  end else ChangeListSize := True;
end;

function TMemoryStream.GetPos: Longint;
begin
  if Status = stOk then GetPos := Position else GetPos := -1;
end;

function TMemoryStream.GetSize: Longint;
begin
  if Status = stOk then GetSize := Size else GetSize := -1;
end;

procedure TMemoryStream.Read(var Buf; Count: Word); assembler; {$USES ebx,esi,edi} {$FRAME+}
asm
                mov     edi,Self
                cmp     [edi].TMemoryStream.Status,stOk
                jne     @@3
                xor     ebx,ebx
                mov     eax,[edi].TMemoryStream.Position
                add     eax,Count
                cmp     eax,[edi].TMemoryStream.Size
                jbe     @@7
                xor     eax,eax
                mov     ecx,edi
                mov     dl,stReadError
                Call    DoStreamError
              @@3:
                mov     edi,Buf
                mov     ecx,Count
                xor     al,al
                cld
                rep     stosb
                jmp     @@8
              @@5:
                Call    MemSelectBlock
                mov     eax,Count
                sub     eax,ebx
                cmp     ecx,eax
                jb      @@6
                mov     ecx,eax
              @@6:
                add     [edi].TMemoryStream.Position,ecx
                push    edi
                mov     edx,[edi].TMemoryStream.CurBlock
                mov     eax,[edi].TMemoryStream.BlockList
                add     esi,[eax+edx]           { Block base pointer }
                mov     edi,Buf
                add     edi,ebx
                add     ebx,ecx
                mov     al,cl
                shr     ecx,2
                and     al,11b
                cld
                rep     movsd
                mov     cl,al
                rep     movsb
                pop     edi
              @@7:
                cmp     ebx,Count
                jb      @@5
              @@8:
end;

procedure TMemoryStream.Seek(Pos: Longint);
begin
  if Status = stOk then
    if Pos > 0 then Position := Pos else Position := 0;
end;

procedure TMemoryStream.Truncate; assembler; {$USES None} {$FRAME-}
asm
                mov     ecx,Self
                cmp     [ecx].TMemoryStream.Status,stOk
                jne     @@2
                mov     eax,[ecx].TMemoryStream.Position
                xor     edx,edx
                div     [ecx].TMemoryStream.BlockSize
                neg     edx
                adc     eax,0
                push    eax                     { [1]:DWord = ALimit    }
                push    ecx                     { [2]:Pointer = Self    }
                Call    ChangeListSize
                mov     ecx,Self
                test    al,al
                jnz     @@1
                mov     dl,stError
                Call    DoStreamError
                jmp     @@2
              @@1:
                mov     eax,[ecx].TMemoryStream.Position
                mov     [ecx].TMemoryStream.Size,eax
              @@2:
end;

procedure TMemoryStream.Write(var Buf; Count: Word); assembler; {$USES ebx,esi,edi} {$FRAME+}
asm
                mov     edi,Self
                cmp     [edi].TMemoryStream.Status,stOk
                jne     @@7
                xor     ebx,ebx
                mov     eax,[edi].TMemoryStream.Position
                add     eax,Count
                xor     edx,edx
                div     [edi].TMemoryStream.BlockSize
                neg     edx
                adc     eax,0
                cmp     eax,[edi].TMemoryStream.BlockCount
                jbe     @@4
                push    eax                     { [1]:DWord = ALimit    }
                push    edi                     { [2]:Pointer = Self    }
                Call    ChangeListSize
                test    al,al
                jnz     @@4
              @@1:
                mov     ecx,edi
                mov     dl,stWriteError
                Call    DoStreamError
                jmp     @@7
              @@2:
                Call    MemSelectBlock
                mov     eax,Count
                sub     eax,ebx
                cmp     ecx,eax
                jb      @@3
                mov     ecx,eax
              @@3:
                add     [edi].TMemoryStream.Position,ecx
                push    edi
                mov     edx,[edi].TMemoryStream.CurBlock
                mov     eax,[edi].TMemoryStream.BlockList
                add     esi,[eax+edx]
                mov     edi,esi
                mov     esi,Buf
                add     esi,ebx
                add     ebx,ecx
                mov     al,cl
                shr     ecx,2
                and     al,11b
                cld
                rep     movsd
                mov     cl,al
                rep     movsb
                pop     edi
              @@4:
                cmp     ebx,Count
                jb      @@2
              @@5:
                mov     eax,[edi].TMemoryStream.Position
                cmp     eax,[edi].TMemoryStream.Size
                jbe     @@7
              @@6:
                mov     [edi].TMemoryStream.Size,eax
              @@7:
end;

{ TCollection }

const
  TCollection_Error    = vmtHeaderSize + $04;
  TCollection_SetLimit = vmtHeaderSize + $1C;

{ Reports collection error                                      }
{ In     al   = Error code                                      }
{       edx   = Error info                                      }
{       edi   = TCollection pointer                             }

procedure CollectionError; assembler; {$USES None} {$FRAME-}
asm
                movsx   eax,al
                push    eax                     { [1]:DWord = Error code }
                push    edx                     { [2]:DWord = Error info }
                push    edi                     { [3]:Pointer = Self     }
                mov     eax,[edi]
                Call    DWord Ptr [eax].TCollection_Error
end;

constructor TCollection.Init(ALimit, ADelta: Integer);
begin
  TObject.Init;
  Items := nil;
  Count := 0;
  Limit := 0;
  Delta := ADelta;
  SetLimit(ALimit);
end;

constructor TCollection.Load(var S: TStream);
var
  C, I: Integer;
begin
  S.Read(Count, SizeOf(Integer) * 3);
  Items := nil;
  C := Count;
  I := Limit;
  Count := 0;
  Limit := 0;
  SetLimit(I);
  Count := C;
  for I := 0 to C - 1 do AtPut(I, GetItem(S));
end;

destructor TCollection.Done;
begin
  FreeAll;
  SetLimit(0);
end;

function TCollection.At(Index: Integer): Pointer; assembler; {$USES edi} {$FRAME-}
asm
                mov     edi,Self
                mov     edx,Index
                test    edx,edx
                jl      @@1
                cmp     edx,[edi].TCollection.Count
                jge     @@1
                mov     edi,[edi].TCollection.Items
                mov     eax,[edi+edx*4]
                jmp     @@2
              @@1:
                mov     al,coIndexError
                Call    CollectionError
                xor     eax,eax
              @@2:
end;

procedure TCollection.AtDelete(Index: Integer); assembler; {$USES esi,edi} {$FRAME-}
asm
                mov     edi,Self
                mov     edx,Index
                test    edx,edx
                jl      @@1
                cmp     edx,[edi].TCollection.Count
                jge     @@1
                dec     [edi].TCollection.Count
                mov     ecx,[edi].TCollection.Count
                sub     ecx,edx
                je      @@2
                cld
                mov     edi,[edi].TCollection.Items
                lea     edi,[edi+edx*4]
                lea     esi,[edi+4]
                rep     movsd
                jmp     @@2
              @@1:
                mov     al,coIndexError
                Call    CollectionError
              @@2:
end;

procedure TCollection.AtFree(Index: Integer);
var
  Item: Pointer;
begin
  Item := At(Index);
  AtDelete(Index);
  FreeItem(Item);
end;

procedure TCollection.AtInsert(Index: Integer; Item: Pointer); assembler; {USES esi, edi} {$FRAME-}
asm
                mov     edi,Self
                mov     edx,Index
                test    edx,edx
                jl      @@3
                mov     ecx,[edi].TCollection.Count
                cmp     edx,ecx
                jg      @@3
                cmp     ecx,[edi].TCollection.Limit
                jne     @@1
                push    ecx
                push    edx
                add     ecx,[edi].TCollection.Delta
                push    ecx                     { [1]:DWord = ALimit    }
                push    edi                     { [2]:Pointer = Self    }
                mov     eax,[edi]
                Call    DWord Ptr [eax].TCollection_SetLimit
                pop     edx
                pop     ecx
                cmp     ecx,[edi].TCollection.Limit
                je      @@4
              @@1:
                inc     [edi].TCollection.Count
                std
                mov     edi,[edi].TCollection.Items
                lea     edi,[edi+ecx*4]
                sub     ecx,edx
                je      @@2
                lea     esi,[edi-4]
                rep     movsd
              @@2:
                mov     eax,Item
                stosd
                cld
                jmp     @@6
              @@3:
                mov     al,coIndexError
                jmp     @@5
              @@4:
                mov     al,coOverflow
                mov     edx,ecx
              @@5:
                Call    CollectionError
              @@6:
end;

procedure TCollection.AtPut(Index: Integer; Item: Pointer); assembler; {$USES edi} {$FRAME-}
asm
                mov     eax,Item
                mov     edi,Self
                mov     edx,Index
                test    edx,edx
                jl      @@1
                cmp     edx,[edi].TCollection.Count
                jge     @@1
                mov     edi,[edi].TCollection.Items
                mov     [edi+edx*4],eax
                jmp     @@2
              @@1:
                mov     al,coIndexError
                Call    CollectionError
              @@2:
end;

procedure TCollection.Delete(Item: Pointer);
begin
  AtDelete(IndexOf(Item));
end;

procedure TCollection.DeleteAll;
begin
  Count := 0;
end;

procedure TCollection.Error(Code, Info: Integer);
begin
  RunError (212 - Code);
end;

function TCollection.FirstThat(Test: Pointer): Pointer; assembler; {$USES ebx} {$FRAME-}
asm
                mov     edx,Self
                mov     ecx,[edx].TCollection.Count
                jecxz   @@3
                mov     ebx,Test
                mov     edx,[edx].TCollection.Items
              @@1:
                push    edx
                push    ecx
                push    DWord Ptr [edx]         { [1]:Pointer = Item }
                Call    ebx
                pop     ecx
                pop     edx
                test    al,al
                jnz     @@2
                add     edx,4
                loop    @@1
                jmp     @@3
              @@2:
                mov     ecx,[edx]
              @@3:
                mov     eax,ecx
end;

procedure TCollection.ForEach(Action: Pointer); assembler; {$USES ebx} {$FRAME-}
asm
                mov     edx,Self
                mov     ecx,[edx].TCollection.Count
                jecxz   @@2
                mov     ebx,Action
                mov     edx,[edx].TCollection.Items
              @@1:
                push    edx
                push    ecx
                push    DWord Ptr [edx]         { [1]:Pointer = Item }
                Call    ebx
                pop     ecx
                pop     edx
                add     edx,4
                loop    @@1
              @@2:
end;

procedure TCollection.Free(Item: Pointer);
begin
  Delete(Item);
  FreeItem(Item);
end;

procedure TCollection.FreeAll;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do FreeItem(At(I));
  Count := 0;
end;

procedure TCollection.FreeItem(Item: Pointer);
begin
  if Item <> nil then Dispose(PObject(Item), Done);
  Item := nil;
end;

function TCollection.GetItem(var S: TStream): Pointer;
begin
  GetItem := S.Get;
end;

function TCollection.IndexOf(Item: Pointer): Integer; assembler; {$USES edi} {$FRAME-}
asm
                mov     eax,Item
                mov     edi,Self
                mov     ecx,[edi].TCollection.Count
                jecxz   @@1
                mov     edi,[edi].TCollection.Items
                mov     edx,edi
                cld
                repne   scasd
                jne     @@1
                mov     eax,edi
                sub     eax,edx
                shr     eax,2
                dec     eax
                jmp     @@2
              @@1:
                xor     eax,eax
                dec     eax
              @@2:
end;

procedure TCollection.Insert(Item: Pointer);
begin
  AtInsert(Count, Item);
end;

function TCollection.LastThat(Test: Pointer): Pointer; assembler; {$USES ebx} {$FRAME-}
asm
                mov     edx,Self
                mov     ecx,[edx].TCollection.Count
                jecxz   @@3
                mov     edx,[edx].TCollection.Items
                lea     edx,[edx+ecx*4]
                mov     ebx,Test
              @@1:
                sub     edx,4
                push    edx
                push    ecx
                push    DWord Ptr [edx]         { [1]:Pointer = Item }
                Call    ebx
                pop     ecx
                pop     edx
                test    al,al
                jnz     @@2
                loop    @@1
                jmp     @@3
              @@2:
                mov     ecx,[edx]
              @@3:
                mov     eax,ecx
end;

procedure TCollection.Pack; assembler; {$USES esi,edi} {$FRAME-}
asm
                mov     edx,Self
                mov     ecx,[edx].TCollection.Count
                jecxz   @@3
                mov     edi,[edx].TCollection.Items
                mov     esi,edi
                cld
              @@1:
                lodsd
                test    eax,eax
                jz      @@2
                stosd
              @@2:
                loop    @@1
                sub     edi,[edx].TCollection.Items
                shr     edi,2
                mov     [edx].TCollection.Count,edi
              @@3:
end;

procedure TCollection.PutItem(var S: TStream; Item: Pointer);
begin
  S.Put(Item);
end;

procedure TCollection.SetLimit(ALimit: Integer);
var
  AItems: PItemList;
begin
  if ALimit < Count then ALimit := Count;
  if ALimit > MaxCollectionSize then ALimit := MaxCollectionSize;
  if ALimit <> Limit then
  begin
    if ALimit = 0 then AItems := nil else
    begin
      GetMem(AItems, ALimit * SizeOf(Pointer));
      if (Count <> 0) and (Items <> nil) then
        Move(Items^, AItems^, Count * SizeOf(Pointer));
    end;
    if Limit <> 0 then FreeMem(Items, Limit * SizeOf(Pointer));
    Items := AItems;
    Limit := ALimit;
  end;
end;

procedure TCollection.Store(var S: TStream);

procedure DoPutItem(P: Pointer);
begin
  PutItem(S, P);
end;

begin
  S.Write(Count, SizeOf(Integer) * 3);
  ForEach(@DoPutItem);
end;

{ TSortedCollection }

constructor TSortedCollection.Init(ALimit, ADelta: Integer);
begin
  TCollection.Init(ALimit, ADelta);
  Duplicates := False;
end;

constructor TSortedCollection.Load(var S: TStream);
begin
  TCollection.Load(S);
  S.Read(Duplicates, SizeOf(Boolean));
end;

function TSortedCollection.Compare(Key1, Key2: Pointer): Integer;
begin
  Abstract;
end;

function TSortedCollection.IndexOf(Item: Pointer): Integer;
var
  I: Integer;
begin
  IndexOf := -1;
  if Search(KeyOf(Item), I) then
  begin
    if Duplicates then
      while (I < Count) and (Item <> Items^[I]) do Inc(I);
    if I < Count then IndexOf := I;
  end;
end;

procedure TSortedCollection.Insert(Item: Pointer);
var
  I: Integer;
begin
  if not Search(KeyOf(Item), I) or Duplicates then AtInsert(I, Item);
end;

function TSortedCollection.KeyOf(Item: Pointer): Pointer;
begin
  KeyOf := Item;
end;

function TSortedCollection.Search(Key: Pointer; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  Search := False;
  L := 0;
  H := Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := Compare(KeyOf(Items^[I]), Key);
    if C < 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Search := True;
        if not Duplicates then L := I;
      end;
    end;
  end;
  Index := L;
end;

procedure TSortedCollection.Store(var S: TStream);
begin
  TCollection.Store(S);
  S.Write(Duplicates, SizeOf(Boolean));
end;

{ TStringCollection }

{$USES esi,edi} {$FRAME-}

function TStringCollection.Compare(Key1, Key2: Pointer): Integer; assembler;
asm
                cld
                xor     eax,eax
                xor     edx,edx
                mov     esi,Key1
                mov     edi,Key2
                lodsb
                mov     dl,[edi]
                inc     edi
                mov     ecx,eax
                cmp     cl,dl
                jbe     @@1
                mov     cl,dl
              @@1:
                repe    cmpsb
                je      @@2
                mov     al,[esi-1]
                mov     dl,[edi-1]
              @@2:
                sub     eax,edx
end;

procedure TStringCollection.FreeItem(Item: Pointer);
begin
  DisposeStr(Item);
end;

function TStringCollection.GetItem(var S: TStream): Pointer;
begin
  GetItem := S.ReadStr;
end;

procedure TStringCollection.PutItem(var S: TStream; Item: Pointer);
begin
  S.WriteStr(Item);
end;

{ TStrCollection }

function TStrCollection.Compare(Key1, Key2: Pointer): Integer;
begin
  Compare := StrComp(Key1, Key2);
end;

procedure TStrCollection.FreeItem(Item: Pointer);
begin
  StrDispose(Item);
end;

function TStrCollection.GetItem(var S: TStream): Pointer;
begin
  GetItem := S.StrRead;
end;

procedure TStrCollection.PutItem(var S: TStream; Item: Pointer);
begin
  S.StrWrite(Item);
end;

{ Private resource manager types }

const
  RStreamMagic: Longint = $52504246; { 'FBPR' }
  RStreamBackLink: Longint = $4C424246; { 'FBBL' }

type
  PResourceItem = ^TResourceItem;
  TResourceItem = record
    Pos: Longint;
    Size: Longint;
    Key: String;
  end;

{ TResourceCollection }

procedure TResourceCollection.FreeItem(Item: Pointer);
begin
  If Item <> Nil Then FreeMem(Item, Length(PResourceItem(Item)^.Key) +
    (SizeOf(TResourceItem) - SizeOf(String) + 1));
  Item := Nil;
end;

function TResourceCollection.GetItem(var S: TStream): Pointer;
var
  Pos: Longint;
  Size: Longint;
  L: Byte;
  P: PResourceItem;
begin
  S.Read(Pos, SizeOf(Longint));
  S.Read(Size, SizeOf(Longint));
  S.Read(L, 1);
  GetMem(P, L + (SizeOf(TResourceItem) - SizeOf(String) + 1));
  P^.Pos := Pos;
  P^.Size := Size;
  P^.Key[0] := Char(L);
  S.Read(P^.Key[1], L);
  GetItem := P;
end;

function TResourceCollection.KeyOf(Item: Pointer): Pointer; assembler; {$USES None} {$FRAME-}
asm
                mov     eax,Item
                add     eax,OFFSET TResourceItem.Key
end;

procedure TResourceCollection.PutItem(var S: TStream; Item: Pointer);
begin
  S.Write(PResourceItem(Item)^, Length(PResourceItem(Item)^.Key) +
    (SizeOf(TResourceItem) - SizeOf(String) + 1));
end;

{ TResourceFile }

constructor TResourceFile.Init(AStream: PStream);
type

  TExeHeader = record
    eHdrSize:   SmallWord;
    eMinAbove:  SmallWord;
    eMaxAbove:  SmallWord;
    eInitSS:    SmallWord;
    eInitSP:    SmallWord;
    eCheckSum:  SmallWord;
    eInitPC:    SmallWord;
    eInitCS:    SmallWord;
    eRelocOfs:  SmallWord;
    eOvlyNum:   SmallWord;
    eRelocTab:  SmallWord;
    eSpace:     array [1..30] of Byte;
    eNewHeader: Word;
  end;

  THeader = record
    Signature: SmallWord;
    case Integer of
      0: (
        LastCount: SmallWord;
        PageCount: SmallWord;
        ReloCount: SmallWord);
      1: (
        InfoType: SmallWord;
        InfoSize: Longint);
  end;
var
  Found, Stop: Boolean;
  Header: THeader;

  ExeHeader: TExeHeader;

begin
  TObject.Init;
  Stream := AStream;
  BasePos := Stream^.GetPos;
  Found := False;
  repeat
    Stop := True;
    if BasePos <= Stream^.GetSize - SizeOf(THeader) then
    begin
      Stream^.Seek(BasePos);
      Stream^.Read(Header, SizeOf(THeader));
      case Header.Signature of

        $5A4D:                                  { 'MZ' }
          begin
            Stream^.Read(ExeHeader, SizeOf(TExeHeader));
            BasePos := ExeHeader.eNewHeader;
            Stop := False;
          end;
        $584C:                                  { 'LX' }
          begin
            BasePos := Stream^.GetSize - 8;
            Stop := False;
          end;
        $4246:                                  { 'FB' }
          begin
            Stop := False;
            case Header.Infotype of
              $5250:                            {'PR': Found Resource}
                begin
                  Found := True;
                  Stop := True;
                end;
              $4C42: Dec(BasePos, Header.InfoSize - 8); {'BL': Found BackLink}
              $4648: Dec(BasePos, SizeOf(THeader) * 2); {'HF': Found HelpFile}
            else
              Stop := True;
            end;
          end;
        $424E:                                  { 'NB' }
          if Header.InfoType = $3230 then       { '02': Found Debug Info}
          begin
            Dec(BasePos, Header.InfoSize);
            Stop := False;
          end;
      end;
    end;
  until Stop;
  if Found then
  begin
    Stream^.Seek(BasePos + SizeOf(Longint) * 2);
    Stream^.Read(IndexPos, SizeOf(Longint));
    Stream^.Seek(BasePos + IndexPos);
    Index.Load(Stream^);
  end else
  begin
    IndexPos := SizeOf(Longint) * 3;
    Index.Init(0, 8);
  end;
end;

destructor TResourceFile.Done;
begin
  Flush;
  Index.Done;
  Dispose(Stream, Done);
end;

function TResourceFile.Count: Integer;
begin
  Count := Index.Count;
end;

procedure TResourceFile.Delete(Key: String);
var
  I: Integer;
begin
  if Index.Search(@Key, I) then
  begin
    Index.Free(Index.At(I));
    Modified := True;
  end;
end;

procedure TResourceFile.Flush;
var
  ResSize: Longint;
  LinkSize: Longint;
begin
  if Modified then
  begin
    Stream^.Seek(BasePos + IndexPos);
    Index.Store(Stream^);
    ResSize := Stream^.GetPos - BasePos;
    LinkSize := ResSize + SizeOf(Longint) * 2;
    Stream^.Write(RStreamBackLink, SizeOf(Longint));
    Stream^.Write(LinkSize, SizeOf(Longint));
    Stream^.Seek(BasePos);
    Stream^.Write(RStreamMagic, SizeOf(Longint));
    Stream^.Write(ResSize, SizeOf(Longint));
    Stream^.Write(IndexPos, SizeOf(Longint));
    Stream^.Flush;
    Modified := False;
  end;
end;

function TResourceFile.Get(Key: String): PObject;
var
  I: Integer;
begin
  if not Index.Search(@Key, I) then Get := nil else
  begin
    Stream^.Seek(BasePos + PResourceItem(Index.At(I))^.Pos);
    Get := Stream^.Get;
  end;
end;

function TResourceFile.KeyAt(I: Integer): String;
begin
  KeyAt := PResourceItem(Index.At(I))^.Key;
end;

procedure TResourceFile.Put(Item: PObject; Key: String);
var
  I: Integer;
  P: PResourceItem;
begin
  if Index.Search(@Key, I) then P := Index.At(I) else
  begin
    GetMem(P, Length(Key) + (SizeOf(TResourceItem) - SizeOf(String) + 1));
    P^.Key := Key;
    Index.AtInsert(I, P);
  end;
  P^.Pos := IndexPos;
  Stream^.Seek(BasePos + IndexPos);
  Stream^.Put(Item);
  IndexPos := Stream^.GetPos - BasePos;
  P^.Size := IndexPos - P^.Pos;
  Modified := True;
end;

function TResourceFile.SwitchTo(AStream: PStream; Pack: Boolean): PStream;
var
  NewBasePos: Longint;

procedure DoCopyResource(Item: PResourceItem);
begin
  Stream^.Seek(BasePos + Item^.Pos);
  Item^.Pos := AStream^.GetPos - NewBasePos;
  AStream^.CopyFrom(Stream^, Item^.Size);
end;

begin
  SwitchTo := Stream;
  NewBasePos := AStream^.GetPos;
  if Pack then
  begin
    AStream^.Seek(NewBasePos + SizeOf(Longint) * 3);
    Index.ForEach(@DoCopyResource);
    IndexPos := AStream^.GetPos - NewBasePos;
  end else
  begin
    Stream^.Seek(BasePos);
    AStream^.CopyFrom(Stream^, IndexPos);
  end;
  Stream := AStream;
  Modified := True;
  BasePos := NewBasePos;
end;

{ TStringList }

constructor TStringList.Load(var S: TStream);
var
  Size: Word;
begin
  Stream := @S;
  S.Read(Size, SizeOf(Word));
  BasePos := S.GetPos;
  S.Seek(BasePos + Size);
  S.Read(IndexSize, SizeOf(Integer));
  GetMem(Index, IndexSize * SizeOf(TStrIndexRec));
  S.Read(Index^, IndexSize * SizeOf(TStrIndexRec));
end;

destructor TStringList.Done;
begin
  If Index <> Nil Then FreeMem(Index, IndexSize * SizeOf(TStrIndexRec));
  Index := Nil;
end;

function TStringList.Get(Key: Word): String; assembler; {$USES ebx,esi,edi} {$FRAME+}
asm
                mov     esi,Self
                mov     edi,@Result
                cld
                mov     ecx,[esi].TStringList.IndexSize
                jecxz   @@2
                mov     ebx,Key
                mov     esi,[esi].TStringList.Index
              @@1:
                mov     edx,ebx
                lodsd
                sub     edx,eax
                lodsd
                cmp     edx,eax
                lodsd
                jb      @@3
                loop    @@1
              @@2:
                xor     al,al                   { Empty string }
                stosb
                jmp     @@4
              @@3:
                push    edi                     { [1]:Pointer = String  }
                push    eax                     { [2]:DWord   = Offset  }
                push    edx                     { [3]:DWord   = Skip    }
                push    Self                    { [4]:Pointer = Self    }
                Call    TStringList.ReadStr
              @@4:
end;

procedure TStringList.ReadStr(var S: String; Offset, Skip: Word);
begin
  Stream^.Seek(BasePos + Offset);
  Inc(Skip);
  repeat
    Stream^.Read(S[0], 1);
    Stream^.Read(S[1], Ord(S[0]));
    Dec(Skip);
  until Skip = 0;
end;

{ TStrListMaker }

constructor TStrListMaker.Init(AStrSize, AIndexSize: Word);
begin
  TObject.Init;
  StrSize := AStrSize;
  IndexSize := AIndexSize;
  GetMem(Strings, AStrSize);
  GetMem(Index, AIndexSize * SizeOf(TStrIndexRec));
end;

destructor TStrListMaker.Done;
begin
  If Index <> Nil Then FreeMem(Index, IndexSize * SizeOf(TStrIndexRec));
  If Strings <> Nil Then FreeMem(Strings, StrSize);
  Index := Nil;
  Strings := Nil;
end;

procedure TStrListMaker.CloseCurrent;
begin
  if Cur.Count <> 0 then
  begin
    Index^[IndexPos] := Cur;
    Inc(IndexPos);
    Cur.Count := 0;
  end;
end;

procedure TStrListMaker.Put(Key: Word; S: String);
begin
  if (Cur.Count = 16) or (Key <> Cur.Key + Cur.Count) then CloseCurrent;
  if Cur.Count = 0 then
  begin
    Cur.Key := Key;
    Cur.Offset := StrPos;
  end;
  Inc(Cur.Count);
  Move(S, Strings^[StrPos], Length(S) + 1);
  Inc(StrPos, Length(S) + 1);
end;

procedure TStrListMaker.Store(var S: TStream);
begin
  CloseCurrent;
  S.Write(StrPos, SizeOf(Word));
  S.Write(Strings^, StrPos);
  S.Write(IndexPos, SizeOf(Word));
  S.Write(Index^, IndexPos * SizeOf(TStrIndexRec));
end;

{ TRect }

procedure CheckEmpty; assembler; {$USES None} {$FRAME-}
asm
                mov     eax,[edi].TRect.A.X
                cmp     eax,[edi].TRect.B.X
                jge     @@1
                mov     eax,[edi].TRect.A.Y
                cmp     eax,[edi].TRect.B.Y
                jl      @@2
              @@1:
                cld
                xor     eax,eax
                stosd
                stosd
                stosd
                stosd
              @@2:
end;

procedure TRect.Assign(XA, YA, XB, YB: Integer); assembler; {$USES edi} {$FRAME-}
asm
                mov     edi,Self
                cld
                mov     eax,XA
                stosd
                mov     eax,YA
                stosd
                mov     eax,XB
                stosd
                mov     eax,YB
                stosd
end;

procedure TRect.Copy(R: TRect); assembler; {$USES esi,edi} {$FRAME-}
asm
                mov     esi,R
                mov     edi,Self
                cld
                movsd
                movsd
                movsd
                movsd
end;

procedure TRect.Move(ADX, ADY: Integer); assembler; {$USES None} {$FRAME-}
asm
                mov     ecx,Self
                mov     eax,ADX
                add     [ecx].TRect.A.X,eax
                add     [ecx].TRect.B.X,eax
                mov     eax,ADY
                add     [ecx].TRect.A.Y,eax
                add     [ecx].TRect.B.Y,eax
end;

procedure TRect.Grow(ADX, ADY: Integer); assembler; {$USES edi} {$FRAME-}
asm
                mov     edi,Self
                mov     eax,ADX
                sub     [edi].TRect.A.X,eax
                add     [edi].TRect.B.X,eax
                mov     eax,ADY
                sub     [edi].TRect.A.Y,eax
                add     [edi].TRect.B.Y,eax
                Call    CheckEmpty
end;

procedure TRect.Intersect(R: TRect); assembler; {$USES esi,edi} {$FRAME-}
asm
                mov     esi,R
                mov     edi,Self
                cld
                lodsd
                scasd
                jle     @@1
                sub     edi,4
                stosd
              @@1:
                lodsd
                scasd
                jle     @@2
                sub     edi,4
                stosd
              @@2:
                lodsd
                scasd
                jge     @@3
                sub     edi,4
                stosd
              @@3:
                lodsd
                scasd
                jge     @@4
                sub     edi,4
                stosd
              @@4:
                sub     edi,TYPE TRect
                Call    CheckEmpty
end;

procedure TRect.Union(R: TRect); assembler; {$USES esi,edi} {$FRAME-}
asm
                mov     esi,R
                mov     edi,Self
                cld
                lodsd
                scasd
                jge     @@1
                sub     edi,4
                stosd
              @@1:
                lodsd
                scasd
                jge     @@2
                sub     edi,4
                stosd
              @@2:
                lodsd
                scasd
                jle     @@3
                sub     edi,4
                stosd
              @@3:
                lodsd
                scasd
                jle     @@4
                sub     edi,4
                stosd
              @@4:
end;

function TRect.Contains(P: TPoint): Boolean; assembler; {$USES None} {$FRAME-}
asm
                mov     ecx,Self
                mov     al,0
                mov     edx,P.X
                cmp     edx,[ecx].TRect.A.X
                jl      @@1
                cmp     edx,[ecx].TRect.B.X
                jge     @@1
                mov     edx,P.Y
                cmp     edx,[ecx].TRect.A.Y
                jl      @@1
                cmp     edx,[ecx].TRect.B.Y
                setl    al
              @@1:
end;

function TRect.Equals(R: TRect): Boolean; assembler; {$USES esi,edi} {$FRAME-}
asm
                mov     esi,R
                mov     edi,Self
                mov     ecx,4
                cld
                repe    cmpsd
                sete    al
end;

function TRect.Empty: Boolean; assembler;
asm
                mov     ecx,Self
                mov     al,1
                mov     edx,[ecx].TRect.A.X
                cmp     edx,[ecx].TRect.B.X
                jge     @@1
                mov     edx,[ecx].TRect.A.Y
                cmp     edx,[ecx].TRect.B.Y
                setge   al
              @@1:
end;

{ Dynamic string handling routines }

function NewStr(const S: String): PString;
var
  P: PString;
begin
  if S = '' then P := nil else
  begin
    GetMem(P, Length(S) + 1);
    P^ := S;
  end;
  NewStr := P;
end;

procedure DisposeStr(P: PString);
begin
  if P <> nil Then FreeMem(P, Length(P^) + 1);
  P := Nil;
end;

{ Objects registration procedure }

procedure RegisterObjects;
begin
  RegisterType(RCollection);
  RegisterType(RStringCollection);
  RegisterType(RStrCollection);
end;

{ Peforms services analogous to DOS INT 21h Fns: 3Ch,3Dh,3Eh,3Fh,40h,42h }

procedure DosFn; assembler; {$USES ecx} {$FRAME+}
var
  Written,NewPtr,Handle,Result,Fn: Longint;
asm
                cmp     ah,42h
                je      @@Seek
                cmp     ah,3Fh
                je      @@Read
                cmp     ah,40h
                je      @@Write
                cmp     ah,3Eh
                je      @@Close         { 3Ch, 3Dh                      }
{ Open or create file}
                mov     Fn,eax
                push    0               { [8]:Pointer = @EAs            }
                or      al,40h          { Deny none                     }
                cmp     ah,3Ch
                jne     @@1
                mov     al,42h          { Create: Read/Write access     }
              @@1:
                movzx   eax,al
                push    eax             { [7]:DWord = OpenMode          }
                mov     al,1            { If file exist, open it        }
                cmp     Fn.Byte[1],3Dh
                je      @@2
                mov     al,12h          { If file doesn't exist, create it, if exist truncate }
              @@2:
                push    eax             { [6]:DWord = OpenFlags         }
                push    ecx             { [5]:DWord = Attr              }
                push    0               { [4]:DWord = File Size         }
                lea     eax,Result      { [3]:Pointer =  @OpenResult    }
                push    eax
                lea     eax,Handle      { [2]:Pointer = @Handle         }
                push    eax
                push    edx             { [1]:Pointer = file name       }
                Call    DosOpen
                add     esp,8*4         { Stack cleanup after "C" call  }
                test    eax,eax
                stc
                jnz     @@RET
                mov     eax,Handle
                jmp     @@OK
{ Seek file }
              @@Seek:
                lea     edx,NewPtr      { [4]:Pointer = @NewPtr         }
                push    edx
                movzx   eax,al          { [3]:DWord = Method            }
                push    eax
                push    ecx             { [2]:DWord = Distance          }
                push    ebx             { [1]:DWord = File Handle       }
                Call    DosSetFilePtr
                add     esp,4*4         { Stack cleanup after "C" call  }
                test    eax,eax
                stc
                jnz     @@RET
                mov     eax,NewPtr
                jmp     @@OK
{ Read file }
              @@Read:
                lea     eax,Written     { [4]:Pointer = @BytesRead      }
                push    eax
                push    ecx             { [3]:DWord   = ReadCount       }
                push    edx             { [2]:Pointer = @Buffer         }
                push    ebx             { [1]:DWord = File Handle       }
                Call    DosRead
                jmp     @@3
{ Write file }
              @@Write:
                jecxz   @@Truncate
                lea     eax,Written
                push    eax             { [4]:Pointer = @BytesWritten   }
                push    ecx             { [3]:DWord   = WriteCount      }
                push    edx             { [2]:Pointer = @Buffer         }
                push    ebx             { [1]:DWord = File Handle       }
                Call    DosWrite
              @@3:
                add     esp,4*4         { Stack cleanup after "C" call  }
                test    eax,eax
                stc
                jnz     @@RET
                mov     eax,Written
                jmp     @@OK
{ Write 0 bytes = Truncate file }
              @@Truncate:               { Seek mode: Current Pointer    }
                mov     ax,4201h        { ebx = Handle                  }
                Call    DosFn           { ecx = 0 = Distance            }
                jc      @@RET           { eax = Current File Pointer    }
                push    eax             { [2]:Longint = New File Size   }
                push    ebx             { [1]:Longint = File Handle     }
                Call    DosSetFileSize
                add     esp,2*4
                test    eax,eax
                stc
                jnz     @@RET
                jmp     @@OK
{ Close file }
              @@Close:
                push    ebx             { [1]:DWord = File Handle       }
                Call    DosClose
                test    eax,eax
                stc
                jnz     @@RET
              @@OK:
                clc
              @@RET:
end;

{$ENDIF}

{$IFDEF WIN32}

Interface

Uses
  Classes,
  Consts,
  TypInfo;

const

{ TStream access modes }

  stCreate    = $3C00;           { Create new file }
  stOpenRead  = $3D00;           { Read access only }
  stOpenWrite = $3D01;           { Write access only }
  stOpen      = $3D02;           { Read and write access }

{ TStream error codes }

  stOk         =  0;              { No error }
  stError      = -1;              { Access error }
  stInitError  = -2;              { Cannot initialize stream }
  stReadError  = -3;              { Read beyond end of stream }
  stWriteError = -4;              { Cannot expand stream }
  stGetError   = -5;              { Get of unregistered object type }
  stPutError   = -6;              { Put of unregistered object type }

{ Maximum TCollection size }

  MaxCollectionSize = 512*1024*1024 div SizeOf(Pointer);

{ TCollection error codes }

  coIndexError = -1;              { Index out of range }
  coOverflow   = -2;              { Overflow }

Type
  tMatchProc = Function (P : Pointer): Boolean;
  pEachProc = ^tEachProc;
  tEachProc = Procedure (P: Pointer);

  TTList = class(TObject)
    FList: PPointerList;
    FCount: Integer;
    FCapacity: Integer;
    procedure Error; virtual;
    function Get(Index: Integer): Pointer;
    procedure Grow; virtual;
    procedure Put(Index: Integer; Item: Pointer);
    procedure SetCapacity(NewCapacity: Integer);
    procedure SetCount(NewCount: Integer);
    destructor Destroy; override;
    function Add(Item: Pointer): Integer;
    procedure Clear;
    procedure Delete(Index: Integer);
    procedure Exchange(Index1, Index2: Integer);
    function Expand: TTList;
    function First: Pointer;
    function IndexOf(Item: Pointer): Integer;
    procedure Insert(Index: Integer; Item: Pointer);
    function Last: Pointer;
    procedure Move(CurIndex, NewIndex: Integer);
    function Remove(Item: Pointer): Integer;
    procedure Pack;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount write SetCount;
    property Items[Index: Integer]: Pointer read Get write Put; default;
    property List: PPointerList read FList;
  end;

  PWNotSortedCollection = ^TWNotSortedCollection;
  TWNotSortedCollection = Object
    Lst : TTList;
    Count : Integer;
    Function At (i: LongInt): Pointer;
    Procedure Insert (P: Pointer); Virtual;
    Procedure AtPut (N: LongInt; P: Pointer); Virtual;
    Procedure AtInsert (N: LongInt; P: Pointer); Virtual;
    Procedure AtDelete (N: LongInt);
    Procedure AtFree (N: LongInt);
    Function FirstThat (MatchProc: tMatchProc): Pointer;
    Procedure ForEach (EachProc: pEachProc);
    Constructor Init (N1, N2: LongInt);
    Constructor Load (var S: TStream);
    Destructor Done;
    Procedure Store (Var S: TStream);
    Function GetItem (Var S: TStream): Pointer;
    Procedure PutItem (Var S: TStream; P: Pointer);
    Procedure FreeAll;
    Procedure DeleteAll;
  End;

  PCollection = ^TCollection;
  TCollection = TWNotSortedCollection;

  PSortedCollection = ^TSortedCollection;
  TSortedCollection = Object (TWNotSortedCollection)
    Constructor Init (N1, N2: LongInt);
    Destructor Done;
    Procedure AtInsert (N: LongInt; P: Pointer); Virtual;
    Procedure Insert (P: Pointer); Virtual;
    Procedure AtPut (N: LongInt; P: Pointer); Virtual;
    Function Compare (Item1, Item2: Pointer): Integer; Virtual;
    Procedure QuickSort (L, R: Integer);
    Function KeyOf (Item: Pointer): Pointer; Virtual;
    Function Search (Key: Pointer; Var Index: Integer): Boolean; Virtual;
  End;

{ DOS file name string }
  FNameStr = String;

{ TDosStream }
  TWDosStream = class(TFileStream)
(*
    Handle: Word;
    constructor Init(FileName: FNameStr; Mode: 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 ReadBlock (Var Buf; Count: Word; Var BytesRead: Word);
*)
  end;
  PDosStream = ^TDosStream;
  TDosStream = TWDosStream;


Implementation

Constructor TWNotSortedCollection. Init (N1, N2: LongInt);
Begin
  Lst := TTList. Create;
  Count := 0;
End;

Constructor TWNotSortedCollection. Load (var S: TStream);
Var
  C, i : Integer;

Begin
  S. Read (C, SizeOf (Integer) * 3);
  For i := 0 to C-1 Do Insert (GetItem (S));
End;

Procedure TWNotSortedCollection. Store (Var S: TStream);
Var
  C : Integer;

  Procedure DoPutItem (P: Pointer); Far;
  Begin
    PutItem (S, P);
  End;

Begin
  C := Count;
  S. Write (C, SizeOf (Integer) * 3);
  ForEach (@DoPutItem);
End;

Function TWNotSortedCollection. GetItem (Var S: TStream): Pointer;
Begin
  GetItem := S. ReadComponent (nil);
End;

Procedure TWNotSortedCollection. PutItem (Var S: TStream; P: Pointer);
Begin
  S. WriteComponent (P);
End;

Constructor TSortedCollection. Init (N1, N2: LongInt);
Begin
  Inherited Init (N1, N2);
End;

Function TWNotSortedCollection. At (i: LongInt): Pointer;
Begin
  At := Lst. Items [i];
End;

Function TWNotSortedCollection. FirstThat (MatchProc: tMatchProc): Pointer;
Var
  i : LongInt;

Begin
  FirstThat := Nil;

  For i := 0 To Count-1 Do
  If MatchProc (At (i)) Then
  Begin
    FirstThat := At (i);
    Exit;
  End;
End;

Procedure TWNotSortedCollection. ForEach (EachProc: pEachProc);
Var
  i : LongInt;

Begin
  For i := 0 To Count-1 Do EachProc^ (At (i));
End;

Procedure TWNotSortedCollection. Insert (P: Pointer);
Begin
  Lst. Add (P);
  Count := Lst. Count;
End;

Procedure TWNotSortedCollection. AtPut (N: LongInt; P: Pointer);
Begin
  Dispose (Lst. Items [N]);
  Lst. Delete (N);
  Lst. Insert (N, P);
  Count := Lst. Count;
End;

Procedure TWNotSortedCollection. AtInsert (N: LongInt; P: Pointer);
Begin
  Lst. Insert (N, P);
  Count := Lst. Count;
End;

Procedure TWNotSortedCollection. AtDelete (N: LongInt);
Begin
  Lst. Delete (N);
  Count := Lst. Count;
End;

Procedure TWNotSortedCollection. AtFree (N: LongInt);
Begin
  Dispose (Lst. Items [N]);
  Lst. Delete (N);
  Count := Lst. Count;
End;

Procedure TWNotSortedCollection. FreeAll;
Begin
  Lst. Clear;
  Count := Lst. Count;
End;

Procedure TWNotSortedCollection. DeleteAll;
Begin
  Lst. Clear;
  Count := Lst. Count;
End;

Destructor TWNotSortedCollection. Done;
Begin
  Lst. Destroy;
End;

Destructor TSortedCollection. Done;
Begin
  Inherited Done;
End;

Procedure TSortedCollection. Insert (P: Pointer);
Begin
  Inherited Insert (P);
  If (Lst. FList <> nil) And (Lst. Count > 0) Then QuickSort (0, Lst. Count - 1);
End;

Procedure TSortedCollection. AtInsert (N: LongInt; P: Pointer);
Begin
  Insert (P);
End;

Function TSortedCollection. Compare (Item1, Item2: Pointer): Integer;
Begin
  Compare := 0;
End;

Procedure TSortedCollection. AtPut (N: LongInt; P: Pointer);
Begin
  Insert (P);
End;

Procedure TSortedCollection. QuickSort(L, R: Integer);
var
  I, J: Integer;
  P, T: Pointer;
begin
  repeat
    I := L;
    J := R;
    P := Lst. FList^[(L + R) shr 1];
    repeat
      while Compare (Lst. FList^[I], P) < 0 do Inc(I);
      while Compare (Lst. FList^[J], P) > 0 do Dec(J);
      if I <= J then
      begin
        T := Lst. FList^ [I];
        Lst. FList^ [I] := Lst. FList^[J];
        Lst. FList^ [J] := T;
        Inc (I);
        Dec (J);
      end;
    until I > J;
    if L < J then QuickSort(L, J);
    L := I;
  until I >= R;
  Count := Lst. Count;
end;

Function TSortedCollection. KeyOf (Item: Pointer): Pointer;
Begin
  KeyOf := Item;
End;

Function TSortedCollection. Search (Key: Pointer; Var Index: Integer): Boolean;
Var
  L, H, I, C: Integer;
Begin
  Search := False;
  L := 0;
  H := Count - 1;
  While L <= H Do
  Begin
    I := (L + H) ShR 1;
    C := Compare (KeyOf (Lst. FList^ [I] ), Key);
    If C < 0 Then L := I + 1 Else
    Begin
      H := I - 1;
      If C = 0 Then
      Begin
        Search := True;
        {If Not Duplicates Then} L := I;
      End;
    End;
  End;
  Index := L;
End;

{ TTList }

destructor TTList.Destroy;
begin
  Clear;
end;

function TTList.Add(Item: Pointer): Integer;
begin
  Result := FCount;
  if Result = FCapacity then Grow;
  FList^[Result] := Item;
  Inc(FCount);
end;

procedure TTList.Clear;
begin
  SetCount(0);
  SetCapacity(0);
end;

procedure TTList.Delete(Index: Integer);
begin
  if (Index < 0) or (Index >= FCount) then Error;
  Dec(FCount);
  if Index < FCount then
    System.Move(FList^[Index + 1], FList^[Index],
      (FCount - Index) * SizeOf(Pointer));
end;

procedure ListError(Ident: Integer);
begin
  raise EListError.CreateRes(Ident);
end;

procedure ListIndexError;
begin
  {ListError(SListIndexError);}
end;

procedure TTList.Error;
begin
  ListIndexError;
end;

procedure TTList.Exchange(Index1, Index2: Integer);
var
  Item: Pointer;
begin
  if (Index1 < 0) or (Index1 >= FCount) or
    (Index2 < 0) or (Index2 >= FCount) then Error;
  Item := FList^[Index1];
  FList^[Index1] := FList^[Index2];
  FList^[Index2] := Item;
end;

function TTList.Expand: TTList;
begin
  if FCount = FCapacity then Grow;
  Result := Self;
end;

function TTList.First: Pointer;
begin
  Result := Get(0);
end;

function TTList.Get(Index: Integer): Pointer;
begin
  if (Index < 0) or (Index >= FCount) then Error;
  Result := FList^[Index];
end;

procedure TTList.Grow;
var
  Delta: Integer;
begin
  if FCapacity > 8 then Delta := 16 else
    if FCapacity > 4 then Delta := 8 else
      Delta := 4;
  SetCapacity(FCapacity + Delta);
end;

function TTList.IndexOf(Item: Pointer): Integer;
begin
  Result := 0;
  while (Result < FCount) and (FList^[Result] <> Item) do Inc(Result);
  if Result = FCount then Result := -1;
end;

procedure TTList.Insert(Index: Integer; Item: Pointer);
begin
  if (Index < 0) or (Index > FCount) then Error;
  if FCount = FCapacity then Grow;
  if Index < FCount then
    System.Move(FList^[Index], FList^[Index + 1],
      (FCount - Index) * SizeOf(Pointer));
  FList^[Index] := Item;
  Inc(FCount);
end;

function TTList.Last: Pointer;
begin
  Result := Get(FCount - 1);
end;

procedure TTList.Move(CurIndex, NewIndex: Integer);
var
  Item: Pointer;
begin
  if CurIndex <> NewIndex then
  begin
    if (NewIndex < 0) or (NewIndex >= FCount) then Error;
    Item := Get(CurIndex);
    Delete(CurIndex);
    Insert(NewIndex, Item);
  end;
end;

procedure TTList.Put(Index: Integer; Item: Pointer);
begin
  if (Index < 0) or (Index >= FCount) then Error;
  FList^[Index] := Item;
end;

function TTList.Remove(Item: Pointer): Integer;
begin
  Result := IndexOf(Item);
  if Result <> -1 then Delete(Result);
end;

procedure TTList.Pack;
var
  I: Integer;
begin
  for I := FCount - 1 downto 0 do if Items[I] = nil then Delete(I);
end;

procedure TTList.SetCapacity(NewCapacity: Integer);
begin
  if (NewCapacity < FCount) or (NewCapacity > MaxListSize) then Error;
  if NewCapacity <> FCapacity then
  begin
    ReallocMem(FList, NewCapacity * SizeOf(Pointer));
    FCapacity := NewCapacity;
  end;
end;

procedure TTList.SetCount(NewCount: Integer);
begin
  if (NewCount < 0) or (NewCount > MaxListSize) then Error;
  if NewCount > FCapacity then SetCapacity(NewCount);
  if NewCount > FCount then
    FillChar(FList^[FCount], (NewCount - FCount) * SizeOf(Pointer), 0);
  FCount := NewCount;
end;


{ TWDosStream }
{$IFDEF ASSHOLE}
constructor TWDosStream.Init(FileName: FNameStr; Mode: Word); assembler;
var
  NameBuf: array[0..79] of Char;
begin
(*
asm
                push    0                       { [1]:DWord = VMT       }
                push    Self                    { [2]:Pointer = Self    }
                Call    TStream.Init            { Inherited Init;       }
                mov     esi,FileName
                lea     edi,NameBuf
                mov     edx,edi                 { edx = @FName (ASCIIZ) }
                xor     eax,eax
                cld
                lodsb
                cmp     al,79
                jb      @@1
                mov     al,79
              @@1:
                xchg    ecx,eax
                rep     movsb                   { File name             }
                xchg    eax,ecx
                stosb                           { Null terminator       }
                xor     ecx,ecx                 { ecx = File attribute  }
                mov     eax,Mode                { ah=DosFn,al=Open mode }
                Call    DosFn
                jnc     @@2                     { eax = File Handle     }
                mov     ecx,Self
                mov     dl,stInitError
                Call    DoStreamError
                or      eax,-1
              @@2:
                mov     ecx,Self
                mov     [ecx].TWDosStream.Handle,eax
*)
end;

destructor TWDosStream.Done; assembler;
begin
(*
asm
                mov     eax,Self
                mov     ebx,[eax].TWDosStream.Handle
                cmp     ebx,-1
                je      @@1
                mov     ah,3Eh                  { Close file            }
                Call    DosFn
              @@1:
                push    0                       { [1]:DWord = VMT       }
                push    Self                    { [2]:Pointer = Self    }
                Call    TStream.Done            { Inherited Done;       }
*)
end;

function TWDosStream.GetPos: Longint; assembler;
begin
(*
asm
                mov     eax,Self
                cmp     [eax].TWDosStream.Status,stOk
                jne     @@1
                xor     ecx,ecx                 { ecx = Distance        }
                mov     ebx,[eax].TWDosStream.Handle { ebx = File Handle }
                mov     ax,4201h                { Get current position  }
                Call    DosFn
                jnc     @@2
                mov     ecx,Self
                mov     dl,stError
                Call    DoStreamError           { eax = Current FilePtr }
              @@1:
                or      eax,-1
              @@2:
*)
end;

function TWDosStream.GetSize: Longint; assembler;
begin
(*
asm
                mov     eax,Self
                cmp     [eax].TWDosStream.Status,stOk
                jne     @@1
                xor     ecx,ecx                 { ecx = Distance        }
                mov     ebx,[eax].TWDosStream.Handle
                mov     ax,4201h                { ebx = Handle          }
                Call    DosFn
                push    eax                     { Save current position }
                xor     ecx,ecx
                mov     ax,4202h                { Move to the EOF       }
                Call    DosFn
                pop     ecx
                push    eax
                mov     ax,4200h                { Restore old position  }
                Call    DosFn
                pop     eax
                jnc     @@2
                mov     ecx,Self
                mov     dl,stError
                Call    DoStreamError
              @@1:
                or      eax,-1
              @@2:
*)
end;

procedure TWDosStream. Read (var Buf; Count: Word); assembler;
begin
(*
asm
                mov     edi,Self
                cmp     [edi].TWDosStream.Status,stOk
                jne     @@2
                mov     edx,Buf                 { edx = Buffer@         }
                mov     ecx,Count               { ecx = Count           }
                mov     ebx,[edi].TWDosStream.Handle { ebx = File Handle }
                mov     ah,3Fh                  { Read file             }
                Call    DosFn
                mov     dl,stError
                jc      @@1
                cmp     eax,ecx
                je      @@3
                xor     eax,eax
                mov     dl,stReadError
              @@1:
                mov     ecx,edi
                Call    DoStreamError
              @@2:
                mov     edi,Buf
                mov     ecx,Count
                xor     al,al
                cld
                rep     stosb
              @@3:
*)
end;

Procedure TWDosStream. ReadBlock (Var Buf; Count: Word; Var BytesRead: Word);
Begin
  BytesRead := GetSize-GetPos;
  If BytesRead > Count Then BytesRead := Count;
  Read (Buf, BytesRead);
End;

procedure TWDosStream. Seek (Pos: Longint); Assembler;
begin
(*
Asm
                mov     eax,Self
                cmp     [eax].TWDosStream.Status,stOk
                jne     @@2
                mov     ecx,Pos
                test    ecx,ecx
                jns     @@1
                xor     ecx,ecx
              @@1:
                mov     ebx,[eax].TWDosStream.Handle
                mov     ax,4200h
                Call    DosFn
                jnc     @@2
                mov     ecx,Self
                mov     dl,stError
                Call    DoStreamError
              @@2:
*)
End;

Procedure TWDosStream. Truncate; Assembler;
begin
(*
Asm
                mov     eax,Self
                cmp     [eax].TWDosStream.Status,stOk
                jne     @@1
                xor     ecx,ecx                 { ecx=0: Truncate file  }
                mov     ebx,[eax].TWDosStream.Handle
                mov     ah,40h                  { Write file            }
                Call    DosFn
                jnc     @@1
                mov     ecx,Self
                mov     dl,stError
                Call    DoStreamError
              @@1:
*)
end;

procedure TWDosStream.Write(var Buf; Count: Word); assembler;
begin
(*
asm
                mov     eax,Self
                cmp     [eax].TWDosStream.Status,stOk
                jne     @@2
                mov     edx,Buf
                mov     ecx,Count
                mov     ebx,[eax].TWDosStream.Handle
                mov     ah,40h
                Call    DosFn
                mov     dl,stError
                jc      @@1
                cmp     eax,ecx
                je      @@2
                xor     eax,eax
                mov     dl,stWriteError
              @@1:
                mov     ecx,Self
                Call    DoStreamError
              @@2:
*)
end;
{$ENDIF}
{$ENDIF}

End.