wie bekomme ich das richtige Protocol raus bei einer URL?

[CrashBack]

Hey,

ich habe einen Kleinen Download Manager Geschrieben wo ich sowohl auf http als auch auf ftp Links zugreifen möchte.
Leider bekomme ich es nicht raus welches Protocol in der list gerade Aktiv ist.

Delphi-Quellcode:

ZB: [url]http://www.delphi-library.de/zippi.zip[/url] = HTTP = idhttp
    [url]ftp://192.111.111.21/zippi.zip[/url] = ftp = idftp oder idfsp

wie bekomm ich das raus?
Ich Suche jetzt schon seit einiger Zeit und habe bisher nichts gefunden.

Ich Danke schon mal.
Mfg
Crashback

[daywalker9]

Du könntest zum beispiel mit "Pos" gucken ob FTP oder HTTP vorkommt und damit entschieden was du benutzt

[himitsu]

Fällt dir an den URLs was auf?

protocol://domain/file

Also zerlege die URL, bzw. prüfe was am Anfang steht.

Das ftp://192.111.111.21/zippi.zip könnte sich eventuell auch über idHTTP laden lassen (solange der Server keine FTP-Authentifizierung verlangt )

[blackfin]

Willst du nur die beiden arten da unterscheiden? also ftp:// und http://?

Dann ist die Super-Billigmethode:

Delphi-Quellcode:

if AnsiContainsStr(lowercase(url),'http://') then
begin
  // fire up idhttp 
end
else
if AnsiContainsStr(lowercase(url),'ftp://') then
begin
  // engage the idftp thingy
end;

wird mehr, sollstest du zu RegEx übergehen und das Ding "ordentlich" parsen , aber für den Anfang würd die Billigmethode wohl reichen, wenn es nur gilt, die beiden
zu unterscheiden.

[Luckie]

Vorsicht. Man sollte noch überprüfen, ob die Zeichenkette, die das Protokoll identifizeirt, auch am Anfang steht.

[blackfin]

Rrrrüschüsch! Deswegen meinte ich ja "Super-Billigmethode" und "wenns nur darum geht, die beiden zu unterscheiden"
Vielleicht noch ein trim() dazu für die Deluxe-Billig-Variante

[CrashBack]

Danke Danke für die Schnelle Hilfe Ja Erstmal wollte ich nur die 2 Protokolle Nutzen und dann Spätter wenn es geht was ich vor hab mit dem Manager dann vllt mehr.

Ich werde es mal Versuchen so wie es weiter oben steht

Zitat:

if AnsiContainsStr(lowercase(url),'http://') then
begin
// fire up idhttp
end
else
if AnsiContainsStr(lowercase(url),'ftp://') then
begin
// engage the idftp thingy
end;

ich habe es ja schon mit CrackURL Versucht aber irgend wie zickt da Delphi2010 rum.

[Sir Rufo]

Kannst ja auch das hier benutzen.

Habe ich mal geschrieben um eine URL nicht nur zu zerlegen, sondern auch auf einfache Art und Weise Teile der URL zu ändern.

Eine Demo für die Unit habe ich auch mal angehängt

Delphi-Quellcode:

unit uParseURL;
{<
@abstract(URL-Parser)

}

{.$DEFINE SERV_DEFAULT_PORT}

interface

type
  // @abstract(Zerlegen und Zusammensetzen von URL-Pfaden)
  //
  // @noautolink(Aufbau einer Standard-URL:)
  // @code(Serv)@code(:)@code(//)@code(User)@code(:)@code(Pass)@code(@@)@code(Host)@code(:) @code(Port)@code(/)@code(Path)@code(?)@code(Parm)
  //
  // Wird der URL-Wert gesetzt, so wird diese wie folgt in ihre Einzelteile zerlegt:
  // @table(
  //   @rowHead( @cell(URL) @cell(Serv) @cell(User) @cell(Pass) @cell(Host) @cell(Port) @cell(Path) @cell(Parm) )
  //   @row( @cell([url]http://www.google.de[/url]) @cell(http) @cell() @cell() @cell([url]www.google.de[/url]) @cell(80) @cell() @cell() )
  //   @row( @cell([url]http://www.google.de/imghp?hl=de&tab=vw[/url]) @cell(http) @cell() @cell() @cell([url]www.google.de[/url]) @cell(80) @cell(imghp) @cell(hl=de&tab=vw) )
  // )
  // Werden die Einzelteile gesetzt, so wird die URL wie folgt zusammengesetzt:
  // @table(
  //   @rowHead( @cell(Serv) @cell(User) @cell(Pass) @cell(Host) @cell(Port) @cell(Path) @cell(Parm) @cell(URL) )
  //   @row( @cell(http) @cell() @cell() @cell([url]www.google.de[/url]) @cell(80) @cell() @cell() @cell([url]http://www.google.de[/url]) )
  //   @row( @cell(http) @cell() @cell() @cell([url]www.google.de[/url]) @cell(8080) @cell() @cell() @cell([url]http://www.google.de:8080[/url]) )
  //   @row( @cell(http) @cell() @cell() @cell([url]www.google.de[/url]) @cell(80) @cell(imghp) @cell(hl=de&tab=vw) @cell([url]http://www.google.de/imghp?hl=de&tab=vw[/url]) )
  // )
  // Ist der angegebene Port der Default-Port des Service, dann wird dieser in der URL nicht ausgegeben. @br
  // Ist in der übergebenen URL kein Port angegeben, so wird als Port der Default-Port für den Service verwendet. @br
  // Diese Informationen werden aus der Datei "services" (Pfad: "%system%\drivers\etc\") gelesen. 
  TParseURL = class
  private
    FPath : string;
    FPort : integer;
    FPass : string;
    FServ : string;
    FHost : string;
    FUser : string;
    FParm : string;
    FValid : boolean;
    function GetURL : string;
    procedure SetURL( const Value : string );
    procedure SetHost( const Value : string );
    procedure SetPass( const Value : string );
    procedure SetPath( const Value : string );
    procedure SetPort( const Value : integer );
    procedure SetServ( const Value : string );
    procedure SetUser( const Value : string );
    procedure SetParm( const Value : string );
    function GetPort : integer;

  public
    // URL-Pfad
    // 
    // @code(Serv)@code(:)@code(//)@code(User)@code(:)@code(Pass)@code(@@)@code(Host)@code(:) @code(Port)@code(/)@code(Path)@code(?)@code(Parm)
    property URL : string read GetURL write SetURL;
    // Service (ftp, http, etc.)
    // 
    // @code(@bold(Serv))@code(:)@code(//)@code(User)@code(:)@code(Pass)@code(@@)@code(Host)@code(:) @code(Port)@code(/)@code(Path)@code(?)@code(Parm)
    property Serv : string read FServ write SetServ;
    // Benutzer
    // 
    // @code(Serv)@code(:)@code(//)@code(@bold(User))@code(:)@code(Pass)@code(@@)@code(Host)@code(:) @code(Port)@code(/)@code(Path)@code(?)@code(Parm)
    property User : string read FUser write SetUser;
    // Kennwort
    // 
    // @code(Serv)@code(:)@code(//)@code(User)@code(:)@code(@bold(Pass))@code(@@)@code(Host)@code(:) @code(Port)@code(/)@code(Path)@code(?)@code(Parm)
    property Pass : string read FPass write SetPass;
    // Host-Name
    // 
    // @code(Serv)@code(:)@code(//)@code(User)@code(:)@code(Pass)@code(@@)@code(@bold(Host))@code(:) @code(Port)@code(/)@code(Path)@code(?)@code(Parm)
    property Host : string read FHost write SetHost;
    // Anschluss-Port
    // 
    // @code(Serv)@code(:)@code(//)@code(User)@code(:)@code(Pass)@code(@@)@code(Host) @code(:)@code(@bold(Port))@code(/)@code(Path)@code(?)@code(Parm)
    property Port : integer read GetPort write SetPort;
    // Pfad
    //     
    // @code(Serv)@code(:)@code(//)@code(User)@code(:)@code(Pass)@code(@@)@code(Host)@code(:) @code(Port)@code(/)@code(@bold(Path))@code(?)@code(Parm)
    property Path : string read FPath write SetPath;
    // Parameter
    // 
    // @code(Serv)@code(:)@code(//)@code(User)@code(:)@code(Pass)@code(@@)@code(Host)@code(:) @code(Port)@code(/)@code(Path)@code(?)@code(@bold(Parm))
    property Parm : string read FParm write SetParm;
    // Ist die URL gültig
    property Valid : boolean read FValid;

    // Löscht alle Werte in @classname
    procedure Clear;

    // Erzeugt eine neue Instanz von @classname
    constructor Create;
  end;

implementation

uses

  {$IFDEF SERV_DEFAULT_PORT}

  ActiveX,
  ShlObj,
  Windows,

  {$ENDIF SERV_DEFAULT_PORT}

  WinInet,
  SysUtils,
  Classes;

{$IFDEF SERV_DEFAULT_PORT}

