减少 InternetOpenUrl 超时？

Posted 2023-02-16

【中文标题】减少 InternetOpenUrl 超时？

【英文标题】：Decrease InternetOpenUrl timeout?

【发布时间】：2015-02-27 20:58:04

【问题描述】：

此函数检查是否可以访问 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;

但是，当没有 Internet 连接时，该函数仅在 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.

【参考方案1】：

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

var
  dwTimeOut: DWORD;


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

【讨论】：

Ken，这个超时时间超过一分钟，然后是 14 秒，然后是 14 秒（路由器电缆已断开）。

@user1580348：所以调整dwTimeOut中的超时值。我没有你的设置来测试，也不能从这台机器上做。我在代码中留下了注释来解释documentation 所说的值应该是什么。

即使使用INTERNET_OPTION_CONNECT_TIMEOUT，该函数也仅在一分钟后才返回。我试着把它放在hfile := InternetOpenUrl 之前或之后——超时总是 14 - 18 秒。文档说milliseconds，这里只有一个IP地址。

它必须在调用InternetOpenURL之前，因为之后对你没有好处。 :-) 正如我所说，我回答了您提出的问题，即如何更改超时。我无法在你的网络连接上调试它，因为我无权访问你的网络连接。

如果我的解决方案是正确的，我很困惑你为什么不接受它。

【参考方案2】：

尝试使用InternetSetOption 设置INTERNET_OPTION_CONNECT_TIMEOUT，或使用async mode 以便完全控制超时。

【讨论】：

谢谢乔希，我只来InternetSetOption(hfile, INTERNET_OPTION_CONNECT_TIMEOUT, ???)。你能帮我看看其他参数吗？

@user1580348 - @Ken White's answer 有一个完整的例子（虽然他使用了INTERNET_OPTION_RECEIVE_TIMEOUT - 我必须测试一下，在实践中，你是否需要它或INTERNET_OPTION_CONNECT_TIMEOUT 或两者兼而有之）。

他的回答是在我发表评论后到达这里的。

@Josh：你说得对；它应该是连接而不是接收。我会更正（有适当的归属）。我已经对你的答案投了赞成票，这是在我整理我的时候发布的。

在这种情况下，这是使用异步模式的正确方法吗？：hSession := InternetOpen('InetURL:/1.0', INTERNET_FLAG_ASYNC, nil, nil, 0);