Board index » delphi » Need Pascal Program Help

Need Pascal Program Help

This program actually about student registration system....with option in
the CASE option.  I try very hard to do with link list and lost in space
(see coding).  Something wrong with my open file section.... what I get in
the diskette are funny character instead of student data... why????

Lost in PAscal Code,
Kim

program StudentDatabaseApplication;
USES CRT,DOS;
TYPE
    keytype = string;

    module = record
 subject     : string;
      classcode   : string;
 test        : integer;
 assignment  : integer;
 exam        : integer;
 grade       : string;
    end;

    student_type = record
 stud_name   : string;
 sex         : string;
 stud_ID     : keytype;
 modules     : ARRAY[1..12] of module;
      status      : char;
    end;

    stud_ptr = ^studentDB;

    studentDB = record
      data        : student_type;
 next        : stud_ptr;
    end;

VAR
   Student_file              : FILE OF student_type;
{  Oldfile,newfile           : FILE OF student_type;
   Student, New_Student      : student_type;}
   List                      : stud_ptr;

procedure create_list(VAR list: stud_ptr);
begin
    list := nil;
end;

function empty_list(list : stud_ptr): boolean;
begin
    empty_list := (list = nil);
end;

function full_list(list: stud_ptr):boolean;
VAR
   temp : stud_ptr;
begin
     new(temp);
     IF temp = nil THEN
        full_list := TRUE
     ELSE
        begin
             full_list := FALSE;
             DISPOSE (TEMP);
        end;
end;

procedure insert_data(VAR newrec: stud_ptr);

        VAR
          new_stud_rec : Student_type;
