Версия для печати темы

Program vacant_F;
uses wincrt, windos;
Const n=20; n_max=10;
type vac=record
   Org:String[40];
   Dist:Longint;
   Dolgn:string[20];
   Razr:integer;
   stag:integer;
   zarpl:longint;
   strah:String[3];
      end;
type arrvac = array[1 .. n] of vac;
var
Fz: File of vac;
  a: arrvac;
    rec_fz:vac;
    s:string;
    i:integer;
    f:boolean;
PROCEDURE menu;
          const str1='1-Создание файла';
                str2='2-Вывод содержимого файла на экран';
                str3='3-Обработка файла';
                str4='4-Выход';
Begin
     ClrScr; GotoXY(20,3);
     Writeln('Выполняемые действия:');
     GotoXY(1,6);
     Writeln(Str1);
     Writeln(Str2);
     Writeln(Str3);
     Writeln(Str4);
End;
Procedure Operation(var m:byte);
         var F:boolean;
Begin
     Writeln;
     Repeat GotoXY(1,17);ClrEol;GotoXY(1,17);
     write('Выберите требуемое действие'); Readln(m);
     F:=(M=1) or (M=2) or (M=3) or (M=4);
     if not F then
        begin
        GotoXY(1,19);
        Writeln('Вы ошиблись, попробуйте ещё раз');
        end;
     Until F;GotoXY(1,19);ClrEol;Writeln;
end;
procedure new(n:integer; var a:arrvac; var file_name:string);
 begin
 ClrScr;
     Write('Введите имя созданного файла');Readln(file_name);
     Assign(Fz,File_name);
     ReWrite(fz);
     with rec_fz do
     while true do
     begin
      Write('Введите наименование организации  ');
      Readln(a[i].Org);
      if (a[i].Org='яяя') or (a[i].Org='ЯЯЯ') then begin
      Close(Fz); Exit
      end;
      Write('Введите расстояние от центра города  ');
      Readln(a[i].Dist);
      Write('Введите наименование должности  ');
      Readln(a[i].Dolgn);
      Write('Введите разряд(квалификацию)  ');
      Readln(a[i].Razr);
      Write('Введите стаж работы  ');
      Readln(a[i].Stag);
      Write('Введите зарплату  ');
      Readln(a[i].Zarpl);
      Write('Введите наличие страховки("да" или "нет")  ');
      Readln(a[i].Strah);
      write(fz,a[i]);
      end;
      close(fz);
     end;
Procedure Vivod(N:integer; a:arrvac; F_in:Boolean; File_name:string);
          Type Mes=Record
          O:String[40];
          D:Longint;
          Dl:String[20];
          R:integer;
          S:integer;
          Z:Longint;
          Str:String[3];
          end;
          Var K,L:Integer;
          Mst:Mes;
Begin
clrScr;
if not F_in then
repeat
write('Введите имя выводимого файла');readln(file_name);
Assign(fz,File_name);
ReSet(fz);
Until (ioResult=0) or (file_name='ZZZ');
if File_name='ZZZ' then Exit;
Writeln('  СОДЕРЖИМОЕ ФАЙЛА',file_name:12);
with Rec_fz do
while not (Eof(Fz)) do
begin
 with a[i] do
 Writeln(Org,'. ',Dist,' км. ',Dolgn,',',Razr,'разряд, стаж - ',Stag,' зарплата - ',Zarpl,' руб., страховка - ',Strah);
end;
Close(fz);
end;
Procedure Work(F_in:boolean;N:integer; a:arrvac; file_name:string);
          Var
          Dl:string[20];
          j:Integer;
          buf:vac;
Begin {упорядочивание по алфавиту}
     clrscr;
if not F_in then
repeat
Write('Введите имя обрабатываемого файла  '); Readln(file_name);
Assign(fz,File_name);
ReSet(fz);
Until (ioResult=0) or (file_name='ZZZ');
if File_name='ZZZ' then Exit;
     for i:=1 to n-1 do
         for j:=i+1 to n do if a[i].dolgn>a[j].dolgn then
             begin 
                  buf:=a[i]; 
                  a[i]:=a[j]; 
                  a[j]:=buf;
             For i:=1 to N do
      with Rec_fz do
     While not (Eof(fz)) do
Writeln(Org,'. ',Dist,' км. ',Dolgn,',',Razr,'разряд, стаж - ',Stag,' зарплата - ',Zarpl,' руб., страховка - ',Strah);
end;
Close(fz);
end;
 procedure povtorka(var f: boolean);
 var x: char;
 begin  REPEAT ClrEol; writeln('Хотите повторить? Y или N?(н или д)'); readln(x);
 f:=(x='y')or(x='n')or(x='н')or(x='д');
 if not f then
    begin writeln('Вы ошиблись. Повторите ввод');
    end;
 UNTIL f;
 if (x='y') or (x='Y') or (x='Д') or (x='д') then f:=true else begin F:=false; donewincrt;
 end;
 end;
Procedure Realiz(m:byte; file_name:string; f_in:boolean);
   Begin
        case M of
        1: Begin new(N,a,file_name); end;
        2: Begin Vivod(N,a,F_in,File_name);end;
        3: Begin Work(F_in,N,a,File_name);end;
        4: begin write('Выход-ENTER'); readln;
donewincrt; end;
        end;
end;
var m:byte;file_name:string;F_in:boolean;
Begin
    repeat Menu;
    Operation(M);
    Realiz(m,file_name,F_In);
    povtorka(f);
    until f=false;
end.