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...