Keine "CheckURL" - Funktion in der DP zu finden ?!

[turboPASCAL]

Hi,

Das gibts doch nicht, ich finde keine "CheckURL" - Funktion in der DP.

Habe jetzt bestimmt 20 min in der DP gesucht, umd dann doch selbst eine gebastelt.

Kurzversion:

Delphi-Quellcode:

// Windows API - Internet

uses WinINet;

function CheckUrl(url: string; const AutoAddHTMLID: Boolean = True): boolean;
var
  hInet: HINTERNET;
  hConnect: HINTERNET;
  infoBuffer: array [0..512] of char;
  d, bufLen: DWORD;
  nInfo: integer;
begin
  Result := False;
  if url <> '' then
  begin
    if AutoAddHTMLID then
      if pos('http://', AnsiLowerCase(url)) = 0 then url := 'http://' + url;

    hInet := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY, nil, nil, 0);
    if ASSIGNED(hInet) then
    begin
      hConnect := InternetOpenUrl(hInet, PChar(url), nil, 0, INTERNET_FLAG_EXISTING_CONNECT, 0);
      if ASSIGNED(hConnect) then
      begin
        d := 0;
        bufLen := length(infoBuffer);
        ZeroMemory(@infoBuffer, length(infoBuffer));
        if HttpQueryInfo(hConnect,HTTP_QUERY_STATUS_CODE, @infoBuffer[0], bufLen, d) then
        begin
          if infoBuffer = '200' then Result := True // File exists
          { Val(infoBuffer, nInfo, d); // genauere Auswertung
          if d = 0 then
          begin
            case nInfo of
              401: not authorised, page exists
              404: no file
              500: Internal server error.
              else unbekannter fehler
            end;
          end else Fehler bei nInfo  }
        end;
        InternetCloseHandle(hConnect);
      end;
    end;
    InternetCloseHandle(hInet);
  end;
end;

//add:
oder mit einer genaueren Auswertung:

Delphi-Quellcode:

function CheckUrl(url: string; var ErrInfo: string; const AutoAddHTMLID: Boolean = True): boolean;
var
  hInet: HINTERNET;
  hConnect: HINTERNET;
  infoBuffer: array [0..512] of char;
  d, bufLen: DWORD;
  nInfo, e: integer;
begin
  Result := False;
  if url <> '' then
  begin
    if AutoAddHTMLID then
      if pos('http://', AnsiLowerCase(url)) = 0 then url := 'http://' + url;

    hInet := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY, nil, nil, 0);
    if ASSIGNED(hInet) then
    begin
      hConnect := InternetOpenUrl(hInet, PChar(url), nil, 0, INTERNET_FLAG_EXISTING_CONNECT, 0);
      if ASSIGNED(hConnect) then
      begin
        d := 0;
        bufLen := length(infoBuffer);
        ZeroMemory(@infoBuffer, length(infoBuffer));
        if HttpQueryInfo(hConnect,HTTP_QUERY_STATUS_CODE, @infoBuffer[0], bufLen, d) then
        begin
          if infoBuffer = '200' then Result := True;
          Val(infoBuffer, nInfo, e);
          if e = 0 then
          begin
            case nInfo of
              200: ErrInfo := 'ok, file exists';
              401: ErrInfo := 'not authorised, page exists';
              404: ErrInfo := 'no file';
              500: ErrInfo := 'Internal server error';
              else ErrInfo := 'undef. error (1)';
            end;
          end else ErrInfo := 'undef. error (2)';
        end else
          ErrInfo := 'offline or no internet connection';
        InternetCloseHandle(hConnect);
      end else
        ErrInfo := 'error, connection fails. (InternetOpenUrl fail)';
    end else
      ErrInfo := 'error (InternetOpen fail)';
    InternetCloseHandle(hInet);
  end else
    ErrInfo := 'URL is empty';
end;

PS.: i weis ned wohie der beitrag soll und mache ggf. somit den mods eine lange weile kürzer.

[SirThornberry]

ich würde einen anderen Rückgabewert bevorzugen. Denn CheckUrl sagt nicht eindeutig aus wann es true und wann false ist. Zum Beispiel wäre temporäry moved aus sicht vieler auch ein Grund True als Rückgabe zu erwarten für andere wäre ein False hingegen der erwartete Rückgabewert.

[turboPASCAL]

Zitat von SirThornberry:

ich würde einen anderen Rückgabewert bevorzugen.

Ja, ich habe es halt passen für mein Programm geschrieben.
Eine genauere Auswertung der Rückgabewerte kann man ja noch einbauen.

[fkerber]

Hi!

Dazu hätte ich eine Anmerkung:
401: ErrInfo := 'not authorised, page exists'; Bist du dir sicher, dass das so richtig ist? Ich denke, das hier wäre ein Gegenbsp:
www.server.de/private ist ein geschützter Ordner.
Ich versuche auf www.server.de/private/gibt_es_nicht.ext zuzugreifen, kann mich aber nicht authorisieren - dann bekomme ich einen 401 zurück, obwohl die Datei nicht existiert.


Grüße, Frederic

[Matze]

Hallo,

bei W3C gibt es die Liste der Status-Codes.

401 = Unauthorized

[fkerber]

Hi!

Ja, das ist klar.
Ich denke nur, dass der Zusatz "page exists" falsch ist.


Grüße, Frederic

[Matze]

Ja, der ist falsch. Da hast du Recht. 401 bedeutet eben nur "Unauthorized". Matti hat da zu viel hinein interpretiert.

[turboPASCAL]

jaja.

[fkerber]

Hi!

Gut, stellt sich mir nur noch eine Frage:
Wird hier die URL auf korrekte Form geprüft oder wird auch geprüft, ob der Server existiert / erreichbar ist?

Edit:
Oh man, wenn ich die Frage jetzt nochmal so lese und nachdenke, muss ich mir an den Kopf fassen
Vergesst es einfach...


Grüße, Frederic