UrlToFilename, brauche etwas Hilfe

[KodeZwerg]

Hi, ich habe eine Funktion gebastelt die mir aus einer URL-Link-Adresse einen Dateinamen geben soll.
Mit normalen Web-Links klappt das alles soweit so gut.
Wenn nur eine Domäne in URL steht, das hätte ich gerne zu "index.html" abgeändert, habt ihr eine Idee wie ich das lösen kann?

Hier der jetzige Code:

Delphi-Quellcode:

Function UrlToFilename ( Const sURL: String ) : String;
var
  tmp: String;
  Cancel: Boolean;
  i: Integer;
begin
  tmp := ''; Result := '';
  i := Length(sURL);
  Cancel := False;
  repeat // strip input string down to last part after "/"
    if (sURL[i] <> '/') then
     tmp := sURL[i]+tmp
    else
     Cancel := True;
    Dec(i);
  until (Cancel = True) or ( i <= 0);
  if tmp = '' then tmp := 'index.html'; // default name
  for i := 1 to Length(tmp) do // filter out some bad chars
   begin
     if ((Ord(Char(tmp[i])) >= $20)and(Ord(Char(tmp[i])) <= $7F)) then // only use chars between ascii #32 and #127
      if ((tmp[i]<>'"')and(tmp[i]<>'$')and(tmp[i]<>'*')and(tmp[i]<>'<')and(tmp[i]<>'>')and(tmp[i]<>'/')and(tmp[i]<>'\')) then // filter out bad filename chars
       Result := Result + tmp[i];
   end;
end;

Vielleicht habt ihr ja auch noch Vorschläge was für Zeichen nicht in einen Dateinamen gehören?

[Delphi.Narium]

Sowas mach' ich eigentlich immer auf die einfache und blöde Art:

Zuerst aus http:// bzw. https:// einen Laufwerksbuchstaben machen, also z. B. c:\.
Danach alle / umdrehen zu \.
Anschließend funktionieren ExtractFilename, ChangeFileExt ... wie bei "normalen" Dateinamen.

Hat man 'ne Url mit Parametern, muss man vorher alles hinter dem ? wegwerfen.

Delphi-Quellcode:

Function UrlToFilename(Const sURL: String) : String;
var
  iPos: Integer;
begin
  iPos := Pos('?',sUrl);
  if iPos > 0 then sUrl := Copy(sUrl,1,iPos - 1);
  iPos := Pos('//',sUrl);
  if iPos > 0 then sUrl := 'c:' + Copy(sUrl,iPos + 1,Length(sUrl));
  sUrl := AnsiReplaceText(sUrl,'/','\'); 
  Result := ExtractFileName(sUrl);
end;

procedure Irgendwas;
begin
  // Hier sollte nun newreply.php ausgeben werden:
  ShowMessage(UrlToFilename('https://www.delphipraxis.net/newreply.php?do=postreply&t=196264'));
end;

Wenn man die Parameter auch noch auswerten muss, dann kann man z. B. aus ?, &, = und % jeweils 'nen \ machen, damit hat man dann eine "ellenlange" Pfadangabe.

Hier muss man dann ggfls. schauen, was im Einzelfall sinnvoll weiterzuverwenden ist.

[KodeZwerg]

Welche Unit soll ich nehmen um AnsiReplaceText() bereitzustellen, System.AnsiStrings oder System.StrUtils?

Delphi-Quellcode:

Function UrlToFilename(sURL: String) : String; // da Du auf sURL schreibst hab ich Const entfernt
var
  iPos: Integer;
begin
  iPos := Pos('?',sUrl);
  if iPos > 0 then sUrl := Copy(sUrl,1,iPos - 1);
  iPos := Pos('//',sUrl);
  if iPos > 0 then sUrl := 'c:' + Copy(sUrl,iPos + 1,Length(sUrl));
  sUrl := AnsiReplaceText(sUrl,'/','\');
  Result := ExtractFileName(sUrl);
  if Result = '' then Result := 'index.html'; // und das hier zugefügt
end;

Das funktioniert astrein aber das Hauptproblem bleibt bestehen,
hier ein Beispiel

Delphi-Quellcode:

ShowMessage(UrlToFilename('https://www.delphipraxis.net/');
oder
ShowMessage(UrlToFilename('https://www.delphipraxis.net');

da wünsche ich mir als Ergebnis ein "index.html"

[Delphi.Narium]

Das Ergebnis soll also etwas sein, was nicht da ist?

Also http:// bzw. https.// wegwerfen.

Dann schauen, ob es im Rest einen / gibt.
Wenn nein ist das Ergebnis index.html.

Gibt es einen / dann alles davor wegwerfen.

Bleibt nur der / über, dann ist das Ergebnis ebenfalls index.html.

Gibt es den / plus nochirgendwas, ist alles ab dem / Pfad und Dateiname.
Ist darin noch ein ? enthalten, dann alles vor dem ? nehmen.

Evntuell vorhandene / umdrehen zum \.

[Alallart]

Keine Lösung, aber vielleicht paar Anregungen

Delphi-Quellcode:

var
  s: string;
  p: Integer;
begin
  s := 'https://www.delphipraxis.net/196264-urltofilename-brauche-etwas-hilfe.html#post1401364';
  p := LastDelimiter('/', s);
  s := Copy(s, p + 1, MaxInt);
  p := Pos('#', s);
  if p > 0 then
    Delete(s, p, MaxInt);
  if not(AnsiEndsText('.html', s) or AnsiEndsText('.htm', s) or AnsiEndsText('.php', s)) then
    ShowMessage(Format('"%s" scheint keine Datei zu sein', [s]))
  else
    ShowMessage(s);
end;

[KodeZwerg]

Vielen Dank für Tipps!

Delphi-Quellcode:

Function UrlToFilename( Const sURL: String ) : String;
var
  tmp: String;
  iPos: Integer;
begin
  Result := '';
  tmp := sURL;
  iPos := Pos('?',tmp);
  if iPos > 0 then tmp := Copy(tmp,1,iPos - 1);
  iPos := Pos('//',tmp);
  if iPos > 0 then
  begin
    tmp := Copy(tmp,iPos+2,Length(tmp));
    iPos := Pos('/',tmp);
    if iPos <> 0 then
     repeat
       tmp := Copy(tmp,iPos + 1,Length(tmp));
       iPos := Pos('/',tmp);
     until iPos = 0
     else tmp := 'index.html';
    for iPos := 1 to Length(tmp) do
     begin
       if ((Ord(Char(tmp[iPos])) >= $20)and(Ord(Char(tmp[iPos])) <= $7F)) then // only use chars between ascii #32 and #127
        if ((tmp[iPos]<>'"')and(tmp[iPos]<>'$')and(tmp[iPos]<>'?')and(tmp[iPos]<>'*')and(tmp[iPos]<>'<')and(tmp[iPos]<>'>')and(tmp[iPos]<>'/')and(tmp[iPos]<>'\')) then // filter out bad filename chars
         Result := Result + tmp[iPos];
     end;
  end;
  if Result = '' then Result := 'index.html';
end;

So macht es genau was ich will, tut mir leid das ich den Source so verunstaltet habe aber so scheint es zu funktionieren.

@Delphi.Narium: Ja, so grausam es klingen mag aber was Du schreibst trifft den Nagel auf den Kopf.
Zuerst alles hinter "?" kappen
Dann alles vor "//" kappen
Jetzt gucken ob ein "/" existiert oder "index.html" ausgeben.
Falls mehrere "/" existieren halt nur den Rest dahinter verwenden.
Wenn dann noch etwas übrig sein sollte durch den Char-Checker jagen.
Zu guter letzt, falls kein Ergebnis vorliegt ein "index.html" draus machen.

[Schokohase]

Jag die URL doch erst durch System.Net.URLClient.TURI. Der zerlegt dir das praktischerweise in die logischen Teile.

[EWeiss]

Zitat von Schokohase:

Jag die URL doch erst durch System.Net.URLClient.TURI. Der zerlegt dir das praktischerweise in die logischen Teile.

Ja, ja die Super schlauen mach mal einfach..
Lese doch erst mal um was es ihm geht.

Dann gebe dein Kommentar ab.
Er will keine riesen Komponenten verwenden sondern alles klein halten was will er also mit dieser RIESEN Classe?
Zudem täte es ein einfaches Split auch.

gruss

[KodeZwerg]

Delphi-Quellcode:

type
 TRealURL = record
   OriginalURL, {whatever input it was - its stored here}
   Protocol, {holds used protocol without "://", example "http"}
   Username, {Ham}
   Password, {Eggs}
   Domain, {can be www or ip-adress}
   Sublevel, {may just hold char "/" if source is root plus a filename}
   Filename, {holds logical Name from given input}
   Parameter, {if you need them for further usage}
   Port: String; {Port Royale}
 end; // TRealURL

Function ExpandURL ( Const sURL: String ) : TRealURL;
var
  tmp, NoParam: String;
  i, ii: Integer;
begin
  Result.OriginalURL := sURL;
  Result.Protocol := '';
  Result.Username := '';
  Result.Password := '';
  Result.Domain := '';
  Result.Sublevel := '';
  Result.Filename := '';
  Result.Parameter := '';
  Result.Port := '';
  (* Get Parameter & Port *)
  tmp := sURL;
  NoParam := '';
  if Pos('?', tmp) > 0 then
  begin
   tmp := Copy(tmp, Pos('?', tmp), Length(tmp));
   if Pos(':',tmp) > 0 then Result.Parameter := Copy(tmp, 1, Pos(':',tmp)-1) else Result.Parameter := tmp;
   if Pos(':',tmp) > 0 then Result.Port := Copy(tmp, Pos(':', tmp)+1, Length(tmp));
   NoParam := Copy(sURL, 1, Pos('?', sURL)-1);
  end
  else NoParam := tmp;
  (* Get Protocol *)
  tmp := NoParam;
  if Pos('://',tmp) > 0 then Result.Protocol := Copy(tmp, 1, Pos('://',tmp)-1);
  (* Get Username *)
  if Pos('@', tmp) > 0 then
  begin
   i := Length(Result.Protocol);
   if Length(Result.Protocol) > 0 then Inc(i,3);
   Inc(i);
   tmp := Copy(NoParam, i, Length(NoParam));
   if Pos(':',tmp) > 0 then tmp := Copy(tmp, 1, Pos(':',tmp)-1);
   if Pos('@',tmp) > 0 then tmp := Copy(tmp, 1, Pos('@',tmp)-1);
   Result.Username := tmp;
  end;
  (* Get Password *)
  tmp := NoParam;
  if ((Pos('@', tmp) > 0)and(Pos(':', tmp) > 0)) then
  begin
   i := Length(Result.Protocol)+Length(Result.Username);
   if Length(Result.Protocol) > 0 then Inc(i,3);
   if Length(Result.Username) > 0 then Inc(i);
   Inc(i);
   tmp := Copy(NoParam, i, Length(NoParam));
   tmp := Copy(tmp, 1, Pos('@',tmp)-1);
   Result.Password := tmp;
  end;
  (* Get Domain & Port *)
  begin
   i := Length(Result.Protocol)+Length(Result.Username)+Length(Result.Password);
   if Length(Result.Protocol) > 0 then Inc(i,3);
   if Length(Result.Username) > 0 then Inc(i);
   if Length(Result.Password) > 0 then Inc(i);
   Inc(i);
   tmp := Copy(NoParam, i, Length(NoParam));
   if Pos('/', tmp) > 0 then tmp := Copy(tmp, 1, Pos('/', tmp)-1);
   if Pos(':', tmp) > 0 then
   begin
    Result.Port := Copy(tmp, Pos(':', tmp)+1, Length(tmp));
    tmp := Copy(tmp, 1, Pos(':', tmp)-1);
   end;
   Result.Domain := tmp;
  end;
  (* Get Sublevel & Port *)
  begin
   i := Length(Result.Protocol)+Length(Result.Username)+Length(Result.Password)+Length(Result.Domain);
   if Length(Result.Protocol) > 0 then Inc(i,3);
   if Length(Result.Username) > 0 then Inc(i);
   if Length(Result.Password) > 0 then Inc(i);
   Inc(i);
   tmp := Copy(NoParam, i, Length(NoParam));
   i := 0;
   for ii := 1 to Length(tmp) do if tmp[ii] = '/' then i := ii;
   if i > 0 then tmp := Copy(tmp, 1, i);
   if Pos(':', tmp) > 0 then
   begin
    Result.Port := Copy(tmp, Pos(':', tmp)+1, Length(tmp));
    tmp := Copy(tmp, 1, Pos(':', tmp)-1);
   end;
   Result.Sublevel := tmp;
  end;
  (* Get Filename & Port *)
  begin
   i := Length(Result.Protocol)+Length(Result.Username)+Length(Result.Password)+Length(Result.Domain)+Length(Result.Sublevel);
   if Length(Result.Protocol) > 0 then Inc(i,3);
   if Length(Result.Username) > 0 then Inc(i);
   if Length(Result.Password) > 0 then Inc(i);
   Inc(i);
   tmp := Copy(NoParam, i, Length(NoParam));
   if Pos(':', tmp) > 0 then
   begin
    Result.Port := Copy(tmp, Pos(':', tmp)+1, Length(tmp));
    tmp := Copy(tmp, 1, Pos(':', tmp)-1);
   end;
   Result.Filename := tmp;
  end;
end;

Das tuts auch, hat zumindest erste alpha phase überstanden

Zitat von EWeiss:

Ich hoffe du blickst da in 10 Jahren noch durch.

Habs nochmal überarbeitet, schöner wirds nicht aber hält bis jetzt meinen Tests stand
Gruß zurück!

[EWeiss]

Zitat:

Das tuts auch, hat zumindest erste alpha phase überstanden

Ich hoffe du blickst da in 10 Jahren noch durch.

gruss