home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PAS_0493.ZIP / TBASE3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-22  |  4.7 KB  |  150 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 458 of 535
  3. From : Ken Burrows                         1:249/201.21         19 Apr 93  18:33
  4. To   : All
  5. Subj : Collecting Objects
  6. ────────────────────────────────────────────────────────────────────────────────
  7.  
  8. Well, here I go again. There have been a few messages here and there regarding
  9. collections and objects and streams. I've been trying to grapple with how
  10. things work, and sometimes I win and sometimes I lose. The following code is my
  11. rendition of a useful TObject Descendent. It is completely collectable and
  12. streamable. Feel free to dismiss it offhand if you like.}
  13.  
  14. Unit TBase3;  {BP 7.0}
  15.               {released to the public domain by ken burrows}
  16. interface
  17. Uses objects,memory;
  18. Type
  19.     TBase = object(TObject)
  20.               Data : Pointer;
  21.               constructor Init(Var Buf;n:longint);
  22.               Constructor Load(Var S:TStream);
  23.               Procedure Store(Var S:TStream); virtual;
  24.               Destructor Done; virtual;
  25.               Private
  26.               Size : LongInt;
  27.             end;
  28.    PBase = ^TBase;
  29. Const
  30.   RBaseRec : TStreamRec = (ObjType : 19560;
  31.                            VMTLink : Ofs(TypeOf(TBase)^);
  32.                            Load    : @TBase.Load;
  33.                            Store   : @TBase.Store);
  34.  
  35. Procedure RegisterTBase;
  36. implementation
  37.  
  38. Constructor TBase.Init(Var Buf;n:longint);
  39.    Begin
  40.      Data := MemAlloc(n);
  41.      if   Data <> Nil
  42.      then begin
  43.             size := n;
  44.             move(Buf,Data^,size);
  45.           end
  46.      else size := 0;
  47.    End;
  48. Constructor TBase.Load(Var S:TStream);
  49.    Begin
  50.      size := 0;
  51.      S.Read(size,4);
  52.      if   (S.Status = StOk) and (size <> 0)
  53.      then begin
  54.             Data := MemAlloc(size);
  55.             if   Data <> Nil 
  56.             then Begin
  57.                    S.read(Data^,size);
  58.                    if   S.Status <> StOk
  59.                    then begin
  60.                           FreeMem(Data,size);
  61.                           size := 0;
  62.                         end;
  63.                  End
  64.             else size := 0; 
  65.           end 
  66.      else Data := Nil;
  67.    End;
  68. Procedure TBase.Store(Var S:TStream);
  69.    begin
  70.      S.write(size,4);
  71.      if Data <> Nil
  72.      then S.Write(Data^,Size);
  73.    End;
  74. Destructor TBase.Done;
  75.    begin
  76.      if Data <> Nil then FreeMem(Data,size);
  77.    end;
  78.  
  79. Procedure RegisterTBase;
  80.    Begin
  81.      RegisterType(RBaseRec);
  82.    End;
  83. End.
  84.  
  85.  
  86.  
  87. Program TestTBase3; {bare bones make/store/load/display a collection}
  88.                     {collected type defined locally to the program}
  89.  
  90. uses objects,tbase3;
  91.  
  92. Procedure ShowStuff(P:PCollection);
  93.    Procedure ShowIt(Pb:PBase); far;
  94.       begin
  95.         if Pb^.Data <> Nil then Writeln(PString(Pb^.Data)^);
  96.       end;
  97.    Begin
  98.      P^.ForEach(@ShowIt);
  99.    End;
  100.  
  101. Var
  102. A_Collection : PCollection;
  103. A_Stream     : TDosStream;
  104. S            : String;
  105. m            : longint;
  106.  
  107. Begin
  108.   m := memavail; RegisterTBase;
  109.   New(A_Collection,init(5,2));
  110.   Repeat
  111.     writeln; write('enter some string : '); Readln(S);
  112.     if   S <> ''
  113.     then A_Collection^.insert(New(PBase,init(S,Length(S)+1)));
  114.   Until S = '';
  115.   writeln; writeln('Storing the collection...');
  116.   A_Stream.init('Test.TB3',stCreate);
  117.   A_Collection^.Store(A_Stream);
  118.   writeln; writeln('Storing Done. ');
  119.   dispose(A_Collection,done); A_Stream.done;
  120.   writeln; writeln('Disposing of Stream and Collection ...');
  121.   if   m = memavail
  122.   then writeln('memory fully released')
  123.   else writeln('memory not fully released');
  124.   write('Press [ENTER] to [continue] ...'); readln;
  125.   writeln;
  126.   writeln('Constructing a new collection using the LOAD constructor');
  127.   A_Stream.init('Test.TB3',stOpenRead);
  128.   New(A_Collection,Load(A_Stream));
  129.   A_Stream.done;
  130.   Writeln; ShowStuff(A_Collection);
  131.   writeln; writeln('Disposing of Stream and Collection ...');
  132.   dispose(A_Collection,done);
  133.   if   m = memavail
  134.   then writeln('memory fully released')
  135.   else writeln('memory not fully released');
  136.   write('Press [ENTER] to [EXIT] ...'); readln;
  137. End.
  138.  
  139. The above code has been tested and works just fine. By defining what I put into
  140. the object and typecasting it when I take it out, I can collect and store and
  141. load just about anything without ever haveing to descend either the
  142. TCollection, TBase or the TDosStream objects. In the case of the above program,
  143. I elected to collect simple strings. It might just as well have been any other 
  144. type of complex record structure. 
  145.  
  146. This program was written solely for the purpose of discovering how the objects 
  147. behave and possibly to even learn something. Any comments, discussions or
  148. flames are always welcome.
  149.  
  150. ...ken