ANTICHAT — форум по информационной безопасности, OSINT и технологиям

Program bibka;  uses CRT,graph;  Type kniga=record  ISBN:integer;  avtor:string;  nazvanie:string;  izdatelstvo:string;  god:integer;  obem:integer;  end;  function p(a:string; n:byte):string;  var i: byte;  begin     for i:=1 to n-length(a) do a:=a+' ';     p:=a;  end;    var f,fn:file of kniga;a,x,j:kniga;n:array[1..5] of kniga;  i:byte;w,k:integer; y:char;  procedure OutMenu;  begin  clrscr;  TextColor(15);  writeln('1 - Create file');  writeln('2 - Print to screen');  writeln('3 - Add record to file');  writeln('4 - Delete record by ISBN');  writeln('5 - Change of record');  writeln('6 - Sortirovka');  writeln('7 - Text file');  writeln('8 - Diagramma');  writeln('9 - Exit');  writeln;  write('Type number ');  end;  procedure create;  begin  clrscr;  writeln('Procedure create');  n[1].ISBN:=1;  n[1].avtor:='Ivanov I.I.';  n[1].nazvanie:='zhivopis';  n[1].izdatelstvo:='ruskniga';  n[1].god:=1990;  n[1].obem:=246;    n[2].ISBN:=2;  n[2].avtor:='Petrov P.V.';  n[2].nazvanie:='live';  n[2].izdatelstvo:='prosv';  n[2].god:=1994;  n[2].obem:=53;    n[3].ISBN:=3;  n[3].avtor:='Sidorov S.P.';  n[3].nazvanie:='viy';  n[3].izdatelstvo:='pechat';  n[3].god:=2004;  n[3].obem:=246;    n[4].ISBN:=4;  n[4].avtor:='Kuznecov V.A.';  n[4].nazvanie:='skazki';  n[4].izdatelstvo:='prosv';  n[4].god:=1999;  n[4].obem:=34;    n[5].ISBN:=5;  n[5].avtor:='Denisov A.A. ';  n[5].nazvanie:='stixi';  n[5].izdatelstvo:='ruskniga';  n[5].god:=2006;  n[5].obem:=85;    assign(f,'c:\zap.tmp');    rewrite(f);  for i:=1 to 5 do    write(f,n[i]);    close(f);     reset(f);    while not eof(f) do    read(f,x);     close(f);  writeln('Press ENTER');  readln;  end;  procedure vivod;  var i:byte;  begin  clrscr;  TextColor(2);    writeln('              file kniga              ');    TextColor(8);    writeln('ISBN','    avtor    ','    nazvanie ','     izdatelstvo','      god ','      obem');    TextColor(5);    reset(f);    i:=1;    while not eof(f) do    begin    read(f,x);    with x do    writeln(ISBN,'     ',p(avtor,15),p(nazvanie,15),izdatelstvo:10,god:10,obem:10);    i:=i+1;    end;    close(f);    writeln;    TextColor(6);    writeln('Press Enter');    readln;  end;  procedure add;  begin  clrscr;  writeln('Procedure of add');  writeln('Vvedite zapis');  reset(f);  seek(f,filesize(f));  x.ISBN:=w+1;  with x do begin  writeln('avtor');  readln(avtor);  writeln('nazvanie');  readln(nazvanie);  writeln('izdatelstvo');  readln(izdatelstvo);  writeln('god');  readln(god);  writeln('obem');  readln(obem);  end;  write(f,x);  w:=x.ISBN;  close(f);  writeln('Press ENTER');  readln;  end;  procedure delete;  begin  clrscr;  writeln('Procedure delete record by ISBN ');  assign(fn,'c:\temp');  reset(f);  rewrite(fn);  write('What record to delete');  readln(i);  while not eof(f) do begin  read(f,j);  if j.ISBN<>i then write (fn,j);  end;  close(f);  close(fn);  erase(f);  rename(fn,'c:\zap.tmp');  writeln('Press ENTER');  readln;  end;  procedure change;  var r:integer;  begin  clrscr;  writeln('Procedure changing');  with a do begin  writeln('ISBN');  readln(ISBN);  writeln('avtor');  readln(avtor);  writeln('nazvanie');  readln(nazvanie);  writeln('izdatelstvo');  readln(izdatelstvo);  writeln('god');  readln(god);  writeln('obem');  readln(obem);  end;  r:=a.ISBN;  reset(f);  seek(f,r-1);  write(f,a);  close(f);  writeln('Press ENTER');  readln;  end;  procedure sort;  var i,j:byte; k,x:kniga;  begin  clrscr;  writeln('Procedure sort');  reset(f);  for i:=0 to filesize(f)-2 do  for j:=i+1 to filesize(f)-1 do  begin  seek(f,i); read(f,k);  seek(f,j); read(f,x);  if k.god<x.god then begin  seek(f,i); write(f,x);  seek(f,j); write(f,k);  end; end;  writeln('Press ENTER');  readln;  end;  procedure textf;  var f1:text;f:file of kniga; st,st1,st2,st3:string;c:kniga;g:integer;z:integer;  begin  clrscr;  writeln('Procedure text');  writeln('        text file for kniga novee 2000 goda              ');    TextColor(5);    writeln(' ISBN  ','avtor         ','nazvanie  ','izdatelstvo','     ','obem');    TextColor(12);  assign(f,'c:\zap.tmp');  reset(f);  assign(f1,'c:\txt');  rewrite(f1);  while not eof(f) do begin  read(f,c);  if c.god>2000 then begin  str(c.ISBN,st1);  g:=c.god;  str(g,st2);  z:=c.obem;  str(z,st3);  st:='   '+st1+'   '+P(c.avtor,15)+P(c.nazvanie,10)+'  '+st2+'         '+st3+'';   writeln(f1,st);   end;end;   begin close(f1);   reset(f1);   while not eof(f1) do begin   readln(f1,st);   writeln(st);   end;end;   TextColor(15);   writeln('Press ENTER');   readln;   end;  procedure diagramma;  VAR  kol:array[1..100] of integer;  obem:array[1..100] of integer;  flag:boolean;j,n,i,gd,gm,ec,x,y, s,b,r:integer; k:kniga;ST5,ST6:STRING;  begin  clrscr;  writeln('procedure diagramma');  r:=210;  n:=0;  assign(f,'c:\zap.tmp');  reset(f);   while not eof(f) do begin   read(f,k);   flag:=false;   for i:=1 to n do   if obem[i]=k.obem then begin   flag:=true;   kol[i]:=kol[i]+1;   end;   if flag=false then begin n:=n+1;   obem[n]:=k.obem;   kol[n]:=1;   end;   end;   gd:=detect;   initgraph(gd,gm,'d:\bp\bgi\');    SetColor(10);   ST5:='balli po fizike';   OUTTEXTXY(30,2,ST5);   s:=filesize(f);   b:=0;   for i:=1 to n do   begin   setfillstyle(7,i+1);   if i=n then pieslice(getmaxx div 2,getmaxy div 2, b, 360,r)   else   pieslice(getmaxx div 2, getmaxy div 2, b, trunc(b+kol[i]/s*360),r);   b:=trunc(b+kol[i]/s*360);   X:=40;Y:=20+I*20;   STR(obem[i],ST6);   OUTTEXTXY(X,Y,ST6);   BAR(X-20,Y,X-10,Y+10);   end;     readln;   CLOSEGRAPH;   end;    begin  w:=5;  assign(f,'c:\zap.tmp');  repeat  OutMenu;  readln(y);  case y of  '1':create;  '2':vivod;  '3':add;  '4':delete;  '5':change;  '6':sort;  '7':textf;  '8':diagramma;  end;  until y='9';  end.

procedure stat;  var     o :integer;  begin       clrscr;       WriteLn('                         Statistika:');       textcolor(green);       kolv:=1;       o:=arr[1].obem;       iz[1].name:=arr[1].izd;       iz[1].kol:=1;       for i:=2 to n do       begin            o:=o+arr[i].obem;            t:=0;            for j:=1 to kolv do if arr[i].izd=iz[j].name then t:=j;            if t<>0 then inc(iz[t].kol) else            begin                 inc(kolv);                 iz[kolv].name:=arr[i].izd;                 iz[kolv].kol:=1;            end;       end;       for i:=1 to kolv do Writeln('Imeetsya ',iz[i].kol,' knig(a) ',iz[i].name,' izdatel"stvo');       writeln;       writeln;       textcolor(4);       Writeln('Srednij ob"em vseh knig: ',o div n);       textcolor(9);       writeln('                            press any key');       textcolor(white);       readkey;  end;