Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Neuen Beitrag zur Code-Library hinzufügen (https://www.delphipraxis.net/33-neuen-beitrag-zur-code-library-hinzufuegen/)
-   -   Delphi Keine "CheckURL" - Funktion in der DP zu finden ?! (https://www.delphipraxis.net/143029-keine-checkurl-funktion-der-dp-zu-finden.html)

turboPASCAL 8. Nov 2009 14:19


Keine "CheckURL" - Funktion in der DP zu finden ?!
 
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 8. Nov 2009 14:22

Re: Kein "CheckURL" - Funktion in der DP zu finden
 
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.

DP-Maintenance 8. Nov 2009 14:22

DP-Maintenance
 
Dieses Thema wurde von "Matze" von "Klatsch und Tratsch" nach "Neuen Beitrag zur Code-Library hinzufügen" verschoben.
Ich denke, das passt hier ganz gut hin. :)

turboPASCAL 8. Nov 2009 15:07

Re: Kein "CheckURL" - Funktion in der DP zu finden
 
Zitat:

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 23. Jan 2010 11:08

Re: Keine "CheckURL" - Funktion in der DP zu finde
 
Hi!

Dazu hätte ich eine Anmerkung:
Delphi-Quellcode:
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 23. Jan 2010 11:11

Re: Keine "CheckURL" - Funktion in der DP zu finde
 
Hallo,

bei W3C gibt es die Liste der Status-Codes.

401 = Unauthorized

fkerber 23. Jan 2010 11:12

Re: Keine "CheckURL" - Funktion in der DP zu finde
 
Hi!

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


Grüße, Frederic

Matze 23. Jan 2010 11:39

Re: Keine "CheckURL" - Funktion in der DP zu finde
 
Ja, der ist falsch. Da hast du Recht. 401 bedeutet eben nur "Unauthorized". Matti hat da zu viel hinein interpretiert. :stupid:

turboPASCAL 23. Jan 2010 13:38

Re: Keine "CheckURL" - Funktion in der DP zu finde
 
jaja. :stupid: :mrgreen:

fkerber 23. Jan 2010 13:42

Re: Keine "CheckURL" - Funktion in der DP zu finde
 
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 :wall:
Vergesst es einfach...


Grüße, Frederic


Alle Zeitangaben in WEZ +1. Es ist jetzt 20:01 Uhr.
Seite 1 von 2  1 2      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz