Jump to content
Janilabo

ReplaceEx2

Recommended Posts

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 by Janilabo
Fixes.
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



×
  • Create New...