[Back to OOP SWAG index] [Back to Main SWAG index] [Original]

    {
    KEN BURROWS

    Well, here I go again. There have been a few messages here and there regarding
    collections and Objects and streams. I've been trying to grapple With how
    things work, and sometimes I win and sometimes I lose. The following code is my
    rendition of a useful TObject Descendent. It is completely collectable and
    streamable. Feel free to dismiss it offhand if you like.
    }

    Unit TBase3;  {BP 7.0}
                  {released to the public domain by ken burrows}
    Interface
    Uses
      Objects, memory;
    Type
      TBase = Object(TObject)
                Data : Pointer;
                Constructor Init(Var Buf;n:LongInt);
                Constructor Load(Var S:TStream);
                Procedure Store(Var S:TStream); virtual;
                Destructor Done; virtual;
                Private
                Size : LongInt;
              end;
      PBase = ^TBase;

    Const
      RBaseRec : TStreamRec = (ObjType : 19560;
                               VMTLink : Ofs(TypeOf(TBase)^);
                               Load    : @TBase.Load;
                               Store   : @TBase.Store);

    Procedure RegisterTBase;

    Implementation

    Constructor TBase.Init(Var Buf; n : LongInt);
    begin
      Data := MemAlloc(n);
      if Data <> Nil then
      begin
        size := n;
        move(Buf,Data^,size);
      end
      else
        size := 0;
    end;

    Constructor TBase.Load(Var S : TStream);
    begin
      size := 0;
      S.Read(size,4);
      if (S.Status = StOk) and (size <> 0) then
      begin
        Data := MemAlloc(size);
        if Data <> Nil then
        begin
          S.read(Data^,size);
          if S.Status <> StOk then
          begin
            FreeMem(Data,size);
            size := 0;
          end;
        end
        else
          size := 0;
      end
      else
        Data := Nil;
    end;

    Procedure TBase.Store(Var S : TStream);
    begin
      S.Write(size, 4);
      if Data <> Nil then
        S.Write(Data^, Size);
    end;

    Destructor TBase.Done;
    begin
      if Data <> Nil then
        FreeMem(Data, size);
    end;

    Procedure RegisterTBase;
    begin
      RegisterType(RBaseRec);
    end;

    end.

    Program TestTBase3; {bare bones make/store/load/display a collection}
                        {collected Type defined locally to the Program}

    Uses
      Objects, tbase3;

    Procedure ShowStuff(P : PCollection);

      Procedure ShowIt(Pb : PBase); Far;
      begin
        if Pb^.Data <> Nil then
          Writeln(PString(Pb^.Data)^);
      end;

    begin
      P^.ForEach(@ShowIt);
    end;

    Var
      A_Collection : PCollection;
      A_Stream     : TDosStream;
      S            : String;
      m            : LongInt;

    begin
      m := memavail;
      RegisterTBase;
      New(A_Collection,init(5,2));
      Repeat
        Writeln;
        Write('enter some String : ');
        Readln(S);
        if S <> '' then
          A_Collection^.insert(New(PBase,init(S,Length(S)+1)));
      Until S = '';
      Writeln;
      Writeln('Storing the collection...');
      A_Stream.init('Test.TB3',stCreate);
      A_Collection^.Store(A_Stream);
      Writeln;
      Writeln('Storing Done. ');
      dispose(A_Collection,done);
      A_Stream.done;
      Writeln;
      Writeln('Disposing of Stream and Collection ...');
      if m = memavail then
        Writeln('memory fully released')
      else
        Writeln('memory not fully released');
      Write('Press [ENTER] to [continue] ...');
      readln;
      Writeln;
      Writeln('Constructing a new collection using the LOAD Constructor');
      A_Stream.init('Test.TB3',stOpenRead);
      New(A_Collection,Load(A_Stream));
      A_Stream.done;
      Writeln;
      ShowStuff(A_Collection);
      Writeln;
      Writeln('Disposing of Stream and Collection ...');
      dispose(A_Collection,done);
      if m = memavail then
        Writeln('memory fully released')
      else
        Writeln('memory not fully released');
      Write('Press [ENTER] to [EXIT] ...');
      readln;
    end.

    {
    The above code has been tested and works just fine. By defining what I put into
    the Object and Typecasting it when I take it out, I can collect and store and
    load just about anything Without ever haveing to descend either the
    TCollection, TBase or the TDosStream Objects. In the Case of the above Program,
    I elected to collect simple Strings. It might just as well have been any other
    Type of complex Record structure.

    This Program was written solely For the purpose of discovering how the Objects
    behave and possibly to even learn something. Any comments, discussions or
    flames are always welcome.
    }

[Back to OOP SWAG index] [Back to Main SWAG index] [Original]