IsValidURL

[Ally]

Hallo,

meine Suche nach einer Möglichkeit einen String auf seine Gültigkeit als URL zu prüfen, endete mehr oder weniger erfolglos.
Also habe ich mal selbst eine Unit geschrieben, die das möglichst flott und ohne die Einbindung aufwändiger Bibliotheken erledigt.
Zur Anwendung kommt das ganze in meinem Texteditor. Wird eine Textstelle ausgewählt, die eine gültige URL darstellt, wird ein Menüpunkt aktiv der, per OpenURL(), die Seite im Browser öffnet.
Getestet habe ich das Ganze mit den Bookmarks aus meinem Browser. So weit so gut.
Anbei die Unit und eine Testprogramm zur freien Verwendung, mit der Bitte um Rückmeldung wenn's irgendwo klemmt.

MfG Roland

Code: Alles auswählen

 
unit rhsIsValidURL;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils;
 
function IsValidURL(const sURL: String): Boolean;
 
implementation
 
function IsValidURL(const sURL: String): Boolean;
var
  i: Integer;
  p: Integer;
  TypList: TStringList;
  PartList: TStringArray;
  sTyp: String = '';
  sAdress: String = '';
  sForbidden: String = ' :?#[]@!$&()*+,;=.' + #39;
begin
  Result := False;
 
  if Pos(RightStr(sURL, 1), sForbidden) > 0 then
    Exit(False);
 
  TypList := TStringList.Create;
  TypList.Add('https://www.');
  TypList.Add('http://www.');
  TypList.Add('https://');
  TypList.Add('http://');
  TypList.Add('www.');
  for i := 0 to TypList.Count - 1 do
  begin
    if Pos(TypList[i], Lowercase(sURL)) = 1 then
    begin
      sTyp := TypList[i];
      Break;
    end;
  end;
  TypList.Free;
 
  if sTyp > '' then
  begin
    sAdress := Copy(sURL, Length(sTyp) + 1, 255);
    p := Pos('/', sAdress);
    if p > 0 then
      sAdress := LeftStr(sAdress, p - 1);
    PartList := sAdress.Split('.');
    if High(PartList) = 0 then
      Exit(False);
    for i := 0 to High(PartList) do
    begin
      if PartList[i] > '' then
      begin
        Result := True;
        for p := 1 to Length(sForbidden) do
        begin
          if Pos(sForbidden[p], PartList[i]) > 0 then
            Exit(False);
        end;
      end;
    end;
  end;
end;
 
end.

Zum testen:

Code: Alles auswählen

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
  private
 
  public
 
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses
  rhsIsValidURL, lclintf;
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.Edit1Change(Sender: TObject);
begin
  Button1.Enabled := IsValidURL(Edit1.Text);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenURL(Edit1.Text);
end;
 
end.
 

[Warf]

Zunächst mal möchtest du den TypList kram wahrscheinlich in ein Try-Finally packen

Code: Alles auswählen

  TypList := TStringList.Create;
  try
    TypList.Add('https://www.');
    TypList.Add('http://www.');
    TypList.Add('https://');
    TypList.Add('http://');
    TypList.Add('www.');
    for i := 0 to TypList.Count - 1 do
    begin
      if Pos(TypList[i], Lowercase(sURL)) = 1 then
      begin
        sTyp := TypList[i];
        Break;
      end;
    end;
  finally
    TypList.Free;
  end;

Damit du nicht ausversehen memoryleaks erstellst weil dir irgendwo ne exception um die ohren fliegt (Access violation auf sURL, OOM bei .Add, etc.)

Ansonsten schaut der code ok aus. Aber du möchtest wahrscheinlich lieber Regex verwenden. Gibt ja ne Regex unit als teil von Lazarus (ich mein wirklich die Regex unit, nicht das RegExpr package). Denn eine gute regex implementierung kompiliert den Regex ausdruck in einen DFA und kann damit Textanalyse in einem durchlauf fahren. Also muss der zu testende String nur ein einziges mal gelesen werden, egal wie komplex der Regex query ist. Zum vergleich bei dir:

Code: Alles auswählen

  for i := 0 to TypList.Count - 1 do
  begin
    if Pos(TypList[i], Lowercase(sURL)) = 1 then
    begin
      sTyp := TypList[i];
      Break;
    end;
  end;

Diese schleife läuft 5 mal durch, und muss 2 mal über die URL laufen (einmal für lowercase und einmal für Pos). Wenn du glück hast wird dir da ordentlich was wegoptimiert, (so kann LowerCase ja auch nur einmal verwendet werden, und pos muss ja nur für den Prefix checken, wofür du auch beginswith hättest verwenden können), aber im worst case hast du hier schonmal 10 durchläufe.