const
  PathToServices = '\drivers\etc\services';

var
  ServList : TStringList;

  {$ENDIF SERV_DEFAULT_PORT}

type
  TEasyURLComponents = record
    Scheme, HostName : string;
    Port : integer;
    User, Password, UrlPath, ExtraInfo : string;
  end;

function CrackURL( const URL : string; decode, escape : boolean;
  var data : TEasyURLComponents ) : boolean;
  var
    uc : TURLComponents;
    flags : Cardinal;
  begin
    ZeroMemory( @uc, sizeof( uc ) );
    uc.dwStructSize := sizeof( TURLComponents );

    with data do
      begin
        SetLength( Scheme, 10 );
        uc.lpszScheme := PChar( Scheme );
        uc.dwSchemeLength := Length( Scheme );

        SetLength( HostName, 200 );
        uc.lpszHostName := PChar( HostName );
        uc.dwHostNameLength := Length( HostName );

        SetLength( User, 200 );
        uc.lpszUserName := PChar( User );
        uc.dwUserNameLength := Length( User );

        SetLength( Password, 200 );
        uc.lpszPassword := PChar( Password );
        uc.dwPasswordLength := Length( Password );

        SetLength( UrlPath, 1000 );
        uc.lpszUrlPath := PChar( UrlPath );
        uc.dwUrlPathLength := Length( UrlPath );

        SetLength( ExtraInfo, 2000 );
        uc.lpszExtraInfo := PChar( ExtraInfo );
        uc.dwExtraInfoLength := Length( ExtraInfo );
      end;

    flags := 0;
    // Converts encoded characters back to their normal form.
    if decode then
      flags := flags or ICU_DECODE;

    // Converts all escape sequences (%xx) to their corresponding characters.
    if escape then
      flags := flags or ICU_ESCAPE;

    RESULT := InternetCrackUrl( PChar( URL ), Length( URL ), flags, uc );

    with data do
      begin
        SetLength( Scheme, uc.dwSchemeLength );
        SetLength( HostName, uc.dwHostNameLength );
        SetLength( User, uc.dwUserNameLength );
        SetLength( Password, uc.dwPasswordLength );
        SetLength( UrlPath, uc.dwUrlPathLength );
        SetLength( ExtraInfo, uc.dwExtraInfoLength );
        Port := uc.nPort;
      end;
  end;

function StrBefore( const SubStr, S : string ) : string;
  begin
    if Pos( SubStr, S ) > 0 then
      RESULT := Copy( S, 1, Pos( SubStr, S ) - 1 )
    else
      RESULT := '';
  end;

function StrAfter( const SubStr, S : string ) : string;
  begin
    if Pos( SubStr, S ) > 0 then
      RESULT := Copy( S, Pos( SubStr, S ) + Length( SubStr ), Length( S ) )
    else
      RESULT := S;
  end;

{$IFDEF SERV_DEFAULT_PORT}

function GetSpecialFolder( hWindow : HWND; Folder : integer ) : String;
  var
    pMalloc : IMalloc;
    pidl : PItemIDList;
    Path : PChar;
  begin
    // Get IMalloc interface pointer
    if ( SHGetMalloc( pMalloc ) = S_OK ) then
      begin
        // retrieve path
        SHGetSpecialFolderLocation( hWindow, Folder, pidl );
        GetMem( Path, MAX_PATH );
        SHGetPathFromIDList( pidl, Path );
        RESULT := Path;
        if RESULT <> '' then
          RESULT := ExcludeTrailingPathDelimiter( RESULT );
        FreeMem( Path );
        // free memory allocated by SHGetSpecialFolderLocation
        pMalloc.Free( pidl );
      end
    else
      RESULT := '';
  end;

procedure BuildServList;
  var
    idx : integer;
  begin
    ServList.Clear;
    ServList.Sorted := False;
    with TStringList.Create do
      try
        LoadFromFile( GetSpecialFolder( 0, CSIDL_SYSTEM ) + PathToServices );
        idx := 0;
        while ( idx < Count ) do
          begin
            if ( Pos( '#', Trim( Strings[ idx ] ) ) = 1 ) or
              ( Trim( StrBefore( '/tcp', Strings[ idx ] ) ) = '' ) then
              Delete( idx )
            else
              inc( idx );
          end;

        idx := 0;
        while ( idx < Count ) do
          begin
            ServList.Values[ Trim( StrBefore( '  ', Strings[ idx ] ) ) ] := Trim
              ( StrBefore( '/tcp', StrAfter( '  ', Strings[ idx ] ) ) );
            inc( idx );
          end;

      finally
        Free;
      end;
    ServList.Sort;
    ServList.Sorted := True;
  end;

