Program Code Program DVD_Program; Uses Menuunit, CRT, dos; {Declaration of constants in program}
Program Code
Program DVD_Program;
Uses Menuunit, CRT, dos;
{Declaration of constants in program}
CONST
Never= False;
mem_mainfile= 'c:\ripmid.rec';
vid_mainfile= 'c:\ripvid.rec';
rentalfile= 'c:\ripren.rec';
yesno: array [boolean] of string = ('No', 'Yes');
{Declaration of data type}
TYPE
mem_rec= record
mid: longint:
mname: string;
address: string;
phone: string;
end;
mem_file= file of mem_rec;
video_rec=record
vid: longint;
vname: string;
actor: string;
genre: string;
cost: real;
stock_number: integer;
end;
video_file= file of video_rec;
rental_rec= record
mid: longint;
vid: longint;
datedue: string;
dateborrowed: datetime;
days: longint;
returned: boolean;
{--------------------------------------------------------------------}
{Declaration of variables}
VAR
member: mem_file;
one_rec: mem_rec;
found: Boolean;
epos: integer;
password: text;
video: video_file;
two_rec: video_rec;
foundb: Boolean;
eposb: integer;
{--------------------------------------------------------------------}
{Ensures that the member names input by users are
valid i.e. all characters are letters}
Function validatemname (mname: string): integer;
VAR
j, l: integer;
c: char;
valid: integer;
Begin
l:= length (mname); valid:= 0;
FOR j:= 1 to 1 DO
Begin
If not (mname[j] in ['A'..'Z','a'..'z','-',' ']) then
valid:= j;
End;
validatemname:= valid;
If (valid<> 0) then
Begin
textcolor (red);
gotoxy (12,19);
Write( 'SORRY INVALID NAME ');
delay (800);
textcolor(blue);
gotoxy (37,13);
For j:= 1 to 1+1 Do
Write (' ');
End;
End;
{--------------------------------------------------------------------}
{Ensures that the video name input by users are
valid i.e. characters, numbers, spaces and dashes only}
Function validatevname (vname: string) : integer;
VAR
j, l: integer;
c: char;
valid: integer;
Begin
l:= length (vname); valid:= 0;
FOR j:= 1 to 1 DO
Begin
If not (vname[j] in ['A'..'Z','a'..'z','-',' ','0'..'9']) then
valid:= j;
End;
validatevname:= valid;
If (valid<> 0) then
Begin
textcolor (red);
gotoxy (12,19);
Write( 'SORRY INVALID NAME ');
delay (800);
textcolor(blue);
gotoxy (37,13);
For j:= 1 to 1+1 Do
Write (' ');
End;
End;
{--------------------------------------------------------------------}
{Ensures that the address entered by the user
is acceptable or valid i.e. containing only letters and numbers.}
Function validateaddress (address: string): integer;
VAR
j, l: integer;
c: char;
valid: integer;
Begin
l:= length (address); valid:= 0;
FOR j:= 1 to 1 DO
Begin
If not (address[j] in ['A'..'Z','a'..'z'..,'#','0'..'9']) then
valid:= j;
End;
validateaddress:= valid;
if ( valid<> 0) then
Begin
textcolor(red);
gotoxy(12,19);
Write( 'SORRY INVALID ADDRESS ');
delay(800);
gotoxy(12,19);
Write (' ');
textcolor(blue);
gotoxy(37,13);
For j:= 1 to 1+1 Do
Write (' ');
End;
End;
{--------------------------------------------------------------------}
{Ensures that the phone # entered by the user is
valid i.e. contains only numbers, spaces or dashes.}
Function validatephone (phone: string): integer;
VAR
j, l: integer;
c: char;
valid: integer;
Begin
l:= length (phone); valid:= 0;
FOR j:= 1 to 1 DO
Begin
If not (phone[j] in['0'..'9','-']) then
valid:= j;
End;
validatephone:= valid;
if ( valid<> 0) then
Begin
textcolor(red);
gotoxy(12,19);
Write( 'SORRY INVALID PHONE NUMBER ');
delay(800);
gotoxy(12,19);
Write (' ');
textcolor(blue);
gotoxy(37,13);
For j:= 1 to 1+1 Do
Write (' ');
End;
End;
{------------------------------------------------------------------}
{Validates the actor name entered by the user.}
Function validateactor ( actor: string): integer;
VAR
j, l: integer;
c: char;
valid: integer;
Begin
l:= length (actor); valid:= 0;
FOR j:= 1 to 1 DO
Begin
If not (actor[j] in ['A'..'Z','a'..'z','-',' ']) then
valid:= j;
End;
validateactor:= valid;
If (valid<> 0) then
Begin
textcolor (red);
gotoxy (12,19);
Write( 'SORRY INVALID NAME ');
delay (800);
textcolor(blue);
gotoxy (37,13);
For j:= 1 to 1+1 Do
Write (' ');
End;
End;
{------------------------------------------------------------------}
{Validates the genre entered by the user.}
Function validategenre ( genre: string): integer;
VAR
j, l: integer;
c: char;
valid: integer;
Begin
l:= length (genre); valid:= 0;
FOR j:= 1 to 1 DO
Begin
If not (genre[j] in ['A'..'Z','a'..'z','-',' ']) then
valid:= j;
End;
validategenre:= valid;
If (valid<> 0) then
Begin
textcolor (red);
gotoxy (12,19);
Write( 'SORRY INVALID GENRE ');
delay (800);
textcolor(blue);
gotoxy (37,13);
For j:= 1 to 1+1 Do
Write (' ');
End;
End;
{------------------------------------------------------------------}
{Validates the cost of a video when it is added to database.}
Function validatecost (cost: real): integer;
VAR
j, l: integer;
c: char;
valid: integer;
Begin
l:= length (cost); valid:= 0;
FOR j:= 1 to 1 DO
Begin
If not (cost[j] in['1','2','3','4','5','6','7','8','9','0',' ','.''-']) then
valid:= j;
End;
validatecost:= valid;
if ( valid<> 0) then
Begin
textcolor(red);
gotoxy(12,19);
Write( 'SORRY INVALID COST ');
delay(800);
gotoxy(12,19);
Write (' ');
textcolor(blue);
gotoxy(37,15);
For j:= 1 to 1+1 Do
Write (' ');
End;
End;
{--------------------------------------------------------------------}
{Used to validate the stock number entered by user.}
Function validatestock_number (number2:string): integer;
VAR
j, l: integer;
valid: integer;
number_2 : integer;
Begin
l:= length (number2); valid:= 0;
FOR j:= 1 to 1 DO
Begin
If not (number2[j] in['1','2','3','4','5','6','7','8','9','0']) then
valid:= j;
Else stock:= 1
End;
validatestock_number:= valid;
if ( valid<> 0) then
Begin
textcolor(red);
gotoxy(12,19);
Write( 'SORRY INVALID NUMBER ');
delay(800);
gotoxy(12,19);
Write (' ');
textcolor(blue);
gotoxy(37,15);
For j:= 1 to 1+1 Do
Write (' ');
End;
End;
{------------------------------------------------------------------}
{Validates the date entered by the user.}
Function validatedate (date: string): integer;
VAR
j, l: integer;
c: char;
valid: integer;
Begin
l:= length (date); valid:= 0;
FOR j:= 1 to 1 DO
Begin
If not (date[j] in['1','2','3','4','5','6','7','8','9','0','/']) then
valid:= j;
End;
validatedate:= valid;
if ( valid<> 0) then
Begin
textcolor(red);
gotoxy(12,19);
Write( 'SORRY INVALID DATE ');
delay(800);
gotoxy(12,19);
Write (' ');
textcolor(blue);
gotoxy(37,15);
For j:= 1 to 1+1 Do
Write (' ');
End;
End;
{--------------------------------------------------------------------}
{This procedure is used to initialise the screen for use.}
Procedure Init_Screen;
Begin
TextMode (co80);
HideCursor;
TextBackGround (1);
ClrScr;
End;
{--------------------------------------------------------------------}
{This procedure is used to initialise the menu for use.}
Procedure Init_Menus;
Begin
Reset_Menu; {Clears any menu values}
{Declaration of menu}
Add_Menu ('File', 1, 1);
Add_Menu ('Initialise File', 1, 2);
Add_Menu ('-', 1, 3);
Add_Menu ('Add a member record', 1, 4);
Add_Menu ('Add a video record', 1, 5);
Add_Menu ('-', 1, 6);
Add_Menu ('Locate member record', 1, 7);
Add_Menu ('Locate video record', 1, 8);
Add_Menu ('-', 1, 9);
Add_Menu('View all member records', 1, 10);
Add_Menu('View all video records', 1, 11);
Add_Menu ('Edit', 2, 1);
Add_Menu ('Edit a member record', 2, 2);
Add_Menu ('Edit a video record', 2, 3);
Add_Menu ('-', 2, 4);
Add_Menu ('Delete a member record', 2, 5);
Add_Menu ('Delete a video record', 2, 6);
Add_Menu ('Rental Record', 3, 1);
Add_Menu ('Do borrow', ...
This is a preview of the whole essay
Add_Menu ('Add a video record', 1, 5);
Add_Menu ('-', 1, 6);
Add_Menu ('Locate member record', 1, 7);
Add_Menu ('Locate video record', 1, 8);
Add_Menu ('-', 1, 9);
Add_Menu('View all member records', 1, 10);
Add_Menu('View all video records', 1, 11);
Add_Menu ('Edit', 2, 1);
Add_Menu ('Edit a member record', 2, 2);
Add_Menu ('Edit a video record', 2, 3);
Add_Menu ('-', 2, 4);
Add_Menu ('Delete a member record', 2, 5);
Add_Menu ('Delete a video record', 2, 6);
Add_Menu ('Rental Record', 3, 1);
Add_Menu ('Do borrow', 3, 2);
Add_Menu ('Count movies out', 3, 3);
Add_Menu ('Do return', 3, 4);
Add_Menu ('Search movies out by member', 3, 5);
Add_Menu ('Exit', 3,6);
Add_Menu ('Set a password', 4, 1);
End;
{--------------------------------------------------------------------}
{This procedure is used to erase the database.}
Procedure init_file;
VAR
response: string;
Begin
Draw_Box (10, 10, 70, 17);
Gotoxy (12, 11);
TextColor (15);
Writeln ('WARNING!!! THIS PROCEDURE CANNOT BE UNDONE!')
Write ('Erase all data? Y or N ');
Readln ( response);
If (response = 'y') or (response = 'Y') then
Begin
Assign (member, 'c:\pas\member.pas');
Rewrite (member);
Close (member);
Assign (video,'c:\pas\video.pas');
Rewrite (video);
Close (video);
Clear_Selected;
Save_Screen;
Draw_Shadow_Box (10, 10 70, 17);
Gotoxy (12, 11);
TextColor (red+blink);
Writeln ('ALL DATA STORED ARE ABOUT TO BE CLEARED..');
Gotoxy (12, 15);
Write ('Press enter to continue...');
Readln (enter);
End;
End;
{--------------------------------------------------------------------}
{This procedure is used to add a new member record.}
Procedure add_a_member;
VAR
size: integer;
temp: mem_rec;
Begin
Assign (member,'c:\pas\member.pas');
Reset (member);
Repeat
size:= filesize(member);
Clear_Selected;
Save_Screen;
Draw_Shadow_Box (10, 10, 70, 17);
TextColor (15);
Gotoxy (12, 10);
Write (' ADD CUSTOMER RECORD');
Gotoxy (12, 11);
TextColor (Red);
Write (' -------------);
Gotoxy (12, 12);
TextClor (blue);
one_rec.mid := size;
If (size> 0) then
Begin
Seek (member, filesize(member) - 1);
Read (member, temp);
one_rec.mid := temp.mid + 1;
End;
Write ('Member id # is :' one_rec.mid);
Repeat
Gotoxy (12, 13);
Write ('Please enter member name: ');
Readln (one_rec.mname);
Until (validatemname(one_rec.mname)=0);
Repeat
Gotoxy (12, 14);
Write(' Please enter address :');
Readln (one_rec.address);
Until (validateaddress (one_rec.address)=0);
Repeat
Gotoxy (12, 15);
Write ('Please enter the member's phone number :');
Readln (one_rec.phone);
Until (validatephone (one_rec.phone)=0);
Gotoxy (12, 17);
Write ('Press enter to save record');
Gotoxy (12, 18);
Write ('Press Esc to clear values');
ch:= #0
ch:= Readkey
If (ch = #13) then
Begin
Seek (member, filesize(member));
Write (member, one_rec);
Gotoxy (12, 19);
TextColor (red+blink);
Write ('RECORD WAS SAVED.....');
Delay (800)
End;
Restore_Screen;
Window (1, 2, 80, 24);
Until (ch= #13);
Close (member);
{Since Draw_Shadow_Box messes up window settings
it has to be reset}
End;
{--------------------------------------------------------------------}
{This procedure is used to add video records onto the database.}
Procedure add_a_video;
VAR
size: integer;
temp: item_rec;
Begin
Assign (video,'c:\pas\item.pas');
Reset (video);
Repeat
size:= filesize (video);
Clear_Selected;
Save_Screen;
Draw_Shadow_Box (20, 30, 70, 30);
TextColor (15);
Gotoxy (12, 10);
Write ('Add a DVD record');
Gotoxy (12, 11);
TextColor (red);
Write ('----------------------------');
Gotoxy (12, 12);
TextColor (green);
two_rec.vid := size;
If (size > 0) then
Begin
Seek (video, filesize (video) -1);
Read (video, temp);
two_rec.vid:= temp.vid + 1;
End;
Write (DVD id # is:' two_rec.vid);
Repeat
Gotoxy (12, 13);
Write ('Please enter the DVD name:');
Readln (two_rec.vname);
Until (validatevname (two_rec.vname)= 0);
Repeat
Gotoxy (12, 14);
Write ('Please enter the actors in this DVD: ');
Readln ( two_rec.actor);
Until (validateactor ( two_rec.actor)=0);
Repeat
Gotoxy (12, 15);
Write (' Please enter movie genre: ');
Readln (two_rec.genre);
Until (validategenre (two_rec.genre)=0);
Repeat
Gotoxy (12, 16);
Write (' Please enter cost of this DVD:$ ');
Readln (two_rec.cost);
Until (validatecost (two_rec.cost)= 0);
Repeat
Gotoxy (12, 17);
Write (' Please enter the number of copies of this movie in stock: ');
Readln ( two_rec.stock_number);
Until (validatestock_number (two_rec.stock_number)= 0);
Gotoxy ( 12, 18);
Write ('Press enter to save record...');
Gotoxy (12, 19);
Write(' Press Esc to clear values');
ch:= #0;
ch:= ReadKey;
If (ch:= #13) then
Begin
Seek (video, filesize (video));
Write (video, two_rec);
Gotoxy (12, 20);
TextColor (red+ blink);
Write ('Record was saved');
Delay (800);
End;
Restore_Screen;
Window (1, 2, 80, 24);
Until (ch= #13);
Close (video);
{Since Draw_Shadow_Box messes up window settings
it has to be reset}
End;
{--------------------------------------------------------------------}
{This procedure is used to search for an existing member record in the database.}
Procedure search_for_member;
VAR
size, i, an_id: integer;
one_rec: mem_rec;
Begin
Assign (member, 'c:\pas\member.pas');
Reset (member);
size:= filesize (member);
For i:= 1 to size Do
Begin
Read (member, one_rec);
epos:= filepos (member);
If (one_rec.mid= an_id) then
Begin
found:= true;
i:= size;
End;
End;
Close (member);
End;
{--------------------------------------------------------------------}
{This procedure is used to search for an existing video record in the database.}
Procedure search_for_video;
VAR
size, i, an_id: integer;
two_rec: video_rec;
Begin
Assign (video, 'c:\pas\ video.pas');
Reset (video);
size:= filesize (video);
For i:= 1 to size Do
Begin
Read (video, two_rec);
epos:= filepos (video);
If (two_rec.vid= an_id) then
Begin
found:= true;
i:= size;
End;
End;
Close (video);
End;
{--------------------------------------------------------------------}
{This procedure is used to display an existing member record from the database.}
Procedure display_member (one_rec:mem_rec);
Begin
Gotoxy (12, 12);
TextColor (green);
Write ('Member id # is: ', one_rec.mid);
Gotoxy (12, 13);
Write ('Name:');
Write (one_rec.mname);
Gotoxy (12, 14);
Write ('Address:');
Write (one_rec.address);
Gotoxy (12, 15);
Write ('Phone #:');
Write (one_rec.phone);
End;
{--------------------------------------------------------------------}
{This procedure is used to display an existing video record from the database.}
Procedure display_video (two_rec:video_rec);
Begin
Gotoxy (12, 12);
TextColor (green);
Write ('Video id # is: ', two_rec.vid);
Gotoxy (12, 13);
Write ('Name:');
Write (two_rec.vname);
Gotoxy (12, 14);
Write ('Actor:');
Write (two_rec.actor);
Gotoxy (12, 15);
Write ('Genre:');
Write (two_rec.genre);
Gotoxy (12, 16);
Write ('Cost:$ ');
Write (two_rec.cost);
Gotoxy (12, 17);
Write ('Number of copies:');
Write (two_rec.stock_number);
End;
{--------------------------------------------------------------------}
{This procedure is used to locate a member record stored in the database.}
Procedure locate_member_record;
VAR
mid: longint;
Begin
found:= false;
Clear_Selected;
Save_Screen;
Draw_Shadow_Box (10, 9, 70, 20);
TextColor (15);
Gotoxy (12, 10);
Write ( 'Locate member record...');
Gotoxy (12, 11);
TextColor (blue);
Write ('Please enter the id # of member to be found: ');
Readln (mid);
search_for_member (one_rec,mid);
If (found) then
display_member (one_rec)
Else
Begin
TextColor (red+ blink);
Gotoxy (12, 14);
Write (' SORRY RECORD NOT FOUND....');
Delay (800);
End;
TextColor (blue);
Gotoxy (12, 20);
Write ('Press Enter to continue...');
ch:= #0;
Repeat
ch:= Readkey;
Until ch= #13;
Restore_Screen;
Window (1, 2, 80, 24);
{Since Draw_Shadow_Box messes up window settings
it has to be reset}
End;
{--------------------------------------------------------------------}
{This procedure is used to locate a video record stored in the database.}
Procedure locate_video_record;
VAR
vid: longint;
Begin
found:= false;
Clear_Selected;
Save_Screen;
Draw_Shadow_Box (10, 9, 70, 20);
TextColor (15);
Gotoxy (12, 10);
Write ( 'Locate a DVD record...');
Gotoxy (12, 11);
TextColor (blue);
Write ('Please enter the id # of DVD to be found: ');
Readln (vid);
search_for_video (two_rec,vid);
If (found) then
display_video (two_rec)
Else
Begin
TextColor (red+ blink);
Gotoxy (12, 14);
Write (' SORRY RECORD NOT FOUND....');
Delay (800);
End;
TextColor (blue);
Gotoxy (12, 20);
Write ('Press Enter to continue...');
ch:= #0;
Repeat
ch:= Readkey;
Until ch= #13;
Restore_Screen;
Window (1, 2, 80, 24);
{Since Draw_Shadow_Box messes up window settings
it has to be reset}
End;
{--------------------------------------------------------------------}
{This procedure is used to view all member records stored in the database.}
Procedure view_all_member;
VAR
i, size: integer;
Begin
Assign (member,' c:\pas.member\pas');
Reset (member);
size:= filesize (member);
For i:= 1 to size Do
Begin
Clear_Selected;
Save_Screen;
Draw_Shadow_Box (10, 9, 70, 20);
TextColor (15);
Gotoxy (12, 10);
Write ( 'View all member records...');
Gotoxy (12, 11);
TextColor (red);
Write (' ---------------------------');
Read (member, one_rec);
display_member (one_rec)
Gotoxy (12, 19);
TextColor (blue);
Write ('Press Enter to continue or Esc to exit...');
ch:= Readkey;
If ch= #27 then
i:= size;
End;
Close (member);
Restore_Screen;
Window (1, 2, 80, 24);
{Since Draw_Shadow_Box messes up window settings
it has to be reset}
End;
{--------------------------------------------------------------------}
{This procedure is used to view all video records stored in the database.}
Procedure view_all_video;
VAR
i, size: integer;
Begin
Assign (video,' c:\pas.video\pas');
Reset (video);
size:= filesize (video);
For i:= 1 to size Do
Begin
Clear_Selected;
Save_Screen;
Draw_Shadow_Box (10, 9, 70, 20);
TextColor (15);
Gotoxy (12, 10);
Write ( 'View all video records...');
Gotoxy (12, 11);
TextColor (red);
Write (' ---------------------------');
Read (video, two_rec);
display_video (two_rec)
Gotoxy (12, 19);
TextColor (blue);
Write ('Press Enter to continue or Esc to exit...');
ch:= Readkey;
If ch= #27 then
i:= size;
End;
Close (video);
Restore_Screen;
Window (1, 2, 80, 24);
{Since Draw_Shadow_Box messes up window settings
it has to be reset}
End;
{--------------------------------------------------------------------}
{This procedure is used to edit a member record stored in the database.}
Procedure do_edit_member;
VAR
one_rec: mem_rec;
an_id: integer;
Begin
Gotoxy (12, 18);
Write ('Please enter the field to edit (1-3) ');
Gotoxy (12, 17);
Write ('1- ');textColor (red+ blink); write ('Name '); textcolor (blue);
Write ('2- ');textColor (red+ blink); write ('Address '); textcolor (blue);
Write ('3- ');textColor (red+ blink); write ('Phone # '); textcolor (blue);
ch:= readkey;
case ch of
'1' Repeat
Gotoxy (12, 19);
Write ('Please enter member name: ');
Readln (one_rec.mname);
Until ( validatemname (one_rec.mname)=0);
'2' Repeat
Gotoxy (12, 19);
Write ('Please enter address: ');
Readln (one_rec.address);
Until ( validateaddress (one_rec.address)=0);
'3' Repeat
Gotoxy (12, 19);
Write ('Please enter phone #: ');
Readln (one_rec.phone);
Until ( validatephone (one_rec.phone)=0);
End; {End of repeat loop}
Seek (member, epos-1);
Write (member, one_rec);
End;
{--------------------------------------------------------------------}
{This procedure is used to edit a member record stored in the database.}
Procedure edit_member;
VAR
mid: longint;
Begin
Clear_Selected;
Save_Screen;
Draw_Shadow_Box (7, 8, 70, 23);
TextColor (15);
Gotoxy (12, 10);
Write ( 'Edit a member record...');
Gotoxy (12, 11);
TextColor (red);
Write (' ---------------------------');
TextColor (blue);
Gotoxy (12, 12);
Write (' Enter the id# of member record to modify: ');
Read (mid);
search_for_member (one_rec, mid);
If (found) then
Begin
display_member (one_rec);
Assign (member,' c:\pas.member.pas');
Reset (member);
do_edit_member (one_rec.mid);
Close (member);
End;
Else
Begin
TextColor (red+ blink);
Gotoxy (12, 14);
Write (' Sorry you are attempting to edit a non existing member record..');
Delay (800);
End;
Gotoxy (12, 22);
Write ('Press Enter to continue')
ch:= #0;
Repeat
ch:= ReadKey;
Until ch= #13;
Restore_Screen;
Window (1, 2, 80, 24);
{Since Draw_Shadow_Box messes up window settings
it has to be reset}
End;
{--------------------------------------------------------------------}
{This procedure is used to edit a video record stored in the database.}
Procedure do_edit_video;
VAR
two_rec: video_rec;
an_id: integer;
Begin
Gotoxy (12, 18);
Write ('Please enter the field to edit (1-5) ');
Gotoxy (12, 17);
Write ('1- ');textColor (red+ blink); write ('DVD Name '); textcolor (blue);
Write ('2- ');textColor (red+ blink); write ('Actor '); textcolor (blue);
Write ('3- ');textColor (red+ blink); write ('Genre '); textcolor (blue);
Write ('4- ');textColor (red+ blink); write ('Cost '); textcolor (blue);
Write ('5- ');textColor (red+ blink); write ('Number of copies '); textcolor (blue);
ch:= readkey;
case ch of
'1' Repeat
Gotoxy (12, 19);
Write ('Please enter DVD name: ');
Readln (two_rec.vname);
Until ( validatevname (two_rec.vname)=0);
'2' Repeat
Gotoxy (12, 19);
Write ('Please enter actor: ');
Readln (two_rec.actor);
Until ( validateactor (two_rec.actor)=0);
'3' Repeat
Gotoxy (12, 19);
Write ('Please enter genre: ');
Readln (two_rec.genre);
Until ( validategenre (two_rec.genre)=0);
'4' Repeat
Gotoxy (12, 19);
Write ('Please enter cost: ');
Readln (two_rec.cost);
Until ( validatecost (two_rec.cost)=0);
'5' Repeat
Gotoxy (12, 19);
Write ('Please enter number of copies: ');
Readln (two_rec.stock_number);
Until (validatestock_number (two_rec.stock_number)=0);
End; {End of repeat loop}
Seek (video, epos-1);
Write (video, two_rec);
End;
{--------------------------------------------------------------------}
{This procedure is used to edit a video record stored in the database.}
Procedure edit_video;
VAR
vid: longint;
Begin
Clear_Selected;
Save_Screen;
Draw_Shadow_Box (7, 8, 70, 23);
TextColor (15);
Gotoxy (12, 10);
Write ( 'Edit a video record...');
Gotoxy (12, 11);
TextColor (red);
Write (' ---------------------------');
TextColor (blue);
Gotoxy (12, 12);
Write (' Enter the id# of video record to modify: ');
Read (vid);
search_for_video (two_rec, vid);
If (found) then
Begin
display_video (two_rec);
Assign (video,' c:\pas.video.pas');
Reset (video);
do_edit_video (two_rec.vid);
Close (video);
End;
Else
Begin
TextColor (red+ blink);
Gotoxy (12, 14);
Write (' Sorry you are attempting to edit a non existing DVD record..');
Delay (800);
End;
Gotoxy (12, 22);
Write ('Press Enter to continue');
ch:= #0;
Repeat
ch:= ReadKey;
Until ch= #13;
Restore_Screen;
Window (1, 2, 80, 24);
{Since Draw_Shadow_Box messes up window settings
it has to be reset}
End;
{--------------------------------------------------------------------}
{This procedure is used to find and erase a member record stored in the database.}
Procedure do_delete_member;
VAR
one_rec: mem_rec;
size, i, an_id: integer;
temp: mem_file;
Begin
Assign (member,'c:\pas\member.pas');
Reset (member);
Assign (temp,'c:\pas\temp.pas');
Rewrite (temp);
size:= filesize (member);
For i:= 1 to size Do
Begin
Read (member, one_rec);
If (one_rec.mid<> an_id) then
Write (temp, one_rec);
End;
Rewrite (member);
Reset (temp);
size:= 1 to size Do
Begin
Read (temp, one_rec);
Write (member, one_rec);
End;
Close (member);
TextColor (red+ blink);
Gotoxy (12, 18);
Write ('Record was deleted..');
Delay (800);
End;
{--------------------------------------------------------------------}
{This procedure is used to find and erase a member record stored in the database.}
Procedure delete_member;
VAR
mid: longint;
Begin
Clear_Selected;
Save_Screen;
Draw_Shadow_Box (10, 9, 70, 20);
TextColor (15);
Gotoxy (12, 10);
Write (' Delete a member record ');
Gotoxy (12, 11);
TextColor (red);
Writeln ('THIS PROCEDURE IS NON REVERSIBLE!!');
Gotoxy (12, 12);
Write ('Enter id # of member record to be deleted: ');
Readln (mid);
search_for_member (one_rec, mid);
If (found) then
Begin
display_member (one_rec);
do_delete_member (one_rec, mid);
End;
Else
Begin
TextColor (red+ blink);
Gotoxy (12, 14);
Write (' Sorry you are attempting to delete a non existing member record');
Delay (800);
End;
TextColor (blue);
Gotoxy (12, 19);
Write ('Press Enter to continue');
ch:= #0;
Repeat
ch:= Readkey;
Until ch= #13
Restore_Screen;
Window (1, 2, 80, 24);
{Since Draw_Shadow_Box messes up window settings
it has to be reset}
End;
{--------------------------------------------------------------------}
{This procedure is used to find and erase a DVD record stored in the database.}
Procedure do_delete_video;
VAR
two_rec: video_rec;
size, i, an_id: integer;
temp: video_file;
Begin
Assign (video,'c:\pas\video.pas');
Reset (video);
Assign (temp,'c:\pas\temp.pas');
Rewrite (temp);
size:= filesize (video);
For i:= 1 to size Do
Begin
Read (video, two_rec);
If (two_rec.vid<> an_id) then
Write (temp, two_rec);
End;
Rewrite (video);
Reset (temp);
size:= 1 to size Do
Begin
Read (temp, two_rec);
Write (video, two_rec);
End;
Close (video);
TextColor (red+ blink);
Gotoxy (12, 18);
Write ('DVD record was deleted..');
Delay (800);
End;
{--------------------------------------------------------------------}
{This procedure is used to find and erase a video record stored in the database.}
Procedure delete_video;
VAR
vid: longint;
Begin
Clear_Selected;
Save_Screen;
Draw_Shadow_Box (10, 9, 70, 20);
TextColor (15);
Gotoxy (12, 10);
Write (' Delete a DVD record ');
Gotoxy (12, 11);
TextColor (red);
Writeln ('THIS PROCEDURE IS NON REVERSIBLE!!');
Gotoxy (12, 12);
Write ('Enter id # of DVD record to be deleted: ');
Readln (vid);
search_for_video (two_rec, vid);
If (found) then
Begin
display_video (one_rec);
do_delete_video (one_rec, id);
End;
Else
Begin
TextColor (red+ blink);
Gotoxy (12, 14);
Write (' Sorry you are attempting to delete a non existing video record');
Delay (800);
End;
TextColor (blue);
Gotoxy (12, 19);
Write ('Press Enter to continue');
ch:= #0;
Repeat
ch:= Readkey;
Until ch= #13
Restore_Screen;
Window (1, 2, 80, 24);
{Since Draw_Shadow_Box messes up window settings
it has to be reset}
End;
{--------------------------------------------------------------------}
{This procedure is used to view a rental record.}
Procedure Rental_record (rr: rentals);
VAR
dateborrowed: datetime;
Begin
With rr do
Begin
ClrScr;
Writeln ('Member id: ', rr.mid);
Writeln (' Video id :', rr.vid);
With dateborrowed Do
Writeln (' Date borrowed: year,'/', month'/', day);
Writeln (' Days borrowed for: ' days);
Writeln ('Returned?', yesno[rr.returned]);
End;
End;
{--------------------------------------------------------------------}
{This procedure is used to search movies out by a member.}
Procedure search_member_rental;
VAR
rr: rentals;
rf: file of rentals;
s_memberid, mp, vp: word; {location pointers to files- members, videos}
a, z: longint;
rfile: string;
ch: char;
found: boolean;
location0: word;
Begin
ClrScr;
Writeln;
{open files}
Assign (rf, RENTAL FILE);
Reset (rf);
z:= filesize (rf);
found:= false;
If z= 0 then
Begin
Close (rf);
Writeln ('Rental file is empty.');
Readkey;
Exit;
End;
Write ('Enter member to search for');
Readln (s_memberid);
found:= false;
location0:= $ffff;
For a:= 0 to z-1 do
Begin
Read (rf,rr);
If (rr.mid=s_memberid) and not rr.returned then
Begin
Rental_record (rr);
Writeln;
Write (' Would you like to continue searching? (Y/N)');
Repeat
ch:= upcase (readkey);
Until ch in ['Y','N'];
Writeln (ch);
If ch= 'N' then
Begin
found:= true;
location0:=a
exit; break;
End;
exit;
break;
End;
End;
if not found then Writeln(' No results found');
readkey;
Close (rf);
End;
{--------------------------------------------------------------------}
{This procedure is used to carry out a rental transaction.}
Procedure do_borrow;
VAR
rr: rentals;
rf: file of rentals;
mr: members;
mf: file of members;
vr: videos;
vf: file of videos;
z: longint;
mp, vp: word; {location pointers to files- members, videos}
ch: char;
mfound, vfound: boolean;
label exitproc;
year, month, day: integer;
Begin
{open files}
Assign (rf, rentalfile);
Reset (rf);
Assign (mf, mem_mainfile);
Reset (mf);
Assign (vf, vid_mainfile);
Reset (rf);
Textattr := $1f;
Writeln ('BORROW');
{Search for member record}
locate_member_record (mfound, mp);
If not mfound then goto ExitProc;
Seek (mf, mp);
Read (mf, mr);
{Search for video record to be borrowed}
locate_video_record (vfound, vp);
If not vfound then goto ExitProc;
Seek (vf, vp);
Read (vf, vr);
{Verify}
Textattr := $5f;
ClrScr;
Writeln;
Textattr := $5e;
Write (mr.mname);
Textattr := $5f;
Write (' is borrowing');
Textattr := $5a;
Writeln (vr.vname);
Textattr := $5f;
{Get date}
Writeln;
Writeln ('Enter today's date');
Repeat
Readln (year, month, day);
Writeln (' Today is', year,'/', month,'/'day);
Writeln;
Until (validatedate= 0);
Write (' Continue Borrow?');
Repeat ch := upcase (readkey);
Until ch in ['Y', 'N'];
Writeln (ch);
If ch:= 'N' then goto ExitProc;
Writeln;
Write (' Days borrowed for?');
Readln (rr.days);
Writeln;
{Setup new rental record}
With rr do
Begin
rr.mid:= mr.mid;
rr.vid:= vr.vid;
returned:= false;
End;
{Save record to file}
z:= filesize (rf);
Seek (rf, z);
Write (rf, rr);
Textcolor (blue);
Writeln (' RECORD WAS SAVED');
Readln;
ExitProc: Close (rf);
Close (mf);
Close (vf);
Textattr:= $7;
clrscr;
End;
{--------------------------------------------------------------------}
{This procedure is used to count the number of movies out.}
Procedure count_movies_out;
VAR
rr: rentals;
rf: file of rentals;
a, z, count: longint;
ch: char;
Begin
ClrScr;
Writeln;
Assign (rf, rentalfile);
Reset (rf);
z:= filesize (rf);
count:= 0;
For a:= 1 to z do
Begin
Read (rf, ff);
If not rr.returned then
Begin
inc (count);
Writeln (count,' VideoID (',rr.vid,'); MemberID (',rr.mid,')');
End;
End;
Writeln (' Count found=' count);
Readln;
Close (rf);
End;
{--------------------------------------------------------------------}
{This procedure is used to carry out a return transaction.}
Procedure do_return;
VAR
found: boolean;
location: word;
rf: file of rentals;
rr: rentals;
ch: char;
Begin
ClrScr;
search_member_rental (found, location);
If not found then exit;
If found then
Begin
Assign (rf, rentalfile);
Reset (rf);
Seek (rf, location);
Read (rf, rr);
Rental_record (rr);
Writeln;
Write (' Return Video? (Y/N)');
Repeat ch:= upcase (readkey);
Until ch in ['Y', 'N'];
Writeln (ch);
If ch = 'Y' then
Begin
rr.returned:= true; {sets returned to true}
Seek (rf, location);
Write (rf, rr);
Writeln (' Video returned.');
End;
Else Writeln (' Video not returned.');
Readkey;
Close (rf);
End;
End;
{--------------------------------------------------------------------}
{This procedure is used welcome the user to the program.}
Procedure welcome;
VAR
x: integer;
count: integer;
Begin
ClrScr;
Textattr:= $1;
Gotoxy (12, 5);
Writeln ('*-*-*-*-*-*-*-*-*-*- WELCOME *-*-*-*-*-*-*-*-*-*');
Textattr:= $1;
x:= 1;
Write (' Thank you for choosing Angel Corp');
Delay (900);
Sound (100);
Delay (300);
Sound (10);
Delay (300);
Sound (100);
Delay (300);
Sound (200);
Delay (200);
Sound (500);
Delay (70);
Nosound;
Delay (1000);
Gotoxy (20, 20);
Textattr:= $81;
Write ('............Program loading..............');
Delay (2500);
End;
{--------------------------------------------------------------------}
{This procedure is used say farewell to the user when it is shutting down.}
Procedure goodbye;
VAR
x: integer;
count: integer;
Begin
ClrScr;
Textattr:= $1;
Gotoxy (12, 5);
Writeln ('*-*-*-*-*-*-*-*-*-*- GOODBYE *-*-*-*-*-*-*-*-*-*');
Textattr:= $1;
x:= 1;
Delay (900);
Sound (100);
Delay (300);
Sound (10);
Delay (300);
Sound (100);
Delay (300);
Sound (200);
Delay (200);
Sound (500);
Delay (70);
Nosound;
Delay (1000);
Gotoxy (20, 15);
Textattr:= $85;
Write (' Made by Angel Corp');
Readkey;
halt;
End;
{--------------------------------------------------------------------}
{This procedure is used to set or change a password.}
Procedure set_password;
VAR
apass, pass: string
valid: boolean;
i: integer;
ch: string;
Begin
valid:= false;
Assign (password, 'c:\pas\passw.pas');
Reset (password);
Read (password, pass);
Close (password);
Repeat
Init_screen;
Clear_Scelected;
Save_Screen;
Draw_Shadow_Box (10, 9, 70, 16);
TextColor (blue);
Gotoxy (12, 10);
Write (' Please enter old password');
ch:= "; apass := "; i:= 40;
Repeat
apass:= apass + ch;
ch:= readkey;
Gotoxy (i, 10);
inc (i);
Write ('*');
Until ( ch= #13);
Gotoxy (12, 12);
TextColor (red+ blink);
If (apass= pass) then
Begin
Init_screen;
Clear_Selected;
Save_Screen;
Draw_Shadow_Box ( 10, 9, 70, 16);
TextColor (15);
Gotoxy (12, 10);
Write (' Please enter new password');
ch:= "; apass:= "; i:= 40;
Repeat
apass:= apass+ ch;
ch:= readkey;
Gotoxy (i, 10);
inc (i);
Write ('*');
Until (ch =# 13);
Assign (password, 'c:\pas\passw.pas');
Rewrite (password);
Write (password, apass);
Close (password);
valid: true;
End;
Else
Begin
Write (' Sorry Invalid Password');
Gotoxy (12, 14);
Write ('Press Enter to try again');
Readkey;
End;
Until (valid);
End;
{--------------------------------------------------------------------}
{This procedure is allows user to select options from the menu.}
Procedure menu_selection;
Begin
Repeat
Init_Screen;
Init_Menus;
{Set menu colours.}
C_MenuBack:= 8;
C_MenuText:= 2;
C_HighBack:= 12;
C_HighText:= 16;
Bottom_Bar ('F10 = Activate menu. Select exit on the file menu to quit');
Create_Menu (1, 1, 79);
ch:= #0;
Window (1, 2, 80, 24);
If key pressed then ch:= readkey;
If ch= #0 then
Begin
ch:= readkey;
If ch= #68 then {F10 pressed}
Window (1, 1, 80, 25);
Start_Menu_Sys;
Window (1, 2, 80, 24);
End;
{Check what was selected from the menu}
If selected (1, 2) then
init_file;
If selected (1, 4) then
add_a_member;
If selected (1, 5) then
add_a_video;
If selected (1, 7) then
locate_member_record;
If selected (1, 8) then
locate_video_record;
If selected (1, 10) then
view_all_member;
If selected (1, 11) then
view_all_video;
If Selected (3, 6) then
Exit: Begin
Clear_Selected;
TextMode (co80);
TextBackGround (0);
goodbye;
End;
If selected (2, 2) then
edit_member;
If selected (2, 3) then
edit_video;
If selected (2, 5) then
delete_member;
If selected (2, 6) then
delete_video;
If selected (3, 1) then
Rental_record;
If selected (3, 2) then
do_borrow;
If selected (3, 3) then
do_return;
If selected (3, 4) then
count_movies_out;
If selected (3, 5) then
search_member_rental;
If selected (4, 1) then
set_password;
Until never;
End;
{--------------------------------------------------------------------}
{This procedure sets the password.}
Procedure pass_word;
VAR
apass, pass: string;
valid: boolean;
i: integer;
ch: string;
Begin
valid:= false;
Assign (password, 'c:\pas\passw.pas');
Reset (password);
Read (password, pass);
Close (password);
Repeat
Init_screen;
Clear_Selected;
Save_Screen;
Draw_Shadow_Box (10, 9, 70, 16);
TextColor (15);
Gotoxy (12, 10);
Write ('Please enter password');
ch:="; apass:="; i:= 35;
Repeat
apass:= apass+ ch;
ch:= readkey;
Gotoxy (i, 10);
inc (i);
Write ('*');
Until (ch= #13);
Gotoxy (12, 12);
TextColor (red+ blink);
If (apass= pass) then
valid:= true;
Else
Begin
Write ('Sorry invalid password');
Gotoxy (12, 14);
Write (' Press enter to try again');
Readkey;
End;
Until (valid);
End;
{--------------------------------------------------------------------}
{This is the main program.}
Begin
welcome;
pass_word;
menu_selection;
goodbye;
End.
