IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Помогите с сортировкой, plz
сообщение
Сообщение #1


Гость






Задание на запись.Создадь БД студентов, про каждого известно ФИО, пол, возр,средний балл.Отсортировать по возрасту.
написал, но пишет ошибку при попытке отсортировать, не могу устранить. помогите пожалуйста

Код
program lab_Zapisi;
uses crt;
const n=9;
type stud=record
  fio:string;
  srb:integer;
  age:integer;
  pol:char;
  end;
var f1:file of stud;
m,k,a:stud;
gruppa:array[1..n] of stud;
vid: byte;
flag: boolean;
i:integer;
name:string;

procedure file_name;{ima fila}
begin
write(' Vvedite ima fila ');
readln(name);
end;

procedure zapici; {sozdanie zapici}
begin
writeln(' zapici gryppi ',filepos(f1)+1);
with gruppa[i] do
  begin
   write(' Enter FIO ');  readln(fio);
  write(' Vozrast ');  readln(age);
  write(' Pol ');  readln(pol);
  write(' CPEDHUU BALL ');  readln(srb);
  write(f1,gruppa[i]);
  end;
end;

procedure dobavit_zapic;
var
i,p:integer;
begin
file_name;
assign(f1, name);
rewrite(f1);
writeln(' Sozdanie novoy zapisi ',name);
write(' Vvedite colichestvo zapisey ');
readln(p);
for i:=1 to p do
zapici;
writeln(' Dobavlenie novogo file ');
writeln(' File imeet ',filesize(f1),' zapicei ');
close(f1);
end;

procedure vivod;
begin
read(f1,gruppa[i]);
with gruppa[i] do
begin
  write(filepos(f1));
  writeln(' FIO ',fio,' Bo3PaCT ',age,' CPEDHUU BALL ', srb,' Pol ',pol);
  end;
end;

procedure vivod_zapicei;
begin
  file_name;
  assign(f1, name);
  {$I-}
  reset(f1);
  {$I+}
  if IOresult = 0 then
   begin
   seek(f1, 0);
   writeln(' Vivod zapicei ',name);
   while (not Eof(f1)) do
   vivod;
  close(f1);
end
  else
  writeln(' File s imenem ',name,' NET');
end;

procedure updaterec;
var
numrec: longint;
  begin
  file_name;
  assign(f1, name);
  {$I-}
  reset(f1);
  {$I+}
  if IOresult = 0 then
   begin
   write('N zapici');
   readln(numrec);
   seek(f1,numrec-1);
   writeln(' Staroe znachenie ');
   vivod;
   seek(f1,numrec-1);
   writeln(' Zadaem novoe znachenie ',numrec,' zapici ');
   zapici;
  close(f1);
end
else
  writeln('Faila s imenem ',name,' NET ');
end;

procedure zapic_end;
begin
file_name;
assign(f1, name);
{$I-}
reset(f1);
{$I+}
if IOresult = 0 then
begin
seek(f1, filesize(f1));
zapici;
writeln('Otkritiy file imeet ',filesize(f1),' zapisey ');
close(f1);
end
else
  writeln(' File s imenem ',name,' NET ');
end;

procedure findfio;
var
f: file of stud;
gruppa: stud;
maska: string;
flag: boolean;
countrec: integer;
  begin
  file_name;
  assign(f, name);
  {$I-}
  reset(f);
  {$I+}
  if IOresult = 0 then
   begin
   write('vvedite familiy dly poiska: ');
   readln(maska);
   flag:=false;
   countrec:=0;
   while (not Eof(f)) do
    begin
    read(f,gruppa);
    with gruppa do
    if pos(maska,fio) <> 0 then
      begin
      flag:=true;
      inc(countrec);
      writeln(' FIO ',fio,' Vozrast ',age,' sped ball ', srb,' Pol ',pol);
     end;
  end;
if flag then
  begin
  writeln(' Chislo zapisey s imenem ',maska,'=',countrec);
end
else
writeln(' File ne sodershit familii ',maska);
close(f);
end
else
writeln(' Fila s imenem ',name,' NET ');
end;

procedure sort_age;
var i:integer;
f1:file of stud;
k,m:stud;
flag:boolean;
  begin
  file_name;
  assign(f1,name);
  {$I-}
  reset(f1);
  {$I+}
  if IOresult = 0 then
   begin
   for i:=1 to filesize(f1) do begin
   seek(f1,i);
   read(f1,m);
   seek(f1,i+1);
   read(f1,k);
    repeat
    if m.age >k.age then begin
    a.age:=m.age;
    m.age:=k.age;
    k.age:=a.age;
    if i>1 then dec(i);
   end
  else inc(i);
   until i>=filesize(f1);
   for i:=1 to filesize(f1) do begin
   with gruppa[i] do
   write(' FIO ',fio,' Vozrast ',age,' srednii ball',srb ,' Pol ',pol);
  end;
end;
  close(f1);
  end
  else writeln(' Fila s imenem ',name,' NET ');
end;

Begin
textcolor(6);
flag:=false;
repeat

writeln(' 1. New file');
writeln(' 2. Prosmotr gruppi ');
writeln(' 3. Izmenenie zapisi');
writeln(' 4. Dobavlenie zapici');
writeln(' 5. Poik zapisi');
writeln(' 6. Sortirovka po Bo3PACTY');
writeln(' 0. Exit');
readln(vid);
case vid of
1: dobavit_zapic;
2: begin
   clrscr;

    vivod_zapicei;
   end;
3: updaterec;
4: zapic_end;
5: findfio;
6: begin
   sort_age;
   vivod;
   end;
0: flag:=true;
end;
writeln('Nagmite enter');
readln;
clrscr;
until flag;
END.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

Репутация: -  55  +


М
1. При размещении исходного кода программ необходимо пользоваться тегами!


Гости не могут редактировать сообщения, поэтому исправлю сама...
но на будущее....

2.
for i:=1 to filesize(f1) do begin {откуда? нумерация вообще-то идет с 0}
seek(f1,i);
read(f1,m);
seek(f1,i+1); {seek(f1,filesize(f1)+1) - это лихо..}
read(f1,k);


3.Что это за деятельность?
    a.age:=m.age;
m.age:=k.age;
k.age:=a.age;

то есть из Пети 17 лет и Виктора 93 лет получится Петя 93 лет и Виктор 17 лет. Зачем?
Тем более что в файл эти изменения не пойдут...


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 28.01.2021 8:46
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name