home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 September / Chip_1999-09_cd.bin / ctenari / Trejbal / TRELL.PAK / SOURCE / ERSD.EXE / KOLBEX.PAS < prev    next >
Pascal/Delphi Source File  |  1999-01-13  |  3KB  |  250 lines
  1.  
  2.  
  3.  
  4. uses dos,crt,slova;
  5.  
  6. var i,j,par,k,l,m,n,o,coko : integer;
  7.     radk,rad,kus,sfs,para,parb : string;
  8.     paka : string[6];
  9.     aa,bb,cc,ee,ff,gg,hh,ii:text;
  10.     znak:array [0..7] of char;
  11.     zaka:array [0..5] of char;
  12.     zakk,alla : char;
  13.  
  14.  
  15.  
  16. procedure prepis;
  17. begin
  18.  
  19. if para='0780' then
  20. begin
  21.  
  22. znak[5]:=znak[1];
  23. znak[1]:=znak[2];
  24. znak[2]:=znak[4];
  25. znak[4]:=znak[3];
  26. znak[3]:=znak[5];
  27.  
  28. end;     { konec }
  29.  
  30. if para='0782' then
  31. begin
  32.  
  33. znak[5]:=znak[1];
  34. znak[1]:=znak[3];
  35. znak[3]:=znak[4];
  36. znak[4]:=znak[2];
  37. znak[2]:=znak[5];
  38.  
  39. end;     { konec }
  40.  
  41.  
  42.  
  43. i:=0;
  44. write(bb,znak[1]);
  45. write(bb,znak[2]);
  46. write(bb,znak[3]);
  47. write(bb,znak[4]);
  48.  
  49. end;     { konec procedury }
  50.  
  51.  
  52.  
  53.  
  54. procedure preved;
  55. var code : integer;
  56.  
  57.  
  58. begin
  59.  
  60. assign(aa,parb);
  61. assign(bb,'ekiypo');
  62.  
  63. sfs:=fsearch(parb,GetEnv('path'));
  64. if not(sfs='') then
  65. begin
  66.  
  67.  
  68. reset(aa);
  69. rewrite(bb);
  70.  
  71.  
  72.  
  73. if para='0780' then
  74. begin
  75.   write(bb,'Kolben');
  76. end;
  77.  
  78. if para='0782' then
  79. begin
  80.   for i:=1 to 6 do read(aa,zakk);
  81. end;
  82.  
  83.  
  84.  
  85. i:=0;
  86. k:=0;
  87. l:=0;
  88.  
  89. while k=0 do
  90. begin
  91.  
  92.  if i>3 then prepis;
  93.  
  94.    j:=0;
  95.    while l>0 do
  96.    begin
  97.     j:=j+1;
  98.     i:=i+1;
  99.     znak[i]:=zaka[j];
  100.     l:=l-1;
  101.     if i>3 then prepis;
  102.    end;
  103.  
  104.    i:=i+1;
  105.    read(aa,znak[i]);
  106.    if eof(aa) then
  107.    begin
  108.     l:=l+1;
  109.     read(aa,zaka[l]);
  110.     if eof(aa) then
  111.     begin
  112.       l:=l+1;
  113.       read(aa,zaka[l]);
  114.       if eof(aa) then
  115.       begin
  116.        l:=l+1;
  117.        read(aa,zaka[l]);
  118.        if eof(aa) then k:=1;
  119.       end;
  120.     end;
  121.    end;
  122.  
  123. end;
  124.  
  125. if i>0 then
  126. begin
  127.  for j:=1 to i do write(bb,znak[j]);
  128. end;
  129.  
  130. close(bb);
  131. close(aa);
  132.  
  133. {
  134. write('kkkkkk');
  135. readln;
  136. }
  137.  
  138. reset(bb);
  139. rewrite(aa);
  140.  
  141. k:=0;
  142. l:=0;
  143.  
  144. while k=0 do
  145. begin
  146.  
  147.  j:=0;
  148.  while l>0 do
  149.  begin
  150.   j:=j+1;
  151.   write(aa,znak[j+1]);
  152.   l:=l-1;
  153.  end;
  154.  
  155.  read(bb,znak[1]);
  156.  write(aa,znak[1]);
  157.  if eof(bb) then
  158.  begin
  159.   l:=l+1;
  160.   read(bb,znak[2]);
  161.   if eof(bb) then
  162.   begin
  163.     l:=l+1;
  164.     read(bb,znak[3]);
  165.     if eof(bb) then
  166.     begin
  167.      l:=l+1;
  168.      read(bb,znak[4]);
  169.      if eof(bb) then
  170.      begin
  171.        k:=1;
  172.      end;
  173.     end;
  174.   end;
  175.  end;
  176. end;
  177.  
  178. close(bb);
  179.  
  180. if para='0782' then write(aa,chr(26));
  181.  
  182. close(aa);
  183. erase(bb);
  184.  
  185.  
  186. end;
  187.  
  188.  
  189. end; { konec procedury }
  190.  
  191.  
  192.  
  193.  
  194.  
  195. begin
  196.  
  197.  
  198.    par:=paramcount;
  199.    para:=paramstr(1);
  200.  
  201.  
  202. {   par:=2;
  203.    para:='0780';
  204.    parb:='b.zip';
  205. }
  206.  
  207.  
  208.    if par>0 then
  209.    begin
  210.  
  211.  
  212.     textcolor(7);
  213.     textbackground(1);
  214.     cls;
  215.  
  216.     dd[1]:='Ukládám data, vyçkejte..';
  217.     oknno(0,0,1,1);
  218.  
  219.     soubory('c:\trell\data\*.dbf','c:\hubla',1);
  220.  
  221.     assign(hh,'c:\hubla');
  222.     reset(hh);
  223.     while not(eof(hh)) do
  224.     begin
  225.  
  226.        readln(hh,parb);
  227.        parb:='C:\trell\data\'+parb;
  228.  
  229.        assign(ii,parb);
  230.        reset(ii);
  231.        read(ii,paka);
  232.        close(ii);
  233.  
  234.        if paka='Kolben' then
  235.        begin
  236.          if para='0782' then preved;
  237.        end
  238.        else
  239.        begin
  240.          if para='0780' then preved;
  241.        end;
  242.  
  243.     end;
  244.     close(hh);
  245.     erase(hh);
  246.  
  247.  
  248.    end;
  249.  
  250. end.