SHARE
TWEET

Untitled

a guest Oct 13th, 2019 87 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. type tfile = text;
  2.  
  3. function len(a:integer):integer;
  4. var ans:integer;
  5.     begin
  6.     ans := 0;
  7.     while (a > 0) do
  8.         begin
  9.         a := a div 10;
  10.         ans := ans + 1;
  11.         end;
  12.     len := ans;
  13.     end;
  14.  
  15. procedure add_to_end_of_file(fname: string; intext:string);
  16. var fbuff: tfile;
  17.     buff:string;
  18.     cnt_ln: integer;
  19.     num_ln:string;
  20.     begin
  21.     assign(fbuff, fname);
  22.     reset(fbuff);
  23.     cnt_ln := 0;
  24.     while not eof(fbuff) do
  25.         begin
  26.         readln(fbuff, buff);
  27.         cnt_ln := cnt_ln + 1;
  28.         end;
  29.     cnt_ln := cnt_ln + 1;
  30.     str(cnt_ln, num_ln);
  31.     append(fbuff);
  32.     write(fbuff,num_ln + ':' + intext);
  33.     close(fbuff);
  34.     end;
  35.  
  36. procedure edit_file(fname: string; pos:integer; text:string);
  37. var f:tfile;
  38.     fbuff:tfile;
  39.     i_str:string;
  40.     s:string;
  41.     buff_s:string;
  42.     i, j:integer;
  43.     begin
  44.     assign(f, fname);
  45.     assign(fbuff, './5_buff.txt');
  46.     reset(f);
  47.     rewrite(fbuff);
  48.     i := 0;
  49.     while not eof(f) do
  50.         begin
  51.         i := i + 1;
  52.         if (i <> pos) then
  53.             begin
  54.             readln(f, buff_s);
  55.             append(fbuff);
  56.             writeln(fbuff, buff_s);
  57.             end
  58.         else
  59.             begin
  60.             readln(f, buff_s);
  61.             break;
  62.             end;
  63.         end;
  64.     str(i, i_str);
  65.     writeln(fbuff, i_str + ':' + text);
  66.     i := i + 1;
  67.     while not eof(f) do
  68.         begin
  69.         readln(f, buff_s);
  70.         //delete(buff_s, 1, pos(':', buff_s));
  71.         j := 0;
  72.         while (j <= len(i)) do
  73.             begin
  74.             delete(buff_s, 1, 1);
  75.             j := j + 1;
  76.             end;
  77.         str(i, i_str);
  78.         s := i_str + ':' + buff_s;
  79.         append(fbuff);
  80.         writeln(fbuff, s);
  81.         i := i + 1;
  82.         end;
  83.     readln(f, buff_s);
  84.     j := 0;
  85.     while (j <= len(i)) do
  86.         begin
  87.         delete(buff_s, 1, 1);
  88.         j := j + 1;
  89.         end;
  90.     str(i, i_str);
  91.     s := i_str + ':' + buff_s;
  92.     append(fbuff);
  93.     writeln(fbuff, s);
  94.     rewrite(f);
  95.     reset(fbuff);
  96.     while not eof(fbuff) do
  97.         begin
  98.         append(f);
  99.         readln(fbuff, buff_s);
  100.         writeln(f, buff_s);
  101.         end;
  102.     end;
  103.  
  104. procedure remove_from_file(fname: string; pos:integer);
  105. var f:tfile;
  106.     fbuff:tfile;
  107.     i_str:string;
  108.     s:string;
  109.     buff_s:string;
  110.     i, j:integer;
  111.     begin
  112.     assign(f, fname);
  113.     assign(fbuff, './5_buff.txt');
  114.     reset(f);
  115.     rewrite(fbuff);
  116.     i := 0;
  117.     while not eof(f) do
  118.         begin
  119.         i := i + 1;
  120.         if (i <> pos) then
  121.             begin
  122.             readln(f, buff_s);
  123.             append(fbuff);
  124.             writeln(fbuff, buff_s);
  125.             end
  126.         else
  127.             begin
  128.             readln(f, buff_s);
  129.             break;
  130.             end;
  131.         end;
  132.    
  133.     while not eof(f) do
  134.         begin
  135.         readln(f, buff_s);
  136.         //delete(buff_s, 1, pos(':', buff_s));
  137.         j := 0;
  138.         while (j <= len(i)) do
  139.             begin
  140.             delete(buff_s, 1, 1);
  141.             j := j + 1;
  142.             end;
  143.         str(i, i_str);
  144.         s := i_str + ':' + buff_s;
  145.         append(fbuff);
  146.         writeln(fbuff, s);
  147.         i := i + 1;
  148.         end;
  149.     readln(f, buff_s);
  150.     j := 0;
  151.     while (j <= len(i)) do
  152.         begin
  153.         delete(buff_s, 1, 1);
  154.         j := j + 1;
  155.         end;
  156.     str(i, i_str);
  157.     s := i_str + ':' + buff_s;
  158.     append(fbuff);
  159.     writeln(fbuff, s);
  160.     rewrite(f);
  161.     reset(fbuff);
  162.     while not eof(fbuff) do
  163.         begin
  164.         append(f);
  165.         readln(fbuff, buff_s);
  166.         writeln(f, buff_s);
  167.         end;
  168.     end;
  169.  
  170.  
  171.  
  172. function conver_to_base_format(user_ans:string):string;
  173. var s, buff_s:string;
  174.     begin
  175.     s := '';
  176.     delete(user_ans, 1, pos('[', user_ans));
  177.     buff_s := user_ans;
  178.     delete(buff_s, pos(']', buff_s), length(buff_s) - pos(']', buff_s) + 1);
  179.     s := s + buff_s + ' ';
  180.     delete(user_ans, 1, pos('[', user_ans));
  181.     buff_s := user_ans;
  182.     delete(buff_s, pos(']', buff_s), length(buff_s) - pos(']', buff_s) + 1);
  183.     s := s + buff_s + ' ';
  184.     delete(user_ans, 1, pos('[', user_ans));
  185.     buff_s := user_ans;
  186.     delete(buff_s, pos(']', buff_s), length(buff_s) - pos(']', buff_s) + 1);
  187.     s := s + buff_s + ':';
  188.     delete(user_ans, 1, pos('[', user_ans));
  189.     buff_s := user_ans;
  190.     delete(buff_s, pos(']', buff_s), length(buff_s) - pos(']', buff_s) + 1);
  191.     s := s + buff_s + ':';
  192.     delete(user_ans, 1, pos('[', user_ans));
  193.     buff_s := user_ans;
  194.     delete(buff_s, pos(']', buff_s), length(buff_s) - pos(']', buff_s) + 1);
  195.     s := s + buff_s;
  196.     conver_to_base_format := s;
  197.     end;
  198.  
  199. function pos_search_in_file(fname: string; text:string):string;
  200. var buff_s:string;
  201.     s: string;
  202.     fbuff: tfile;
  203.     begin
  204.     assign(fbuff, fname);
  205.     reset(fbuff);
  206.     while not eof(fbuff) do
  207.         begin
  208.         readln(fbuff, buff_s);
  209.         s := buff_s;
  210.         delete(buff_s, 1, pos(':', buff_s));
  211.         delete(buff_s, pos(' ', buff_s), length(buff_s) - pos(' ', buff_s) + 1);
  212.         if (buff_s = text) then
  213.             begin
  214.             delete(s, 2, length(s) - 1);
  215.             pos_search_in_file := s;
  216.             break;
  217.             end;
  218.         end;
  219.     end;
  220.  
  221. function search_in_file(fname: string; text:string):string;
  222. var buff_s:string;
  223.     s: string;
  224.     fbuff: tfile;
  225.     ans_s: string;
  226.     begin
  227.     ans_s := '';
  228.     if (length(text) = 2) then
  229.         begin
  230.         assign(fbuff, fname);
  231.         reset(fbuff);
  232.         while not eof(fbuff) do
  233.             begin
  234.             readln(fbuff, buff_s);
  235.             s := buff_s;
  236.             delete(buff_s, 1, pos(':', buff_s));
  237.             delete(buff_s, 3, length(buff_s) - 1);
  238.             if (buff_s = text) then
  239.                 begin
  240.                 delete(s, 1, pos(':', s));
  241.                 delete(s, pos(' ', s), length(s) - pos(' ', s) + 1);
  242.                 ans_s := ans_s + s + #10;
  243.                 end;
  244.             end;
  245.         end
  246.     else
  247.         begin
  248.         assign(fbuff, fname);
  249.         reset(fbuff);
  250.         while not eof(fbuff) do
  251.             begin
  252.             readln(fbuff, buff_s);
  253.             s := buff_s;
  254.             delete(buff_s, 1, pos(':', buff_s));
  255.             delete(buff_s, pos(' ', buff_s), length(buff_s) - pos(' ', buff_s) + 1);
  256.             if (buff_s = text) then
  257.                 begin
  258.                 delete(s, 1, pos(':', s));
  259.                 ans_s := ans_s + s + #10;
  260.                 end;
  261.             end;
  262.         end;
  263.     search_in_file := ans_s;
  264.     end;
  265.  
  266. var filename:string;
  267.     user_ans:string;
  268.     s:string;
  269.     pos:integer;
  270.     begin
  271.     filename := './5.txt';
  272.     {subs := search_in_file(filename, 'П');
  273.     write(search_in_file(filename, 'П'));
  274.     delete(subs, pos(#10, subs), length(subs) - pos('#10', subs) + 1);
  275.     write(subs);}
  276.     writeln('Добро пожаловать в программу для редактирования сведений об обонентах телефонного узла!');
  277.     write('Вы хотите начать редактирвание?(Д/Н) ');
  278.     readln(user_ans);
  279.     if ( (user_ans = 'Д') or (user_ans = 'д')) then
  280.         begin
  281.         while (true) do
  282.             begin
  283.             writeln('Если хотите добавить новую запись, введите 1.');
  284.             writeln('Если хотите просмотреть уже существующую запись, введите 2.');
  285.             writeln('Если хотите удалить запись, введите 3.');
  286.             writeln('Если хотите отредактировать запись, введите 4.');
  287.             write('Ввод: ');
  288.             readln(user_ans);
  289.             if (user_ans = '1') then
  290.                 begin
  291.                 write('Введите новые данные, соблюдая формат ввода - [Ф] [И] [О] [адрес] [номер счета], где [] разграничивают поля информации: ');
  292.                 readln(user_ans);
  293.                 add_to_end_of_file(filename, conver_to_base_format(user_ans));
  294.                 end
  295.             else if (user_ans = '2') then
  296.                 begin
  297.                 write('Введите первую букву фамилии: ');
  298.                 readln(user_ans);
  299.                 s := search_in_file(filename, user_ans);
  300.                 writeln('Список фамилий, начинающихся на эту букву: ');
  301.                 write(s);
  302.                 write('Введите конкретную фамилию, которая Вас интересует: ');
  303.                 readln(user_ans);
  304.                 s := search_in_file(filename, user_ans);
  305.                 writeln('Запрашиваемая информация по данному человеку: ');
  306.                 write(s);
  307.                 end
  308.             else if (user_ans = '3') then
  309.                 begin
  310.                 write('Введите первую букву фамилии: ');
  311.                 readln(user_ans);
  312.                 s := search_in_file(filename, user_ans);
  313.                 writeln('Список фамилий, начинающихся на эту букву: ');
  314.                 write(s);
  315.                 write('Введите конкретную фамилию, которая Вас интересует: ');
  316.                 readln(user_ans);
  317.                 s := pos_search_in_file(filename, user_ans);
  318.                 val(s, pos);
  319.                 remove_from_file(filename, pos);
  320.                 end
  321.             else if (user_ans = '4') then
  322.                 begin
  323.                 write('Введите первую букву фамилии: ');
  324.                 readln(user_ans);
  325.                 s := search_in_file(filename, user_ans);
  326.                 writeln('Список фамилий, начинающихся на эту букву: ');
  327.                 write(s);
  328.                 write('Введите конкретную фамилию, которая Вас интересует: ');
  329.                 readln(user_ans);
  330.                 s := pos_search_in_file(filename, user_ans);
  331.                 val(s, pos);
  332.                 s := search_in_file(filename, user_ans);
  333.                 writeln('Запрашиваемая информация по данному человеку: ');
  334.                 write(s);
  335.                 write('Желаете отредактировать её?(Д/Н)');
  336.                 readln(user_ans);
  337.                 if ( (user_ans = 'Д') or (user_ans = 'д')) then
  338.                     begin
  339.                     write('Введите новые данные, соблюдая формат ввода - [Ф] [И] [О] [адрес] [номер счета], где [] разграничивают поля информации: ');
  340.                     readln(user_ans);
  341.                     edit_file(filename, pos, conver_to_base_format(user_ans));
  342.                     end;
  343.                 end
  344.             else
  345.                 begin
  346.                 writeln('Некорректный ввод! Повторите попытку.');
  347.                 continue;
  348.                 end;
  349.             write('Хотите завершить работу?(Д/Н) ');
  350.             readln(user_ans);
  351.             if ( (user_ans = 'Д') or (user_ans = 'д')) then
  352.                 begin
  353.                 writeln('До скорой встречи!');
  354.                 break;
  355.                 end
  356.             else
  357.                 begin
  358.                 writeln('Тогда продолжим.');
  359.                 end
  360.             end;
  361.         end
  362.     else
  363.         begin
  364.         writeln('До скорой встречи!');
  365.         end;
  366.     end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top