减少 InternetOpenUrl 超时？

Question

此函数检查是否可以到达 URL:

uses wininet, System.Types,

...

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;

但是，当没有互联网连接时，函数returns只能在21秒后。那么如何将超时限制为 2 秒？

这是一个测试程序：

program CheckURLTest;

{.$APPTYPE CONSOLE}
{.$R *.res}

uses
  CodeSiteLogging,
  wininet,
  System.Types,
  System.SysUtils;

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;

var
  TestURL: string;

begin
  try
    TestURL := 'http://www.google.com';

    CodeSite.Send('VOR CheckUrl');
    if CheckUrl(TestURL) then
      CodeSite.Send(TestURL + ' exists!')
    else
      CodeSite.Send(TestURL + ' does NOT exist!');

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

end.

Answer 1

尝试使用 InternetSetOption to set INTERNET_OPTION_CONNECT_TIMEOUT, or use async mode 以便您可以完全控制超时。

Answer 2

使用InternetSetOption并设置接收连接超时（INTERNET_OPTION_CONNECT_TIMEOUT）。（更正为使用 CONNECT 而不是 RECEIVE，感谢@JoshKelley 的评论。）

var
  dwTimeOut: DWORD;


dwTimeOut := 2000; // Timeout in milliseconds
InternetSetOption(hSession, INTERNET_OPTION_CONNECT_TIMEOUT, 
                  @dwTimeOut, SizeOf(dwTimeOut));

减少 InternetOpenUrl 超时？

Decrease InternetOpenUrl timeout?

delphi

wininet

delphi-xe7