URL checken

[Privateer3000]

Hallöchen,
ich erstelle mal zu diesem Thema einen neuen Thread.
Und zwar geht es um das Beispiel von Marabu:

Code:

function Tmain.urlcheck(sUrl: String; bAllowRedirects: Boolean = false): Integer;
begin
   with IdHTTP1 do
   try
     try
       HandleRedirects := bAllowRedirects;
       Head(sUrl);
       Result := Response.ResponseCode;
     finally
       Free;
     end;
   except
       Result := GetLastError;
   end;
end;

Wenn nun die Funktion mit

Code:

urlcheck('http://www.delphipraxis.net', true) = 200

aufgerufen wird, funktioniert das.
Aber nur einmal. Lässt man einen Timer regelmäßig diese Funktion aufrufen
gibt es eine Exception beim zweiten Mal.

Warum passiert das?

[DeddyH]

Durch das Free ist IdHTTP1 ja gar nicht mehr existent, daher muss ja jeder weitere Zugriff scheitern. Hast Du evtl. Code ausgelassen, ich kann mir nicht vorstellen, dass Achim so ein Klopper passiert sein soll?

[edit] Du kannst es aber auch mal so versuchen (ohne Indy):

Delphi-Quellcode:

uses WinInet;

function IsUrlValid(const sUrl: string; CheckTimeout: DWORD = 3000): Boolean;
var
  hInet, hConnect: HINTERNET;
  StatusCode, dummy, bufLen, Option: DWORD;
begin
  Result := False;
  hInet := InternetOpen(PChar(Application.Title),
    INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY, nil, nil, 0);
  if Assigned(hInet) then
    try
      Option := CheckTimeout;
      InternetSetOption(hInet, INTERNET_OPTION_CONNECT_TIMEOUT, @Option,
        SizeOf(Option));
      InternetSetOption(hInet, INTERNET_OPTION_RECEIVE_TIMEOUT, @Option,
        SizeOf(Option));
      hConnect := InternetOpenUrl(hInet, PChar(trim(sUrl)), nil, 0,
        INTERNET_FLAG_NO_UI, 0);
      if Assigned(hConnect) then
        try
          dummy := 0;
          bufLen := SizeOf(StatusCode);
          if HttpQueryInfo(hConnect, HTTP_QUERY_STATUS_CODE or
            HTTP_QUERY_FLAG_NUMBER, @StatusCode, bufLen, dummy) then
            Result := StatusCode = HTTP_STATUS_OK;
        finally
          InternetCloseHandle(hConnect);
        end;
    finally
      InternetCloseHandle(hInet);
    end;
end;

Das setzt zwar einen installierten InternetExplorer voraus, aber davon kann man wohl ausgehen.[/edit]

[Privateer3000]

Vielen Dank dafür!
Dieses funtkioniert,
ich weiß zwar nicht wie, aber es funktioniert.
Von der Materie hab ich echt keinen Schimmer.
Apropos:

Code:

Result := StatusCode = HTTP_STATUS_OK;

Läßt sich das ganze so modifizieren dass es den Statuscode zurückgibt?


Grüße

[DeddyH]

Klar, deklariere statt Boolean DWORD als Rückgabewert, initialisiere mit 0 und ändere besagte Zeile in

Delphi-Quellcode:

Result := StatusCode;

[Privateer3000]

Ha! Das hab ich sogar verstanden :)

Danke und schönes Wochenende!

[Privateer3000]

Also irgendwas stimmt da nicht.
Ich bekomme immer ein "OK" auch wenn die URL ungültig ist:

Delphi-Quellcode:

function urlcheck(const sUrl: string; CheckTimeout: DWORD = 3000): DWORD;
var
   hInet, hConnect: HINTERNET;
   StatusCode, dummy, bufLen, Option: DWORD;
begin
   Result := 0;
   hInet := InternetOpen(PChar(Application.Title),
     INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY, nil, nil, 0);
   if Assigned(hInet) then
     try
       Option := CheckTimeout;
       InternetSetOption(hInet, INTERNET_OPTION_CONNECT_TIMEOUT, @Option,
         SizeOf(Option));
       InternetSetOption(hInet, INTERNET_OPTION_RECEIVE_TIMEOUT, @Option,
         SizeOf(Option));
       hConnect := InternetOpenUrl(hInet, PChar(trim(sUrl)), nil, 0,
         INTERNET_FLAG_NO_UI, 0);
       if Assigned(hConnect) then
         try
           dummy := 0;
           bufLen := SizeOf(StatusCode);
           if HttpQueryInfo(hConnect, HTTP_QUERY_STATUS_CODE or
             HTTP_QUERY_FLAG_NUMBER, @StatusCode, bufLen, dummy) then
             Result := StatusCode;
         finally
           InternetCloseHandle(hConnect);
         end;
     finally
       InternetCloseHandle(hInet);
     end;
