|
|
 |
 |
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
Appendix C
Answers to Drills
Chapter 1
Drill 1-1
{ ------------------------- DRILL 1-1 ---------------------------- }
PROGRAM DisplayText(OUTPUT);
BEGIN
WRITELN('WORDWARE PUBLISHING, INC.');
WRITELN('-------------------------');
WRITELN('2320 Los Rios Boulevard');
WRITELN('PLANO, TEXAS 75074')
END.
Drill 1-2
{ --------------------------- DRILL 1-2 -------------------------- }
PROGRAM Expressions(OUTPUT);
BEGIN
WRITELN;
WRITELN('A. 144/12 = ',144 / 12:0:2);
WRITELN('B. 144 DIV 12 = ', 144 DIV 12);
WRITELN('C. 17 MOD 5 = ', 17 MOD 5);
WRITELN('D. 3 MOD 5 = ', 3 MOD 5);
WRITELN('E. 3e+02 + 3 = ',3E+02+3:0:2);
WRITELN('F. 345E-01 -1 = ',345E-01-1:0:2);
WRITELN('Press ENTER to continue..');
READLN
END.
Drill 1-3
{ -------------------------- DRILL 1-3 --------------------------- }
PROGRAM Expressions1(OUTPUT);
BEGIN
WRITELN;
WRITELN('A. 15 - 15 DIV 15 = ',15-15 DIV 15);
WRITELN('B. 22 + 10 / 2 = ', 22+10/2:0:2);
WRITELN('B. (22 + 10) / 2 = ', (22+10)/2:0:2);
WRITELN('C. 50 * 10 - 4 MOD 3 * 5 + 80 = ',50*10-4 MOD 3*5+80);
WRITELN('Press ENTER to continue..');
READLN
END.
Drill 1-4
{ -------------------------- DRILL 1-4 --------------------------- }
PROGRAM Expressions2(OUTPUT);
{ Variable Declarations }
VAR
a, b :INTEGER;
{ Program block }
BEGIN
a := 2;
b := 9;
WRITELN;
WRITELN('a=',a);
WRITELN('b=',b);
WRITELN('a+b DIV 2 = ',a+b DIV 2);
WRITELN('(a+b) DIV 2 = ',(a+b) DIV 2)
END.
Drill 1-5
{ -------------------------- DRILL 1-5 --------------------------- }
PROGRAM Payroll(INPUT,OUTPUT);
{ Variable Declarations }
VAR
HoursWorked, PayRate, Wages:REAL;
{ Program block }
BEGIN
WRITE('Please enter hours worked: ');
READLN(HoursWorked);
WRITE('Please pay rate: ');
READLN(PayRate);
Wages := HoursWorked * PayRate;
WRITELN;
WRITELN('Wages = $', Wages:0:2)
END.
Chapter 2
Drill 2-1
{ --------------------------- DRILL 2-1 -------------------------- }
{ Grocery Store }
PROGRAM Grocery(INPUT,OUTPUT);
VAR
Change, AmountPaid, TotalPrice :REAL;
IntChange, Dollars, Quarters, Dimes, Nickels, Cents :INTEGER;
BEGIN
WRITE('Enter the total-price in dollars:');
READLN(TotalPrice);
WRITE('Enter the amount-paid in dollars:');
READLN(AmountPaid);
{ dollars }
Change := AmountPaid - TotalPrice;
Dollars := TRUNC(Change);
Change := (Change - Dollars)*100;
IntChange := ROUND(Change);
{ Quarters }
Quarters := IntChange DIV 25;
IntChange := IntChange MOD 25;
{ Dimes }
Dimes := IntChange DIV 10;
IntChange := IntChange MOD 10;
{ Nickels }
Nickels := IntChange DIV 5;
IntChange := IntChange MOD 5;
{ Cents }
Cents := IntChange;
WRITELN('The change is:');
WRITELN(Dollars,' Dollars');
WRITELN(Quarters,' Quarters');
WRITELN(Dimes,' Dimes');
WRITELN(Nickels, ' Nickels');
WRITELN(Cents, ' Cents');
READLN
END.
Drill 2-2
{---------------------------- DRILL 2-2 -------------------------- }
{ Solution of a Quadratic Equation }
PROGRAM Quadratic(INPUT,OUTPUT);
VAR
A, B, C, D, X1, X2 :REAL;
BEGIN
WRITE('Enter the values of A,B and C fo the quadratic equation:');
READLN(a,b,c);
{ Determinant}
D:=SQR(B)-4.0*A*C;
{ Roots }
X1:=(-B+SQRT(D))/(2*A);
X2:=(-B-SQRT(D))/(2*A);
WRITELN('X1=',X1:2:2,' X2=',X2:2:2);
WRITELN('Press ENTER to continue...');
READLN
END.
{ Sample runs:
A=2, B=4, C=1
X1=0.29
X2=1.70
A=1, B=2, C=1
X1=-1
X2=-1 }
Drill 2-3
{ -------------------------- DRILL 2-3 --------------------------- }
{ Boolean Expressions }
PROGRAM CompoundBoolean(OUTPUT);
VAR
A, X, Y, Z :INTEGER;
One, Two, Three, Four :BOOLEAN;
BEGIN
{ Run the program for different values of A, X, Y, Z, and see the results }
WRITE('Enter values of A, X, Y, Z:');
READLN(A,X,Y,Z);
One := A < 55.5;
Two := (X=Y) OR (X>=Z);
Three := (X=40) OR (Y=80);
Four := (X=40) <> (Y=80);
{ Four := (X=40) XOR (Y=80); } { Turbo Pascal version }
WRITELN('Expression #1= ', One);
WRITELN('Expression #2= ', Two);
WRITELN('Expression #3= ', Three);
WRITELN('Expression #4= ', Four)
END.
Chapter 3
Drill 3-1
{ -------------------------- DRILL 3-1 --------------------------- }
PROGRAM CharsTester(INPUT,OUTPUT);
VAR
InputChar :CHAR;
BEGIN
WRITE('Please enter an alphabetic character:');
READLN(InputChar);
IF (ORD(InputChar) > 64) AND (ORD(InputChar) < 91) THEN
WRITELN('This is an upper-case letter.');
IF (ORD(InputChar) > 96) AND (ORD(InputChar) < 123) THEN
WRITELN('This is a lower-case letter.');
IF (ORD(InputChar) > 47) AND (ORD(InputChar) < 58) THEN
WRITELN('This is a number.');
WRITELN('Press ENTER to continue..');
READLN
END.
Drill 3-2
{-------------------------- DRILL 3-2 -------------------------- }
{ Complete Solution of a Quadratic Equation }
PROGRAM Quadratic2(INPUT,OUTPUT);
VAR
A, B, C, D, X1, X2 :REAL;
BEGIN
WRITE('Enter the values of A,B,C separated by spaces:');
READLN(a,b,c);
{ Determinant}
D:=SQR(B)-4.0*A*C;
IF D < 0 THEN
BEGIN
WRITELN('Roots are imaginary.');
WRITELN('X1=',-B/(2*A):0:2,'+j',SQRT(ABS(D))/(2*A):0:2);
WRITELN('X2=',-B/(2*A):0:2,'-j',SQRT(ABS(D))/(2*A):0:2)
END
ELSE
BEGIN
WRITELN('Roots are real.');
WRITELN('X1=',(-B+SQRT(D))/(2*A):0:2);
WRITELN('X2=',(-B-SQRT(D))/(2*A):0:2)
END;
WRITELN('Press ENTER to continue...');
READLN
END.
{ Sample runs:
Real roots:
A=2, B=4, C=1
X1=0.29
X2=1.70
Equal real roots:
A=1, B=2, C=1
X1=-1
X2=-1
Imaginary roots:
A=1, B=1,C=1
X1=-0.5+j0.87
X2=-0.5-j0.87 }
Drill 3-3
{ -------------------------- DRILL 3-3 --------------------------- }
PROGRAM WeatherTester(INPUT,OUTPUT);
VAR
Temperature :INTEGER;
Hot, Cool, Cold, Freezing :BOOLEAN;
BEGIN
WRITE('Please enter the temperature:');
READLN(Temperature);
Hot := (Temperature >= 75) AND (Temperature < 140);
Cool := (Temperature >= 50) AND (Temperature < 75);
Cold := (Temperature >= 35) AND (Temperature < 50);
Freezing := (Temperature < 35) AND (Temperature > -80);
WRITELN;
{ Beginning of the IF construct }
{ ----------------------------- }
IF Hot THEN
WRITELN('It is hot out there!')
ELSE IF Cool THEN
WRITELN('Wow, the weather is cool.')
ELSE IF Cold THEN
WRITELN('Oh, it is cold. ')
ELSE IF Freezing THEN
WRITELN('Uh-oh, It is freezing.')
ELSE
WRITELN('Hey, I have never heard of this temperature!');
{ End of the IF construct }
{ ----------------------- }
WRITELN('Press ENTER to continue..');
READLN
END.
Drill 3-4
{ -------------------------- DRILL 3-4 --------------------------- }
PROGRAM DateConverter(INPUT,OUTPUT);
VAR
Day, Month, Year :INTEGER;
BEGIN
WRITE('Please enter date in the format mm dd yy:');
READLN(Month, Day, Year);
CASE Month OF
1: WRITE('January ');
2: WRITE('February ');
3: WRITE('March ');
4: WRITE('April ');
5: WRITE('May ');
6: WRITE('June ');
7: WRITE('July ');
8: WRITE('August ');
9: WRITE('September ');
10: WRITE('October ');
11: WRITE('November ');
12: WRITE('December ')
END;
IF (Day=1) OR (Day=21) OR (Day=31) THEN
WRITE(Day,'st')
ELSE IF (Day=2) OR (Day=22) THEN
WRITE(Day,'nd')
ELSE IF (Day=3) OR (Day=23) THEN
WRITE(Day,'rd')
ELSE
WRITE(Day,'th');
WRITELN(', 19', Year);
WRITELN('Press ENTER to continue..');
READLN
END.
Chapter 4
Drill 4-1
{ -------------------------- DRILL 4-1 --------------------------- }
PROGRAM LeapYears(OUTPUT);
VAR
Year :INTEGER;
BEGIN
FOR Year := 1990 TO 2000 DO
BEGIN
IF (Year MOD 4 = 0) AND
(Year MOD 100 <> 0) OR (Year MOD 400 = 0) THEN
WRITELN('The year ', Year, ' is a leap year.')
ELSE
WRITELN('The year ', Year, ' is not a leap year.')
END;
WRITELN('Press ENTER to continue...');
READLN
END.
Drill 4-2
{ --------------------------- DRILL 4-2 -------------------------- }
PROGRAM FactorialProg3(INPUT,OUTPUT);
VAR
Factorial :REAL;
Kounter, Number :INTEGER;
BEGIN
WRITE('Give me a number (or 0 to exit): ');
READLN(Number);
IF Number = 0 THEN
EXIT;
Factorial := 1;
FOR kounter := Number DOWNTO 1 DO
Factorial := Factorial * Kounter;
WRITELN('The factorial of ', Number,' is ', Factorial:0:0);
WRITELN('Press ENTER to continue..');
READLN
END.
Drill 4-3
{ -------------------------- DRILL 4-3 --------------------------- }
PROGRAM FlagLoop(OUTPUT);
VAR
Row, Column : INTEGER;
BEGIN
FOR Row := 1 TO 5 DO
BEGIN
FOR Column := 1 to 10 DO
WRITE('* ');
WRITELN
END;
WRITELN;
WRITELN('Press ENTER to continue...');
READLN
END.
Drill 4-4
{ --------------------------- DRILL 4-4 -------------------------- }
PROGRAM Multiplication(INPUT,OUTPUT);
VAR
Result, Kounter, Number :INTEGER;
BEGIN
WRITE('Give me a number: ');
READLN(Number);
Kounter := 1;
WHILE Kounter <= 9 DO
BEGIN
Result := Kounter * Number;
WRITELN(Kounter,' * ',Number, ' = ', Result);
Kounter := Kounter +1
END;
WRITELN;
WRITELN('Press ENTER to continue...');
READLN
END.
Drill 4-5
{ --------------------------- DRILL 4-5 -------------------------- }
PROGRAM FactorialProg3(INPUT,OUTPUT);
VAR
Factorial :REAL;
Kounter, Number :INTEGER;
BEGIN
WRITE('Give me a number (or 0 to exit): ');
READLN(Number);
WHILE Number <> 0 DO
BEGIN
Factorial := 1;
FOR kounter := Number DOWNTO 1 DO
Factorial := Factorial * Kounter;
WRITELN('The factorial of ', Number,' is ', Factorial:0:0);
WRITE('Give me a number (or 0 to exit): ');
READLN(Number)
END
END.
Chapter 5
Drill 5-1
{ --------------------------- DRILL 5-1 -------------------------- }
PROGRAM Subrange2(INPUT,OUTPUT);
VAR
UpperCase :'A'..'Z';
LowerCase :'a'..'z';
Digit :'0'..'9';
BEGIN
WRITE('Please enter an a lowercase letter: ');
READLN(LowerCase);
WRITE('Please enter an uppercase letter: ');
READLN(UpperCase);
WRITE('Please enter a digit: ');
READLN(Digit);
WRITELN('-----------------------------------------------');
WRITELN('Your inputs are:');
WRITELN('Lowercase letter : ', LowerCase);
WRITELN('Uppercase letter : ', UpperCase);
WRITELN('Digit : ', Digit);
WRITELN('Press ENTER to continue...');
READLN
END.
Drill 5-2
{ --------------------------- DRILL 5-2 -------------------------- }
PROGRAM SubrangesAndEnum(INPUT,OUTPUT);
{
****************************************************
*** Remove the comment markers to see the error messages ***
****************************************************
}
TYPE
Football = (Saints, Cowboys);
{ Games = (Football, Baseball, Basketball) }
{ Duplicate identifier: Football }
Week = (Mon, Tue, Wed, Thu, Fri, Sat, Sun);
Weekend = Sat..Sun;
Compiler = (C, Pascal, Fortran, Ada, Basic);
VAR
WholeWeek :Week;
{ WorkingDay :(Mon, tue, Wed, Fri);}
{ Duplicate identifier: Mon,..}
Weekday :Mon..Fri;
{ SW :(Compiler, OperatingSystem, ApplicationProgram); }
{ Duplicate identifier: Compiler}
DpTools :(Hardware, Software, PeopleWare);
DpTool :(HW, SW, PW);
{ C :(TurboC, QuickC); }
{ Duplicate identifier: C}
Margin : -10..+10;
BEGIN
END.
Drill 5-3
{ --------------------------- DRILL 5-3 ------------------------- }
PROGRAM Scores4(INPUT,OUTPUT);
CONST
NumberOfStudents = 5;
Tab = ' '; { 9 spaces }
Dash = '-';
NumberOfDashes = 23;
VAR
Score :ARRAY[1..NumberOfStudents] OF REAL;
Average, SumOfScores :REAL;
Index :INTEGER;
BEGIN
{ Read the scores array }
{ --------------------- }
FOR Index := 1 TO NumberOfStudents DO
BEGIN
WRITE('Enter Score of Student #', Index,': ');
READLN(Score[Index])
END;
{ Calculate the average score }
{ --------------------------- }
SumOfScores := 0;
FOR Index := 1 TO NumberOfStudents DO
SumOfScores := SumOfScores + Score[Index];
Average := SumOfScores / NumberOfStudents;
{ Display Results }
{ --------------- }
WRITELN;
WRITE(Tab, 'Student #');
WRITE(Tab, 'Score');
WRITELN;
WRITE(Tab);
FOR Index := 1 TO NumberOfDashes DO
WRITE(Dash);
WRITELN;
FOR Index := 1 TO NumberOfStudents DO
WRITELN(Tab,Index:3,tab,Score[Index]:10:2);
WRITE(Tab);
FOR Index := 1 TO NumberOfDashes DO
WRITE(Dash);
WRITELN;
WRITELN(Tab,'Average score = ', Average:0:2);
WRITELN;
WRITELN('Press ENTER to continue..');
READLN
END.
Drill 5-4
{ --------------------------- DRILL 5-4 -------------------------- }
PROGRAM Scores5(INPUT,OUTPUT);
CONST
NumberOfStudents = 5;
Tab = ' ';
Dash = '-';
NumberOfDashes = 23;
VAR
Score :ARRAY[1..NumberOfStudents] OF REAL;
Average, SumOfScores, BestScore :REAL;
Index, BestOfClass :INTEGER;
BEGIN
{ Read the scores array }
{ --------------------- }
FOR Index := 1 TO NumberOfStudents DO
BEGIN
WRITE('Enter score of student #', Index,': ');
READLN(Score[Index])
END;
{ Calculate the average score }
{ --------------------------- }
SumOfScores := 0;
FOR Index := 1 TO NumberOfStudents DO
SumOfScores := SumOfScores + Score[Index];
Average := SumOfScores / NumberOfStudents;
{ Get the best score }
{ ------------------ }
BestScore := Score[1]; { initial value }
BestOfClass := 1; { initial value }
FOR Index := 2 TO NumberOfStudents DO
BEGIN
IF Score[Index] > BestScore THEN
BEGIN
BestScore := Score[Index];
BestOfClass := Index;
END
END;
{ Display Results }
{ --------------- }
WRITELN;
WRITE(Tab, 'Student #', Tab, 'Score');
WRITELN;
WRITE(Tab);
FOR Index := 1 TO NumberOfDashes DO
WRITE(Dash);
WRITELN;
FOR Index := 1 TO NumberOfStudents DO
WRITELN(Tab, Index:3, Tab, Score[Index]:10:2);
WRITE(Tab);
FOR Index := 1 TO NumberOfDashes DO
WRITE(Dash);
WRITELN;
WRITELN(Tab,'Average score = ', Average:0:2);
WRITELN(Tab,'The best score = ', BestScore:0:2);
WRITELN(Tab,'The best of the class is student #',BestOfClass);
WRITELN;
WRITELN('Press ENTER to continue..');
READLN
END.
Drill 5-5
{ -------------------------- DRILL 5-5 --------------------------- }
PROGRAM Scores6(INPUT,OUTPUT);
{ using two-dimensional array }
CONST
NumberOfClasses = 3; { Change this number for more classes }
NumberOfStudents = 4; { Change this number for more students }
Tab = ' '; { 5 spaces }
Dash = '-';
NumberOfDashes = 23;
TYPE
ScoreArray = ARRAY[1..NumberOfStudents, 1..NumberOfClasses] OF REAL;
AverageArray = ARRAY[1..NumberOfStudents] OF REAL;
NameArray = ARRAY[1..NumberOfStudents] OF STRING;
VAR
Score :ScoreArray;
Average :AverageArray;
Name :NameArray;
SumOfScores, AveragePot :REAL;
StudentCount, ScoreCount, DashCount :INTEGER;
I, J :INTEGER;
NamePot :STRING;
BEGIN
{ Read the scores array }
{ --------------------- }
FOR StudentCount := 1 TO NumberOfStudents DO
BEGIN
WRITELN;
WRITE('Name of student #', StudentCount,': ');
READLN(Name[StudentCount]);
WRITELN('Scores of ', Name[StudentCount], ': ');
FOR ScoreCount := 1 TO NumberOfClasses DO
BEGIN
WRITE('Enter score of class #', ScoreCount,': ');
READLN(Score[StudentCount, ScoreCount])
END;
END;
{ Calculate the average for each student }
{ -------------------------------------- }
FOR StudentCount := 1 TO NumberOfStudents DO
BEGIN
SumOfScores:= 0; { Initialize for each student }
FOR ScoreCount := 1 TO NumberOfClasses DO
SumOfScores := SumOfScores + Score[StudentCount, ScoreCount];
Average[StudentCount] := SumOfScores/NumberOfClasses
END;
{ Sort averages in a descending order }
{ ------------------------------------ }
FOR I := 1 TO NumberOfStudents-1 DO
BEGIN
FOR J := I+1 TO NumberOfStudents DO
IF Average[J] > Average[I] THEN
BEGIN
{ swap the averages }
AveragePot := Average[I];
Average[I] := Average[J];
Average[J] := AveragePot;
{ swap the corresponding student number }
NamePot := Name[I];
Name[I] := Name[J];
Name[J] := NamePot
END { End of IF and inner loop }
END; { End of outer loop }
{ Display results }
{ --------------- }
WRITELN;
WRITELN(Tab, 'Student name', Tab, 'Average');
WRITE(Tab);
FOR DashCount := 1 TO NumberOfDashes DO
WRITE(Dash);
WRITELN;
FOR StudentCount := 1 TO NumberOfStudents DO
BEGIN
WRITE(Tab, Name[StudentCount]);
FOR I := 1 TO 15 - LENGTH(Name[StudentCount]) DO
WRITE(' ');
WRITELN(Average[StudentCount]:8:2)
END;
WRITE(Tab);
FOR DashCount := 1 TO NumberOfDashes DO
WRITE(Dash);
WRITELN;
WRITELN('Press ENTER to continue..');
READLN
END.
Chapter 6
Drill 6-3
{ -------------------------- DRILL 6-3 --------------------------- }
PROGRAM AlphaCounter(INPUT,OUTPUT);
VAR
Ch :CHAR;
Counter :INTEGER;
BEGIN
Counter := 0;
WHILE NOT EOLN DO
BEGIN
READ(Ch);
IF (Ch >= 'a') AND (Ch <= 'z')
OR (Ch >= 'A') AND (Ch <= 'Z') THEN
Counter := Counter + 1
END;
WRITELN('Number of letters= ', Counter);
READLN; { To advance the pointer past to End-Of-Line mark }
WRITELN('Press ENTER to continue...');
READLN
END.
Drill 6-4
{ -------------------------- DRILL 6-4 --------------------------- }
PROGRAM ScramblingStrings(INPUT,OUTPUT);
CONST
NumberOfElements = 3;
TYPE
ScrambleArray = Array[1..NumberOfElements] OF STRING[10];
VAR
A :ScrambleArray;
I1, I2, I3 :INTEGER;
BEGIN
WRITE('Enter a word: ');
READLN(A[1]);
WRITE('Enter a word: ');
READLN(A[2]);
WRITE('Enter a word: ');
READLN(A[3]);
FOR I1 := 1 TO 3 DO
FOR I2 := 1 TO 3 DO
IF I2 <> I1 THEN
BEGIN
I3 := 6- (I1 + I2);
WRITELN(A[I1],' ',A[I2],' ',A[I3]);
END;
WRITELN('Press ENTER to continue...');
READLN
END.
Drill 6-5
{ ---------------------------- DRILL 6-5 ----------------------------- }
PROGRAM StringFunctions2(INPUT,OUTPUT);
VAR
Name :STRING[30];
First, Middle, Last:STRING[10];
BEGIN
WRITE('Please enter your first name: ');
READLN(First);
{ Capitalize the first letter if it is lowercase }
IF ORD(First[1]) > 90 THEN
First[1]:= CHR(ORD(First[1]) - 32);
First:= CONCAT(First, ' ');
WRITE('Please enter your middle name: ');
READLN(Middle);
{ Capitalize the first letter if it is lowercase }
IF ORD(Middle[1]) > 90 THEN
Middle[1]:= CHR(ORD(Middle[1]) - 32);
{ Get the middle initial from the middle name }
Middle:= COPY(Middle, 1, 1);
Middle:= CONCAT(Middle, '. ');
WRITE('Please enter your last name: ');
READLN(Last);
{ Capitalize the first letter if it is lowercase }
IF ORD(Last[1]) > 90 THEN
Last[1]:= CHR(ORD(Last[1]) - 32);
Name:= CONCAT(First, Middle, Last);
WRITELN;
WRITELN('Your complete name is: ',Name);
WRITELN('Press ENTER to continue...');
READLN
END.
Chapter 7
Drill 7-1
{ ---------------------------- DRILL 7-1 ---------------------------- }
PROGRAM Header(OUTPUT);
VAR
Len, Tab, Kounter :INTEGER;
TestSentence :STRING;
LineChar :CHAR;
{ ----------------------- Beginning of Procedure --------------------- }
PROCEDURE DrawLine(LineLength, TabLength:INTEGER; LineCh: CHAR);
VAR
Counter:INTEGER;
BEGIN
FOR Counter:= 1 TO TabLength DO
WRITE(' ');
FOR Counter:= 1 TO LineLength DO
WRITE(LineCh);
WRITELN
END;
{ ------------------------- End of Procedure ------------------------- }
{ --------------------------- Main program --------------------------- }
BEGIN
WRITE('Please enter a sentence: ');
READLN(TestSentence);
Len:= LENGTH(TestSentence);
Tab:= (80 - Len) DIV 2;
WRITE('Please enter the line character: ');
READLN(LineChar);
WRITELN;
Drawline(Len, Tab, LineChar);
FOR Kounter:= 1 TO Tab DO
WRITE(' ');
WRITELN(TestSentence);
Drawline(Len, Tab, LineChar);
WRITELN('Press ENTER to continue...');
READLN
END.
Drill 7-2
{ ---------------------------- DRILL 7-2 ----------------------------- }
PROGRAM FunctionMax(INPUT, OUTPUT);
CONST
ArraySize = 6;
TYPE
Range = 1..ArraySize;
NumbersArray = ARRAY[Range] OF INTEGER;
VAR
Numbers :NumbersArray;
{ --------------------------- Read procedure ------------------------- }
PROCEDURE ReadNumbers(L: INTEGER; VAR R:NumbersArray);
VAR
I:INTEGER;
BEGIN
WRITELN('Give me an array of numbers of six elements.');
FOR I:= 1 TO L DO
BEGIN
WRITE('Enter element #', I,': ');
READLN(R[I])
END
END;
{ ----------------------- Function MaxNumber ------------------------- }
FUNCTION MaxNumber(S:INTEGER; N: NumbersArray):INTEGER;
VAR
K, Maximum:INTEGER;
BEGIN
Maximum:= N[1];
FOR K:= 1 TO S DO
IF N[K] > Maximum THEN
Maximum:= N[K];
MaxNumber:= Maximum { Assign the max value to the function }
END;
{ ------------------------- End of Function -------------------------- }
{ --------------------------- Main program --------------------------- }
BEGIN
ReadNumbers(ArraySize, Numbers);
WRITELN('The maximum number is: ', MaxNumber(ArraySize, Numbers));
WRITELN;
WRITELN('Press ENTER to continue...');
READLN
END.
Drill 7-3
{ ----------------------------- DRILL 7-3 ---------------------------- }
PROGRAM ProcedureRecursion(INPUT, OUTPUT);
VAR
A :INTEGER;
Fact:REAL;
{ ------------- Procedure Definition -------------- }
PROCEDURE Factorial(X:INTEGER; VAR Fac:REAL);
BEGIN
IF X > 1 THEN
BEGIN
Factorial(X-1, Fac);
Fac:= Fac * X
END
ELSE
Fac:= 1;
END;
{ -------------- End of Procedure ---------------- }
{ ----------------- Main program ----------------- }
BEGIN
WRITE('Enter a number: ');
READLN(A);
Factorial(A, Fact);
WRITELN('The Factorial of ', A,' = ', Fact:0:0);
WRITELN('Press ENTER to continue...');
READLN
END.
Chapter 8
Drill 8-1
Expression Value
1. ['A','B','C','D'] + ['E','F'] ['A','B','C','D','E','F']
2. ['A','B','C','D'] + ['B','C','E','F'] ['A','B','C','D','E','F']
3. [1,3,7] + [] [1,3,7]
4. ['A','D','F'] * ['O','F'] ['F']
5. [1,2,3,4] * [5,6,7] []
6. [1,2,3,4] - [5,6,7] [1,2,3,4]
7. [5,6,7] - [] [5,6,7]
8. [Able, Baker, Charlie] - [Able, Charlie] [Baker]
Drill 8-2
{ ---------------------------- DRILL 8-2 ----------------------------- }
PROGRAM TestExpressions(OUTPUT);
CONST
CR = CHR(13);
LF = CHR(10);
T = ' ';
A1= '[1,0] = [1,0]';
B1= '[1,0] <> [1,4]';
C1= '[1,2,3] >= [1,2]';
D1= '[1,2,3] >= [1,2,3]';
E1= '[] <= [1,2,3]';
F1= '[1,2,3] <= [1,2,3]';
VAR
A, B, C, D, E, F:BOOLEAN;
BEGIN
A:= [1,0] = [1,0];
B:= [1,0] <> [1,4];
C:= [1,2,3] >= [1,2];
D:= [1,2,3] >= [1,2,3];
E:= [] <= [1,2,3];
F:= [1,2,3] <= [1,2,3];
WRITELN(A1:30, T, A, CR, LF, B1:30, T, B, CR, LF,
C1:30, T, C, CR, LF, D1:30, T, D, CR, LF,
E1:30, T, E, CR, LF, F1:30, T, F);
WRITELN;
WRITELN('Press ENTER to continue...');
READLN
END.
Drill 8-3
{----------------------------- DRILL 8-3 ------------------------------}
PROGRAM NestedRecord2(OUTPUT);
TYPE
AddressRecord = RECORD
Street :STRING[18];
City :STRING[15];
State :STRING[2];
Zip :String[5];
END;
EmployeeRecord = RECORD
Name :STRING[25];
AddressRec :AddressRecord;
Phone :STRING[12];
Rate :REAL;
MaritalStatus :CHAR;
END;
VAR
EmployeeRec :EmployeeRecord;
BEGIN
{ Assign values to the fields }
WITH EmployeeRec DO
WITH AddressRec DO
BEGIN
Name:= 'Sally A. Abolrous';
Street:= '5 Belle Chasse Dr.';
City:= 'LaPlace';
State:= 'LA';
Zip:= '70068';
Phone:= '504-285-3434';
Rate:= 22.5;
MaritalStatus:= 'S';
{ Display record information }
WRITELN('Employee name: ', Name);
WRITELN('Address: ', Street);
WRITELN(' ', City);
WRITE(' ', State);
WRITELN(' ', Zip);
WRITELN('Telephone #: ', Phone);
WRITELN('Hourly rate: $', Rate:0:2);
WRITELN('Marital status: ', MaritalStatus)
END;
WRITELN('Press ENTER to continue...');
READLN
END.
Chapter 9
Drill 9-1
{----------------------------- DRILL 9-1 ----------------------------}
PROGRAM EmployeeInfoFile(INPUT,OUTPUT,TimeFile);
{ This program is used to create a time sheet file for one month period }
TYPE
EmployeeRecord = RECORD
ID :INTEGER;
Name :STRING[25];
HoursWorked :INTEGER;
END;
VAR
TimeFile :TEXT;
EmployeeRec:EmployeeRecord;
{ ----------- Procedure FileInfo ------------ }
PROCEDURE FileInFo(VAR F:TEXT; Employee:EmployeeRecord);
{ A procedure to file one record at a time }
BEGIN
WITH Employee DO
BEGIN
WRITELN(F, ID);
WRITELN(F, Name);
WRITELN(F, HoursWorked)
END
END;
{ ------------- Procedure GetData -------------- }
{ A procedure to accept data from the keyboard,
and pass them to the "FileInfo" procedure }
PROCEDURE GetData(VAR F:TEXT; VAR Employee:EmployeeRecord);
VAR
Counter:INTEGER;
BEGIN
Counter:= 0;
WITH Employee DO
BEGIN
WRITE('Employee ID (or 0 to exit): '); READLN(ID);
WHILE ID <> 0 DO
BEGIN
Counter:= Counter + 1;
WRITE('Employee Name: '); READLN(Name);
WRITE('HoursWorked : '); READLN(HoursWorked);
FILEINFO(F, Employee);
WRITE('Employee ID (or 0 to exit): '); READLN(ID);
END
END;
WRITELN(Counter,' Employee records have been filed.')
END;
{ --------------- Main Program ----------------- }
BEGIN
ASSIGN(TimeFile, 'TIMSHEET.TXT');
REWRITE(TimeFile);
GetData(TimeFile, EmployeeRec);
CLOSE(TimeFile)
END.
Drill 9-2
{ ----------------------------- DRILL 9-2 ---------------------------- }
PROGRAM CreateEmpFile(INPUT,OUTPUT,F);
TYPE
AddressRecord = RECORD
Street :STRING[18];
City :STRING[15];
State :STRING[2];
Zip :String[5];
END;
EmployeeRecord = RECORD
ID :INTEGER;
Name :STRING[25];
AddressRec :AddressRecord;
Phone :STRING[12];
Rate :REAL;
MaritalStatus :CHAR;
END;
VAR
F :TEXT; { The file variable }
EmployeeRec:EmployeeRecord;
{ ----------- Procedure WriteRecord ---------- }
PROCEDURE WriteRecord;
BEGIN
{ Store one record to the file }
WITH EmployeeRec DO
WITH AddressRec DO
BEGIN
WRITELN(F, ID);
WRITELN(F, Name);
WRITELN(F, Street);
WRITELN(F, City);
WRITELN(F, State);
WRITELN(F, Zip);
WRITELN(F, Phone);
WRITELN(F, Rate:0:2);
WRITELN(F, MaritalStatus)
END
END;
{ ----------- Procedure Get Data ---------- }
PROCEDURE getdata;
VAR
Counter:INTEGER;
BEGIN
Counter:= 0;
WITH EmployeeRec DO
WITH AddressRec DO
BEGIN
WRITE('Please enter Employee ID (or 0 to exit): '); READLN(ID);
WHILE ID <> 0 DO
BEGIN
Counter:= counter + 1;
WRITE('Employee Name: '); READLN(Name);
WRITE('Address: Street: '); READLN(Street);
WRITE(' City: '); READLN(City);
WRITE(' State: '); READLN(State);
WRITE(' Zip code: '); READLN(Zip);
WRITE('Phone Number: '); READLN(Phone);
WRITE('Hourly Rate: '); READLN(Rate);
WRITE('Marital Status (S/M): '); READLN(MaritalStatus);
WriteRecord;
WRITE('Please enter Employee ID (or 0 to exit): '); READLN(ID);
END
END;
WRITELN(Counter, ' Employee records have been filed.')
END;
{ ---------------- Main Program -------------- }
{ Main Program }
BEGIN
ASSIGN(F, 'EMPFILE.TXT');
REWRITE(F);
GetData;
CLOSE(F)
END.
Drill 9-3
{ ------------------------------- DRILL 9-3 -------------------------------- }
PROGRAM PayRoll2(INPUT,OUTPUT,MasterFile,PayFile);
TYPE
AddressRecord = RECORD
Street :STRING[18];
City :STRING[15];
State :STRING[2];
Zip :String[5];
END;
EmployeeRecord = RECORD
ID :INTEGER;
Name :STRING[20];
AddressRec :AddressRecord;
Phone :STRING[12];
Rate :REAL;
MaritalStatus :CHAR;
END;
PayRecord = RECORD
ID :INTEGER;
Name :STRING[20];
Wages :REAL;
END;
VAR
MasterFile, PayFile:TEXT;
EmployeeRec :EmployeeRecord;
PayRec :PayRecord;
HoursWorked, Wages :REAL;
{ --------------- Procedure Getinfo ------------------ }
{ This procedure reads the employee file "EMPFILE.TXT"
and displays the ID, Name, and Hourly Rate. Then it accepts
the Hours Worked during this pay period from the keyboard }
PROCEDURE Getinfo(VAR F:TEXT);
BEGIN
WITH EmployeeRec DO
WITH AddressRec DO
BEGIN
READLN(F,ID); WRITELN('ID: ',ID);
READLN(F,Name); WRITELN('Name: ',Name);
READLN(F,Street);
READLN(F,City);
READLN(F,State);
READLN(F,Zip);
READLN(F,Phone);
READLN(F,Rate); WRITELN('Hourly rate: $', Rate:0:2);
READLN(F,MaritalStatus);
END;
END;
{ --------------- Procedure CalcWages ---------------- }
{ This procedure is used to calculate Wages and round
the cents in the resulting number. The result is
returned to the main program }
PROCEDURE CalcWages(HoursWorked:REAL; VAR Wages:REAL);
BEGIN
WITH EmployeeRec DO
WITH AddressRec DO
Wages:= Hoursworked * Rate;
Wages:= ROUND(100 * Wages) / 100;
END;
{ -------------- Procedure FilePayRoll --------------- }
{ This procedure is used to write one record
in the output file "PAYFILE.TXT" }
PROCEDURE FilePayRoll(VAR F:TEXT; VAR P:TEXT; Wages:REAL);
BEGIN
WITH EmployeeRec DO
WITH AddressRec DO
BEGIN
PayRec.ID:= ID;
PayRec.Name:= Name;
Payrec.Wages:= Wages
END;
WITH PayRec DO
WRITELN(P, ID:3, Name:20, Wages:10:2)
END;
{ -------------- Procedure ReadPayRoll --------------- }
{ This procedure is used to read the file "PAYFILE.TXT"
and display the records at the end of the program }
PROCEDURE ReadPayRoll(VAR P:TEXT);
BEGIN
WITH PayRec DO
BEGIN
READLN(P, ID, Name, Wages);
WRITELN(ID:3, Name:20, ' $',Wages:0:2)
END;
END;
{ --------------- Main Program ------------------ }
BEGIN
ASSIGN(MasterFile, 'EMPFILE.TXT');
ASSIGN(Payfile, 'PAYFILE.TXT');
REWRITE(PayFile);
RESET(MasterFile);
WHILE NOT EOF(MasterFile) DO
BEGIN
Getinfo(MasterFile);
WRITE('Please enter hours worked for this pay period: ');
READLN(HoursWorked);
CalcWages(HoursWorked, Wages);
FilePayRoll(MasterFile, PayFile, Wages)
END;
CLOSE(MasterFile);
CLOSE(PayFile);
RESET(PayFile);
WRITELN('--------- PayRoll Summary --------- ');
WRITELN('ID --------- Name -------- Salary');
WHILE NOT EOF(PayFile) DO
ReadPayroll(PayFile);
CLOSE(PayFile);
WRITELN('----------------------------------- ');
WRITELN('Press ENTER to continue..');
READLN
END.
Chapter 10
Drill 10-1
{ --------------------------- DRILL 10-1 ----------------------------- }
PROGRAM CreateEmployeeDataBase2(INPUT, OUTPUT, PayrollFile, NewFile);
{ This program is to create the TEXT file "PR.TXT which stores employee records. }
CONST
FileName = 'PR.TXT';
Header = '---------- Creating Payroll File ----------';
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;
VAR
PF:TEXT;
EmployeeRec :EmployeeRecord;
Title :ARRAY [1..9] OF STRING[20];
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: ';
ASSIGN(PF, FileName);
REWRITE(PF);
WRITELN(Header);
WITH EmployeeRec DO
BEGIN
WRITE('Please enter Employee ID: '); READLN(ID);
WRITELN(PF,ID);
WRITE('Name: '); READLN(Name);
WRITELN(PF,Name);
WRITE('Position: '); READLN(Position);
WRITELN(PF,Position);
WRITE('SSN (xxx-xx-xxxx): '); READLN(SSN);
WRITELN(PF,SSN);
WRITE('Payroll category: '); READLN(Category);
CASE Category OF
'1': BEGIN
WRITE('Monthly Salary: ');
READLN(MonthlySalary);
WRITELN(PF,MonthlySalary)
END;
'2': BEGIN
WRITE('Hourly Rate: ');
READLN(HourlyRate);
WRITELN(PF,HourlyRate)
END;
'3': BEGIN
WRITE('Commission Rate: ');
READLN(Commission);
WRITELN(PF,Commission);
WRITE('Basic Salary: ');
READLN(BasicSalary);
WRITELN(PF,BasicSalary);
WRITE('Area: ');
READLN(Area);
WRITELN(PF,Area)
END
END
END;
CLOSE(PF);
WRITELN(Separator);
WRITELN('Payroll file has been created. Press any key');
READLN
END.
Drill 10-2
{ -------------------------- DRILL 10-2 ------------------------------ }
PROCEDURE DelRec(VAR NewFile, PayrollFile:TEXT; Employee:EmployeeRecord);
VAR
SSNumber:STRING[11];
Found :INTEGER;
BEGIN
Found:= 0;
ASSIGN(PayrollFile, FileName);
RESET(PayrollFile);
ASSIGN(NewFile, TempFile);
REWRITE(NewFile);
WRITE('Please enter the SSN of the employee to be deleted: ');
READLN(SSNumber);
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
ELSE
Found:= 1;
END { End of WITH block }
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);
{ User Messages }
IF Found =1 THEN
WRITELN('The employee ', SSNumber, ' is removed from file.')
ELSE
BEGIN
WRITELN('The SSN ', SSNumber, ' is not found.');
WRITELN('Check the number and try again.');
WRITELN
END
END;
Drill 10-3
{ -------------------------- DRILL 10-3 ------------------------------ }
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;
VAR
NewFile, PayrollFile:TEXT;
EmployeeRec :EmployeeRecord;
Title :ARRAY [1..9] OF STRING[20];
OneLine :STRING[80];
{ ------------------ Procedure ReadRec -------------------- }
PROCEDURE ReadRec(VAR PayrollFile:TEXT;
Employee:EmployeeRecord);
VAR
SSNumber :STRING[11];
Found :INTEGER;
BEGIN
Found:= 0; {Reset the flag}
ASSIGN(PayrollFile, FileName);
RESET(PayrollFile);
WRITELN;
WRITE('Please enter the SSN of the employee: ');
READLN(SSNumber);
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 }
Found:= 1
END
END { End of WITH block }
END;
CLOSE(PayrollFile);
IF Found <> 1 THEN
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];
BEGIN
ASSIGN(PayrollFile, FileName);
RESET(PayrollFile);
ASSIGN(NewFile, TempFile);
REWRITE(NewFile);
WRITE('Please enter the SSN of the employee to be deleted: ');
READLN(SSNumber);
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;
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);
WRITELN('The employee ', SSNumber, ' is removed from file.')
END;
{ ------------------ Procedure AddRec --------------------- }
PROCEDURE AddRec(VAR NewFile, PayrollFile:TEXT;
Employee: EmployeeRecord);
BEGIN
ASSIGN(PayrollFile, FileName);
RESET(PayrollFile);
ASSIGN(NewFile, TempFile);
REWRITE(NewFile);
{ Check for the end of the text file }
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
Found:= 0;
ASSIGN(PayrollFile, FileName);
RESET(PayrollFile);
ASSIGN(NewFile, TempFile);
REWRITE(NewFile);
WRITE('Please enter the SSN of the employee to be updated: ');
READLN(SSNumber);
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
ELSE
BEGIN
Found:= 1;
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 { End of WITH block }
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);
{ User Messages }
IF Found =1 THEN
WRITELN('The employee ', SSNumber, ' is updated.')
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.
Chapter 11
Drill 11-1
{ --------------------------- DRILL 11-1 ----------------------------- }
PROGRAM CreateEmployeeDataBase3(INPUT, OUTPUT, PayrollFile, NewFile);
{ This program is used to create a payroll TEXT file "PR.TXT" }
CONST
FileName = 'PR.TXT';
Header = '---------- Creating Payroll File ----------';
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;
EmployeePointer = ^EmployeeRecord;
VAR
PF:TEXT;
RecPointer :EmployeePointer;
Title :ARRAY [1..9] OF STRING[20];
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: ';
ASSIGN(PF, FileName);
REWRITE(PF);
WRITELN(Header);
WITH RecPointer^ DO
BEGIN
WRITE('Please enter Employee ID: '); READLN(ID);
WRITELN(PF,ID);
WRITE('Name: '); READLN(Name);
WRITELN(PF,Name);
WRITE('Position: '); READLN(Position);
WRITELN(PF,Position);
WRITE('SSN (xxx-xx-xxxx): '); READLN(SSN);
WRITELN(PF,SSN);
WRITE('Payroll category: '); READLN(Category);
CASE Category OF
'1': BEGIN
WRITE('Monthly Salary: ');
READLN(MonthlySalary);
WRITELN(PF,MonthlySalary)
END;
'2': BEGIN
WRITE('Hourly Rate: ');
READLN(HourlyRate);
WRITELN(PF,HourlyRate)
END;
'3': BEGIN
WRITE('Commission Rate: ');
READLN(Commission);
WRITELN(PF,Commission);
WRITE('Basic Salary: ');
READLN(BasicSalary);
WRITELN(PF,BasicSalary);
WRITE('Area: ');
READLN(Area);
WRITELN(PF,Area)
END
END
END;
CLOSE(PF);
WRITELN(Separator);
WRITELN('Payroll file has been created. Press any key');
READLN
END.
Drill 11-2
{ -------------------------- DRILL 11-2 ------------------------------ }
PROGRAM EmployeeDataBase2(INPUT, OUTPUT, PayrollFile, NewFile);
{ This program uses the employee data base file "payroll.txt" to process records using pointers. }
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];
EmployeePointer = ^EmployeeRecord;
VAR
NewFile, PayrollFile:TEXT;
EmployeeRec :EmployeePointer;
Title :ARRAY [1..9] OF STRING[20];
OneLine :STRING[80];
{ ----------------- Procedure SearchRec ------------------- }
PROCEDURE SearchRec(VAR PayrollFile:TEXT;
Employee:EmployeePointer;
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:EmployeePointer);
VAR
SSNumber :STRING[11];
Found :INTEGER;
BEGIN
WRITELN;
WRITE('Please enter the SSN of the employee: ');
READLN(SSNumber);
SearchRec(PayrollFile, Employee, 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:EmployeePointer);
VAR
SSNumber:STRING[11];
Found :INTEGER;
BEGIN
WRITE('Please enter the SSN of the employee to be deleted: ');
READLN(SSNumber);
SearchRec(PayrollFile, Employee, 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: EmployeePointer);
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:EmployeePointer);
VAR
SSNumber :STRING[11];
Found :INTEGER;
BEGIN
WRITE('Please enter the SSN of the employee to be updated: ');
READLN(SSNumber);
SearchRec(PayrollFile, Employee, 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.
Drill 11-3
{ -------------------------- DRILL 11-3 ------------------------------ }
PROGRAM LinkedListDemo(INPUT, OUTPUT, NamesFile);
{ This program initializes a linked list that stores strings. It
adds data to the list, displays its contents, and stores it in
the file "namelist.bin." It also reads the file and adds its
contents to the list }
CONST
FileName = 'namelist.bin';
Header = '------------- Main Menu --------------';
Separator = '--------------------------------------';
TYPE
DataString = STRING[30];
ListPointer = ^ListRecord;
ListRecord = RECORD
DataField :DataString;
NextField :ListPointer
END;
NamesFile = FILE OF DataString;
VAR
FirstPointer:ListPointer;
MyListFile :NamesFile;
{ ---------------- Procedure BuildList -------------------- }
PROCEDURE BuildList(VAR FirstPointer:ListPointer;
DataItem:DataString);
{Note: The FirstPointer is passed using the VAR keyword as
it will be updated by this procedure. }
VAR
ToolPointer:ListPointer;
BEGIN
NEW(ToolPointer);
ToolPointer^.DataField:= DataItem;
ToolPointer^.NextField:= FirstPointer;
FirstPointer:= ToolPointer
END;
{ ----------------- Procedure ReadList -------------------- }
PROCEDURE ReadList(FirstPointer:ListPointer);
VAR
CurrentPointer:ListPointer;
BEGIN
CurrentPointer:= FirstPointer;
WHILE CurrentPointer <> NIL DO
BEGIN
WRITELN(CurrentPointer^.DataField);
CurrentPointer:= CurrentPointer^.NextField
END;
WRITELN
END;
{ ----------------- Procedure GetData --------------------- }
PROCEDURE GetData(VAR FirstPointer:ListPointer);
VAR
Name:DataString;
BEGIN
WRITELN('Enter the names to add to the list,',
' when finished hit ENTER.');
{ Read the first data item }
READLN(Name);
{ Check for end-of-data }
WHILE LENGTH(Name) <> 0 DO
BEGIN
BuildList(FirstPointer, Name);
READLN(Name)
END
END;
{ ----------------- Procedure DisplayInfo ----------------- }
PROCEDURE DisplayInfo(FirstPointer:ListPointer);
BEGIN
WRITELN(Separator);
WRITELN('The contents of the list: ');
ReadList(FirstPointer);
WRITE('Hit any key to continue...');
READLN
END;
{ ---------------- Procedure SaveList --------------------- }
PROCEDURE SaveList(FirstPointer:ListPointer;
VAR MyListFile: NamesFile);
VAR
CurrentPointer:ListPointer;
BEGIN
ASSIGN(MyListFile, FileName);
REWRITE(MyListFile);
CurrentPointer:= FirstPointer;
WHILE CurrentPointer <> NIL DO
BEGIN
WRITE(MyListFile, CurrentPointer^.DataField);
CurrentPointer:= CurrentPointer^.NextField
END;
CLOSE(MyListFile)
END;
{ ----------------- Procedure ReadFile -------------------- }
PROCEDURE ReadFile(VAR FirstPointer:ListPointer;
VAR MyListFile: NamesFile);
VAR
Name :DataString;
BEGIN
ASSIGN(MyListFile, FileName);
RESET(MyListFile);
WHILE NOT EOF (MyListFile) DO
BEGIN
READ(MyListFile, Name);
BuildList(FirstPointer, Name);
END;
CLOSE(MyListFile)
END;
{ ------------------ Procedure Menu ----------------------- }
PROCEDURE Menu;
VAR
Option:INTEGER;
BEGIN
WRITELN(Header);
WRITELN('1. Add data from the keyboard.');
WRITELN('2. Display the list.');
WRITELN('3. Add data from file.');
WRITELN('4. Save the list to a file.');
WRITELN('5. Exit.');
WRITELN(Separator);
WRITE('Make a choice and press a number: ');
READLN(Option);
CASE Option OF
1: GetData(FirstPointer);
2: DisplayInfo(FirstPointer);
3: ReadFile(FirstPointer, MyListFile);
4: SaveList(FirstPointer, MyListFile);
5: Exit
END;
Menu
END;
{ --------------------- Main Program ---------------------- }
BEGIN
{ Initialize an empty List }
FirstPointer:= NIL;
menu
END.
Drill 11-4
{ --------------------- Procedure UpdateRec -------------------------- }
PROCEDURE UpdateRec(FirstPointer:ListPointer);
{ This procedure updates record information for a specific employee.
It calls the procedure "SearchList" to search the list using the
Social Security Number of the employee. The new information is
accepted from the user, otherwise a message "not found" is issued.}
VAR
CurrentPointer:ListPointer;
SSNumber :SSNstring;
Found :BOOLEAN;
BEGIN
Found:= FALSE;
WRITELN(Separator);
WRITE('Enter the SSN of the employee:'); READLN(SSNumber);
SearchList(FirstPointer, CurrentPointer,
SSNumber, Found);
IF NOT Found THEN
WRITELN('SSN: ', SSNumber, ' Not Found')
ELSE
WITH CurrentPointer^.DataField DO
BEGIN
WRITELN('Please enter the now information of',
' the employee (SSN: ', SSNumber,'):');
WRITE('ID: '); READLN(ID);
WRITE('Name: '); READLN(Name);
WRITE('Position: '); READLN(Position);
WRITE('Hourly Rate: '); READLN(Rate);
WRITELN('Record updated.')
END;
WRITE('Hit any key to continue...');
READLN
END;
|