Und dann hast du noch:

Code: Alles auswählen

        for p := 1 to Length(sForbidden) do
        begin
          if Pos(sForbidden[p], PartList[i]) > 0 then
            Exit(False);
        end;

Was für jeden verbotenen character nochmal ein durchlauf über den ganzen string bedeuten kann (naja, abzühglich präfix und eventuellem suffix). Also +19 Durchläufe

Das heißt, im vergleich zu einer effizienten regex implementierung bist du asymptotisch (also in relation zur eingabe größe) um nen faktor 30 langsamer. Klar um ein paar kurze Strings zu checken ist das absolut kein problem, aber wenn ich z.B. nen riesigen textfile hab und ich möchte alle URL's darin finden, wäre diese funktion gänzlich ungeeignet

[Ally]

Hallo Warf,

vielen Dank für deine ausführliche Antwort.
Regex hatte ich auch gefunden und auch diverse Diskussionen darüber wie die Ausdrücke aufgebaut sein müssten.
Ich habe mich mit dieser Thematik noch nicht beschäftigt. Das Ganze scheint aber recht komplex zu sein.
regexpr.pas ist schon 150 KB groß. Bist du sicher, dass für diesen speziellen Fall, eine kleine Unit wie die meine, nicht effizienter agiert?

Ich habe heute Morgen einiges geändert. Den Vorschlag von dir den "TypList kram" in ein Try-Finally zu packen habe ich schon wegoptimiert.

aber wenn ich z.B. nen riesigen textfile hab und ich möchte alle URL's darin finden, wäre diese funktion gänzlich ungeeignet

Da gebe ich dir recht. Aber wenn man einfach nur eine URL auf ihre Gültigkeit prüfen möchte, ist eine Funktion wie IsValidURL() von der Anwendung her deutlich einfacher.
Die Frage ist halt: macht sie schon alles Richtig?

Hier die überarbeitete Version:

Code: Alles auswählen

unit rhsIsValidURL;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, StrUtils;
 
function IsValidURL(const sURL: String): Boolean;
 
implementation
 
function IsValidURL(const sURL: String): Boolean;
var
  i: Integer;
  p: Integer;
  PartList: TStringArray;
  sAdress: String = '';
  sProtocol: String = '';
  sForbidden: String = ' :?#[]@!$&()*+,;=.' + #39;
  sProtocolList: String = 'https://www.;http://www.;https://;http://;www.';
begin
  Result := False;
 
  // sURL darf keine Leerzeichen enthalten oder mit einem reservierten Zeichen enden.
  if (Pos(' ', sURL) > 0) or (Pos(RightStr(sURL, 1), sForbidden) > 0) then
    Exit(False);
 
  // Protokoll ermitteln.
  PartList := sProtocolList.Split(';');
  for i := 0 to High(PartList) do
  begin
    if Pos(PartList[i], Lowercase(sURL)) = 1 then
    begin
      sProtocol := PartList[i];
      Break;
    end;
  end;
  if sProtocol.IsEmpty then
    Exit(False);
 
  // Die Adresse darf incl. Protokoll maximal 255 Zeichen lang sein.
  sAdress := sURL.Substring(sProtocol.Length, 255 - sProtocol.Length);
 
  // Nur die Zeichen vor dem ersten Pfadtrenner gehören zur Adresse.
  p := sAdress.IndexOf('/');
  if p > -1 then
    sAdress := LeftStr(sAdress, p);
 
  // Adresse in Subdomain(s), Second-Level-Domain und Top-Level-Domain aufteilen.
  PartList := sAdress.Split('.');
 
  // Die Adresse muss aus mindestens zwei Teilen bestehen (Second-Level-Domain und Top-Level-Domain).
  if High(PartList) < 1 then
    Exit(False);
 
  // Die Adressteile dürfen nicht leer sein oder reservierte Zeichen enthalten.
  for i := 0 to High(PartList) do
  begin
    Result := True;
    if (PartList[i].IsEmpty) or (PosSet(sForbidden, PartList[i]) > 0) then
      Exit(False);
  end;                     
end;
 
end.

MfG Roland

[Warf]

Es gibt auch ne FPC interne Regex Unit (regex, regexpr ist ein package), die ist schmaler, 50 kb.
Regex macht das ganze halt recht simpel, und ist gar nicht mal so kompliziert. z.B.

Code: Alles auswählen

