Файловый архив студентов. Файловый архив студентов.
1327 вузов, 5495 предметов.
/ Регистрация
FAQ Обратная связь Вопросы и предложения
Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Пермский национальный исследовательский политехнический университет
Предмет:
Информатика
Файл:

TP / 10 / 10-51

.PAS
Скачиваний:
33
Добавлен:
10.12.2013
Размер:
9 Кб
Скачать
☆ 
program Lab10;

uses Crt;

const
  BD = 'BD.dat';
  L = 18;      { „«Ё­  ⥪бв®ў®Ј® Ї®«п  }

type
  Pupil = Record
    Class, Angl, Mat, Inf: Byte;
    FIO, Data, Addr, Tel: String[L];
  end;

var
  Index: Longint;
  f: file of Pupil;

procedure Ekran(str:String);
begin
  ClrScr;
  GotoXY(32,1);
  Write(str);
  WriteLn;
  WriteLn;
end;

procedure Menu;
begin
  Ekran('‹ Ў®а в®а­ п 10');
  WriteLn('1 - Џа®б¬®ва');
  WriteLn('2 - „®Ў ўЁвм');
  WriteLn('3 - €§¬Ґ­Ёвм');
  WriteLn('4 - “¤ «Ёвм');
  WriteLn('5 - Џ®ЁбЄ');
  WriteLn('6 - ‘®авЁа®ўЄ ');
  WriteLn('Esc - ‚л室');
end;

procedure PMenu;
begin
  WriteLn('1 - ”€Ћ');
  WriteLn('2 - „ в  ஦¤Ґ­Ёп');
  WriteLn('3 - Ђ¤аҐб');
  WriteLn('4 - ’Ґ«Ґд®­');
  WriteLn('5 - Љ« бб');
  WriteLn('6 - Ђ­Ј«Ё©бЄЁ©');
  WriteLn('7 - Њ вҐ¬ вЁЄ ');
  WriteLn('8 - €­д®а¬ вЁЄ ');
  WriteLn;
end;

procedure Title;
begin
  WriteLn('” ¬Ё«Ёп €¬п ЋвзҐбвў®':L,'„ в  ஦¤Ґ­Ёп':L,'Ђ¤аҐб':L,'’Ґ«Ґд®­':L);
  WriteLn('Љ« бб':L,'Ђ­Ј«Ё©бЄЁ©':L,'Њ вҐ¬ вЁЄ ':L,'€­д®а¬ вЁЄ ':L);
  WriteLn;
end;

procedure Prosmotr;
var
  w: Pupil;
  i: Byte;
begin
  reset(f);
  Ekran('Џа®б¬®ва');
  Title;
  for i:=1 to Index do begin
    Read(f,w);
    if w.Class > 0 then
      with w do begin
        WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
        WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
      end;
    end;
  close(f);
  ReadLn;
end;

procedure Dobavlenie;
var
  w: Pupil;
begin
  repeat
    reset(f);
    Seek(f,Index);
    Ekran('„®Ў ў«Ґ­ЁҐ');
    with w do begin
      Inc(Index); WriteLn(Index);
      Write('”€Ћ: '); ReadLn(FIO);
      Write('„ в  ஦¤Ґ­Ёп: '); ReadLn(Data);
      Write('Ђ¤аҐб: '); ReadLn(Addr);
      Write('’Ґ«Ґд®­: '); ReadLn(Tel);
      Write('Љ« бб: '); ReadLn(Class);
      Write('Ђ­Ј«Ё©бЄЁ©: '); ReadLn(Angl);
      Write('Њ вҐ¬ вЁЄ : '); ReadLn(Mat);
      Write('€­д®а¬ вЁЄ : '); ReadLn(Inf);
    end;
    Write(f,w);
    close(f);
    WriteLn;
    WriteLn('Esc - ¬Ґ­о');
  until ReadKey = #27;
end;

procedure Redact;
var
  w: Pupil;
  i: Longint;
