?
Solved

Why won't it delete more than once?

Posted on 2003-03-10
9
Medium Priority
?
198 Views
Last Modified: 2010-04-16
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.

 


****************************SOURCE CODE**********************************


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.DAT');
     RESET(rafilevar);
     getnomem := FILESIZE(rafilevar);
     CLOSE(rafilevar);
END;    {*********** of function getnomem ***********}


PROCEDURE readmemrec (recno : INTEGER);
BEGIN
     {$I-}
     ASSIGN(rafilevar,'MEMBER.DAT');
     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_details;
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_details}


{****************************************************************************
 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.DAT');
     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.DAT');
        RESET(rafilevar);
        SEEK(rafilevar,numberrec);
        WRITE(rafilevar,infomem);
        CLOSE(rafilevar);
        display_full_member_details;
        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_details;
        member_headings;
        disp_member_prompts;
        modify_member_rec;
        display_full_member_details;
        print_member_details;
        infomem.addrno := getnomem;
        ASSIGN(rafilevar,'MEMBER.DAT');
        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: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,startrecord);
                    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.DAT');
  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_details;
       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.DAT');
             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.DAT');
           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.


**************************END SOURCE CODE*********************************


Thank you very much in advance for any help you are willing to give me


John.



0
Comment
Question by:john-formby
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
  • 2
  • +3
9 Comments
 
LVL 22

Expert Comment

by:grg99
ID: 8106697
My guess is that since you're not checking for I/O errors, you go to read the first record, its not there, so you get back whatever is still in memory.

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
0
 
LVL 3

Expert Comment

by:ILE
ID: 8107048
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


:)))



0
 
LVL 49

Assisted Solution

by:dbrunton
dbrunton earned 1000 total points
ID: 8107850
Have only very briefly browsed the code.  Nice coding by the way.

This line

 IF (recnum>getnomem-1) and (recnum<getnomem-1) THEN

shouldn't it be

 IF (recnum>=0) and (recnum<getnomem-1) THEN

You need to test from the 0 record to the getnomem - 1
0
Enroll in August's Course of the Month

August's CompTIA IT Fundamentals course includes 19 hours of basic computer principle modules and prepares you for the certification exam. It's free for Premium Members, Team Accounts, and Qualified Experts!

 
LVL 14

Author Comment

by:john-formby
ID: 8109185
Hi ILE,
      let me know your e-mail address and i will send the source code to you.

Thanks,

John.
0
 
LVL 15

Accepted Solution

by:
VGR earned 1000 total points
ID: 8109495
the same as before :
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');
#### ADD this line ###
         recnum=-1;
## or the IF and UNTIL below are acting on an undefined variable##
       END;
##strange test##
     IF (recnum>getnomem-1) and (recnum<getnomem-1) THEN
## this is impossible, being <n-1 and >n-1 ##
       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;

should be modified where I have put #### comments

Also you may try
if UpCase(gnagna)='Y' Then... in stead of if (gnagna='y') or (gnagna='Y') Then...
0
 

Expert Comment

by:CleanupPing
ID: 9314366
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.
0
 
LVL 49

Expert Comment

by:dbrunton
ID: 9316836
Split between VGR and dbrunton
0
 
LVL 14

Author Comment

by:john-formby
ID: 9323445
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
0
 
LVL 15

Expert Comment

by:VGR
ID: 9323484
thanks
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The well known Cerber ransomware continues to spread this summer through spear phishing email campaigns targeting enterprises. Learn how it easily bypasses traditional defenses - and what you can do to protect your data.
Hey fellow admins! This time, I have a little fairy tale for you. As many tales do, it starts boring and then gets pretty gory. I hope you like it. TL;DR: It is about an important security matter, you should read it if you run or administer Windows …
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …
Sometimes it takes a new vantage point, apart from our everyday security practices, to truly see our Active Directory (AD) vulnerabilities. We get used to implementing the same techniques and checking the same areas for a breach. This pattern can re…
Suggested Courses
Course of the Month13 days, 5 hours left to enroll

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question