Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Сети > Проверка URL


Автор: sssssss7 12.3.2009, 07:40
при любом url выдает false... пользуюсь Дельфи2009 есть подозрение что это все из за юникода... пробывал ставить за место char AnsiChar не помогает... значение переменной infoBuffe набор символов... Помогите разобратся....
Код

function IsUrlValid(const url: string): boolean;
var
  hInet: HINTERNET;
  hConnect: HINTERNET;
  infoBuffer: array [0..512] of char;
  dummy: DWORD;
  bufLen: DWORD;
  okay: LongBool;
  reply: String;
begin
    hInet := InternetOpen(PChar(application.title),INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY,nil,nil,0);
    hConnect := InternetOpenUrl(hInet,PChar(url),nil,0,INTERNET_FLAG_NO_UI,0);
  if not Assigned(hConnect) then
    result := false
  else
  begin
    dummy := 0;
    bufLen := Length(infoBuffer);
    okay := HttpQueryInfo(hConnect,HTTP_QUERY_STATUS_CODE,@infoBuffer[0],bufLen,dummy);
    if not okay then
      // Probably working offline, or no internet connection.
      result := False
    else
    begin
      reply := infoBuffer;
      if reply = '200' then
        // File exists, all ok.
        result := True
      else if reply = '401' then
        // Not authorised. Assume page exists,
        // but we can't check it.
        result := True
      else if reply = '404' then
        // No such file.
        result := False
      else if reply = '500' then
        // Internal server error.
        result := False
      else
        // Shouldn't get here! It means there is
        // a status code left unhandled.
        result := False;
    end;
    InternetCloseHandle(hConnect);
  end;
  InternetCloseHandle(hInet);
end;

Автор: sssssss7 12.3.2009, 09:45
Весь инет завален этой функцией 
Код

function CheckUrl(url: String): boolean;
var hSession, hfile: hInternet;
    dwindex, dwcodelen: dword;
    dwcode: array [1..20] of widechar;
    res: PChar;
begin
    if pos('http', lowercase(url)) = 0 then
        url := 'http://'+url;
    Result := false;
    hSession := InternetOpen(pwidechar(application.exename), PRE_CONFIG_INTERNET_ACCESS, nil, nil, 0);
    if assigned(hsession) then
    begin
        hfile :=InternetOpenURL(hSession,PChar(url),nil,0,0,0);
        dwIndex := 0;
        dwCodeLen := 10;
        HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);
        form1.Memo1.Lines.Add(dwcode);
        res := PChar(@dwcode);
        result := (res = '200') or (res = '302');
        if assigned(hfile) then
            InternetCloseHandle(hfile);
        InternetCloseHandle(hsession);
    end;
end;

в делфи 7 работает как по маслу.. в 2009 не хочет... постоянно false  smile  в чем причина???? кто подскажит рабочий на 2009 код проверки линка

Автор: MetalFan 12.3.2009, 13:11
тут два варианта - либо адаптировать функцию так, чтобы она вызывала и использовала однобайтовые строки и вызывала нужные функции, либо переделывать на двухбайтовые строки.
но сначала убедиться, какие функции реально вызываются (InternetXXX) - с расширением A или W. по идее должны уже с W.
2009й под рукой нет, проверить не могу.

счас перепишу на вайдстринги. вообще код какойто бредовый "распространен в интернете"

Автор: MetalFan 12.3.2009, 13:29
вот, переделал на вайдстринги и довел до ума. должно работать в любой версии делфи.
Код

function CheckUrl( AURL: WideString ): Boolean;
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 := False;
  lSession := InternetOpenW( PWideChar(C_CLIENT), PRE_CONFIG_INTERNET_ACCESS, nil, nil, 0);
  if Assigned(lSession) then
  try
    lFile :=InternetOpenURLW( lSession, PWideChar(AURL), nil, 0 , INTERNET_FLAG_RELOAD, 0);
    if Assigned( lFile ) then
    try
      lIdx := 0;
      lLen := SizeOf(lBuf);
      if HttpQueryInfoW( lFile, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @lBuf, lLen, lIdx) then
        Result := (lBuf = 200) or (lBuf = 302);
    finally
      InternetCloseHandle( lFile )
    end;
  finally
    InternetCloseHandle(lSession);
  end;
end;

Автор: sssssss7 12.3.2009, 14:15
yandex.ru и google.com у меня почему то lFile=nil... 

Автор: MetalFan 12.3.2009, 14:52
а интернет в системе настроен корректно?
у меня данный код отрабатывает на ура. правда д2006.

