ReplaceEx2

[Janilabo]

Here it is! Finally done.

While working on this, I got around some little bugs that were left in Find(). So I fixed em aswell.

 

Included test script.

 

const
 TEXT = 'TestesTESTTestest test TEST Test Test.';
 FIND_STR = 'test';  
 REPLACE_STR = '*';

type           
 TMatchMethod = (mmAll, mmBackward, mmIgnoreCase, mmOverlap, mmWholeWords, mmStrictWW);
 TMatchMethods = set of TMatchMethod;

function ReplaceEx2(Text, FindStr, ReplaceStr: string; Methods: TMatchMethods; Offset: Integer): string;
var
 fsL, tL, i, c, e, t: Integer;
 rgx_fs, tmp: string;
 r: TRegexMatchArray;
 p: TIntArray;
begin
 Result := Text;
 tL := Length(Text);
 fsL := Length(FindStr);
 if ((tL < 1) or (Length(FindStr) > tL) or (FindStr = '')) then
   Exit;
 if (Offset < 1) then
   Offset := 1;   
 FindStr := PregQuote(FindStr);  
 if (mmWholeWords in Methods) then
 begin
   if (mmStrictWW in Methods) then  
     rgx_fs := '/(?<!\S)' + FindStr + '(?!\S)/'
   else
     rgx_fs := '/(^|\(?<=\s))' + FindStr + '((?=\s)|\$)/'
 end else
   rgx_fs := '/' + FindStr + '/';
 if (mmIgnoreCase in Methods) then
   rgx_fs := (rgx_fs + 'i');
 rgx_fs := (rgx_fs + 'm');   
 case (mmBackward in Methods) of
   True:
   begin      
     Result := Copy(Text, 1, Offset);    
     tmp := Result;     
     SetLength(p, Length(tmp));
     while PregMatchEx(rgx_fs, tmp, r) do
     begin
       p[c] := (r[0].Offset + c); 
       Inc(c);
       Delete(tmp, r[0].Offset, 1);
       SetLength(r, 0);
     end;        
     SetLength(p, c);
     TIAUnique(p);
     c := Length(p);
     InvertTIA(p); 
     if (c > 0) then
       if not (mmAll in Methods) then
       begin
         Delete(Result, p[0], fsL);
         Insert(ReplaceStr, Result, p[0]);
       end else
       case (not (mmWholeWords in Methods) and (mmOverlap in Methods)) of
         True: 
         for i := 0 to (c - 1) do
         begin      
           e := fsL;
           if (i > 0) then
             if ((p[(i - 1)] - p[i]) <= fsL) then
               e := (p[(i - 1)] - p[i]); 
           Delete(Result, p[i], e);
           Insert(ReplaceStr, Result, p[i]);
         end; 
         False:   
         begin   
           e := 0;
           if (mmWholeWords in Methods) then
             e := 1;
           for i := 0 to (c - 1) do
           begin                                        
             Inc(t);
             if (i > 0) then
               if ((p[(i - t)] - p[i]) < (fsL - e)) then
                 Continue; 
             Delete(Result, p[i], fsL); 
             Insert(ReplaceStr, Result, p[i]);
             t := 0;
           end;
         end;
       end; 
     Result := (Result + Copy(Text, (Offset + 1), (Length(Text) - Offset))); 
   end;   
   False:
   begin
     Result := Copy(Text, Offset, ((tL - Offset) + 1)); 
     case (mmAll in Methods) of 
       True:
       begin 
         if (not (mmWholeWords in Methods) and (mmOverlap in Methods)) then
         begin
           tmp := Result;
           SetLength(p, Length(tmp));
           while PregMatchEx(rgx_fs, tmp, r) do
           begin
             p[c] := (r[0].Offset + c); 
             Inc(c);
             Delete(tmp, r[0].Offset, 1);
             SetLength(r, 0);
           end;        
           SetLength(p, c);
           TIAUnique(p);
           c := Length(p);
           for i := (c - 1) downto 0 do
           begin           
             e := fsL;
             if (i < (c - 1)) then
               if ((p[(i + 1)] - p[i]) <= fsL) then
                 e := (p[(i + 1)] - p[i]);         
             Delete(Result, p[i], e);
             Insert(ReplaceStr, Result, p[i]);
           end;
         end else
           Result := PregReplace(rgx_fs, ReplaceStr, Result);  
       end;
       False:
       if PregMatchEx(rgx_fs, Result, r) then
       begin
         Result := (Copy(Result, 1, (r[0].Offset - 1)) + ReplaceStr + Copy(Result, (r[0].Offset + r[0].Length), (Length(Result) - (r[0].Offset + r[0].Length) + 1)));
         SetLength(r, 0);   
       end;
     end;                                                               
     Result := (Copy(Text, 1, (Offset - 1)) + Result);     
   end;
 end;  
 SetLength(p, 0);
 tmp := '';     
