Паскаль, файлы

[Ильгиза]

Паскаль, файлы

Здравствуйте! Помогите пожалуйста. найти ошибку в программе!
Необходимо написать два файла, в первый информацию о жильца дома( фио,номер кв.,этаж,количество комнат,площадь), во второй файл записать всю информацию о трех и четырех комнатных квартирах и подсчитать их количество.


Решила так, но где то есть ошибка. Помогите разобраться!!!
program upr1;
const n=2;
type home=record;
nom,pl,k,i:integer;
end;
pupil=record;
fam,name,ot:string[15];
inf:home;
end;

procedure p1(var aupil);
begin
with a do
begin
write('фамилия:');
readln(fam);
write('имя:');
readln(name);
write('отчество:');
readln(ot);
write('номер квартиры:');
readln(inf.nom);
write('площадь квартиры:');
readln(inf.pl);
write('количество комнат:');
readln(inf.k);
write('этаж:');
readln(inf.i);
end;
end;
procedure p2( aupil);
begin
with a do
begin
write(fam,'':15-length(fam));
write(name,'':10-length(name));
write(ot,'':10-length(ot));
with inf do
writeln(nom:4,pl:4,k:4,i:6);
end;
end;
var mas:array[1..n] of pupil;
i,k:integer;
F: File Of pupil;
S: pupil;
Begin
Assign(F,'komnata.dat'); Rewrite(f);
writeln('введите информацию об ',n,' жильцах');
for i:=1 to n do begin
p1(mas);
end;
writeln('список жильцов');
writeln(' n ф и о №кв.пл. кол.к. этаж');
for i:=1 to n do begin write(i:2,'.');
p2(mas);
write(f,s);
end;
write('файл записан');
close(f);
end.





program upr2;
const n=2;
type home=record;
nom,pl,k,i:integer;
end;
pupil=record;
fam,name,ot:string[15];
inf:home;
end;
var f,f2: file of pupil;
supil;
i,l:byte;
begin
l:=0;
assign(f,'komnata.dat');
reset(f);
assign(f2,'file1.dat');
rewrite(f2);
writeln('информация о 3-х или 4-х комнатной квартире');
while not eof(f) do begin
read(f,s);
for i:=1 to n do
if (s.inf.k=3) or (s.inf.k=4)
then begin write(f2,s);
l:=l+1 ;
end;
close(f);
close(f2);
writeln('количество таких квартир:',l);
end;
end.

 

[Vladimir_S]

Дорогая Ильгиза, не обижайтесь, но я в полном ужасе от Вашего творчества. Вы не пробовали задать себе вопрос, чем отличается компьютерная программа от, например, любовного письма? Так я Вам объясню: если в последнем допустимы недомолвки, иносказания, милые оговорки и прочее, то первая требует предельной строгости и абсолютной точности. Вот что это такое: (var aupil)? Что еще за aupil? Откуда взялся? Да, путем анализа текста, я-то могу догадаться, что подразумевается (var aupil). И Вы полагаете, что транслятор, даже этот идиотский АВС, тоже "сообразит"? И не надейтесь!!! Потом - ну зачем же использовать одинаковые идентификаторы i, k как переменные цикла и как поля записи? Ни к чему, кроме путаницы и ошибок, такой подход не приведет, уж поверьте.
И это еще далеко не всё.
Ладно, попробую из этого сделать что-то путное.

 

[Vladimir_S]

Ну вот, например, так:

program upr1;
const
 n=7;
type
 home=record
       nom,pl,nk,et:integer;
      end;
 pupil=record
        fam,name,ot:string[15];
        inf:home;
       end;

var
 mas:array[1..n] of pupil;
 i,k:integer;
 F,F1: File of pupil;

procedure p1(var a:pupil);
begin
 with a do
  begin
   write('Фамилия: ');
   readln(fam);
   write('Имя: ');
   readln(name);
   write('Отчество: ');
   readln(ot);
   write('Номер квартиры: ');
   readln(inf.nom);
   write('Площадь квартиры: ');
   readln(inf.pl);
   write('Количество комнат: ');
   readln(inf.nk);
   write('Этаж: ');
   readln(inf.et);
  end;
end;

procedure p2(a:pupil);
begin
 with a do
  begin
   write(fam,'':15-length(fam));
   write(name,'':10-length(name));
   write(ot,'':10-length(ot));
   with inf do
    writeln(nom:8,pl:8,nk:8,et:8);
  end;
end;

Begin
 Assign(F,'komnata.dat');
 Rewrite(f);
 writeln('Введите информацию о ',n,' жильцах');
 for i:=1 to n do
  begin
   p1(mas[i]);
  end;
 writeln('Список жильцов:');
 writeln(' n     Ф            И         О             Nкв.     пл.   кол.к.   этаж');
 for i:=1 to n do
  begin
   write(i:2,'. ');
   p2(mas[i]);
   write(f,mas[i]);
  end;
 write('Файл записан');
 close(f);
 readln
end.

program upr2;
const
 n=7;
type
 home=record
       nom,pl,nk,et:integer;
      end;
 pupil=record
        fam,name,ot:string[15];
        inf:home;
       end;
var
 f,f2: file of pupil;
 s:pupil;
 i,l,fl_n:Integer;
 Nmb:Set of Byte;

begin
 Nmb:=[];
 l:=0;
 assign(f,'komnata.dat');
 reset(f);
 assign(f2,'file1.dat');
 rewrite(f2);
 writeln('Информация о 3-х и 4-х комнатных квартирах:');
 while not eof(f) do
  begin
   read(f,s);
   if (s.inf.nk=3) or (s.inf.nk=4) then
    begin
     write(f2,s);
     l:=l+1 ;
    end;
  end;
 close(f);
 close(f2);
 writeln('Количество таких квартир: ',l);
 writeln('    Ф            И         О             Nкв.     пл.   кол.к.   этаж');
 for i:=1 to l do
  begin
   reset(f2);
   while not eof(f2) do
    begin
     read(f2,s);
     if not(s.inf.nom in Nmb) then
      begin
       fl_n:=s.inf.nom;
       reset(f2);
       repeat
        read(f2,s);
        if s.inf.nom=fl_n then
         with s do
          begin
           write(fam,'':15-length(fam));
           write(name,'':10-length(name));
           write(ot,'':10-length(ot));
           with inf do
            writeln(nom:8,pl:8,nk:8,et:8);
          end;
        until eof(f2);
       Nmb:=Nmb+[fl_n];
      end;
    end;
   close(f2);
  end;
 readln
end.

 

[Ильгиза]

Спасибо Вам огромное!!!

 

[Vladimir_S]

Спасибо Вам огромное!!!

Ну Вы запустите, погоняйте. С этим Вашим АВС еще любые сюрпризы возможны. Я ведь отлаживал на Free.