| Код |
program Project2;
{$APPTYPE CONSOLE}
type
employee = record
name : string[40];
hourly : real;
pay : real;
tax : real;
payYTD : real;
taxYTD : real;
filepos : longint;
end;
var
diskfile : file of employee;
single : employee;
counter : integer;
choice : char;
procedure newemployee;
begin
with single do begin
write('Enter name: ');
readln(name);
write('Enter hourly rate: ');
readln(hourly);
filepos := counter;
seek(diskfile,filepos);
write(diskfile,single);
end;
counter := counter + 1;
end;
procedure showone(disk : employee);
begin
if length(single.name) > 0 then
with disk do begin
writeln('Payrooll number: ',filepos);
writeln('Name: ',name);
writeln('Hourly rate: ',hourly:0:2);
writeln('Pay to date: ',payYTD:0:2);
writeln('Deduction to date: ',taxYTD:0:2);
end;
end;
procedure display;
var
loop : integer;
begin
for loop := 1 to counter-1 do
begin
seek(diskfile,loop);
read(diskfile,single);
showone(single);
end;
end;
procedure editrec;
var
target : longint;
begin
write('Worker number? ');
readln(target);
if (target>0) and (target<counter)
then begin
seek(diskfile,target);
read(diskfile,single);
showone(single);
write('Enter new hourly rate ');
readln(single.hourly);
seek(diskfile,target);
write(diskfile,single);
end;
end;
procedure deleterec;
var
target : longint;
reply : char;
begin
write('Record number? ');
readln(target);
if (target > 0 ) and (target < counter)
then begin
single.name := '';
seek(diskfile,target);
write(diskfile,single);
end;
end;
procedure payrun;
var
hours : real;
loop : integer;
begin
for loop := 1 to counter-1 do
begin
seek(diskfile,loop);
read(diskfile,single);
with single do begin
writeln('Hours worked by ',name);
readln(hours);
if hours <= 40
then pay := hours * hourly
else pay := 40 * hourly + ( hours - 40 ) * hourly * 1.5;
tax := pay * 0.25;
payYTD := payYTD + pay;
taxYTD := taxYTD + tax;
end;
seek(diskfile,loop);
write(diskfile,single);
end;
end;
procedure showpay;
var
loop : integer;
totpay,totax : real;
begin
totpay := 0;
totax := 0;
writeln('Payroll No. Name Gross Deduction Net');
for loop := 1 to counter-1 do
begin
seek(diskfile,loop);
read(diskfile,single);
if length(single.name) > 0 then
with single do begin
writeln(filepos:12,name:12,pay:10:2,tax:10:2,pay-tax:8:2);
totpay := totpay + pay;
totax := totax + tax;
end;
end;
writeln('Totals':24,totpay:8:2,totax:8:2,totpay-totax:8:2);
end;
procedure wageslip;
var
loop : integer;
output : text;
net : real;
begin
assign(output,'pringout.prn');
rewrite(output);
for loop := 1 to counter-1 do
begin
seek(diskfile,loop);
read(diskfile,single);
writeln(output,'Payroll No. Name Gross Deduction NET ');
net:= single.pay - single.tax;
with single do
writeln(output,filepos:12,name:12,pay:10:2,tax:10:2,net:10:2,payYTD:10:2,taxYTD:10:2);
writeln(output);
writeln(output);
end;
close(output);
end;
procedure closefile;
begin
single.filepos := counter;
seek(diskfile,0);
write(diskfile,single);
close(diskfile);
end;
begin
assign(diskfile,'employee.dat');
rewrite(diskfile);
counter:= single.filepos;
counter := 1;
writeln('Payroll');
repeat
writeln('New employee...........1');
writeln('Display all............2');
writeln('Search for employee....3');
writeln('Edit an hourly rate....4');
writeln('Delete an entry........5');
writeln('Weekly pay.............6');
writeln('Display pay and totals.7');
writeln('Print wage slips.......8');
writeln('Exit...................9');
readln(choice);
case choice of
'1' : newemployee;
'2' : display;
'4' : editrec;
'5' : deleterec;
'6' : payrun;
'7' : showpay;
'8' : wageslip;
'9' : closefile;
end;
until choice = '9';
end.
|
Вот такая прога..
Прога все исправно сохраняет в фаил но вот когда я закрою прогу и второй раз открою она стерает все содержимое employee.dat .. 
( программа для Delphi 7 консольной аппликации ( без .NET ) )
Заранее благодарен !  |
