CODEWITHSUNDEEP
delphiwininetdelphi-xe7
user1580348
user1580348

Reputation: 6053

Decrease InternetOpenUrl timeout?

This function checks whether an URL can be reached or not:

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;

However, when there is no Internet connection, the function returns only after 21 seconds. So how can I restrict the timeout to 2 seconds?

Here is a test program:

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.

Upvotes: 1

Views: 3286

Answers (2)

Ken White
Ken White

Reputation: 125708

Use InternetSetOption and set the receive connect timeout (INTERNET_OPTION_CONNECT_TIMEOUT). (Corrected to use CONNECT instead of RECEIVE, thanks to a comment from @JoshKelley.)

var
  dwTimeOut: DWORD;


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

Upvotes: 2

Josh Kelley
Josh Kelley

Reputation: 58362

Try using InternetSetOption to set INTERNET_OPTION_CONNECT_TIMEOUT, or use async mode so that you have full control over timeouts.

Upvotes: 2

Related Questions