Standard URL encode function? - delphi
Is there a Delphi equivalent of this .net's method:
Url.UrlEncode()
Note
I haven't worked with Delphi for several years now.
As I read through the answers I notice that there are several remarks and alternatives to the currently marked answer. I haven't had the opportunity to test them so I'm basing my answer on the most upvoted.
For your own sake, do check later answers and after deciding upvote the best answer so everybody can benefit from your experience.
Look at indy IdURI unit, it has two static methods in the TIdURI class for Encode/Decode the URL.
uses
IdURI;
..
begin
S := TIdURI.URLEncode(str);
//
S := TIdURI.URLDecode(str);
end;
Another simple way of doing this is to use the HTTPEncode function in the HTTPApp unit - very roughly
Uses
HTTPApp;
function URLEncode(const s : string) : string;
begin
result := HTTPEncode(s);
end
HTTPEncode is deprecated in Delphi 10.3 - 'Use TNetEncoding.URL.Decode'
Uses
NetEncoding;
function URLEncode(const s : string) : string;
begin
result := TNetEncoding.URL.Encode(s);
end
I made myself this function to encode everything except really safe characters. Especially I had problems with +. Be aware that you can not encode the whole URL with this function but you need to encdoe the parts that you want to have no special meaning, typically the values of the variables.
function MyEncodeUrl(source:string):string;
var i:integer;
begin
result := '';
for i := 1 to length(source) do
if not (source[i] in ['A'..'Z','a'..'z','0','1'..'9','-','_','~','.']) then result := result + '%'+inttohex(ord(source[i]),2) else result := result + source[i];
end;
Another option, is to use the Synapse library which has a simple URL encoding method (as well as many others) in the SynaCode unit.
uses
SynaCode;
..
begin
s := EncodeUrl( str );
//
s := DecodeUrl( str );
end;
Since Delphi xe7 you can use TNetEncoding.Url.Encode()
Update 2018: the code shown below seems to be outdated. see Remy's comment.
class function TIdURI.ParamsEncode(const ASrc: string): string;
var
i: Integer;
const
UnsafeChars = '*#%<> []'; {do not localize}
begin
Result := ''; {Do not Localize}
for i := 1 to Length(ASrc) do
begin
if CharIsInSet(ASrc, i, UnsafeChars) or (not CharIsInSet(ASrc, i, CharRange(#33,#128))) then begin {do not localize}
Result := Result + '%' + IntToHex(Ord(ASrc[i]), 2); {do not localize}
end else begin
Result := Result + ASrc[i];
end;
end;
end;
From Indy.
Anyway Indy is not working properly so YOU NEED TO SEE THIS ARTICLE:
http://marc.durdin.net/2012/07/indy-tiduri-pathencode-urlencode-and-paramsencode-and-more/
In a non-dotnet environment, the Wininet unit provides access to Windows' WinHTTP encode function:
InternetCanonicalizeUrl
In recent versions of Delphi (tested with XE5), use the URIEncode function in the REST.Utils unit.
I was also facing the same issue (Delphi 4).
I resolved the issue using below mentioned function:
function fnstUrlEncodeUTF8(stInput : widestring) : string;
const
hex : array[0..255] of string = (
'%00', '%01', '%02', '%03', '%04', '%05', '%06', '%07',
'%08', '%09', '%0a', '%0b', '%0c', '%0d', '%0e', '%0f',
'%10', '%11', '%12', '%13', '%14', '%15', '%16', '%17',
'%18', '%19', '%1a', '%1b', '%1c', '%1d', '%1e', '%1f',
'%20', '%21', '%22', '%23', '%24', '%25', '%26', '%27',
'%28', '%29', '%2a', '%2b', '%2c', '%2d', '%2e', '%2f',
'%30', '%31', '%32', '%33', '%34', '%35', '%36', '%37',
'%38', '%39', '%3a', '%3b', '%3c', '%3d', '%3e', '%3f',
'%40', '%41', '%42', '%43', '%44', '%45', '%46', '%47',
'%48', '%49', '%4a', '%4b', '%4c', '%4d', '%4e', '%4f',
'%50', '%51', '%52', '%53', '%54', '%55', '%56', '%57',
'%58', '%59', '%5a', '%5b', '%5c', '%5d', '%5e', '%5f',
'%60', '%61', '%62', '%63', '%64', '%65', '%66', '%67',
'%68', '%69', '%6a', '%6b', '%6c', '%6d', '%6e', '%6f',
'%70', '%71', '%72', '%73', '%74', '%75', '%76', '%77',
'%78', '%79', '%7a', '%7b', '%7c', '%7d', '%7e', '%7f',
'%80', '%81', '%82', '%83', '%84', '%85', '%86', '%87',
'%88', '%89', '%8a', '%8b', '%8c', '%8d', '%8e', '%8f',
'%90', '%91', '%92', '%93', '%94', '%95', '%96', '%97',
'%98', '%99', '%9a', '%9b', '%9c', '%9d', '%9e', '%9f',
'%a0', '%a1', '%a2', '%a3', '%a4', '%a5', '%a6', '%a7',
'%a8', '%a9', '%aa', '%ab', '%ac', '%ad', '%ae', '%af',
'%b0', '%b1', '%b2', '%b3', '%b4', '%b5', '%b6', '%b7',
'%b8', '%b9', '%ba', '%bb', '%bc', '%bd', '%be', '%bf',
'%c0', '%c1', '%c2', '%c3', '%c4', '%c5', '%c6', '%c7',
'%c8', '%c9', '%ca', '%cb', '%cc', '%cd', '%ce', '%cf',
'%d0', '%d1', '%d2', '%d3', '%d4', '%d5', '%d6', '%d7',
'%d8', '%d9', '%da', '%db', '%dc', '%dd', '%de', '%df',
'%e0', '%e1', '%e2', '%e3', '%e4', '%e5', '%e6', '%e7',
'%e8', '%e9', '%ea', '%eb', '%ec', '%ed', '%ee', '%ef',
'%f0', '%f1', '%f2', '%f3', '%f4', '%f5', '%f6', '%f7',
'%f8', '%f9', '%fa', '%fb', '%fc', '%fd', '%fe', '%ff');
var
iLen,iIndex : integer;
stEncoded : string;
ch : widechar;
begin
iLen := Length(stInput);
stEncoded := '';
for iIndex := 1 to iLen do
begin
ch := stInput[iIndex];
if (ch >= 'A') and (ch <= 'Z') then
stEncoded := stEncoded + ch
else if (ch >= 'a') and (ch <= 'z') then
stEncoded := stEncoded + ch
else if (ch >= '0') and (ch <= '9') then
stEncoded := stEncoded + ch
else if (ch = ' ') then
stEncoded := stEncoded + '+'
else if ((ch = '-') or (ch = '_') or (ch = '.') or (ch = '!') or (ch = '*')
or (ch = '~') or (ch = '\') or (ch = '(') or (ch = ')')) then
stEncoded := stEncoded + ch
else if (Ord(ch) <= $07F) then
stEncoded := stEncoded + hex[Ord(ch)]
else if (Ord(ch) <= $7FF) then
begin
stEncoded := stEncoded + hex[$c0 or (Ord(ch) shr 6)];
stEncoded := stEncoded + hex[$80 or (Ord(ch) and $3F)];
end
else
begin
stEncoded := stEncoded + hex[$e0 or (Ord(ch) shr 12)];
stEncoded := stEncoded + hex[$80 or ((Ord(ch) shr 6) and ($3F))];
stEncoded := stEncoded + hex[$80 or ((Ord(ch)) and ($3F))];
end;
end;
result := (stEncoded);
end;
source : Java source code
I have made my own function. It converts spaces to %20, not to plus sign. It was needed to convert local file path to path for browser (with file:/// prefix). The most important is it handles UTF-8 strings. It was inspired by Radek Hladik's solution above.
function URLEncode(s: string): string;
var
i: integer;
source: PAnsiChar;
begin
result := '';
source := pansichar(s);
for i := 1 to length(source) do
if not (source[i - 1] in ['A'..'Z', 'a'..'z', '0'..'9', '-', '_', '~', '.', ':', '/']) then
result := result + '%' + inttohex(ord(source[i - 1]), 2)
else
result := result + source[i - 1];
end;
AFAIK you need to make your own.
Here is an example.
HTTPEncode
TIdUri or HTTPEncode has problems with unicode charactersets. Function below will do correct encoding for you.
function EncodeURIComponent(const ASrc: string): UTF8String;
const
HexMap: UTF8String = '0123456789ABCDEF';
function IsSafeChar(ch: Integer): Boolean;
begin
if (ch >= 48) and (ch <= 57) then Result := True // 0-9
else if (ch >= 65) and (ch <= 90) then Result := True // A-Z
else if (ch >= 97) and (ch <= 122) then Result := True // a-z
else if (ch = 33) then Result := True // !
else if (ch >= 39) and (ch <= 42) then Result := True // '()*
else if (ch >= 45) and (ch <= 46) then Result := True // -.
else if (ch = 95) then Result := True // _
else if (ch = 126) then Result := True // ~
else Result := False;
end;
var
I, J: Integer;
ASrcUTF8: UTF8String;
begin
Result := ''; {Do not Localize}
ASrcUTF8 := UTF8Encode(ASrc);
// UTF8Encode call not strictly necessary but
// prevents implicit conversion warning
I := 1; J := 1;
SetLength(Result, Length(ASrcUTF8) * 3); // space to %xx encode every byte
while I <= Length(ASrcUTF8) do
begin
if IsSafeChar(Ord(ASrcUTF8[I])) then
begin
Result[J] := ASrcUTF8[I];
Inc(J);
end
else if ASrcUTF8[I] = ' ' then
begin
Result[J] := '+';
Inc(J);
end
else
begin
Result[J] := '%';
Result[J+1] := HexMap[(Ord(ASrcUTF8[I]) shr 4) + 1];
Result[J+2] := HexMap[(Ord(ASrcUTF8[I]) and 15) + 1];
Inc(J,3);
end;
Inc(I);
end;
SetLength(Result, J-1);
end;
I'd like to point out that if you care much more about correctness than about efficiency, the simplest you can do is hex encode every character, even if it's not strictly necessary.
Just today I needed to encode a few parameters for a basic HTML login form submission. After going through all the options, each with their own caveats, I decided to write this naive version that works perfectly:
function URLEncode(const AStr: string): string;
var
LBytes: TBytes;
LIndex: Integer;
begin
Result := '';
LBytes := TEncoding.UTF8.GetBytes(AStr);
for LIndex := Low(LBytes) to High(LBytes) do
Result := Result + '%' + IntToHex(LBytes[LIndex], 2);
end;
Related
delete all words with more than 4 letters in a string (Pascal)?
I was assigned a task for university where I have to write a program which deletes all words with more than 4 letters. I really have no clue at all. I would be very thankful for any kind of help. VAR UserString: string; //должна быть строка на 40 символов и точку в конце i, n: byte; BEGIN Writeln('Enter the string:'); Readln(UserString); i:=0; n:=1; repeat //MAIN LOOP: inc(i); if (UserString[i] = ' ') or (UserString[i] = '.') then begin if (i-n<3)then begin delete(UserString, n, i-n+1); i:=n-1; end; n:=i+1 end until (UserString[i] = '.') or (i>length(UserString)); Writeln('Result String: ', UserString); END. I tried this. and its working on onlinegdb but not on Delphi... and I don't know why...
You should break up the logic into smaller utility functions for each task you need (finding a word, getting the word's length, deleting the word and any subsequent whitespace, etc). It will make the code easier to read and maintain. For example: function FindNextWordStart(const S: string; var Index: Integer): Boolean; var Len: Integer; begin Len := Length(S); while (Index <= Len) and (Ord(S[Index]) <= 32) do Inc(Index); Result := (Index <= Len); end; function GetWordLength(const S: string; Index: Integer): Integer; var StartIdx, Len: Integer; begin Len := Length(S); StartIdx := Index; while (Index <= Len) and (Ord(S[Index]) > 32) do Inc(Index); Result := (Index - StartIdx); end; procedure DeleteWord(var S: String; Index, WordLen: Integer); var StartIdx, Len: Integer; begin Len := Length(S); StartIdx := Index; Inc(Index, WordLen); while (Index <= Len) and (Ord(S[Index]) <= 32) do Inc(Index); Delete(S, StartIdx, Index - StartIdx); end; var UserString: string; StartIdx, WordLen: Integer; begin Writeln('Enter the string:'); Readln(UserString); StartIdx := 1; while FindNextWordStart(UserString, StartIdx) do begin WordLen := GetWordLength(UserString, StartIdx); if WordLen > 4 then DeleteWord(UserString, StartIdx, WordLen) else Inc(StartIdx, WordLen); end; Writeln('Result String: ', UserString); end. Online Demo
I guess you can solve your task with TStringlist class: uses Classes; ...... var AStrLst : TStringlist ; i : Integer , begin AStrLst := TStringlist.Create ; try // use this char for separation of words AStrLst.Delimiter :=' '; AStrLst.DelimitedText := ' here comes my sample string '; for I := AStrLst.Count-1 to 0 do begin // delete item from list if ... if length( trim(AStrLst[i])) <= 4 then AStrLst.Delete(i); end; finally // get the complete writeln ( AStrLst.Text ) ; AStrLst.Free; end; end; I did not test this code - but hope it helps - to get this code running, your home work
Update Knuth, Morris, Pratt algorithm to work with unicode
Have some old code (written by someone else) that I need to fix to work with Unicode strings in Delphi 10.1. EDIT: I've narrowed my question down to the following: code below fails with unicode strings. Suggestions? //global variable: var UpCaseLookup : array[ 1..255 ] of char; // ---- Knuth, Morris, Pratt: type failure = array[1..255] of word; procedure PrepareUpcaseLookup; var S : string; //was shortstring; i : integer; begin for i := 1 to 255 do begin S := ToUpper( chr(i) ); //was AnsiUpperCase UpCaseLookup[i] := S[1] end end;
function PosKnuthMorrisPratt(Pattern, Text: string): Integer; var Prefix: array of Integer; i, k: Integer; begin Result := 0; if (Pattern = '') or (Text = '') then Exit; Pattern := UpperCase(Pattern); // case-insensitive Text := UpperCase(Text); // Buld prefix function array SetLength(Prefix, Length(Pattern) + 1); Prefix[1] := 0; k := 0; for i := 2 to Length(Pattern) do begin while (k > 0) and (Pattern[k + 1] <> Pattern[i]) do k := Prefix[k]; if Pattern[k + 1] = Pattern[i] then Inc(k); Prefix[i] := k; end; k := 0; for i := 1 to Length(Text) do begin while (k > 0) and (Pattern[k + 1] <> Text[i]) do k := Prefix[k]; if Pattern[k + 1] = Text[i] then Inc(k); if k = Length(Pattern) then Exit(i + 1 - Length(Pattern)); end; end; begin Memo1.Lines.Add(IntToStr(PosKnuthMorrisPratt('abaBc', 'ggabagabAbccsab'))); Memo1.Lines.Add(IntToStr(PosKnuthMorrisPratt('ab', 'ggagbc')));
There is an ansi version of StrToInt?
It seems there is no Ansi overload for StrToInt. Is this right? Or maybe I am missing something. StrToInt insists to convert my ansistrings to string.
You are correct. There is no ANSI version of StrToInt. The place to find ANSI versions of standard function is the AnsiStrings unit, and there's nothing there. Either write your own function to do the job, or accept the conversion required to use StrToInt. It's not too hard to write your own function. It might look like this: uses SysConst; // for SInvalidInteger .... {$OVERFLOWCHECKS OFF} {$RANGECHECKS OFF} function AnsiStrToInt(const s: AnsiString): Integer; procedure Error; begin raise EConvertError.CreateResFmt(#SInvalidInteger, [s]); end; var Index, Len, Digit: Integer; Negative: Boolean; begin Index := 1; Result := 0; Negative := False; Len := Length(s); while (Index <= Len) and (s[Index] = ' ') do inc(Index); if Index > Len then Error; case s[Index] of '-','+': begin Negative := s[Index] = '-'; inc(Index); if Index > Len then Error; end; end; while Index <= Len do begin Digit := ord(s[Index]) - ord('0'); if (Digit < 0) or (Digit > 9) then Error; Result := Result * 10 + Digit; if Result < 0 then Error; inc(Index); end; if Negative then Result := -Result; end; This is a cut-down version of that found in StrToInt. It does not handle hexadecimal and is a bit more stringent regarding errors. Before using this code I'd want to test whether or not this really is your bottleneck. It is quite interesting that this code, based on that in the RTL source, is incapable of returning low(Integer). It's not too hard to fix that up, but it would make the code more complex.
The code is actually very simple (hex strings aren't supported but prolly you don't need them): function AnsiStrToInt(const S: RawByteString): Integer; var P: PByte; Negative: Boolean; Digit: Integer; begin P:= Pointer(S); // skip leading spaces while (P^ = Ord(' ')) do Inc(P); Negative:= False; if (P^ = Ord('-')) then begin Negative:= True; Inc(P); end else if (P^ = Ord('+')) then Inc(P); if P^ = 0 then raise Exception.Create('No data'); Result:= 0; repeat if Cardinal(Result) > Cardinal(High(Result) div 10) then raise Exception.Create('Integer overflow'); Digit:= P^ - Ord('0'); if (Digit < 0) or (Digit > 9) then raise Exception.Create('Invalid char'); Result:= Result * 10 + Digit; if (Result < 0) then begin if not Negative or (Cardinal(Result) <> Cardinal(Low(Result))) then raise Exception.Create('Integer overflow'); end; Inc(P); until (P^ = 0); if Negative then Result:= -Result; end;
I followed this tip: How to convert AnsiString to UnicodeString in Delphi XE4 Example: var a : AnsiString; b : String; c : Integer; begin a := '123'; b := String(a); c := StrToInt(b);
Getting equavalent of strings like chr(33)+'test line'+chr(33)
Above string equals "3test line3" When I enter above line into an editbox, and say; StrVar := Edit1.text; StrVar is "chr(33)+'test line'+chr(33)" How can i get the result 3test line3 as a variant; To achieve this, i use pascal scripting engine from rem-objects. Might be a simpler way to do this.. Any ideas are welcomed...
If you need a function that takes a Delphi string literal as input, and returns the string, e.g. 'This is a test! '#9728#9729 would be evaluated to This is a test! ☀☁ then this will do it: function ParseStr(const Str: string): string; var InLiteral, InOrdinal: boolean; ActualHigh: integer; i: Integer; ordinal: string; const STRING_TERMINATOR = ''''; CHAR_SYMBOL = '#'; NUMBERS = ['0' .. '9']; WHITESPACE = [#$20, #$A0, #$09]; begin SetLength(result, length(Str)); ActualHigh := 1; InLiteral := false; InOrdinal := false; i := 1; if length(Str) = 0 then Exit; repeat if InLiteral then begin if (Str[i] = STRING_TERMINATOR) and (i < length(Str)) and (Str[i + 1] = STRING_TERMINATOR) then begin result[ActualHigh] := STRING_TERMINATOR; inc(ActualHigh); inc(i, 2); Continue; end else if (Str[i] = STRING_TERMINATOR) then begin InLiteral := false; inc(i); Continue; end; result[ActualHigh] := Str[i]; inc(ActualHigh); inc(i); end else if InOrdinal then begin if Str[i] in NUMBERS then begin ordinal := ordinal + Str[i]; if i = length(Str) then begin result[ActualHigh] := char(StrToInt(ordinal)); inc(ActualHigh); end; inc(i); end else if Str[i] = STRING_TERMINATOR then begin result[ActualHigh] := char(StrToInt(ordinal)); inc(ActualHigh); InLiteral := true; InOrdinal := false; inc(i); end else if Str[i] = CHAR_SYMBOL then begin result[ActualHigh] := char(StrToInt(ordinal)); inc(ActualHigh); ordinal := ''; inc(i); end else if Str[i] in WHITESPACE then inc(i) else raise EConvertError.CreateFmt('Invalid string constant: "%s"', [Str]); end else begin if Str[i] = STRING_TERMINATOR then begin InLiteral := true; inc(i); end else if Str[i] = CHAR_SYMBOL then begin InOrdinal := true; inc(i); ordinal := ''; end else if Str[i] in WHITESPACE then inc(i) else raise EConvertError.CreateFmt('Invalid string constant: "%s"', [Str]); end; until i > length(Str); SetLength(result, ActualHigh - 1); end;
A script engine is probably the best you're going to get. Some languages have a built-in way to evaluate expressions written in their own code, but only scripting languages that have an interpreter (or sometimes a compiler) built into the runtime. As a pure compiled language, Delphi doesn't offer that, so you need to provide your own scripting language, such as PascalScript.
StringReplace alternatives to improve performance
I am using StringReplace to replace > and < by the char itself in a generated XML like this: StringReplace(xml.Text,'>','>',[rfReplaceAll]) ; StringReplace(xml.Text,'<','<',[rfReplaceAll]) ; The thing is it takes way tooo long to replace every occurence of >. Do you purpose any better idea to make it faster?
If you're using Delphi 2009, this operation is about 3 times faster with TStringBuilder than with ReplaceString. It's Unicode safe, too. I used the text from http://www.CodeGear.com with all occurrences of "<" and ">" changed to "<" and ">" as my starting point. Including string assignments and creating/freeing objects, these took about 25ms and 75ms respectively on my system: function TForm1.TestStringBuilder(const aString: string): string; var sb: TStringBuilder; begin StartTimer; sb := TStringBuilder.Create; sb.Append(aString); sb.Replace('>', '>'); sb.Replace('<', '<'); Result := sb.ToString(); FreeAndNil(sb); StopTimer; end; function TForm1.TestStringReplace(const aString: string): string; begin StartTimer; Result := StringReplace(aString,'>','>',[rfReplaceAll]) ; Result := StringReplace(Result,'<','<',[rfReplaceAll]) ; StopTimer; end;
Try FastStrings.pas from Peter Morris.
You should definitely look at the Fastcode project pages: http://fastcode.sourceforge.net/ They ran a challenge for a faster StringReplace (Ansi StringReplace challenge), and the 'winner' was 14 times faster than the Delphi RTL. Several of the fastcode functions have been included within Delphi itself in recent versions (D2007 on, I think), so the performance improvement may vary dramatically depending on which Delphi version you are using. As mentioned before, you should really be looking at a Unicode-based solution if you're serious about processing XML.
The problem is that you are iterating the entire string size twice (one for replacing > by > and another one to replace < by <). You should iterate with a for and simply check ahead whenever you find a & for a gt; or lt; and do the immediate replace and then skipping 3 characters ((g|l)t;). This way it can do that in proportional time to the size of the string xml.Text. A simple C# example as I do not know Delphi but should do for you to get the general idea. String s = "<xml>test</xml>"; char[] input = s.ToCharArray(); char[] res = new char[s.Length]; int j = 0; for (int i = 0, count = input.Length; i < count; ++i) { if (input[i] == '&') { if (i < count - 3) { if (input[i + 1] == 'l' || input[i + 1] == 'g') { if (input[i + 2] == 't' && input[i + 3] == ';') { res[j++] = input[i + 1] == 'l' ? '<' : '>'; i += 3; continue; } } } } res[j++] = input[i]; } Console.WriteLine(new string(res, 0, j)); This outputs: <xml>test</xml>
When you are dealing with a multiline text files, you can get some performance by processing it line by line. This approach reduced time in about 90% to replaces on >1MB xml file. procedure ReplaceMultilineString(xml: TStrings); var i: Integer; line: String; begin for i:=0 to xml.Count-1 do begin line := xml[i]; line := StringReplace(line, '>', '>', [rfReplaceAll]); line := StringReplace(line, '<', '<', [rfReplaceAll]); xml[i] := line; end; end;
Untested conversion of the C# code written by Jorge Ferreira. function ReplaceLtGt(const s: string): string; var inPtr, outPtr: integer; begin SetLength(Result, Length(s)); inPtr := 1; outPtr := 1; while inPtr <= Length(s) do begin if (s[inPtr] = '&') and ((inPtr + 3) <= Length(s)) and (s[inPtr+1] in ['l', 'g']) and (s[inPtr+2] = 't') and (s[inPtr+3] = ';') then begin if s[inPtr+1] = 'l' then Result[outPtr] := '<' else Result[outPtr] := '>'; Inc(inPtr, 3); end else begin Result[outPtr] := Result[inPtr]; Inc(inPtr); end; Inc(outPtr); end; SetLength(Result, outPtr - 1); end;
Systools (Turbopower, now open source) has a ReplaceStringAllL function that does all of them in a string.
it's work like charm so fast trust it Function NewStringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string; var OldPat,Srch: string; // Srch and Oldp can contain uppercase versions of S,OldPattern PatLength,NewPatLength,P,i,PatCount,PrevP: Integer; c,d: pchar; begin PatLength:=Length(OldPattern); if PatLength=0 then begin Result:=S; exit; end; if rfIgnoreCase in Flags then begin Srch:=AnsiUpperCase(S); OldPat:=AnsiUpperCase(OldPattern); end else begin Srch:=S; OldPat:=OldPattern; end; PatLength:=Length(OldPat); if Length(NewPattern)=PatLength then begin //Result length will not change Result:=S; P:=1; repeat P:=PosEx(OldPat,Srch,P); if P>0 then begin for i:=1 to PatLength do Result[P+i-1]:=NewPattern[i]; if not (rfReplaceAll in Flags) then exit; inc(P,PatLength); end; until p=0; end else begin //Different pattern length -> Result length will change //To avoid creating a lot of temporary strings, we count how many //replacements we're going to make. P:=1; PatCount:=0; repeat P:=PosEx(OldPat,Srch,P); if P>0 then begin inc(P,PatLength); inc(PatCount); if not (rfReplaceAll in Flags) then break; end; until p=0; if PatCount=0 then begin Result:=S; exit; end; NewPatLength:=Length(NewPattern); SetLength(Result,Length(S)+PatCount*(NewPatLength-PatLength)); P:=1; PrevP:=0; c:=pchar(Result); d:=pchar(S); repeat P:=PosEx(OldPat,Srch,P); if P>0 then begin for i:=PrevP+1 to P-1 do begin c^:=d^; inc(c); inc(d); end; for i:=1 to NewPatLength do begin c^:=NewPattern[i]; inc(c); end; if not (rfReplaceAll in Flags) then exit; inc(P,PatLength); inc(d,PatLength); PrevP:=P-1; end else begin for i:=PrevP+1 to Length(S) do begin c^:=d^; inc(c); inc(d); end; end; until p=0; end; end;