home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kompon / d123456 / STR_BIT.ZIP / UTIL / TFIX.TXT < prev   
Text File  |  1999-04-22  |  8KB  |  322 lines
  1. >Let's pause here for a moment. We indeed have the various solutions
  2. >for the RTE200 problem when the source code is available. The
  3. >current question, however, seems somewhat a different variation. Is
  4. >there anything a user can do for just an .exe or a .tpu unit with
  5. >this problem? At least our TP FAQ #124 does not yet mention anything
  6. >on this twist. The only solution I can thing of off-hand are the
  7. >slowdown programs.
  8.  
  9. How about this: Tfix.pas. It is used as a loader program: Tfix program
  10. parameters. As one can see it is derived from the fdelay unit. However,
  11. accurate delay cannot be reproduced, instead maximum value: 65535 is
  12. used for the delay loop. It requires TP 6.0+ to compile.
  13.  
  14. {$M 1100,0,0}
  15.  
  16. Program TFix;
  17.  
  18. uses dos;  { better not use CRT :-) }
  19.  
  20.  
  21. procedure oldints; assembler; { "variables" in the code segment }
  22.           asm dd 0,0; db 0 end;
  23.  
  24.  
  25.  
  26. Procedure Int0; assembler;
  27.           asm
  28.           cmp byte ptr oldints+8,0     { Done with the fix? }
  29.           jnz @old
  30.  
  31.           cmp cx,55       { If CX<>55 we are at some other point }
  32.           jne @x
  33.           cmp dx,cx       { If DX<CX we are at some other point }
  34.           jae @ok
  35.  
  36. @x:       mov byte ptr oldints+8,1     { unexpected division overflow }
  37.                                        { we are done with the fix }
  38.  
  39. @old:     jmp dword ptr oldints
  40.  
  41. @ok:
  42.           mov dx,54                    { slowest possible delay }
  43.           mov ax,65535
  44.           mov byte ptr oldints+8,1     { we are done with the fix }
  45.           iret                         { return to the DIV (286+) }
  46.           end;
  47.  
  48.  
  49.  
  50. Procedure Int21h; assembler;
  51.           asm
  52.           cmp byte ptr oldints+8,0
  53.           jnz @old
  54.  
  55.           cmp ax,$2500
  56.           jne @x
  57.           mov word ptr oldints,dx
  58.           mov word ptr oldints+2,ds
  59.           iret
  60.  
  61. @x:
  62.           cmp ax,$251B
  63.           jne @old                      { Not setint 1Bh? }
  64.           mov byte ptr oldints+8,1      { inactivate! }
  65.  
  66.  
  67. @old:     jmp dword ptr oldints+4
  68.  
  69.           end;
  70.  
  71.  
  72. type tr=record int0,int21:pointer; flag:byte End;
  73.      pr=^tr;
  74.  
  75.      ps=^string;
  76.  
  77. var i,j:integer;
  78.     cline:string[128];
  79.     pname:pathstr;
  80.     i21save,i00save:pointer;
  81.  
  82.     int:array[0..255] of pointer absolute 0:0;
  83.  
  84. begin
  85.   cline:=ps(ptr(prefixseg,128))^;
  86.   while (cline<>'') and (cline[1]=' ') do delete(cline,1,1);
  87.  
  88.   i:=1;
  89.   while (i<=length(cline)) and (cline[i]<>' ') do inc(i);
  90.   pname:=copy(cline,1,i-1);
  91.   for j:=1 to length(pname) do pname[j]:=upcase(pname[j]);
  92.   j:=length(pname);
  93.   while (j>0) and not (pname[j] in ['\','/','.']) do dec(j);
  94.   if (j=0) or (pname[j]<>'.') then  pname:=pname+'.EXE';
  95.   pname:=fsearch(pname,getenv('path'));
  96.  
  97.   if pname<>'' then begin
  98.      swapvectors;
  99.  
  100.      GetIntVec(0,i00save);
  101.      GetIntVec($21,i21save);
  102.  
  103.      with pr(@oldints)^ do begin
  104.        int0:=i00Save;
  105.        int21:=i21save;
  106.        flag:=0;
  107.      End;
  108.  
  109.      SetIntVec(0,@int0);
  110.      SetIntVec($21,@int21h);
  111.  
  112.      exec(pname,copy(cline,i,255));
  113.  
  114.      SetIntVec($21,i21Save);     { Note the order, int 21h first so }
  115.      SetIntVec(0,i00Save);       { it does not catch the setting of int 0}
  116.  
  117.      swapvectors;
  118.   end
  119.   else begin
  120.          Writeln('TFix: Error: program not found');
  121.          Writeln('Usage: TFix program [parameters]')
  122.        End;
  123.  
  124. end.
  125.  
  126. The following program can be used to patch the programs. If one gives
  127. just the name of the program as parameters,. it will give a temporary
  128. fix but in that case delays should work OK. The patch should be good for
  129. about 5 years. If one gives also parameter /nd then the delays will be set
  130. to zero. This fixes the program for good and should also also with PM.
  131.  
  132. If one chooses first option then the program can be patched again after some
  133. time or by explicitly specifying the factor. If one fixes with /nd it
  134. cannot be reversed. Make backups and keep them.
  135.  
  136. {$n-}
  137. Program Dfix;
  138.  
  139. uses dos;
  140.  
  141. Var buff:array[1..32768] of byte;
  142.  
  143.  
  144. Var factor:1..1191;
  145.  
  146. const Division:array[1..10] of integer=
  147.                ($f7,$d0,$f7,$d2,$B9,-1,-1,$f7,$f1,$a3);
  148.  
  149.  
  150.       delay:array[1..19] of integer=($8e,6,-1,-1,$33,$ff,$26,$8a,$1d,
  151.                                      $a1,-1,-1,$33,$d2,$e8,5,0,$e2,$f6);
  152.  
  153.  
  154.       newdelay:array[1..19] of byte=($33,$ff,$8e,$c7,$26,$8a,$1d,
  155.                                      $b8,0,0,$f7,$26,0,0,$e8,5,0,$e2,$f4);
  156.  
  157.       fixeddelay:array[1..19] of integer=($33,$ff,$8e,$c7,$26,$8a,$1d,$b8,
  158.                                           -1,-1,$f7,$26,-1,-1,$e8,5,0,$e2,$f4);
  159.  
  160.  
  161.       delayloop:array[1..14] of integer=($2d,1,0,$83,$da,0,$72,5,$26,
  162.                                          $3a,$1d,$74,$f3,$c3);
  163.  
  164.  
  165. Procedure Backup(st:string);
  166. var fp,fp2:file;
  167.     s:string[4];
  168.     d:dirstr;
  169.     n:namestr;
  170.     e:extstr;
  171.     i:integer;
  172.     bytesread:word;
  173.     t:longint;
  174. begin
  175.   fsplit(st,d,n,e);
  176.   {$i-}
  177.   for i:=1 to 999 do begin
  178.     str(1000+i:3,s);
  179.     delete(s,1,1);
  180.     assign(fp,d+n+'.'+s);
  181.     reset(fp,1);
  182.     if ioresult>0 then break;
  183.     close(fp);
  184.     if ioresult>0 then;
  185.   End;
  186.   {$i+}
  187.   assign(fp,d+n+'.'+s);
  188.   rewrite(fp,1);
  189.   assign(fp2,st);
  190.   reset(fp2,1);
  191.   repeat
  192.     blockread(fp2,buff,sizeof(buff),bytesread);
  193.     blockwrite(fp,buff,bytesread);
  194.   until bytesread=0;
  195.   getftime(fp2,t);
  196.   setftime(fp,t);
  197.   close(fp);
  198.   close(fp2);
  199. End;
  200.  
  201.  
  202.  
  203.  
  204. var ind:longint;
  205.     i,j:integer;
  206.     bytesread:word;
  207.     fp:file;
  208.  
  209.  
  210. Function Find(data:array of integer):longint;
  211. var ind:longint;
  212. label out;
  213. Begin
  214.   ind:=0;
  215.   repeat
  216.     seek(fp,ind);
  217.     blockread(fp,buff,sizeof(buff),bytesread);
  218.     i:=1;
  219.     while i<bytesread-20 do begin
  220.       if buff[i]=data[0] then begin
  221.          for j:=1 to high(data) do if (data[j]>=0) and (buff[i+j]<>data[j])
  222.              then goto out;
  223.          Find:=ind+i-1;
  224.          exit;
  225.       End;
  226.    out:
  227.      inc(i);
  228.     End;
  229.     inc(ind,bytesread-50);
  230.  until bytesread<=50;
  231.  find:=-1;
  232. End;
  233.  
  234.  
  235. Procedure Error;
  236. begin
  237.   Writeln('Dfix: Could not find CRT unit!"');
  238.   close(fp);
  239.   halt;
  240. End;
  241.  
  242.  
  243.  
  244. Procedure FixNoDelay;
  245. var x:byte;
  246.     ind:longint;
  247. Begin
  248.   ind:=find(Delayloop);
  249.   if ind<0 then error;
  250.   x:=$c3;
  251.   Seek(fp,ind);
  252.   blockwrite(fp,x,1);
  253. End;
  254.  
  255.  
  256. Procedure FixDelay;
  257. var ind,ind2,countindex:longint;
  258.  
  259.     xx:word;
  260. Begin
  261.   ind:=Find(Division);
  262.   if ind<0 then error;
  263.   ind2:=Find(Delay);
  264.   Countindex:=ind2+10;
  265.   if ind2<0 then begin
  266.       ind2:=Find(FixedDelay);
  267.       if ind2<0 then error;
  268.       countindex:=ind2+12;
  269.   End;
  270.  
  271.   if factor=1191 then xx:=65535
  272.                  else xx:=55*factor;
  273.  
  274.   seek(fp,countindex);
  275.   blockread(fp,newdelay[13],2);
  276.  
  277.   seek(fp,ind+5);
  278.   blockwrite(fp,xx,2);
  279.   seek(fp,ind2);
  280.   newdelay[9]:=lo(factor);
  281.   newdelay[10]:=hi(factor);
  282.  
  283.   Blockwrite(fp,newdelay,sizeof(newdelay));
  284. End;
  285.  
  286.  
  287. var x:word;
  288.     err:integer;
  289.     d,m,y,dw:word;
  290.     ps2:string[4];
  291.     fr:real;
  292.  
  293. begin
  294.   getdate(y,d,m,dw);
  295.   fr:=10*exp((y-1998)/1.5*ln(2));       { Moore's law }
  296.   if fr>1191 then factor:=1191
  297.              else factor:=trunc(fr);
  298.   filemode:=2;
  299.   if paramcount<1 then runerror(255);
  300.   assign(fp,paramstr(1));
  301.   backup(paramstr(1));
  302.   reset(fp,1);
  303.   val(paramstr(2),x,err);
  304.   if err=0 then factor:=x;
  305.   ps2:=paramstr(2);
  306.   for d:=1 to length(ps2) do ps2[d]:=upcase(ps2[d]);
  307.  
  308.   if (ps2='/ND') then begin
  309.      FixNoDelay;
  310.      Writeln('Program fixed by disabling delays');
  311.   End
  312.   else begin
  313.           FixDelay;
  314.           Writeln('Program fixed with factor ',factor);
  315.        end;
  316.   close(fp);
  317. End.
  318.  
  319.  
  320.  
  321. Osmo
  322.