home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / streams.swg / 0001_STREAMS1.PAS.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  6.0 KB  |  160 lines
  1. {
  2. I have a question about registration of Objects to allow them
  3. to be Put on the TDosStream. I want to Write my own Get Function,
  4. but I don't know the name of Variable or even address which points
  5. to the Array of Records of just registered Objects. I would like
  6. to search For appriopriate Record on my own. Is it possible in TV6.0
  7.  
  8. Here si an article that was posted some time ago about locating
  9. the tStreamRec suite in memory: I think it is what you want:
  10.  
  11. > BJ> I am looking For the location of the RegisterTypes
  12. > BJ> Variables. if you make an Register of your Object- where it
  13. > BJ> is stored ? Can I access it through a standard Variable ?
  14. >if you look up the definition of TStreamRec on page 380 of the TVision
  15. >manual a lot may become clearer to your.
  16.  
  17.   As any Typed Constants (another name could be initialized Variables)
  18.   the tStreamRecs are stored in the DATA segment. The actual content is :
  19.     PStreamRec = ^TStreamRec;
  20.     TStreamRec = Record
  21.       ObjType: Word;
  22.       VmtLink: Word;
  23.       Load: Pointer;
  24.       Store: Pointer;
  25.       Next: Word;      <====== this is the link to a next tStreamRec
  26.     end;
  27.   When registering a View , the Procedure RegisterType simply adds
  28.   the new tStreamRec at the top of a stack by filling in the field
  29.   Next (a Word only) since the segment is always DSEG.
  30.   This Field now points to the offset in DSEG of the
  31.   previously registered view...
  32.   The top of the stack is located in a Word Variable
  33.   which is private to the Objects Unit... No way to get it ???
  34.  
  35.   The trick is to register an extra dummy view after all your Real
  36.   registrations.
  37.   The private topofStack(???) Variable will now point to the offset of
  38.   the Dummy View, and THE NEXT field of the dummy view will point
  39.   to THE LAST REGISTERED VIEW. This is the beginning of the thread
  40.   were are looking For....
  41.   Just follow back the NEXT Fields Until a value of 0 that indicates
  42.   the end of the stack (i.e; the first registered view )
  43.   The following Program prints out the Stack of all the tSreamRec
  44.   starting from the dummy view back to the tView streamRec which
  45.   is normally the first registered item.
  46.   We are using the technique to avoid the infamous Runtime error 212
  47.     ( registration of an already registered Type ) , quite common
  48.     if you include the registration process in the initialization part
  49.      of Units . Simply Write a Function IsRegistered that take as
  50.      a parameter a tStreamRec and return True if member of the Stack .
  51.      ( code is Really similar to the exemple below )
  52.    Replace any call to RegisterType(MyStreamRec) by
  53.       if not IsRegistered  (MyStreamRec) then RegisterType(MyStreamRec)
  54. ---------------------------------------------------------------------------}
  55. Program ShowStreamRecs;
  56. { (C) P.Pollet National Institute For Applied Sciences (inSA)
  57.   Lyon France 1992  ppollet@cismibm.univ-lyon1.fr }
  58. Uses Drivers,Objects,views,Dialogs,Menus;
  59. Const
  60.   RDummyView: TStreamRec = (
  61.     ObjType: $FFFF;
  62.     VmtLink: 0;
  63.     Load:    NIL;
  64.     Store:   NIL
  65.   );
  66. Function PtrtoStr(P:Pointer):String;
  67. { convert a Ptr to Hex representation }
  68. Var S:String;
  69.     Param:Array[0..1] of LongInt;
  70. begin
  71.   Param[0]:=Seg(P^);
  72.   Param[1]:=ofs(P^);
  73.   FormatStr(S,'%x:%x',Param);
  74.   PtrtoStr:=S
  75. end;
  76. Function WordtoHex(W:Word):String;
  77. { convert a Word to Hex representation }
  78. Var S:String;
  79.     Param: LongInt;
  80. begin
  81.   Param:=W;
  82.   FormatStr(S,'%x',Param);
  83.   WordtoHex:=S
  84. end;
  85. Procedure ShowThem;
  86. { show the stack or the tStreamrec in DSeg }
  87. Var Base:Word;
  88.     Pt:PstreamRec;
  89.       Procedure ShowArec (Var R:tstreamRec);
  90.       { display Info on the tstreamrec R}
  91.       { the Var is only to Pass the Real Address of R
  92.         and not the address of its copy on the stack !!! }
  93.       begin
  94.         With R do
  95.           begin
  96.             Writeln ('AT      =',PtrtoStr(@R)); { gives the address of the StreamRec}
  97.             Writeln ('ObjType =',ObjType);      { what Object is it see TV6 doc}
  98.             Writeln ('VTMLink =',VmTlink);      { offset of VMT table also in DSEG }
  99.             Writeln ('LOAD    =',PtrtoStr(Load)); { address of Load Constructor }
  100.             Writeln ('StoRE   =',PtrtoStr(Store)); { address of store method }
  101.             Writeln ('Next    =',WordtoHex(Next)); { offset in DSEG of next item }
  102.             Writeln;
  103.           end
  104.       end;
  105. begin
  106.   Base:=ofs(RDummyView);    { start at Dummy view }
  107.   Repeat
  108.      Pt:=Ptr(DSeg,Base);    {Real address is DSG:base}
  109.      ShowARec(Pt^);         {Display this tStreamRec }
  110.      Base:=Pt^.Next;        { move to previous item }
  111.    Until Base=0             { Until first reached }
  112. end;
  113. begin
  114.   {Assign(Output,'RegType.log');}
  115.   ReWrite(Output);
  116.   RegisterViews;            { register some from TV }
  117.   RegisterDialogs;
  118.   RegisterMenus;
  119.   RegisterType(RDummyView); { doN'T ForGET the DummyView at Last ! }
  120.   ShowThem;
  121.   Close(Output)
  122. end.
  123. (*
  124. This is a partial print out of the output ...
  125. AT      =86DC:2       { my Dumy View }
  126. ObjType =65535
  127. VTMLink =0
  128. LOAD    =0:0
  129. StoRE   =0:0
  130. Next    =128      <----  { Real offset of the first VIEW }
  131.                       |
  132. AT      =86DC:128 <----  { the last register View }
  133. ObjType =42              { it is tStatusLine  Type =42 }
  134. VTMLink =184
  135. LOAD    =79AB:1A84
  136. StoRE   =79AB:22E9
  137. Next    =11A       <----
  138.                        |
  139. AT      =86DC:11A  <----    { this is  tMenuBox }
  140. ObjType =41
  141. VTMLink =100
  142. LOAD    =79AB:247
  143. StoRE   =79AB:1171
  144. Next    =10C
  145. ...................................
  146.   cut to save space
  147. ...................................
  148. AT      =86DC:91A     { this is the first registered }
  149. ObjType =1            { tView Type =1 }
  150. VTMLink =1726
  151. LOAD    =7F1C:2C1
  152. StoRE   =7F1C:18FE
  153. Next    =0            {<-----  Next =0 so Last One of the Stack }
  154. Hope it helps you ... Let me know ...
  155.  
  156. of course With TP7, since you have the sources code, you may
  157. modify the OBjECTS Unit( ?) to move the Typed Constant that points at
  158. the top of the list from the Implementation part of the Unit to the
  159. Interface part....
  160.