Chip 2002 September/Chip_2002-09_cd1.bin/zkuste/delphi/kompon/d123456/STR_BIT.ZIP/UTIL/TFIX.TXT

Text File | 1999-04-22 | 7.5 KB | 322 lines

>Let's pause here for a moment. We indeed have the various solutions
>for the RTE200 problem when the source code is available. The
>current question, however, seems somewhat a different variation. Is
>there anything a user can do for just an .exe or a .tpu unit with
>this problem? At least our TP FAQ #124 does not yet mention anything
>on this twist. The only solution I can thing of off-hand are the
>slowdown programs.

How about this: Tfix.pas. It is used as a loader program: Tfix program
parameters. As one can see it is derived from the fdelay unit. However,
accurate delay cannot be reproduced, instead maximum value: 65535 is
used for the delay loop. It requires TP 6.0+ to compile.

{$M 1100,0,0}

Program TFix;

uses dos;  { better not use CRT :-) }


procedure oldints; assembler; { "variables" in the code segment }
          asm dd 0,0; db 0 end;



Procedure Int0; assembler;
          asm
          cmp byte ptr oldints+8,0     { Done with the fix? }
          jnz @old

          cmp cx,55       { If CX<>55 we are at some other point }
          jne @x
          cmp dx,cx       { If DX<CX we are at some other point }
          jae @ok

@x:       mov byte ptr oldints+8,1     { unexpected division overflow }
                                       { we are done with the fix }

@old:     jmp dword ptr oldints

@ok:
          mov dx,54                    { slowest possible delay }
          mov ax,65535
          mov byte ptr oldints+8,1     { we are done with the fix }
          iret                         { return to the DIV (286+) }
          end;



Procedure Int21h; assembler;
          asm
          cmp byte ptr oldints+8,0
          jnz @old

          cmp ax,$2500
          jne @x
          mov word ptr oldints,dx
          mov word ptr oldints+2,ds
          iret

@x:
          cmp ax,$251B
          jne @old                      { Not setint 1Bh? }
          mov byte ptr oldints+8,1      { inactivate! }


@old:     jmp dword ptr oldints+4

          end;


type tr=record int0,int21:pointer; flag:byte End;
     pr=^tr;

     ps=^string;

var i,j:integer;
    cline:string[128];
    pname:pathstr;
    i21save,i00save:pointer;

    int:array[0..255] of pointer absolute 0:0;

