PASCAL: Simple Database Program Code
this code is for intermediate PASCAL programmers. just study this..
Code:
program dBase;
uses crt;
const
fname = 'student.dat';
Type
Str50 = String[50];
Student = Record
StudNo, LastName, FirstName, Address : Str50;
MI : char;
End;
function isExist(s : String):integer;
var
studfile : file of Student;
studtmp : Student;
b : integer;
begin
b := 0;
assign(studfile,fname);
reset(studfile);
while not eof(studfile) do
begin
read(studfile,studtmp);
if studtmp.studNo = s then
if b = 0 then
b := 1;
end;
close(studfile);
isExist := b;
end;
procedure bblsort;
var
stud, swap, studA, studB : Student;
studfile : file of Student;
loop, ctr : longint;
swap_occur : integer;
begin
assign(studfile,fname);
reset(studfile);
ctr := 0;
while not eof(studfile) do
begin
read(studfile,stud);
ctr := ctr + 1;
end;
reset(studfile);
repeat
swap_occur := 0;
for loop := 0 to (ctr - 2) do
begin
seek(studfile,loop);
read(studfile,stud);
studA := stud;
seek(studfile,loop+1);
read(studfile,stud);
studB := stud;
if (studA.LastName > studB.LastName) then
begin
swap := studA;
studA := studB;
studB := swap;
seek(studfile,loop);
write(studfile,studA);
seek(studfile,loop+1);
write(studfile,studB);
swap_occur := 1;
end;
end;
ctr := ctr -1 ;
until (swap_occur = 0) or (ctr = 1);
close(studfile);
end;
procedure StudentDetails(stud : Student);
begin
writeln('Student No.: ',stud.StudNo);
writeln(' Last Name: ',stud.LastName);
writeln(' First Name: ',stud.FirstName);
writeln(' Middle: ',stud.MI);
writeln(' Address: ',stud.Address);
end;
procedure StudentInput(var stud : Student);
begin
writeln('Student No.: ');
readln(stud.StudNo);
writeln('Last Name: ');
readln(stud.LastName);
writeln('First Name: ');
readln(stud.FirstName);
writeln('Middle: ');
readln(stud.MI);
writeln('Address: ');
readln(stud.Address);
end;
procedure StudentInput2(var stud : Student);
begin
writeln('Last Name: ');
readln(stud.LastName);
writeln('First Name: ');
readln(stud.FirstName);
writeln('Middle: ');
readln(stud.MI);
writeln('Address: ');
readln(stud.Address);
end;
function getTotalRec : integer;
var
studfile : file of Student;
i : integer;
begin
assign(studfile,fname);
{$I-}
reset(studfile);
{$I+}
if IOresult <> 0 then
rewrite(studfile);
i := filesize(studfile);
close(studfile);
getTotalRec := i
end;
procedure viewDetails(var recNo : longint);
var
studfile : file of Student;
studtmp : Student;
tmp, i : integer;
begin
tmp := recNo - 1;
assign(studfile,fname);
reset(studfile);
seek(studfile,tmp);
read(studfile,studtmp);
StudentDetails(studtmp);
close(studfile);
end;
procedure InvalidMsg;
begin
writeln;
writeln('Invalid Input! Press ENTER to continue...');
readln;
end;
procedure viewList(var inl, cntview, lstoptn : integer);
var
studfile : file of Student;
studtmp : Student;
i, ii, ctr, tmp, pahina : integer;
recordNo : longint;
ch, ync, yndel : char;
begin
assign(studfile,fname);
{$I-}
reset(studfile);
{$I+}
if IOresult <> 0 then
rewrite(studfile);
if filesize(studfile) > 0 then
begin
clrscr;
writeln('Record List');
writeln;
tmp := (filesize(studfile) - 1) div cntview;
if inl > tmp then
inl := tmp
else
if inl < 0 then
inl := 0;
i := inl * cntview;
ctr := i + (cntview - 1);
if (filesize(studfile) - 1) < ctr then
ctr := filesize(studfile) - 1;
for ii := i to ctr do
begin
seek(studfile,ii);
read(studfile,studtmp);
writeln('[',(ii+1):3,'] ',studtmp.LastName,', ',studtmp.FirstName,' ',studtmp.MI);
end;
close(studfile);
writeln;
case lstoptn of
0:
writeln('
- Update Record');
1:
writeln('[D] - Delete Record');
2:
writeln('[V] - View Details');
end;
writeln(' - Previous Page');
writeln('[N] - Next Page');
writeln;
writeln('[X] - Return to Main');
writeln;
writeln('Choose one: ');
ch := readkey;
case ch of
#85,#117:
{U - Update Record}
begin
if lstoptn = 0 then
begin
writeln;
writeln('Enter record # to update:');
readln(recordno);
if (recordno >= 1) and (recordno <= getTotalRec) then
begin
repeat
clrscr;
writeln('Update Record #: ', recordno);
writeln;
viewDetails(recordno);
writeln;
StudentInput2(studtmp);
writeln;
writeln('Are you sure? [Y = yes, N = no, C = Cancel]');
writeln;
StudentDetails(studtmp);
readln(ync);
until (ync = 'Y') or (ync = 'y') or (ync = 'C') or (ync = 'c');
if (ync = 'Y') or (ync = 'y') then
begin
assign(studfile,fname);
reset(studfile);
seek(studfile,recordno-1);
write(studfile,studtmp);
close(studfile);
bblsort;
end;
viewList(inl,cntview,lstoptn);
end
else
begin
writeln;
writeln('Invalid Record #! Press ENTER.');
readln;
viewList(inl,cntview,lstoptn);
end;
end
else
begin
InvalidMsg;
viewList(inl,cntview,lstoptn);
end;
end;
#68,#100:
{D - Delete Record}
begin
if lstoptn = 1 then
begin
writeln;
writeln('Enter Record # to delete:');
readln(recordno);
if (recordno >= 1) and (recordno <= getTotalRec) then
begin
clrscr;
writeln('Are you sure you want to delete this record permanently? [Y = Yes, N = No]');
writeln;
viewdetails(recordno);
writeln;
readln(yndel);
if (yndel = 'Y') or (yndel = 'y') then
begin
assign(studfile,fname);
for i := recordno to getTotalRec - 1 do
begin
reset(studfile);
seek(studfile,i);
read(studfile,studtmp);
seek(studfile,i-1);
write(studfile,studtmp);
end;
reset(studfile);
seek(studfile,getTotalRec-1);
truncate(studfile);
close(studfile);
clrscr;
writeln('Record Successfully Deleted. Press ENTER to continue...');
readln;
end
else
begin
viewList(inl,cntview,lstoptn);
end;
end
else
begin
writeln;
writeln('Invalid Record #! Press ENTER.');
readln;
viewList(inl,cntview,lstoptn);
end;
end
else
begin
InvalidMsg;
viewList(inl,cntview,lstoptn);
end;
end;
#86,#118:
{V - View Specific Record}
begin
if lstoptn = 2 then
begin
writeln;
writeln('Enter record # to view:');
readln(recordno);
writeln;
if (recordno >= 1) and (recordno <= getTotalRec) then
begin
clrscr;
writeln('Record #: ', recordno);
writeln;
ViewDetails(recordno);
writeln;
writeln('Press ENTER to continue...');
end
else
begin
writeln('Invalid Record #! Press ENTER.');
end;
readln;
viewList(inl,cntview,lstoptn);
end
else
begin
InvalidMsg;
viewList(inl,cntview,lstoptn);
end;
end;
#80,#112:
{P - Previous Page}
begin
pahina := inl - 1;
viewList(pahina,cntview,lstoptn);
end;
#78,#110:
{N - Next Page}
begin
pahina := inl + 1;
viewList(pahina,cntview,lstoptn);
end;
#88,#120:{X - Back To Main};
else
begin
InvalidMsg;
viewList(inl,cntview,lstoptn);
end;
end;
end
else
begin
writeln;
writeln('No Record! Press ENTER to Continue...');
close(studfile);
readln;
end;
end;
procedure MainMenu;
var
ch, ync, yn, rk : char;
stud : Student;
studfile : file of Student;
pos, ppage, lstoptn, existed : integer;
begin
clrscr;
pos := 0;
ppage := 5;
writeln(' - Add Record');
writeln(' - Update Record');
writeln('[D] - Delete Record');
writeln;
writeln('[V] - View Records');
writeln('[X] - Exit Program');
writeln;
writeln('Choose one: ');
ch := readKey;
case ch of
#65,#97:
begin
repeat
clrscr;
writeln('*** ADD RECORD ***');
StudentInput(stud);
writeln;
if (stud.studNo <> '') then
begin
existed := isexist(stud.studNo);
if existed = 0 then
begin
writeln('Are you sure? [Y = yes, N = no, C = cancel]');
writeln;
StudentDetails(stud);
readln(ync);
end
else
begin
writeln('INVALID: Student No. Already Exist. Press ENTER to continue...');
readln;
end;
end
else
begin
writeln('INVALID: Please fill up the Student No. Press ENTER to continue...');
readln
end;
until ((ync = 'y') or (ync = 'Y') or (ync = 'c') or (ync = 'C')) and (stud.studNo <> '') and (existed = 0);
if ((ync = 'y') or (ync = 'Y')) then
begin
assign(studfile,fname);
{$I-}
begin
reset(studfile);
seek(studfile,getTotalRec);
write(studfile,stud);
end;
{$I+}
if IOresult <> 0 then
begin
rewrite(studfile);
write(studfile,stud);
end;
close(studfile);
bblsort;
end;
MainMenu;
end;
#85,#117:
begin
lstoptn := 0;
viewList(pos,ppage,lstoptn);
MainMenu;
end;
#68,#100:
begin
lstoptn := 1;
viewList(pos,ppage,lstoptn);
MainMenu;
end;
#86,#118:
begin
lstoptn := 2;
viewList(pos,ppage,lstoptn);
MainMenu;
end;
#88,#120:
begin
writeln;
writeln('Are you sure you want to end this program? [Y/N]:');
readln(yn);
if (yn <> 'Y') and (yn <> 'y') then
MainMenu
else
begin
writeln;
writeln('by: [$]KULLF/\¢[E]');
writeln('http://skullface.multiply.com');
writeln('black_ninjaz@hotmail.com');
writeln;
writeln('Press ENTER to Continue...');
readln;
end;
end;
else
begin
writeln;
writeln('Invalid input! Press any key.');
rk := readkey;
MainMenu;
end
end;
end;
begin
MainMenu;
end.
