Регистрация участников конференции - Pascal - Ответ 263460

uses crt;
const
nmax=100;
fname:string[10]='uchas.dat';
type
str=string[14];
date=record
     d:1..31;
     m:1..12;
     g:2009..2100;
     end;
uchas=record
      fio:str;
      gor:str;
      org:str;
      dlz:str;
      ubt:date;
      end;
fail=file of uchas;
procedure Tabl;
begin
writeln;
writeln('----------------------------------------------------------------------------');
writeln('| Фамилия И.О. |    Город     | Организация  |  Должность   | Дата убытия  |');
writeln('----------------------------------------------------------------------------');
end;
procedure Add(var uc:uchas;var f:fail);
var i,k:byte;
    x:uchas;
begin
assign(f,fname);
{$I-}reset(f);{$I+}
if IOResult<>0 then rewrite(f);
if filesize(f)>=nmax then
 begin
  writeln('Все участники зарегистрированы!');
  readln;
  exit;
 end;
writeln('Введите данные об участнике:');
with uc do
 begin
  repeat //пока строка пустая, не даст вводить дальше
  write('Фамилия И.О.: ');readln(fio);
  until fio<>'';
  repeat
  write('Город: ');readln(gor);
  until gor<>'';
  repeat
  write('Организация.: ');readln(org);
  until org<>'';
  repeat
  write('Должность: ');readln(dlz);
  until dlz<>'';
  repeat
   k:=0;
   writeln('Введите дату убытия:');
   write('Год: ');readln(uc.ubt.g);
   if (uc.ubt.g<>2009)and(uc.ubt.g<>2010) then k:=1;
   write('Месяц: ');readln(uc.ubt.m);
   if not (uc.ubt.m in [1..12])then k:=1;
   write('День: ');readln(uc.ubt.d);
   if((uc.ubt.m in [1,3,5,7,8,10,12])and not(uc.ubt.d in [1..31]))
   or((uc.ubt.m in [4,6,9,11])and not(uc.ubt.d in [1..30]))
   or((uc.ubt.m=2)and not(uc.ubt.d in [1..28])) then
    begin
     writeln('Дата введена неверно!. Повторите ввод.');
     k:=1;
    end;
  until k=0;
 end;
if filesize(f)=0 then write(f,uc)
else
 begin
   i:=0;
   while not eof(f) do
    begin
     read(f,x);
     if x.fio>=uc.fio then
      begin
       k:=i;
       break;
      end
     else i:=i+1;
     if i=filesize(f)-1 then k:=i+1;
    end;
   close(f);
   reset(f);
   for i:=filesize(f) downto k+1 do
    begin
     seek(f,i-1);
     read(f,x);
     seek(f,i);
     write(f,x);
    end;
   seek(f,k);
   write(f,uc);
   close(f);
  end;
end;
procedure ReadFile(var f:fail;var uc:uchas);
begin
clrscr;
writeln('Полный список зарегистрированных участнтков':55);
writeln;
Tabl;
assign(f,fname);
reset(f);
while not eof(f)do
 begin
  read(f,uc);
  gotoXY(1,whereY);
  write('| ',uc.fio);
  gotoXY(16,whereY);
  write('| ',uc.gor);
  gotoXY(31,whereY);
  write('| ',uc.org);
  gotoXY(46,whereY);
  write('| ',uc.dlz);
  gotoXY(61,whereY);
  write('| ');
  if uc.ubt.d<10 then write('0',uc.ubt.d,'.')else write(uc.ubt.d,'.');
  if uc.ubt.m<10 then write('0',uc.ubt.m)else write(uc.ubt.m);
  gotoXY(76,whereY);
  writeln('|');
 end;
writeln('---------------------------------------------------------------------------|');
readln;
close(f);
end;
 
function Convert(s:string):string;//функция переводит в верхний регистр все буквы и убирает ведущие и ведомые пробелы
var i,k:byte;
    st:string;
begin
st:=s;//введем дополнительно строку, чтоб не калечить исходную
for i:=1 to length(s) do
 if st[i] in ['a'..'z'] then st[i]:=UpCase(st[i])//английские
 else if st[i] in ['а'..'п'] then st[i]:=chr(ord(st[i])-32)//русские
 else if st[i] in ['р'..'я'] then st[i]:=chr(ord(st[i])-80)
 else if st[i]='ё' then st[i]:='Ё';
while st[1]=' 'do delete(st,1,1);//пробелы в начале
while st[length(st)]=' ' do delete(st,length(st),1);//пробелы в конце
Convert:=st;
end;
 
procedure WriteGor(var f:fail;var uc:uchas;gr:str);
var k:byte;
begin
assign(f,fname);
reset(f);
write('Введите город: ');
readln(gr);
clrscr;
writeln('Список участников из г.':45,gr);
k:=0;
writeln;
Tabl;
while not eof(f) do
 begin
  read(f,uc);
  if Convert(uc.gor)=Convert(gr)//если конвертированные клоны строк равны
   then
   begin
    k:=1;
    gotoXY(1,whereY);
    write('| ',uc.fio);
    gotoXY(16,whereY);
    write('| ',uc.gor);
    gotoXY(31,whereY);
    write('| ',uc.org);
    gotoXY(46,whereY);
    write('| ',uc.dlz);
    gotoXY(61,whereY);
    write('| ');
    if uc.ubt.d<10 then write('0',uc.ubt.d,'.')else write(uc.ubt.d,'.');
    if uc.ubt.m<10 then write('0',uc.ubt.m)else write(uc.ubt.m);
    gotoXY(76,whereY);
    writeln('| ');
   end;
 end;
writeln('---------------------------------------------------------------------------|');
if k=0 then writeln('Прибывших нет!');
readln;
close(f);
end;
var uc:uchas;
    f:fail;
    i:byte;
    c:char;
    gr:str;
begin
clrscr;
repeat
clrscr;
writeln('Выберите действие 1-зарегистрировать 2-вывести данные 3-вывести данные по городу');
c:=readkey;;
case c of
'1':Add(uc,f);
'2':ReadFile(f,uc);
'3':WriteGor(f,uc,gr);
else exit;
end;
until not (c in ['1'..'3']);
end.