begin
        clrscr;
        new(newrec);
        Assign(Student_file, 'a:\Student.dat');
        Reset(Student_File);
            Writeln;
            Writeln;
            Writeln('        N E W   S T U D E N T   R E C O R D   E N T R
Y');
            Writeln('
*****************************************************');
            Writeln;
            Writeln;
            Write('        Student ID                  : ');
            Readln(newrec^.data.stud_ID);
            Write('        Student Name                : ');
            Readln(newrec^.data.stud_name);
            Write('        Student Gender (M/F)        : ');
            Readln(newrec^.data.sex);
            Write('        Student Status (Comp/Incomp): ');
            Readln(newrec^.data.status);
            newrec^.next := nil;
            Write(Student_file,new_stud_rec);
            Close(Student_file);
            clrscr;
end;

procedure insert_rec(VAR list: stud_ptr; newrec:stud_ptr; VAR
success:boolean);

VAR
   curr,prev : stud_ptr;
   done,dup  : boolean;
begin
     prev := nil;
     curr := list;
     done := FALSE;
     dup  := FALSE;

     WHILE (curr <> nil) AND (NOT done) DO
        begin
   IF (newrec^.data.stud_ID > curr^.data.stud_ID) THEN
      begin
  prev := curr;
                curr := curr^.next;
      end
   ELSE
    done := true
        end;

        IF (curr = nil) THEN
           dup := false
        ELSE
           IF (newrec^.data.stud_ID <> curr^.data.stud_ID) THEN
              dup := false
           ELSE
              dup := true;

        IF (NOT dup) THEN
           begin
               IF (prev = nil) THEN
                  begin
                      newrec^.next := list;
                      list := newrec;
                  end
               ELSE
                  begin
                      newrec^.next := curr;
                      prev^.next := newrec;
                  end;
                  success := true;
            end
        ELSE
            success := FALSE;
end;

procedure locate(list: stud_ptr;  target : keytype;
                 VAR wanted : stud_ptr);
VAR
   curr : stud_ptr;
begin
     curr := list;
     WHILE (curr <> nil) AND (curr^.data.stud_ID <> target) DO
           curr := curr^.next;
     IF curr^.data.stud_ID = target THEN
        wanted := curr
     ELSE
        wanted := nil;
end;

procedure get_ID(VAR wanted : keytype);
begin
    clrscr;
    Writeln;
    Writeln;
    Writeln('             L O C A T E   S T U D E N T   R E C O R D');
    Writeln('          ***********************************************');
    Writeln;
    Writeln;
    Write('                         Student ID  : ');
    Readln(wanted);
end;

procedure add_record(VAR list: stud_ptr);

VAR
   newrec        : stud_ptr;
   Another       : char;
   success, cont : boolean;

begin
     REPEAT
           cont := NOT full_list(list);
           IF cont THEN
              begin
                   insert_data(newrec);
                   insert_rec(list,newrec,success);
                   IF success THEN
                      writeln('      Student Record Added')
                   ELSE
                      writeln('      Student ID Already Exists...Student
Record Not Added');
              end
           ELSE
               begin
                    writeln;
                    writeln;
                    writeln('      Insufficient memory...Unable To Add
Student Record...');
               end;
               delay(1000);
               writeln;
               writeln;
               write('     Add Another Record (Y/N) ?....');
               readln(another);
               clrscr;
     UNTIL (upcase(another) = 'N') OR (NOT cont);
end;

procedure Delete(VAR list: stud_ptr);

VAR
    target       : keytype;
    prev, wanted : stud_ptr;
    Student      : student_type;
begin
        clrscr;
       Assign(Student_File, 'a:\Student.dat');
        Reset(Student_File);
        IF NOT empty_list(list) THEN
         begin
           get_ID(target);
           locate(list, target, wanted);
           IF wanted <> nil THEN
             begin
                prev := list;
                IF
                  prev = wanted THEN
                  list := wanted^.next
                ELSE
                    begin
                        WHILE prev^.next <> wanted DO
                              prev := prev^.next;
                        prev^.next := wanted^.next;
                    end;
                DISPOSE(wanted);
             end
           ELSE
             writeln;
             writeln;
             writeln('             No Such ID !...Record Not Deleted');
             delay(1000);
         end
        ELSE
            writeln;
            writeln;
            writeln('              List is EMPTY!!!');
            delay(1000);
            clrscr;
       Rewrite(Student_File);
        close(Student_File);
end;

procedure Update(VAR list: stud_ptr);
VAR
   target : keytype;
   prev, wanted : stud_ptr;

begin
     clrscr;
     IF NOT empty_list(list) THEN
        begin
             get_ID(target);
             locate(list, target,wanted);
             IF wanted <> nil THEN
                begin
                     writeln;
                     writeln('Student ID     : ', wanted^.data.stud_ID);
                     writeln('Student Name   : ', wanted^.data.stud_name);
                     writeln('Student Gender : ', wanted^.data.sex);
                     writeln;

writeln('==============================================');
                     writeln;
                     write('Student Status : ');
                     readln(wanted^.data.status);
                     write('

procedure main_menu(VAR list:stud_ptr);

VAR
   option: char;
begin
     clrscr;
     REPEAT
 writeln;
      writeln;
      writeln('      S T U D E N T   D A T A B A S E   M A I N   M E N U');
      writeln('
*******************************************************');
      writeln;
      writeln;
      writeln('             [1] ...............Insert Record');
 writeln('             [2] ...............Delete Record');
 writeln('             [3] ...............Update Record');
 writeln('             [4] ...........List all students');
 writeln('             [5] ....List students in a class');
 writeln('             [6] .....List students in a unit');
 writeln('             [7] ...........Save Student File');
 writeln('             [9] ........................Quit');
      writeln;
 write('             Choose options     : ');
        readln(option);

        CASE (option) OF
             '1' : add_record(list);
             '2' : delete(list);
             '3' : update(list);
             '4' : list_student(list);
             '5' : list_class(list);
             '6' : list_unit(list);
             '7' : save_rec(list);
             '9' :
        ELSE
              begin
                writeln;
                writeln('             Invalid Option!.. Please Try Again');
                delay (1000);
                clrscr;
            end;
        end;
     UNTIL
        option = '9';
        writeln;
        writeln('             ~~~ Thank You ~~~');
        delay (1000);
        clrscr;
end;

begin
    create_list(list);
    main_menu(list);
end.

 

Re:Need Pascal Program Help


In article <77d40b$ua...@mango.singnet.com.sg>, kimer...@singnet.com.sg
says...
Quote
> This program actually about student registration system....with option in
> the CASE option.  I try very hard to do with link list and lost in space
> (see coding).  Something wrong with my open file section.... what I get in
> the diskette are funny character instead of student data... why????
> program StudentDatabaseApplication;

[original source deleted...]
   It was a good start, and you're only encountering a problem of
"uninitialized data" in your file output.  That is, the garbage you're
seeing is due to not initializing all the data fields in the record when
you "add" it to the linked list and write it to the file: you're only
filling in the name, id, sex, and status, but the Modules array in the
record isn't cleared or initialized.
   There were numerous other problems, such as your overwriting the first
record as you added each subsequent record (because you closed the file
and reopened with each action, which does all I/o from the 1st record
position), uninitialized pointers (a BAD error many programmers get
into...), lack of data "case" processing (making finding data in your
file very difficult), your use of "string" (256 characters!) where
smaller string data types are surely called for, loss of data by not
loading the existing file, assumption of the files presence, etc.  
   I've rewritten much of your program's code and done some initial
testing to see that it runs.  I suspect you won't be able to hand it in,
though, if part of your assignment was to use Linked Lists (I substituted
Pointer Array processing for the L/L stuff).  Nonetheless, you should be
able to see the overall flow and control in the code...

program ModifiedStudentDatabaseApplication;
USES CRT,DOS;
Const MaxStud = 500;
      Blanks = '                                                  ';
TYPE KeyType = string[6];  { change! }
     Module  = record
                 Subject     : string[24]; { change! }
                 ClassCode   : string[6];     { "  }
                 Test        : integer;
                 Assignment  : integer;
                 Exam        : integer;
                 Grade       : Char;
               end;
    Student_Type = record
                     Stud_Name   : string[50]; { change! }
                     Sex         : Char;
                     Stud_Id     : KeyType;
                     Status      : Char;
                     Active      : boolean;    { Active/Deleted status }
                     Modules     : ARRAY[1..12] of Module;
                   end;
     Student_Ptr = ^Student_Type;
VAR
   Student_File              : FILE OF Student_Type;
   List                      : array[1..MaxStud] of Student_Ptr;
   CRIdx                     : integer;
   SRCount                   : integer;
   Work                      : Student_Ptr;
   UpdFlag                   : boolean;            { file update flag }

procedure Initialize;
var I : integer;
begin
  for I := 1 to MaxStud do                  { initialize all pointers }
    begin
      List[I] := Nil
    end;
  SRCount := 0; CRIdx := 0; UpdFlag := false;
  Assign(Student_File, 'a:\Student.dat');
{$I-}
  Reset(Student_File);
{$I+}
  if IOResult <> 0 then ReWrite (Student_File)
  else                              { existing data - load into memory }
    begin
      while not EOF (Student_File) do
        begin
          New (Work); Read(Student_File,Work^);
          Inc(CRIdx); List[CRIdx] := Work; Inc (SRCount)
        end;
    end;
                { now, the file is ready to append new data record(s) }
end;  { Initialize }

function Full_List : boolean;
begin
  Full_List := SRCount >= MaxStud
end;

function Upper (S : string): string;          { convert to UPPER case }
var I : integer;
begin
  for I := 1 to Length(S) do S[I] := UpCase(S[I]);
  Upper := S
end;  { Upper }

procedure New_Data;
var I : integer;
begin
  ClrScr; Writeln; Writeln;
  Writeln('        N E W   S T U D E N T   R E C O R D   E N T R Y');
  Writeln('*****************************************************');
  Writeln; Writeln; New (Work);
  with Work^ do
    begin
      Stud_Id := Blanks;
      Write('        Student ID                  : '); Readln(Stud_Id);
      Stud_Id := Upper(Stud_Id); Stud_Name := Blanks;
      Write('        Student Name                : '); Readln(Stud_Name);
      Write('        Student Gender (M/F)        : '); Readln(Sex);
      Sex := UpCase(Sex);
      Write('        Student Status (C/I)        : '); Readln(Status);
      Status := UpCase(Status);
      for I := 1 to 12 do with Modules[I] do{ initialize rest of record }
        begin
          Subject := Blanks; ClassCode := Blanks; Test := 0;
          Assignment := 0; Exam := 0; Grade := ' '
        end;
      Active := true; UpdFlag := true
    end;
{  Write(Student_File,Work^); }
  ClrScr;
end;  { New_data }

procedure Insert_Rec(VAR Okay : boolean);
begin
  Inc (CRIdx); Okay := false;
  if CRIdx <= MaxStud then
    begin
      List[CRIdx] := Work; Okay := true
    end
end;  { Insert_Rec }

function Locate(Key : KeyType; VAR Wanted : Student_Ptr): boolean;
VAR I     : integer;
    Found : boolean;
begin
  I := 1; Found := false; CRIdx := 0;
  while (not Found) and (I <= CRIdx) and (List[I] <> Nil) do with
List[I]^ do
    if (Stud_Id = Key) and (Active) then Found := true
    else                                 Inc (I);
  if Found then
    begin
      Wanted := List[I]; CRIdx := I
    end;
  Locate := Found
end;  { Locate }

procedure Get_Id(VAR Key : KeyType);
begin
  ClrScr; Writeln; Writeln;
  Writeln('             L O C A T E   S T U D E N T   R E C O R D');
  Writeln('          ***********************************************');
  Writeln; Writeln;
  Write('                         Student ID  : '); Readln(Key);
  Key := Upper(Key)
end;

procedure Add_Record;
VAR NewRec       : Student_Type;
    More         : char;
    Success,Cont : boolean;
begin
  REPEAT
    Cont := NOT Full_List;
    IF Cont THEN
      begin
        New_Data; Insert_Rec(Success);
        IF Success THEN writeln('      Student Record Added')
        ELSE writeln('Student ID Already Exists...Student Record Not
Added');
      end
    ELSE
      begin
        writeln; writeln;
        writeln('      Insufficient memory...Unable To Add Student
Record...');
      end;
    Delay(1000); writeln; writeln;
    write('     Add Another Record (Y/n) ?....'); readln(More);
    More := UpCase(More);
    if More <> 'N' then More := 'Y';                 { force default }
    ClrScr
  UNTIL (More = 'N') OR (NOT cont);
end;  { Add_Record }

procedure Delete_Rec;
VAR Target       : KeyType;
    Student      : Student_Ptr;
begin
  ClrScr;
  IF SRCount > 0 THEN
    begin
      Get_Id(Target);
      IF Locate(Target,Student) THEN  { CRIdx points to located record }
        with Student^ do
          begin
            Active := false; Dec (SRCount)
          end
      ELSE
        begin
          writeln; writeln;
          writeln('             No Such ID !...Record Not Deleted');
          Delay(1000);
        end
    end
  ELSE
    begin
      writeln; writeln; writeln('              List is EMPTY!!!');
      Delay(1000); ClrScr;
    end
end;

procedure Update;
VAR Target : KeyType;
    Wanted : Student_Ptr;
begin
  ClrScr;
  IF SRCount > 0 THEN
    begin
      Get_Id(Target);
      IF Locate(Target,Wanted) THEN with Wanted^ do
        begin
          writeln;
          writeln('Student ID     : ', Stud_Id);
          writeln('Student Name   : ', Stud_Name);
          writeln('Student Gender : ', Sex);
          writeln;
writeln('==============================================');
          writeln; write('Student Status : '); readln(Status);
{ *** need to update the current record here!!! }
        end
    end
end;

procedure Windup;                            { terminate application }
var I : integer;
begin
  Close (Student_File);                        { end of adds/updates }
  if UpdFlag then                            { rebuild the data file }
    begin
      Rewrite (Student_File);
      for I := 1 to CRIdx do
        if List[I] <> Nil then with List[I]^ do
          begin
            if Active then Write (Student_File,List[I]^)
          end;
      Close (Student_File)
    end;
end;  { Windup }

procedure Main_Menu;
VAR Option: char;
begin
  ClrScr;
  REPEAT
    writeln; writeln;
    writeln('      S T U D E N T   D A T A B A S E   M A I N   M E N U');
    writeln('*******************************************************');
    writeln; writeln;
    writeln('             [1] ...............Insert Record');
    writeln('             [2] ...............Delete Record');
    writeln('             [3] ...............Update Record');
    writeln('             [4] ...........List all Students');
    writeln('             [5] ....List Students in a class');
    writeln('             [6] .....List Students in a unit');
    writeln('             [7] ...........Save Student File');
    writeln('             [9] ........................Quit');
    writeln;
    write('             Choose Options     : '); readln(Option);
    CASE Option OF
     '1' : Add_Record;
     '2' : Delete_Rec;
     '3' : Update;
     '4' : {List_Student};
     '5' : {List_class};
     '6' : {List_unit};
     '7' : {Save_Rec};
     '9' : Windup;   { added! }
     ELSE  begin
              writeln;
              writeln('             Invalid Option!.. Please Try Again');
              Delay (1000); ClrScr;
            end;
    end  { Case }
  UNTIL Option = '9';
  writeln; writeln('             ~~~ Thank You ~~~'); Delay (1000);
ClrScr;
end;

begin
  Initialize;
  Main_Menu;
  writeln ('Finis...')
end.

Other Threads