SHOW:
|
|
- or go back to the newest paste.
| 1 | //uses wininet; | |
| 2 | function InternetCheckUrl( AURL: WideString; | |
| 3 | AHTTPStatus: PDWORD = nil; | |
| 4 | AConnectTimeout: Cardinal = INFINITE; | |
| 5 | ARecieveTimeout: Cardinal = INFINITE; | |
| 6 | ASendTimeout: Cardinal = INFINITE ): Integer; | |
| 7 | const | |
| 8 | C_CLIENT: WideString = 'checkurl'; | |
| 9 | C_HTTP_W : WideString = 'http'; | |
| 10 | C_ADD_W: WideString = '://'; | |
| 11 | var | |
| 12 | lSession, | |
| 13 | lFile: hInternet; | |
| 14 | lBuf, | |
| 15 | lLen, | |
| 16 | lIdx: DWORD; | |
| 17 | begin | |
| 18 | if Pos( C_HTTP_W, WideLowerCase( AURL ) ) <> 1 then | |
| 19 | AURL := C_HTTP_W + C_ADD_W + AURL; | |
| 20 | Result := -1; | |
| 21 | lSession := InternetOpenW( PWideChar(C_CLIENT), PRE_CONFIG_INTERNET_ACCESS, nil, nil, 0); | |
| 22 | if not Assigned(lSession) then | |
| 23 | Result := GetLastError | |
| 24 | else | |
| 25 | try | |
| 26 | if InternetSetOption( lSession, INTERNET_OPTION_CONNECT_TIMEOUT, @AConnectTimeOut, SizeOf(Cardinal) ) and | |
| 27 | InternetSetOption( lSession, INTERNET_OPTION_RECEIVE_TIMEOUT, @ARecieveTimeOut, SizeOf(Cardinal) ) and | |
| 28 | InternetSetOption( lSession, INTERNET_OPTION_SEND_TIMEOUT, @ASendTimeout, SizeOf(Cardinal) ) then | |
| 29 | begin | |
| 30 | lFile :=InternetOpenURLW( lSession, PWideChar(AURL), nil, 0 , INTERNET_FLAG_RELOAD, 0); | |
| 31 | if not Assigned( lFile ) then | |
| 32 | Result := GetLastError | |
| 33 | else | |
| 34 | try | |
| 35 | lIdx := 0; | |
| 36 | lLen := SizeOf(lBuf); | |
| 37 | if not Assigned( AHTTPStatus ) then | |
| 38 | AHTTPStatus := @lBuf; | |
| 39 | if not HttpQueryInfoW( lFile, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, AHTTPStatus, lLen, lIdx) then | |
| 40 | Result := GetLastError | |
| 41 | else | |
| 42 | if (AHTTPStatus^ = 200 ) or (AHTTPStatus^ = 302 ) then | |
| 43 | Result := 0 //если все ОК, то обнулим результат; | |
| 44 | finally | |
| 45 | InternetCloseHandle( lFile ) | |
| 46 | end; | |
| 47 | end; | |
| 48 | finally | |
| 49 | InternetCloseHandle(lSession); | |
| 50 | end; | |
| 51 | end; | |
| 52 | /////////////////////////////////////////////////////////////////////// | |
| 53 | //использование | |
| 54 | while InternetCheckUrl('http://www.***сайт',nil,3000,3000,3000)<>0 do begin
| |
| 55 | LabelB2.Caption:='NO_CONNECT_URL'; | |
| 56 | Application.ProcessMessages; | |
| 57 | if (FileExists(ExtractFilePath(ParamStr(0))+'OKSOUND.WAV')) and alarm then | |
| 58 | PlaySound(pchar(ExtractFilePath(ParamStr(0))+'OKSOUND.WAV'), 0, SND_ASYNC); | |
| 59 | Sleep(10000); | |
| 60 | end; | |
| 61 | /////////////////////////////////////////////////////////////////////// | |
| 62 | {
| |
| 63 | Как пользоваться: | |
| 64 | AURL - соотв ссылка, которую проверяем. | |
| 65 | AHTTPStatus - HTTP статус запрошенной странички на сервере. | |
| 66 | AConnectTimeout, | |
| 67 | ARecieveTimeout, | |
| 68 | ASendTimeout - соответственно таймауты на подключение, чтение и посылку данных. по умолчанию - бесконечность. | |
| 69 | Result функции будут следующие: | |
| 70 | -1: запрос по адресу странички выдал HTTP Status Code <> 200 или 302. если был передан указатель на DWORD вторым параметром, то по его адресу можно прочитать собственно выданный сервером статус. | |
| 71 | 0: Все нормально, сервер существует и вернул HTTP Status Code равным 200 или 302. | |
| 72 | >0: ошибка произошла при вызове функций WinInet. результат работы GetLastError. для получения текстового представления (не для всех ошибок) можно вызвать SysErrorMessage для получения текста с сообщением об ошибке. | |
| 73 | ||
| 74 | единственный косяк в функции, который сразу заметен, это разные типы Result'а функции и типа, возвращаемого GetLastError... | |
| 75 | з.ы. можно сделать и асинхронный вариант проверки... | |
| 76 | } |
