Board index » delphi » look @ my source code here

look @ my source code here

i waited as long as i could but i cant find the problem in this
program. im including the source. it uses a stream to write a list to
and read from disk. i did it by the book and i cant for the life of
me figure out whats wrong. it seems there can be 7 items lets say in
the list but they would all say the same thing seven times. obviously
a pointer problem. if u can point out my error or have i found a bug
;-).
thanks it should only take a genius like u 5 minutes top.
ill owe u one
thanks
pascal rules

{ this file is to keep track of the special dates that i need to remember
 throughout the year. thats how dumb i am}
Program dater;
uses crt,objects,dos;
            {this is the record object}

Type
    PInfo = ^Tinfo;
    Tinfo = object(Tobject)
    Name:pstring;month,day:integer;
    constructor init(newname:string;newMonth,newday:integer);
    destructor Done; virtual;
    procedure store(var s:Tstream); virtual;
    procedure Load(var s:Tstream);
    end; {tinfo}

CONST {REGISTER THE STREAM TYPE}
      Rinfo:
        TStreamrec =
        (objtype: 1001;
         VMTLink: ofs(Typeof(Tinfo)^);
         Load:  @Tinfo.load;
         Store: @TInfo.Store  );

var
  blackbook:Pcollection;
  entry:PInfo;
  ch:char;
  phonebookfile: Tbufstream;
  s:string;

constructor tinfo.init(newname:string;newMonth,newday:integer );
begin
name := newstr(newname);
Month := newMonth;
Day := newday;
end;  {tinfo.init }

destructor Tinfo.Done;
begin
  DisposeStr(name);
end;
{*************************************************************************}
procedure Tinfo.Load( var s: TStream);
begin
     s.Read(name, sizeof(name));
     s.READ(month, sizeof(month));
     s.Read(day, sizeof(day));
end;
{*************************************************************************}
{*************************************************************************}
procedure Tinfo.store( var s: TStream);
begin
     s.write(name, sizeof(name));
     s.write(month, sizeof(month));
     s.write(day, sizeof(day));
end;

function fileExists(var s : string) : boolean;
begin
  fileExists := fSearch(s, '') <> '';
end;
{*************************************************************************}

{*************************************************************************}
Procedure Newentry( var e:PInfo;  var b:pcollection);
VAR
ch:char; I:integer;

{*************************************************************************}

begin
s := 'fonebook.dat';
if  not Fileexists(s) then
begin
     phonebookfile.init('fonebook.dat',stCreate, 1024);
     phonebookfile.put(b);
     phonebookfile.done;
 end
 else
     begin      {get the old collection from file}

     phonebookfile.init('fonebook.dat',stopenread, 1024);
     b := pcollection(phonebookfile.get);
     phonebookfile.done;
     end;
   {*****************************************************************}
     {geting new info}
     clrscr;
     writeln('Enter name: ');
     readln(e^.name^);
     writeln('Enter Month');
     Readln(e^.Month);
     writeln('Enter day');
     readln(e^.Day);

     {insert it into collection}
  {   b^.Insert(New(pinfo,Init(e^.name^,e^.month,e^.day)));}
      b^.Insert(e);

   clrscr;
   writeln('NAME', 'DATE':25);
   WRITELN('----', '----':25);
        { loop through and print all entries }
   for I := 0 to b^.count -1 do
          begin
          e := b^.at(I);

          writeln(e^.name^, e^.month:25- length(e^.name^),
          '/',e^.day);

          end;
     phonebookfile.init('fonebook.dat',stOpenWrite, 1024);
     phonebookfile.put(b);
     phonebookfile.done;
     blackbook^.freeall;

     ch := readkey;

  {printall1(entry,blackbook);}

END;
{*************************************************************************}
Begin
blackbook := New(PCollection, init(100,50));
registertype(rcollection);
registerType(Rinfo);

REPEAT

clrscr;
writeln('a. New entries');
writeln('b. Check entries');
writeln('c. Print entries');
writeln; writeln;
writeln('Enter letter of choice');
ch := readkey;
case upcase(ch) of
'A': newentry(entry,blackbook);

end;

