Delphi10. Function to copy the character until this character ':' - string

Hello guys I want to do a function which stop and copy the string until the first character ':' is meet.
I have the following string '404:Bad Request' and my output is '404:' but i want just '404'.Here is my code:
function CutOff(const s: string; n: integer):string;
var
i, k: integer;
begin
k := 0;
for i := 1 to n do
begin
k := Pos(s, ':', k+1);
if k = 1 then Exit;
end;
Result := Copy(s, 1, k);
end;

It appears that your function is intended to return the string up to the nth colon, contrary to what you say in your description: ... until the first character ':' is met.
A problem with your code is however, that you have the arguments to the Pos() function the wrong way. After correcting that, to omit the colon you can simply subtract 1 from the length to copy:
function CutOff(const s: string; n: integer): string;
var
i, k: integer;
begin
k := 0;
for i := 1 to n do
begin
k := Pos(':', s, k+1);
if k = 1 then Exit;
end;
Result := Copy(s, 1, k-1); // note here k-1
end;
And to find the string up to the first colon you call it
Errorcode := CutOff('404:Bad request', 1);
Alternatively, if you never want the nth colon, only the first
function CutOff(const s: string): string;
var
k: integer;
begin
k := Pos(':', s);
Result := Copy(s, 1, k-1);
end;

Related

Convert multibyte hex back to UTF-8 string

In Delphi 10.4, I have a hexadecimal representation of a string:
function TForm1.Button2Click(Sender: TObject);
var
i, nr : integer;
Input, HexStr, h: String;
begin
HexStr := '';
Input := Edit2.Text;
for i:=1 to Length(Input) do begin
nr := Ord(Input[i]);
h := IntToHex(nr, 0);
if Length(h) = 1 then
h := '0' + h;
HexStr := HexStr + h;
end;
Edit3.Text := HexStr;
end;
For "abc€", I get "61626320AC" here. Note the € sign converts to "20AC".
Now for converting it back to a normal string, I split that hex into 2-char pairs, using StrToInt() with a '$' prefix. I have no indicator for it being 4 chars long for an € sign, instead of 2 chars, and this breaks the euro sign:
How do I convert back such a hex string without breaking multibyte characters?
I have no indicator for it being 4 chars long for an € sign, instead of 2 chars
And because of that reason alone, you simply won't be able to convert "61626320AC" back to "abc€", because you don't know which hex codes are 2 digits and which are 4 digits, you didn't deliminate them. For instance, the hex codes 6162 and 6263 also represent valid Unicode characters, too.
As #TomBrunberg mentioned in comments, you can use 4-digit hex codes for every character, eg:
function TForm1.Button2Click(Sender: TObject);
var
i, nr : integer;
Input, HexStr, h: String;
begin
HexStr := '';
Input := Edit2.Text;
for i := Low(Input) to High(Input) do begin
nr := Ord(Input[i]);
h := IntToHex(nr, 4);
HexStr := HexStr + h;
end;
Edit3.Text := HexStr;
end;
Then you can convert back by splitting up the hex string into 4-character groups when calling StrToInt(), eg:
function TForm1.Button3Click(Sender: TObject);
var
i, nr : integer;
Output, HexStr, h: String;
begin
HexStr := Edit3.Text;
Output := '';
i := Low(HexStr);
while i <= High(HexStr) do begin
h := Copy(HexStr, i, 4);
nr := StrToInt('$' + h);
Output := Output + Char(nr);
Inc(i, 4);
end;
Edit2.Text := Output;
end;
Or, as #AmigoJack hinted at, you can use UTF-8 instead, eg:
function TForm1.Button2Click(Sender: TObject);
var
i, nr : integer;
HexStr, h: String;
Input: UTF8String;
begin
HexStr := '';
Input := UTF8String(Edit2.Text);
for i := Low(Input) to High(Input) do begin
nr := Ord(Input[i]);
h := IntToHex(nr, 2);
HexStr := HexStr + h;
end;
Edit3.Text := HexStr;
end;
function TForm1.Button3Click(Sender: TObject);
var
i, nr : integer;
HexStr, h: String;
Output: UTF8String;
begin
HexStr := Edit3.Text;
Output := '';
i := Low(HexStr);
while i <= High(HexStr) do begin
h := Copy(HexStr, i, 2);
nr := StrToInt('$' + h);
Output := Output + AnsiChar(nr);
Inc(i, 2);
end;
Edit2.Text := string(Output);
end;