end;

function htcodes(mycode: Integer): string;
begin
   case mycode of
     200: Result := 'OK';
     301: Result := 'Adresse umgezogen';
     400: Result := 'Anfrage fehlerhaft';
     401: Result := 'keine Authentifizierung';
     403: Result := 'keine Berechtigung';
     404: Result := 'Keine Antwort';
     408: Result := 'Timeout';
     else
       Result := 'unbekannter Fehler'; 
   end;
end;

Aufruf:

Delphi-Quellcode:

procedure Tmain.testbuttonClick(Sender: TObject);
var stc: Integer;
begin
 stc:=urlcheck(urltext.Text);
 Showmessage(htcodes(stc));
end;

Theoretisch gibt es also immer eine 200 zurück.
Mache ich was falsch?

[DeddyH]

Bei mir funktioniert der Code, unter Delphi 7 ausprobiert.

[Privateer3000]

Seltsam
selbst wenn ich den größten Blödsinn reinschreibe
meldet es OK. Hauptsache ich schreibe überhaupt was rein.
Ist urltext.text leer kommt unbekannter Fehler, also die else vom case.
Wie kann es bei dir funktionieren?

[DeddyH]

Bist Du mal durchgesteppt? Ich habe unter Windows kein Lazarus zur Verfügung, unter Linux kann ich ja WinInet schlecht benutzen.

[Privateer3000]

Auch wenn bei mir inzwischen FPC/Lazarus steht,
das nutze ich hauptsächlich, habe ich das hier
in meinem alten D7 gemacht. Also unter quasi gleichen Bedingungen.
Hätte ich vllt. dazuschreiben sollen, sry :(

Aber ich setze mal einen Haltepunkt, mal sehen wo
die Routine hinspringt...

[Privateer3000]

Ich hab mal mittels Haltepunkt geschaut.
Es wird im Case auf die 200 gesprungen und die Ausgabe getätigt.
Also ist der zurückgegebene Statuscode 200.
Aber eben immer, wie gesagt...

ratlos...

[jaenicke]

Hast du es denn mal ohne das Free mit dem ursprünglichen Code versucht?

Delphi-Quellcode:

function Tmain.urlcheck(sUrl: String; bAllowRedirects: Boolean = false): Integer;
begin
   try
     IdHTTP1.HandleRedirects := bAllowRedirects;
     IdHTTP1.Head(sUrl);
     Result := IdHTTP1.Response.ResponseCode;
   except
     Result := GetLastError; // was soll das bringen? bei Indy dürfte GetLastError nichts über den Fehler aussagen...
   end;
end;

[Privateer3000]

Das hatte sich doch schon erledigt,
DeddyH hat ja eine Lösung ohne Indy.
An sich war das klar ein Fehler von mir,
eine zur Laufzeit generierte Kompo wird natürlich freigegeben.
Trotzdem Danke!

[haentschman]

Moin...8-)
[mein Senf]

Zitat:

DeddyH hat ja eine Lösung ohne Indy.

Persönlich würde ich die Indy Lösung bevorzugen. Ist einkompiliert und nicht von externen Voraussetzungen abhängig. Wenn dein Programm nicht funktioniert, weil der IE nicht will, bist du Schuld und nicht der Admin der das Dingens falsch eingestellt hat. (mögliches Szenario :zwinker:)
[/mein Senf]

[jaenicke]

Solange man das nicht auf einem Server oder in einem Dienst einsetzt funktioniert es in der Regel schon (auch wenn es so ca. meine letzte Wahl wäre). Die Warnung wegen Servern und einem Einsatz im Dienst sollte man aber schon bedenken, denn wenn man den Code später mal dort einsetzen will, muss man es umschreiben...

Zitat:

Zitat von Doku

WinINet does not support server implementations. In addition, it should not be used from a service. For server implementations or services use Microsoft Windows HTTP Services (WinHTTP).

http://msdn.microsoft.com/en-us/libr...(v=vs.85).aspx