end;

var
 rTEXT: string;
 l, i, s, o: Integer;
 m_sets: array of TMatchMethods;
 TSA: TStrArray;

procedure BuildSets(find_method: (fmBackward, fmForward));
begin
 case find_method of
   fmForward:
   begin
     TSA := ['[]', '[mmIgnoreCase]', '[mmIgnoreCase, mmAll]', '[mmIgnoreCase, mmAll, mmOverlap]', '[mmIgnoreCase, mmAll, mmOverlap, mmWholeWords]', '[mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW]'];
     l := Length(FIND_STR);
     o := 1;   
     s := High(TSA); 
     SetLength(m_sets, (s + 1));
     m_sets[0] := [];
     m_sets[1] := [mmIgnoreCase];
     m_sets[2] := [mmIgnoreCase, mmAll];
     m_sets[3] := [mmIgnoreCase, mmAll, mmOverlap];
     m_sets[4] := [mmIgnoreCase, mmAll, mmOverlap, mmWholeWords];
     m_sets[5] := [mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW];  
   end;
   fmBackward:
   begin
     TSA := ['[mmBackward]', '[mmBackward, mmIgnoreCase]', '[mmBackward, mmIgnoreCase, mmAll]', '[mmBackward, mmIgnoreCase, mmAll, mmOverlap]', '[mmBackward, mmIgnoreCase, mmAll, mmOverlap, mmWholeWords]', '[mmBackward, mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW]'];
     l := Length(FIND_STR);
     o := Length(TEXT);
     s := High(TSA); 
     SetLength(m_sets, (s + 1));
     m_sets[0] := [mmBackward];
     m_sets[1] := [mmBackward, mmIgnoreCase];
     m_sets[2] := [mmBackward, mmIgnoreCase, mmAll];
     m_sets[3] := [mmBackward, mmIgnoreCase, mmAll, mmOverlap];
     m_sets[4] := [mmBackward, mmIgnoreCase, mmAll, mmOverlap, mmWholeWords];
     m_sets[5] := [mmBackward, mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW];  
   end;    
 end;
end;

begin                
 ClearDebug;                              
 BuildSets(fmForward);      
 WriteLn('FORWARD:');
 for i := 0 to s do
 begin
   rTEXT := ReplaceEx2(TEXT, FIND_STR, REPLACE_STR, m_sets[i], o); 
   WriteLn('ReplaceEx2(''' + TEXT + ''', ''' + FIND_STR + ''', ''' + REPLACE_STR + ''', ' + TSA[i] + ', ' + IntToStr(o) + ')');
   WriteLn('TEXT: ' + rTEXT);
   if (i < s) then 
     WriteLn('');
 end;               
 BuildSets(fmBackward);
 WriteLn('BACKWARD:'); 
 for i := 0 to s do
 begin
   rTEXT := ReplaceEx2(TEXT, FIND_STR, REPLACE_STR, m_sets[i], o); 
   WriteLn('ReplaceEx2(''' + TEXT + ''', ''' + FIND_STR + ''', ''' + REPLACE_STR + ''', ' + TSA[i] + ', ' + IntToStr(o) + ')');
   WriteLn('TEXT: ' + rTEXT);
   if (i < s) then 
     WriteLn('');
 end;
 SetLength(m_sets, 0);
 SetLength(TSA, 0);       
end.

Edited August 31, 2012 by Janilabo
Fixes.

[Bixby Sayz]

I love seeing creativity like this.

[TerryKig]

where is crypto arena 1070 nvidia bitcoin mining can you buy litecoin with bitcoin cyberopolis crypto buy bitcoin with amex iso 20022 compliant coins crypto capacity bitstop bitcoin atm crypto whale tracker cherry crypto most profitable fish pond stardew buying bitcoin on cantor exchange bitcoin scammer list whatsapp how to buy into bitcoin canada axi crypto

best way to buy bitcoin in the us will ripple hit 1000 leash crypto nano coin price amp crypto futures amazon accepting crypto 35000 bitcoin value how to withdraw money from crypto com best bitcoin buys league of legends teddy

buy bitcoin ph review buy.bitcoin.com review bandchain 00194520 bitcoin to usd crypto live ticker $rndr can people in china buy bitcoin dogecoin highest price ever chart of cryptocurrency market cap how much is 1 crypto worth

buy steroids with bitcoin btc marketwatch buy intel bitcoin miner how do you buy a physical bitcoin realm crypto base coin totem crypto zksync token how to invest in bitcoin on schwab best buy bitcoin canada

1 bitcoin a cuГЎntos dГіlares equivale stafi benefits of crypto wallets how to mine crypto on iphone octopus crypto