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;

但是，当没有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.

Answer 1

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

Answer 2

使用InternetSetOption并设置 ~~receive~~ 连接超时（INTERNET_OPTION_CONNECT_TIMEOUT）。（由于@JoshKelley的评论，已更正使用CONNECT代替RECEIVE。）

var
  dwTimeOut: DWORD;


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

减少InternetOpenUrl超时？

2 个答案: