home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk14 / rtl70.pak / OBJECTS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-08-24  |  69.4 KB  |  3,018 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      AL,AL
  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.       FillChar(AItems^, ALimit * SizeOf(Word), 0);
  1615.       if (SegCount <> 0) and (SegList <> nil) then
  1616.         if SegCount > ALimit then
  1617.           Move(SegList^, AItems^, ALimit * SizeOf(Word))
  1618.         else
  1619.           Move(SegList^, AItems^, SegCount * SizeOf(Word));
  1620.     end;
  1621.     if ALimit < SegCount then
  1622.     begin
  1623.       Dif  := ALimit;
  1624.       Term := SegCount - 1;
  1625.       while Dif <= Term do
  1626.       begin
  1627.         if SegList^[Dif] <> 0 then
  1628.           FreeMem(Ptr(SegList^[Dif], 0), BlockSize);
  1629.         Inc(Dif);
  1630.       end;
  1631.     end
  1632.     else
  1633.     begin
  1634.       Dif := SegCount;
  1635.       Term := ALimit - 1;
  1636.       while Dif <= Term do
  1637.       begin
  1638.         NewBlock := MemAllocSeg(BlockSize);
  1639.         if NewBlock = nil then Break
  1640.         else AItems^[Dif] := PtrRec(NewBlock).Seg;
  1641.         Inc(Dif);
  1642.       end;
  1643.       if Dif = ALimit then
  1644.         ChangeListSize := True;
  1645.     end;
  1646.     if SegCount <> 0 then FreeMem(SegList, SegCount * SizeOf(Word));
  1647.     SegList := AItems;
  1648.     SegCount := ALimit;
  1649.   end else ChangeListSize := True;
  1650. end;
  1651.  
  1652. function TMemoryStream.GetPos: Longint; assembler;
  1653. asm
  1654.         LES     DI,Self
  1655.         CMP     ES:[DI].TMemoryStream.Status,0
  1656.         JNE     @@1
  1657.         MOV     AX,ES:[DI].TMemoryStream.Position.Word[0]
  1658.         MOV     DX,ES:[DI].TMemoryStream.Position.Word[2]
  1659.         JMP     @@2
  1660. @@1:    MOV     AX,-1
  1661.         CWD
  1662. @@2:
  1663. end;
  1664.  
  1665. function TMemoryStream.GetSize: Longint; assembler;
  1666. asm
  1667.         LES     DI,Self
  1668.         CMP     ES:[DI].TMemoryStream.Status,0
  1669.         JNE     @@1
  1670.         MOV     AX,ES:[DI].TMemoryStream.Size.Word[0]
  1671.         MOV     DX,ES:[DI].TMemoryStream.Size.Word[2]
  1672.         JMP     @@2
  1673. @@1:    MOV     AX,-1
  1674.         CWD
  1675. @@2:
  1676. end;
  1677.  
  1678. procedure TMemoryStream.Read(var Buf; Count: Word); assembler;
  1679. asm
  1680.         LES     DI,Self
  1681.         XOR     BX,BX
  1682.         CMP     BX,ES:[DI].TMemoryStream.Status
  1683.         JNE     @@3
  1684.         MOV     AX,ES:[DI].TMemoryStream.Position.Word[0]
  1685.         MOV     DX,ES:[DI].TMemoryStream.Position.Word[2]
  1686.         ADD     AX,Count
  1687.         ADC     DX,BX
  1688.         CMP     DX,ES:[DI].TMemoryStream.Size.Word[2]
  1689.         JA      @@1
  1690.         JB      @@7
  1691.         CMP     AX,ES:[DI].TMemoryStream.Size.Word[0]
  1692.         JBE     @@7
  1693. @@1:    XOR     AX,AX
  1694.         MOV     DX,stReadError
  1695. @@2:    CALL    DoStreamError
  1696. @@3:    LES     DI,Buf
  1697.         MOV     CX,Count
  1698.         XOR     AL,AL
  1699.         CLD
  1700.         REP     STOSB
  1701.         JMP     @@8
  1702. @@5:    CALL    MemSelectSeg
  1703.         MOV     AX,Count
  1704.         SUB     AX,BX
  1705.         CMP     CX,AX
  1706.         JB      @@6
  1707.         MOV     CX,AX
  1708. @@6:    ADD     ES:[DI].TMemoryStream.Position.Word[0],CX
  1709.         ADC     ES:[DI].TMemoryStream.Position.Word[2],0
  1710.         PUSH    ES
  1711.         PUSH    DS
  1712.         PUSH    DI
  1713.         MOV     DX,ES:[DI].TMemoryStream.CurSeg
  1714.         LES     DI,ES:[DI].TMemoryStream.SegList
  1715.         ADD     DI,DX
  1716.         MOV     DS,WORD PTR ES:[DI]
  1717.         LES     DI,Buf
  1718.         ADD     DI,BX
  1719.         ADD     BX,CX
  1720.         CLD
  1721.         REP     MOVSB
  1722.         POP     DI
  1723.         POP     DS
  1724.         POP     ES
  1725. @@7:    CMP     BX,Count
  1726.         JB      @@5
  1727. @@8:
  1728. end;
  1729.  
  1730. procedure TMemoryStream.Seek(Pos: Longint); assembler;
  1731. asm
  1732.         LES     DI,Self
  1733.         MOV     AX,Pos.Word[0]
  1734.         MOV     DX,Pos.Word[2]
  1735.         OR      DX,DX
  1736.         JNS     @@1
  1737.         XOR     AX,AX
  1738.         CWD
  1739. @@1:    MOV     ES:[DI].TMemoryStream.Position.Word[0],AX
  1740.         MOV     ES:[DI].TMemoryStream.Position.Word[2],DX
  1741. end;
  1742.  
  1743. procedure TMemoryStream.Truncate; assembler;
  1744. asm
  1745.         LES     DI,Self
  1746.         XOR     BX,BX
  1747.         CMP     ES:[DI].TMemoryStream.Status,BX
  1748.         JNE     @@2
  1749.         MOV     AX,ES:[DI].TMemoryStream.Position.Word[0]
  1750.         MOV     DX,ES:[DI].TMemoryStream.Position.Word[2]
  1751.         DIV     ES:[DI].TMemoryStream.BlockSize
  1752.         NEG     DX
  1753.         ADC     AX,BX
  1754.         PUSH    AX
  1755.         PUSH    ES
  1756.         PUSH    DI
  1757.         CALL    ChangeListSize
  1758.         OR      AL,AL
  1759.         JNZ     @@1
  1760.         MOV     DX,stError
  1761.         CALL    DoStreamError
  1762.         JMP     @@2
  1763. @@1:    LES     DI,Self
  1764.         MOV     AX,ES:[DI].TMemoryStream.Position.Word[0]
  1765.         MOV     DX,ES:[DI].TMemoryStream.Position.Word[2]
  1766.         MOV     ES:[DI].TMemoryStream.Size.Word[0],AX
  1767.         MOV     ES:[DI].TMemoryStream.Size.Word[2],DX
  1768. @@2:
  1769. end;
  1770.  
  1771. procedure TMemoryStream.Write(var Buf; Count: Word); assembler;
  1772. asm
  1773.         LES     DI,Self
  1774.         XOR     BX,BX
  1775.         CMP     BX,ES:[DI].TMemoryStream.Status
  1776.         JNE     @@7
  1777.         MOV     AX,ES:[DI].TMemoryStream.Position.Word[0]
  1778.         MOV     DX,ES:[DI].TMemoryStream.Position.Word[2]
  1779.         ADD     AX,Count
  1780.         ADC     DX,BX
  1781.         DIV     ES:[DI].TMemoryStream.BlockSize
  1782.         NEG     DX
  1783.         ADC     AX,BX
  1784.         CMP     AX,ES:[DI].TMemoryStream.SegCount
  1785.         JBE     @@4
  1786.         PUSH    BX
  1787.         PUSH    ES
  1788.         PUSH    DI
  1789.         PUSH    AX
  1790.         PUSH    ES
  1791.         PUSH    DI
  1792.         CALL    ChangeListSize
  1793.         POP     DI
  1794.         POP     ES
  1795.         POP     BX
  1796.         OR      AL,AL
  1797.         JNZ     @@4
  1798. @@1:    MOV     DX,stWriteError
  1799.         CALL    DoStreamError
  1800.         JMP     @@7
  1801. @@2:    CALL    MemSelectSeg
  1802.         MOV     AX,Count
  1803.         SUB     AX,BX
  1804.         CMP     CX,AX
  1805.         JB      @@3
  1806.         MOV     CX,AX
  1807. @@3:    ADD     ES:[DI].TMemoryStream.Position.Word[0],CX
  1808.         ADC     ES:[DI].TMemoryStream.Position.Word[2],0
  1809.         PUSH    ES
  1810.         PUSH    DS
  1811.         PUSH    DI
  1812.         MOV     DX,ES:[DI].TMemoryStream.CurSeg
  1813.         LES     DI,ES:[DI].TMemoryStream.SegList
  1814.         ADD     DI,DX
  1815.         MOV     ES,WORD PTR ES:[DI]
  1816.         MOV     DI,SI
  1817.         LDS     SI,Buf
  1818.         ADD     SI,BX
  1819.         ADD     BX,CX
  1820.         CLD
  1821.         REP     MOVSB
  1822.         POP     DI
  1823.         POP     DS
  1824.         POP     ES
  1825. @@4:    CMP     BX,Count
  1826.         JB      @@2
  1827. @@5:    MOV     AX,ES:[DI].TMemoryStream.Position.Word[0]
  1828.         MOV     DX,ES:[DI].TMemoryStream.Position.Word[2]
  1829.         CMP     DX,ES:[DI].TMemoryStream.Size.Word[2]
  1830.         JB      @@7
  1831.         JA      @@6
  1832.         CMP     AX,ES:[DI].TMemoryStream.Size.Word[0]
  1833.         JBE     @@7
  1834. @@6:    MOV     ES:[DI].TMemoryStream.Size.Word[0],AX
  1835.         MOV     ES:[DI].TMemoryStream.Size.Word[2],DX
  1836. @@7:
  1837. end;
  1838.  
  1839. { TCollection }
  1840.  
  1841. const
  1842.   TCollection_Error    = vmtHeaderSize + $04;
  1843.   TCollection_SetLimit = vmtHeaderSize + $1C;
  1844.  
  1845. procedure CollectionError; near; assembler;
  1846. asm
  1847.         PUSH    AX
  1848.         PUSH    BX
  1849.         PUSH    ES
  1850.         PUSH    DI
  1851.         MOV     DI,ES:[DI]
  1852.         CALL    DWORD PTR [DI].TCollection_Error
  1853. end;
  1854.  
  1855. constructor TCollection.Init(ALimit, ADelta: Integer);
  1856. begin
  1857.   TObject.Init;
  1858.   Items := nil;
  1859.   Count := 0;
  1860.   Limit := 0;
  1861.   Delta := ADelta;
  1862.   SetLimit(ALimit);
  1863. end;
  1864.  
  1865. constructor TCollection.Load(var S: TStream);
  1866. var
  1867.   C, I: Integer;
  1868. begin
  1869.   S.Read(Count, SizeOf(Integer) * 3);
  1870.   Items := nil;
  1871.   C := Count;
  1872.   I := Limit;
  1873.   Count := 0;
  1874.   Limit := 0;
  1875.   SetLimit(I);
  1876.   Count := C;
  1877.   for I := 0 to C - 1 do AtPut(I, GetItem(S));
  1878. end;
  1879.  
  1880. destructor TCollection.Done;
  1881. begin
  1882.   FreeAll;
  1883.   SetLimit(0);
  1884. end;
  1885.  
  1886. function TCollection.At(Index: Integer): Pointer; assembler;
  1887. asm
  1888.         LES     DI,Self
  1889.         MOV     BX,Index
  1890.         OR      BX,BX
  1891.         JL      @@1
  1892.         CMP     BX,ES:[DI].TCollection.Count
  1893.         JGE     @@1
  1894.         LES     DI,ES:[DI].TCollection.Items
  1895.         SHL     BX,1
  1896.         SHL     BX,1
  1897.     MOV    AX,ES:[DI+BX]
  1898.     MOV    DX,ES:[DI+BX+2]
  1899.         JMP     @@2
  1900. @@1:    MOV     AX,coIndexError
  1901.         CALL    CollectionError
  1902.         XOR     AX,AX
  1903.         MOV     DX,AX
  1904. @@2:
  1905. end;
  1906.  
  1907. procedure TCollection.AtDelete(Index: Integer); assembler;
  1908. asm
  1909.         LES     DI,Self
  1910.         MOV     BX,Index
  1911.         OR      BX,BX
  1912.         JL      @@1
  1913.         CMP     BX,ES:[DI].TCollection.Count
  1914.         JGE     @@1
  1915.         DEC     ES:[DI].TCollection.Count
  1916.         MOV     CX,ES:[DI].TCollection.Count
  1917.         SUB     CX,BX
  1918.         JE      @@2
  1919.         CLD
  1920.         LES     DI,ES:[DI].TCollection.Items
  1921.         SHL     BX,1
  1922.         SHL     BX,1
  1923.         ADD     DI,BX
  1924.         LEA     SI,[DI+4]
  1925.         SHL     CX,1
  1926.         PUSH    DS
  1927.         PUSH    ES
  1928.         POP     DS
  1929.         REP     MOVSW
  1930.         POP     DS
  1931.         JMP     @@2
  1932. @@1:    MOV     AX,coIndexError
  1933.         CALL    CollectionError
  1934. @@2:
  1935. end;
  1936.  
  1937. procedure TCollection.AtFree(Index: Integer);
  1938. var
  1939.   Item: Pointer;
  1940. begin
  1941.   Item := At(Index);
  1942.   AtDelete(Index);
  1943.   FreeItem(Item);
  1944. end;
  1945.  
  1946. procedure TCollection.AtInsert(Index: Integer; Item: Pointer); assembler;
  1947. asm
  1948.         LES     DI,Self
  1949.         MOV     BX,Index
  1950.         OR      BX,BX
  1951.         JL      @@3
  1952.         MOV     CX,ES:[DI].TCollection.Count
  1953.         CMP     BX,CX
  1954.         JG      @@3
  1955.         CMP     CX,ES:[DI].TCollection.Limit
  1956.         JNE     @@1
  1957.         PUSH    CX
  1958.         PUSH    BX
  1959.         ADD     CX,ES:[DI].TCollection.Delta
  1960.         PUSH    CX
  1961.         PUSH    ES
  1962.         PUSH    DI
  1963.         MOV     DI,ES:[DI]
  1964.         CALL    DWORD PTR [DI].TCollection_SetLimit
  1965.         POP     BX
  1966.         POP     CX
  1967.         LES     DI,Self
  1968.         CMP     CX,ES:[DI].TCollection.Limit
  1969.         JE      @@4
  1970. @@1:    INC     ES:[DI].TCollection.Count
  1971.         STD
  1972.         LES     DI,ES:[DI].TCollection.Items
  1973.         SHL     CX,1
  1974.         ADD     DI,CX
  1975.         ADD     DI,CX
  1976.         INC     DI
  1977.         INC     DI
  1978.         SHL     BX,1
  1979.         SUB     CX,BX
  1980.         JE      @@2
  1981.         LEA     SI,[DI-4]
  1982.         PUSH    DS
  1983.         PUSH    ES
  1984.         POP     DS
  1985.         REP     MOVSW
  1986.         POP     DS
  1987. @@2:    MOV     AX,WORD PTR [Item+2]
  1988.         STOSW
  1989.         MOV     AX,WORD PTR [Item]
  1990.         STOSW
  1991.         CLD
  1992.         JMP     @@6
  1993. @@3:    MOV     AX,coIndexError
  1994.         JMP     @@5
  1995. @@4:    MOV     AX,coOverflow
  1996.         MOV     BX,CX
  1997. @@5:    CALL    CollectionError
  1998. @@6:
  1999. end;
  2000.  
  2001. procedure TCollection.AtPut(Index: Integer; Item: Pointer); assembler;
  2002. asm
  2003.     MOV    AX,Item.Word[0]
  2004.         MOV    DX,Item.Word[2]
  2005.         LES    DI,Self
  2006.         MOV     BX,Index
  2007.         OR      BX,BX
  2008.         JL      @@1
  2009.         CMP     BX,ES:[DI].TCollection.Count
  2010.         JGE     @@1
  2011.         LES     DI,ES:[DI].TCollection.Items
  2012.         SHL     BX,1
  2013.         SHL     BX,1
  2014.         MOV     ES:[DI+BX],AX
  2015.         MOV     ES:[DI+BX+2],DX
  2016.         JMP     @@2
  2017. @@1:    MOV     AX,coIndexError
  2018.         CALL    CollectionError
  2019. @@2:
  2020. end;
  2021.  
  2022. procedure TCollection.Delete(Item: Pointer);
  2023. begin
  2024.   AtDelete(IndexOf(Item));
  2025. end;
  2026.  
  2027. procedure TCollection.DeleteAll;
  2028. begin
  2029.   Count := 0;
  2030. end;
  2031.  
  2032. procedure TCollection.Error(Code, Info: Integer);
  2033. begin
  2034.   RunError(212 - Code);
  2035. end;
  2036.  
  2037. function TCollection.FirstThat(Test: Pointer): Pointer; assembler;
  2038. asm
  2039.         LES     DI,Self
  2040.         MOV     CX,ES:[DI].TCollection.Count
  2041.         JCXZ    @@2
  2042.         LES     DI,ES:[DI].TCollection.Items
  2043. @@1:    PUSH    ES
  2044.         PUSH    DI
  2045.         PUSH    CX
  2046.         PUSH    WORD PTR ES:[DI+2]
  2047.         PUSH    WORD PTR ES:[DI]
  2048. {$IFDEF Windows}
  2049.     MOV    AX,[BP]
  2050.     AND    AL,0FEH
  2051.     PUSH    AX
  2052. {$ELSE}
  2053.         PUSH    WORD PTR [BP]
  2054. {$ENDIF}
  2055.         CALL    Test
  2056.         POP     CX
  2057.         POP     DI
  2058.         POP     ES
  2059.         OR      AL,AL
  2060.         JNE     @@3
  2061.         ADD     DI,4
  2062.         LOOP    @@1
  2063. @@2:    XOR     AX,AX
  2064.         MOV     DX,AX
  2065.         JMP     @@4
  2066. @@3:    MOV    AX,ES:[DI]
  2067.     MOV    DX,ES:[DI+2]
  2068. @@4:
  2069. end;
  2070.  
  2071. procedure TCollection.ForEach(Action: Pointer); assembler;
  2072. asm
  2073.         LES     DI,Self
  2074.         MOV     CX,ES:[DI].TCollection.Count
  2075.         JCXZ    @@2
  2076.         LES     DI,ES:[DI].TCollection.Items
  2077. @@1:    PUSH    ES
  2078.         PUSH    DI
  2079.         PUSH    CX
  2080.         PUSH    WORD PTR ES:[DI+2]
  2081.         PUSH    WORD PTR ES:[DI]
  2082. {$IFDEF Windows}
  2083.     MOV    AX,[BP]
  2084.     AND    AL,0FEH
  2085.     PUSH    AX
  2086. {$ELSE}
  2087.         PUSH    WORD PTR [BP]
  2088. {$ENDIF}
  2089.         CALL    Action
  2090.         POP     CX
  2091.         POP     DI
  2092.         POP     ES
  2093.         ADD     DI,4
  2094.         LOOP    @@1
  2095. @@2:
  2096. end;
  2097.  
  2098. procedure TCollection.Free(Item: Pointer);
  2099. begin
  2100.   Delete(Item);
  2101.   FreeItem(Item);
  2102. end;
  2103.  
  2104. procedure TCollection.FreeAll;
  2105. var
  2106.   I: Integer;
  2107. begin
  2108.   for I := 0 to Count - 1 do FreeItem(At(I));
  2109.   Count := 0;
  2110. end;
  2111.  
  2112. procedure TCollection.FreeItem(Item: Pointer);
  2113. begin
  2114.   if Item <> nil then Dispose(PObject(Item), Done);
  2115. end;
  2116.  
  2117. function TCollection.GetItem(var S: TStream): Pointer;
  2118. begin
  2119.   GetItem := S.Get;
  2120. end;
  2121.  
  2122. function TCollection.IndexOf(Item: Pointer): Integer; assembler;
  2123. asm
  2124.     MOV    AX,Item.Word[0]
  2125.     MOV    DX,Item.Word[2]
  2126.         LES     DI,Self
  2127.         MOV     CX,ES:[DI].TCollection.Count
  2128.         JCXZ    @@3
  2129.         LES     DI,ES:[DI].TCollection.Items
  2130.         MOV     BX,DI
  2131.         SHL     CX,1
  2132.         CLD
  2133. @@1:    REPNE   SCASW
  2134.         JCXZ    @@3
  2135.         TEST    CX,1
  2136.         JE      @@1
  2137.         XCHG    AX,DX
  2138.         SCASW
  2139.         XCHG    AX,DX
  2140.         LOOPNE  @@1
  2141.         JNE     @@3
  2142.         MOV     AX,DI
  2143.         SUB     AX,BX
  2144.         SHR     AX,1
  2145.         SHR     AX,1
  2146.         DEC     AX
  2147.         JMP     @@2
  2148. @@3:    MOV     AX,-1
  2149. @@2:
  2150. end;
  2151.  
  2152. procedure TCollection.Insert(Item: Pointer);
  2153. begin
  2154.   AtInsert(Count, Item);
  2155. end;
  2156.  
  2157. function TCollection.LastThat(Test: Pointer): Pointer; assembler;
  2158. asm
  2159.         LES     DI,Self
  2160.         MOV     CX,ES:[DI].TCollection.Count
  2161.         JCXZ    @@2
  2162.         LES     DI,ES:[DI].TCollection.Items
  2163.         MOV     AX,CX
  2164.         SHL     AX,1
  2165.         SHL     AX,1
  2166.         ADD     DI,AX
  2167. @@1:    SUB     DI,4
  2168.         PUSH    ES
  2169.         PUSH    DI
  2170.         PUSH    CX
  2171.         PUSH    WORD PTR ES:[DI+2]
  2172.         PUSH    WORD PTR ES:[DI]
  2173. {$IFDEF Windows}
  2174.     MOV    AX,[BP]
  2175.     AND    AL,0FEH
  2176.     PUSH    AX
  2177. {$ELSE}
  2178.         PUSH    WORD PTR [BP]
  2179. {$ENDIF}
  2180.         CALL    Test
  2181.         POP     CX
  2182.         POP     DI
  2183.         POP     ES
  2184.         OR      AL,AL
  2185.         JNE     @@3
  2186.         LOOP    @@1
  2187. @@2:    XOR     AX,AX
  2188.         MOV     DX,AX
  2189.         JMP     @@4
  2190. @@3:    MOV    AX,ES:[DI]
  2191.     MOV    DX,ES:[DI+2]
  2192. @@4:
  2193. end;
  2194.  
  2195. procedure TCollection.Pack; assembler;
  2196. asm
  2197.         LES     DI,Self
  2198.         MOV     CX,ES:[DI].TCollection.Count
  2199.         JCXZ    @@3
  2200.         LES     DI,ES:[DI].TCollection.Items
  2201.         MOV     SI,DI
  2202.         PUSH    DS
  2203.         PUSH    ES
  2204.         POP     DS
  2205.         CLD
  2206. @@1:    LODSW
  2207.         XCHG    AX,DX
  2208.         LODSW
  2209.         MOV     BX,AX
  2210.         OR      BX,DX
  2211.         JE      @@2
  2212.         XCHG    AX,DX
  2213.         STOSW
  2214.         XCHG    AX,DX
  2215.         STOSW
  2216. @@2:    LOOP    @@1
  2217.         POP     DS
  2218.         LES     BX,Self
  2219.         SUB     DI,WORD PTR ES:[BX].TCollection.Items
  2220.         SHR     DI,1
  2221.         SHR     DI,1
  2222.         MOV     ES:[BX].TCollection.Count,DI
  2223. @@3:
  2224. end;
  2225.  
  2226. procedure TCollection.PutItem(var S: TStream; Item: Pointer);
  2227. begin
  2228.   S.Put(Item);
  2229. end;
  2230.  
  2231. procedure TCollection.SetLimit(ALimit: Integer);
  2232. var
  2233.   AItems: PItemList;
  2234. begin
  2235.   if ALimit < Count then ALimit := Count;
  2236.   if ALimit > MaxCollectionSize then ALimit := MaxCollectionSize;
  2237.   if ALimit <> Limit then
  2238.   begin
  2239.     if ALimit = 0 then AItems := nil else
  2240.     begin
  2241.       GetMem(AItems, ALimit * SizeOf(Pointer));
  2242.       if (Count <> 0) and (Items <> nil) then
  2243.         Move(Items^, AItems^, Count * SizeOf(Pointer));
  2244.     end;
  2245.     if Limit <> 0 then FreeMem(Items, Limit * SizeOf(Pointer));
  2246.     Items := AItems;
  2247.     Limit := ALimit;
  2248.   end;
  2249. end;
  2250.  
  2251. procedure TCollection.Store(var S: TStream);
  2252.  
  2253. procedure DoPutItem(P: Pointer); far;
  2254. begin
  2255.   PutItem(S, P);
  2256. end;
  2257.  
  2258. begin
  2259.   S.Write(Count, SizeOf(Integer) * 3);
  2260.   ForEach(@DoPutItem);
  2261. end;
  2262.  
  2263. { TSortedCollection }
  2264.  
  2265. constructor TSortedCollection.Init(ALimit, ADelta: Integer);
  2266. begin
  2267.   TCollection.Init(ALimit, ADelta);
  2268.   Duplicates := False;
  2269. end;
  2270.  
  2271. constructor TSortedCollection.Load(var S: TStream);
  2272. begin
  2273.   TCollection.Load(S);
  2274.   S.Read(Duplicates, SizeOf(Boolean));
  2275. end;
  2276.  
  2277. function TSortedCollection.Compare(Key1, Key2: Pointer): Integer;
  2278. begin
  2279.   Abstract;
  2280. end;
  2281.  
  2282. function TSortedCollection.IndexOf(Item: Pointer): Integer;
  2283. var
  2284.   I: Integer;
  2285. begin
  2286.   IndexOf := -1;
  2287.   if Search(KeyOf(Item), I) then
  2288.   begin
  2289.     if Duplicates then
  2290.       while (I < Count) and (Item <> Items^[I]) do Inc(I);
  2291.     if I < Count then IndexOf := I;
  2292.   end;
  2293. end;
  2294.  
  2295. procedure TSortedCollection.Insert(Item: Pointer);
  2296. var
  2297.   I: Integer;
  2298. begin
  2299.   if not Search(KeyOf(Item), I) or Duplicates then AtInsert(I, Item);
  2300. end;
  2301.  
  2302. function TSortedCollection.KeyOf(Item: Pointer): Pointer;
  2303. begin
  2304.   KeyOf := Item;
  2305. end;
  2306.  
  2307. function TSortedCollection.Search(Key: Pointer; var Index: Integer): Boolean;
  2308. var
  2309.   L, H, I, C: Integer;
  2310. begin
  2311.   Search := False;
  2312.   L := 0;
  2313.   H := Count - 1;
  2314.   while L <= H do
  2315.   begin
  2316.     I := (L + H) shr 1;
  2317.     C := Compare(KeyOf(Items^[I]), Key);
  2318.     if C < 0 then L := I + 1 else
  2319.     begin
  2320.       H := I - 1;
  2321.       if C = 0 then
  2322.       begin
  2323.         Search := True;
  2324.         if not Duplicates then L := I;
  2325.       end;
  2326.     end;
  2327.   end;
  2328.   Index := L;
  2329. end;
  2330.  
  2331. procedure TSortedCollection.Store(var S: TStream);
  2332. begin
  2333.   TCollection.Store(S);
  2334.   S.Write(Duplicates, SizeOf(Boolean));
  2335. end;
  2336.  
  2337. { TStringCollection }
  2338.  
  2339. function TStringCollection.Compare(Key1, Key2: Pointer): Integer; assembler;
  2340. asm
  2341.         PUSH    DS
  2342.         CLD
  2343.         LDS     SI,Key1
  2344.         LES     DI,Key2
  2345.         LODSB
  2346.         MOV     AH,ES:[DI]
  2347.         INC     DI
  2348.         MOV     CL,AL
  2349.         CMP     CL,AH
  2350.         JBE     @@1
  2351.         MOV     CL,AH
  2352. @@1:    XOR     CH,CH
  2353.         REP     CMPSB
  2354.         JE      @@2
  2355.         MOV     AL,DS:[SI-1]
  2356.         MOV     AH,ES:[DI-1]
  2357. @@2:    SUB     AL,AH
  2358.         SBB     AH,AH
  2359.         POP     DS
  2360. end;
  2361.  
  2362. procedure TStringCollection.FreeItem(Item: Pointer);
  2363. begin
  2364.   DisposeStr(Item);
  2365. end;
  2366.  
  2367. function TStringCollection.GetItem(var S: TStream): Pointer;
  2368. begin
  2369.   GetItem := S.ReadStr;
  2370. end;
  2371.  
  2372. procedure TStringCollection.PutItem(var S: TStream; Item: Pointer);
  2373. begin
  2374.   S.WriteStr(Item);
  2375. end;
  2376.  
  2377. { TStrCollection }
  2378.  
  2379. function TStrCollection.Compare(Key1, Key2: Pointer): Integer;
  2380. begin
  2381.   Compare := StrComp(Key1, Key2);
  2382. end;
  2383.  
  2384. procedure TStrCollection.FreeItem(Item: Pointer);
  2385. begin
  2386.   StrDispose(Item);
  2387. end;
  2388.  
  2389. function TStrCollection.GetItem(var S: TStream): Pointer;
  2390. begin
  2391.   GetItem := S.StrRead;
  2392. end;
  2393.  
  2394. procedure TStrCollection.PutItem(var S: TStream; Item: Pointer);
  2395. begin
  2396.   S.StrWrite(Item);
  2397. end;
  2398.  
  2399. {$IFNDEF Windows }
  2400.  
  2401. { Private resource manager types }
  2402.  
  2403. const
  2404.   RStreamMagic: Longint = $52504246; { 'FBPR' }
  2405.   RStreamBackLink: Longint = $4C424246; { 'FBBL' }
  2406.  
  2407. type
  2408.   PResourceItem = ^TResourceItem;
  2409.   TResourceItem = record
  2410.     Pos: Longint;
  2411.     Size: Longint;
  2412.     Key: String;
  2413.   end;
  2414.  
  2415. { TResourceCollection }
  2416.  
  2417. procedure TResourceCollection.FreeItem(Item: Pointer);
  2418. begin
  2419.   FreeMem(Item, Length(PResourceItem(Item)^.Key) +
  2420.     (SizeOf(TResourceItem) - SizeOf(String) + 1));
  2421. end;
  2422.  
  2423. function TResourceCollection.GetItem(var S: TStream): Pointer;
  2424. var
  2425.   Pos: Longint;
  2426.   Size: Longint;
  2427.   L: Byte;
  2428.   P: PResourceItem;
  2429. begin
  2430.   S.Read(Pos, SizeOf(Longint));
  2431.   S.Read(Size, SizeOf(Longint));
  2432.   S.Read(L, 1);
  2433.   GetMem(P, L + (SizeOf(TResourceItem) - SizeOf(String) + 1));
  2434.   P^.Pos := Pos;
  2435.   P^.Size := Size;
  2436.   P^.Key[0] := Char(L);
  2437.   S.Read(P^.Key[1], L);
  2438.   GetItem := P;
  2439. end;
  2440.  
  2441. function TResourceCollection.KeyOf(Item: Pointer): Pointer; assembler;
  2442. asm
  2443.         MOV     AX,Item.Word[0]
  2444.         MOV     DX,Item.Word[2]
  2445.         ADD     AX,OFFSET TResourceItem.Key
  2446. end;
  2447.  
  2448. procedure TResourceCollection.PutItem(var S: TStream; Item: Pointer);
  2449. begin
  2450.   S.Write(PResourceItem(Item)^, Length(PResourceItem(Item)^.Key) +
  2451.     (SizeOf(TResourceItem) - SizeOf(String) + 1));
  2452. end;
  2453.  
  2454. { TResourceFile }
  2455.  
  2456. constructor TResourceFile.Init(AStream: PStream);
  2457. type
  2458.  
  2459. {$IFDEF NewExeFormat}
  2460.  
  2461.   TExeHeader = record
  2462.     eHdrSize:   Word;
  2463.     eMinAbove:  Word;
  2464.     eMaxAbove:  Word;
  2465.     eInitSS:    Word;
  2466.     eInitSP:    Word;
  2467.     eCheckSum:  Word;
  2468.     eInitPC:    Word;
  2469.     eInitCS:    Word;
  2470.     eRelocOfs:  Word;
  2471.     eOvlyNum:   Word;
  2472.     eRelocTab:  Word;
  2473.     eSpace:     Array[1..30] of Byte;
  2474.     eNewHeader: Word;
  2475.   end;
  2476.  
  2477. {$ENDIF}
  2478.  
  2479.   THeader = record
  2480.     Signature: Word;
  2481.     case Integer of
  2482.       0: (
  2483.         LastCount: Word;
  2484.         PageCount: Word;
  2485.         ReloCount: Word);
  2486.       1: (
  2487.         InfoType: Word;
  2488.         InfoSize: Longint);
  2489.   end;
  2490. var
  2491.   Found, Stop: Boolean;
  2492.   Header: THeader;
  2493.  
  2494. {$IFDEF NewExeFormat}
  2495.  
  2496.   ExeHeader: TExeHeader;
  2497.  
  2498. {$ENDIF}
  2499.  
  2500. begin
  2501.   TObject.Init;
  2502.   Stream := AStream;
  2503.   BasePos := Stream^.GetPos;
  2504.   Found := False;
  2505.   repeat
  2506.     Stop := True;
  2507.     if BasePos <= Stream^.GetSize - SizeOf(THeader) then
  2508.     begin
  2509.       Stream^.Seek(BasePos);
  2510.       Stream^.Read(Header, SizeOf(THeader));
  2511.       case Header.Signature of
  2512.  
  2513. {$IFDEF NewExeFormat}
  2514.  
  2515.         $5A4D:
  2516.           begin
  2517.             Stream^.Read(ExeHeader, SizeOf(TExeHeader));
  2518.             BasePos := ExeHeader.eNewHeader;
  2519.             Stop := False;
  2520.           end;
  2521.         $454E:
  2522.           begin
  2523.             BasePos := Stream^.GetSize - 8;
  2524.             Stop := False;
  2525.           end;
  2526.         $4246:
  2527.           begin
  2528.             Stop := False;
  2529.             case Header.Infotype of
  2530.               $5250:                                    {Found Resource}
  2531.                 begin
  2532.                   Found := True;
  2533.                   Stop := True;
  2534.                 end;
  2535.               $4C42: Dec(BasePos, Header.InfoSize - 8); {Found BackLink}
  2536.               $4648: Dec(BasePos, SizeOf(THeader) * 2); {Found HelpFile}
  2537.             else
  2538.               Stop := True;
  2539.             end;
  2540.           end;
  2541.         $424E:
  2542.           if Header.InfoType = $3230 then               {Found Debug Info}
  2543.           begin
  2544.             Dec(BasePos, Header.InfoSize);
  2545.             Stop := False;
  2546.           end;
  2547.  
  2548. {$ELSE}
  2549.  
  2550.         $5A4D:
  2551.           begin
  2552.             Inc(BasePos, LongMul(Header.PageCount, 512) -
  2553.               (-Header.LastCount and 511));
  2554.             Stop := False;
  2555.           end;
  2556.         $4246:
  2557.           if Header.InfoType = $5250 then Found := True else
  2558.           begin
  2559.             Inc(BasePos, Header.InfoSize + 8);
  2560.             Stop := False;
  2561.           end;
  2562.  
  2563. {$ENDIF}
  2564.  
  2565.       end;
  2566.     end;
  2567.   until Stop;
  2568.   if Found then
  2569.   begin
  2570.     Stream^.Seek(BasePos + SizeOf(Longint) * 2);
  2571.     Stream^.Read(IndexPos, SizeOf(Longint));
  2572.     Stream^.Seek(BasePos + IndexPos);
  2573.     Index.Load(Stream^);
  2574.   end else
  2575.   begin
  2576.     IndexPos := SizeOf(Longint) * 3;
  2577.     Index.Init(0, 8);
  2578.   end;
  2579. end;
  2580.  
  2581. destructor TResourceFile.Done;
  2582. begin
  2583.   Flush;
  2584.   Index.Done;
  2585.   Dispose(Stream, Done);
  2586. end;
  2587.  
  2588. function TResourceFile.Count: Integer;
  2589. begin
  2590.   Count := Index.Count;
  2591. end;
  2592.  
  2593. procedure TResourceFile.Delete(Key: String);
  2594. var
  2595.   I: Integer;
  2596. begin
  2597.   if Index.Search(@Key, I) then
  2598.   begin
  2599.     Index.Free(Index.At(I));
  2600.     Modified := True;
  2601.   end;
  2602. end;
  2603.  
  2604. procedure TResourceFile.Flush;
  2605. var
  2606.   ResSize: Longint;
  2607.   LinkSize: Longint;
  2608. begin
  2609.   if Modified then
  2610.   begin
  2611.     Stream^.Seek(BasePos + IndexPos);
  2612.     Index.Store(Stream^);
  2613.     ResSize := Stream^.GetPos - BasePos;
  2614.     LinkSize := ResSize + SizeOf(Longint) * 2;
  2615.     Stream^.Write(RStreamBackLink, SizeOf(Longint));
  2616.     Stream^.Write(LinkSize, SizeOf(Longint));
  2617.     Stream^.Seek(BasePos);
  2618.     Stream^.Write(RStreamMagic, SizeOf(Longint));
  2619.     Stream^.Write(ResSize, SizeOf(Longint));
  2620.     Stream^.Write(IndexPos, SizeOf(Longint));
  2621.     Stream^.Flush;
  2622.     Modified := False;
  2623.   end;
  2624. end;
  2625.  
  2626. function TResourceFile.Get(Key: String): PObject;
  2627. var
  2628.   I: Integer;
  2629. begin
  2630.   if not Index.Search(@Key, I) then Get := nil else
  2631.   begin
  2632.     Stream^.Seek(BasePos + PResourceItem(Index.At(I))^.Pos);
  2633.     Get := Stream^.Get;
  2634.   end;
  2635. end;
  2636.  
  2637. function TResourceFile.KeyAt(I: Integer): String;
  2638. begin
  2639.   KeyAt := PResourceItem(Index.At(I))^.Key;
  2640. end;
  2641.  
  2642. procedure TResourceFile.Put(Item: PObject; Key: String);
  2643. var
  2644.   I: Integer;
  2645.   P: PResourceItem;
  2646. begin
  2647.   if Index.Search(@Key, I) then P := Index.At(I) else
  2648.   begin
  2649.     GetMem(P, Length(Key) + (SizeOf(TResourceItem) - SizeOf(String) + 1));
  2650.     P^.Key := Key;
  2651.     Index.AtInsert(I, P);
  2652.   end;
  2653.   P^.Pos := IndexPos;
  2654.   Stream^.Seek(BasePos + IndexPos);
  2655.   Stream^.Put(Item);
  2656.   IndexPos := Stream^.GetPos - BasePos;
  2657.   P^.Size := IndexPos - P^.Pos;
  2658.   Modified := True;
  2659. end;
  2660.  
  2661. function TResourceFile.SwitchTo(AStream: PStream; Pack: Boolean): PStream;
  2662. var
  2663.   NewBasePos: Longint;
  2664.  
  2665. procedure DoCopyResource(Item: PResourceItem); far;
  2666. begin
  2667.   Stream^.Seek(BasePos + Item^.Pos);
  2668.   Item^.Pos := AStream^.GetPos - NewBasePos;
  2669.   AStream^.CopyFrom(Stream^, Item^.Size);
  2670. end;
  2671.  
  2672. begin
  2673.   SwitchTo := Stream;
  2674.   NewBasePos := AStream^.GetPos;
  2675.   if Pack then
  2676.   begin
  2677.     AStream^.Seek(NewBasePos + SizeOf(Longint) * 3);
  2678.     Index.ForEach(@DoCopyResource);
  2679.     IndexPos := AStream^.GetPos - NewBasePos;
  2680.   end else
  2681.   begin
  2682.     Stream^.Seek(BasePos);
  2683.     AStream^.CopyFrom(Stream^, IndexPos);
  2684.   end;
  2685.   Stream := AStream;
  2686.   Modified := True;
  2687.   BasePos := NewBasePos;
  2688. end;
  2689.  
  2690. { TStringList }
  2691.  
  2692. constructor TStringList.Load(var S: TStream);
  2693. var
  2694.   Size: Word;
  2695. begin
  2696.   Stream := @S;
  2697.   S.Read(Size, SizeOf(Word));
  2698.   BasePos := S.GetPos;
  2699.   S.Seek(BasePos + Size);
  2700.   S.Read(IndexSize, SizeOf(Integer));
  2701.   GetMem(Index, IndexSize * SizeOf(TStrIndexRec));
  2702.   S.Read(Index^, IndexSize * SizeOf(TStrIndexRec));
  2703. end;
  2704.  
  2705. destructor TStringList.Done;
  2706. begin
  2707.   FreeMem(Index, IndexSize * SizeOf(TStrIndexRec));
  2708. end;
  2709.  
  2710. function TStringList.Get(Key: Word): String; assembler;
  2711. asm
  2712.         PUSH    DS
  2713.         LDS     SI,Self
  2714.         LES     DI,@Result
  2715.         CLD
  2716.         MOV     CX,DS:[SI].TStringList.IndexSize
  2717.         JCXZ    @@2
  2718.         MOV     BX,Key
  2719.         LDS     SI,DS:[SI].TStringList.Index
  2720. @@1:    MOV     DX,BX
  2721.         LODSW
  2722.         SUB     DX,AX
  2723.         LODSW
  2724.         CMP     DX,AX
  2725.         LODSW
  2726.         JB      @@3
  2727.         LOOP    @@1
  2728. @@2:    POP     DS
  2729.         XOR     AL,AL
  2730.         STOSB
  2731.         JMP     @@4
  2732. @@3:    POP     DS
  2733.         PUSH    ES
  2734.         PUSH    DI
  2735.         PUSH    AX
  2736.         PUSH    DX
  2737.         LES     DI,Self
  2738.         PUSH    ES
  2739.         PUSH    DI
  2740.         CALL    TStringList.ReadStr
  2741. @@4:
  2742. end;
  2743.  
  2744. procedure TStringList.ReadStr(var S: String; Offset, Skip: Word);
  2745. begin
  2746.   Stream^.Seek(BasePos + Offset);
  2747.   Inc(Skip);
  2748.   repeat
  2749.     Stream^.Read(S[0], 1);
  2750.     Stream^.Read(S[1], Ord(S[0]));
  2751.     Dec(Skip);
  2752.   until Skip = 0;
  2753. end;
  2754.  
  2755. { TStrListMaker }
  2756.  
  2757. constructor TStrListMaker.Init(AStrSize, AIndexSize: Word);
  2758. begin
  2759.   TObject.Init;
  2760.   StrSize := AStrSize;
  2761.   IndexSize := AIndexSize;
  2762.   GetMem(Strings, AStrSize);
  2763.   GetMem(Index, AIndexSize * SizeOf(TStrIndexRec));
  2764. end;
  2765.  
  2766. destructor TStrListMaker.Done;
  2767. begin
  2768.   FreeMem(Index, IndexSize * SizeOf(TStrIndexRec));
  2769.   FreeMem(Strings, StrSize);
  2770. end;
  2771.  
  2772. procedure TStrListMaker.CloseCurrent;
  2773. begin
  2774.   if Cur.Count <> 0 then
  2775.   begin
  2776.     Index^[IndexPos] := Cur;
  2777.     Inc(IndexPos);
  2778.     Cur.Count := 0;
  2779.   end;
  2780. end;
  2781.  
  2782. procedure TStrListMaker.Put(Key: Word; S: String);
  2783. begin
  2784.   if (Cur.Count = 16) or (Key <> Cur.Key + Cur.Count) then CloseCurrent;
  2785.   if Cur.Count = 0 then
  2786.   begin
  2787.     Cur.Key := Key;
  2788.     Cur.Offset := StrPos;
  2789.   end;
  2790.   Inc(Cur.Count);
  2791.   Move(S, Strings^[StrPos], Length(S) + 1);
  2792.   Inc(StrPos, Length(S) + 1);
  2793. end;
  2794.  
  2795. procedure TStrListMaker.Store(var S: TStream);
  2796. begin
  2797.   CloseCurrent;
  2798.   S.Write(StrPos, SizeOf(Word));
  2799.   S.Write(Strings^, StrPos);
  2800.   S.Write(IndexPos, SizeOf(Word));
  2801.   S.Write(Index^, IndexPos * SizeOf(TStrIndexRec));
  2802. end;
  2803.  
  2804. { TRect }
  2805.  
  2806. procedure CheckEmpty; near; assembler;
  2807. asm
  2808.         MOV     AX,ES:[DI].TRect.A.X
  2809.         CMP     AX,ES:[DI].TRect.B.X
  2810.         JGE     @@1
  2811.         MOV     AX,ES:[DI].TRect.A.Y
  2812.         CMP     AX,ES:[DI].TRect.B.Y
  2813.         JL      @@2
  2814. @@1:    CLD
  2815.         XOR     AX,AX
  2816.         STOSW
  2817.         STOSW
  2818.         STOSW
  2819.         STOSW
  2820. @@2:
  2821. end;
  2822.  
  2823. procedure TRect.Assign(XA, YA, XB, YB: Integer); assembler;
  2824. asm
  2825.         LES     DI,Self
  2826.         CLD
  2827.         MOV     AX,XA
  2828.         STOSW
  2829.         MOV     AX,YA
  2830.         STOSW
  2831.         MOV     AX,XB
  2832.         STOSW
  2833.         MOV     AX,YB
  2834.         STOSW
  2835. end;
  2836.  
  2837. procedure TRect.Copy(R: TRect); assembler;
  2838. asm
  2839.         PUSH    DS
  2840.         LDS     SI,R
  2841.         LES     DI,Self
  2842.         CLD
  2843.         MOVSW
  2844.         MOVSW
  2845.         MOVSW
  2846.         MOVSW
  2847.         POP     DS
  2848. end;
  2849.  
  2850. procedure TRect.Move(ADX, ADY: Integer); assembler;
  2851. asm
  2852.         LES     DI,Self
  2853.         MOV     AX,ADX
  2854.         ADD     ES:[DI].TRect.A.X,AX
  2855.         ADD     ES:[DI].TRect.B.X,AX
  2856.         MOV     AX,ADY
  2857.         ADD     ES:[DI].TRect.A.Y,AX
  2858.         ADD     ES:[DI].TRect.B.Y,AX
  2859. end;
  2860.  
  2861. procedure TRect.Grow(ADX, ADY: Integer); assembler;
  2862. asm
  2863.         LES     DI,Self
  2864.         MOV     AX,ADX
  2865.         SUB     ES:[DI].TRect.A.X,AX
  2866.         ADD     ES:[DI].TRect.B.X,AX
  2867.         MOV     AX,ADY
  2868.         SUB     ES:[DI].TRect.A.Y,AX
  2869.         ADD     ES:[DI].TRect.B.Y,AX
  2870.         CALL    CheckEmpty
  2871. end;
  2872.  
  2873. procedure TRect.Intersect(R: TRect); assembler;
  2874. asm
  2875.         PUSH    DS
  2876.         LDS     SI,R
  2877.         LES     DI,Self
  2878.         CLD
  2879.         LODSW
  2880.         SCASW
  2881.         JLE     @@1
  2882.         DEC     DI
  2883.         DEC     DI
  2884.         STOSW
  2885. @@1:    LODSW
  2886.         SCASW
  2887.         JLE     @@2
  2888.         DEC     DI
  2889.         DEC     DI
  2890.         STOSW
  2891. @@2:    LODSW
  2892.         SCASW
  2893.         JGE     @@3
  2894.         DEC     DI
  2895.         DEC     DI
  2896.         STOSW
  2897. @@3:    LODSW
  2898.         SCASW
  2899.         JGE     @@4
  2900.         DEC     DI
  2901.         DEC     DI
  2902.         STOSW
  2903. @@4:    POP     DS
  2904.         SUB     DI,8
  2905.         CALL    CheckEmpty
  2906. end;
  2907.  
  2908. procedure TRect.Union(R: TRect); assembler;
  2909. asm
  2910.         PUSH    DS
  2911.         LDS     SI,R
  2912.         LES     DI,Self
  2913.         CLD
  2914.         LODSW
  2915.         SCASW
  2916.         JGE     @@1
  2917.         DEC     DI
  2918.         DEC     DI
  2919.         STOSW
  2920. @@1:    LODSW
  2921.         SCASW
  2922.         JGE     @@2
  2923.         DEC     DI
  2924.         DEC     DI
  2925.         STOSW
  2926. @@2:    LODSW
  2927.         SCASW
  2928.         JLE     @@3
  2929.         DEC     DI
  2930.         DEC     DI
  2931.         STOSW
  2932. @@3:    LODSW
  2933.         SCASW
  2934.         JLE     @@4
  2935.         DEC     DI
  2936.         DEC     DI
  2937.         STOSW
  2938. @@4:    POP     DS
  2939. end;
  2940.  
  2941. function TRect.Contains(P: TPoint): Boolean; assembler;
  2942. asm
  2943.         LES     DI,Self
  2944.         MOV     AL,0
  2945.         MOV     DX,P.X
  2946.         CMP     DX,ES:[DI].TRect.A.X
  2947.         JL      @@1
  2948.         CMP     DX,ES:[DI].TRect.B.X
  2949.         JGE     @@1
  2950.         MOV     DX,P.Y
  2951.         CMP     DX,ES:[DI].TRect.A.Y
  2952.         JL      @@1
  2953.         CMP     DX,ES:[DI].TRect.B.Y
  2954.         JGE     @@1
  2955.         INC     AX
  2956. @@1:
  2957. end;
  2958.  
  2959. function TRect.Equals(R: TRect): Boolean; assembler;
  2960. asm
  2961.         PUSH    DS
  2962.         LDS     SI,R
  2963.         LES     DI,Self
  2964.         MOV     CX,4
  2965.         CLD
  2966.         REP     CMPSW
  2967.         MOV     AL,0
  2968.         JNE     @@1
  2969.         INC     AX
  2970. @@1:    POP     DS
  2971. end;
  2972.  
  2973. function TRect.Empty: Boolean; assembler;
  2974. asm
  2975.         LES     DI,Self
  2976.         MOV     AL,1
  2977.         MOV     DX,ES:[DI].TRect.A.X
  2978.         CMP     DX,ES:[DI].TRect.B.X
  2979.         JGE     @@1
  2980.         MOV     DX,ES:[DI].TRect.A.Y
  2981.         CMP     DX,ES:[DI].TRect.B.Y
  2982.         JGE     @@1
  2983.         DEC     AX
  2984. @@1:
  2985. end;
  2986.  
  2987. {$ENDIF}
  2988.  
  2989. { Dynamic string handling routines }
  2990.  
  2991. function NewStr(const S: String): PString;
  2992. var
  2993.   P: PString;
  2994. begin
  2995.   if S = '' then P := nil else
  2996.   begin
  2997.     GetMem(P, Length(S) + 1);
  2998.     P^ := S;
  2999.   end;
  3000.   NewStr := P;
  3001. end;
  3002.  
  3003. procedure DisposeStr(P: PString);
  3004. begin
  3005.   if P <> nil then FreeMem(P, Length(P^) + 1);
  3006. end;
  3007.  
  3008. { Objects registration procedure }
  3009.  
  3010. procedure RegisterObjects;
  3011. begin
  3012.   RegisterType(RCollection);
  3013.   RegisterType(RStringCollection);
  3014.   RegisterType(RStrCollection);
  3015. end;
  3016.  
  3017. end.
  3018.