Advertisement
Guest User

Untitled

a guest
Dec 14th, 2018
98
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 7.18 KB | None | 0 0
  1. program Trial_File;
  2. //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3. type
  4.   tm = record
  5.     name: string[10];
  6.     last_name: string[10];
  7.     first_mark: integer;
  8.     second_mark: integer;
  9.   end;
  10.    // the file of group
  11. type
  12.   ff = file of tm;
  13. //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  14.  
  15.              {проверка на существование файла (в делфи , АВС не поддерживает её)}
  16.  
  17. // Используй код ниже только в делфи , АВС не имеет таких директив  
  18. //Function prov(var a:ff):boolean;
  19. //   begin
  20. //    {$I-};
  21. //    reset(a);
  22. //    {$i+};
  23. //    if Ioresult=0 then
  24. //      prov:=True
  25. //    else Prov:=False;
  26. //   end;
  27.  
  28.  //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  29.  
  30.                           {ввод данных}
  31. procedure input(var a: ff);
  32. var
  33.   f: tm;
  34.   c: string[5];
  35.   m: string[5];
  36. begin
  37.   writeln('ввод');
  38.   m := 'exit';
  39.   rewrite(a);
  40.   repeat
  41.     write('Введте марку автомобиля: '); readln(f.name);
  42.     write('Введите номер автомобиля: '); readln(f.last_name);
  43.     write('Введите мощность автомобиля: '); readln(f.first_mark);
  44.     write('Введите стоимость автомобиля: '); readln(f.second_mark);
  45.     writeln('do you want to exit the writing? Then enter "exit": ');
  46.     readln(c);
  47.     write(a, f);
  48.   until c = m;
  49.   close(a);
  50. end;
  51.  // +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  52.  
  53.                            {вывод данных}
  54. procedure output(var a: ff);
  55. var
  56.   f: tm;
  57. begin
  58.   writeln('вывод');
  59.   Reset(a);
  60.   while not eof(a) do
  61.   begin
  62.     read(a, f);
  63.     writeln('-----------------------------------------------------------------------------------------------');
  64.     write('марка автомобиля: ', '¦', f.name, '¦ ; ');
  65.     write('номер автомобиля: ', '¦', f.last_name, '¦ ; ');
  66.     write('мощность автомобиля и стоимость автомобиля: ', '¦', f.first_mark, '¦', f.second_mark, '¦');
  67.     writeln('-----------------------------------------------------------------------------------------------');
  68.     writeln;
  69.   end;
  70.   close(a);
  71. end;
  72.  
  73. //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  74.  
  75.               {в процедуре вводит диапазон стоимости автомобиля
  76.                  и мощность, выводит подходящие автомобили}
  77. procedure poisk(var t: ff);
  78. var
  79.   f: tm;
  80.   a, b: real;
  81.   c, d: real;
  82. begin
  83.   writeln('looking for automobile');
  84.   reset(t);
  85.   repeat
  86.     writeln('Введите диапазон желаемой стоимости автомобиля: ');
  87.     write(' ¦ '); read(a); write(' ¦ '); read(b); write(' ¦ ');
  88.     writeln('Введите диапазон мощности автомобиля: ');
  89.     write(' ¦ '); read(c); write(' ¦ '); read(d); write(' ¦ ');
  90.   until (a > 0) and (b > 0) and (c > 0) and (d > 0);
  91.   while not eof(t) do
  92.   // first_mark : integer;  мощность авто (c,d)
  93.   //  second_mark : integer;  стоимость авто (a,b)
  94.   begin
  95.     read(t, f);
  96.     if (a < f.second_mark) and (f.second_mark < b) and (c < f.first_mark) and (f.first_mark < d) then
  97.     begin
  98.       writeln('Мы нашли автомобили по вашему запросу: ');
  99.       write('Марка автомобиля: ', '¦', f.name, '¦ ');
  100.       write('Номер : ', '¦', f.last_name, '¦ ');
  101.       writeln;
  102.       write('Мощность : ', '¦', f.first_mark, '¦ ');
  103.       write('Стоимость: ', '¦', f.second_mark, '¦');
  104.       writeln;
  105.     end;
  106.   end;
  107.   closefile(t);
  108. end;
  109.  
  110.  
  111.  //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  112.  
  113.                            {сортировка по мощности авто}
  114. procedure sort(var a: ff);
  115. var
  116.   f, t: tm;
  117.   i, j, k, m: byte;
  118. begin
  119.   reset(a);
  120.   i := 0;
  121.   k := filesize(a) - 2;
  122.   j := 0;
  123.   writeln('Сортировка машин по мощности: ');
  124.   for i := 1 to k do
  125.     for j := 0 to k-i+1 do
  126.     begin
  127.       m := j + 1;
  128.       seek(a, j);
  129.       read(a, f);
  130.       seek(a, m);
  131.       read(a, t);
  132.       if (f.first_mark < t.first_mark) then begin
  133.         seek(a, j);
  134.         write(a, t, f);
  135.       end;
  136.     end;
  137.   seek(a, 0);
  138.   reset(a);
  139.   while not eof(a) do
  140.   begin
  141.     read(a, f);
  142.     writeln('марка автомобиля: ', '¦', f.name, '¦');
  143.     writeln;
  144.     writeln('номер автомобиля: ', '¦', f.last_name, '¦');
  145.     writeln;
  146.     writeln('мощность автомобиля и стоимость автомобиля: ', '¦', f.first_mark, '¦', f.second_mark, '¦');
  147.   end;
  148.   closefile(a);
  149. end;
  150.  
  151. //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  152.  
  153.                     {Удаление из списка авто с указанным номером}
  154. procedure delete(var a: ff; name: string);
  155. var
  156.   f: tm;
  157.   s: string;
  158.   g: string;
  159.   b: ff;
  160. begin
  161.   g := 'b.dat';
  162.   assign(b, g);
  163.   writeln('Введите номер машины , которую хотите удалить из списка');
  164.   readln(s);
  165.   reset(a);
  166.   rewrite(b);
  167.   while not eof(a) do
  168.   begin
  169.     read(a, f);
  170.     if (f.last_name <> s) then
  171.       write(b, f)      
  172.       end;
  173.      closefile(b);
  174.      closefile(a);
  175.      erase(a);
  176.      Rename(b, name);  
  177. end;
  178. procedure delete(var a:ff);
  179. begin
  180.   erase(a);
  181. end;
  182.  
  183.  
  184. //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  185.  
  186.                                 {основная программа}
  187. var
  188.   t, z: ff;
  189.   f: tm;
  190.   name: string;
  191.   stop: boolean;
  192.   n: integer;
  193.   u: byte;
  194.  
  195. begin
  196.   writeln('Enter the name of file');
  197.   readln(name);
  198.   assign(t, name);
  199.   repeat
  200.     begin
  201.       writeln('1-ввод файла');
  202.       writeln('2-вывод файла');
  203.       writeln('3-выход из файла');
  204.       writeln('4-поиск автомобиля по заданным параметрам');
  205.       writeln('5-сортировка автомобилей по мощности');
  206.       writeln('6-удаление из списка машины с указанным номером');
  207.       writeln('7-удалить весь список');
  208.       readln(n);
  209.       case n of
  210.         1: // Следующие коментарии толко в делфи :
  211.          //if prov(t)=false then
  212.          //input(t) else
  213.         // begin writeln('хотите ли вы перезаписать файл? Введите 1');
  214.         // readln(u); if u=1 then
  215.         input(t);
  216.         //  end;
  217.         2: output(t);
  218.         3: stop := true;
  219.         4: poisk(t);
  220.         5: sort(t);
  221.         6: delete(t, name);
  222.         7: erase(t);
  223.       else writeln('неверный номер');
  224.       end;
  225.     end;
  226.   until stop;
  227.   readln;
  228. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement