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