begin
  cline:=ps(ptr(prefixseg,128))^;
  while (cline<>'') and (cline[1]=' ') do delete(cline,1,1);

  i:=1;
  while (i<=length(cline)) and (cline[i]<>' ') do inc(i);
  pname:=copy(cline,1,i-1);
  for j:=1 to length(pname) do pname[j]:=upcase(pname[j]);
  j:=length(pname);
  while (j>0) and not (pname[j] in ['\','/','.']) do dec(j);
  if (j=0) or (pname[j]<>'.') then  pname:=pname+'.EXE';
  pname:=fsearch(pname,getenv('path'));

  if pname<>'' then begin
     swapvectors;

     GetIntVec(0,i00save);
     GetIntVec($21,i21save);

     with pr(@oldints)^ do begin
       int0:=i00Save;
       int21:=i21save;
       flag:=0;
     End;

     SetIntVec(0,@int0);
     SetIntVec($21,@int21h);

     exec(pname,copy(cline,i,255));

     SetIntVec($21,i21Save);     { Note the order, int 21h first so }
     SetIntVec(0,i00Save);       { it does not catch the setting of int 0}

     swapvectors;
  end
  else begin
         Writeln('TFix: Error: program not found');
         Writeln('Usage: TFix program [parameters]')
       End;

end.

The following program can be used to patch the programs. If one gives
just the name of the program as parameters,. it will give a temporary
fix but in that case delays should work OK. The patch should be good for
about 5 years. If one gives also parameter /nd then the delays will be set
to zero. This fixes the program for good and should also also with PM.

If one chooses first option then the program can be patched again after some
time or by explicitly specifying the factor. If one fixes with /nd it
cannot be reversed. Make backups and keep them.

{$n-}
Program Dfix;

uses dos;

Var buff:array[1..32768] of byte;


Var factor:1..1191;

const Division:array[1..10] of integer=
               ($f7,$d0,$f7,$d2,$B9,-1,-1,$f7,$f1,$a3);


      delay:array[1..19] of integer=($8e,6,-1,-1,$33,$ff,$26,$8a,$1d,
                                     $a1,-1,-1,$33,$d2,$e8,5,0,$e2,$f6);


      newdelay:array[1..19] of byte=($33,$ff,$8e,$c7,$26,$8a,$1d,
                                     $b8,0,0,$f7,$26,0,0,$e8,5,0,$e2,$f4);

      fixeddelay:array[1..19] of integer=($33,$ff,$8e,$c7,$26,$8a,$1d,$b8,
                                          -1,-1,$f7,$26,-1,-1,$e8,5,0,$e2,$f4);


      delayloop:array[1..14] of integer=($2d,1,0,$83,$da,0,$72,5,$26,
                                         $3a,$1d,$74,$f3,$c3);


Procedure Backup(st:string);
var fp,fp2:file;
    s:string[4];
    d:dirstr;
    n:namestr;
    e:extstr;
    i:integer;
    bytesread:word;
    t:longint;
begin
  fsplit(st,d,n,e);
  {$i-}
  for i:=1 to 999 do begin
    str(1000+i:3,s);
    delete(s,1,1);
    assign(fp,d+n+'.'+s);
    reset(fp,1);
    if ioresult>0 then break;
    close(fp);
    if ioresult>0 then;
  End;
  {$i+}
  assign(fp,d+n+'.'+s);
  rewrite(fp,1);
  assign(fp2,st);
  reset(fp2,1);
  repeat
    blockread(fp2,buff,sizeof(buff),bytesread);
    blockwrite(fp,buff,bytesread);
  until bytesread=0;
  getftime(fp2,t);
  setftime(fp,t);
  close(fp);
  close(fp2);
End;




var ind:longint;
    i,j:integer;
    bytesread:word;
    fp:file;


Function Find(data:array of integer):longint;
var ind:longint;
label out;
Begin
  ind:=0;
  repeat
    seek(fp,ind);
    blockread(fp,buff,sizeof(buff),bytesread);
    i:=1;
    while i<bytesread-20 do begin
      if buff[i]=data[0] then begin
         for j:=1 to high(data) do if (data[j]>=0) and (buff[i+j]<>data[j])
             then goto out;
         Find:=ind+i-1;
         exit;
      End;
   out:
     inc(i);
    End;
    inc(ind,bytesread-50);
 until bytesread<=50;
 find:=-1;
End;


Procedure Error;
begin
  Writeln('Dfix: Could not find CRT unit!"');
  close(fp);
  halt;
End;



Procedure FixNoDelay;
var x:byte;
    ind:longint;
Begin
  ind:=find(Delayloop);
  if ind<0 then error;
  x:=$c3;
  Seek(fp,ind);
  blockwrite(fp,x,1);
End;


Procedure FixDelay;
var ind,ind2,countindex:longint;

    xx:word;
Begin
  ind:=Find(Division);
  if ind<0 then error;
  ind2:=Find(Delay);
  Countindex:=ind2+10;
  if ind2<0 then begin
      ind2:=Find(FixedDelay);
      if ind2<0 then error;
      countindex:=ind2+12;
  End;

  if factor=1191 then xx:=65535
                 else xx:=55*factor;

  seek(fp,countindex);
  blockread(fp,newdelay[13],2);

  seek(fp,ind+5);
  blockwrite(fp,xx,2);
  seek(fp,ind2);
  newdelay[9]:=lo(factor);
  newdelay[10]:=hi(factor);

  Blockwrite(fp,newdelay,sizeof(newdelay));
End;


var x:word;
    err:integer;
    d,m,y,dw:word;
    ps2:string[4];
    fr:real;

begin
  getdate(y,d,m,dw);
  fr:=10*exp((y-1998)/1.5*ln(2));       { Moore's law }
  if fr>1191 then factor:=1191
             else factor:=trunc(fr);
  filemode:=2;
  if paramcount<1 then runerror(255);
  assign(fp,paramstr(1));
  backup(paramstr(1));
  reset(fp,1);
  val(paramstr(2),x,err);
  if err=0 then factor:=x;
  ps2:=paramstr(2);
  for d:=1 to length(ps2) do ps2[d]:=upcase(ps2[d]);

  if (ps2='/ND') then begin
     FixNoDelay;
     Writeln('Program fixed by disabling delays');
  End
  else begin
          FixDelay;
          Writeln('Program fixed with factor ',factor);
       end;
  close(fp);
End.



Osmo