function GetServDefaultPort( const Serv : string ) : integer;
  begin
    RESULT := StrToIntDef( ServList.Values[ Serv ], 0 );
  end;

{$ENDIF SERV_DEFAULT_PORT}

{ TParseURL }

procedure TParseURL.Clear;
  begin
    FServ := '';
    FUser := '';
    FPass := '';
    FHost := '';
    FPort := 0;
    FPath := '';
    FParm := '';
    FValid := False;
  end;

constructor TParseURL.Create;
  begin
    inherited;
    Clear;
  end;

function TParseURL.GetPort : integer;
  begin
    RESULT := FPort;

    {$IFDEF SERV_DEFAULT_PORT}

    if ( FPort = 0 ) then
      RESULT := GetServDefaultPort( FServ );

    {$ENDIF SERV_DEFAULT_PORT}

  end;

function TParseURL.GetURL : string;
  var
    data : TEasyURLComponents;
  begin
    RESULT := '';
    if ( FUser <> '' ) then
      begin
        RESULT := RESULT + FUser;
      end;
    if ( FPass <> '' ) then
      RESULT := RESULT + ':' + FPass;
    if ( FUser <> '' ) or ( FPass <> '' ) then
      RESULT := RESULT + '@';
    if ( FHost <> '' ) then
      RESULT := RESULT + Host;
    if ( FPort <> 0 )

    {$IFDEF SERV_DEFAULT_PORT}

    and ( FPort <> GetServDefaultPort( FServ ) )

    {$ENDIF SERV_DEFAULT_PORT}

    then
      RESULT := RESULT + ':' + IntToStr( FPort );

    if ( FPath <> '' ) then
      RESULT := RESULT + FPath;

    if ( FParm <> '' ) then
      RESULT := RESULT + FParm;

    if ( FServ <> '' ) then
      begin
        if ( RESULT <> '' ) then
          RESULT := '//' + RESULT;
        RESULT := FServ + ':' + RESULT;
      end;

    FValid := CrackURL( RESULT, False, False, data );

    if not FValid then
      RESULT := '';
  end;

procedure TParseURL.SetHost( const Value : string );
  begin
    FHost := LowerCase( Value );
    GetURL;
  end;

procedure TParseURL.SetParm( const Value : string );
  begin
    FParm := Value;
    GetURL;
  end;

procedure TParseURL.SetPass( const Value : string );
  begin
    FPass := Value;
    GetURL;
  end;

procedure TParseURL.SetPath( const Value : string );
  begin
    FPath := Value;
    GetURL;
  end;

procedure TParseURL.SetPort( const Value : integer );
  begin
    FPort := Value;
    GetURL;
  end;

procedure TParseURL.SetServ( const Value : string );
  begin
    FServ := LowerCase( Value );
    GetURL;
  end;

procedure TParseURL.SetURL( const Value : string );
  var
    data : TEasyURLComponents;
  begin
    Clear;
    if CrackURL( Value, False, False, data ) then
      begin
        FServ := data.Scheme;
        FUser := data.User;
        FPass := data.Password;
        FHost := data.HostName;
        FPort := data.Port;
        FPath := data.UrlPath;
        FParm := data.ExtraInfo;
        FValid := True;
      end;
  end;

procedure TParseURL.SetUser( const Value : string );
  begin
    FUser := Value;
    GetURL;
  end;

{$IFDEF SERV_DEFAULT_PORT}

initialization

ServList := TStringList.Create;
BuildServList;

finalization

ServList.Free;

{$ENDIF SERV_DEFAULT_PORT}

end.

[edit=Matze]Leerzeichen in die Kommentare eingefügt, damit bei geringerer Bildschirmauflösung kein horizontaler Scrollbalken entsteht. MfG, Matze[/edit]

[CrashBack]

Danke werde ich auch mal versuchen.

[CrashBack]

Zitat von Sir Rufo:

Kannst ja auch das hier benutzen.

Habe ich mal geschrieben um eine URL nicht nur zu zerlegen, sondern auch auf einfache Art und Weise Teile der URL zu ändern.

Eine Demo für die Unit habe ich auch mal angehängt

*schnipp*

Bekomme bei der Unit einen Fehler ([DCC Fehler] uParseURL.pas(136): E2003 Undeklarierter Bezeichner: 'ZeroMemory') hab ich da was Falsch gemacht?

[edit=Matze]Langen Delphi-Code aus dem Zitat entfernt. MfG, Matze[/edit]