home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 13.ddi / RTLCOM.ZIP / OBJECTS.PAS next >
Encoding:
Pascal/Delphi Source File  |  1992-10-28  |  69.2 KB  |  3,015 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 7.0                        }
  5. {       Standard Objects Unit                           }
  6. {                                                       }
  7. {       Copyright (c) 1992 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit Objects;
  12.  
  13. {$O+,F+,X+,I-,S-}
  14.  
  15. interface
  16.  
  17. const
  18.  
  19. { TStream access modes }
  20.  
  21.   stCreate    = $3C00;           { Create new file }
  22.   stOpenRead  = $3D00;           { Read access only }
  23.   stOpenWrite = $3D01;           { Write access only }
  24.   stOpen      = $3D02;           { Read and write access }
  25.  
  26. { TStream error codes }
  27.  
  28.   stOk         =  0;              { No error }
  29.   stError      = -1;              { Access error }
  30.   stInitError  = -2;              { Cannot initialize stream }
  31.   stReadError  = -3;              { Read beyond end of stream }
  32.   stWriteError = -4;              { Cannot expand stream }
  33.   stGetError   = -5;              { Get of unregistered object type }
  34.   stPutError   = -6;              { Put of unregistered object type }
  35.  
  36. { Maximum TCollection size }
  37.  
  38.   MaxCollectionSize = 65520 div SizeOf(Pointer);
  39.  
  40. { TCollection error codes }
  41.  
  42.   coIndexError = -1;              { Index out of range }
  43.   coOverflow   = -2;              { Overflow }
  44.  
  45. { VMT header size }
  46.  
  47.   vmtHeaderSize = 8;
  48.  
  49. type
  50.  
  51. { Type conversion records }
  52.  
  53.   WordRec = record
  54.     Lo, Hi: Byte;
  55.   end;
  56.  
  57.   LongRec = record
  58.     Lo, Hi: Word;
  59.   end;
  60.  
  61.   PtrRec = record
  62.     Ofs, Seg: Word;
  63.   end;
  64.  
  65. { String pointers }
  66.  
  67.   PString = ^String;
  68.  
  69. { Character set type }
  70.  
  71.   PCharSet = ^TCharSet;
  72.   TCharSet = set of Char;
  73.  
  74. { General arrays }
  75.  
  76.   PByteArray = ^TByteArray;
  77.   TByteArray = array[0..32767] of Byte;
  78.  
  79.   PWordArray = ^TWordArray;
  80.   TWordArray = array[0..16383] of Word;
  81.  
  82. { TObject base object }
  83.  
  84.   PObject = ^TObject;
  85.   TObject = object
  86.     constructor Init;
  87.     procedure Free;
  88.     destructor Done; virtual;
  89.   end;
  90.  
  91. { TStreamRec }
  92.  
  93.   PStreamRec = ^TStreamRec;
  94.   TStreamRec = record
  95.     ObjType: Word;
  96.     VmtLink: Word;
  97.     Load: Pointer;
  98.     Store: Pointer;
  99.     Next: Word;
  100.   end;
  101.  
  102. { TStream }
  103.  
  104.   PStream = ^TStream;
  105.   TStream = object(TObject)
  106.     Status: Integer;
  107.     ErrorInfo: Integer;
  108.     constructor Init;
  109.     procedure CopyFrom(var S: TStream; Count: Longint);
  110.     procedure Error(Code, Info: Integer); virtual;
  111.     procedure Flush; virtual;
  112.     function Get: PObject;
  113.     function GetPos: Longint; virtual;
  114.     function GetSize: Longint; virtual;
  115.     procedure Put(P: PObject);
  116.     procedure Read(var Buf; Count: Word); virtual;
  117.     function ReadStr: PString;
  118.     procedure Reset;
  119.     procedure Seek(Pos: Longint); virtual;
  120.     function StrRead: PChar;
  121.     procedure StrWrite(P: PChar);
  122.     procedure Truncate; virtual;
  123.     procedure Write(var Buf; Count: Word); virtual;
  124.     procedure WriteStr(P: PString);
  125.   end;
  126.  
  127. { DOS file name string }
  128.  
  129. {$IFDEF Windows}
  130.   FNameStr = PChar;
  131. {$ELSE}
  132.   FNameStr = string[79];
  133. {$ENDIF}
  134.  
  135. { TDosStream }
  136.  
  137.   PDosStream = ^TDosStream;
  138.   TDosStream = object(TStream)
  139.     Handle: Word;
  140.     constructor Init(FileName: FNameStr; Mode: Word);
  141.     destructor Done; virtual;
  142.     function GetPos: Longint; virtual;
  143.     function GetSize: Longint; virtual;
  144.     procedure Read(var Buf; Count: Word); virtual;
  145.     procedure Seek(Pos: Longint); virtual;
  146.     procedure Truncate; virtual;
  147.     procedure Write(var Buf; Count: Word); virtual;
  148.   end;
  149.  
  150. { TBufStream }
  151.  
  152.   PBufStream = ^TBufStream;
  153.   TBufStream = object(TDosStream)
  154.     Buffer: Pointer;
  155.     BufSize: Word;
  156.     BufPtr: Word;
  157.     BufEnd: Word;
  158.     constructor Init(FileName: FNameStr; Mode, Size: Word);
  159.     destructor Done; virtual;
  160.     procedure Flush; virtual;
  161.     function GetPos: Longint; virtual;
  162.     function GetSize: Longint; virtual;
  163.     procedure Read(var Buf; Count: Word); virtual;
  164.     procedure Seek(Pos: Longint); virtual;
  165.     procedure Truncate; virtual;
  166.     procedure Write(var Buf; Count: Word); virtual;
  167.   end;
  168.  
  169. { TEmsStream }
  170.  
  171.   PEmsStream = ^TEmsStream;
  172.   TEmsStream = object(TStream)
  173.     Handle: Word;
  174.     PageCount: Word;
  175.     Size: Longint;
  176.     Position: Longint;
  177.     constructor Init(MinSize, MaxSize: Longint);
  178.     destructor Done; virtual;
  179.     function GetPos: Longint; virtual;
  180.     function GetSize: Longint; virtual;
  181.     procedure Read(var Buf; Count: Word); virtual;
  182.     procedure Seek(Pos: Longint); virtual;
  183.     procedure Truncate; virtual;
  184.     procedure Write(var Buf; Count: Word); virtual;
  185.   end;
  186.  
  187. { TMemoryStream }
  188.  
  189.   PMemoryStream = ^TMemoryStream;
  190.   TMemoryStream = object(TStream)
  191.     SegCount: Integer;
  192.     SegList: PWordArray;
  193.     CurSeg: Integer;
  194.     BlockSize: Integer;
  195.     Size: Longint;
  196.     Position: Longint;
  197.     constructor Init(ALimit: Longint; ABlockSize: Word);
  198.     destructor Done; virtual;
  199.     function GetPos: Longint; virtual;
  200.     function GetSize: Longint; virtual;
  201.     procedure Read(var Buf; Count: Word); virtual;
  202.     procedure Seek(Pos: Longint); virtual;
  203.     procedure Truncate; virtual;
  204.     procedure Write(var Buf; Count: Word); virtual;
  205.   private
  206.     function ChangeListSize(ALimit: Word): Boolean;
  207.   end;
  208.  
  209. { TCollection types }
  210.  
  211.   PItemList = ^TItemList;
  212.   TItemList = array[0..MaxCollectionSize - 1] of Pointer;
  213.  
  214. { TCollection object }
  215.  
  216.   PCollection = ^TCollection;
  217.   TCollection = object(TObject)
  218.     Items: PItemList;
  219.     Count: Integer;
  220.     Limit: Integer;
  221.     Delta: Integer;
  222.     constructor Init(ALimit, ADelta: Integer);
  223.     constructor Load(var S: TStream);
  224.     destructor Done; virtual;
  225.     function At(Index: Integer): Pointer;
  226.     procedure AtDelete(Index: Integer);
  227.     procedure AtFree(Index: Integer);
  228.     procedure AtInsert(Index: Integer; Item: Pointer);
  229.     procedure AtPut(Index: Integer; Item: Pointer);
  230.     procedure Delete(Item: Pointer);
  231.     procedure DeleteAll;
  232.     procedure Error(Code, Info: Integer); virtual;
  233.     function FirstThat(Test: Pointer): Pointer;
  234.     procedure ForEach(Action: Pointer);
  235.     procedure Free(Item: Pointer);
  236.     procedure FreeAll;
  237.     procedure FreeItem(Item: Pointer); virtual;
  238.     function GetItem(var S: TStream): Pointer; virtual;
  239.     function IndexOf(Item: Pointer): Integer; virtual;
  240.     procedure Insert(Item: Pointer); virtual;
  241.     function LastThat(Test: Pointer): Pointer;
  242.     procedure Pack;
  243.     procedure PutItem(var S: TStream; Item: Pointer); virtual;
  244.     procedure SetLimit(ALimit: Integer); virtual;
  245.     procedure Store(var S: TStream);
  246.   end;
  247.  
  248. { TSortedCollection object }
  249.  
  250.   PSortedCollection = ^TSortedCollection;
  251.   TSortedCollection = object(TCollection)
  252.     Duplicates: Boolean;
  253.     constructor Init(ALimit, ADelta: Integer);
  254.     constructor Load(var S: TStream);
  255.     function Compare(Key1, Key2: Pointer): Integer; virtual;
  256.     function IndexOf(Item: Pointer): Integer; virtual;
  257.     procedure Insert(Item: Pointer); virtual;
  258.     function KeyOf(Item: Pointer): Pointer; virtual;
  259.     function Search(Key: Pointer; var Index: Integer): Boolean; virtual;
  260.     procedure Store(var S: TStream);
  261.   end;
  262.  
  263. { TStringCollection object }
  264.  
  265.   PStringCollection = ^TStringCollection;
  266.   TStringCollection = object(TSortedCollection)
  267.     function Compare(Key1, Key2: Pointer): Integer; virtual;
  268.     procedure FreeItem(Item: Pointer); virtual;
  269.     function GetItem(var S: TStream): Pointer; virtual;
  270.     procedure PutItem(var S: TStream; Item: Pointer); virtual;
  271.   end;
  272.  
  273. { TStrCollection object }
  274.  
  275.   PStrCollection = ^TStrCollection;
  276.   TStrCollection = object(TSortedCollection)
  277.     function Compare(Key1, Key2: Pointer): Integer; virtual;
  278.     procedure FreeItem(Item: Pointer); virtual;
  279.     function GetItem(var S: TStream): Pointer; virtual;
  280.     procedure PutItem(var S: TStream; Item: Pointer); virtual;
  281.   end;
  282.  
  283. {$IFNDEF Windows}
  284.  
  285. { TResourceCollection object }
  286.  
  287.   PResourceCollection = ^TResourceCollection;
  288.   TResourceCollection = object(TStringCollection)
  289.     procedure FreeItem(Item: Pointer); virtual;
  290.     function GetItem(var S: TStream): Pointer; virtual;
  291.     function KeyOf(Item: Pointer): Pointer; virtual;
  292.     procedure PutItem(var S: TStream; Item: Pointer); virtual;
  293.   end;
  294.  
  295. { TResourceFile object }
  296.  
  297.   PResourceFile = ^TResourceFile;
  298.   TResourceFile = object(TObject)
  299.     Stream: PStream;
  300.     Modified: Boolean;
  301.     constructor Init(AStream: PStream);
  302.     destructor Done; virtual;
  303.     function Count: Integer;
  304.     procedure Delete(Key: String);
  305.     procedure Flush;
  306.     function Get(Key: String): PObject;
  307.     function KeyAt(I: Integer): String;
  308.     procedure Put(Item: PObject; Key: String);
  309.     function SwitchTo(AStream: PStream; Pack: Boolean): PStream;
  310.   private
  311.     BasePos: Longint;
  312.     IndexPos: Longint;
  313.     Index: TResourceCollection;
  314.   end;
  315.  
  316. { TStringList object }
  317.  
  318.   TStrIndexRec = record
  319.     Key, Count, Offset: Word;
  320.   end;
  321.  
  322.   PStrIndex = ^TStrIndex;
  323.   TStrIndex = array[0..9999] of TStrIndexRec;
  324.  
  325.   PStringList = ^TStringList;
  326.   TStringList = object(TObject)
  327.     constructor Load(var S: TStream);
  328.     destructor Done; virtual;
  329.     function Get(Key: Word): String;
  330.   private
  331.     Stream: PStream;
  332.     BasePos: Longint;
  333.     IndexSize: Integer;
  334.     Index: PStrIndex;
  335.     procedure ReadStr(var S: String; Offset, Skip: Word);
  336.   end;
  337.  
  338. { TStrListMaker object }
  339.  
  340.   PStrListMaker = ^TStrListMaker;
  341.   TStrListMaker = object(TObject)
  342.     constructor Init(AStrSize, AIndexSize: Word);
  343.     destructor Done; virtual;
  344.     procedure Put(Key: Word; S: String);
  345.     procedure Store(var S: TStream);
  346.   private
  347.     StrPos: Word;
  348.     StrSize: Word;
  349.     Strings: PByteArray;
  350.     IndexPos: Word;
  351.     IndexSize: Word;
  352.     Index: PStrIndex;
  353.     Cur: TStrIndexRec;
  354.     procedure CloseCurrent;
  355.   end;
  356.  
  357. { TPoint object }
  358.  
  359.   TPoint = object
  360.     X, Y: Integer;
  361.   end;
  362.  
  363. { Rectangle object }
  364.  
  365.   TRect = object
  366.     A, B: TPoint;
  367.     procedure Assign(XA, YA, XB, YB: Integer);
  368.     procedure Copy(R: TRect);
  369.     procedure Move(ADX, ADY: Integer);
  370.     procedure Grow(ADX, ADY: Integer);
  371.     procedure Intersect(R: TRect);
  372.     procedure Union(R: TRect);
  373.     function Contains(P: TPoint): Boolean;
  374.     function Equals(R: TRect): Boolean;
  375.     function Empty: Boolean;
  376.   end;
  377.  
  378. {$ENDIF}
  379.  
  380. { Dynamic string handling routines }
  381.  
  382. function NewStr(const S: String): PString;
  383. procedure DisposeStr(P: PString);
  384.  
  385. { Longint routines }
  386.  
  387. function LongMul(X, Y: Integer): Longint;
  388. inline($5A/$58/$F7/$EA);
  389.  
  390. function LongDiv(X: Longint; Y: Integer): Integer;
  391. inline($59/$58/$5A/$F7/$F9);
  392.  
  393. { Stream routines }
  394.  
  395. procedure RegisterType(var S: TStreamRec);
  396.  
  397. { Abstract notification procedure }
  398.  
  399. procedure Abstract;
  400.  
  401. { Objects registration procedure }
  402.  
  403. procedure RegisterObjects;
  404.  
  405. const
  406.  
  407. { Stream error procedure }
  408.  
  409.   StreamError: Pointer = nil;
  410.  
  411. { EMS stream state variables }
  412.  
  413.   EmsCurHandle: Word = $FFFF;
  414.   EmsCurPage: Word = $FFFF;
  415.  
  416. { Stream registration records }
  417.  
  418. const
  419.   RCollection: TStreamRec = (
  420.     ObjType: 50;
  421.     VmtLink: Ofs(TypeOf(TCollection)^);
  422.     Load: @TCollection.Load;
  423.     Store: @TCollection.Store);
  424.  
  425. const
  426.   RStringCollection: TStreamRec = (
  427.     ObjType: 51;
  428.     VmtLink: Ofs(TypeOf(TStringCollection)^);
  429.     Load: @TStringCollection.Load;
  430.     Store: @TStringCollection.Store);
  431.  
  432. const
  433.   RStrCollection: TStreamRec = (
  434.     ObjType: 69;
  435.     VmtLink: Ofs(TypeOf(TStrCollection)^);
  436.     Load:    @TStrCollection.Load;
  437.     Store:   @TStrCollection.Store);
  438.  
  439. {$IFNDEF Windows }
  440.  
  441. const
  442.   RStringList: TStreamRec = (
  443.     ObjType: 52;
  444.     VmtLink: Ofs(TypeOf(TStringList)^);
  445.     Load: @TStringList.Load;
  446.     Store: nil);
  447.  
  448. const
  449.   RStrListMaker: TStreamRec = (
  450.     ObjType: 52;
  451.     VmtLink: Ofs(TypeOf(TStrListMaker)^);
  452.     Load: nil;
  453.     Store: @TStrListMaker.Store);
  454.  
  455. {$ENDIF}
  456.  
  457. implementation
  458.  
  459. {$IFDEF Windows}
  460. uses WinProcs, Strings, OMemory;
  461. {$ELSE}
  462. uses Memory, Strings;
  463. {$ENDIF}
  464.  
  465. {$IFDEF Windows}
  466.   {$DEFINE NewExeFormat}
  467. {$ENDIF}
  468.  
  469. {$IFDEF DPMI}
  470.   {$DEFINE NewExeFormat}
  471. {$ENDIF}
  472.  
  473. procedure Abstract;
  474. begin
  475.   RunError(211);
  476. end;
  477.  
  478. { TObject }
  479.  
  480. constructor TObject.Init;
  481. type
  482.   Image = record
  483.     Link: Word;
  484.     Data: record end;
  485.   end;
  486. begin
  487. {$IFNDEF Windows}
  488.   FillChar(Image(Self).Data, SizeOf(Self) - SizeOf(TObject), 0);
  489. {$ENDIF}
  490. end;
  491.  
  492. { Shorthand procedure for a done/dispose }
  493.  
  494. procedure TObject.Free;
  495. begin
  496.   Dispose(PObject(@Self), Done);
  497. end;
  498.  
  499. destructor TObject.Done;
  500. begin
  501. end;
  502.  
  503. { TStream type registration routines }
  504.  
  505. const
  506.   StreamTypes: Word = 0;
  507.  
  508. procedure RegisterError;
  509. begin
  510.   RunError(212);
  511. end;
  512.  
  513. procedure RegisterType(var S: TStreamRec); assembler;
  514. asm
  515.         MOV     AX,DS
  516.         CMP     AX,S.Word[2]
  517.         JNE     @@1
  518.         MOV     SI,S.Word[0]
  519.         MOV     AX,[SI].TStreamRec.ObjType
  520.         OR      AX,AX
  521.         JE      @@1
  522.         MOV     DI,StreamTypes
  523.         MOV     [SI].TStreamRec.Next,DI
  524.         JMP     @@3
  525. @@1:    JMP     RegisterError
  526. @@2:    CMP     AX,[DI].TStreamRec.ObjType
  527.         JE      @@1
  528.         MOV     DI,[DI].TStreamRec.Next
  529. @@3:    OR      DI,DI
  530.         JNE     @@2
  531.         MOV     StreamTypes,SI
  532. end;
  533.  
  534. { TStream support routines }
  535.  
  536. const
  537.   TStream_Error = vmtHeaderSize + $04;
  538.   TStream_Flush = vmtHeaderSize + $08;
  539.   TStream_Read  = vmtHeaderSize + $14;
  540.   TStream_Write = vmtHeaderSize + $20;
  541.  
  542. { Stream error handler                                  }
  543. { In    AX    = Error info                              }
  544. {       DX    = Error code                              }
  545. {       ES:DI = Stream object pointer                   }
  546. { Uses  AX,BX,CX,DX,SI                                  }
  547.  
  548. procedure DoStreamError; near; assembler;
  549. asm
  550.         PUSH    ES
  551.         PUSH    DI
  552.         PUSH    DX
  553.         PUSH    AX
  554.         PUSH    ES
  555.         PUSH    DI
  556.         MOV     DI,ES:[DI]
  557.         CALL    DWORD PTR [DI].TStream_Error
  558.         POP     DI
  559.         POP     ES
  560. end;
  561.  
  562. { TStream }
  563.  
  564. constructor TStream.Init;
  565. begin
  566.   TObject.Init;
  567.   Status := 0;
  568.   ErrorInfo := 0;
  569. end;
  570.  
  571. procedure TStream.CopyFrom(var S: TStream; Count: Longint);
  572. var
  573.   N: Word;
  574.   Buffer: array[0..1023] of Byte;
  575. begin
  576.   while Count > 0 do
  577.   begin
  578.     if Count > SizeOf(Buffer) then N := SizeOf(Buffer) else N := Count;
  579.     S.Read(Buffer, N);
  580.     Write(Buffer, N);
  581.     Dec(Count, N);
  582.   end;
  583. end;
  584.  
  585. procedure TStream.Error(Code, Info: Integer);
  586. type
  587.   TErrorProc = procedure(var S: TStream);
  588. begin
  589.   Status := Code;
  590.   ErrorInfo := Info;
  591.   if StreamError <> nil then TErrorProc(StreamError)(Self);
  592. end;
  593.  
  594. procedure TStream.Flush;
  595. begin
  596. end;
  597.  
  598. function TStream.Get: PObject; assembler;
  599. asm
  600.         PUSH    AX
  601.         MOV     AX,SP
  602.         PUSH    SS
  603.         PUSH    AX
  604.         MOV     AX,2
  605.         PUSH    AX
  606.         LES     DI,Self
  607.         PUSH    ES
  608.         PUSH    DI
  609.         MOV     DI,ES:[DI]
  610.         CALL    DWORD PTR [DI].TStream_Read
  611.         POP     AX
  612.         OR      AX,AX
  613.         JE      @@3
  614.         MOV     BX,StreamTypes
  615.         JMP     @@2
  616. @@1:    CMP     AX,[BX].TStreamRec.ObjType
  617.         JE      @@4
  618.         MOV     BX,[BX].TStreamRec.Next
  619. @@2:    OR      BX,BX
  620.         JNE     @@1
  621.         LES     DI,Self
  622.         MOV     DX,stGetError
  623.         CALL    DoStreamError
  624. @@3:    XOR     AX,AX
  625.         MOV     DX,AX
  626.         JMP     @@5
  627. @@4:    LES     DI,Self
  628.         PUSH    ES
  629.         PUSH    DI
  630.         PUSH    [BX].TStreamRec.VmtLink
  631.         XOR     AX,AX
  632.         PUSH    AX
  633.         PUSH    AX
  634.         CALL    [BX].TStreamRec.Load
  635. @@5:
  636. end;
  637.  
  638. function TStream.GetPos: Longint;
  639. begin
  640.   Abstract;
  641. end;
  642.  
  643. function TStream.GetSize: Longint;
  644. begin
  645.   Abstract;
  646. end;
  647.  
  648. procedure TStream.Put(P: PObject); assembler;
  649. asm
  650.         LES     DI,P
  651.         MOV     CX,ES
  652.         OR      CX,DI
  653.         JE      @@4
  654.         MOV     AX,ES:[DI]
  655.         MOV     BX,StreamTypes
  656.         JMP     @@2
  657. @@1:    CMP     AX,[BX].TStreamRec.VmtLink
  658.         JE      @@3
  659.         MOV     BX,[BX].TStreamRec.Next
  660. @@2:    OR      BX,BX
  661.         JNE     @@1
  662.         LES     DI,Self
  663.         MOV     DX,stPutError
  664.         CALL    DoStreamError
  665.         JMP     @@5
  666. @@3:    MOV     CX,[BX].TStreamRec.ObjType
  667. @@4:    PUSH    BX
  668.         PUSH    CX
  669.         MOV     AX,SP
  670.         PUSH    SS
  671.         PUSH    AX
  672.         MOV     AX,2
  673.         PUSH    AX
  674.         LES     DI,Self
  675.         PUSH    ES
  676.         PUSH    DI
  677.         MOV     DI,ES:[DI]
  678.         CALL    DWORD PTR [DI].TStream_Write
  679.         POP     CX
  680.         POP     BX
  681.         JCXZ    @@5
  682.         LES     DI,Self
  683.         PUSH    ES
  684.         PUSH    DI
  685.         PUSH    P.Word[2]
  686.         PUSH    P.Word[0]
  687.         CALL    [BX].TStreamRec.Store
  688. @@5:
  689. end;
  690.  
  691. procedure TStream.Read(var Buf; Count: Word);
  692. begin
  693.   Abstract;
  694. end;
  695.  
  696. function TStream.ReadStr: PString;
  697. var
  698.   L: Byte;
  699.   P: PString;
  700. begin
  701.   Read(L, 1);
  702.   if L > 0 then
  703.   begin
  704.     GetMem(P, L + 1);
  705.     P^[0] := Char(L);
  706.     Read(P^[1], L);
  707.     ReadStr := P;
  708.   end else ReadStr := nil;
  709. end;
  710.  
  711. procedure TStream.Reset;
  712. begin
  713.   Status := 0;
  714.   ErrorInfo := 0;
  715. end;
  716.  
  717. procedure TStream.Seek(Pos: Longint);
  718. begin
  719.   Abstract;
  720. end;
  721.  
  722. function TStream.StrRead: PChar;
  723. var
  724.   L: Word;
  725.   P: PChar;
  726. begin
  727.   Read(L, SizeOf(Word));
  728.   if L = 0 then StrRead := nil else
  729.   begin
  730.     GetMem(P, L + 1);
  731.     Read(P[0], L);
  732.     P[L] := #0;
  733.     StrRead := P;
  734.   end;
  735. end;
  736.  
  737. procedure TStream.StrWrite(P: PChar);
  738. var
  739.   L: Word;
  740. begin
  741.   if P = nil then L := 0 else L := StrLen(P);
  742.   Write(L, SizeOf(Word));
  743.   if P <> nil then Write(P[0], L);
  744. end;
  745.  
  746. procedure TStream.Truncate;
  747. begin
  748.   Abstract;
  749. end;
  750.  
  751. procedure TStream.Write(var Buf; Count: Word);
  752. begin
  753.   Abstract;
  754. end;
  755.  
  756. procedure TStream.WriteStr(P: PString);
  757. const
  758.   Empty: String[1] = '';
  759. begin
  760.   if P <> nil then Write(P^, Length(P^) + 1) else Write(Empty, 1);
  761. end;
  762.  
  763. { TDosStream }
  764.  
  765. constructor TDosStream.Init(FileName: FNameStr; Mode: Word); assembler;
  766. var
  767.   NameBuf: array[0..79] of Char;
  768. asm
  769.         XOR     AX,AX
  770.         PUSH    AX
  771.         LES     DI,Self
  772.         PUSH    ES
  773.         PUSH    DI
  774.         CALL    TStream.Init
  775. {$IFDEF Windows}
  776.     LEA    DI,NameBuf
  777.     PUSH    SS
  778.     PUSH    DI
  779.     LES    DI,FileName
  780.     PUSH    ES
  781.     PUSH    DI
  782.     MOV    AX,79
  783.     PUSH    AX
  784.     CALL    StrLCopy
  785.     PUSH    DX
  786.     PUSH    AX
  787.     PUSH    DX
  788.     PUSH    AX
  789.     CALL    AnsiToOem
  790.     PUSH    DS
  791.     LEA    DX,NameBuf
  792. {$ELSE}
  793.         PUSH    DS
  794.         LDS     SI,FileName
  795.         LEA     DI,NameBuf
  796.         MOV     DX,DI
  797.         PUSH    SS
  798.         POP     ES
  799.         CLD
  800.         LODSB
  801.         CMP     AL,79
  802.         JB      @@1
  803.         MOV     AL,79
  804. @@1:    CBW
  805.         XCHG    AX,CX
  806.         REP     MOVSB
  807.         XCHG    AX,CX
  808.         STOSB
  809. {$ENDIF}
  810.         PUSH    SS
  811.         POP     DS
  812.         XOR     CX,CX
  813.         MOV     AX,Mode
  814.         INT     21H
  815.         POP     DS
  816.         JNC     @@2
  817.         LES     DI,Self
  818.         MOV     DX,stInitError
  819.         CALL    DoStreamError
  820.         MOV     AX,-1
  821. @@2:    LES     DI,Self
  822.         MOV     ES:[DI].TDosStream.Handle,AX
  823. end;
  824.  
  825. destructor TDosStream.Done; assembler;
  826. asm
  827.         LES     DI,Self
  828.         MOV     BX,ES:[DI].TDosStream.Handle
  829.         CMP     BX,-1
  830.         JE      @@1
  831.         MOV     AH,3EH
  832.         INT     21H
  833. @@1:    XOR     AX,AX
  834.         PUSH    AX
  835.         PUSH    ES
  836.         PUSH    DI
  837.         CALL    TStream.Done
  838. end;
  839.  
  840. function TDosStream.GetPos: Longint; assembler;
  841. asm
  842.         LES     DI,Self
  843.         XOR     DX,DX
  844.         CMP     DX,ES:[DI].TDosStream.Status
  845.         JNE     @@1
  846.         MOV     CX,DX
  847.         MOV     BX,ES:[DI].TDosStream.Handle
  848.         MOV     AX,4201H
  849.         INT     21H
  850.         JNC     @@2
  851.         MOV     DX,stError
  852.         CALL    DoStreamError
  853. @@1:    MOV     AX,-1
  854.         CWD
  855. @@2:
  856. end;
  857.  
  858. function TDosStream.GetSize: Longint; assembler;
  859. asm
  860.         LES     DI,Self
  861.         XOR     DX,DX
  862.         CMP     DX,ES:[DI].TDosStream.Status
  863.         JNE     @@1
  864.         MOV     CX,DX
  865.         MOV     BX,ES:[DI].TDosStream.Handle
  866.         MOV     AX,4201H
  867.         INT     21H
  868.         PUSH    DX
  869.         PUSH    AX
  870.         XOR     DX,DX
  871.         MOV     CX,DX
  872.         MOV     AX,4202H
  873.         INT     21H
  874.         POP     SI
  875.         POP     CX
  876.         PUSH    DX
  877.         PUSH    AX
  878.         MOV     DX,SI
  879.         MOV     AX,4200H
  880.         INT     21H
  881.         POP     AX
  882.         POP     DX
  883.         JNC     @@2
  884.         MOV     DX,stError
  885.         CALL    DoStreamError
  886. @@1:    MOV     AX,-1
  887.         CWD
  888. @@2:
  889. end;
  890.  
  891. procedure TDosStream.Read(var Buf; Count: Word); assembler;
  892. asm
  893.         LES     DI,Self
  894.         CMP     ES:[DI].TDosStream.Status,0
  895.         JNE     @@2
  896.         PUSH    DS
  897.         LDS     DX,Buf
  898.         MOV     CX,Count
  899.         MOV     BX,ES:[DI].TDosStream.Handle
  900.         MOV     AH,3FH
  901.         INT     21H
  902.         POP     DS
  903.         MOV     DX,stError
  904.         JC      @@1
  905.         CMP     AX,CX
  906.         JE      @@3
  907.         XOR     AX,AX
  908.         MOV     DX,stReadError
  909. @@1:    CALL    DoStreamError
  910. @@2:    LES     DI,Buf
  911.         MOV     CX,Count
  912.         XOR     AL,AL
  913.         CLD
  914.         REP     STOSB
  915. @@3:
  916. end;
  917.  
  918. procedure TDosStream.Seek(Pos: Longint); assembler;
  919. asm
  920.         LES     DI,Self
  921.         CMP     ES:[DI].TDosStream.Status,0
  922.         JNE     @@2
  923.         MOV     DX,Pos.Word[0]
  924.         MOV     CX,Pos.Word[2]
  925.         OR      CX,CX
  926.         JNS     @@1
  927.         XOR     DX,DX
  928.         XOR     CX,CX
  929. @@1:    MOV     BX,ES:[DI].TDosStream.Handle
  930.         MOV     AX,4200H
  931.         INT     21H
  932.         JNC     @@2
  933.         MOV     DX,stError
  934.         CALL    DoStreamError
  935. @@2:
  936. end;
  937.  
  938. procedure TDosStream.Truncate; assembler;
  939. asm
  940.         LES     DI,Self
  941.         XOR     CX,CX
  942.         CMP     CX,ES:[DI].TDosStream.Status
  943.         JNE     @@1
  944.         MOV     BX,ES:[DI].TDosStream.Handle
  945.         MOV     AH,40H
  946.         INT     21H
  947.         JNC     @@1
  948.         MOV     DX,stError
  949.         CALL    DoStreamError
  950. @@1:
  951. end;
  952.  
  953. procedure TDosStream.Write(var Buf; Count: Word); assembler;
  954. asm
  955.         LES     DI,Self
  956.         CMP     ES:[DI].TDosStream.Status,0
  957.         JNE     @@2
  958.         PUSH    DS
  959.         LDS     DX,Buf
  960.         MOV     CX,Count
  961.         MOV     BX,ES:[DI].TDosStream.Handle
  962.         MOV     AH,40H
  963.         INT     21H
  964.         POP     DS
  965.         MOV     DX,stError
  966.         JC      @@1
  967.         CMP     AX,CX
  968.         JE      @@2
  969.         XOR     AX,AX
  970.         MOV     DX,stWriteError
  971. @@1:    CALL    DoStreamError
  972. @@2:
  973. end;
  974.  
  975. { TBufStream }
  976.  
  977. { Flush TBufStream buffer                               }
  978. { In    AL    = Flush mode (0=Read, 1=Write, 2=Both)    }
  979. {       ES:DI = TBufStream pointer                      }
  980. { Out   ZF    = Status test                             }
  981.  
  982. procedure FlushBuffer; near; assembler;
  983. asm
  984.         MOV     CX,ES:[DI].TBufStream.BufPtr
  985.         SUB     CX,ES:[DI].TBufStream.BufEnd
  986.         JE      @@3
  987.         MOV     BX,ES:[DI].TDosStream.Handle
  988.         JA      @@1
  989.         CMP     AL,1
  990.         JE      @@4
  991.         MOV     DX,CX
  992.         MOV     CX,-1
  993.         MOV     AX,4201H
  994.         INT     21H
  995.         JMP     @@3
  996. @@1:    CMP     AL,0
  997.         JE      @@4
  998.         PUSH    DS
  999.         LDS     DX,ES:[DI].TBufStream.Buffer
  1000.         MOV     AH,40H
  1001.         INT     21H
  1002.         POP     DS
  1003.         MOV     DX,stError
  1004.         JC      @@2
  1005.         CMP     AX,CX
  1006.         JE      @@3
  1007.         XOR     AX,AX
  1008.         MOV     DX,stWriteError
  1009. @@2:    CALL    DoStreamError
  1010. @@3:    XOR     AX,AX
  1011.         MOV     ES:[DI].TBufStream.BufPtr,AX
  1012.         MOV     ES:[DI].TBufStream.BufEnd,AX
  1013.         CMP     AX,ES:[DI].TStream.Status
  1014. @@4:
  1015. end;
  1016.  
  1017. constructor TBufStream.Init(FileName: FNameStr; Mode, Size: Word);
  1018. begin
  1019.   TDosStream.Init(FileName, Mode);
  1020.   BufSize := Size;
  1021.   if Size = 0 then Error(stInitError, 0)
  1022.   else GetMem(Buffer, Size);
  1023.   BufPtr := 0;
  1024.   BufEnd := 0;
  1025. end;
  1026.  
  1027. destructor TBufStream.Done;
  1028. begin
  1029.   TBufStream.Flush;
  1030.   TDosStream.Done;
  1031.   FreeMem(Buffer, BufSize);
  1032. end;
  1033.  
  1034. procedure TBufStream.Flush; assembler;
  1035. asm
  1036.         LES     DI,Self
  1037.         CMP     ES:[DI].TBufStream.Status,0
  1038.         JNE     @@1
  1039.         MOV     AL,2
  1040.         CALL    FlushBuffer
  1041. @@1:
  1042. end;
  1043.  
  1044. function TBufStream.GetPos: Longint; assembler;
  1045. asm
  1046.         LES     DI,Self
  1047.         PUSH    ES
  1048.         PUSH    DI
  1049.         CALL    TDosStream.GetPos
  1050.         OR      DX,DX
  1051.         JS      @@1
  1052.         LES     DI,Self
  1053.         SUB     AX,ES:[DI].TBufStream.BufEnd
  1054.         SBB     DX,0
  1055.         ADD     AX,ES:[DI].TBufStream.BufPtr
  1056.         ADC     DX,0
  1057. @@1:
  1058. end;
  1059.  
  1060. function TBufStream.GetSize: Longint; assembler;
  1061. asm
  1062.         LES     DI,Self
  1063.         PUSH    ES
  1064.         PUSH    DI
  1065.         PUSH    ES
  1066.         PUSH    DI
  1067.         CALL    TBufStream.Flush
  1068.         CALL    TDosStream.GetSize
  1069. end;
  1070.  
  1071. procedure TBufStream.Read(var Buf; Count: Word); assembler;
  1072. asm
  1073.         LES     DI,Self
  1074.         CMP     ES:[DI].TBufStream.Status,0
  1075.         JNE     @@6
  1076.         MOV     AL,1
  1077.         CALL    FlushBuffer
  1078.         JNE     @@6
  1079.         XOR     BX,BX
  1080. @@1:    MOV     CX,Count
  1081.         SUB     CX,BX
  1082.         JE      @@7
  1083.         LES     DI,Self
  1084.         MOV     AX,ES:[DI].TBufStream.BufEnd
  1085.         SUB     AX,ES:[DI].TBufStream.BufPtr
  1086.         JA      @@2
  1087.         PUSH    DS
  1088.         PUSH    CX
  1089.         PUSH    BX
  1090.         LDS     DX,ES:[DI].TBufStream.Buffer
  1091.         MOV     CX,ES:[DI].TBufStream.BufSize
  1092.         MOV     BX,ES:[DI].TBufStream.Handle
  1093.         MOV     AH,3FH
  1094.         INT     21H
  1095.         POP     BX
  1096.         POP     CX
  1097.         POP     DS
  1098.         MOV     DX,stError
  1099.         JC      @@5
  1100.         MOV     ES:[DI].TBufStream.BufPtr,0
  1101.         MOV     ES:[DI].TBufStream.BufEnd,AX
  1102.         OR      AX,AX
  1103.         JE      @@4
  1104. @@2:    CMP     CX,AX
  1105.         JB      @@3
  1106.         MOV     CX,AX
  1107. @@3:    PUSH    DS
  1108.         LDS     SI,ES:[DI].TBufStream.Buffer
  1109.         ADD     SI,ES:[DI].TBufStream.BufPtr
  1110.         ADD     ES:[DI].TBufStream.BufPtr,CX
  1111.         LES     DI,Buf
  1112.         ADD     DI,BX
  1113.         ADD     BX,CX
  1114.         CLD
  1115.         REP     MOVSB
  1116.         POP     DS
  1117.         JMP     @@1
  1118. @@4:    MOV     DX,stReadError
  1119. @@5:    CALL    DoStreamError
  1120. @@6:    LES     DI,Buf
  1121.         MOV     CX,Count
  1122.         XOR     AL,AL
  1123.         CLD
  1124.         REP     STOSB
  1125. @@7:
  1126. end;
  1127.  
  1128. procedure TBufStream.Seek(Pos: Longint); assembler;
  1129. asm
  1130.         LES     DI,Self
  1131.         PUSH    ES
  1132.         PUSH    DI
  1133.         CALL    TDosStream.GetPos
  1134.         OR      DX,DX
  1135.         JS      @@2
  1136.         LES     DI,Self
  1137.         SUB     AX,Pos.Word[0]
  1138.         SBB     DX,Pos.Word[2]
  1139.         JNE     @@1
  1140.         OR      AX,AX
  1141.         JE      @@1
  1142.         MOV     DX,ES:[DI].TBufStream.BufEnd
  1143.         SUB     DX,AX
  1144.         JB      @@1
  1145.         MOV     ES:[DI].TBufStream.BufPtr,DX
  1146.         JMP     @@2
  1147. @@1:    PUSH    Pos.Word[2]
  1148.         PUSH    Pos.Word[0]
  1149.         PUSH    ES
  1150.         PUSH    DI
  1151.         PUSH    ES
  1152.         PUSH    DI
  1153.         CALL    TBufStream.Flush
  1154.         CALL    TDosStream.Seek
  1155. @@2:
  1156. end;
  1157.  
  1158. procedure TBufStream.Truncate;
  1159. begin
  1160.   TBufStream.Flush;
  1161.   TDosStream.Truncate;
  1162. end;
  1163.  
  1164. procedure TBufStream.Write(var Buf; Count: Word); assembler;
  1165. asm
  1166.         LES     DI,Self
  1167.         CMP     ES:[DI].TBufStream.Status,0
  1168.         JNE     @@4
  1169.         MOV     AL,0
  1170.         CALL    FlushBuffer
  1171.         JNE     @@4
  1172.         XOR     DX,DX
  1173. @@1:    MOV     CX,Count
  1174.         SUB     CX,DX
  1175.         JE      @@4
  1176.         LES     DI,Self
  1177.         MOV     AX,ES:[DI].TBufStream.BufSize
  1178.         SUB     AX,ES:[DI].TBufStream.BufPtr
  1179.         JA      @@2
  1180.         PUSH    CX
  1181.         PUSH    DX
  1182.         MOV     AL,1
  1183.         CALL    FlushBuffer
  1184.         POP     DX
  1185.         POP     CX
  1186.         JNE     @@4
  1187.         MOV     AX,ES:[DI].TBufStream.BufSize
  1188. @@2:    CMP     CX,AX
  1189.         JB      @@3
  1190.         MOV     CX,AX
  1191. @@3:    PUSH    DS
  1192.         MOV     AX,ES:[DI].TBufStream.BufPtr
  1193.         ADD     ES:[DI].TBufStream.BufPtr,CX
  1194.         LES     DI,ES:[DI].TBufStream.Buffer
  1195.         ADD     DI,AX
  1196.         LDS     SI,Buf
  1197.         ADD     SI,DX
  1198.         ADD     DX,CX
  1199.         CLD
  1200.         REP     MOVSB
  1201.         POP     DS
  1202.         JMP     @@1
  1203. @@4:
  1204. end;
  1205.  
  1206. { TEmsStream }
  1207.  
  1208. const
  1209.   EmsPageSize = $4000;
  1210.  
  1211. var
  1212.   EmsBaseSeg: Word;
  1213.   EmsVersion: Byte;
  1214.  
  1215. procedure EmsSelectPage; near; assembler;
  1216. asm
  1217.         MOV     AX,ES:[DI].TEmsStream.Position.Word[0]
  1218.         MOV     DX,ES:[DI].TEmsStream.Position.Word[2]
  1219.         MOV     CX,EmsPageSize
  1220.         DIV     CX
  1221.         SUB     CX,DX
  1222.         MOV     SI,DX
  1223.         MOV     DX,ES:[DI].TEmsStream.Handle
  1224.         CMP     DX,EmsCurHandle
  1225.         JNE     @@1
  1226.         CMP     AX,EmsCurPage
  1227.         JE      @@3
  1228. @@1:    MOV     BX,AX
  1229.         MOV     AX,4400H
  1230.         INT     67H
  1231.         MOV     AL,AH
  1232.         AND     AX,0FFH
  1233.         JE      @@2
  1234.         MOV     DX,stError
  1235.         JMP     @@3
  1236. @@2:    MOV     EmsCurHandle,DX
  1237.         MOV     EmsCurPage,BX
  1238. @@3:
  1239. end;
  1240.  
  1241. procedure EmsSetPages; near; assembler;
  1242. asm
  1243.         CMP     EmsVersion,40H
  1244.         JAE     @@1
  1245.         MOV     AX,84H
  1246.         JMP     @@2
  1247. @@1:    MOV     DX,ES:[DI].TEmsStream.Handle
  1248.         MOV     BX,AX
  1249.         MOV     AH,51H
  1250.         INT     67H
  1251.         MOV     AL,AH
  1252.         AND     AX,0FFH
  1253.         JNE     @@2
  1254.         MOV     ES:[DI].TEmsStream.PageCount,BX
  1255. @@2:
  1256. end;
  1257.  
  1258. constructor TEmsStream.Init(MinSize, MaxSize: LongInt); assembler;
  1259. const
  1260.   EmsDeviceLen = 8;
  1261.   EmsDeviceStr: array[1..EmsDeviceLen] of Char = 'EMMXXXX0';
  1262. asm
  1263.         XOR     AX,AX
  1264.         PUSH    AX
  1265.         LES     DI,Self
  1266.         PUSH    ES
  1267.         PUSH    DI
  1268.         CALL    TStream.Init
  1269.         MOV     AX,3567H
  1270.         INT     21H
  1271.         MOV     CX,EmsDeviceLen
  1272.         MOV     SI,OFFSET EmsDeviceStr
  1273.         MOV     DI,0AH
  1274.         CLD
  1275.         REP     CMPSB
  1276.         LES     DI,Self
  1277.         MOV     AX,-1
  1278.         JNE     @@3
  1279.         MOV     AH,41H
  1280.         INT     67H
  1281.         MOV     EmsBaseSeg,BX
  1282.         MOV     AH,46H
  1283.         INT     67H
  1284.         MOV     EmsVersion,AL
  1285.         MOV     CX,EmsPageSize
  1286.         MOV     AX,MinSize.Word[0]
  1287.         MOV     DX,MinSize.Word[2]
  1288.         ADD     AX,EmsPageSize-1
  1289.         ADC     DX,0
  1290.         DIV     CX
  1291.         MOV     BX,AX
  1292.         CMP     EmsVersion,40H
  1293.         JAE     @@2
  1294.         PUSH    AX
  1295.         MOV     AX,MaxSize.Word[0]
  1296.         MOV     DX,MaxSize.Word[2]
  1297.         ADD     AX,EmsPageSize-1
  1298.         ADC     DX,0
  1299.         DIV     CX
  1300.         MOV     CX,AX
  1301.         MOV     AH,42H
  1302.         INT     67H
  1303.         POP     AX
  1304.         CMP     BX,CX
  1305.         JB      @@1
  1306.         MOV     BX,CX
  1307. @@1:    CMP     BX,AX
  1308.         JA      @@2
  1309.         MOV     BX,AX
  1310. @@2:    MOV     AH,43H
  1311.         INT     67H
  1312.         MOV     AL,AH
  1313.         AND     AX,0FFH
  1314.         JE      @@4
  1315. @@3:    MOV     DX,stInitError
  1316.         CALL    DoStreamError
  1317.         MOV     DX,-1
  1318.         XOR     BX,BX
  1319. @@4:    MOV     ES:[DI].TEmsStream.Handle,DX
  1320.         MOV     ES:[DI].TEmsStream.PageCount,BX
  1321.     XOR    AX,AX
  1322.     ADD    DI,OFFSET TEmsStream.Size
  1323.     MOV    CX,4
  1324.     REP    STOSW
  1325. end;
  1326.  
  1327. destructor TEmsStream.Done; assembler;
  1328. asm
  1329.         LES     DI,Self
  1330.         MOV     DX,ES:[DI].TEmsStream.Handle
  1331.         CMP     DX,-1
  1332.         JE      @@1
  1333.         MOV     AH,45H
  1334.         INT     67H
  1335. @@1:    XOR     AX,AX
  1336.         PUSH    AX
  1337.         PUSH    ES
  1338.         PUSH    DI
  1339.         CALL    TStream.Done
  1340. end;
  1341.  
  1342. function TEmsStream.GetPos: Longint; assembler;
  1343. asm
  1344.         LES     DI,Self
  1345.         CMP     ES:[DI].TEmsStream.Status,0
  1346.         JNE     @@1
  1347.         MOV     AX,ES:[DI].TEmsStream.Position.Word[0]
  1348.         MOV     DX,ES:[DI].TEmsStream.Position.Word[2]
  1349.         JMP     @@2
  1350. @@1:    MOV     AX,-1
  1351.         CWD
  1352. @@2:
  1353. end;
  1354.  
  1355. function TEmsStream.GetSize: Longint; assembler;
  1356. asm
  1357.         LES     DI,Self
  1358.         CMP     ES:[DI].TEmsStream.Status,0
  1359.         JNE     @@1
  1360.         MOV     AX,ES:[DI].TEmsStream.Size.Word[0]
  1361.         MOV     DX,ES:[DI].TEmsStream.Size.Word[2]
  1362.         JMP     @@2
  1363. @@1:    MOV     AX,-1
  1364.         CWD
  1365. @@2:
  1366. end;
  1367.  
  1368. procedure TEmsStream.Read(var Buf; Count: Word); assembler;
  1369. asm
  1370.         LES     DI,Self
  1371.         XOR     BX,BX
  1372.         CMP     BX,ES:[DI].TEmsStream.Status
  1373.         JNE     @@3
  1374.         MOV     AX,ES:[DI].TEmsStream.Position.Word[0]
  1375.         MOV     DX,ES:[DI].TEmsStream.Position.Word[2]
  1376.         ADD     AX,Count
  1377.         ADC     DX,BX
  1378.         CMP     DX,ES:[DI].TEmsStream.Size.Word[2]
  1379.         JA      @@1
  1380.         JB      @@7
  1381.         CMP     AX,ES:[DI].TEmsStream.Size.Word[0]
  1382.         JBE     @@7
  1383. @@1:    XOR     AX,AX
  1384.         MOV     DX,stReadError
  1385. @@2:    CALL    DoStreamError
  1386. @@3:    LES     DI,Buf
  1387.         MOV     CX,Count
  1388.         XOR     AL,AL
  1389.         CLD
  1390.         REP     STOSB
  1391.         JMP     @@8
  1392. @@5:    PUSH    BX
  1393.         CALL    EmsSelectPage
  1394.         POP     BX
  1395.         JNE     @@2
  1396.         MOV     AX,Count
  1397.         SUB     AX,BX
  1398.         CMP     CX,AX
  1399.         JB      @@6
  1400.         MOV     CX,AX
  1401. @@6:    ADD     ES:[DI].TEmsStream.Position.Word[0],CX
  1402.         ADC     ES:[DI].TEmsStream.Position.Word[2],0
  1403.         PUSH    ES
  1404.         PUSH    DS
  1405.         PUSH    DI
  1406.         LES     DI,Buf
  1407.         ADD     DI,BX
  1408.         ADD     BX,CX
  1409.         MOV     DS,EmsBaseSeg
  1410.         CLD
  1411.         REP     MOVSB
  1412.         POP     DI
  1413.         POP     DS
  1414.         POP     ES
  1415. @@7:    CMP     BX,Count
  1416.         JB      @@5
  1417. @@8:
  1418. end;
  1419.  
  1420. procedure TEmsStream.Seek(Pos: Longint); assembler;
  1421. asm
  1422.         LES     DI,Self
  1423.         MOV     AX,Pos.Word[0]
  1424.         MOV     DX,Pos.Word[2]
  1425.         OR      DX,DX
  1426.         JNS     @@1
  1427.         XOR     AX,AX
  1428.         CWD
  1429. @@1:    MOV     ES:[DI].TEmsStream.Position.Word[0],AX
  1430.         MOV     ES:[DI].TEmsStream.Position.Word[2],DX
  1431. end;
  1432.  
  1433. procedure TEmsStream.Truncate; assembler;
  1434. asm
  1435.         LES     DI,Self
  1436.         XOR     BX,BX
  1437.         CMP     ES:[DI].TEmsStream.Status,BX
  1438.         JNE     @@2
  1439.         CMP     EmsVersion,40H
  1440.         JB      @@1
  1441.         MOV     AX,ES:[DI].TEmsStream.Position.Word[0]
  1442.         MOV     DX,ES:[DI].TEmsStream.Position.Word[2]
  1443.         ADD     AX,EmsPageSize-1
  1444.         ADC     DX,BX
  1445.         MOV     CX,EmsPageSize
  1446.         DIV     CX
  1447.         CALL    EmsSetPages
  1448.         JE      @@1
  1449.         MOV     DX,stError
  1450.         CALL    DoStreamError
  1451.         JMP     @@2
  1452. @@1:    MOV     AX,ES:[DI].TEmsStream.Position.Word[0]
  1453.         MOV     DX,ES:[DI].TEmsStream.Position.Word[2]
  1454.         MOV     ES:[DI].TEmsStream.Size.Word[0],AX
  1455.         MOV     ES:[DI].TEmsStream.Size.Word[2],DX
  1456. @@2:
  1457. end;
  1458.  
  1459. procedure TEmsStream.Write(var Buf; Count: Word); assembler;
  1460. asm
  1461.         LES     DI,Self
  1462.         XOR     BX,BX
  1463.         CMP     BX,ES:[DI].TEmsStream.Status
  1464.         JNE     @@7
  1465.         MOV     AX,ES:[DI].TEmsStream.Position.Word[0]
  1466.         MOV     DX,ES:[DI].TEmsStream.Position.Word[2]
  1467.         ADD     AX,Count
  1468.         ADC     DX,BX
  1469.         ADD     AX,EmsPageSize-1
  1470.         ADC     DX,BX
  1471.         MOV     CX,EmsPageSize
  1472.         DIV     CX
  1473.         CMP     AX,ES:[DI].TEmsStream.PageCount
  1474.         JBE     @@4
  1475.         PUSH    BX
  1476.         CALL    EmsSetPages
  1477.         POP     BX
  1478.         JE      @@4
  1479. @@1:    MOV     DX,stWriteError
  1480.         CALL    DoStreamError
  1481.         JMP     @@7
  1482. @@2:    PUSH    BX
  1483.         CALL    EmsSelectPage
  1484.         POP     BX
  1485.         JNE     @@1
  1486.         MOV     AX,Count
  1487.         SUB     AX,BX
  1488.         CMP     CX,AX
  1489.         JB      @@3
  1490.         MOV     CX,AX
  1491. @@3:    ADD     ES:[DI].TEmsStream.Position.Word[0],CX
  1492.         ADC     ES:[DI].TEmsStream.Position.Word[2],0
  1493.         PUSH    ES
  1494.         PUSH    DS
  1495.         PUSH    DI
  1496.         MOV     DI,SI
  1497.         MOV     ES,EmsBaseSeg
  1498.         LDS     SI,Buf
  1499.         ADD     SI,BX
  1500.         ADD     BX,CX
  1501.         CLD
  1502.         REP     MOVSB
  1503.         POP     DI
  1504.         POP     DS
  1505.         POP     ES
  1506. @@4:    CMP     BX,Count
  1507.         JB      @@2
  1508. @@5:    MOV     AX,ES:[DI].TEmsStream.Position.Word[0]
  1509.         MOV     DX,ES:[DI].TEmsStream.Position.Word[2]
  1510.         CMP     DX,ES:[DI].TEmsStream.Size.Word[2]
  1511.         JB      @@7
  1512.         JA      @@6
  1513.         CMP     AX,ES:[DI].TEmsStream.Size.Word[0]
  1514.         JBE     @@7
  1515. @@6:    MOV     ES:[DI].TEmsStream.Size.Word[0],AX
  1516.         MOV     ES:[DI].TEmsStream.Size.Word[2],DX
  1517. @@7:
  1518. end;
  1519.  
  1520. { TMemoryStream }
  1521.  
  1522. const
  1523.   MaxSegArraySize = 16384;
  1524.  
  1525. {$IFDEF NewExeFormat}
  1526.  
  1527.   DefaultBlockSize = $2000;
  1528.  
  1529. {$ELSE}
  1530.  
  1531.   DefaultBlockSize = $0800;
  1532.  
  1533. {$ENDIF}
  1534.  
  1535. procedure MemSelectSeg; near; assembler;
  1536. asm
  1537.         MOV     AX,ES:[DI].TMemoryStream.Position.Word[0]
  1538.         MOV     DX,ES:[DI].TMemoryStream.Position.Word[2]
  1539.         MOV     CX,ES:[DI].TMemoryStream.BlockSize
  1540.         DIV     CX
  1541.         SUB     CX,DX
  1542.         MOV     SI,DX
  1543.         SHL     AX,1
  1544.         MOV     ES:[DI].TMemoryStream.CurSeg,AX
  1545. end;
  1546.  
  1547. const
  1548.   MemStreamSize = (SizeOf(TMemoryStream) - SizeOf(TStream)) div 2;
  1549.  
  1550. constructor TMemoryStream.Init(ALimit: Longint; ABlockSize: Word); assembler;
  1551. asm
  1552.         XOR     AX,AX
  1553.         PUSH    AX
  1554.         LES     DI,Self
  1555.         PUSH    ES
  1556.         PUSH    DI
  1557.         CALL    TStream.Init
  1558.         LES     DI,Self
  1559. {$IFDEF Windows}
  1560.         XOR     AX,AX
  1561.         PUSH    DI
  1562.         ADD     DI,OFFSET TMemoryStream.SegCount
  1563.         MOV     CX,MemStreamSize
  1564.         REP     STOSW
  1565.         POP     DI
  1566. {$ENDIF}
  1567.         CMP     ABlockSize,0
  1568.         JNZ     @@1
  1569.         MOV     ABlockSize,DefaultBlockSize
  1570. @@1:    MOV     AX,ALimit.Word[0]
  1571.         MOV     DX,ALimit.Word[2]
  1572.         DIV     ABlockSize
  1573.         NEG     DX
  1574.         ADC     AX,0
  1575.         MOV     DX,ABlockSize
  1576.         MOV     ES:[DI].TMemoryStream.BlockSize,DX
  1577.         PUSH    AX
  1578.         PUSH    ES
  1579.         PUSH    DI
  1580.         CALL    ChangeListSize
  1581.         LES     DI,Self
  1582.         OR      AX,AX
  1583.         JNZ     @@2
  1584.         MOV     DX,stInitError
  1585.         CALL    DoStreamError
  1586.         MOV     ALimit.Word[0],0
  1587.         MOV     ALimit.Word[2],0
  1588. @@2:    MOV     AX,ALimit.Word[0]
  1589.         MOV     DX,ALimit.Word[2]
  1590.         MOV     ES:[DI].TMemoryStream.Size.Word[0],AX
  1591.         MOV     ES:[DI].TMemoryStream.Size.Word[2],DX
  1592. end;
  1593.  
  1594. destructor TMemoryStream.Done;
  1595. begin
  1596.   ChangeListSize(0);
  1597.   inherited Done;
  1598. end;
  1599.  
  1600. function TMemoryStream.ChangeListSize(ALimit: Word): Boolean;
  1601. var
  1602.   AItems: PWordArray;
  1603.   Dif, Term: Word;
  1604.   NewBlock: Pointer;
  1605. begin
  1606.   ChangeListSize := False;
  1607.   if ALimit > MaxSegArraySize then ALimit := MaxSegArraySize;
  1608.   if ALimit <> SegCount then
  1609.   begin
  1610.     if ALimit = 0 then AItems := nil else
  1611.     begin
  1612.       AItems := MemAlloc(ALimit * SizeOf(Word));
  1613.       if AItems = nil then Exit;
  1614.       if (SegCount <> 0) and (SegList <> nil) then
  1615.         if SegCount > ALimit then
  1616.           Move(SegList^, AItems^, ALimit * SizeOf(Word))
  1617.         else
  1618.           Move(SegList^, AItems^, SegCount * SizeOf(Word));
  1619.     end;
  1620.     if ALimit < SegCount then
  1621.     begin
  1622.       Dif  := ALimit;
  1623.       Term := SegCount - 1;
  1624.       while Dif <= Term do
  1625.       begin
  1626.         FreeMem(Ptr(SegList^[Dif], 0), BlockSize);
  1627.         Inc(Dif);
  1628.       end;
  1629.     end
  1630.     else
  1631.     begin
  1632.       Dif := SegCount;
  1633.       Term := ALimit - 1;
  1634.       while Dif <= Term do
  1635.       begin
  1636.         NewBlock := MemAllocSeg(BlockSize);
  1637.         if NewBlock = nil then Exit
  1638.         else AItems^[Dif] := PtrRec(NewBlock).Seg;
  1639.         Inc(Dif);
  1640.       end;
  1641.     end;
  1642.     if SegCount <> 0 then FreeMem(SegList, SegCount * SizeOf(Word));
  1643.     SegList := AItems;
  1644.     SegCount := ALimit;
  1645.   end;
  1646.   ChangeListSize := True;
  1647. end;
  1648.  
  1649. function TMemoryStream.GetPos: Longint; assembler;
  1650. asm
  1651.         LES     DI,Self
  1652.         CMP     ES:[DI].TMemoryStream.Status,0
  1653.         JNE     @@1
  1654.         MOV     AX,ES:[DI].TMemoryStream.Position.Word[0]
  1655.         MOV     DX,ES:[DI].TMemoryStream.Position.Word[2]
  1656.         JMP     @@2
  1657. @@1:    MOV     AX,-1
  1658.         CWD
  1659. @@2:
  1660. end;
  1661.  
  1662. function TMemoryStream.GetSize: Longint; assembler;
  1663. asm
  1664.         LES     DI,Self
  1665.         CMP     ES:[DI].TMemoryStream.Status,0
  1666.         JNE     @@1
  1667.         MOV     AX,ES:[DI].TMemoryStream.Size.Word[0]
  1668.         MOV     DX,ES:[DI].TMemoryStream.Size.Word[2]
  1669.         JMP     @@2
  1670. @@1:    MOV     AX,-1
  1671.         CWD
  1672. @@2:
  1673. end;
  1674.  
  1675. procedure TMemoryStream.Read(var Buf; Count: Word); assembler;
  1676. asm
  1677.         LES     DI,Self
  1678.         XOR     BX,BX
  1679.         CMP     BX,ES:[DI].TMemoryStream.Status
  1680.         JNE     @@3
  1681.         MOV     AX,ES:[DI].TMemoryStream.Position.Word[0]
  1682.         MOV     DX,ES:[DI].TMemoryStream.Position.Word[2]
  1683.         ADD     AX,Count
  1684.         ADC     DX,BX
  1685.         CMP     DX,ES:[DI].TMemoryStream.Size.Word[2]
  1686.         JA      @@1
  1687.         JB      @@7
  1688.         CMP     AX,ES:[DI].TMemoryStream.Size.Word[0]
  1689.         JBE     @@7
  1690. @@1:    XOR     AX,AX
  1691.         MOV     DX,stReadError
  1692. @@2:    CALL    DoStreamError
  1693. @@3:    LES     DI,Buf
  1694.         MOV     CX,Count
  1695.         XOR     AL,AL
  1696.         CLD
  1697.         REP     STOSB
  1698.         JMP     @@8
  1699. @@5:    CALL    MemSelectSeg
  1700.         MOV     AX,Count
  1701.         SUB     AX,BX
  1702.         CMP     CX,AX
  1703.         JB      @@6
  1704.         MOV     CX,AX
  1705. @@6:    ADD     ES:[DI].TMemoryStream.Position.Word[0],CX
  1706.         ADC     ES:[DI].TMemoryStream.Position.Word[2],0
  1707.         PUSH    ES
  1708.         PUSH    DS
  1709.         PUSH    DI
  1710.         MOV     DX,ES:[DI].TMemoryStream.CurSeg
  1711.         LES     DI,ES:[DI].TMemoryStream.SegList
  1712.         ADD     DI,DX
  1713.         MOV     DS,WORD PTR ES:[DI]
  1714.         LES     DI,Buf
  1715.         ADD     DI,BX
  1716.         ADD     BX,CX
  1717.         CLD
  1718.         REP     MOVSB
  1719.         POP     DI
  1720.         POP     DS
  1721.         POP     ES
  1722. @@7:    CMP     BX,Count
  1723.         JB      @@5
  1724. @@8:
  1725. end;
  1726.  
  1727. procedure TMemoryStream.Seek(Pos: Longint); assembler;
  1728. asm
  1729.         LES     DI,Self
  1730.         MOV     AX,Pos.Word[0]
  1731.         MOV     DX,Pos.Word[2]
  1732.         OR      DX,DX
  1733.         JNS     @@1
  1734.         XOR     AX,AX
  1735.         CWD
  1736. @@1:    MOV     ES:[DI].TMemoryStream.Position.Word[0],AX
  1737.         MOV     ES:[DI].TMemoryStream.Position.Word[2],DX
  1738. end;
  1739.  
  1740. procedure TMemoryStream.Truncate; assembler;
  1741. asm
  1742.         LES     DI,Self
  1743.         XOR     BX,BX
  1744.         CMP     ES:[DI].TMemoryStream.Status,BX
  1745.         JNE     @@2
  1746.         MOV     AX,ES:[DI].TMemoryStream.Position.Word[0]
  1747.         MOV     DX,ES:[DI].TMemoryStream.Position.Word[2]
  1748.         DIV     ES:[DI].TMemoryStream.BlockSize
  1749.         NEG     DX
  1750.         ADC     AX,BX
  1751.         PUSH    AX
  1752.         PUSH    ES
  1753.         PUSH    DI
  1754.         CALL    ChangeListSize
  1755.         OR      AX,AX
  1756.         JNZ     @@1
  1757.         MOV     DX,stError
  1758.         CALL    DoStreamError
  1759.         JMP     @@2
  1760. @@1:    LES     DI,Self
  1761.         MOV     AX,ES:[DI].TMemoryStream.Position.Word[0]
  1762.         MOV     DX,ES:[DI].TMemoryStream.Position.Word[2]
  1763.         MOV     ES:[DI].TMemoryStream.Size.Word[0],AX
  1764.         MOV     ES:[DI].TMemoryStream.Size.Word[2],DX
  1765. @@2:
  1766. end;
  1767.  
  1768. procedure TMemoryStream.Write(var Buf; Count: Word); assembler;
  1769. asm
  1770.         LES     DI,Self
  1771.         XOR     BX,BX
  1772.         CMP     BX,ES:[DI].TMemoryStream.Status
  1773.         JNE     @@7
  1774.         MOV     AX,ES:[DI].TMemoryStream.Position.Word[0]
  1775.         MOV     DX,ES:[DI].TMemoryStream.Position.Word[2]
  1776.         ADD     AX,Count
  1777.         ADC     DX,BX
  1778.         DIV     ES:[DI].TMemoryStream.BlockSize
  1779.         NEG     DX
  1780.         ADC     AX,BX
  1781.         CMP     AX,ES:[DI].TMemoryStream.SegCount
  1782.         JBE     @@4
  1783.         PUSH    BX
  1784.         PUSH    ES
  1785.         PUSH    DI
  1786.         PUSH    AX
  1787.         PUSH    ES
  1788.         PUSH    DI
  1789.         CALL    ChangeListSize
  1790.         POP     DI
  1791.         POP     ES
  1792.         POP     BX
  1793.         OR      AX,AX
  1794.         JNZ     @@4
  1795. @@1:    MOV     DX,stWriteError
  1796.         CALL    DoStreamError
  1797.         JMP     @@7
  1798. @@2:    CALL    MemSelectSeg
  1799.         MOV     AX,Count
  1800.         SUB     AX,BX
  1801.         CMP     CX,AX
  1802.         JB      @@3
  1803.         MOV     CX,AX
  1804. @@3:    ADD     ES:[DI].TMemoryStream.Position.Word[0],CX
  1805.         ADC     ES:[DI].TMemoryStream.Position.Word[2],0
  1806.         PUSH    ES
  1807.         PUSH    DS
  1808.         PUSH    DI
  1809.         MOV     DX,ES:[DI].TMemoryStream.CurSeg
  1810.         LES     DI,ES:[DI].TMemoryStream.SegList
  1811.         ADD     DI,DX
  1812.         MOV     ES,WORD PTR ES:[DI]
  1813.         MOV     DI,SI
  1814.         LDS     SI,Buf
  1815.         ADD     SI,BX
  1816.         ADD     BX,CX
  1817.         CLD
  1818.         REP     MOVSB
  1819.         POP     DI
  1820.         POP     DS
  1821.         POP     ES
  1822. @@4:    CMP     BX,Count
  1823.         JB      @@2
  1824. @@5:    MOV     AX,ES:[DI].TMemoryStream.Position.Word[0]
  1825.         MOV     DX,ES:[DI].TMemoryStream.Position.Word[2]
  1826.         CMP     DX,ES:[DI].TMemoryStream.Size.Word[2]
  1827.         JB      @@7
  1828.         JA      @@6
  1829.         CMP     AX,ES:[DI].TMemoryStream.Size.Word[0]
  1830.         JBE     @@7
  1831. @@6:    MOV     ES:[DI].TMemoryStream.Size.Word[0],AX
  1832.         MOV     ES:[DI].TMemoryStream.Size.Word[2],DX
  1833. @@7:
  1834. end;
  1835.  
  1836. { TCollection }
  1837.  
  1838. const
  1839.   TCollection_Error    = vmtHeaderSize + $04;
  1840.   TCollection_SetLimit = vmtHeaderSize + $1C;
  1841.  
  1842. procedure CollectionError; near; assembler;
  1843. asm
  1844.         PUSH    AX
  1845.         PUSH    BX
  1846.         PUSH    ES
  1847.         PUSH    DI
  1848.         MOV     DI,ES:[DI]
  1849.         CALL    DWORD PTR [DI].TCollection_Error
  1850. end;
  1851.  
  1852. constructor TCollection.Init(ALimit, ADelta: Integer);
  1853. begin
  1854.   TObject.Init;
  1855.   Items := nil;
  1856.   Count := 0;
  1857.   Limit := 0;
  1858.   Delta := ADelta;
  1859.   SetLimit(ALimit);
  1860. end;
  1861.  
  1862. constructor TCollection.Load(var S: TStream);
  1863. var
  1864.   C, I: Integer;
  1865. begin
  1866.   S.Read(Count, SizeOf(Integer) * 3);
  1867.   Items := nil;
  1868.   C := Count;
  1869.   I := Limit;
  1870.   Count := 0;
  1871.   Limit := 0;
  1872.   SetLimit(I);
  1873.   Count := C;
  1874.   for I := 0 to C - 1 do AtPut(I, GetItem(S));
  1875. end;
  1876.  
  1877. destructor TCollection.Done;
  1878. begin
  1879.   FreeAll;
  1880.   SetLimit(0);
  1881. end;
  1882.  
  1883. function TCollection.At(Index: Integer): Pointer; assembler;
  1884. asm
  1885.         LES     DI,Self
  1886.         MOV     BX,Index
  1887.         OR      BX,BX
  1888.         JL      @@1
  1889.         CMP     BX,ES:[DI].TCollection.Count
  1890.         JGE     @@1
  1891.         LES     DI,ES:[DI].TCollection.Items
  1892.         SHL     BX,1
  1893.         SHL     BX,1
  1894.     MOV    AX,ES:[DI+BX]
  1895.     MOV    DX,ES:[DI+BX+2]
  1896.         JMP     @@2
  1897. @@1:    MOV     AX,coIndexError
  1898.         CALL    CollectionError
  1899.         XOR     AX,AX
  1900.         MOV     DX,AX
  1901. @@2:
  1902. end;
  1903.  
  1904. procedure TCollection.AtDelete(Index: Integer); assembler;
  1905. asm
  1906.         LES     DI,Self
  1907.         MOV     BX,Index
  1908.         OR      BX,BX
  1909.         JL      @@1
  1910.         CMP     BX,ES:[DI].TCollection.Count
  1911.         JGE     @@1
  1912.         DEC     ES:[DI].TCollection.Count
  1913.         MOV     CX,ES:[DI].TCollection.Count
  1914.         SUB     CX,BX
  1915.         JE      @@2
  1916.         CLD
  1917.         LES     DI,ES:[DI].TCollection.Items
  1918.         SHL     BX,1
  1919.         SHL     BX,1
  1920.         ADD     DI,BX
  1921.         LEA     SI,[DI+4]
  1922.         SHL     CX,1
  1923.         PUSH    DS
  1924.         PUSH    ES
  1925.         POP     DS
  1926.         REP     MOVSW
  1927.         POP     DS
  1928.         JMP     @@2
  1929. @@1:    MOV     AX,coIndexError
  1930.         CALL    CollectionError
  1931. @@2:
  1932. end;
  1933.  
  1934. procedure TCollection.AtFree(Index: Integer);
  1935. var
  1936.   Item: Pointer;
  1937. begin
  1938.   Item := At(Index);
  1939.   AtDelete(Index);
  1940.   FreeItem(Item);
  1941. end;
  1942.  
  1943. procedure TCollection.AtInsert(Index: Integer; Item: Pointer); assembler;
  1944. asm
  1945.         LES     DI,Self
  1946.         MOV     BX,Index
  1947.         OR      BX,BX
  1948.         JL      @@3
  1949.         MOV     CX,ES:[DI].TCollection.Count
  1950.         CMP     BX,CX
  1951.         JG      @@3
  1952.         CMP     CX,ES:[DI].TCollection.Limit
  1953.         JNE     @@1
  1954.         PUSH    CX
  1955.         PUSH    BX
  1956.         ADD     CX,ES:[DI].TCollection.Delta
  1957.         PUSH    CX
  1958.         PUSH    ES
  1959.         PUSH    DI
  1960.         MOV     DI,ES:[DI]
  1961.         CALL    DWORD PTR [DI].TCollection_SetLimit
  1962.         POP     BX
  1963.         POP     CX
  1964.         LES     DI,Self
  1965.         CMP     CX,ES:[DI].TCollection.Limit
  1966.         JE      @@4
  1967. @@1:    INC     ES:[DI].TCollection.Count
  1968.         STD
  1969.         LES     DI,ES:[DI].TCollection.Items
  1970.         SHL     CX,1
  1971.         ADD     DI,CX
  1972.         ADD     DI,CX
  1973.         INC     DI
  1974.         INC     DI
  1975.         SHL     BX,1
  1976.         SUB     CX,BX
  1977.         JE      @@2
  1978.         LEA     SI,[DI-4]
  1979.         PUSH    DS
  1980.         PUSH    ES
  1981.         POP     DS
  1982.         REP     MOVSW
  1983.         POP     DS
  1984. @@2:    MOV     AX,WORD PTR [Item+2]
  1985.         STOSW
  1986.         MOV     AX,WORD PTR [Item]
  1987.         STOSW
  1988.         CLD
  1989.         JMP     @@6
  1990. @@3:    MOV     AX,coIndexError
  1991.         JMP     @@5
  1992. @@4:    MOV     AX,coOverflow
  1993.         MOV     BX,CX
  1994. @@5:    CALL    CollectionError
  1995. @@6:
  1996. end;
  1997.  
  1998. procedure TCollection.AtPut(Index: Integer; Item: Pointer); assembler;
  1999. asm
  2000.     MOV    AX,Item.Word[0]
  2001.         MOV    DX,Item.Word[2]
  2002.         LES    DI,Self
  2003.         MOV     BX,Index
  2004.         OR      BX,BX
  2005.         JL      @@1
  2006.         CMP     BX,ES:[DI].TCollection.Count
  2007.         JGE     @@1
  2008.         LES     DI,ES:[DI].TCollection.Items
  2009.         SHL     BX,1
  2010.         SHL     BX,1
  2011.         MOV     ES:[DI+BX],AX
  2012.         MOV     ES:[DI+BX+2],DX
  2013.         JMP     @@2
  2014. @@1:    MOV     AX,coIndexError
  2015.         CALL    CollectionError
  2016. @@2:
  2017. end;
  2018.  
  2019. procedure TCollection.Delete(Item: Pointer);
  2020. begin
  2021.   AtDelete(IndexOf(Item));
  2022. end;
  2023.  
  2024. procedure TCollection.DeleteAll;
  2025. begin
  2026.   Count := 0;
  2027. end;
  2028.  
  2029. procedure TCollection.Error(Code, Info: Integer);
  2030. begin
  2031.   RunError(212 - Code);
  2032. end;
  2033.  
  2034. function TCollection.FirstThat(Test: Pointer): Pointer; assembler;
  2035. asm
  2036.         LES     DI,Self
  2037.         MOV     CX,ES:[DI].TCollection.Count
  2038.         JCXZ    @@2
  2039.         LES     DI,ES:[DI].TCollection.Items
  2040. @@1:    PUSH    ES
  2041.         PUSH    DI
  2042.         PUSH    CX
  2043.         PUSH    WORD PTR ES:[DI+2]
  2044.         PUSH    WORD PTR ES:[DI]
  2045. {$IFDEF Windows}
  2046.     MOV    AX,[BP]
  2047.     AND    AL,0FEH
  2048.     PUSH    AX
  2049. {$ELSE}
  2050.         PUSH    WORD PTR [BP]
  2051. {$ENDIF}
  2052.         CALL    Test
  2053.         POP     CX
  2054.         POP     DI
  2055.         POP     ES
  2056.         OR      AL,AL
  2057.         JNE     @@3
  2058.         ADD     DI,4
  2059.         LOOP    @@1
  2060. @@2:    XOR     AX,AX
  2061.         MOV     DX,AX
  2062.         JMP     @@4
  2063. @@3:    MOV    AX,ES:[DI]
  2064.     MOV    DX,ES:[DI+2]
  2065. @@4:
  2066. end;
  2067.  
  2068. procedure TCollection.ForEach(Action: Pointer); assembler;
  2069. asm
  2070.         LES     DI,Self
  2071.         MOV     CX,ES:[DI].TCollection.Count
  2072.         JCXZ    @@2
  2073.         LES     DI,ES:[DI].TCollection.Items
  2074. @@1:    PUSH    ES
  2075.         PUSH    DI
  2076.         PUSH    CX
  2077.         PUSH    WORD PTR ES:[DI+2]
  2078.         PUSH    WORD PTR ES:[DI]
  2079. {$IFDEF Windows}
  2080.     MOV    AX,[BP]
  2081.     AND    AL,0FEH
  2082.     PUSH    AX
  2083. {$ELSE}
  2084.         PUSH    WORD PTR [BP]
  2085. {$ENDIF}
  2086.         CALL    Action
  2087.         POP     CX
  2088.         POP     DI
  2089.         POP     ES
  2090.         ADD     DI,4
  2091.         LOOP    @@1
  2092. @@2:
  2093. end;
  2094.  
  2095. procedure TCollection.Free(Item: Pointer);
  2096. begin
  2097.   Delete(Item);
  2098.   FreeItem(Item);
  2099. end;
  2100.  
  2101. procedure TCollection.FreeAll;
  2102. var
  2103.   I: Integer;
  2104. begin
  2105.   for I := 0 to Count - 1 do FreeItem(At(I));
  2106.   Count := 0;
  2107. end;
  2108.  
  2109. procedure TCollection.FreeItem(Item: Pointer);
  2110. begin
  2111.   if Item <> nil then Dispose(PObject(Item), Done);
  2112. end;
  2113.  
  2114. function TCollection.GetItem(var S: TStream): Pointer;
  2115. begin
  2116.   GetItem := S.Get;
  2117. end;
  2118.  
  2119. function TCollection.IndexOf(Item: Pointer): Integer; assembler;
  2120. asm
  2121.     MOV    AX,Item.Word[0]
  2122.     MOV    DX,Item.Word[2]
  2123.         LES     DI,Self
  2124.         MOV     CX,ES:[DI].TCollection.Count
  2125.         JCXZ    @@3
  2126.         LES     DI,ES:[DI].TCollection.Items
  2127.         MOV     BX,DI
  2128.         SHL     CX,1
  2129.         CLD
  2130. @@1:    REPNE   SCASW
  2131.         JCXZ    @@3
  2132.         TEST    CX,1
  2133.         JE      @@1
  2134.         XCHG    AX,DX
  2135.         SCASW
  2136.         XCHG    AX,DX
  2137.         LOOPNE  @@1
  2138.         JNE     @@3
  2139.         MOV     AX,DI
  2140.         SUB     AX,BX
  2141.         SHR     AX,1
  2142.         SHR     AX,1
  2143.         DEC     AX
  2144.         JMP     @@2
  2145. @@3:    MOV     AX,-1
  2146. @@2:
  2147. end;
  2148.  
  2149. procedure TCollection.Insert(Item: Pointer);
  2150. begin
  2151.   AtInsert(Count, Item);
  2152. end;
  2153.  
  2154. function TCollection.LastThat(Test: Pointer): Pointer; assembler;
  2155. asm
  2156.         LES     DI,Self
  2157.         MOV     CX,ES:[DI].TCollection.Count
  2158.         JCXZ    @@2
  2159.         LES     DI,ES:[DI].TCollection.Items
  2160.         MOV     AX,CX
  2161.         SHL     AX,1
  2162.         SHL     AX,1
  2163.         ADD     DI,AX
  2164. @@1:    SUB     DI,4
  2165.         PUSH    ES
  2166.         PUSH    DI
  2167.         PUSH    CX
  2168.         PUSH    WORD PTR ES:[DI+2]
  2169.         PUSH    WORD PTR ES:[DI]
  2170. {$IFDEF Windows}
  2171.     MOV    AX,[BP]
  2172.     AND    AL,0FEH
  2173.     PUSH    AX
  2174. {$ELSE}
  2175.         PUSH    WORD PTR [BP]
  2176. {$ENDIF}
  2177.         CALL    Test
  2178.         POP     CX
  2179.         POP     DI
  2180.         POP     ES
  2181.         OR      AL,AL
  2182.         JNE     @@3
  2183.         LOOP    @@1
  2184. @@2:    XOR     AX,AX
  2185.         MOV     DX,AX
  2186.         JMP     @@4
  2187. @@3:    MOV    AX,ES:[DI]
  2188.     MOV    DX,ES:[DI+2]
  2189. @@4:
  2190. end;
  2191.  
  2192. procedure TCollection.Pack; assembler;
  2193. asm
  2194.         LES     DI,Self
  2195.         MOV     CX,ES:[DI].TCollection.Count
  2196.         JCXZ    @@3
  2197.         LES     DI,ES:[DI].TCollection.Items
  2198.         MOV     SI,DI
  2199.         PUSH    DS
  2200.         PUSH    ES
  2201.         POP     DS
  2202.         CLD
  2203. @@1:    LODSW
  2204.         XCHG    AX,DX
  2205.         LODSW
  2206.         MOV     BX,AX
  2207.         OR      BX,DX
  2208.         JE      @@2
  2209.         XCHG    AX,DX
  2210.         STOSW
  2211.         XCHG    AX,DX
  2212.         STOSW
  2213. @@2:    LOOP    @@1
  2214.         POP     DS
  2215.         LES     BX,Self
  2216.         SUB     DI,WORD PTR ES:[BX].TCollection.Items
  2217.         SHR     DI,1
  2218.         SHR     DI,1
  2219.         MOV     ES:[BX].TCollection.Count,DI
  2220. @@3:
  2221. end;
  2222.  
  2223. procedure TCollection.PutItem(var S: TStream; Item: Pointer);
  2224. begin
  2225.   S.Put(Item);
  2226. end;
  2227.  
  2228. procedure TCollection.SetLimit(ALimit: Integer);
  2229. var
  2230.   AItems: PItemList;
  2231. begin
  2232.   if ALimit < Count then ALimit := Count;
  2233.   if ALimit > MaxCollectionSize then ALimit := MaxCollectionSize;
  2234.   if ALimit <> Limit then
  2235.   begin
  2236.     if ALimit = 0 then AItems := nil else
  2237.     begin
  2238.       GetMem(AItems, ALimit * SizeOf(Pointer));
  2239.       if (Count <> 0) and (Items <> nil) then
  2240.         Move(Items^, AItems^, Count * SizeOf(Pointer));
  2241.     end;
  2242.     if Limit <> 0 then FreeMem(Items, Limit * SizeOf(Pointer));
  2243.     Items := AItems;
  2244.     Limit := ALimit;
  2245.   end;
  2246. end;
  2247.  
  2248. procedure TCollection.Store(var S: TStream);
  2249.  
  2250. procedure DoPutItem(P: Pointer); far;
  2251. begin
  2252.   PutItem(S, P);
  2253. end;
  2254.  
  2255. begin
  2256.   S.Write(Count, SizeOf(Integer) * 3);
  2257.   ForEach(@DoPutItem);
  2258. end;
  2259.  
  2260. { TSortedCollection }
  2261.  
  2262. constructor TSortedCollection.Init(ALimit, ADelta: Integer);
  2263. begin
  2264.   TCollection.Init(ALimit, ADelta);
  2265.   Duplicates := False;
  2266. end;
  2267.  
  2268. constructor TSortedCollection.Load(var S: TStream);
  2269. begin
  2270.   TCollection.Load(S);
  2271.   S.Read(Duplicates, SizeOf(Boolean));
  2272. end;
  2273.  
  2274. function TSortedCollection.Compare(Key1, Key2: Pointer): Integer;
  2275. begin
  2276.   Abstract;
  2277. end;
  2278.  
  2279. function TSortedCollection.IndexOf(Item: Pointer): Integer;
  2280. var
  2281.   I: Integer;
  2282. begin
  2283.   IndexOf := -1;
  2284.   if Search(KeyOf(Item), I) then
  2285.   begin
  2286.     if Duplicates then
  2287.       while (I < Count) and (Item <> Items^[I]) do Inc(I);
  2288.     if I < Count then IndexOf := I;
  2289.   end;
  2290. end;
  2291.  
  2292. procedure TSortedCollection.Insert(Item: Pointer);
  2293. var
  2294.   I: Integer;
  2295. begin
  2296.   if not Search(KeyOf(Item), I) or Duplicates then AtInsert(I, Item);
  2297. end;
  2298.  
  2299. function TSortedCollection.KeyOf(Item: Pointer): Pointer;
  2300. begin
  2301.   KeyOf := Item;
  2302. end;
  2303.  
  2304. function TSortedCollection.Search(Key: Pointer; var Index: Integer): Boolean;
  2305. var
  2306.   L, H, I, C: Integer;
  2307. begin
  2308.   Search := False;
  2309.   L := 0;
  2310.   H := Count - 1;
  2311.   while L <= H do
  2312.   begin
  2313.     I := (L + H) shr 1;
  2314.     C := Compare(KeyOf(Items^[I]), Key);
  2315.     if C < 0 then L := I + 1 else
  2316.     begin
  2317.       H := I - 1;
  2318.       if C = 0 then
  2319.       begin
  2320.         Search := True;
  2321.         if not Duplicates then L := I;
  2322.       end;
  2323.     end;
  2324.   end;
  2325.   Index := L;
  2326. end;
  2327.  
  2328. procedure TSortedCollection.Store(var S: TStream);
  2329. begin
  2330.   TCollection.Store(S);
  2331.   S.Write(Duplicates, SizeOf(Boolean));
  2332. end;
  2333.  
  2334. { TStringCollection }
  2335.  
  2336. function TStringCollection.Compare(Key1, Key2: Pointer): Integer; assembler;
  2337. asm
  2338.         PUSH    DS
  2339.         CLD
  2340.         LDS     SI,Key1
  2341.         LES     DI,Key2
  2342.         LODSB
  2343.         MOV     AH,ES:[DI]
  2344.         INC     DI
  2345.         MOV     CL,AL
  2346.         CMP     CL,AH
  2347.         JBE     @@1
  2348.         MOV     CL,AH
  2349. @@1:    XOR     CH,CH
  2350.         REP     CMPSB
  2351.         JE      @@2
  2352.         MOV     AL,DS:[SI-1]
  2353.         MOV     AH,ES:[DI-1]
  2354. @@2:    SUB     AL,AH
  2355.         SBB     AH,AH
  2356.         POP     DS
  2357. end;
  2358.  
  2359. procedure TStringCollection.FreeItem(Item: Pointer);
  2360. begin
  2361.   DisposeStr(Item);
  2362. end;
  2363.  
  2364. function TStringCollection.GetItem(var S: TStream): Pointer;
  2365. begin
  2366.   GetItem := S.ReadStr;
  2367. end;
  2368.  
  2369. procedure TStringCollection.PutItem(var S: TStream; Item: Pointer);
  2370. begin
  2371.   S.WriteStr(Item);
  2372. end;
  2373.  
  2374. { TStrCollection }
  2375.  
  2376. function TStrCollection.Compare(Key1, Key2: Pointer): Integer;
  2377. begin
  2378.   Compare := StrComp(Key1, Key2);
  2379. end;
  2380.  
  2381. procedure TStrCollection.FreeItem(Item: Pointer);
  2382. begin
  2383.   StrDispose(Item);
  2384. end;
  2385.  
  2386. function TStrCollection.GetItem(var S: TStream): Pointer;
  2387. begin
  2388.   GetItem := S.StrRead;
  2389. end;
  2390.  
  2391. procedure TStrCollection.PutItem(var S: TStream; Item: Pointer);
  2392. begin
  2393.   S.StrWrite(Item);
  2394. end;
  2395.  
  2396. {$IFNDEF Windows }
  2397.  
  2398. { Private resource manager types }
  2399.  
  2400. const
  2401.   RStreamMagic: Longint = $52504246; { 'FBPR' }
  2402.   RStreamBackLink: Longint = $4C424246; { 'FBBL' }
  2403.  
  2404. type
  2405.   PResourceItem = ^TResourceItem;
  2406.   TResourceItem = record
  2407.     Pos: Longint;
  2408.     Size: Longint;
  2409.     Key: String;
  2410.   end;
  2411.  
  2412. { TResourceCollection }
  2413.  
  2414. procedure TResourceCollection.FreeItem(Item: Pointer);
  2415. begin
  2416.   FreeMem(Item, Length(PResourceItem(Item)^.Key) +
  2417.     (SizeOf(TResourceItem) - SizeOf(String) + 1));
  2418. end;
  2419.  
  2420. function TResourceCollection.GetItem(var S: TStream): Pointer;
  2421. var
  2422.   Pos: Longint;
  2423.   Size: Longint;
  2424.   L: Byte;
  2425.   P: PResourceItem;
  2426. begin
  2427.   S.Read(Pos, SizeOf(Longint));
  2428.   S.Read(Size, SizeOf(Longint));
  2429.   S.Read(L, 1);
  2430.   GetMem(P, L + (SizeOf(TResourceItem) - SizeOf(String) + 1));
  2431.   P^.Pos := Pos;
  2432.   P^.Size := Size;
  2433.   P^.Key[0] := Char(L);
  2434.   S.Read(P^.Key[1], L);
  2435.   GetItem := P;
  2436. end;
  2437.  
  2438. function TResourceCollection.KeyOf(Item: Pointer): Pointer; assembler;
  2439. asm
  2440.         MOV     AX,Item.Word[0]
  2441.         MOV     DX,Item.Word[2]
  2442.         ADD     AX,OFFSET TResourceItem.Key
  2443. end;
  2444.  
  2445. procedure TResourceCollection.PutItem(var S: TStream; Item: Pointer);
  2446. begin
  2447.   S.Write(PResourceItem(Item)^, Length(PResourceItem(Item)^.Key) +
  2448.     (SizeOf(TResourceItem) - SizeOf(String) + 1));
  2449. end;
  2450.  
  2451. { TResourceFile }
  2452.  
  2453. constructor TResourceFile.Init(AStream: PStream);
  2454. type
  2455.  
  2456. {$IFDEF NewExeFormat}
  2457.  
  2458.   TExeHeader = record
  2459.     eHdrSize:   Word;
  2460.     eMinAbove:  Word;
  2461.     eMaxAbove:  Word;
  2462.     eInitSS:    Word;
  2463.     eInitSP:    Word;
  2464.     eCheckSum:  Word;
  2465.     eInitPC:    Word;
  2466.     eInitCS:    Word;
  2467.     eRelocOfs:  Word;
  2468.     eOvlyNum:   Word;
  2469.     eRelocTab:  Word;
  2470.     eSpace:     Array[1..30] of Byte;
  2471.     eNewHeader: Word;
  2472.   end;
  2473.  
  2474. {$ENDIF}
  2475.  
  2476.   THeader = record
  2477.     Signature: Word;
  2478.     case Integer of
  2479.       0: (
  2480.         LastCount: Word;
  2481.         PageCount: Word;
  2482.         ReloCount: Word);
  2483.       1: (
  2484.         InfoType: Word;
  2485.         InfoSize: Longint);
  2486.   end;
  2487. var
  2488.   Found, Stop: Boolean;
  2489.   Header: THeader;
  2490.  
  2491. {$IFDEF NewExeFormat}
  2492.  
  2493.   ExeHeader: TExeHeader;
  2494.  
  2495. {$ENDIF}
  2496.  
  2497. begin
  2498.   TObject.Init;
  2499.   Stream := AStream;
  2500.   BasePos := Stream^.GetPos;
  2501.   Found := False;
  2502.   repeat
  2503.     Stop := True;
  2504.     if BasePos <= Stream^.GetSize - SizeOf(THeader) then
  2505.     begin
  2506.       Stream^.Seek(BasePos);
  2507.       Stream^.Read(Header, SizeOf(THeader));
  2508.       case Header.Signature of
  2509.  
  2510. {$IFDEF NewExeFormat}
  2511.  
  2512.         $5A4D:
  2513.           begin
  2514.             Stream^.Read(ExeHeader, SizeOf(TExeHeader));
  2515.             BasePos := ExeHeader.eNewHeader;
  2516.             Stop := False;
  2517.           end;
  2518.         $454E:
  2519.           begin
  2520.             BasePos := Stream^.GetSize - 8;
  2521.             Stop := False;
  2522.           end;
  2523.         $4246:
  2524.           begin
  2525.             Stop := False;
  2526.             case Header.Infotype of
  2527.               $5250:                                    {Found Resource}
  2528.                 begin
  2529.                   Found := True;
  2530.                   Stop := True;
  2531.                 end;
  2532.               $4C42: Dec(BasePos, Header.InfoSize - 8); {Found BackLink}
  2533.               $4648: Dec(BasePos, SizeOf(THeader) * 2); {Found HelpFile}
  2534.             else
  2535.               Stop := True;
  2536.             end;
  2537.           end;
  2538.         $424E:
  2539.           if Header.InfoType = $3230 then               {Found Debug Info}
  2540.           begin
  2541.             Dec(BasePos, Header.InfoSize);
  2542.             Stop := False;
  2543.           end;
  2544.  
  2545. {$ELSE}
  2546.  
  2547.         $5A4D:
  2548.           begin
  2549.             Inc(BasePos, LongMul(Header.PageCount, 512) -
  2550.               (-Header.LastCount and 511));
  2551.             Stop := False;
  2552.           end;
  2553.         $4246:
  2554.           if Header.InfoType = $5250 then Found := True else
  2555.           begin
  2556.             Inc(BasePos, Header.InfoSize + 8);
  2557.             Stop := False;
  2558.           end;
  2559.  
  2560. {$ENDIF}
  2561.  
  2562.       end;
  2563.     end;
  2564.   until Stop;
  2565.   if Found then
  2566.   begin
  2567.     Stream^.Seek(BasePos + SizeOf(Longint) * 2);
  2568.     Stream^.Read(IndexPos, SizeOf(Longint));
  2569.     Stream^.Seek(BasePos + IndexPos);
  2570.     Index.Load(Stream^);
  2571.   end else
  2572.   begin
  2573.     IndexPos := SizeOf(Longint) * 3;
  2574.     Index.Init(0, 8);
  2575.   end;
  2576. end;
  2577.  
  2578. destructor TResourceFile.Done;
  2579. begin
  2580.   Flush;
  2581.   Index.Done;
  2582.   Dispose(Stream, Done);
  2583. end;
  2584.  
  2585. function TResourceFile.Count: Integer;
  2586. begin
  2587.   Count := Index.Count;
  2588. end;
  2589.  
  2590. procedure TResourceFile.Delete(Key: String);
  2591. var
  2592.   I: Integer;
  2593. begin
  2594.   if Index.Search(@Key, I) then
  2595.   begin
  2596.     Index.Free(Index.At(I));
  2597.     Modified := True;
  2598.   end;
  2599. end;
  2600.  
  2601. procedure TResourceFile.Flush;
  2602. var
  2603.   ResSize: Longint;
  2604.   LinkSize: Longint;
  2605. begin
  2606.   if Modified then
  2607.   begin
  2608.     Stream^.Seek(BasePos + IndexPos);
  2609.     Index.Store(Stream^);
  2610.     ResSize := Stream^.GetPos - BasePos;
  2611.     LinkSize := ResSize + SizeOf(Longint) * 2;
  2612.     Stream^.Write(RStreamBackLink, SizeOf(Longint));
  2613.     Stream^.Write(LinkSize, SizeOf(Longint));
  2614.     Stream^.Seek(BasePos);
  2615.     Stream^.Write(RStreamMagic, SizeOf(Longint));
  2616.     Stream^.Write(ResSize, SizeOf(Longint));
  2617.     Stream^.Write(IndexPos, SizeOf(Longint));
  2618.     Stream^.Flush;
  2619.     Modified := False;
  2620.   end;
  2621. end;
  2622.  
  2623. function TResourceFile.Get(Key: String): PObject;
  2624. var
  2625.   I: Integer;
  2626. begin
  2627.   if not Index.Search(@Key, I) then Get := nil else
  2628.   begin
  2629.     Stream^.Seek(BasePos + PResourceItem(Index.At(I))^.Pos);
  2630.     Get := Stream^.Get;
  2631.   end;
  2632. end;
  2633.  
  2634. function TResourceFile.KeyAt(I: Integer): String;
  2635. begin
  2636.   KeyAt := PResourceItem(Index.At(I))^.Key;
  2637. end;
  2638.  
  2639. procedure TResourceFile.Put(Item: PObject; Key: String);
  2640. var
  2641.   I: Integer;
  2642.   P: PResourceItem;
  2643. begin
  2644.   if Index.Search(@Key, I) then P := Index.At(I) else
  2645.   begin
  2646.     GetMem(P, Length(Key) + (SizeOf(TResourceItem) - SizeOf(String) + 1));
  2647.     P^.Key := Key;
  2648.     Index.AtInsert(I, P);
  2649.   end;
  2650.   P^.Pos := IndexPos;
  2651.   Stream^.Seek(BasePos + IndexPos);
  2652.   Stream^.Put(Item);
  2653.   IndexPos := Stream^.GetPos - BasePos;
  2654.   P^.Size := IndexPos - P^.Pos;
  2655.   Modified := True;
  2656. end;
  2657.  
  2658. function TResourceFile.SwitchTo(AStream: PStream; Pack: Boolean): PStream;
  2659. var
  2660.   NewBasePos: Longint;
  2661.  
  2662. procedure DoCopyResource(Item: PResourceItem); far;
  2663. begin
  2664.   Stream^.Seek(BasePos + Item^.Pos);
  2665.   Item^.Pos := AStream^.GetPos - NewBasePos;
  2666.   AStream^.CopyFrom(Stream^, Item^.Size);
  2667. end;
  2668.  
  2669. begin
  2670.   SwitchTo := Stream;
  2671.   NewBasePos := AStream^.GetPos;
  2672.   if Pack then
  2673.   begin
  2674.     AStream^.Seek(NewBasePos + SizeOf(Longint) * 3);
  2675.     Index.ForEach(@DoCopyResource);
  2676.     IndexPos := AStream^.GetPos - NewBasePos;
  2677.   end else
  2678.   begin
  2679.     Stream^.Seek(BasePos);
  2680.     AStream^.CopyFrom(Stream^, IndexPos);
  2681.   end;
  2682.   Stream := AStream;
  2683.   Modified := True;
  2684.   BasePos := NewBasePos;
  2685. end;
  2686.  
  2687. { TStringList }
  2688.  
  2689. constructor TStringList.Load(var S: TStream);
  2690. var
  2691.   Size: Word;
  2692. begin
  2693.   Stream := @S;
  2694.   S.Read(Size, SizeOf(Word));
  2695.   BasePos := S.GetPos;
  2696.   S.Seek(BasePos + Size);
  2697.   S.Read(IndexSize, SizeOf(Integer));
  2698.   GetMem(Index, IndexSize * SizeOf(TStrIndexRec));
  2699.   S.Read(Index^, IndexSize * SizeOf(TStrIndexRec));
  2700. end;
  2701.  
  2702. destructor TStringList.Done;
  2703. begin
  2704.   FreeMem(Index, IndexSize * SizeOf(TStrIndexRec));
  2705. end;
  2706.  
  2707. function TStringList.Get(Key: Word): String; assembler;
  2708. asm
  2709.         PUSH    DS
  2710.         LDS     SI,Self
  2711.         LES     DI,@Result
  2712.         CLD
  2713.         MOV     CX,DS:[SI].TStringList.IndexSize
  2714.         JCXZ    @@2
  2715.         MOV     BX,Key
  2716.         LDS     SI,DS:[SI].TStringList.Index
  2717. @@1:    MOV     DX,BX
  2718.         LODSW
  2719.         SUB     DX,AX
  2720.         LODSW
  2721.         CMP     DX,AX
  2722.         LODSW
  2723.         JB      @@3
  2724.         LOOP    @@1
  2725. @@2:    POP     DS
  2726.         XOR     AL,AL
  2727.         STOSB
  2728.         JMP     @@4
  2729. @@3:    POP     DS
  2730.         PUSH    ES
  2731.         PUSH    DI
  2732.         PUSH    AX
  2733.         PUSH    DX
  2734.         LES     DI,Self
  2735.         PUSH    ES
  2736.         PUSH    DI
  2737.         CALL    TStringList.ReadStr
  2738. @@4:
  2739. end;
  2740.  
  2741. procedure TStringList.ReadStr(var S: String; Offset, Skip: Word);
  2742. begin
  2743.   Stream^.Seek(BasePos + Offset);
  2744.   Inc(Skip);
  2745.   repeat
  2746.     Stream^.Read(S[0], 1);
  2747.     Stream^.Read(S[1], Ord(S[0]));
  2748.     Dec(Skip);
  2749.   until Skip = 0;
  2750. end;
  2751.  
  2752. { TStrListMaker }
  2753.  
  2754. constructor TStrListMaker.Init(AStrSize, AIndexSize: Word);
  2755. begin
  2756.   TObject.Init;
  2757.   StrSize := AStrSize;
  2758.   IndexSize := AIndexSize;
  2759.   GetMem(Strings, AStrSize);
  2760.   GetMem(Index, AIndexSize * SizeOf(TStrIndexRec));
  2761. end;
  2762.  
  2763. destructor TStrListMaker.Done;
  2764. begin
  2765.   FreeMem(Index, IndexSize * SizeOf(TStrIndexRec));
  2766.   FreeMem(Strings, StrSize);
  2767. end;
  2768.  
  2769. procedure TStrListMaker.CloseCurrent;
  2770. begin
  2771.   if Cur.Count <> 0 then
  2772.   begin
  2773.     Index^[IndexPos] := Cur;
  2774.     Inc(IndexPos);
  2775.     Cur.Count := 0;
  2776.   end;
  2777. end;
  2778.  
  2779. procedure TStrListMaker.Put(Key: Word; S: String);
  2780. begin
  2781.   if (Cur.Count = 16) or (Key <> Cur.Key + Cur.Count) then CloseCurrent;
  2782.   if Cur.Count = 0 then
  2783.   begin
  2784.     Cur.Key := Key;
  2785.     Cur.Offset := StrPos;
  2786.   end;
  2787.   Inc(Cur.Count);
  2788.   Move(S, Strings^[StrPos], Length(S) + 1);
  2789.   Inc(StrPos, Length(S) + 1);
  2790. end;
  2791.  
  2792. procedure TStrListMaker.Store(var S: TStream);
  2793. begin
  2794.   CloseCurrent;
  2795.   S.Write(StrPos, SizeOf(Word));
  2796.   S.Write(Strings^, StrPos);
  2797.   S.Write(IndexPos, SizeOf(Word));
  2798.   S.Write(Index^, IndexPos * SizeOf(TStrIndexRec));
  2799. end;
  2800.  
  2801. { TRect }
  2802.  
  2803. procedure CheckEmpty; near; assembler;
  2804. asm
  2805.         MOV     AX,ES:[DI].TRect.A.X
  2806.         CMP     AX,ES:[DI].TRect.B.X
  2807.         JGE     @@1
  2808.         MOV     AX,ES:[DI].TRect.A.Y
  2809.         CMP     AX,ES:[DI].TRect.B.Y
  2810.         JL      @@2
  2811. @@1:    CLD
  2812.         XOR     AX,AX
  2813.         STOSW
  2814.         STOSW
  2815.         STOSW
  2816.         STOSW
  2817. @@2:
  2818. end;
  2819.  
  2820. procedure TRect.Assign(XA, YA, XB, YB: Integer); assembler;
  2821. asm
  2822.         LES     DI,Self
  2823.         CLD
  2824.         MOV     AX,XA
  2825.         STOSW
  2826.         MOV     AX,YA
  2827.         STOSW
  2828.         MOV     AX,XB
  2829.         STOSW
  2830.         MOV     AX,YB
  2831.         STOSW
  2832. end;
  2833.  
  2834. procedure TRect.Copy(R: TRect); assembler;
  2835. asm
  2836.         PUSH    DS
  2837.         LDS     SI,R
  2838.         LES     DI,Self
  2839.         CLD
  2840.         MOVSW
  2841.         MOVSW
  2842.         MOVSW
  2843.         MOVSW
  2844.         POP     DS
  2845. end;
  2846.  
  2847. procedure TRect.Move(ADX, ADY: Integer); assembler;
  2848. asm
  2849.         LES     DI,Self
  2850.         MOV     AX,ADX
  2851.         ADD     ES:[DI].TRect.A.X,AX
  2852.         ADD     ES:[DI].TRect.B.X,AX
  2853.         MOV     AX,ADY
  2854.         ADD     ES:[DI].TRect.A.Y,AX
  2855.         ADD     ES:[DI].TRect.B.Y,AX
  2856. end;
  2857.  
  2858. procedure TRect.Grow(ADX, ADY: Integer); assembler;
  2859. asm
  2860.         LES     DI,Self
  2861.         MOV     AX,ADX
  2862.         SUB     ES:[DI].TRect.A.X,AX
  2863.         ADD     ES:[DI].TRect.B.X,AX
  2864.         MOV     AX,ADY
  2865.         SUB     ES:[DI].TRect.A.Y,AX
  2866.         ADD     ES:[DI].TRect.B.Y,AX
  2867.         CALL    CheckEmpty
  2868. end;
  2869.  
  2870. procedure TRect.Intersect(R: TRect); assembler;
  2871. asm
  2872.         PUSH    DS
  2873.         LDS     SI,R
  2874.         LES     DI,Self
  2875.         CLD
  2876.         LODSW
  2877.         SCASW
  2878.         JLE     @@1
  2879.         DEC     DI
  2880.         DEC     DI
  2881.         STOSW
  2882. @@1:    LODSW
  2883.         SCASW
  2884.         JLE     @@2
  2885.         DEC     DI
  2886.         DEC     DI
  2887.         STOSW
  2888. @@2:    LODSW
  2889.         SCASW
  2890.         JGE     @@3
  2891.         DEC     DI
  2892.         DEC     DI
  2893.         STOSW
  2894. @@3:    LODSW
  2895.         SCASW
  2896.         JGE     @@4
  2897.         DEC     DI
  2898.         DEC     DI
  2899.         STOSW
  2900. @@4:    POP     DS
  2901.         SUB     DI,8
  2902.         CALL    CheckEmpty
  2903. end;
  2904.  
  2905. procedure TRect.Union(R: TRect); assembler;
  2906. asm
  2907.         PUSH    DS
  2908.         LDS     SI,R
  2909.         LES     DI,Self
  2910.         CLD
  2911.         LODSW
  2912.         SCASW
  2913.         JGE     @@1
  2914.         DEC     DI
  2915.         DEC     DI
  2916.         STOSW
  2917. @@1:    LODSW
  2918.         SCASW
  2919.         JGE     @@2
  2920.         DEC     DI
  2921.         DEC     DI
  2922.         STOSW
  2923. @@2:    LODSW
  2924.         SCASW
  2925.         JLE     @@3
  2926.         DEC     DI
  2927.         DEC     DI
  2928.         STOSW
  2929. @@3:    LODSW
  2930.         SCASW
  2931.         JLE     @@4
  2932.         DEC     DI
  2933.         DEC     DI
  2934.         STOSW
  2935. @@4:    POP     DS
  2936. end;
  2937.  
  2938. function TRect.Contains(P: TPoint): Boolean; assembler;
  2939. asm
  2940.         LES     DI,Self
  2941.         MOV     AL,0
  2942.         MOV     DX,P.X
  2943.         CMP     DX,ES:[DI].TRect.A.X
  2944.         JL      @@1
  2945.         CMP     DX,ES:[DI].TRect.B.X
  2946.         JGE     @@1
  2947.         MOV     DX,P.Y
  2948.         CMP     DX,ES:[DI].TRect.A.Y
  2949.         JL      @@1
  2950.         CMP     DX,ES:[DI].TRect.B.Y
  2951.         JGE     @@1
  2952.         INC     AX
  2953. @@1:
  2954. end;
  2955.  
  2956. function TRect.Equals(R: TRect): Boolean; assembler;
  2957. asm
  2958.         PUSH    DS
  2959.         LDS     SI,R
  2960.         LES     DI,Self
  2961.         MOV     CX,4
  2962.         CLD
  2963.         REP     CMPSW
  2964.         MOV     AL,0
  2965.         JNE     @@1
  2966.         INC     AX
  2967. @@1:    POP     DS
  2968. end;
  2969.  
  2970. function TRect.Empty: Boolean; assembler;
  2971. asm
  2972.         LES     DI,Self
  2973.         MOV     AL,1
  2974.         MOV     DX,ES:[DI].TRect.A.X
  2975.         CMP     DX,ES:[DI].TRect.B.X
  2976.         JGE     @@1
  2977.         MOV     DX,ES:[DI].TRect.A.Y
  2978.         CMP     DX,ES:[DI].TRect.B.Y
  2979.         JGE     @@1
  2980.         DEC     AX
  2981. @@1:
  2982. end;
  2983.  
  2984. {$ENDIF}
  2985.  
  2986. { Dynamic string handling routines }
  2987.  
  2988. function NewStr(const S: String): PString;
  2989. var
  2990.   P: PString;
  2991. begin
  2992.   if S = '' then P := nil else
  2993.   begin
  2994.     GetMem(P, Length(S) + 1);
  2995.     P^ := S;
  2996.   end;
  2997.   NewStr := P;
  2998. end;
  2999.  
  3000. procedure DisposeStr(P: PString);
  3001. begin
  3002.   if P <> nil then FreeMem(P, Length(P^) + 1);
  3003. end;
  3004.  
  3005. { Objects registration procedure }
  3006.  
  3007. procedure RegisterObjects;
  3008. begin
  3009.   RegisterType(RCollection);
  3010.   RegisterType(RStringCollection);
  3011.   RegisterType(RStrCollection);
  3012. end;
  3013.  
  3014. end.
  3015.