Learn Pascal in Three Days, 2nd Edition:Using Variant Records

To access the contents, click the chapter and section titles.

Learn Pascal in a Three Days (2nd Ed.)
(Publisher: Wordware Publishing, Inc.)
Author(s):
ISBN: 1556225679
Publication Date: 07/01/97

Table of Contents

Drill 10-3

Bring procedures together in order to build a complete program containing the capabilities to display, add, delete, and update an employee record.

10-5 Enhance the Program Modularity

Now that you added more procedures to your program, you may need to take a second look at the modularity of the program. One disadvantage of the program is that the flag “Found” is used in three procedures to check the existence of the required record. Another disadvantage is that the “payroll.txt” file is being copied into the temporary file whether or not the required record exists. This redundancy could be avoided by building a new procedure to search the file and set (or reset) the “Found” flag. Thus, when any of the other procedures is entered, the procedure “knows” in advance whether or not the record exists. Therefore, all the steps can be included inside an IF block as shown below:

READLN(SSNumber);
  SearchRec(PayrollFile, EmployeeRec, SSNumber, Found);
  IF Found =1 THEN
        BEGIN
        ...
        { open files and carry out the required chores }
        ...
        END
  ELSE
        { send the proper message }
  END;

The new procedure “SearchRec” is invoked after the value of the “SSNumber” is entered from the keyboard. The procedure opens the file, searches for the required employee, and returns the proper value of the flag “Found.” If the record is found, the regular chores (updating, deleting, or reading) are carried on by the other procedures; otherwise, the proper message is sent and no files have to be reopened.

The following are some important points of the “SearchRec” procedure:

• The “SSNumber” and the flag are both passed as parameters to the procedure.

• Because the value of the flag is expected to be modified by the procedure, it has to be passed using the VAR keyword.

• In order to pass the string variable (SSNumber), the parameter has to be TYPEd; for this reason, a new type is declared in the TYPE section as follows:

    SSNstring = STRING[11];

This is the program in its final shape:

{ -------------------------- figure 10-2 ----------------------------- }
PROGRAM EmployeeDataBase2(INPUT, OUTPUT, PayrollFile, NewFile);
CONST
  FileName = 'payroll.txt';
  TempFile = 'temp.txt';
  Header = '------------- Main Menu --------------';
  Header1 = '--------- Employee DataBase ----------';
  Header2 = '---------- Employee Record -----------';
  Separator = '--------------------------------------';
TYPE
  EmployeeRecord = RECORD
           ID        :STRING[5];
           Name, Position  :STRING[20];
           SSN         :STRING[11];
           CASE Category     :CHAR OF
            '1' :(MonthlySalary  :REAL);
            '2' :(HourlyRate    :REAL);
            '3' :(Commission,
                 BasicSalary    :REAL;
                 Area        :STRING[20])
           END;
 SSNstring = STRING[11];
VAR
  NewFile, PayrollFile :TEXT;
  EmployeeRec            :EmployeeRecord;
  Title        :ARRAY [1..9] OF STRING[20];
  OneLine         :STRING[80];

{ ------------------------- Procedure SearchRec --------------------- }
PROCEDURE SearchRec(VAR PayrollFile:TEXT;
          Employee:EmployeeRecord;
          SSNumber:SSNstring;
          VAR Found:INTEGER);
BEGIN
  Found:= 0;
  ASSIGN(PayrollFile, FileName);
  RESET(PayrollFile);
  WHILE NOT EOF(PayrollFile) DO
    BEGIN
     WITH Employee DO
       BEGIN
        READLN(PayrollFile, ID);
        READLN(PayrollFile, Name);
        READLN(PayrollFile, Position);
        READLN(PayrollFile, SSN);
        READLN(PayrollFile, Category);
        CASE Category OF
         '1': READLN(PayrollFile, MonthlySalary);
         '2': READLN(PayrollFile, HourlyRate);
         '3': BEGIN
               READLN(PayrollFile, Commission);
               READLN(PayrollFile, BasicSalary);
               READLN(PayrollFile, Area)
              END
        END; { End of CASE structure }
        IF SSNumber = SSN THEN
          Found:= 1;
     END { End of WITH block }
    END;
  CLOSE(PayrollFile);
END;

{ ------------------------- Procedure ReadRec ------------------------ }
PROCEDURE ReadRec(VAR PayrollFile:TEXT;
Employee:EmployeeRecord);
VAR
  SSNumber :STRING[11];
  Found :INTEGER;
