home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 September / Chip_1999-09_cd.bin / ctenari / Trejbal / TRELL.PAK / SOURCE / ERSD.EXE / BUBEN.PAS < prev    next >
Pascal/Delphi Source File  |  1999-02-28  |  2KB  |  134 lines
  1.  
  2.  
  3. uses dos,crt,slova,matika;
  4.  
  5. var u,i,j,par,k,l,m,n,o,coko : integer;
  6.     radk,rad,kus,sfs,para,parb,str,smr : string;
  7.     aa,bb,cc,dd,ee,ff,gg:text;
  8.     znak:char;
  9.  
  10.  
  11.  
  12.  
  13.  
  14. begin
  15.  
  16. rad:='a.dbf';
  17.  
  18. assign(aa,'C:\trell\convert.dll');
  19. assign(bb,'bubben');
  20. assign(cc,'bubcen');
  21. assign(dd,'bublen');
  22. sfs:=fsearch('C:\trell\convert.dll',GetEnv('path'));
  23. if not(sfs='') then
  24. begin
  25.  
  26.  
  27. reset(aa);
  28. rewrite(bb);
  29. rewrite(cc);
  30. rewrite(dd);
  31.  
  32. j:=0;
  33. k:=0;
  34. kus:='';
  35. while not(eof(aa)) do
  36. begin
  37.   u:=0;
  38.   readln(aa,rad);
  39.   if ord(rad[0])=0 then rad:=' ';
  40.   if (rad[1]='-') or (rad[1]=chr(196)) then
  41.    begin
  42.      j:=j+1;
  43.      u:=1;
  44.    end;
  45.    if (j=1) and (u=0) then
  46.    begin
  47.      k:=k+1;
  48.      kus:=kus+rad;
  49.      if k=2 then
  50.      begin
  51.        rad:='';
  52.        for i:=1 to 20 do rad:=rad+kus[i];
  53.        for i:=116 to 123 do rad:=rad+kus[i];
  54.        kus:=rad+kus;
  55.        writeln(cc,kus);
  56.        rad:='';
  57.        kus:='';
  58.        k:=0;
  59.      end;
  60.    end
  61.    else
  62.    begin
  63.     if j<2 then writeln(bb,rad);
  64.     if j>1 then writeln(dd,rad);
  65.    end;
  66. end;
  67.  
  68. close(bb);
  69. close(aa);
  70. close(cc);
  71. close(dd);
  72.  
  73. sortuj('bubcen',1,28);
  74.  
  75.  
  76. reset(bb);
  77. rewrite(aa);
  78.  
  79. while not(eof(bb)) do
  80. begin
  81.   readln(bb,rad);
  82.   kus:='';
  83.   for i:=1 to 19 do kus:=kus+rad[i];
  84.   if kus='Kategorie:   Sklad:' then rad:=kus;
  85.   writeln(aa,rad);
  86. end;
  87. close(bb);
  88.  
  89. reset(cc);
  90. k:=0;
  91. str:='kdsagjsfg';
  92. while not(eof(cc)) do
  93. begin
  94.   readln(cc,rad);
  95.   kus:='';
  96.   for i:=29 to 108 do kus:=kus+rad[i];
  97.   smr:='';
  98.   for i:=1 to 20 do smr:=smr+kus[i];
  99.   if not(smr=str) then
  100.   begin
  101.    if k=1 then writeln(aa);
  102.    writeln(aa,smr);
  103.   end;
  104.   str:=smr;
  105.   kus:='';
  106.   k:=1;
  107.   for i:=109 to ord(rad[0]) do kus:=kus+rad[i];
  108.   writeln(aa,kus);
  109. end;
  110. close(cc);
  111.  
  112.  
  113. reset(dd);
  114. while not(eof(dd)) do
  115. begin
  116.   readln(dd,rad);
  117.   writeln(aa,rad);
  118. end;
  119. close(dd);
  120.  
  121. close(aa);
  122.  
  123. erase(bb);
  124. erase(cc);
  125. erase(dd);
  126.  
  127.  
  128.  
  129. end;     { konec dll }
  130.  
  131.  
  132.  
  133.  
  134. end.