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