Need Pascal Program Help

Kimerlin

Delphi Developer

Wed, 18 Jun 1902 08:00:00 GMT

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.

Mike Copela

Delphi Developer

Wed, 18 Jun 1902 08:00:00 GMT

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

1. Need Pascal Program Help

2. Need HELP FINISHING PROGRAM (posted program) PASCAL

3. Need help on a very simple Pascal program....

4. Help needed on Pascal programming

5. Need help to modify a Pascal Program

6. Need Help On Protect mode Pascal Programming

7. free idsoftware front-end program in pascal--need help - idgames.pas [1/1]

8. free idsoftware front-end program in pascal--need help - idgames.pas [1/1]

9. Need help on a very simple Pascal program....

10. Need Help with Pascal program