InternetCheckUrl

//uses wininet;
function InternetCheckUrl( AURL: WideString;
                           AHTTPStatus: PDWORD = nil;
                           AConnectTimeout: Cardinal = INFINITE;
                           ARecieveTimeout: Cardinal = INFINITE;
                           ASendTimeout: Cardinal = INFINITE ): Integer;
const
  C_CLIENT: WideString = 'checkurl';
  C_HTTP_W : WideString = 'http';
  C_ADD_W: WideString = '://';
var
  lSession,
  lFile: hInternet;
  lBuf,
  lLen,
  lIdx: DWORD;
begin
  if Pos( C_HTTP_W, WideLowerCase( AURL ) ) <> 1 then
    AURL := C_HTTP_W + C_ADD_W + AURL;
  Result := -1;
  lSession := InternetOpenW( PWideChar(C_CLIENT), PRE_CONFIG_INTERNET_ACCESS, nil, nil, 0);
  if not Assigned(lSession) then
    Result := GetLastError
  else
  try
    if InternetSetOption( lSession, INTERNET_OPTION_CONNECT_TIMEOUT, @AConnectTimeOut, SizeOf(Cardinal) ) and
       InternetSetOption( lSession, INTERNET_OPTION_RECEIVE_TIMEOUT, @ARecieveTimeOut, SizeOf(Cardinal) ) and
       InternetSetOption( lSession, INTERNET_OPTION_SEND_TIMEOUT, @ASendTimeout, SizeOf(Cardinal) ) then
    begin
      lFile :=InternetOpenURLW( lSession, PWideChar(AURL), nil, 0 , INTERNET_FLAG_RELOAD, 0);
      if not Assigned( lFile ) then
        Result := GetLastError
      else
      try
        lIdx := 0;
        lLen := SizeOf(lBuf);
        if not Assigned( AHTTPStatus ) then
          AHTTPStatus := @lBuf;
        if not HttpQueryInfoW( lFile, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, AHTTPStatus, lLen, lIdx) then
          Result := GetLastError
        else
        if (AHTTPStatus^ = 200 ) or (AHTTPStatus^ = 302 ) then
          Result := 0 //если все ОК, то обнулим результат;
      finally
        InternetCloseHandle( lFile )
      end;
    end;
  finally
    InternetCloseHandle(lSession);
  end;
end;
///////////////////////////////////////////////////////////////////////
//использование
while InternetCheckUrl('http://www.***сайт',nil,3000,3000,3000)<>0 do begin
LabelB2.Caption:='NO_CONNECT_URL';
Application.ProcessMessages;
if (FileExists(ExtractFilePath(ParamStr(0))+'OKSOUND.WAV')) and alarm then
PlaySound(pchar(ExtractFilePath(ParamStr(0))+'OKSOUND.WAV'), 0, SND_ASYNC);
Sleep(10000);
end;
///////////////////////////////////////////////////////////////////////
{
Как пользоваться:
AURL - соотв ссылка, которую проверяем.
AHTTPStatus - HTTP статус запрошенной странички на сервере.
AConnectTimeout,
ARecieveTimeout,
ASendTimeout - соответственно таймауты на подключение, чтение и посылку данных. по умолчанию - бесконечность.
Result функции будут следующие:
-1: запрос по адресу странички выдал HTTP Status Code <> 200 или 302. если был передан указатель на DWORD вторым параметром, то по его адресу можно прочитать собственно выданный сервером статус.
0: Все нормально, сервер существует и вернул HTTP Status Code равным 200 или 302.
>0: ошибка произошла при вызове функций WinInet. результат работы GetLastError. для получения текстового представления (не для всех ошибок) можно вызвать SysErrorMessage для получения текста с сообщением об ошибке.

единственный косяк в функции, который сразу заметен, это разные типы Result'а функции и типа, возвращаемого GetLastError...
з.ы. можно сделать и асинхронный вариант проверки...
}