uses crt,dos, windos;
var s:array[1..4096]of char;
    fl:TSearchRec;
    FN:String;Exp:string;


Function IsEq(s1:string;n:integer):boolean;
Var I:Integer;
begin
 I:=1;
 while(i<=length(s1))and(s1[i]=s[n-1+i])do inc(i);
 IsEq:=i>length(s1);
end;

Function El(n:integer):boolean;
begin
EL:=IsEq(#13#10,n-1);
{If (n>=1)and(s[n-1]=#13)and(s[n]=#10)then El:=true else El:=False;}
end;

Procedure ReplaceF(nm,exp:string);
var f1,f2,f3:file of char;
    Changed:boolean;
    i,j:integer;
{$I-}
begin
 Assign(f1,nm); Assign(f2,'~rn~.TMP');
 Reset(f1);ReWrite(f2);
 Changed:=false;
 While not eof(f1) do begin
  i:=1;
  repeat
   read(f1,s[i]);
   inc(i);
  Until (eof(f1))or(i=4096)or(el(i-1));
  if not IsEq(exp,1)then for j:=1 to i-1 do write(f2,s[j]) else Changed:=true;
 End;
 if Changed then begin
  MkDir('Bak');
  Assign(f3,'Bak\'+nm);
  Erase(f3);
  Rename(f1,'Bak\'+nm);
  Rename(f2,nm);
 end;
 Close(F1);Close(f2);
end;
{$I-}
begin
 If ParamCount=0 then begin Write('Expresia: ');Readln(Exp); end else
 If ParamCount=1 then begin Exp:=ParamStr(1); end else
 If ParamCount=2 then begin Exp:=ParamStr(1); Fn:=ParamStr(2);end;

 If ParamCount<2 then begin
  FindFirst('*.*', $2f, fl);
  while DosError = 0 do
  begin
    ReplaceF(fl.Name,Exp);
    FindNext(fl);
  end;
 end else ReplaceF(fn,exp);
end.