Прога на файлы Опции

[Юра]

Помогите написать прогу

Создать файл из сведений об абонентах телефонного узла. Формат сведений: фамилия, имя, отчество, адрес, номер счета. Обеспечить вывод из файла только последовательностей абонентов на запрашиваемую букву. После выбора конкретной фамилии должны выводиться все сведения об абоненте. Необходимо обеспечить редактирование , удаление, дополнение сведений . Все изменения должны заноситься в файл.

[Гость]

ПОЧТИ ТОЖЕ САМОЕ, ПРИКОЛИСТ

Код

program Project4;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  M=30;

type
  str=string[50];
  spr=record
      name:str;
      family:str;
      tel1:str;
      tel2:str;
      end;
  mas=array[1..M] of spr;

procedure num2(var f:text; var t:mas; var k:integer);
var
  abon:spr;
  S:str;
  i:integer;
begin
  for i:=1 to M do
  begin
    t[i].family:=' ';
    t[i].name:=' ';
    t[i].tel1:=' ';
    t[i].tel2:=' ';
  end;
  reset(f);
  k:=0;
  while not seekeof(f) do
  begin
    readln(f,S);
    S:=S+' ';
    i:=pos(' ',S);
    abon.family:=copy(S,1,i-1);
    delete(S,1,i);
    i:=pos(' ',S);
    abon.name:=copy(S,1,i-1);
    delete(S,i,1);
    i:=pos(' ',S);
    abon.tel1:=copy(S,1,i-1);
    delete(S,1,i);
    i:=pos(' ',S);
    abon.tel2:=copy(S,1,i-1);
    k:=k+1;
    t[k]:=abon;
  end;
  close(f);
end;

procedure num1(var f:text; var t:mas; var k:integer);
var
  abon:spr;
begin
  append(f);
  writeln('vvedite familiy');
  readln(abon.family);
  write(f,abon.family,' ');
  writeln('vvedite ima');
  readln(abon.name);
  write(f,abon.name,' ');
  writeln('vvedite domashnii telefon');
  readln(abon.tel1);
  write(f,abon.tel1,' ');
  writeln('vvedite mobilnii telefon');
  readln(abon.tel2);
  writeln(f,abon.tel2);
  close(f);
  num2(f,t,k);
end;

procedure num3(t:mas; k:integer);
var
  i,n:integer;
  a,S:str;
begin
  writeln('vvedite bykvy dla poiska');
  readln(S);
  n:=0;
  for i:=1 to k do
  begin
    a:=copy(t[i].family,1,1);
    if a=S then
    begin
      writeln(t[i].family,' ',t[i].name,' ',t[i].tel1,' ',t[i].tel2);
      n:=1;
    end;
  end;
  if n=0 then
    writeln('abonent ne naiden');
end;

procedure num4(t:mas; k:integer);
var
  S:str;
  i,n:integer;
begin
  writeln('vvedite familiy');
  readln(S);
  n:=0;
  for i:=1 to k do
  begin
    if S=t[i].family then
    begin
      writeln(t[i].family,' ',t[i].name,' ',t[i].tel1,' ',t[i].tel2);
      n:=1;
    end;
  end;
  if n=0 then
    writeln('abonent ne naiden');
end;

procedure num5(var f:text; var t:mas; k:integer);
var
  S:str;
  i,n,j:integer;
begin
  writeln('vvedite familiy');
  readln(S);
  j:=0;
  for i:=1 to k do
  begin
    if t[i].family=S then
    begin
      writeln(t[i].family,' ',t[i].name,' ',t[i].tel1,' ',t[i].tel2);
      writeln('esli xotite redaktirovat, na*mite 1; esli net - 0');
      readln(n);
      if n=1 then
      begin
        writeln('vvedite familiy');
        readln(t[i].family);
        writeln('vvedite ima');
        readln(t[i].name);
        writeln('vvedite domashnii telefon');
        readln(t[i].tel1);
        writeln('vvedite mobilnii telefon');
        readln(t[i].tel2);
        j:=1;
      end;
    end;
  end;
  if j=1 then
  begin
    rewrite(f);
    for i:=1 to k do
      writeln(f,t[i].family,' ',t[i].name,' ',t[i].tel1,' ',t[i].tel2);
    close(f);
  end
  else
    writeln('abonent ne naiden');
end;

procedure num6(var f:text; var t:mas; var k:integer);
var
  S:str;
  i,n:integer;
begin
  writeln('vvedite familiy');
  readln(S);
  n:=0;
  for i:=1 to k do
  begin
    if t[i].family=S then
    begin
      t[i].family:=t[k].family;
      t[k].family:=' ';
      t[i].name:=t[k].name;
      t[k].name:=' ';
      t[i].tel1:=t[k].tel1;
      t[k].tel1:=' ';
      t[i].tel2:=t[k].tel2;
      t[k].tel2:=' ';
      k:=k-1;
      n:=1;
    end;
  end;
  if n=1 then
  begin
    rewrite(f);
    for i:=1 to k do
      writeln(f,t[i].family,' ',t[i].name,' ',t[i].tel1,' ',t[i].tel2);
    close(f);
    writeln('ydalenie zaversheno');
  end
  else
    writeln('abonent ne naiden');
end;

procedure num7(t:mas; k:integer);
var
  i:integer;
begin
  for i:=1 to k do
    writeln(t[i].family,' ',t[i].name,' ',t[i].tel1,' ',t[i].tel2);
end;

procedure menu(z:integer; var f:text);
var
  t:mas;
  k:integer;
begin
  writeln;
  z:=10;
  while z>0 do
  begin
    writeln('vvedite pynkt:');
    writeln('1 - dobavit abonenta');
    writeln('2 - poisk po bykve');
    writeln('3 - poisk po familii');
    writeln('4 - redaktirovat dannie');
    writeln('5 - ydalit abonenta');
    writeln('6 - vivesti vse');
    writeln('0 - vixod iz programmi');
    readln(z);
    case z of
      1:num1(f,t,k);
      2:num3(t,k);
      3:num4(t,k);
      4:num5(f,t,k);
      5:num6(f,t,k);
      6:num7(t,k);
    else
      writeln('nevernii vvod');
    end;
    writeln;
  end;
end;

var
  f:text;
  z:integer;
begin
  { TODO -oUser -cConsole Main : Insert code here }
  assign(f,'qw.txt');
  menu(z,f);
end.

Сообщение отредактировано: GoodWind - 22.12.2005 23:33