BEGIN
  WRITELN;
  WRITE('Please enter the SSN of the employee: ');
  READLN(SSNumber);
  SearchRec(PayrollFile, EmployeeRec, SSNumber, Found);
  IF Found =1 THEN
    BEGIN
      ASSIGN(PayrollFile, FileName);
      RESET(PayrollFile);
      WHILE NOT EOF(PayrollFile) DO
       BEGIN
         WITH Employee DO
           BEGIN
            READLN(PayrollFile, ID);
            READLN(PayrollFile, Name);
            READLN(PayrollFile, Position);
            READLN(PayrollFile, SSN);
            READLN(PayrollFile, Category);
            CASE Category OF
             '1': READLN(PayrollFile, MonthlySalary);
             '2': READLN(PayrollFile, HourlyRate);
             '3': BEGIN
                   READLN(PayrollFile, Commission);
                   READLN(PayrollFile, BasicSalary);
                   READLN(PayrollFile, Area)
                  END
            END; { End of CASE structure }
            IF SSNumber = SSN THEN
              BEGIN
               WRITELN(Header2);
               WRITELN(Title[1],ID);
               WRITELN(Title[2],Name);
               WRITELN(Title[3],Position);
               WRITELN(Title[4], SSN);
               CASE Category OF
                '1': WRITELN(Title[5], MonthlySalary:0:2);
                '2': WRITELN(Title[6], HourlyRate:0:2);
                '3': BEGIN
                      WRITELN(Title[7], Commission:0:2);
                      WRITELN(Title[8], BasicSalary:0:2);
                      WRITELN(Title[9], Area)
                   END
                END; { End of CASE structure }
            END
         END { End of WITH block }
      END;
      CLOSE(PayrollFile)
      END
    ELSE { If not found }
     BEGIN
      WRITELN('SSN not found in file.');
      WRITELN('Please try again.');
      WRITELN
   END
END;

{ ------------------------- Procedure DelRec ------------------------- }
PROCEDURE DelRec(VAR NewFile, PayrollFile:TEXT;
Employee:EmployeeRecord);
VAR
  SSNumber:STRING[11];
  Found :INTEGER;
BEGIN
  WRITE('Please enter the SSN of the employee to be deleted: ');
  READLN(SSNumber);
  SearchRec(PayrollFile, EmployeeRec, SSNumber, Found);
  IF Found =1 THEN
    BEGIN
      ASSIGN(NewFile, TempFile);
      REWRITE(NewFile);
      ASSIGN(PayrollFile, FileName);
      RESET(PayrollFile);
      WHILE NOT EOF(PayrollFile) DO
       BEGIN
        WITH Employee DO
         BEGIN
          READLN(PayrollFile, ID);
          READLN(PayrollFile, Name);
          READLN(PayrollFile, Position);
          READLN(PayrollFile, SSN);
          READLN(PayrollFile, Category);
          CASE Category OF
           '1': READLN(PayrollFile, MonthlySalary);
           '2': READLN(PayrollFile, HourlyRate);
           '3': BEGIN
                 READLN(PayrollFile, Commission);
                 READLN(PayrollFile, BasicSalary);
                 READLN(PayrollFile, Area)
                END
          END; { End of CASE structure }
          IF SSNumber <> SSN THEN
            BEGIN
             WRITELN(NewFile, ID);
             WRITELN(NewFile, Name);
             WRITELN(NewFile, Position);
             WRITELN(NewFile, SSN);
             WRITELN(NewFile, Category);
             CASE Category OF
              '1': WRITELN(NewFile, MonthlySalary:0:2);
              '2': WRITELN(NewFile, HourlyRate:0:2);
              '3': BEGIN
                    WRITELN(NewFile, Commission:0:2);
                    WRITELN(NewFile, BasicSalary:0:2);
                    WRITELN(NewFile, Area)
                   END
              END; { End of CASE structure }
            END;
        END { End of WITH block }
      END; {End of DO }
      CLOSE(NewFile);
      CLOSE(PayrollFile);
{ Copy NewFile back to Payroll File }
      ASSIGN(PayrollFile, FileName);
      REWRITE(PayrollFile);
      ASSIGN(NewFile, TempFile);
      RESET(NewFile);
      WHILE NOT EOF(NewFile) DO
        BEGIN
        READLN(NewFile, OneLine);
        WRITELN(PayrollFile, OneLine)
        END;
      CLOSE(NewFile);
      ERASE(NewFile);       { Erase the temporary file }
      CLOSE(PayrollFile);
{ User Messages }
      WRITELN('The employee ', SSNumber,
                 ' is removed from file.')
    END { End of the "IF Found.." block }
  ELSE { IF not found }
   BEGIN
    WRITELN('The SSN ', SSNumber, ' is not found.');
    WRITELN('Check the number and try again.');
    WRITELN
   END
