Why won't it delete more than once?
I have got a program with a delete procedure but have got one huge problem.
The following is sample test data and will demonstrate my problem
Three records are entered:
Record: 1, Surname: Evans
Record: 2, Surname: Smith
Record: 3, Surname: Jones
If you delete Record: 1, Surname: Evans the records
are altered as follows:
Record: 1, (now becomes) Surname: Smith
Record: 2, (now becomes) Surname: Jones
However, if you try to delete Record: 1, Surname:
Smith it displays it on the screen but will not remove
it.
This is the only thing left to sort out on this program. Because it is so important to me I am offering 500 points.
If it would make it easier I can e-mail the source, but it is also displayed below.
**************************
PROGRAM NEWSAGENTS;
USES
crt, printer, dos;
TYPE
memberrec = RECORD
addrno : BYTE;
surname : STRING[20]; { Surname }
forename : STRING[15]; { Forenames }
address : ARRAY[1..4] OF STRING[30]; { Address }
postcode : STRING[8]; { Post Code }
telno : STRING[20]; { Telephone Number }
dpapers : STRING[50]; { Mon-Sat Papers }
spapers : STRING[50]; { Sun Papers }
total : REAL; { Total in GBP }
lpaid : STRING[15]; { Date Last Paid }
END;
VAR
S : STRING[20];
option : CHAR;
numberrec : INTEGER;
recnum : INTEGER;
IOcode : INTEGER;
recno : INTEGER;
infomem : memberrec;
rafilevar : FILE OF memberrec;
tempfile : FILE OF memberrec;
{$I NALIB.PAS}
FUNCTION getnomem : INTEGER;
BEGIN
ASSIGN(rafilevar,'MEMBER.D
RESET(rafilevar);
getnomem := FILESIZE(rafilevar);
CLOSE(rafilevar);
END; {*********** of function getnomem ***********}
PROCEDURE readmemrec (recno : INTEGER);
BEGIN
{$I-}
ASSIGN(rafilevar,'MEMBER.D
RESET(rafilevar);
SEEK(rafilevar,recno);
READ(rafilevar,infomem);
CLOSE(rafilevar);
{$I+}
END; {************ of procedure readmemrec **********}
PROCEDURE press_next;
BEGIN
cursors('C','N');
TEXTCOLOR(15);
GOTOXY(20,23); WRITELN(' Press Enter For Next Section... ');
READLN;
cursors('C','S');
END;
PROCEDURE press_menu;
BEGIN
cursors('C','N');
TEXTCOLOR(15);
GOTOXY(20,23); WRITELN(' Press Enter to Return to Menu... ');
READLN;
cursors('C','S');
END;
PROCEDURE press_cont;
BEGIN
cursors('C','N');
TEXTCOLOR(15);
GOTOXY(20,23); WRITE(' Press Enter to Continue... ');
READLN;
cursors('C','S');
END;
{*************************
THE FOLLOWING PROCEDURE WILL DISPLAY FULL DETAILS OF A MEMBER STORED IN THE
DATABASE.
**************************
PROCEDURE display_full_member_detail
VAR
FF : CHAR;
ptr : BYTE;
recnum : INTEGER;
BEGIN
cursors('C','N');
FF := #12;
TEXTBACKGROUND(1);
CLRSCR;
TEXTCOLOR(15);
GOTOXY(23,1); WRITELN('HARTLEYS NEWS - CUSTOMER DETAILS');
TEXTCOLOR(10);
GOTOXY(15,5); WRITELN('Surname :- ');
GOTOXY(15,6); WRITELN('Forename :- ');
GOTOXY(15,8);
WRITELN('Address ');
TEXTCOLOR(14);
FOR ptr := 1 TO 4 DO WRITELN(' ',infomem.address[ptr]);
TEXTCOLOR(10);
GOTOXY(15,14); WRITELN('Postcode :- ');
GOTOXY(15,15); WRITELN('Telephone Number :- ');
GOTOXY(15,16); WRITELN('Daily Papers :- ');
GOTOXY(15,17); WRITELN('Sunday Papers :- ');
GOTOXY(15,18); WRITELN('Total :- ');
TEXTCOLOR(14);
GOTOXY(37,18); WRITELN('œ');
TEXTCOLOR(10);
GOTOXY(15,19); WRITELN('Last Paid :- ');
TEXTCOLOR(14);
GOTOXY(37,5); WRITE(infomem.surname);
GOTOXY(37,6); WRITE(infomem.forename);
GOTOXY(37,14); WRITE(infomem.postcode);
GOTOXY(37,15); WRITE(infomem.telno);
GOTOXY(37,16); WRITE(infomem.dpapers);
GOTOXY(37,17); WRITE(infomem.spapers);
GOTOXY(38,18); WRITE(infomem.total:2:2);
GOTOXY(37,19); WRITE(infomem.lpaid);
cursors('C','S');
END; {of PROCEDURE display_full_member_detail
{*************************
THE FOLLOWING PROCEDURE WILL SEND FULL DETAILS OF A MEMBER STORED IN THE
DATABASE TO THE PRINTER.
**************************
PROCEDURE print_member_details;
VAR
FF : CHAR;
reply : CHAR;
ptr : BYTE;
BEGIN
REPEAT
FF := #12;
TEXTCOLOR(15);
GOTOXY(58,23); CLREOL;
GOTOXY(21,23); WRITE('Would You Like a Printout? Y or N : ');
READLN(reply);
TEXTCOLOR(14);
IF (reply='y') OR (reply='Y') THEN
BEGIN
GOTOXY(18,20);
WRITELN('Sending Details to the Printer. Please Wait...');
WRITELN(LST,' Record Number = ',infomem.addrno);
WRITELN(LST);
WRITELN(LST,' HARTLEYS NEWS - - CUSTOMER DETAILS');
WRITELN(LST,' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
WRITELN(LST);
WRITELN(LST,' Surname :- ',infomem.surname);
WRITELN(LST,' Forename :- ',infomem.forename);
WRITELN(LST);
WRITELN(LST,' Address ');
FOR ptr := 1 TO 4 DO WRITELN(LST,' ',infomem.address[ptr]);
WRITELN(LST);
WRITELN(LST,' Postcode :- ',infomem.postcode);
WRITELN(LST,' Telephone Number :- ',infomem.telno);
WRITELN(LST,' Daily Papers :- ',infomem.dpapers);
WRITELN(LST,' Sunday Papers :- ',infomem.spapers);
WRITELN(LST,' Total :- ',infomem.total:2:2);
WRITELN(LST,' Last Paid :- ',infomem.lpaid);
WRITELN(LST,FF);
GOTOXY(1,20); CLREOL;
END;
UNTIL reply IN['y','Y','n','N'];
END; {of PROCEDURE print_member_details}
{*************************
THE FOLLOWING PROCEDURE CREATES THE FILE MEMBER.DAT
**************************
PROCEDURE create_member_record;
VAR
ptr : BYTE;
BEGIN
CLRSCR;
infomem.addrno := 0;
FOR ptr := 1 TO 4 DO infomem.address[ptr] := 'A';
infomem.surname := 'A';
infomem.forename := 'A';
infomem.postcode := 'A';
infomem.telno := 'A';
infomem.dpapers := 'A';
infomem.spapers := 'A';
infomem.total := 0 ;
infomem.lpaid := 'A';
ASSIGN(rafilevar,'MEMBER.D
REWRITE(rafilevar);
WRITE(rafilevar,infomem);
CLOSE(rafilevar);
WRITELN;
WRITELN('PROCEDURE CREATE MEMBER RECORD WAS CALLED BY MAIN MENU');
READLN;
END; {of PROCEDURE create_member_record}
{*************************
THE FOLLOWING PROCEDURE CREATES THE FILE MEMBER.DAT
**************************
PROCEDURE create_temp_file;
VAR
ptr : BYTE;
BEGIN
CLRSCR;
infomem.addrno := 0;
FOR ptr := 1 TO 4 DO infomem.address[ptr] := 'A';
infomem.surname := 'A';
infomem.forename := 'A';
infomem.postcode := 'A';
infomem.telno := 'A';
infomem.dpapers := 'A';
infomem.spapers := 'A';
infomem.total := 0 ;
infomem.lpaid := 'A';
ASSIGN(rafilevar,'TEMP.DAT
REWRITE(rafilevar);
WRITE(rafilevar,infomem);
CLOSE(rafilevar);
END; {of PROCEDURE create_temp_file}
{*************************
THE FOLLOWING PROCEDURE DISPLAYS THE PROMPTS ON THE ADD_MEMBER SCREEN
**************************
PROCEDURE disp_mem;
BEGIN
TEXTCOLOR(10);
GOTOXY(5,5); WRITE('Surname : ');
GOTOXY(5,6); WRITE('Forename : ');
GOTOXY(5,8); WRITELN('Address (4 lines)');
GOTOXY(5,14); WRITE('Postcode : ');
GOTOXY(5,15); WRITE('Telephone Number : ');
GOTOXY(5,16); WRITE('Daily Papers : ');
GOTOXY(5,17); WRITE('Sunday Papers : ');
GOTOXY(5,18); WRITE('Total : ');
TEXTCOLOR(14);
GOTOXY(33,18); WRITE('œ');
TEXTCOLOR(10);
GOTOXY(5,19); WRITE('Last Paid : ');
END; {of PROCEDURE disp_mem}
FUNCTION UpCaseStr(S : STRING) : STRING;
VAR
I : INTEGER;
BEGIN
FOR I := 1 TO Length(S) DO
S[I] := UPCASE(S[I]);
UpCaseStr := S;
END;
{*************************
THE FOLLOWING PROCEDURE GATHERS THE INFO ON THE ADD_MEMBER SCREEN
**************************
PROCEDURE read_mem;
VAR
ptr : BYTE;
BEGIN
TEXTCOLOR(14);
GOTOXY(33,5); READLN(infomem.surname);
GOTOXY(33,6); READLN(infomem.forename);
GOTOXY(1,9); FOR ptr := 1 TO 4 DO READLN(infomem.address[ptr
GOTOXY(33,14); READLN(infomem.postcode);
GOTOXY(33,15); READLN(infomem.telno);
GOTOXY(33,16); READLN(infomem.dpapers);
GOTOXY(33,17); READLN(infomem.spapers);
REPEAT
{$I-}
TEXTCOLOR(14);
GOTOXY(34,18); READLN(infomem.total);
{$I+}
IOcode:=IOresult;
IF IOcode <> 0 THEN
BEGIN
TEXTCOLOR(15);
GOTOXY(20,23); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
GOTOXY(20,23); WRITELN(' ');
GOTOXY(34,18); CLREOL;
END;
UNTIL IOcode = 0;
GOTOXY(33,19); READLN(infomem.lpaid);
END; {of PROCEDURE read_mem}
{*************************
THE FOLLOWING PROCEDURE ADDS A MEMBER TO THE DATABASE
**************************
PROCEDURE add_member;
VAR
response : CHAR;
BEGIN
CLRSCR;
REPEAT
TEXTBACKGROUND(1);
CLRSCR;
numberrec := getnomem;
TEXTCOLOR(15);
GOTOXY(21,1); WRITELN('HARTLEYS NEWS - ADD NEW CUSTOMER');
disp_mem;
read_mem;
press_next;
infomem.addrno := numberrec;
ASSIGN(rafilevar,'MEMBER.D
RESET(rafilevar);
SEEK(rafilevar,numberrec);
WRITE(rafilevar,infomem);
CLOSE(rafilevar);
display_full_member_detail
print_member_details;
CLRSCR;
REPEAT
TEXTCOLOR(14);
GOTOXY(64,10); CLREOL;
GOTOXY(15,10);
WRITE('Would You Like to Enter Another Record. Y or N : ');
READLN(response);
UNTIL response IN['y','Y','n','N'];
UNTIL (response='n') OR (response='N');
END; {of PROCEDURE add_member}
{*************************
THE FOLLOWING TWO PROCEDURES DISLAY THE PROMPTS FOR MODIFYING A RECORD
**************************
PROCEDURE member_headings;
BEGIN
TEXTCOLOR(15);
GOTOXY(5,5); WRITE('A - ');
GOTOXY(5,6); WRITE('B - ');
GOTOXY(5,8); WRITELN('C - ');
GOTOXY(5,14); WRITE('D - ');
GOTOXY(5,15); WRITE('E - ');
GOTOXY(5,16); WRITE('F - ');
GOTOXY(5,17); WRITE('G - ');
GOTOXY(5,18); WRITE('H - ');
GOTOXY(5,19); WRITE('I - ');
END; {of PROCEDURE member_headings}
PROCEDURE disp_member_prompts;
BEGIN
TEXTCOLOR(10);
GOTOXY(10,5); WRITE('Surname ');
GOTOXY(10,6); WRITE('Forename ');
GOTOXY(10,8); WRITELN('Address (4 lines) ');
GOTOXY(10,14); WRITE('Post Code ');
GOTOXY(10,15); WRITE('Telephone Number ');
GOTOXY(10,16); WRITE('Daily Papers ');
GOTOXY(10,17); WRITE('Sunday Papers ');
GOTOXY(10,18); WRITE('Total ');
GOTOXY(10,19); WRITE('Last Paid ');
END; {of PROCEDURE disp_member_prompts}
{*************************
THE FOLLOWING THREE PROCEDURES GATHER NEW INFORMATION AND UPDATE THE
RECORD.
**************************
PROCEDURE field;
BEGIN
TEXTCOLOR(15);
GOTOXY(14,23);
WRITE('Please Enter the Field to be Modified (X to Quit) : ');
END; {of PROCEDURE field}
PROCEDURE modify_member_rec;
VAR
fieldno : CHAR;
ptr : BYTE;
BEGIN
field;
REPEAT
GOTOXY(66,23); WRITE(' ');
GOTOXY(66,23);
READLN(fieldno);
TEXTCOLOR(14);
WITH infomem DO
BEGIN
CASE fieldno OF
'A','a' : BEGIN
GOTOXY(37,5); CLREOL;
GOTOXY(37,5); READLN(surname);
END;
'B','b' : BEGIN
GOTOXY(37,6); CLREOL;
GOTOXY(37,6); READLN(forename);
END;
'C','c' : BEGIN
GOTOXY(20,9); CLREOL;
GOTOXY(20,10); CLREOL;
GOTOXY(20,11); CLREOL;
GOTOXY(20,12); CLREOL;
GOTOXY(1,9); FOR ptr := 1 TO 4 DO READLN(infomem.address[ptr
END;
'D','d' : BEGIN
GOTOXY(37,14); CLREOL;
GOTOXY(37,14); READLN(postcode);
END;
'E','e' : BEGIN
GOTOXY(37,15); CLREOL;
GOTOXY(37,15); READLN(telno);
END;
'F','f' : BEGIN
GOTOXY(37,16); CLREOL;
GOTOXY(37,16); READLN(dpapers);
END;
'G','g' : BEGIN
GOTOXY(37,17); CLREOL;
GOTOXY(37,17); READLN(spapers);
END;
'H','h' : BEGIN
GOTOXY(38,18); CLREOL;
REPEAT
{$I-}
TEXTCOLOR(14);
GOTOXY(38,18); CLREOL;
GOTOXY(38,18); READLN(total);
{$I+}
IOcode:=IOresult;
IF IOcode <> 0 THEN
BEGIN
TEXTCOLOR(15);
GOTOXY(26,21); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
GOTOXY(26,21); WRITELN(' ');
END;
UNTIL IOcode = 0;
END;
'I','i' : BEGIN
GOTOXY(37,19); CLREOL;
GOTOXY(37,19); READLN(lpaid);
END;
'X','x' : BEGIN
GOTOXY(1,23);
CLREOL;
GOTOXY(25,23);
END
ELSE
BEGIN
cursors('C','N');
TEXTCOLOR(15);
GOTOXY(1,23);
CLREOL;
GOTOXY(23,23);
WRITE('Enter A - I Only. Please Wait...');
DELAY(2000);
cursors('C','S');
field;
END;
END;
END;
UNTIL (fieldno = 'X') OR (fieldno = 'x');
END; {of PROCEDURE modify_member_rec}
PROCEDURE modify;
VAR
reply : CHAR;
BEGIN
CLRSCR;
begin
REPEAT
REPEAT
numberrec := getnomem;
CLRSCR;
intro_box(4,1,14);
GOTOXY(15,21);WRITE(' ');
GOTOXY(21,5); WRITELN('HARTLEYS NEWS - MODIFY CUSTOMER DETAILS');
GOTOXY(20,6); WRITELN('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
GOTOXY(23,11); WRITE('Customer record number := ');
{$I-}
READLN(recnum);
{$I+}
IOcode:=IOresult;
IF IOcode <> 0 THEN
BEGIN
TEXTCOLOR(15);
GOTOXY(26,19); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
END;
UNTIL IOcode = 0;
UNTIL (recnum <= getnomem) and (recnum > 0);
readmemrec(recnum);
display_full_member_detail
member_headings;
disp_member_prompts;
modify_member_rec;
display_full_member_detail
print_member_details;
infomem.addrno := getnomem;
ASSIGN(rafilevar,'MEMBER.D
RESET(rafilevar);
SEEK(rafilevar,recnum);
WRITE(rafilevar,infomem);
CLOSE(rafilevar);
END;
END; {of PROCEDURE modify}
{*************************
THE FOLLOWING PROCEDURE DISPLAYS THE TABLE THAT IS SHOWN ON THE DISPLAY
BRIEF RECORDS SCREEN
**************************
PROCEDURE brief_box;
BEGIN
TEXTCOLOR(14);
GOTOXY(2,5);
WRITELN('ÉÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍ
GOTOXY(2,6);
WRITELN('º º º º º º');
GOTOXY(2,7);
WRITELN('ÌÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍ
GOTOXY(2,8);
WRITELN('º º º º º º');
GOTOXY(2,9);
WRITELN('º º º º º º');
GOTOXY(2,10);
WRITELN('º º º º º º');
GOTOXY(2,11);
WRITELN('º º º º º º');
GOTOXY(2,12);
WRITELN('º º º º º º');
GOTOXY(2,13);
WRITELN('º º º º º º');
GOTOXY(2,14);
WRITELN('º º º º º º');
GOTOXY(2,15);
WRITELN('º º º º º º');
GOTOXY(2,16);
WRITELN('º º º º º º');
GOTOXY(2,17);
WRITELN('º º º º º º');
GOTOXY(2,18);
WRITELN('º º º º º º');
GOTOXY(2,19);
WRITELN('º º º º º º');
GOTOXY(2,20);
WRITELN('º º º º º º');
GOTOXY(2,21);
WRITELN('º º º º º º');
GOTOXY(2,22);
WRITELN('ÈÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍ
END; {of PROCEDURE brief_box}
PROCEDURE min_members(X,Y :BYTE;
recno : INTEGER);
BEGIN
{$I-}
GOTOXY(X,Y); WRITE(recno);
GOTOXY(X+9,Y); WRITE(infomem.surname);
GOTOXY(X+31,Y); WRITE(infomem.forename);
GOTOXY(X+49,Y); WRITE('œ',infomem.total:2:
GOTOXY(X+63,Y); WRITE(infomem.lpaid);
{$I+}
END;{of PROCEDURE DisplayMinRecord}
PROCEDURE Display_Min;
VAR
startrecord : INTEGER;
endrecord : INTEGER;
pageno : BYTE;
pagerecordno : BYTE;
X,Y : BYTE;
option : CHAR;
BEGIN
REPEAT
REPEAT
infomem.addrno := 0;
CLRSCR;
intro_box(4,1,14);
GOTOXY(15,21);WRITE(' ');
GOTOXY(21,5); WRITELN('HARTLEYS NEWS - BRIEF CUSTOMER DETAILS');
GOTOXY(20,6); WRITELN('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
GOTOXY(18,9);
WRITELN('There is ',getnomem-1,' Member(s) Held in the Database');
GOTOXY(15,11); WRITELN('Hence You can Display any Group of Members in the');
GOTOXY(15,12); WRITELN('Range 1 to ',getnomem-1,'.');
{$I-}
GOTOXY(18,15); WRITE('Start the display at record number :- ');
READLN(startrecord);
GOTOXY(18,17); WRITE('End the display at record number :- ');
READLN(endrecord);
{$I+}
IOcode:=IOresult;
IF IOcode <> 0 THEN
BEGIN
cursors('C','N');
TEXTCOLOR(15);
GOTOXY(26,19); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
cursors('C','S');
END;
IF (startrecord<1) OR (startrecord>getnomem-1) OR (endrecord<0) OR (endrecord>getnomem-1) THEN
BEGIN
TEXTCOLOR(15);
cursors('C','N');
GOTOXY(26,19); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
cursors('C','S');
END;
UNTIL (startrecord>0) AND (startrecord<=getnomem-1) AND (endrecord>0) AND (endrecord<=getnomem-1);
UNTIL IOcode = 0;
cursors('C','N');
GOTOXY(24,21); WRITE('Press Enter to View Next Page...');
READLN;
cursors('C','S');
pageno := 0;
startrecord := startrecord;
endrecord := endrecord;
WHILE startrecord <= endrecord DO
BEGIN
INC(pageno);
CLRSCR;
brief_box;
TEXTCOLOR(15);
GOTOXY(15,2); WRITELN('HARTLEYS NEWS - BRIEF CUSTOMER DETAILS PAGE No.',PageNo);
GOTOXY(14,3); WRITELN('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
TEXTCOLOR(10);
GOTOXY(4,6);
WRITE('Record');
GOTOXY(18,6);
WRITE('Surname');
GOTOXY(37,6);
WRITE('Forename');
GOTOXY(54,6);
WRITE('Total');
GOTOXY(67,6);
WRITE('Last Paid');
TEXTCOLOR(14);
X := 4; Y := 8;
pagerecordno := 1;
WHILE (pagerecordno <= 14) AND (startrecord <= endrecord) DO
BEGIN
readmemrec(startrecord);
min_members(X,Y,startrecor
INC(pagerecordno);
INC(Y);
INC(startrecord);
END;
GOTOXY(1,23);
CLREOL;
press_cont;
END;
END; {of PROCEDURE Display Minimum data}
{*************************
THE FOLLOWING PROCEDURE SEARCHES FOR RECORDS BY SURNAME
**************************
PROCEDURE search;
VAR
sname : STRING[20];
nomatch : BOOLEAN;
rec : memberrec;
ptr : BYTE;
BEGIN
CLRSCR;
ASSIGN(rafilevar,'MEMBER.D
RESET(rafilevar);
BEGIN
intro_box(4,1,14);
GOTOXY(15,21); WRITE(' ');
GOTOXY(29,5); WRITELN('HARTLEYS NEWS - SEARCH');
GOTOXY(28,6); WRITELN('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
GOTOXY(23,11); WRITE('Customer Surname := ');
READLN(sname);
nomatch:=TRUE;
WHILE NOT EOF (rafilevar) DO
BEGIN
{$I-}
READ(rafilevar,rec);
{$I+}
IF (sname=rec.surname) THEN
BEGIN
CLRSCR;
TEXTCOLOR(1);
GOTOXY(14,1);
WRITE(rec.addrno);
TEXTCOLOR(15);
GOTOXY(23,1); WRITELN('HARTLEYS NEWS - CUSTOMER DETAILS');
TEXTCOLOR(10);
GOTOXY(15,5); WRITELN('Surname :- ');
GOTOXY(15,6); WRITELN('Forename :- ');
GOTOXY(15,8);
WRITELN('Address ');
TEXTCOLOR(14);
FOR ptr := 1 TO 4 DO WRITELN(' ',rec.address[ptr]);
TEXTCOLOR(10);
GOTOXY(15,14); WRITELN('Postcode :- ');
GOTOXY(15,15); WRITELN('Telephone Number :- ');
GOTOXY(15,16); WRITELN('Daily Papers :- ');
GOTOXY(15,17); WRITELN('Sunday Papers :- ');
GOTOXY(15,18); WRITELN('Total :- ');
TEXTCOLOR(14);
GOTOXY(37,18); WRITELN('œ');
TEXTCOLOR(10);
GOTOXY(15,19); WRITELN('Last Paid :- ');
TEXTCOLOR(14);
GOTOXY(37,5); WRITE(rec.surname);
GOTOXY(37,6); WRITE(rec.forename);
GOTOXY(37,14); WRITE(rec.postcode);
GOTOXY(37,15); WRITE(rec.telno);
GOTOXY(37,16); WRITE(rec.dpapers);
GOTOXY(37,17); WRITE(rec.spapers);
GOTOXY(38,18); WRITE(rec.total:2:2);
GOTOXY(37,19); WRITE(rec.lpaid);
print_member_details;
nomatch:=FALSE;
END;
END;
END;
close(rafilevar); {of PROCEDURE Search}
END;
{*************************
THE FOLLOWING PROCEDURE DELETES MEMBERS RECORDS
**************************
PROCEDURE delete_members;
VAR
ptr : BYTE;
delete : INTEGER;
no_alter : BOOLEAN;
keep_rec : BOOLEAN;
rec : memberrec;
reply : CHAR;
BEGIN
REPEAT
REPEAT
CLRSCR;
TEXTCOLOR(14);
GOTOXY(5,6); WRITE('Enter record number for deletion :- ');
{$I-}
READLN(recnum);
{$I+}
IOcode:=IOresult;
IF IOcode <> 0 THEN
BEGIN
TEXTCOLOR(15);
cursors('C','N');
GOTOXY(26,19); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
cursors('C','S');
END;
IF (recnum>getnomem-1) and (recnum<getnomem-1) THEN
BEGIN
TEXTCOLOR(15);
cursors('C','N');
GOTOXY(26,19); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
cursors('C','S');
END;
UNTIL (recnum <= getnomem) and (recnum > 0);
UNTIL IOcode = 0;
no_alter := TRUE;
readmemrec(recnum);
CLRSCR;
display_full_member_detail
TEXTCOLOR(15);
GOTOXY(20,23); WRITE('Do you want to Delete this Record? [y/n]: ');
READLN(reply);
GOTOXY(20,23); CLREOL;
GOTOXY(27,23); WRITE('Press Enter to Continue...');
READLN;
IF (reply='Y') OR (reply='y') THEN
BEGIN
keep_rec := FALSE;
no_alter := FALSE;
create_temp_file;
ASSIGN(rafilevar,'MEMBER.D
RESET(rafilevar);
ASSIGN(tempfile,'TEMP.DAT'
REWRITE(tempfile);
WHILE NOT EOF(rafilevar) DO
BEGIN
READ(rafilevar,rec);
IF rec.addrno <> recnum THEN
WRITE(tempfile,rec);
END;
CLOSE(rafilevar);
CLOSE(tempfile);
ERASE(rafilevar);
RENAME(tempfile,'MEMBER.DA
END
ELSE
BEGIN
keep_rec := TRUE;
no_alter := TRUE;
END;
IF no_alter = TRUE THEN
BEGIN
CLRSCR;
TEXTBACKGROUND(1);
TEXTCOLOR(14);
cursors('C','N');
GOTOXY(27,10); WRITELN('No Deletions Have Occured.');
TEXTCOLOR(15);
GOTOXY(25,23); WRITELN('Press Enter to Return to Menu...');
READLN;
cursors('C','S');
END;
{writeback;}
END; {of PROCEDURE Delete_members}
{*************************
THE FOLLOWING PROCEDURE DISPLAYS THE MAIN MENU
**************************
PROCEDURE menu;
BEGIN
REPEAT
CLRSCR;
intro_box(4,1,14);
GOTOXY(59,5); the_date;
GOTOXY(26,5); WRITELN('HARTLEYS NEWS - MAIN MENU');
GOTOXY(25,6); WRITELN('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
GOTOXY(26,9); WRITELN('A - Add New Customer');
GOTOXY(26,10); WRITELN('B - Modify a Record');
GOTOXY(26,11); WRITELN('C - Delete a Record');
GOTOXY(26,12); WRITELN('D - Search by Surname');
GOTOXY(26,13); WRITELN('E - Display Brief Details');
GOTOXY(26,14); WRITELN('F - Quit This Program');
GOTOXY(25,21); WRITE(' Choose A - F. Your Choice = ');
READLN(option);
CASE option OF
'Z','z' : create_member_record;
'A','a' : add_member;
'B','b' : modify;
'C','c' : delete_members;
'D','d' : search;
'E','e' : display_min;
'F','f' : quit;
ELSE
cursors('C','N');
TEXTCOLOR(15);
TEXTBACKGROUND(0);
GOTOXY(20,23);
WRITE('ERROR - ENTER A - F ONLY.');
DELAY(2000);
cursors('C','S');
END;
UNTIL option IN['F','f'];
END; {of PROCEDURE Menu}
BEGIN
highvideo;
menu;
END.
**************************
Thank you very much in advance for any help you are willing to give me
John.
The following is sample test data and will demonstrate my problem
Three records are entered:
Record: 1, Surname: Evans
Record: 2, Surname: Smith
Record: 3, Surname: Jones
If you delete Record: 1, Surname: Evans the records
are altered as follows:
Record: 1, (now becomes) Surname: Smith
Record: 2, (now becomes) Surname: Jones
However, if you try to delete Record: 1, Surname:
Smith it displays it on the screen but will not remove
it.
This is the only thing left to sort out on this program. Because it is so important to me I am offering 500 points.
If it would make it easier I can e-mail the source, but it is also displayed below.
**************************
PROGRAM NEWSAGENTS;
USES
crt, printer, dos;
TYPE
memberrec = RECORD
addrno : BYTE;
surname : STRING[20]; { Surname }
forename : STRING[15]; { Forenames }
address : ARRAY[1..4] OF STRING[30]; { Address }
postcode : STRING[8]; { Post Code }
telno : STRING[20]; { Telephone Number }
dpapers : STRING[50]; { Mon-Sat Papers }
spapers : STRING[50]; { Sun Papers }
total : REAL; { Total in GBP }
lpaid : STRING[15]; { Date Last Paid }
END;
VAR
S : STRING[20];
option : CHAR;
numberrec : INTEGER;
recnum : INTEGER;
IOcode : INTEGER;
recno : INTEGER;
infomem : memberrec;
rafilevar : FILE OF memberrec;
tempfile : FILE OF memberrec;
{$I NALIB.PAS}
FUNCTION getnomem : INTEGER;
BEGIN
ASSIGN(rafilevar,'MEMBER.D
RESET(rafilevar);
getnomem := FILESIZE(rafilevar);
CLOSE(rafilevar);
END; {*********** of function getnomem ***********}
PROCEDURE readmemrec (recno : INTEGER);
BEGIN
{$I-}
ASSIGN(rafilevar,'MEMBER.D
RESET(rafilevar);
SEEK(rafilevar,recno);
READ(rafilevar,infomem);
CLOSE(rafilevar);
{$I+}
END; {************ of procedure readmemrec **********}
PROCEDURE press_next;
BEGIN
cursors('C','N');
TEXTCOLOR(15);
GOTOXY(20,23); WRITELN(' Press Enter For Next Section... ');
READLN;
cursors('C','S');
END;
PROCEDURE press_menu;
BEGIN
cursors('C','N');
TEXTCOLOR(15);
GOTOXY(20,23); WRITELN(' Press Enter to Return to Menu... ');
READLN;
cursors('C','S');
END;
PROCEDURE press_cont;
BEGIN
cursors('C','N');
TEXTCOLOR(15);
GOTOXY(20,23); WRITE(' Press Enter to Continue... ');
READLN;
cursors('C','S');
END;
{*************************
THE FOLLOWING PROCEDURE WILL DISPLAY FULL DETAILS OF A MEMBER STORED IN THE
DATABASE.
**************************
PROCEDURE display_full_member_detail
VAR
FF : CHAR;
ptr : BYTE;
recnum : INTEGER;
BEGIN
cursors('C','N');
FF := #12;
TEXTBACKGROUND(1);
CLRSCR;
TEXTCOLOR(15);
GOTOXY(23,1); WRITELN('HARTLEYS NEWS - CUSTOMER DETAILS');
TEXTCOLOR(10);
GOTOXY(15,5); WRITELN('Surname :- ');
GOTOXY(15,6); WRITELN('Forename :- ');
GOTOXY(15,8);
WRITELN('Address ');
TEXTCOLOR(14);
FOR ptr := 1 TO 4 DO WRITELN(' ',infomem.address[ptr]);
TEXTCOLOR(10);
GOTOXY(15,14); WRITELN('Postcode :- ');
GOTOXY(15,15); WRITELN('Telephone Number :- ');
GOTOXY(15,16); WRITELN('Daily Papers :- ');
GOTOXY(15,17); WRITELN('Sunday Papers :- ');
GOTOXY(15,18); WRITELN('Total :- ');
TEXTCOLOR(14);
GOTOXY(37,18); WRITELN('œ');
TEXTCOLOR(10);
GOTOXY(15,19); WRITELN('Last Paid :- ');
TEXTCOLOR(14);
GOTOXY(37,5); WRITE(infomem.surname);
GOTOXY(37,6); WRITE(infomem.forename);
GOTOXY(37,14); WRITE(infomem.postcode);
GOTOXY(37,15); WRITE(infomem.telno);
GOTOXY(37,16); WRITE(infomem.dpapers);
GOTOXY(37,17); WRITE(infomem.spapers);
GOTOXY(38,18); WRITE(infomem.total:2:2);
GOTOXY(37,19); WRITE(infomem.lpaid);
cursors('C','S');
END; {of PROCEDURE display_full_member_detail
{*************************
THE FOLLOWING PROCEDURE WILL SEND FULL DETAILS OF A MEMBER STORED IN THE
DATABASE TO THE PRINTER.
**************************
PROCEDURE print_member_details;
VAR
FF : CHAR;
reply : CHAR;
ptr : BYTE;
BEGIN
REPEAT
FF := #12;
TEXTCOLOR(15);
GOTOXY(58,23); CLREOL;
GOTOXY(21,23); WRITE('Would You Like a Printout? Y or N : ');
READLN(reply);
TEXTCOLOR(14);
IF (reply='y') OR (reply='Y') THEN
BEGIN
GOTOXY(18,20);
WRITELN('Sending Details to the Printer. Please Wait...');
WRITELN(LST,' Record Number = ',infomem.addrno);
WRITELN(LST);
WRITELN(LST,' HARTLEYS NEWS - - CUSTOMER DETAILS');
WRITELN(LST,' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
WRITELN(LST);
WRITELN(LST,' Surname :- ',infomem.surname);
WRITELN(LST,' Forename :- ',infomem.forename);
WRITELN(LST);
WRITELN(LST,' Address ');
FOR ptr := 1 TO 4 DO WRITELN(LST,' ',infomem.address[ptr]);
WRITELN(LST);
WRITELN(LST,' Postcode :- ',infomem.postcode);
WRITELN(LST,' Telephone Number :- ',infomem.telno);
WRITELN(LST,' Daily Papers :- ',infomem.dpapers);
WRITELN(LST,' Sunday Papers :- ',infomem.spapers);
WRITELN(LST,' Total :- ',infomem.total:2:2);
WRITELN(LST,' Last Paid :- ',infomem.lpaid);
WRITELN(LST,FF);
GOTOXY(1,20); CLREOL;
END;
UNTIL reply IN['y','Y','n','N'];
END; {of PROCEDURE print_member_details}
{*************************
THE FOLLOWING PROCEDURE CREATES THE FILE MEMBER.DAT
**************************
PROCEDURE create_member_record;
VAR
ptr : BYTE;
BEGIN
CLRSCR;
infomem.addrno := 0;
FOR ptr := 1 TO 4 DO infomem.address[ptr] := 'A';
infomem.surname := 'A';
infomem.forename := 'A';
infomem.postcode := 'A';
infomem.telno := 'A';
infomem.dpapers := 'A';
infomem.spapers := 'A';
infomem.total := 0 ;
infomem.lpaid := 'A';
ASSIGN(rafilevar,'MEMBER.D
REWRITE(rafilevar);
WRITE(rafilevar,infomem);
CLOSE(rafilevar);
WRITELN;
WRITELN('PROCEDURE CREATE MEMBER RECORD WAS CALLED BY MAIN MENU');
READLN;
END; {of PROCEDURE create_member_record}
{*************************
THE FOLLOWING PROCEDURE CREATES THE FILE MEMBER.DAT
**************************
PROCEDURE create_temp_file;
VAR
ptr : BYTE;
BEGIN
CLRSCR;
infomem.addrno := 0;
FOR ptr := 1 TO 4 DO infomem.address[ptr] := 'A';
infomem.surname := 'A';
infomem.forename := 'A';
infomem.postcode := 'A';
infomem.telno := 'A';
infomem.dpapers := 'A';
infomem.spapers := 'A';
infomem.total := 0 ;
infomem.lpaid := 'A';
ASSIGN(rafilevar,'TEMP.DAT
REWRITE(rafilevar);
WRITE(rafilevar,infomem);
CLOSE(rafilevar);
END; {of PROCEDURE create_temp_file}
{*************************
THE FOLLOWING PROCEDURE DISPLAYS THE PROMPTS ON THE ADD_MEMBER SCREEN
**************************
PROCEDURE disp_mem;
BEGIN
TEXTCOLOR(10);
GOTOXY(5,5); WRITE('Surname : ');
GOTOXY(5,6); WRITE('Forename : ');
GOTOXY(5,8); WRITELN('Address (4 lines)');
GOTOXY(5,14); WRITE('Postcode : ');
GOTOXY(5,15); WRITE('Telephone Number : ');
GOTOXY(5,16); WRITE('Daily Papers : ');
GOTOXY(5,17); WRITE('Sunday Papers : ');
GOTOXY(5,18); WRITE('Total : ');
TEXTCOLOR(14);
GOTOXY(33,18); WRITE('œ');
TEXTCOLOR(10);
GOTOXY(5,19); WRITE('Last Paid : ');
END; {of PROCEDURE disp_mem}
FUNCTION UpCaseStr(S : STRING) : STRING;
VAR
I : INTEGER;
BEGIN
FOR I := 1 TO Length(S) DO
S[I] := UPCASE(S[I]);
UpCaseStr := S;
END;
{*************************
THE FOLLOWING PROCEDURE GATHERS THE INFO ON THE ADD_MEMBER SCREEN
**************************
PROCEDURE read_mem;
VAR
ptr : BYTE;
BEGIN
TEXTCOLOR(14);
GOTOXY(33,5); READLN(infomem.surname);
GOTOXY(33,6); READLN(infomem.forename);
GOTOXY(1,9); FOR ptr := 1 TO 4 DO READLN(infomem.address[ptr
GOTOXY(33,14); READLN(infomem.postcode);
GOTOXY(33,15); READLN(infomem.telno);
GOTOXY(33,16); READLN(infomem.dpapers);
GOTOXY(33,17); READLN(infomem.spapers);
REPEAT
{$I-}
TEXTCOLOR(14);
GOTOXY(34,18); READLN(infomem.total);
{$I+}
IOcode:=IOresult;
IF IOcode <> 0 THEN
BEGIN
TEXTCOLOR(15);
GOTOXY(20,23); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
GOTOXY(20,23); WRITELN(' ');
GOTOXY(34,18); CLREOL;
END;
UNTIL IOcode = 0;
GOTOXY(33,19); READLN(infomem.lpaid);
END; {of PROCEDURE read_mem}
{*************************
THE FOLLOWING PROCEDURE ADDS A MEMBER TO THE DATABASE
**************************
PROCEDURE add_member;
VAR
response : CHAR;
BEGIN
CLRSCR;
REPEAT
TEXTBACKGROUND(1);
CLRSCR;
numberrec := getnomem;
TEXTCOLOR(15);
GOTOXY(21,1); WRITELN('HARTLEYS NEWS - ADD NEW CUSTOMER');
disp_mem;
read_mem;
press_next;
infomem.addrno := numberrec;
ASSIGN(rafilevar,'MEMBER.D
RESET(rafilevar);
SEEK(rafilevar,numberrec);
WRITE(rafilevar,infomem);
CLOSE(rafilevar);
display_full_member_detail
print_member_details;
CLRSCR;
REPEAT
TEXTCOLOR(14);
GOTOXY(64,10); CLREOL;
GOTOXY(15,10);
WRITE('Would You Like to Enter Another Record. Y or N : ');
READLN(response);
UNTIL response IN['y','Y','n','N'];
UNTIL (response='n') OR (response='N');
END; {of PROCEDURE add_member}
{*************************
THE FOLLOWING TWO PROCEDURES DISLAY THE PROMPTS FOR MODIFYING A RECORD
**************************
PROCEDURE member_headings;
BEGIN
TEXTCOLOR(15);
GOTOXY(5,5); WRITE('A - ');
GOTOXY(5,6); WRITE('B - ');
GOTOXY(5,8); WRITELN('C - ');
GOTOXY(5,14); WRITE('D - ');
GOTOXY(5,15); WRITE('E - ');
GOTOXY(5,16); WRITE('F - ');
GOTOXY(5,17); WRITE('G - ');
GOTOXY(5,18); WRITE('H - ');
GOTOXY(5,19); WRITE('I - ');
END; {of PROCEDURE member_headings}
PROCEDURE disp_member_prompts;
BEGIN
TEXTCOLOR(10);
GOTOXY(10,5); WRITE('Surname ');
GOTOXY(10,6); WRITE('Forename ');
GOTOXY(10,8); WRITELN('Address (4 lines) ');
GOTOXY(10,14); WRITE('Post Code ');
GOTOXY(10,15); WRITE('Telephone Number ');
GOTOXY(10,16); WRITE('Daily Papers ');
GOTOXY(10,17); WRITE('Sunday Papers ');
GOTOXY(10,18); WRITE('Total ');
GOTOXY(10,19); WRITE('Last Paid ');
END; {of PROCEDURE disp_member_prompts}
{*************************
THE FOLLOWING THREE PROCEDURES GATHER NEW INFORMATION AND UPDATE THE
RECORD.
**************************
PROCEDURE field;
BEGIN
TEXTCOLOR(15);
GOTOXY(14,23);
WRITE('Please Enter the Field to be Modified (X to Quit) : ');
END; {of PROCEDURE field}
PROCEDURE modify_member_rec;
VAR
fieldno : CHAR;
ptr : BYTE;
BEGIN
field;
REPEAT
GOTOXY(66,23); WRITE(' ');
GOTOXY(66,23);
READLN(fieldno);
TEXTCOLOR(14);
WITH infomem DO
BEGIN
CASE fieldno OF
'A','a' : BEGIN
GOTOXY(37,5); CLREOL;
GOTOXY(37,5); READLN(surname);
END;
'B','b' : BEGIN
GOTOXY(37,6); CLREOL;
GOTOXY(37,6); READLN(forename);
END;
'C','c' : BEGIN
GOTOXY(20,9); CLREOL;
GOTOXY(20,10); CLREOL;
GOTOXY(20,11); CLREOL;
GOTOXY(20,12); CLREOL;
GOTOXY(1,9); FOR ptr := 1 TO 4 DO READLN(infomem.address[ptr
END;
'D','d' : BEGIN
GOTOXY(37,14); CLREOL;
GOTOXY(37,14); READLN(postcode);
END;
'E','e' : BEGIN
GOTOXY(37,15); CLREOL;
GOTOXY(37,15); READLN(telno);
END;
'F','f' : BEGIN
GOTOXY(37,16); CLREOL;
GOTOXY(37,16); READLN(dpapers);
END;
'G','g' : BEGIN
GOTOXY(37,17); CLREOL;
GOTOXY(37,17); READLN(spapers);
END;
'H','h' : BEGIN
GOTOXY(38,18); CLREOL;
REPEAT
{$I-}
TEXTCOLOR(14);
GOTOXY(38,18); CLREOL;
GOTOXY(38,18); READLN(total);
{$I+}
IOcode:=IOresult;
IF IOcode <> 0 THEN
BEGIN
TEXTCOLOR(15);
GOTOXY(26,21); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
GOTOXY(26,21); WRITELN(' ');
END;
UNTIL IOcode = 0;
END;
'I','i' : BEGIN
GOTOXY(37,19); CLREOL;
GOTOXY(37,19); READLN(lpaid);
END;
'X','x' : BEGIN
GOTOXY(1,23);
CLREOL;
GOTOXY(25,23);
END
ELSE
BEGIN
cursors('C','N');
TEXTCOLOR(15);
GOTOXY(1,23);
CLREOL;
GOTOXY(23,23);
WRITE('Enter A - I Only. Please Wait...');
DELAY(2000);
cursors('C','S');
field;
END;
END;
END;
UNTIL (fieldno = 'X') OR (fieldno = 'x');
END; {of PROCEDURE modify_member_rec}
PROCEDURE modify;
VAR
reply : CHAR;
BEGIN
CLRSCR;
begin
REPEAT
REPEAT
numberrec := getnomem;
CLRSCR;
intro_box(4,1,14);
GOTOXY(15,21);WRITE(' ');
GOTOXY(21,5); WRITELN('HARTLEYS NEWS - MODIFY CUSTOMER DETAILS');
GOTOXY(20,6); WRITELN('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
GOTOXY(23,11); WRITE('Customer record number := ');
{$I-}
READLN(recnum);
{$I+}
IOcode:=IOresult;
IF IOcode <> 0 THEN
BEGIN
TEXTCOLOR(15);
GOTOXY(26,19); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
END;
UNTIL IOcode = 0;
UNTIL (recnum <= getnomem) and (recnum > 0);
readmemrec(recnum);
display_full_member_detail
member_headings;
disp_member_prompts;
modify_member_rec;
display_full_member_detail
print_member_details;
infomem.addrno := getnomem;
ASSIGN(rafilevar,'MEMBER.D
RESET(rafilevar);
SEEK(rafilevar,recnum);
WRITE(rafilevar,infomem);
CLOSE(rafilevar);
END;
END; {of PROCEDURE modify}
{*************************
THE FOLLOWING PROCEDURE DISPLAYS THE TABLE THAT IS SHOWN ON THE DISPLAY
BRIEF RECORDS SCREEN
**************************
PROCEDURE brief_box;
BEGIN
TEXTCOLOR(14);
GOTOXY(2,5);
WRITELN('ÉÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍ
GOTOXY(2,6);
WRITELN('º º º º º º');
GOTOXY(2,7);
WRITELN('ÌÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍ
GOTOXY(2,8);
WRITELN('º º º º º º');
GOTOXY(2,9);
WRITELN('º º º º º º');
GOTOXY(2,10);
WRITELN('º º º º º º');
GOTOXY(2,11);
WRITELN('º º º º º º');
GOTOXY(2,12);
WRITELN('º º º º º º');
GOTOXY(2,13);
WRITELN('º º º º º º');
GOTOXY(2,14);
WRITELN('º º º º º º');
GOTOXY(2,15);
WRITELN('º º º º º º');
GOTOXY(2,16);
WRITELN('º º º º º º');
GOTOXY(2,17);
WRITELN('º º º º º º');
GOTOXY(2,18);
WRITELN('º º º º º º');
GOTOXY(2,19);
WRITELN('º º º º º º');
GOTOXY(2,20);
WRITELN('º º º º º º');
GOTOXY(2,21);
WRITELN('º º º º º º');
GOTOXY(2,22);
WRITELN('ÈÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍ
END; {of PROCEDURE brief_box}
PROCEDURE min_members(X,Y :BYTE;
recno : INTEGER);
BEGIN
{$I-}
GOTOXY(X,Y); WRITE(recno);
GOTOXY(X+9,Y); WRITE(infomem.surname);
GOTOXY(X+31,Y); WRITE(infomem.forename);
GOTOXY(X+49,Y); WRITE('œ',infomem.total:2:
GOTOXY(X+63,Y); WRITE(infomem.lpaid);
{$I+}
END;{of PROCEDURE DisplayMinRecord}
PROCEDURE Display_Min;
VAR
startrecord : INTEGER;
endrecord : INTEGER;
pageno : BYTE;
pagerecordno : BYTE;
X,Y : BYTE;
option : CHAR;
BEGIN
REPEAT
REPEAT
infomem.addrno := 0;
CLRSCR;
intro_box(4,1,14);
GOTOXY(15,21);WRITE(' ');
GOTOXY(21,5); WRITELN('HARTLEYS NEWS - BRIEF CUSTOMER DETAILS');
GOTOXY(20,6); WRITELN('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
GOTOXY(18,9);
WRITELN('There is ',getnomem-1,' Member(s) Held in the Database');
GOTOXY(15,11); WRITELN('Hence You can Display any Group of Members in the');
GOTOXY(15,12); WRITELN('Range 1 to ',getnomem-1,'.');
{$I-}
GOTOXY(18,15); WRITE('Start the display at record number :- ');
READLN(startrecord);
GOTOXY(18,17); WRITE('End the display at record number :- ');
READLN(endrecord);
{$I+}
IOcode:=IOresult;
IF IOcode <> 0 THEN
BEGIN
cursors('C','N');
TEXTCOLOR(15);
GOTOXY(26,19); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
cursors('C','S');
END;
IF (startrecord<1) OR (startrecord>getnomem-1) OR (endrecord<0) OR (endrecord>getnomem-1) THEN
BEGIN
TEXTCOLOR(15);
cursors('C','N');
GOTOXY(26,19); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
cursors('C','S');
END;
UNTIL (startrecord>0) AND (startrecord<=getnomem-1) AND (endrecord>0) AND (endrecord<=getnomem-1);
UNTIL IOcode = 0;
cursors('C','N');
GOTOXY(24,21); WRITE('Press Enter to View Next Page...');
READLN;
cursors('C','S');
pageno := 0;
startrecord := startrecord;
endrecord := endrecord;
WHILE startrecord <= endrecord DO
BEGIN
INC(pageno);
CLRSCR;
brief_box;
TEXTCOLOR(15);
GOTOXY(15,2); WRITELN('HARTLEYS NEWS - BRIEF CUSTOMER DETAILS PAGE No.',PageNo);
GOTOXY(14,3); WRITELN('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
TEXTCOLOR(10);
GOTOXY(4,6);
WRITE('Record');
GOTOXY(18,6);
WRITE('Surname');
GOTOXY(37,6);
WRITE('Forename');
GOTOXY(54,6);
WRITE('Total');
GOTOXY(67,6);
WRITE('Last Paid');
TEXTCOLOR(14);
X := 4; Y := 8;
pagerecordno := 1;
WHILE (pagerecordno <= 14) AND (startrecord <= endrecord) DO
BEGIN
readmemrec(startrecord);
min_members(X,Y,startrecor
INC(pagerecordno);
INC(Y);
INC(startrecord);
END;
GOTOXY(1,23);
CLREOL;
press_cont;
END;
END; {of PROCEDURE Display Minimum data}
{*************************
THE FOLLOWING PROCEDURE SEARCHES FOR RECORDS BY SURNAME
**************************
PROCEDURE search;
VAR
sname : STRING[20];
nomatch : BOOLEAN;
rec : memberrec;
ptr : BYTE;
BEGIN
CLRSCR;
ASSIGN(rafilevar,'MEMBER.D
RESET(rafilevar);
BEGIN
intro_box(4,1,14);
GOTOXY(15,21); WRITE(' ');
GOTOXY(29,5); WRITELN('HARTLEYS NEWS - SEARCH');
GOTOXY(28,6); WRITELN('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
GOTOXY(23,11); WRITE('Customer Surname := ');
READLN(sname);
nomatch:=TRUE;
WHILE NOT EOF (rafilevar) DO
BEGIN
{$I-}
READ(rafilevar,rec);
{$I+}
IF (sname=rec.surname) THEN
BEGIN
CLRSCR;
TEXTCOLOR(1);
GOTOXY(14,1);
WRITE(rec.addrno);
TEXTCOLOR(15);
GOTOXY(23,1); WRITELN('HARTLEYS NEWS - CUSTOMER DETAILS');
TEXTCOLOR(10);
GOTOXY(15,5); WRITELN('Surname :- ');
GOTOXY(15,6); WRITELN('Forename :- ');
GOTOXY(15,8);
WRITELN('Address ');
TEXTCOLOR(14);
FOR ptr := 1 TO 4 DO WRITELN(' ',rec.address[ptr]);
TEXTCOLOR(10);
GOTOXY(15,14); WRITELN('Postcode :- ');
GOTOXY(15,15); WRITELN('Telephone Number :- ');
GOTOXY(15,16); WRITELN('Daily Papers :- ');
GOTOXY(15,17); WRITELN('Sunday Papers :- ');
GOTOXY(15,18); WRITELN('Total :- ');
TEXTCOLOR(14);
GOTOXY(37,18); WRITELN('œ');
TEXTCOLOR(10);
GOTOXY(15,19); WRITELN('Last Paid :- ');
TEXTCOLOR(14);
GOTOXY(37,5); WRITE(rec.surname);
GOTOXY(37,6); WRITE(rec.forename);
GOTOXY(37,14); WRITE(rec.postcode);
GOTOXY(37,15); WRITE(rec.telno);
GOTOXY(37,16); WRITE(rec.dpapers);
GOTOXY(37,17); WRITE(rec.spapers);
GOTOXY(38,18); WRITE(rec.total:2:2);
GOTOXY(37,19); WRITE(rec.lpaid);
print_member_details;
nomatch:=FALSE;
END;
END;
END;
close(rafilevar); {of PROCEDURE Search}
END;
{*************************
THE FOLLOWING PROCEDURE DELETES MEMBERS RECORDS
**************************
PROCEDURE delete_members;
VAR
ptr : BYTE;
delete : INTEGER;
no_alter : BOOLEAN;
keep_rec : BOOLEAN;
rec : memberrec;
reply : CHAR;
BEGIN
REPEAT
REPEAT
CLRSCR;
TEXTCOLOR(14);
GOTOXY(5,6); WRITE('Enter record number for deletion :- ');
{$I-}
READLN(recnum);
{$I+}
IOcode:=IOresult;
IF IOcode <> 0 THEN
BEGIN
TEXTCOLOR(15);
cursors('C','N');
GOTOXY(26,19); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
cursors('C','S');
END;
IF (recnum>getnomem-1) and (recnum<getnomem-1) THEN
BEGIN
TEXTCOLOR(15);
cursors('C','N');
GOTOXY(26,19); WRITELN('INVALID DATA, PLEASE RE-ENTER');
DELAY(1000);
cursors('C','S');
END;
UNTIL (recnum <= getnomem) and (recnum > 0);
UNTIL IOcode = 0;
no_alter := TRUE;
readmemrec(recnum);
CLRSCR;
display_full_member_detail
TEXTCOLOR(15);
GOTOXY(20,23); WRITE('Do you want to Delete this Record? [y/n]: ');
READLN(reply);
GOTOXY(20,23); CLREOL;
GOTOXY(27,23); WRITE('Press Enter to Continue...');
READLN;
IF (reply='Y') OR (reply='y') THEN
BEGIN
keep_rec := FALSE;
no_alter := FALSE;
create_temp_file;
ASSIGN(rafilevar,'MEMBER.D
RESET(rafilevar);
ASSIGN(tempfile,'TEMP.DAT'
REWRITE(tempfile);
WHILE NOT EOF(rafilevar) DO
BEGIN
READ(rafilevar,rec);
IF rec.addrno <> recnum THEN
WRITE(tempfile,rec);
END;
CLOSE(rafilevar);
CLOSE(tempfile);
ERASE(rafilevar);
RENAME(tempfile,'MEMBER.DA
END
ELSE
BEGIN
keep_rec := TRUE;
no_alter := TRUE;
END;
IF no_alter = TRUE THEN
BEGIN
CLRSCR;
TEXTBACKGROUND(1);
TEXTCOLOR(14);
cursors('C','N');
GOTOXY(27,10); WRITELN('No Deletions Have Occured.');
TEXTCOLOR(15);
GOTOXY(25,23); WRITELN('Press Enter to Return to Menu...');
READLN;
cursors('C','S');
END;
{writeback;}
END; {of PROCEDURE Delete_members}
{*************************
THE FOLLOWING PROCEDURE DISPLAYS THE MAIN MENU
**************************
PROCEDURE menu;
BEGIN
REPEAT
CLRSCR;
intro_box(4,1,14);
GOTOXY(59,5); the_date;
GOTOXY(26,5); WRITELN('HARTLEYS NEWS - MAIN MENU');
GOTOXY(25,6); WRITELN('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
GOTOXY(26,9); WRITELN('A - Add New Customer');
GOTOXY(26,10); WRITELN('B - Modify a Record');
GOTOXY(26,11); WRITELN('C - Delete a Record');
GOTOXY(26,12); WRITELN('D - Search by Surname');
GOTOXY(26,13); WRITELN('E - Display Brief Details');
GOTOXY(26,14); WRITELN('F - Quit This Program');
GOTOXY(25,21); WRITE(' Choose A - F. Your Choice = ');
READLN(option);
CASE option OF
'Z','z' : create_member_record;
'A','a' : add_member;
'B','b' : modify;
'C','c' : delete_members;
'D','d' : search;
'E','e' : display_min;
'F','f' : quit;
ELSE
cursors('C','N');
TEXTCOLOR(15);
TEXTBACKGROUND(0);
GOTOXY(20,23);
WRITE('ERROR - ENTER A - F ONLY.');
DELAY(2000);
cursors('C','S');
END;
UNTIL option IN['F','f'];
END; {of PROCEDURE Menu}
BEGIN
highvideo;
menu;
END.
**************************
Thank you very much in advance for any help you are willing to give me
John.
i cen't see whats the problem meybe u wona send me all the code including nalib.pas and sample of your data files
im shure that i will give u correct aswer for a short time
meen time for deleting a record from a base u mey use this code
procedure delete(i:recnum);
var fil: file of reco
rec:reco;
J:longint;
begin
assign(fil,'filename');
reset(fil);
j:=filesize(fil)-1;
for i:=i to j-1 do
begin
seek(fil,i+1); read(fil,rec);
seek(fil,i); write(fil,rec);
end;
see(fil,j-1);
truncate(fil);
close(fil);
end;
wery easy code without use of temporary data
and rename files
:)))
im shure that i will give u correct aswer for a short time
meen time for deleting a record from a base u mey use this code
procedure delete(i:recnum);
var fil: file of reco
rec:reco;
J:longint;
begin
assign(fil,'filename');
reset(fil);
j:=filesize(fil)-1;
for i:=i to j-1 do
begin
seek(fil,i+1); read(fil,rec);
seek(fil,i); write(fil,rec);
end;
see(fil,j-1);
truncate(fil);
close(fil);
end;
wery easy code without use of temporary data
and rename files
:)))
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hi ILE,
let me know your e-mail address and i will send the source code to you.
Thanks,
John.
let me know your e-mail address and i will send the source code to you.
Thanks,
John.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
john-formby:
This old question needs to be finalized -- accept an answer, split points, or get a refund. For information on your options, please click here-> http:/help/closing.jsp#1
EXPERTS:
Post your closing recommendations! No comment means you don't care.
This old question needs to be finalized -- accept an answer, split points, or get a refund. For information on your options, please click here-> http:/help/closing.jsp#1
EXPERTS:
Post your closing recommendations! No comment means you don't care.
Split between VGR and dbrunton
ASKER
So sorry I didn't allocate points sooner. I completely forgot about this question. I have now split the points and ended this question.
John
John
thanks
I would put some known data into the record before you do the read, "???????" is a good value. Also check Ioresult after each read or write to the file. Tedious thing to do, but necessary in any good program.
Remember to do "Err := Ioresult", then test "Err", as reading Ioresult clears it, making it impossible to recover the exact value. Also don't put any stmts betweent he read/write and the "Err := IoResult" line to avoid haveing Ioresult get cleared.
Regards,
George