VPF::Файлы..Рекорды... Вобщем нужна помощь

Insight

Дата 14.4.2006, 18:53 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 5.2.2006

Репутация: нет
Всего: 1

Код


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 .. smile

( программа для Delphi 7 консольной аппликации ( без .NET ) )

Заранее благодарен ! smile

darkart

Дата 14.4.2006, 23:04 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 379
Регистрация: 9.11.2005

Репутация: нет
Всего: 31

Код


rewrite(diskfile);{ - открытие для перезаписи.}

Цитата

Процедура ReWrite создает новый внешний файл с именем назначенным в переменной F. Если внешний файл с тем же именем уже существует, то он удаляется, а на его месте создается новый пустой файл. Если F уже открыт, то он сначала закрывается, а затем вновь создается. Текущая позиция устанавливается на начало пустого файла.

Используй

Код


reset(diskfile);

Это сообщение отредактировал(а) darkart - 15.4.2006, 08:16

APAL

Дата 15.4.2006, 00:05 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 3
Регистрация: 6.4.2006

Репутация: нет
Всего: нет

Цитата

restet(diskfile);

правильнее: reset(diskfile);

А еще желательно перед этим проверить наличие самого файла и если его нет, то создать уже через ReWrite .

darkart

Дата 15.4.2006, 08:16 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 379
Регистрация: 9.11.2005

Репутация: нет
Всего: 31

Цитата(APAL @ 15.4.2006, 01:05

)

правильнее: reset(diskfile);

Исправил

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »