home *** CD-ROM | disk | FTP | other *** search
/ The Pier Shareware 6 / The_Pier_Shareware_Number_6_(The_Pier_Exchange)_(1995).iso / 038 / pmd110.zip / BBOBJECT.PAS < prev    next >
Pascal/Delphi Source File  |  1994-11-14  |  8KB  |  377 lines
  1. { Created : 1994-06-23  (c) Copyright 1994 by Berend de Boer
  2.  
  3. Unit to facilitate ports of Dos/DPMI objects to Windows. The object created here
  4. initializes all fields to zero, just as the Dos TObject.
  5.  
  6. And it implements TResourceFile which was for some reason(??) missing in
  7. the windows version of Objects
  8.  
  9.  
  10. Last changes :
  11. }
  12.  
  13.  
  14.  
  15. {$IFDEF DPMI}
  16. {$X+,S-}
  17. {$ELSE}
  18. {$X+,F+,O+}
  19. {$ENDIF}
  20. unit BBObject;
  21.  
  22. interface
  23.  
  24. {$IFDEF Windows}
  25. uses Objects;
  26.  
  27.  
  28. type
  29.   TObject = object(Objects.TObject)
  30.     constructor Init;
  31.   end;
  32.  
  33.  
  34. { Private resource manager types }
  35.  
  36. const
  37.   RStreamMagic: Longint = $52504246; { 'FBPR' }
  38.   RStreamBackLink: Longint = $4C424246; { 'FBBL' }
  39.  
  40. type
  41.   PResourceItem = ^TResourceItem;
  42.   TResourceItem = record
  43.     Pos: Longint;
  44.     Size: Longint;
  45.     Key: String;
  46.   end;
  47.  
  48. { TResourceCollection object }
  49.  
  50.   PResourceCollection = ^TResourceCollection;
  51.   TResourceCollection = object(TStringCollection)
  52.     procedure FreeItem(Item: Pointer); virtual;
  53.     function GetItem(var S: TStream): Pointer; virtual;
  54.     function KeyOf(Item: Pointer): Pointer; virtual;
  55.     procedure PutItem(var S: TStream; Item: Pointer); virtual;
  56.   end;
  57.  
  58. { TResourceFile object }
  59.  
  60.   PResourceFile = ^TResourceFile;
  61.   TResourceFile = object(TObject)
  62.     Stream: PStream;
  63.     Modified: Boolean;
  64.     constructor Init(AStream: PStream);
  65.     destructor Done; virtual;
  66.     function Count: Integer;
  67.     procedure Delete(Key: String);
  68.     procedure Flush;
  69.     function Get(Key: String): PObject;
  70.     function KeyAt(I: Integer): String;
  71.     procedure Put(Item: PObject; Key: String);
  72.     function SwitchTo(AStream: PStream; Pack: Boolean): PStream;
  73.   private
  74.     BasePos: Longint;
  75.     IndexPos: Longint;
  76.     Index: TResourceCollection;
  77.   end;
  78.  
  79. {$ENDIF}
  80.  
  81.  
  82.  
  83. implementation
  84.  
  85.  
  86. {$IFDEF Windows}
  87. constructor TObject.Init;
  88. type
  89.   Image = record
  90.     Link: Word;
  91.     Data: record end;
  92.   end;
  93. begin
  94.   FillChar(Image(Self).Data, SizeOf(Self) - SizeOf(TObject), 0);
  95.   inherited Init;
  96. end;
  97.  
  98.  
  99. { TResourceCollection }
  100.  
  101. procedure TResourceCollection.FreeItem(Item: Pointer);
  102. begin
  103.   FreeMem(Item, Length(PResourceItem(Item)^.Key) +
  104.     (SizeOf(TResourceItem) - SizeOf(String) + 1));
  105. end;
  106.  
  107. function TResourceCollection.GetItem(var S: TStream): Pointer;
  108. var
  109.   Pos: Longint;
  110.   Size: Longint;
  111.   L: Byte;
  112.   P: PResourceItem;
  113. begin
  114.   S.Read(Pos, SizeOf(Longint));
  115.   S.Read(Size, SizeOf(Longint));
  116.   S.Read(L, 1);
  117.   GetMem(P, L + (SizeOf(TResourceItem) - SizeOf(String) + 1));
  118.   P^.Pos := Pos;
  119.   P^.Size := Size;
  120.   P^.Key[0] := Char(L);
  121.   S.Read(P^.Key[1], L);
  122.   GetItem := P;
  123. end;
  124.  
  125. function TResourceCollection.KeyOf(Item: Pointer): Pointer; assembler;
  126. asm
  127.         MOV     AX,Item.Word[0]
  128.         MOV     DX,Item.Word[2]
  129.         ADD     AX,OFFSET TResourceItem.Key
  130. end;
  131.  
  132. procedure TResourceCollection.PutItem(var S: TStream; Item: Pointer);
  133. begin
  134.   S.Write(PResourceItem(Item)^, Length(PResourceItem(Item)^.Key) +
  135.     (SizeOf(TResourceItem) - SizeOf(String) + 1));
  136. end;
  137.  
  138. { TResourceFile }
  139.  
  140. constructor TResourceFile.Init(AStream: PStream);
  141. type
  142.  
  143. {$IFDEF NewExeFormat}
  144.  
  145.   TExeHeader = record
  146.     eHdrSize:   Word;
  147.     eMinAbove:  Word;
  148.     eMaxAbove:  Word;
  149.     eInitSS:    Word;
  150.     eInitSP:    Word;
  151.     eCheckSum:  Word;
  152.     eInitPC:    Word;
  153.     eInitCS:    Word;
  154.     eRelocOfs:  Word;
  155.     eOvlyNum:   Word;
  156.     eRelocTab:  Word;
  157.     eSpace:     Array[1..30] of Byte;
  158.     eNewHeader: Word;
  159.   end;
  160.  
  161. {$ENDIF}
  162.  
  163.   THeader = record
  164.     Signature: Word;
  165.     case Integer of
  166.       0: (
  167.         LastCount: Word;
  168.         PageCount: Word;
  169.         ReloCount: Word);
  170.       1: (
  171.         InfoType: Word;
  172.         InfoSize: Longint);
  173.   end;
  174. var
  175.   Found, Stop: Boolean;
  176.   Header: THeader;
  177.  
  178. {$IFDEF NewExeFormat}
  179.  
  180.   ExeHeader: TExeHeader;
  181.  
  182. {$ENDIF}
  183.  
  184. begin
  185.   TObject.Init;
  186.   Stream := AStream;
  187.   BasePos := Stream^.GetPos;
  188.   Found := False;
  189.   repeat
  190.     Stop := True;
  191.     if BasePos <= Stream^.GetSize - SizeOf(THeader) then
  192.     begin
  193.       Stream^.Seek(BasePos);
  194.       Stream^.Read(Header, SizeOf(THeader));
  195.       case Header.Signature of
  196.  
  197. {$IFDEF NewExeFormat}
  198.  
  199.         $5A4D:
  200.           begin
  201.             Stream^.Read(ExeHeader, SizeOf(TExeHeader));
  202.             BasePos := ExeHeader.eNewHeader;
  203.             Stop := False;
  204.           end;
  205.         $454E:
  206.           begin
  207.             BasePos := Stream^.GetSize - 8;
  208.             Stop := False;
  209.           end;
  210.         $4246:
  211.           begin
  212.             Stop := False;
  213.             case Header.Infotype of
  214.               $5250:                                    {Found Resource}
  215.                 begin
  216.                   Found := True;
  217.                   Stop := True;
  218.                 end;
  219.               $4C42: Dec(BasePos, Header.InfoSize - 8); {Found BackLink}
  220.               $4648: Dec(BasePos, SizeOf(THeader) * 2); {Found HelpFile}
  221.             else
  222.               Stop := True;
  223.             end;
  224.           end;
  225.         $424E:
  226.           if Header.InfoType = $3230 then               {Found Debug Info}
  227.           begin
  228.             Dec(BasePos, Header.InfoSize);
  229.             Stop := False;
  230.           end;
  231.  
  232. {$ELSE}
  233.  
  234.         $5A4D:
  235.           begin
  236.             Inc(BasePos, LongMul(Header.PageCount, 512) -
  237.               (-Header.LastCount and 511));
  238.             Stop := False;
  239.           end;
  240.         $4246:
  241.           if Header.InfoType = $5250 then Found := True else
  242.           begin
  243.             Inc(BasePos, Header.InfoSize + 8);
  244.             Stop := False;
  245.           end;
  246.  
  247. {$ENDIF}
  248.  
  249.       end;
  250.     end;
  251.   until Stop;
  252.   if Found then
  253.   begin
  254.     Stream^.Seek(BasePos + SizeOf(Longint) * 2);
  255.     Stream^.Read(IndexPos, SizeOf(Longint));
  256.     Stream^.Seek(BasePos + IndexPos);
  257.     Index.Load(Stream^);
  258.   end else
  259.   begin
  260.     IndexPos := SizeOf(Longint) * 3;
  261.     Index.Init(0, 8);
  262.   end;
  263. end;
  264.  
  265. destructor TResourceFile.Done;
  266. begin
  267.   Flush;
  268.   Index.Done;
  269.   Dispose(Stream, Done);
  270. end;
  271.  
  272. function TResourceFile.Count: Integer;
  273. begin
  274.   Count := Index.Count;
  275. end;
  276.  
  277. procedure TResourceFile.Delete(Key: String);
  278. var
  279.   I: Integer;
  280. begin
  281.   if Index.Search(@Key, I) then
  282.   begin
  283.     Index.Free(Index.At(I));
  284.     Modified := True;
  285.   end;
  286. end;
  287.  
  288. procedure TResourceFile.Flush;
  289. var
  290.   ResSize: Longint;
  291.   LinkSize: Longint;
  292. begin
  293.   if Modified then
  294.   begin
  295.     Stream^.Seek(BasePos + IndexPos);
  296.     Index.Store(Stream^);
  297.     ResSize := Stream^.GetPos - BasePos;
  298.     LinkSize := ResSize + SizeOf(Longint) * 2;
  299.     Stream^.Write(RStreamBackLink, SizeOf(Longint));
  300.     Stream^.Write(LinkSize, SizeOf(Longint));
  301.     Stream^.Seek(BasePos);
  302.     Stream^.Write(RStreamMagic, SizeOf(Longint));
  303.     Stream^.Write(ResSize, SizeOf(Longint));
  304.     Stream^.Write(IndexPos, SizeOf(Longint));
  305.     Stream^.Flush;
  306.     Modified := False;
  307.   end;
  308. end;
  309.  
  310. function TResourceFile.Get(Key: String): PObject;
  311. var
  312.   I: Integer;
  313. begin
  314.   if not Index.Search(@Key, I) then Get := nil else
  315.   begin
  316.     Stream^.Seek(BasePos + PResourceItem(Index.At(I))^.Pos);
  317.     Get := Stream^.Get;
  318.   end;
  319. end;
  320.  
  321. function TResourceFile.KeyAt(I: Integer): String;
  322. begin
  323.   KeyAt := PResourceItem(Index.At(I))^.Key;
  324. end;
  325.  
  326. procedure TResourceFile.Put(Item: PObject; Key: String);
  327. var
  328.   I: Integer;
  329.   P: PResourceItem;
  330. begin
  331.   if Index.Search(@Key, I) then P := Index.At(I) else
  332.   begin
  333.     GetMem(P, Length(Key) + (SizeOf(TResourceItem) - SizeOf(String) + 1));
  334.     P^.Key := Key;
  335.     Index.AtInsert(I, P);
  336.   end;
  337.   P^.Pos := IndexPos;
  338.   Stream^.Seek(BasePos + IndexPos);
  339.   Stream^.Put(Item);
  340.   IndexPos := Stream^.GetPos - BasePos;
  341.   P^.Size := IndexPos - P^.Pos;
  342.   Modified := True;
  343. end;
  344.  
  345. function TResourceFile.SwitchTo(AStream: PStream; Pack: Boolean): PStream;
  346. var
  347.   NewBasePos: Longint;
  348.  
  349. procedure DoCopyResource(Item: PResourceItem); far;
  350. begin
  351.   Stream^.Seek(BasePos + Item^.Pos);
  352.   Item^.Pos := AStream^.GetPos - NewBasePos;
  353.   AStream^.CopyFrom(Stream^, Item^.Size);
  354. end;
  355.  
  356. begin
  357.   SwitchTo := Stream;
  358.   NewBasePos := AStream^.GetPos;
  359.   if Pack then
  360.   begin
  361.     AStream^.Seek(NewBasePos + SizeOf(Longint) * 3);
  362.     Index.ForEach(@DoCopyResource);
  363.     IndexPos := AStream^.GetPos - NewBasePos;
  364.   end else
  365.   begin
  366.     Stream^.Seek(BasePos);
  367.     AStream^.CopyFrom(Stream^, IndexPos);
  368.   end;
  369.   Stream := AStream;
  370.   Modified := True;
  371.   BasePos := NewBasePos;
  372. end;
  373. {$ENDIF}
  374.  
  375.  
  376. end.  { of unit BBOject }
  377.