Arsip: Fungsi StringReplace dengan banyak Pattern

Function kifStringReplace(const S: String; const OldPattern,
NewPattern: Array Of String; Flags: TReplaceFlags): String;
Var
i, m, L, R: Integer;
P, SearchStr: PChar;
match: Boolean;
Begin
Result:= '';
m:= High(OldPattern);
If High(NewPattern) < m Then m:= High(NewPattern);
If m < 0 Then Exit;
SearchStr:= PChar(S);
P:= Pointer(Integer(SearchStr) + Length(S));
L:= 1; R:= 0;
While SearchStr < P do
Begin
Inc(R);
match:= False;
For i:= 0 To m Do
Begin
If rfIgnoreCase In Flags Then
match:= AnsiStrLIComp(SearchStr,
PChar(OldPattern[i]), Length(OldPattern[i])) = 0
Else
match:= AnsiStrLComp(SearchStr,
PChar(OldPattern[i]), Length(OldPattern[i])) = 0;
If match Then Break;
End;
If Not match Then
Begin
SearchStr := Pointer(Integer(SearchStr) + 1);
Continue;
End;
Result:= Result + Copy(S, L, R - L) + NewPattern[i];
R:= R + (Length(OldPattern[i]) - 1);
L:= R + 1;
If Not (rfReplaceAll In Flags) Then Break;
SearchStr := Pointer(Integer(SearchStr) + Length(OldPattern[i]));
End;
If L < Length(S) Then
Result:= Result + Copy(S, L, (Length(S) + 1) - L);
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo2.Clear;
If Memo1.Text = '' Then Exit;
Memo2.Text:= kifStringReplace(Memo1.Text,
['hacking', 'Hack', 'cracking', 'Crack'],
['hck n!', 'h!**', 'C4C1N9', 'c3c4k'],
[rfReplaceAll, rfIgnoreCase]);
end;