uses crt;
type
table=record
     ct:word;{Cipher in Table}
     name:string[60];{naimenovanie}
     end;
storage=record
     number:byte;{nomer sklada}
     cs:word;{Cipher in Storage}
     amount:word;{kolichestvo}
     end;
const
end_menu:boolean=false;
var
f1:file of table;
f2:file of storage;
work1:table;
work2:storage;
{/////////////////}
procedure ioe;
begin
textcolor(4);
writeln;
writeln('Ћ??ЃЉЂ ‚‚Ћ„Ђ! ЏЋЏђЋЃ“‰’… ‘ЌЋ‚Ђ!');
writeln;
writeln('ЌЂ†Њ?’… ‹ћЃ“ћ Љ‹Ђ‚??“...');
textcolor(10);
readkey;
end;
{/////////////////}
procedure inputintable;
var
c:byte;
aonr,i:word;
begin
clrscr;
reset(f1);
writeln('1-‚‚…‘’? …„?Ќ?—Ќ“ћ ‡ЂЏ?‘њ');
writeln('2-‚‚…‘’? Ќ…‘ЉЋ‹њЉЋ ‡ЂЏ?‘…‰');
write('>');
readln(c);
case c of
    1:with work1 do
           begin
           seek(f1,filesize(f1));
           write('??”ђ ЏђЋ„“Љ–??:');
           readln(ct);
           write('ЌЂ?Њ…ЌЋ‚ЂЌ?…:');
           readln(name);
           write(f1,work1);
           end;
    2:begin
      seek(f1,filesize(f1));
      write('‚‚…„?’… ЉЋ‹?—…‘’‚Ћ ЌЋ‚›• ‡ЂЏ?‘…‰:');
      readln(aonr);
      for i:=1 to aonr  do
          begin
          clrscr;
          writeln('‡ЂЏ?‘њ ь (ЌЋ‚Ђџ) ',i);
          with work1 do
               begin
               write('??”ђ ЏђЋ„“Љ–??:');
               readln(ct);
               write('ЌЂ?Њ…ЌЋ‚ЂЌ?…:');
               readln(name);
               write(f1,work1);
               end;
          end;
      end;
  end;
close(f1);
end;
{////////////////////////////////////////////}
procedure inputinstorage;
var
c:byte;
aonr,i:word;
begin
clrscr;
reset(f2);
writeln('1-‚‚…‘’? …„?Ќ?—Ќ“ћ ‡ЂЏ?‘њ');
writeln('2-‚‚…‘’? Ќ…‘ЉЋ‹њЉЋ ‡ЂЏ?‘…‰');
write('>');
readln(c);
case c of
    1:with work2 do
           begin
           seek(f2,filesize(f2));
           write('ь ‘Љ‹Ђ„Ђ:');
           readln(number);
           write('??”ђ ЏђЋ„“Љ–??:');
           readln(cs);
           write('ЉЋ‹?—…‘’‚Ћ:');
           readln(amount);
           write(f2,work2);
           end;
    2:begin
      seek(f2,filesize(f2));
      write('‚‚…„?’… ЉЋ‹?—…‘’‚Ћ ЌЋ‚›• ‡ЂЏ?‘…‰:');
      readln(aonr);
      for i:=1 to aonr do
          begin
          clrscr;
          writeln('‡ЂЏ?‘њ ь (ЌЋ‚Ђџ)',i);
          with work2 do
               begin
               write('ь ‘Љ‹Ђ„Ђ:');
               readln(number);
               write('??”ђ ЏђЋ„“Љ–??:');
               readln(cs);
               write('ЉЋ‹?—…‘’‚Ћ:');
               readln(amount);
               write(f2,work2);
               end;
          end;
      end;
  end;
close(f2);
end;
{/////////////////}
procedure bordereau;
var
i,j,k,l,m,fnumber,lnumber,fct,lct:word;
sum:longint;
cstring:string[60];
cond:boolean;
begin{1}
clrscr;
writeln('---------------------------BEDOMOCTb---------------------------------');
reset(f1);
reset(f2);
{vychisljaem nomera zanesennyh v basu skladov}
fnumber:=65535;{first storage}
lnumber:=0;    {last storage}
for i:=1 to filesize(f2) do
   begin{2}
   read(f2,work2);
   if work2.number<fnumber then fnumber:=work2.number;
   if work2.number>lnumber then lnumber:=work2.number;
   end;{2}
{vychisljaem shifry zanesennyh v basu tovarov}
fct:=65535;{first ciphertable}
lct:=0;    {last  ciphertable}
for i:=1 to filesize(f1) do
   begin{3}
   read(f1,work1);
   if work1.ct<fct then fct:=work1.ct;
   if work1.ct>lct then lct:=work1.ct;
   end;{3}
{!}
{dalee nachalis' problemy :))}
seek(f1,0);
seek(f2,0);
sum:=0;
for i:=fnumber to lnumber do
   begin{4}
   for j:=fct to lct do
       begin{5}
       read(f2,work2);
       if ((work2.number=i) and (work2.cs=j)) then
          begin{6}
          seek(f2,0);
          for k:=1 to filesize(f2) do
              begin{7}
              read(f2,work2);
              if ((work2.number=i) and (work2.cs=j)) then sum:=sum+work2.amount;
              end;{7}
          for l:=1 to filesize(f1) do
              begin{8}
              read(f1,work1);
              if work1.ct=j then
                 begin{9}
                 cstring:=work1.name;{cstring-CipherString}
                 break;
                 end;{9}
              end;{8}
          end;{6}
       writeln('storage # ',i);
       writeln('cipher: ',j);
       writeln('name: ',cstring);
       writeln('amount: ',sum);
       writeln('--------------------------');
       seek(f1,0);
       seek(f2,0);
       sum:=0;
       end{5}
   end;{4}
readkey;
end;{1}
{/////////////////}
procedure menu;
var
code:char;
pstn,c:integer;
cnd:boolean;
begin{!}
cnd:=false;
while cnd<>true do
     begin{while}
     clrscr;
     writeln('і=============KOHTOPA==============і');
     writeln('і1-‚Ќ…‘…Ќ?… „ЂЌЌ›• ‚ ЃЂ‡“ "table"  і');
     writeln('і2-‚Ќ…‘…Ќ?… „ЂЌЌ›• ‚ ЃЂ‡“ "storage"і');
     writeln('і3-‚›„Ђ’њ ‚…„ЋЊЋ‘’њ                і');
     writeln('і4-‚›•Ћ„                           і');
     write  ('ЉЋ„ ЋЏ…ђЂ–??:');
     readln(code);
     val(code,c,pstn);
     if pstn=0 then
        begin
        case c of
             1:inputintable;
             2:inputinstorage;
             3:bordereau;
             4:end_menu:=true;
        end;
     cnd:=true;
     end
     else ioe;
     end;{while}
end;{!}
{///////////////////////}
{/////main_program//////}
begin
clrscr;
{\\\\\\\\\\\\\\\\\\\\}
assign(f1,'table.dat');
{$I-}
reset(f1);
{$I+}
if ioresult<>0 then
  begin
  textcolor(4);
  writeln('”Ђ‰‹ "table.dat" Ќ… ЌЂ‰„…Ќ. Ѓ“„…’ ‘Ћ‡„ЂЌ ЌЋ‚›‰ ”Ђ‰‹');
  readkey;
  rewrite(f1);
  end;
{\\\\\\\\\\\\\\\\\\\\}
assign(f2,'storage.dat');
{$I-}
reset(f2);
{$I+}
if ioresult<>0 then
  begin
  textcolor(4);
  writeln('”Ђ‰‹ "storage.dat" Ќ… ЌЂ‰„…Ќ. Ѓ“„…’ ‘Ћ‡„ЂЌ ЌЋ‚›‰ ”Ђ‰‹');
  readkey;
  rewrite(f2);
  end;
close(f1);
close(f2);
textcolor(10);
{/////////////////////}
repeat menu until end_menu;
end.