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

Program KenTest;
{ a short program to check out collecting TObject Descendents, as
  opposed to binding data types directly to a collection object}

Uses Objects;
Type
    PBaseData = ^BaseData;
     BaseData = Object(TObject)
                   name : PString;
                   DType: Word;
                   Data : Pointer;
                   Constructor Init(AName:String;Var AData);
                   Procedure PutData(Var S:TStream); virtual;
                   Function GetData(Var S:TStream):Pointer; virtual;
                   Procedure SetData(Var ADAta); virtual;
                   Constructor Load(Var S:TStream);
                   Procedure Store(Var S:TStream); virtual;
                   Destructor Done; virtual;
                 end;
Constructor BaseData.Init(AName:String;Var AData);
   Begin
     Name := NewStr(Aname);
     Data := Nil;
     SetData(AData);
   End;
Constructor BaseData.Load(Var S:TStream);
   Begin
     Name := S.ReadStr;
     S.Read(DType,2);
     Data := GetData(S);
   End;
Procedure BaseData.SetData(Var AData);
   Begin
     DType := 0;
   End;
Procedure BaseData.Store(Var S:TStream);
   Begin
     S.WriteStr(Name);
     S.Write(DType,2);
     PutData(S);
   End;
Function BaseData.GetData(Var S:TStream):Pointer;
   Begin
     GetData := Nil;
   End;
Procedure BaseData.PutData(Var S:TStream);
   Begin
   End;
Destructor BaseData.Done;
  Begin
    DisposeStr(Name);
  End;

Type
   PStrData = ^StrData;
   StrData = Object(BaseData)
                   Procedure PutData(Var S:TStream); virtual;
                   Function GetData(Var S:TStream):Pointer; virtual;
                   Procedure SetData(Var ADAta); virtual;
                   Destructor Done; virtual;
                end;
   LongPtr   = ^LongInt;
   PNumData = ^NumData;
   NumData = Object(BaseData)
                   Procedure PutData(Var S:TStream); virtual;
                   Function GetData(Var S:TStream):Pointer; virtual;
                   Procedure SetData(Var ADAta); virtual;
                   Destructor Done; virtual;
                end;

Procedure StrData.PutData(Var S:TStream);
   Begin
     S.WriteStr(PString(Data));
   End;
Function StrData.GetData(Var S:TStream):Pointer;
   Begin
     GetData := S.ReadStr;
   End;
Procedure StrData.SetData(Var AData);
   Var S:String Absolute AData;
   Begin
     Data := NewStr(S);
     DType := 1;
   End;
Destructor StrData.Done;
   Begin
     DisposeStr(PString(Data));
     Inherited Done;
   End;

Procedure NumData.PutData(Var S:TStream);
   Begin
     S.Write(LongPtr(Data)^,SizeOf(LongInt));
   End;
Function NumData.GetData(Var S:TStream):Pointer;
   Var L : LongPtr;
   Begin
     New(L);
     S.Read(L^,SizeOf(LongInt));
     GetData := L;
   End;
Procedure NumData.SetData(Var AData);
   Var L:LongInt Absolute AData;
   Begin
     DType := 2;
     New(LongPtr(Data));
     LongPtr(Data)^ := L;
   End;
Destructor NumData.Done;
   Begin
     Dispose(LongPtr(Data));
     Inherited Done;
   End;

Const
RStrDataRec : TStreamRec = (ObjType : 19561;
                             VMTLink : Ofs(TypeOf(StrData)^);
                             Load    : @StrData.Load;
                             Store   : @StrData.Store);

RNumDataRec : TStreamRec = (ObjType : 19562;
                             VMTLink : Ofs(TypeOf(NumData)^);
                             Load    : @NumData.Load;
                             Store   : @NumData.Store);

Procedure ShowStuff(P:PCollection);
   Procedure ShowName(P:PBaseData); far;
      Begin
        if P^.Name <> Nil
        then Write(P^.Name^,'   ');
        Case P^.DType of
           1 : if PString(P^.Data) <> Nil then Writeln(PString(P^.Data)^);
           2 : writeln(LongPtr(P^.Data)^);
         end;
      end;
   Begin
     P^.ForEach(@ShowName);
   End;

Var
  P : PCollection;
  Ps : PDosStream;
  m : Longint;
  S : String;
  I : LongInt;
Begin
  m := MaxAvail;
  RegisterType(RCollection);
  RegisterType(RStrDataRec);
  RegisterType(RNumDataRec);
  New(P,init(5,5));
  if P <> Nil then
      Begin
        S := 'String data # 1';
        P^.insert(New(PStrData,init('A string data type ',S)));
        S := 'String data # 2';
        P^.insert(New(PStrData,init('A second string data type ',S)));
        I := 1234567;
        P^.Insert(New(PNumData,init('Numeric Data Type',I)));
        S := 'String Data #3';
        P^.Insert(New(PStrData,init('A third string data type ',S)));
        I := 987654;
        P^.Insert(New(PNumData,init('A second Numeric data type ',I)));
        New(Ps,init('Test1.dta',StCreate));
        if Ps <> Nil then
            begin
              P^.Store(Ps^);
              dispose(P,Done);
              Dispose(Ps,Done);
              if maxavail = m then writeln('mem disposed')
                              else writeln('Failed to release memory');
              new(Ps,init('test1.dta',stopenread));
              if Ps <> Nil then
                 Begin
                   New(P,Load(Ps^));
                   dispose(Ps,done);
                   if P <> Nil then showstuff(P);
                   if p <> Nil then dispose(P,done);
                 end;
            end;
     end;
  if maxavail = m then writeln('mem disposed')
                  else writeln('Failed to release memory');
End.

...ken
---
 * Origin: Telos Point of Source. Replied From Saved Mail.  (Max 1:249/201.21)
       

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