From: ppollet@cismibm.univ-lyon1.fr (Patrick POLLET)
Newsgroups: comp.lang.pascal
Subject: Re: TRescourceFile
Date: Fri, 11 Dec 1992 18:54:28 GMT
Organization: INSA  CENTRE INFORMATIQUE DU 1er CYCLE
NNTP-Posting-Host: 134.214.232.25

In article <1992Dec11.144151.3239@jupiter.sun.csd.unb.ca> tcsmith@mta.ca (Tim Smith) writes:
>From: tcsmith@mta.ca (Tim Smith)
>Subject: TRescourceFile
>Date: Fri, 11 Dec 1992 14:41:51 GMT

>  I'm having a problem with TResourceFile in TP6 that I hope
>someone can suggest a solution to. I Know; " Ugh! Another
>TVision problem" but I spent alot of time sifting through the
>TVsion manual to get this far and I hate to see it all go to
>waste.


   I read your listing that looked OK to me execpt at the last lines.
   You Disposed the Stream and the Disposed the ResourceFile that 
   used that stream. thus disposing twice the Stream... But it is not you 
   problem since your program BOMBED Before that line...

My guess is that your problem is not here but in the Unit that define the 
student objects. since i had no information I made up one out of the
data you gave us. According to method tStnDt.DiplayIn or DisplayOut, it 
seems that 
 Name is a pointer to a record that holds two strings (and not  
to pStrings)
 Id is a pString...
 I am afraid that your problem come from somewhere in the Init, load or may 
store of these objects.
  Since I had no way to check i wrote something that works ... With comments
to help you improve it ...

uses Objects;const  StdntFileName:FnameStr='Stdnt.dat';

(* simulation of your student objet NOT provided *)
Type
      Str20=String[20];
      pData=^tData;
      tData =record
              last :Str20;
              first:Str20;
             end;

      pStudentObj=^tStudentObj;
      tStudentObj=object(tObject)
         name   :pData;
         Id     :pString;
         Constructor Init ;
         Destructor Done; VIRTUAL;
         Constructor Load (var S:tStream);
         Procedure Store( var S:tstream);
       end;

Constructor tStudentObj.Init;
begin
  tObject.Init;   (* likely not needed sinc all fields are initialiezd below ? *)
  New(name);      (* allocate a Last-First name record DID YOU DO IT ?*)
  Name^.last:='';
  Name^.First:='';
  Id:=Newstr('         ');  
             (* allocate enough space to hold the data !!! *)
             (* quite unsafe if you use a readln later on, but that what
                you MUST DO if you want that Id is initialized !!!!
                If You say Id=Newstr('') ==> Id ends up = NIL  
                so a Redaln(Id^) will be terrible !!!!   
end;

Destructor tStudentObj.done;
begin
 If name <>Nil then dispose(Name);  
 if Id <> Nil then DisposeStr(Id)
end;

Constructor tStudentObj.Load(var S:tstream);
var AuxStr:pString;
begin
  New(name);          (* allocate a Last-First name record*)
  AuxStr:=S.ReadStr;  (* since the field in Name are static *)
  Name^.last:=AuxStr^;(* you must read the strings using ReadStr *)
  DisposeStr(Auxstr); (* to a auxillary pString, copy the string to*)
  AuxStr:=S.ReadStr;   (* the field and dispose the AuxString *)
  Name^.first:=AuxStr^; (* you would be better off if Last and First *)
  DisposeStr(Auxstr);   (* were pString !!! *)
  Id:=S.readStr;
end;

Procedure tStudentObj.Store(var S:tstream);
var AuxStr:pString;
begin
  {$V-}             
  S.WriteStr(@Name^.last);  (* WriteStr wants a pointer so the @ is needed*)
  S.writeStr(@Name^.first);
  S.writestr(Id);
end;

type
  PStdntStream=^TStdntStream;
  { I CHANGED FROM TBUFSTEAM TO TDOSSTREAM SINCE IN MY VERSION OF TV (6.0)
    TBUFSTREAM IS CAPRICIOUS . Solved in 6.01 DON'T KNOW ABOUT YOURS ???? *)

  TStdntStream= Object(TDosStream)
                  { Overide the old 'Lame' error procedure}
                  procedure Error(Code, Info : Integer);virtual;
                end;
  PStdnt = ^TStdnt;
  TStdnt = Object(TStudentObj)
             procedure DisplayOut;virtual;
             procedure DisplayIn;virtual;
           end;

(*************** YOUR CODE STARTS HERE *******************************)
const
    RStdnt: TStreamRec = (
         ObjType : 13000;
         VmtLink : Ofs(TypeOf(TStdnt)^);
         Load    : @TStdnt.Load ;
         Store   : @TStdnt.Store);
var
  StdntRez : TResourceFile;
  MyStrm   : PStdntStream;
  Stdnt    : PStdnt;
procedure TStdntStream.Error(Code, Info : Integer);
begin
  WriteLn('Stream error: ', Code, ' (',info,') ');
  halt(1);
end;
procedure TStdnt.DisplayOut;
  begin
    writeln('Last name...',Name^.Last);  
    writeln('ID #',Id^);
  end;

procedure TStdnt.DisplayIn;
  begin
    write('Input Last Name...');
    Readln(Name^.Last);
    write('Input ID (range 10000, 65535)');
    readln(Id^); (* UNSAFE WHAT YOU SHOULD DO IS:
                      Readln(S); Id:=NewStr(S); and then cancel 
                      initialization of Id I put in the Init Constructor*)
  end;

begin
  {** Create and register student **}
  RegisterType(RStdnt);
  Stdnt:=New(PStdnt, Init);
{** Input information **}
  Stdnt^.DisplayIN;
  {** Initialize Resource file **}
  MyStrm:=New(PStdntStream, Init(StdntFileName,stcreate));
  StdntRez.Init(MyStrm);
  {** Save and dispose of Student **}
  StdntRez.Put(Stdnt,'Student1');
  Dispose(Stdnt,Done);

  StdntRez.Done; 

{ closing and Reopening added for checking the File contents
  post mortem using DEBUG }

  MyStrm:=New(PStdntStream, Init(StdntFileName,stopen));
  StdntRez.Init(MyStrm);
  {** Load and display student **}
  Stdnt:=PStdnt(StdntRez.Get('Student1'));
   ' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ DO NO CRASH ANYMORE}
  Stdnt^.DisplayOut;
{** Clean up **}
  Dispose(Stdnt,Done);
  (*Dispose(MyStrm,Done);  *)   (*<============= NO NON NEIN NIET !!!! *)
  StdntRez.Done;                (* the stream will be also disposed 
here !!! *)
end.
(*********************************************************************)
ppollet@cismibm.ibm.univ-lyon1.fr (Patrick POLLET)
--------------------------------------------------------
Dr Patrick L.Pollet
Institut National des Sciences Appliques
Centre Informatique du 1er Cycle  Bat 110
20 Avenue A.Einstein
69621 Villeurbanne Cedex France
--------------------------------------------------------
Phone: 72 43 83 80 -   la premiere erreur c'est
Fax  : 72 43 85 33 -   de se lever le matin  ... GASTON
-------------------------------------------------------
Newsgroups: comp.lang.pascal