END;

{ -------------------------- Procedure AddRec ------------------------ }
PROCEDURE AddRec(VAR NewFile, PayrollFile:TEXT;
                     Employee: EmployeeRecord);
BEGIN
  ASSIGN(PayrollFile, FileName);
  RESET(PayrollFile);
  ASSIGN(NewFile, TempFile);
  REWRITE(NewFile);
  WHILE NOT EOF(PayrollFile) DO
    BEGIN
{ Copy each record from PayrollFile to the NewFile }
      READLN(PayrollFile, OneLine);
      WRITELN(NewFile, OneLine)
    END;
{ Accept a new record from the keyboard }
  WITH Employee DO
    BEGIN
     WRITE('Please enter Employee ID: ');
     READLN(ID);
     WRITE('Name: ');             READLN(Name);
     WRITE('Position: ');        READLN(Position);
     WRITE('SSN (xxx-xx-xxxx): '); READLN(SSN);
     WRITE('Payroll category: ');    READLN(Category);
     CASE Category OF
      '1': BEGIN
            WRITE('Monthly Salary: ');
            READLN(MonthlySalary)
           END;
      '2': BEGIN
            WRITE('Rate: ');
            READLN(HourlyRate)
            END;
      '3': BEGIN
            WRITE('Commission: ');
            READLN(Commission);
            WRITE('Basic salary: ');
            READLN(BasicSalary);
            WRITE('Area: ');
            READLN(Area)
     END
    END;
{ Store the information in NewFile }
    WRITELN(NewFile, ID);
    WRITELN(NewFile, Name);
    WRITELN(NewFile, Position);
    WRITELN(NewFile, SSN);
    WRITELN(NewFile, Category);
    CASE Category OF
     '1': WRITELN(NewFile, MonthlySalary:0:2);
     '2': WRITELN(NewFile, HourlyRate:0:2);
     '3': BEGIN
           WRITELN(NewFile, Commission:0:2);
           WRITELN(NewFile, BasicSalary:0:2);
           WRITELN(NewFile, Area)
          END
    END
  END;
  CLOSE(NewFile);
  CLOSE(PayrollFile);
{ Copy NewFile back to Payroll File }
  ASSIGN(PayrollFile, FileName);
  REWRITE(PayrollFile);
  ASSIGN(NewFile, TempFile);
  RESET(NewFile);
  WHILE NOT EOF(NewFile) DO
    BEGIN
     READLN(NewFile, OneLine);
     WRITELN(PayrollFile, OneLine)
    END;
  CLOSE(NewFile);
  ERASE(NewFile); { Erase the temporary file }
  CLOSE(PayrollFile)
END;

{ ---------------------- Procedure UpdateRec ------------------------- }
PROCEDURE UpdateRec(VAR NewFile, PayrollFile:TEXT;
          Employee:EmployeeRecord);
VAR
  SSNumber  :STRING[11];
  Found   :INTEGER;
