Как проверить существование URL?

Материал из DRKB


Данная функция позволяет Вам проверить существование определённого адреса(URL) в интернете. Естественно она может пригодиться веб-мастерам, у которых на сайте много ссылок, и необходимо с определённой периодичностью эти ссылки проверять.

URL может быть как с префиксом http:/ так и без него - эта функция добавляет префикс http:// если он отсутствует (необходимо для функции internetOpenUrl которая так же поддерживает FTP:// и gopher://

Эта функция проверяет только два возвращаемых кода '200' (ОК) или '302' (Редирект), но Вы можете заставить проверять функцию и другие коды. Для этого достаточно модифицировать строчку "result := ".

Платформа: Delphi 3.x (или выше)

uses wininet;

function CheckUrl(url: string): Boolean;
var
  hSession, hFile, hRequest: hInternet;
  dwIndex, dwCodeLen: DWord;
  dwCode: array[1..20] of Char;
  res: PChar;
begin
  if Pos('http://', lowercase(url)) = 0 then
    url := 'http://' + url;
  Result := False;
  hSession := InternetOpen('InetURL:/1.0',
    INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if Assigned(hSession) then
  begin
    hFile := InternetOpenUrl(hSession, PChar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
    dwIndex := 0;
    dwCodeLen := 10;
    HttpQueryInfo(hFile, HTTP_QUERY_STATUS_CODE, @dwCode, dwCodeLen, dwIndex);
    res := PChar(@dwCode);
    Result := (res = '200') or (res = '302');
    if Assigned(hFile) then
      InternetCloseHandle(hFile);
    InternetCloseHandle(hSession);
  end;
end;


Source: http://forum.sources.ru
ID: 03576