Convert String to two chars and reverse the two chars

Hello I want to split a simple string into a group of two characters then reverse them.
For example MyStringToBeReversed to two charachters each My St ri ng To Be Re ve rs ed
then reverse each splited two charachters to :
St := ts
ri := ir
etc ...
Here's the code I'm using but it only displays one charachter on memo lines
procedure TForm7.Button1Click(Sender: TObject);
var
MyString: string;
i: integer;
k: integer;
j: integer;
begin
MyString:= Edit1.Text;
for i:= 1 to length(MyString) do
Memo1.Lines.Add(MyString[i]);
// Move(Str[1], MyString, Length(Str));
end;
end.
This should do what you need
function ReverseEachTwoChars(AInput : string) : string;
var
i : integer;
begin
if(Odd(Length(AInput))) then
begin
SetLength(AInput, Length(AInput) + 1);
AInput[Length(AInput)] := 'A';
end;
SetLength(Result, Length(AInput));
i := 1;
while(i < Length(Result)) do
begin
Result[i] := AInput[i + 1];
Result[i + 1] := AInput[i];
Inc(i, 2);
end;
end;
Test:
ShowMessage(ReverseEachTwoChars('010203040506'));
Output:
102030405060

Looping through an array of strings - Type mismatch

I'm attempting to split a csv string and then loop though the array and alter those string, before building it back into a comma separated string again.
function StrSplit(Text: String; Separator: String): Array of String;
var
i, p: Integer;
Dest: Array of String;
begin
i := 0;
repeat
SetArrayLength(Dest, i+1);
p := Pos(Separator,Text);
if p > 0 then begin
Dest[i] := Copy(Text, 1, p-1);
Text := Copy(Text, p + Length(Separator), Length(Text));
i := i + 1;
end else begin
Dest[i] := Text;
Text := '';
end;
until Length(Text)=0;
Result := Dest
end;
function FormatHttpServer(Param: String): String;
var
build: string;
s: string;
ARRAY1: Array of String;
begin
ARRAY1 := StrSplit(param, ',');
build:='';
for s in ARRAY1 do
begin
build := build + DoSomething(C);
end;
end;
I call the FormatHttpServer from elsewhere. I can't get the script to compile though because on the following line I get a "type mismatch error" and I don't understand why. It should be looping through an array of strings using the string s.
for s in ARRAY1 do
Inno Setup Pascal Script does not support for ... in syntax.
You have to use indexes:
var
I: Integer;
A: array of string;
S: string;
begin
A := { ... };
for I := 0 to GetArrayLength(A) - 1 do
begin
S := A[I];
{ Do something with S }
end;
end;

How to remove repeated spaces from a string