UNTIL (CH = #27);

END.

 

Re:look @ my source code here


g...@msn.com (Gaws  ) wrote:

Quote
>i waited as long as i could but i cant find the problem in this
>program. im including the source. it uses a stream to write a list to
>and read from disk. i did it by the book and i cant for the life of
>me figure out whats wrong. it seems there can be 7 items lets say in
>the list but they would all say the same thing seven times. obviously
>a pointer problem. if u can point out my error or have i found a bug
>;-).
>thanks it should only take a genius like u 5 minutes top.
>ill owe u one
>thanks
>pascal rules
>{ this file is to keep track of the special dates that i need to remember
> throughout the year. thats how dumb i am}
>Program dater;
>uses crt,objects,dos;
>            {this is the record object}
>Type
>    PInfo = ^Tinfo;
>    Tinfo = object(Tobject)
>    Name:pstring;month,day:integer;
>    constructor init(newname:string;newMonth,newday:integer);
>    destructor Done; virtual;
>    procedure store(var s:Tstream); virtual;
>    procedure Load(var s:Tstream);
>    end; {tinfo}
>CONST {REGISTER THE STREAM TYPE}
>      Rinfo:
>        TStreamrec =
>        (objtype: 1001;
>         VMTLink: ofs(Typeof(Tinfo)^);
>         Load:  @Tinfo.load;
>         Store: @TInfo.Store  );
>var
>  blackbook:Pcollection;
>  entry:PInfo;
>  ch:char;
>  phonebookfile: Tbufstream;
>  s:string;
>constructor tinfo.init(newname:string;newMonth,newday:integer );
>begin
>name := newstr(newname);
>Month := newMonth;
>Day := newday;
>end;  {tinfo.init }
>destructor Tinfo.Done;
>begin
>  DisposeStr(name);
>end;
>{*************************************************************************}
>procedure Tinfo.Load( var s: TStream);
>begin
>     s.Read(name, sizeof(name));
>     s.READ(month, sizeof(month));
>     s.Read(day, sizeof(day));
>end;
>{*************************************************************************}
>{*************************************************************************}
>procedure Tinfo.store( var s: TStream);
>begin
>     s.write(name, sizeof(name));
>     s.write(month, sizeof(month));
>     s.write(day, sizeof(day));
>end;
>function fileExists(var s : string) : boolean;
>begin
>  fileExists := fSearch(s, '') <> '';
>end;
>{*************************************************************************}
>{*************************************************************************}
>Procedure Newentry( var e:PInfo;  var b:pcollection);
>VAR
>ch:char; I:integer;
>{*************************************************************************}
>begin
>s := 'fonebook.dat';
>if  not Fileexists(s) then
>begin
>     phonebookfile.init('fonebook.dat',stCreate, 1024);
>     phonebookfile.put(b);
>     phonebookfile.done;
> end
> else
>     begin      {get the old collection from file}
>     phonebookfile.init('fonebook.dat',stopenread, 1024);
>     b := pcollection(phonebookfile.get);
>     phonebookfile.done;
>     end;
>   {*****************************************************************}
>     {geting new info}
>     clrscr;
>     writeln('Enter name: ');
>     readln(e^.name^);
>     writeln('Enter Month');
>     Readln(e^.Month);
>     writeln('Enter day');
>     readln(e^.Day);
>     {insert it into collection}
>  {   b^.Insert(New(pinfo,Init(e^.name^,e^.month,e^.day)));}
>      b^.Insert(e);
>   clrscr;
>   writeln('NAME', 'DATE':25);
>   WRITELN('----', '----':25);
>        { loop through and print all entries }
>   for I := 0 to b^.count -1 do
>          begin
>          e := b^.at(I);
>          writeln(e^.name^, e^.month:25- length(e^.name^),
>          '/',e^.day);
>          end;
>     phonebookfile.init('fonebook.dat',stOpenWrite, 1024);
>     phonebookfile.put(b);
>     phonebookfile.done;
>     blackbook^.freeall;
>     ch := readkey;
>  {printall1(entry,blackbook);}
>END;
>{*************************************************************************}
>Begin
>blackbook := New(PCollection, init(100,50));
>registertype(rcollection);
>registerType(Rinfo);
>REPEAT
>clrscr;
>writeln('a. New entries');
>writeln('b. Check entries');
>writeln('c. Print entries');
>writeln; writeln;
>writeln('Enter letter of choice');
>ch := readkey;
>case upcase(ch) of
>'A': newentry(entry,blackbook);
>end;
>UNTIL (CH = #27);
>END.

Hey Man -
        Right, You will have to have a good look at your code. Mainly the
stuff to do with your collection. Mainly you have to explain what type
of object you wish to load and store. That is why you have to overide
the basic Load and Store methods of the TCollection. You do this by
creating your own Collection based on a TCollection. The two methods
you are particularly interested in are GetItem and PutItem. For
cleaning up purposes you need to overide FreeItem. These simply tell
the Collection what type of items you are loading,m storing and
freeing.
        Secondly, there is a bit of a problem with your 'entry' variable in
the main program. You, at no point, create a new instance of the
variable. E.G.
        Entry := New( PInfo, Init( 'Neil', 'March', '18th' ) );

Below is one of the many collections of objects that I use. There is
no main part as this is only a unit but a valid one would be pretty
simple ..........

VAR
        AD                              : PAnswerDetails;
        ADCollection    : PAnswerDetailsCollection;
        Loop                    : Integer;
        MyStream                : PStream;

BEGIN
        ADCollection := New( CollectionOfAnswerDetails, Init( 4, SizeOf(
Pointer ) );
        MyStream := new( PBufStream, Init( 'fonebook.dat', stOpenRead, 1024 )
);
        FOR Loop := 1 TO 10 DO
                BEGIN
                        AD := New( PAnswerDetails, Init );
                        AD^.InitializeItem( Loop,  206, 2,  'Dawg', 'Dog', 2.0 );
                        ADCollection^.Insert( AD );
                END;
        ADCollection^.Store( MyStream );
        Dispose( ADCollection, Done );
END;

This little main shall create 10 AD's and store them in ADCollection,
write this lot to a file, FONEBOOK.DAT, and then clean up after
itself.

Unit CollectionOfAnswerDetails;

{ The Results objects }

Interface

Uses
        Objects, Strings;

const
        R_CollectionOfAnswerDetails     = 12345;
        R_AnswerDetails                 = 23456;

type
        PCollectionOfAnswerDetails = ^TCollectionOfAnswerDetails;
        TCollectionOfAnswerDetails = OBJECT( TCollection )

                PROCEDURE       FreeItem( Item  : Pointer ); VIRTUAL;

                FUNCTION                GetItem(VAR S: TStream): Pointer; VIRTUAL;
                PROCEDURE       PutItem(VAR S: TStream; Item: Pointer); VIRTUAL;
        END;

        PAnswerDetails  = ^TAnswerDetails;
        TAnswerDetails  = OBJECT( TObject )

                AnswerID                : LongInt;
                AnsID                   : LongInt;
                AnswerType              : Integer;
                CorrectAnswer   : PChar;
                ActualAnswer    : PChar;
                Attempts                : Integer;
                Mark                    : Real;

                CONSTRUCTOR     Init;

                DESTRUCTOR              Done; VIRTUAL;
                PROCEDURE               InitializeItem( ID                      : LongInt;
                                                                                        AnsType,
                                                                                        Att                     : Integer;
                                                                                        Correct,
                                                                                        Actual          : PChar;
                                                                                        ThisMark        : Real );
                CONSTRUCTOR     Load( VAR S : TStream );
                PROCEDURE               Store( VAR S : TStream );
        END;

Implementation

{
************************************************************************************************
************************************************************************************************
************************************************************************************************
************************************************************************************************
************************************************************************************************
************************************************************************************************
************************************************************************************************
************************************************************************************************

Quote
}

PROCEDURE TCollectionOfAnswerDetails.FreeItem( Item     : Pointer );
BEGIN
        PAnswerDetails( Item )^.Done;
END;

FUNCTION TCollectionOfAnswerDetails.GetItem(VAR S: TStream): Pointer;
VAR
        Item    : PAnswerDetails;
BEGIN
        Item := New( PAnswerDetails, Init );
        Item^.Load( S );
        GetItem := Item;
END;

PROCEDURE TCollectionOfAnswerDetails.PutItem(VAR S: TStream; Item:
Pointer);
BEGIN
        PAnswerDetails( Item )^.Store( S );
END;

{
************************************************************************************************
************************************************************************************************
************************************************************************************************
************************************************************************************************
************************************************************************************************
************************************************************************************************
************************************************************************************************
************************************************************************************************

Quote
}

CONSTRUCTOR TAnswerDetails.Init;
BEGIN
        INHERITED Init;
        CorrectAnswer   := NIL;
        ActualAnswer    := NIL;
        Mark                    := 0;
        AnswerID                := 0;
        AnsID                   := 0;
        AnswerType              := 0;
        Attempts                := 0;
END;

DESTRUCTOR TAnswerDetails.Done;
BEGIN
        IF CorrectAnswer <> NIL THEN
                StrDispose( CorrectAnswer );
        IF ActualAnswer <> NIL THEN
                StrDispose( ActualAnswer );
        INHERITED Done;
END;

PROCEDURE TAnswerDetails.InitializeItem(        ID                      : LongInt;
                                                                                        AnsType,
                                                                                        Att                     : Integer;
                                                                                        Correct,
                                                                                        Actual          : PChar;
                                                                                        ThisMark        : Real );
BEGIN
        AnswerID                := ID;
        AnsID                   := 0;
        AnswerType              := AnsType;
        Attempts                := Att;
        CorrectAnswer   := StrNew( Correct );
        ActualAnswer    := StrNew( Actual );
        Mark                    := ThisMark;
END;

CONSTRUCTOR TAnswerDetails.Load( VAR S : TStream );
BEGIN
        S.Read( AnswerID, SizeOf( AnswerID ) );
        S.Read( AnswerType, SizeOf( AnswerType ) );
        S.Read( Attempts, SizeOf( Attempts ) );
        S.Read( Mark, SizeOf( Mark ) );
        CorrectAnswer := S.StrRead;
        ActualAnswer := S.StrRead;
END;

PROCEDURE TAnswerDetails.Store( VAR S : TStream );
BEGIN
        S.Write( AnswerID, SizeOf( AnswerID ) );
        S.Write( AnswerType, SizeOf( AnswerType ) );
        S.Write( Attempts,
...

read more »

Other Threads