((http|https):\/\/)([^:\?#\[\]@!\$&\(\)\*\+,;=\.\s\/]+\.)+([^:\?#\[\]@!\$&\(\)\*\+,;=\.\s\/]+)($|\/[^\s]*)

Es begint mit ((http|https):\/\/), das sagt, es muss mit http oder https anfangen, gefolgt von ://
Wenn etwas in eckigen klammern steht ist das ein Set, das matcht einen character wenn er in dem set ist. [^ bedeutet match die wenn sie nicht im set sind.
[^:\?#\[\]@!\$&\(\)\*\+,;=\.\s\/] sagt also, match wenn der nächste character nicht :, ?, #, [, ], @, !, $, &, (, ), *, +, ,, ; =, ., /, oder ein whitespace (\s)
das + danach sagt 1 oder mehr characters (also 1 oder mehr die nicht in dem set liegen.
([^:\?#\[\]@!\$&\(\)\*\+,;=\.\s\/]+\.) bedeutet also, eine mindestens einmal kommt eine characterfolge, die nicht die verbotenen zeichen enthält, aus mindestens einem charakter, die sequenz ist gefolgt von einem ., und es konnen beliebig viele solcher sequenzen kommen (also z.b. google. oder http://www.google. etc.)
([^:\?#\[\]@!\$&\(\)\*\+,;=\.\s\/]+) Matcht dann noch einmal die endung (also wieder eine sequenz von nicht verbotetenen charakteren).
Und schließlich ($|\/[^\s]*) sagt entweder kommt danach End Of Line ($) oder es kommt ein / (\/) gefolgt von beliebig vielen non whitespace charactern.

Das sollte so ziemlich genau das machen wie deine funktion.

Wobei ich die FPC Regex unit noch nicht benutzt hab, natürlich kann man regex auch sehr ineffizient implementieren, und grade für kleinere texte kann es gut sein das es vielleicht sogar langsamer ist (da overhead durch die automaten hinzukommt), müsste man einfach mal testen. Aber grundsätzlich ist regex für sowas ganz gut.

Ich hab deine funktion soweit auch ein bisschen getestet, hab nicht geschafft n false positive zu bekommen. Für die meisten zwecke auf jeden fall ausreichend

[Socke]

In beiden Fällen sollten die Objekte (entweder Liste oder RegEx) außerhalb der Funktion erstellt und gelöscht werden, z.B. im initialization und finalization Block. Damit erhöht sich zwar der Speicherverbrauche durchgehend, die Objekte müssen aber nur einmal erzeugt und können danach immer wieder verwendet werden. Bei RegEx wird zudem noch die Kompilierung des Ausdrucks bei jedem Funktionsaufruf eingespart.

[Ally]

Hallo Warf,

danke für dein Beispiel.
So ganz grob habe ich es wohl verstanden. Oft beginnen Adressen aber auch mit www. - das müsste man dann noch berücksichtigen.
Und wenn man Regex schon im Projekt hat, ist deine Lösung wahrscheinlich die erste Wahl. Aber auch hier muss man erst mal eine Regel zusammenbauen die keine Fehler macht.

Für andere Sprachen gibt es zum Teil entsprechende Funktionen. Für PASCAL habe ich, wie schon gesagt, nichts gefunden und deshalb mal selbst was gebaut.
Vielleicht kann es der Eine oder Andere ja auch gebrauchen und vielleicht fließt hier noch etwas Expertise ein (so wie von dir) mit der man das Ganze, wenn nötig, auch noch verbessern kann.

[Ally]

Hallo Socke,

in der zweiten Version habe ich das erzeugen der Liste schon eingespart und auch über String.Split () realisiert.
Dort wird zwar sicherlich auch Speicher reserviert und freigegeben, was sich aber bei den zu verarbeitenden "Datenmengen" sicherlich nicht all zu sehr auswirkt.

[wp_xyz]

Nachdem sProtocolList konstant ist und nur die Daten für PartList liefert, könnte man stattdessen gleich PartList anlegen:

Code: Alles auswählen

const
  PartList: array[0..4] of string = ('https://www.', 'http://www.', 'https://', 'http://', 'www.');

[Ally]

Hallo wp_xyz,

Meine erste Antwort: PartList wird ja zweimal für String.Split () verwendet, beim ersten mal werden die Protokolle durchsucht und beim zweiten mal die Adressbestandteile überprüft.

Änderung:
Zu schnell geantwortet
Nach kurzem nachdenken hab ich es verstanden. Ich darf halt nicht PartList constant deklarieren, weil ich das ja noch brauche.
Deshalb habe ich ProtocolList als array deklariert, und so einmal String.Split () eingespart und dem Compiler etwas Arbeit abgenommen.

Danke für den Tip.

Änderung: Aktuelle Version vom 14.08.2019

Code: Alles auswählen

unit rhsIsValidURL;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, StrUtils;
 
function IsValidURL(const sURL: String): Boolean;
 
implementation
 
function IsValidURL(const sURL: String): Boolean;
var
  i: Integer;
  PartList: TStringArray;
  sAdress: String = '';
  sProtocol: String = '';
  sForbidden: String = ' :?#[]@!$&()*+,;=.' + #39;
const
  ProtocolList: array[0..4] of string = ('https://www.', 'http://www.', 'https://', 'http://', 'www.');
begin
  Result := False;
 
  // sURL darf keine Leerzeichen enthalten oder mit einem reservierten Zeichen enden.
  if (Pos(' ', sURL) > 0) or (Pos(RightStr(sURL, 1), sForbidden) > 0) then
    Exit(False);
 
  // sURL muss mit einem der definierten Protokolle beginnen.
  for i := 0 to 4 do
  begin
    if Pos(ProtocolList[i], Lowercase(sURL)) = 1 then
    begin
      sProtocol := ProtocolList[i];
      Break;
    end;
  end;
  if sProtocol.IsEmpty then
    Exit(False);
 
  // Die Adresse darf incl. Protokoll maximal 255 Zeichen lang sein.
  sAdress := sURL.Substring(sProtocol.Length, 255 - sProtocol.Length);
 
  // Nur die Zeichen vor dem ersten Pfadtrenner gehören zur Adresse.
  i := sAdress.IndexOf('/');
  if i > -1 then
    sAdress := LeftStr(sAdress, i);
 
  // Adresse in Subdomain(s), Second-Level-Domain und Top-Level-Domain aufteilen.
  PartList := sAdress.Split('.');
 
  // Die Adresse muss aus mindestens zwei Teilen bestehen (Second-Level-Domain und Top-Level-Domain).
  if High(PartList) < 1 then
    Exit(False);
 
  // Die Adressteile dürfen nicht leer sein oder reservierte Zeichen enthalten.
  for i := 0 to High(PartList) do
    if (PartList[i].IsEmpty) or (PosSet(sForbidden, PartList[i]) > 0) then
      Exit(False);
 
  Result := True;
end;
 
end.

[Timm Thaler]

Oft beginnen Adressen aber auch mit www. - das müsste man dann noch berücksichtigen.

Nee, Urls beginnen immer mit dem Protokoll bzw. Schema, also http, https, ftp, mailto... Dass man im Browser mit www beginnen kann und der Browser das http / https ergänzt weil er annimmt dass eine Webseite aufgerufen wird ist eine Unart, die der Internet Explorer irgendwann mal eingeführt hat.

[Ally]

Hallo Timm Thaler,

ja das ist ein Dilemma. Einerseits natürlich unkorrekt, andererseits ist diese Schreibweise aber weit verbreitet.
Hier wirkt halt die normative Kraft des Faktischen.

[af0815]

Im Browser kann man ohne www arbeiten, das wird als default ergänzt. Also lazarusforum.de reicht schon.

[m.fuchs]

Im Browser kann man ohne www arbeiten, das wird als default ergänzt. Also lazarusforum.de reicht schon.

Nein. Nur weil Chrome das www zukünftig ausblenden möchte, heißt das nicht dass man auf www verzichten kann. Zwar ist ein Teil der Zonen im Internet so angelegt, dass sowohl die $domain.tld und www.$domain.tld auf den gleichen Server zeigen, aber das ist durchaus nicht immer so.

Zu der oben geposteten Funktion IsValidURL kann ich nur sagen: der Name ist total falsch. Der Quellcode macht alles mögliche, aber er prüft nicht ob eine URL valide ist.

[sstvmaster]

Was haltet ihr davon?

Code: Alles auswählen

function IsValidUrl(aUrl: String): Boolean;
var
  aRegEx: TRegexpr;
  aExpr: String;
begin
  aExpr := '(http(s)?:\/\/.)?(www\.)?[a-zA-Z0-9@:%._\+~#=]{2,256}\.[a-z]{2,6}\b([a-zA-Z0-9@:%_\+.~#?&//=]*)';
 
  aRegEx := TRegexpr.Create;
  aRegEx.Expression := aExpr;
  aRegEx.ModifierG;
  try
    Result := aRegEx.Exec(aUrl);
  finally
    aRegEx.Free;
  end;
end; 

Testproject im Anhang.

[af0815]

Zu der oben geposteten Funktion IsValidURL kann ich nur sagen: der Name ist total falsch. Der Quellcode macht alles mögliche, aber er prüft nicht ob eine URL valide ist.

Vielleicht sollte man definieren was ist eine Valide URL

https://de.wikipedia.org/wiki/Uniform_Resource_Locator

sollen da alle Spielarten unterstützt werden oder nur ein spezifischer Teil ?! Das jetzt als Frage an den Threadersteller