I need to remove repeated spaces from a string.
The following code, grabbed from internet, works decently except that it duplicate the first char of the string.
Also maybe there is something faster that this.
function DeleteRepeatedSpaces(OldText: string): string;
var
i: integer;
s: string;
begin
if length(OldText) > 0 then
s := OldText[1]
else
s := '';
for i := 1 to length(OldText) do
begin
if OldText[i] = ' ' then
begin
if not (OldText[i - 1] = ' ') then
s := s + ' ';
end
else
begin
s := s + OldText[i];
end;
end;
DelDoubleSpaces := s;
end;
Function based on the simplest state machine (DFA). Minimum of memory reallocations.
State is number of continuous spaces.
J is count of deleted spaces.
function DeleteRepeatedSpaces(const s: string): string;
var
i, j, State: Integer;
begin
SetLength(Result, Length(s));
j := 0;
State := 0;
for i := 1 to Length(s) do begin
if s[i] = ' ' then
Inc(State)
else
State := 0;
if State < 2 then
Result[i - j] := s[i]
else
Inc(j);
end;
if j > 0 then
SetLength(Result, Length(s) - j);
end;
Iterate all members of the string, move the characters to the Result, but skip repeated spaces.
function DeleteRepeatedSpaces(const OldText: string): string;
var
i,j,hi: Integer;
begin
SetLength(Result,Length(OldText));
i := Low(OldText);
j := i;
hi := High(OldText);
while (i <= hi) do begin
Result[j] := OldText[i];
Inc(j);
if (OldText[i] = ' ') then begin
repeat //Skip additional spaces
Inc(i);
until (i > hi) or (OldText[i] <> ' ');
end
else
Inc(i);
end;
SetLength(Result,j-Low(Result)); // Set correct length
end;
The above code is rather fast (faster than any other contribution, so far).
Below is an even more optimized routine:
function DeleteRepeatedSpaces(const OldText: string): string;
var
pO,pR: PChar;
begin
SetLength(Result,Length(OldText));
pR := Pointer(Result);
pO := Pointer(OldText);
while (pO^ <> '') do begin
pR^ := pO^;
Inc(pR);
if (pO^ <> ' ') then begin
Inc(pO);
Continue;
end;
repeat // Skip additional spaces
Inc(pO);
until (pO^ = '') or (pO^ <> ' ');
end;
SetLength(Result,pR-Pointer(Result));
end;
The following isn't wildly efficient, but possibly more so that processiing the string character by character because it doesn't require a new string allocation for each character in the output:
function RemoveDupSpaces(const Input : String) : String;
var
P : Integer;
begin
Result := Input;
repeat
P := Pos(' ', Result); // that's two spaces
if P > 0 then
Delete(Result, P + 1, 1);
until P = 0;
end;
You can use something like this:
function DeleteRepeatedSpaces(const s: string):string;
var
i:integer;
begin
Result := '';
for i := 1 to Length(S) do begin
if not ((s[i]=' ') and (s[i-1]=' ')) then begin
Result := Result + s[i];
end;
end;
end;
Delete two o more spaces contiguous in a string.
This string (without spaces):
The string have groups of spaces inside
return this:
The string have groups of spaces inside
This string (with spaces groups inside):
The string have groups of spaces inside
Return this:
The string have groups of spaces inside

Trouble with string in Delphi

I have a random string of numbers
(numbers can only be used once, only from 1-9, almost any length(min 1,max 9)):
var
Input: String;
begin
Input := '431829576'; //User inputs random numbers
And now I need to get specified number to front. How about 5.
var
Number: Integer;
begin
Number := 5;
and function executes with result 543182976.
I don't have any ideas how to make a function like this, Thanks.
Do you mean like this?
function ForceDigitInFront(const S: string; const Digit: Char): string;
begin
result := Digit + StringReplace(S, Digit, '', []);
end;
A more lightweight solution is
function ForceDigitInFront(const S: string; const Digit: Char): string;
var
i: Integer;
begin
result := S;
for i := 1 to Length(S) do
if result[i] = Digit then
begin
Delete(result, i, 1);
break;
end;
result := Digit + result;
end;
You could do it this way :
function ForceDigitInFront(const S: string; const Digit: Char): string;
var
dPos : Integer;
begin
Result := s;
dPos := Pos( Digit,S);
if (dPos <> 0) then begin // Only apply Digit in front if Digit exists !?
Delete( Result,dPos,1);
Result := Digit + Result;
end;
end;
If Digit is not in input string, the digit is not added here, but change this if it does not fit your implementation.
Here is a solution that reduces the numer of String allocations needed, as well as checks if the digit is already in the front:
function ForceDigitInFront(const S: string; const Digit: Char): string;
var
dPos : Integer;
begin
Result := s;
for dPos := 1 to Length(Result) do
begin
if Result[dPos] = Digit then
begin
if dPos > 1 then
begin
UniqueString(Result);
Move(Result[1], Result[2], (dPos-1) * SizeOf(Char));
Result[1] := Digit;
end;
Exit;
end;
end;
end;

Resources