Is there any way to get the hostname and protocol from an URL?
My use case:
On installation user inputs the application and API URL
Get hostname allowedOrigins configuration
Example url:
https://somelink.com/#/login
https://someapilink.com/api/
Desired result:
https://somelink.com
https://someapilink.com
Had you really needed full URL parsing, you might make use of ParseURL WinAPI function.
But if you only need the hostname and protocol, I'd resort to parsing the URL on your own:
function GetUrlHostName(Url: string): string;
var
P: Integer;
begin
Result := '';
P := Pos('://', Url);
if P > 0 then
begin
Result := Copy(Url, P + 3, Length(Url) - P - 1);
P := Pos('/', Result);
if P > 0 then Result := Copy(Result, 1, P - 1);
P := Pos('#', Result);
if P > 0 then Result := Copy(Result, 1, P - 1);
P := Pos(':', Result);
if P > 0 then Result := Copy(Result, 1, P - 1);
end;
end;
function GetUrlProtocol(Url: string): string;
var
P: Integer;
begin
Result := '';
P := Pos('://', Url);
if P > 0 then
begin
Result := Copy(Url, 1, P - 1);
end;
end;
(The GetUrlHostName does not take possible username and password into account)
Related
I have this string:
Called=%2B12608883475&ToState=IN&CallerCountry=US&Direction=inbound&CallerState=IN&ToZip=&CallSid=CAb7faaa30058c2347a595630f2475113a&To=%2B12608883475&CallerZip=
I would like to parse it by & to get all the parameters out and then sort the parameters in an alphabetical case-sensitive order.
All of this has to be done in Delphi 5:
Function TwilioSignatureValidate(twilioSignature: string; QueryString: string ; Url: string): boolean;
begin
parameters := QueryString;
List := TStringList.Create;
end;
Here is the C# version that I want to copy:
string input = "Called=%2B12608883475&ToState=IN&CallerCountry=US&Direction=inbound&CallerState=IN&ToZip=&CallSid=CAb7faaa30058c2347a595630f2475113a&To=%2B12608883475&CallerZip=";
Dictionary<string,string> keyValuePairs = input.Split('&')
.Select(value => value.Split('='))
.ToDictionary(pair => pair[0], pair => pair[1]);
string studentId = keyValuePairs["StudentId"];
Using List.Sort;
I got my Delphi List To sort alphebetically but its not in using Unix-style case-sensitive sorting order:
//Delphi Sort
https://ffbc1360.ngrok.io
AccountSidACc6d06b4cb61ccbfa61bf461957a5a626
ApiVersion2010-04-01
Called+12608883475
CalledCity
CalledCountryUS
CalledStateIN
CalledZip
Caller+12602060582
CallerCity
CallerCountryUS
CallerStateIN
CallerZip
CallSidCAb7faaa30058c2347a595630f2475113a
CallStatusringing
Directioninbound
From+12602060582
FromCity
FromCountryUS
FromStateIN
FromZip
To+12608883475
ToCity
ToCountryUS
ToStateIN
ToZip
//Correct c# Sort
https://ffbc1360.ngrok.io
AccountSidACc6d06b4cb61ccbfa61bf461957a5a626
ApiVersion2010-04-01
CallSidCAb7faaa30058c2347a595630f2475113a
CallStatusringing
Called+12608883475
CalledCity
CalledCountryUS
CalledStateIN
CalledZip
Caller+12602060582
CallerCity
CallerCountry
USCaller
StateIN
CallerZip
Directioninbound
From+12602060582
FromCity
FromCountryUS
FromStateIN
FromZip
To+12608883475
ToCity
ToCountryUS
ToStateIN
ToZip
TStringList in Delphi 6 and later has Delimiter, DelimitedText, and CaseSensitive properties. Set the Delimiter to '&' and then assign the query string to DelimitedText, then you can use the Values[] property to extract values by name (since the resulting delimited strings are already in name=value format). No sorting is needed:
Function TwilioSignatureValidate(twilioSignature: string; QueryString: string ; Url: string): boolean;
var
List: TStringList;
begin
List := TStringList.Create;
try
List.Delimiter := '&';
List.DelimitedText := QueryString;
List.CaseSensitive := True;
// use List.Values['param name'] as needed, eg:
// List.Values['Called']
// List.Values['ToState']
// List.Values['CallerCountry']
// List.Values['Direction']
// List.Values['CallerState']
// List.Values['ToZip']
// List.Values['CallSid']
// List.Values['To']
// List.Values['CallerZip']
finally
List.Free;
end;
end;
However, in Delphi 5, none of those properties existed yet, so you will have to do everything manually:
Function TwilioSignatureValidate(twilioSignature: string; QueryString: string ; Url: string): boolean;
var
List: TStringList;
// the following are tweaked from TStrings in later Delphi versions...
procedure MySetDelimitedText(const Value: string);
var
P, P1: PChar;
S: string;
begin
List.BeginUpdate;
try
List.Clear;
P := PChar(Value);
while P^ <> #0 do
begin
if P^ = '"' then
S := AnsiExtractQuotedStr(P, '"')
else
begin
P1 := P;
while (P^ <> #0) and (P^ <> '&') do
P := CharNext(P);
SetString(S, P1, P - P1);
end;
List.Add(S);
if P^ = '&' then
begin
P := CharNext(P);
if P^ = #0 then
List.Add('');
end;
end;
finally
List.EndUpdate;
end;
end;
function MyIndexOfName(const Name: string): Integer;
var
P: Integer;
S: string;
begin
for Result := 0 to List.Count - 1 do
begin
S := List.Strings[Result];
P := AnsiPos('=', S);
if (P <> 0) and (AnsiCompareStr(Copy(S, 1, P - 1), Name) = 0) then Exit;
end;
Result := -1;
end;
function MyGetValue(const Name: string): string;
var
I: Integer;
begin
I := MyIndexOfName(Name);
if I >= 0 then
Result := Copy(List.Strings[I], Length(Name) + 2, MaxInt) else
Result := '';
end;
begin
List := TStringList.Create;
try
MySetDelimitedText(QueryString);
// use MyGetValue('param name') as needed, eg:
// MyGetValue('Called')
// MyGetValue('ToState')
// MyGetValue('CallerCountry')
// MyGetValue('Direction')
// MyGetValue('CallerState')
// MyGetValue('ToZip')
// MyGetValue('CallSid')
// MyGetValue('To')
// MyGetValue('CallerZip')
finally
List.Free;
end;
end;
How can I effectively check if a string contains one of a few sub strings?
Suppose I have a string:
`Hi there, <B>my</B> name is Joe <DIV>.</DIV> Hello world. `
How can I check if the string contains either <B> OR <DIV> OR ?
I could do a simple:
Result := (Pos('<B>', S) > 0) or
(Pos('<DIV>', S) > 0) or
(Pos(' ', S) > 0);
But this seems to be very inefficient since it make N (at worst) passes and my strings are considerably large.
Slightly better version:
function StringContainsAny(const S: string; const AnyOf: array of string): Boolean;
var
CurrChr, C: PChar;
i, j, Ln: Integer;
begin
for i := 1 to Length(S) do
begin
CurrChr := #S[i];
for j := 0 to High(AnyOf) do
begin
C := #AnyOf[j][1]; // assume that no empty strings
if C^ <> CurrChr^ then
Continue;
Ln := Length(AnyOf[j]);
if (Length(S) + 1 - i) < Ln then // check bounds
Continue;
if CompareMem(C, CurrChr, Ln * SizeOf(C^)) then
Exit(True);
end;
end;
Exit(False);
end;
You can also build some table of stop-symbols and improve speed. It's kinda complex topic, so I can just suggest you to read, for example, book Bill Smyth "Computing Patterns in Strings".
Here is my solution, thanks to David Heffernan comment:
function StringContainsAny(const S: string; const AnyOf: array of string): Boolean;
var
CurrChr, C: PChar;
I, L, H: Integer;
begin
Result := False;
CurrChr := PChar(S);
while CurrChr^ <> #0 do
begin
H := High(AnyOf);
for I := 0 to H do
begin
L := 0;
C := PChar(AnyOf[I]);
while C^ <> #0 do
begin
if C^ = CurrChr^ then
Inc(L)
else
Break;
Inc(C);
Inc(CurrChr);
if CurrChr^ = #0 then // end of S string
begin
Result := (C^ = #0);
if Result or (not Result and (I = H)) then // match or last AnyOf
Exit;
end;
end;
if C^ = #0 then // match
begin
Result := True;
Exit;
end
else
Dec(CurrChr, L);
end;
Inc(CurrChr);
end;
end;
I'm not sure it is perfect.
EDIT:
What can I say? You know what they say about assumptions...
after actually testing, it seems like using Pos():
function StringContainsAny(const S: string; const AnyOf: array of string): Boolean;
var
I: Integer;
begin
for I := 0 to High(AnyOf) do
begin
if Pos(AnyOf[I], S) <> 0 then
begin
Result := True;
Exit;
end;
end;
Result := False;
end;
Is faster than my solution and #Green_Wizard solution! they did a good job with the Pos function!
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')));
So,
I have a large txt file that contains several email address, and some email address are without a dot before word "com" and now I want add this string in all invalids email address before save to file.
For example some email address are in this format:
aaglt_assessoria#yahoocom.br
where correct way should be:
aaglt_assessoria#yahoo.com.br
and my code about how I'm saving theses emails:
function ExtractEmails(const Input: String; out Emails: TStringList): Boolean;
var
I, position : Integer;
Buffer : String;
Tokens : TStringList;
begin
Result := False;
Tokens := TStringList.Create;
Emails := TStringList.Create;
Try
Tokens.Delimiter := #32;
Tokens.DelimitedText := Input;
For I := 0 To Tokens.Count - 1 Do
begin
Buffer := Tokens.Strings[I];
If Length(Buffer) < 5 Then Continue;
If (Pos('#',Buffer) > 1) And
(Pos('.',Buffer) > 3) And
(Pos('.',Buffer) < Length(Buffer)) Then
begin
Emails.Add(Buffer);
end;
end;
Result := True;
Finally
Tokens.Free;
end;
end;
procedure EscreveEmails;
var
Linhas,Emails:TStringList;
arq: TextFile;
begin
Linhas := TStringList.Create;
Emails := TStringList.Create;
try
Linhas.LoadFromFile('foo.txt');
AssignFile(arq, 'new.txt');
Rewrite(arq);
If ExtractEmails(Linhas.Text,Emails) Then
begin
Writeln(arq,Emails.Text);
end;
finally
CloseFile(arq);
Linhas.Free;
Emails.Free;
end;
end;
Maybe you can use a regex. I'm not a regex crack, but here is what I come with:
https://regex101.com/r/kX8yQ4/2
uses
System.RegularExpressions;
function repairMailDot(const email: string): string; inline;
begin
result := TRegEx.Replace(email, '(#.*(?<!\.))(com(?:$|\..+))', '\1.\2', [roIgnoreCase])
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ShowMessage(repairMailDot('aaglt_assessoria#yahoocom.br'));
ShowMessage(repairMailDot('aaglt_assessoria#yahoo.com.br'));
ShowMessage(repairMailDot('aaglt_assessoria#yahoocom'));
ShowMessage(repairMailDot('aaglt_assessoria#yahoo.com'));
end;
I would say first test to see if a email address is a valid email address
function MailURLMayBeInvalid(const s: string): Boolean;
var
i: Integer;
c: string;
begin // ' ', ä, ö, ü, ß, [, ], (, ), : in EMail-Address
Result := (Trim(s) = '') or (Pos(' ', AnsiLowerCase(s)) > 0) or
(Pos('ä', AnsiLowerCase(s)) > 0) or (Pos('ö', AnsiLowerCase(s)) > 0) or
(Pos('ü', AnsiLowerCase(s)) > 0) or (Pos('ß', AnsiLowerCase(s)) > 0) or
(Pos('[', AnsiLowerCase(s)) > 0) or (Pos(']', AnsiLowerCase(s)) > 0) or
(Pos('(', AnsiLowerCase(s)) > 0) or (Pos(')', AnsiLowerCase(s)) > 0) or
(Pos(':', AnsiLowerCase(s)) > 0);
if Result then Exit; // # not in EMail-Address;
i := Pos('#', s);
Result := (i = 0) or (i = 1) or (i = Length(s));
if Result then Exit;
Result := (Pos('#', Copy(s, i + 1, Length(s) - 1)) > 0);
if Result then Exit; // Domain <= 1
c := Copy(s, i + 1, Length(s));
Result := Length(c) <= 1;
if Result then Exit;
i := Pos('.', c);
Result := (i = 0) or (i = 1) or (i = Length(c));
end;
if it is not a valid address then you can simply check the string for the last occurrence of com that you can do with the LastDelimiter function this function should do the trick
function returnAddress(Address: String): String;
begin
insert('.', Address, LastDelimiter('com',Address)-2);
Result := Address;
end;
I'm trying to make a function that can increment a filename.
If last char of the string is a number then increment it.
If last char is a letter then add _1 or _2 or _3(increment this also).
I have to be sure the filename is unique but i cannot use datetime inside filename because all the filenames must be <32 chars without extension.
EX: Apple_99.txt =>Apple_100
Ex: Apple_173 => Apple_174
EX: This_is_my_first_text.txt => This_is_my_first_text_1.txt
Ex: This_is_my_first_text_9.txt => This_is_my_first_text_10.txt
I need to use this in order to rename a file an then upload it to a ftp server.
I've found a function that can do something like this but it only works if the filename contains only uppercase.How can I modify this function in order to access lowercase an uppercase string?
Here is the function:
function IncStr(Str: String; Amount: Integer; Index: Integer = -1): String;
const
MIN_VAL = 65; // 'A'
MAX_VAL = 90; // 'Z'
var
Digit, ToAdd, ToCarry: Integer;
begin
if (Index = 0) and (Amount > 0) then
begin
Result := Char(MIN_VAL + Amount - 1) + Str;
Exit;
end;
if Index = -1 then Index := Length(Str);
ToCarry := 0;
Digit := Ord(Str[Index]);
while not (Digit in [MIN_VAL..MAX_VAL]) do
begin
Dec(Index);
Digit := Ord(Str[Index]);
end;
ToAdd := Digit + Amount;
while (ToAdd > MAX_VAL) do
begin
Dec(ToAdd, 26);
Inc(ToCarry);
end;
Result := Str;
Result[Index] := Char(ToAdd);
if (ToCarry > 0) then
Result := IncStr(Result, ToCarry, Index - 1);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
S: String; // holds string to increment
C: Integer; // amount to increment by
begin
// make sure that Edit1 starts with a valid character
// i.e. 'A' to 'Z'
S := Edit1.Text;
C := StrtoIntDef(Edit2.Text, 0);
// test it, place result in Edit3
Edit3.Text := IncStr(S, C);
{
Example data:
Edit1 := AAZ
Edit2 := 2
= Edit3 := ABB
Edit1 := BZY
Edit2 := 3
= Edit3 := CAB
Edit1 := ZZZ
Edit2 := 1
= Edit3 := AAAA
Edit1 := AA-AC
Edit2 := 3
= Edit3 := AA-AF
Edit1 := AA/Z
Edit2 := 5
= Edit3 := AB/E
... etc
Here's one to try too :-)
Edit1 := ZZZ
Edit2 := 264172
}
end;
Thank you!
Like so many programming problems, the key is to break the problem down into small pieces. First of all, let's write a function to decode the original file name into its constituent parts:
procedure DecodeFileName(const Input: string; out Stem, Ext: string; out Number: Integer);
var
P: Integer;
begin
Ext := TPath.GetExtension(Input);
Stem := TPath.GetFileNameWithoutExtension(Input);
Number := 0;
P := Stem.LastIndexOf('_');
if P = -1 then begin
exit;
end;
if TryStrToInt(Stem.Substring(P+1), Number) then begin
Stem := Stem.Substring(0, P);
end;
end;
The following demonstrates how this works:
DecodeFileName('test.txt', Stem, Ext, Number);
Writeln(Stem, ', ', Number, ', ', Ext);
DecodeFileName('test_dd.txt', Stem, Ext, Number);
Writeln(Stem, ', ', Number, ', ', Ext);
DecodeFileName('test_23.txt', Stem, Ext, Number);
Writeln(Stem, ', ', Number, ', ', Ext);
The output is:
test, 0, .txt
test_dd, 0, .txt
test, 23, .txt
So now you can make a new filename like this:
function IncrementedFileName(const FileName: string): string;
var
Stem, Ext: string;
Number: Integer;
begin
DecodeFileName(FileName, Stem, Ext, Number);
Result := Format('%s_%d%s', [Stem, Number+1, Ext]);
end;
And then we can see how that performs:
Writeln(IncrementedFileName('test.txt'));
Writeln(IncrementedFileName('test_dd.txt'));
Writeln(IncrementedFileName('test_23.txt'));
Writeln(IncrementedFileName('test_28'));
The output is:
test_1.txt
test_dd_1.txt
test_24.txt
test_29
If you don't have access to the string helper methods then you can code it like this:
procedure DecodeFileName(const Input: string; out Stem, Ext: string; out Number: Integer);
var
P: Integer;
begin
Ext := TPath.GetExtension(Input);
Stem := TPath.GetFileNameWithoutExtension(Input);
Number := 0;
P := LastDelimiter('_', Stem);
if P = 0 then begin
exit;
end;
if TryStrToInt(Copy(Stem, P+1, MaxInt), Number) then begin
Stem := Copy(Stem, 1, P-1);
end;
end;
I have not executed this final function, so do not be surprised if it has errors.