begin
  repeat
    reset(f);
    Ekran('ђҐ¤ ЄвЁа®ў ­ЁҐ');
    Write('Ќ®¬Ґа иЄ®«м­ЁЄ : ');
    ReadLn(i);
    if not (i <= Index) and (i >= 1) then begin
      WriteLn('Ќ®¬Ґа ¤®«¦Ґ­ Ўлвм: 1..',Index);
      ReadLn;
      break;
    end
    else with w do begin
      Write('”€Ћ: '); ReadLn(FIO);
      Write('„ в  ஦¤Ґ­Ёп: '); ReadLn(Data);
      Write('Ђ¤аҐб: '); ReadLn(Addr);
      Write('’Ґ«Ґд®­: '); ReadLn(Tel);
      Write('Љ« бб: '); ReadLn(Class);
      Write('Ђ­Ј«Ё©бЄЁ©: '); ReadLn(Angl);
      Write('Њ вҐ¬ вЁЄ : '); ReadLn(Mat);
      Write('€­д®а¬ вЁЄ : '); ReadLn(Inf);
      Seek(f,i-1); Write(f,w);
    end;
    close(f);
    WriteLn;
    WriteLn('Esc - ¬Ґ­о');
  until ReadKey = #27;
end;

procedure Udalenie;
var
  i,n: Longint;
  w: Pupil;
begin
  repeat
    WriteLn;
    WriteLn('O - “¤ «Ёвм ®¤­г § ЇЁбм');
    WriteLn('A - “¤ «Ёвм ўбҐ § ЇЁбЁ');
    WriteLn;
    case UpCase(ReadKey) of
    'O': begin
      Write('Ќ®¬Ґа иЄ®«м­ЁЄ : ');
      ReadLn(n);
      if not (n <= Index) and (n >= 1) then begin
        WriteLn('Ќ®¬Ґа ¤®«¦Ґ­ Ўлвм: 1..',Index);
        ReadLn;
        break;
      end
      else begin
        reset(f);
        for i:= n to Index-1 do begin
          Seek(f,i); Read(f,w);
          Seek(f,i-1); Write(f,w);
        end;
        Seek(f,FileSize(f)-1);
        TruncAte(f);
        Dec(Index);
        close(f);
        WriteLn('„ ­­лҐ г¤ «Ґ­л');
      end;
    end;
    'A': begin
      erase(f);
      rewrite(f);
      close(f);
      Index:= 0;
      WriteLn('‚ᥠ¤ ­­лҐ г¤ «Ґ­л');
    end;
    end;
    WriteLn;
    WriteLn('Esc - ¬Ґ­о');
  until ReadKey = #27;
end;

procedure Poisk;
var
  i: Longint;
  ws,w: Pupil;
begin
  repeat
    reset(f);
    Ekran('Џ®ЁбЄ');
    PMenu;
    Case ReadKey of
    '1': begin
      Write('”€Ћ: '); ReadLn(ws.FIO);
      Title;
      for i:=1 to Index do With w do begin
        Read(f,w);
        if Pos(ws.FIO,FIO) > 0 then begin
          WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
          WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
        end;
      end;
    end;
    '2': begin
      Write('„ в  ஦¤Ґ­Ёп: '); ReadLn(ws.Data);
      Title;
      for i:=1 to Index do with w do begin
        Read(f,w);
        if Pos(ws.Data,Data) > 0 then begin
          WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
          WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
        end;
      end;
    end;
    '3': begin
      Write('Ђ¤аҐб: '); ReadLn(ws.Addr);
      Title;
      for i:=1 to Index do with w do begin
        Read(f,w);
        if Pos(ws.Addr,Addr) > 0 then begin
          WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
          WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
        end;
      end;
    end;
    '4': begin
      Write('’Ґ«Ґд®­: '); ReadLn(ws.Tel);
      Title;
      for i:=1 to Index do with w do begin
        Read(f,w);
        if Pos(ws.Tel,Tel) > 0 then begin
          WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
          WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
        end;
      end;
    end;
    '5': begin
      Write('Љ« бб: '); ReadLn(ws.Class);
      Title;
      for i:=1 to Index do with w do begin
        Read(f,w);
        if ws.Class = Class then begin
          WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
          WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
        end;
      end;
    end;
    '6': begin
      Write('Ђ­Ј«Ё©бЄЁ© '); ReadLn(ws.Angl);
      Title;
      for i:=1 to Index do with w do begin
        Read(f,w);
        if ws.Angl = Angl then begin
          WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
          WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
        end;
      end;
    end;
    '7': begin
      Write('Њ вҐ¬ вЁЄ  '); ReadLn(ws.Mat);
      Title;
      for i:=1 to Index do with w do begin
        Read(f,w);
        if ws.Mat = Mat then begin
          WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
          WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
        end;
      end;
    end;
    '8': begin
      Write('€­д®а¬ вЁЄ  '); ReadLn(ws.Inf);
      Title;
      for i:=1 to Index do with w do begin
        Read(f,w);
        if ws.Inf = Inf then begin
          WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
          WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
        end;
      end;
    end;
    end;
    close(f);
    WriteLn;
    WriteLn('Esc - ¬Ґ­о');
  until ReadKey = #27;
