UrlToFilename, brauche etwas Hilfe

[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!