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.