end;

function Direct(C: Boolean; D: Char): Boolean;
begin
  if D = '+' then Direct:= C else Direct:= not C;
end;

procedure Sortirovka;
var
  Ch,D: Char;
  Comp: Boolean;
  i,j,Nt: Longint;
  w1,w2,t: Pupil;
begin
  repeat
    Ekran('‘®авЁа®ўЄ ');
    PMenu;
    Ch:= ReadKey;
    Case Ch of
      '1': WriteLn('”€Ћ');
      '2': WriteLn('„ в  ஦¤Ґ­Ёп');
      '3': WriteLn('Ђ¤аҐб');
      '4': WriteLn('’Ґ«Ґд®­');
      '5': WriteLn('Љ« бб');
      '6': WriteLn('Ђ­Ј«Ё©бЄЁ©');
      '7': WriteLn('Њ вҐ¬ вЁЄ ');
      '8': WriteLn('€­д®а¬ вЁЄ ');
    end;
    Write('Ќ Їа ў«Ґ­ЁҐ (+,-): '); ReadLn(D);
    reset(f);
    for i:=0 to Index-2 do begin
      Seek(f,i); Read(f,w1);
      t:= w1; Nt:= i;
      {******************************************************}
      for j:=i to Index-1 do begin
        Seek(f,j); Read(f,w2);
        Case Ch of
          '1': Comp:= Direct(w2.FIO < w1.FIO, D);
          '2': Comp:= Direct(w2.Data < w1.Data, D);
          '3': Comp:= Direct(w2.Addr < w1.Addr, D);
          '4': Comp:= Direct(w2.Tel < w1.Tel, D);
          '5': Comp:= Direct(w2.Class < w1.Class, D);
          '6': Comp:= Direct(w2.Angl < w1.Angl, D);
          '7': Comp:= Direct(w2.Mat < w1.Mat, D);
          '8': Comp:= Direct(w2.Inf < w1.Inf, D);
        end;
        if Comp then begin
          t:= w2;
          Nt:= j;
        end;
      end;
      {******************************************************}
      Case Ch of
        '1': Comp:= Direct(t.FIO < w1.FIO, D);
        '2': Comp:= Direct(t.Data < w1.Data, D);
        '3': Comp:= Direct(t.Addr < w1.Addr, D);
        '4': Comp:= Direct(t.Tel < w1.Tel, D);
        '5': Comp:= Direct(t.Class < w1.Class, D);
        '6': Comp:= Direct(t.Angl < w1.Angl, D);
        '7': Comp:= Direct(t.Mat < w1.Mat, D);
        '8': Comp:= Direct(t.Inf < w1.Inf, D);
      end;
      if Comp then begin
        Seek(f,i); Write(f,t);
        Seek(f,Nt); Write(f,w1);
      end;
    end;
    close(f);
    Prosmotr;
    WriteLn;
    WriteLn('Esc - ¬Ґ­о');
  until ReadKey = #27;
end;

begin
  assign(f,BD);
  {$I-}
  reset(f);
  {$I+}
  if IOResult<>0 then rewrite(f);
  Index:= FileSize(f);
  close(f);
  repeat
    Menu;
    case ReadKey of
      '1': Prosmotr;
      '2': Dobavlenie;
      '3': Redact;
      '4': Udalenie;
      '5': Poisk;
      '6': Sortirovka;
      #27: exit;
    end;
  until False
end.
Соседние файлы в папке 10
Помощь Обратная связь Вопросы и предложения Пользовательское соглашение Политика конфиденциальности