home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / oop.swg / 0007_OBJ-DESC.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  4.2 KB  |  176 lines
  1. {
  2. KEN BURROWS
  3.  
  4. Well, here I go again. There have been a few messages here and there regarding
  5. collections and Objects and streams. I've been trying to grapple With how
  6. things work, and sometimes I win and sometimes I lose. The following code is my
  7. rendition of a useful TObject Descendent. It is completely collectable and
  8. streamable. Feel free to dismiss it offhand if you like.
  9. }
  10.  
  11. Unit TBase3;  {BP 7.0}
  12.               {released to the public domain by ken burrows}
  13. Interface
  14. Uses
  15.   Objects, memory;
  16. Type
  17.   TBase = Object(TObject)
  18.             Data : Pointer;
  19.             Constructor Init(Var Buf;n:LongInt);
  20.             Constructor Load(Var S:TStream);
  21.             Procedure Store(Var S:TStream); virtual;
  22.             Destructor Done; virtual;
  23.             Private
  24.             Size : LongInt;
  25.           end;
  26.   PBase = ^TBase;
  27.  
  28. Const
  29.   RBaseRec : TStreamRec = (ObjType : 19560;
  30.                            VMTLink : Ofs(TypeOf(TBase)^);
  31.                            Load    : @TBase.Load;
  32.                            Store   : @TBase.Store);
  33.  
  34. Procedure RegisterTBase;
  35.  
  36. Implementation
  37.  
  38. Constructor TBase.Init(Var Buf; n : LongInt);
  39. begin
  40.   Data := MemAlloc(n);
  41.   if Data <> Nil then
  42.   begin
  43.     size := n;
  44.     move(Buf,Data^,size);
  45.   end
  46.   else
  47.     size := 0;
  48. end;
  49.  
  50. Constructor TBase.Load(Var S : TStream);
  51. begin
  52.   size := 0;
  53.   S.Read(size,4);
  54.   if (S.Status = StOk) and (size <> 0) then
  55.   begin
  56.     Data := MemAlloc(size);
  57.     if Data <> Nil then
  58.     begin
  59.       S.read(Data^,size);
  60.       if S.Status <> StOk then
  61.       begin
  62.         FreeMem(Data,size);
  63.         size := 0;
  64.       end;
  65.     end
  66.     else
  67.       size := 0;
  68.   end
  69.   else
  70.     Data := Nil;
  71. end;
  72.  
  73. Procedure TBase.Store(Var S : TStream);
  74. begin
  75.   S.Write(size, 4);
  76.   if Data <> Nil then
  77.     S.Write(Data^, Size);
  78. end;
  79.  
  80. Destructor TBase.Done;
  81. begin
  82.   if Data <> Nil then
  83.     FreeMem(Data, size);
  84. end;
  85.  
  86. Procedure RegisterTBase;
  87. begin
  88.   RegisterType(RBaseRec);
  89. end;
  90.  
  91. end.
  92.  
  93.  
  94.  
  95. Program TestTBase3; {bare bones make/store/load/display a collection}
  96.                     {collected Type defined locally to the Program}
  97.  
  98. Uses
  99.   Objects, tbase3;
  100.  
  101. Procedure ShowStuff(P : PCollection);
  102.  
  103.   Procedure ShowIt(Pb : PBase); Far;
  104.   begin
  105.     if Pb^.Data <> Nil then
  106.       Writeln(PString(Pb^.Data)^);
  107.   end;
  108.  
  109. begin
  110.   P^.ForEach(@ShowIt);
  111. end;
  112.  
  113. Var
  114.   A_Collection : PCollection;
  115.   A_Stream     : TDosStream;
  116.   S            : String;
  117.   m            : LongInt;
  118.  
  119. begin
  120.   m := memavail;
  121.   RegisterTBase;
  122.   New(A_Collection,init(5,2));
  123.   Repeat
  124.     Writeln;
  125.     Write('enter some String : ');
  126.     Readln(S);
  127.     if S <> '' then
  128.       A_Collection^.insert(New(PBase,init(S,Length(S)+1)));
  129.   Until S = '';
  130.   Writeln;
  131.   Writeln('Storing the collection...');
  132.   A_Stream.init('Test.TB3',stCreate);
  133.   A_Collection^.Store(A_Stream);
  134.   Writeln;
  135.   Writeln('Storing Done. ');
  136.   dispose(A_Collection,done);
  137.   A_Stream.done;
  138.   Writeln;
  139.   Writeln('Disposing of Stream and Collection ...');
  140.   if m = memavail then
  141.     Writeln('memory fully released')
  142.   else
  143.     Writeln('memory not fully released');
  144.   Write('Press [ENTER] to [continue] ...');
  145.   readln;
  146.   Writeln;
  147.   Writeln('Constructing a new collection using the LOAD Constructor');
  148.   A_Stream.init('Test.TB3',stOpenRead);
  149.   New(A_Collection,Load(A_Stream));
  150.   A_Stream.done;
  151.   Writeln;
  152.   ShowStuff(A_Collection);
  153.   Writeln;
  154.   Writeln('Disposing of Stream and Collection ...');
  155.   dispose(A_Collection,done);
  156.   if m = memavail then
  157.     Writeln('memory fully released')
  158.   else
  159.     Writeln('memory not fully released');
  160.   Write('Press [ENTER] to [EXIT] ...');
  161.   readln;
  162. end.
  163.  
  164. {
  165. The above code has been tested and works just fine. By defining what I put into
  166. the Object and Typecasting it when I take it out, I can collect and store and
  167. load just about anything Without ever haveing to descend either the
  168. TCollection, TBase or the TDosStream Objects. In the Case of the above Program,
  169. I elected to collect simple Strings. It might just as well have been any other
  170. Type of complex Record structure.
  171.  
  172. This Program was written solely For the purpose of discovering how the Objects
  173. behave and possibly to even learn something. Any comments, discussions or
  174. flames are always welcome.
  175. }
  176.