Автор: sssssss7 12.3.2009, 14:58
в коде я не сомниваюсь... вот только не пойму почему у меня не работает.. пробывал на дельфи 7 и 2009... а интернет в системе настроен норм.. файрволы и антивир отключены, подключение vpn... другие компоненты тот же idFTP работает норм.. мистика)

Автор: MetalFan 12.3.2009, 15:10
а попробуй вместо PRE_CONFIG_INTERNET_ACCESS вписать INTERNET_OPEN_TYPE_DIRECT... даже и не знаю, что еще можно предположить...
ай торможу! есть же GetLastError. попробуй такой код:
Код

var
  gLastError: string;

function InternetGetLastError(): WideString;
var
  lLen: dword;
  lErr: dword;
begin
  Result := '';
  lErr := 0;
  lLen := 1000;
  lErr := GetLastError;
  if lErr = ERROR_INTERNET_EXTENDED_ERROR  then
  begin
    SetLength( Result, lLen );
    if InternetGetLastResponseInfoW( lErr, PWideChar( Result ), lLen) then
      SetLength( Result, lLen )
    else
      Result := '';
  end
  else
    Result := 'Error:'+IntToStr(lErr)+' Text:'+ SysErrorMessage( lErr );
end;

function CheckUrl( AURL: WideString ): Boolean;
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 := False;
  gLastError := '';
  lSession := InternetOpenW( PWideChar(C_CLIENT), PRE_CONFIG_INTERNET_ACCESS, nil, nil, 0);
  if not Assigned(lSession) then
    gLastError := InternetGetLastError
  else
  try
    lFile :=InternetOpenURLW( lSession, PWideChar(AURL), nil, 0 , INTERNET_FLAG_RELOAD, 0);
    if not Assigned( lFile ) then
      gLastError := InternetGetLastError
    else
    try
      lIdx := 0;
      lLen := SizeOf(lBuf);
      if HttpQueryInfoW( lFile, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @lBuf, lLen, lIdx) then
        Result := (lBuf = 200) or (lBuf = 302)
      else
        gLastError := InternetGetLastError
    finally
      InternetCloseHandle( lFile )
    end;
  finally
    InternetCloseHandle(lSession);
  end;
end;

ну и соотв. что там в gLastError попало?

Автор: sssssss7 12.3.2009, 15:24
Ура заработала) MetalFan ты с большой буквы "Э" Эксперт... спасибо огромнейшее спас человека от нервоного истощения а компьютер от палета с балкона  smile 

ток вот еще что заметил... очень долгий timeout соединения при отключеном интернете где то сек 20-30.. 

кстати почему заработала не пойму.. ща буду ломать))

Автор: MetalFan 12.3.2009, 15:30
обновил код в предыдущем посте. посмотри, что в gLastError попадает, когда функция False возвращает...

Автор: sssssss7 12.3.2009, 15:54
false...  lErr=12007   text=''

Автор: MetalFan 12.3.2009, 16:12
ERROR_INTERNET_NAME_NOT_RESOLVED 
12007
The server name could not be resolved.

видимо либо DNS висит, либо до него трудно достучаться

Автор: sssssss7 12.3.2009, 16:18
yandex.ru, google.com, mastehost.ru... не висят точно да и захожу на них норм.. грузятся быстро... кстати опять не работает(не долго радовался smile ) и всё таже ошибка 12007 ... вообще не догоняю почему 
Код

 lFile :=InternetOpenURLW( lSession, PWideChar(AURL), nil, 0 , INTERNET_FLAG_RELOAD, 0);

возвращает nil, интерет работает все просто летает...  

Автор: sssssss7 12.3.2009, 17:28
вывод один проблема с сеткой...  MetalFan еще раз спасибо за код, реально понравился так как я новичок в winapi мне еще до такого далеко smile  ... теперь думаю он будет гулять по инету smile  

проблема решена ставьте галочку... тока вот думаю для проверки связи с нетом она не особо годится так как очень долгий timeout попытки соединения когда нет сети... около 30 -40 сек... с замерзанием формы...  smile 

Автор: MetalFan 12.3.2009, 18:21
Цитата(sssssss7 @  12.3.2009,  17:28 Найти цитируемый пост)
тока вот думаю для проверки связи с нетом она не особо годится так как очень долгий timeout попытки соединения когда нет сети

можно использовать асинхронный режим вызова функций WinInet, или запихнуть все это в поток.
вот кстати окончательный вариант проверки URL с проверкой в синхронном режиме:
Код

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;

Как пользоваться:
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...
з.ы. можно сделать и асинхронный вариант проверки...

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)