BEGIN
  WRITE('Please enter the SSN of the employee to be updated: ');
  READLN(SSNumber);
  SearchRec(PayrollFile, EmployeeRec, SSNumber, Found);
  IF Found =1 THEN
    BEGIN
     ASSIGN(PayrollFile, FileName);
     RESET(PayrollFile);
     ASSIGN(NewFile, TempFile);
     REWRITE(NewFile);
     WHILE NOT EOF(PayrollFile) DO
      BEGIN
       WITH Employee DO
        BEGIN
         READLN(PayrollFile, ID);
         READLN(PayrollFile, Name);
         READLN(PayrollFile, Position);
         READLN(PayrollFile, SSN);
         READLN(PayrollFile, Category);
         CASE Category OF
          '1': READLN(PayrollFile, MonthlySalary);
          '2': READLN(PayrollFile, HourlyRate);
          '3': BEGIN
                READLN(PayrollFile, Commission);
                READLN(PayrollFile, BasicSalary);
                READLN(PayrollFile, Area)
               END
         END; { End of CASE structure }
         IF SSNumber <> SSN THEN
           BEGIN
            WRITELN(NewFile, ID);
            WRITELN(NewFile, Name);
            WRITELN(NewFile, Position);
            WRITELN(NewFile, SSN);
            WRITELN(NewFile, Category);
            CASE Category OF
             '1': WRITELN(NewFile, MonthlySalary:0:2);
             '2': WRITELN(NewFile, HourlyRate:0:2);
             '3': BEGIN
                   WRITELN(NewFile, Commission:0:2);
                   WRITELN(NewFile, BasicSalary:0:2);
                   WRITELN(NewFile, Area)
                  END
            END { End of CASE structure }
           END { End of IF block }
         ELSE
           BEGIN
            WRITELN('Please enter the updated information:');
            WRITE('ID: ');   READLN(ID);
            WRITELN(NewFile, ID);
            WRITE('Name: ');    READLN(Name);
            WRITELN(NewFile, Name);
            WRITE('Position: '); READLN(Position);
            WRITELN(NewFile, Position);
            WRITELN(NewFile, SSN);
            WRITE('Category: ');  READLN(Category);
            WRITELN(NewFile, Category);
            CASE Category OF
             '1': BEGIN
                   WRITE('Salary: ');
                   READLN(MonthlySalary);
                   WRITELN(NewFile, MonthlySalary:0:2)
                  END;
             '2': BEGIN
                   WRITE('Hourly Rate: ');
                   READLN(HourlyRate);
                   WRITELN(NewFile, HourlyRate:0:2)
                  END;
             '3': BEGIN
                   WRITE('Commission: ');
                   READLN(Commission);
                   WRITELN(NewFile, Commission:0:2);
                   WRITE('Basic Salary: ');
                   READLN(BasicSalary);
                   WRITELN(NewFile, BasicSalary:0:2);
                   WRITE('Area: ');
                   READLN(Area);
                   WRITELN(NewFile, Area)
                  END
            END { End of CASE structure }
         END { End of ELSE block }
       END { End of WITH block }
     END; { End of DO }
     CLOSE(NewFile);
     CLOSE(PayrollFile);
{ Copy NewFile back to Payroll File }
     ASSIGN(PayrollFile, FileName);
     REWRITE(PayrollFile);
     ASSIGN(NewFile, TempFile);
     RESET(NewFile);
     WHILE NOT EOF(NewFile) DO
      BEGIN
       READLN(NewFile, OneLine);
       WRITELN(PayrollFile, OneLine)
      END;
     CLOSE(NewFile);
     ERASE(NewFile); { Erase the temporary file }
     CLOSE(PayrollFile);
{ User Messages }
     WRITELN('The employee ', SSNumber, ' is updated.')
    END { End of IF block }
  ELSE
    BEGIN
     WRITELN('The SSN ', SSNumber, ' is not found.');
     WRITELN('Check the number and try again.');
     WRITELN
   END
END;

{ -------------------------- Procedure Menu -------------------------- }
PROCEDURE Menu;
VAR
  Option:INTEGER;
BEGIN
  WRITELN(Header);
  WRITELN;
  WRITELN('1. Display an employee record.');
  WRITELN('2. Add a new employee.');
  WRITELN('3. Delete an employee.');
  WRITELN('4. Update an employee record.');
  WRITELN('5. Exit.');
  WRITELN(Separator);
  WRITE('Make a choice and press a number: ');
  READLN(Option);
  CASE Option OF
   1: ReadRec(PayrollFile, EmployeeRec);
   2: AddRec(NewFile, PayrollFile, EmployeeRec);
   3: DelRec(NewFile, PayrollFile, EmployeeRec);
   4: UpdateRec(NewFile, PayrollFile, EmployeeRec);
   5: Exit
  END;
  Menu
END;

{ --------------------------- Main Program --------------------------- }
BEGIN
{ Assign titles }
  Title[1]:= 'ID: ';
  Title[2]:= 'Name: ';
  Title[3]:= 'Position: ';
  Title[4]:= 'SSN: ';
  Title[5]:= 'Salary: ';
  Title[6]:= 'Rate: ';
  Title[7]:= 'Commission: ';
  Title[8]:= 'Basic Salary: ';
  Title[9]:= 'Area: ';
  Menu
END.

Table of Contents

Products | Contact Us | About Us | Privacy | Ad Info | Home

Use of this site is subject to certain Terms & Conditions, Copyright © 1996-2000 EarthWeb Inc.
All rights reserved. Reproduction whole or in part in any form or medium without express written permission of EarthWeb is prohibited. Read EarthWeb's privacy statement.