wininetのエラー処理について

解決

ss 2013-08-05 08:01:47 No: 44982

wininetのエラー処理についてですが、以下のようなプログラムで
サーバーから時間を取得しています。（ntpが使えない環境なので）
サーバーが稼動している場合は問題ないのですが、止まっている
場合とか見つからない場合は、何も戻ってきません。
見つからない場合はこのプログラムが稼動しているパソコンの
時間を戻すようにしたいのですが、どうすればいいでしょうか？
よろしくお願いします。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Wininet, DateUtils;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
Form1: TForm1;

implementation

{$R *.dfm}
function GetMyServerTime : TDateTime ;
  const
  //   Httpで時間取得するサーバー名
      URL = 'http://10.1.1.11/';

var
  InetHandle, IOpenHandle: HINTERNET;
  Buffer: array[0..255] of Char;
  BufSize, Dummy: Cardinal;
  Y, M, D, H, N, S: Word;
  MStr: String;
  HttpDateTime: TDateTime;
  Code : Cardinal;

begin
   Result := Now;
  InetHandle := InternetOpen(nil, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
  //InetHandle := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if InetHandle=nil then
  begin
    Code:=GetLastError;
    raise Exception.Create(Format('Error %d Description %s',[Code,SysErrorMessage(Code)]));
  end;

  try
    if (not Assigned(InetHandle)) then begin

    Exit;
    end;

    IOpenHandle := InternetOpenUrl(InetHandle, URL, nil, 0, INTERNET_FLAG_RELOAD, 0);
    try
      if (not Assigned(IOpenHandle)) then begin

          Exit;
      end;

      if IOpenHandle=nil then
         begin
           Code:=GetLastError;
      raise Exception.Create(Format('Error %d Description %s',[Code,SysErrorMessage(Code)]));
      end;

      BufSize := Length(Buffer);
      FillChar(Buffer, BufSize, 0);
      Dummy := 0;
      if HttpQueryInfo(IOpenHandle, HTTP_QUERY_DATE, @Buffer, BufSize, Dummy) then
      begin
        Y := StrToIntDef(Copy(Buffer, 13, 4), 0);
        MStr := LowerCase(Copy(Buffer, 9, 3));
        if (MStr = 'jan') then M := 1 else
        if (MStr = 'feb') then M := 2 else
        if (MStr = 'mar') then M := 3 else
        if (MStr = 'apr') then M := 4 else
        if (MStr = 'may') then M := 5 else
        if (MStr = 'jun') then M := 6 else
        if (MStr = 'jul') then M := 7 else
        if (MStr = 'aug') then M := 8 else
        if (MStr = 'sep') then M := 9 else
        if (MStr = 'oct') then M := 10 else
        if (MStr = 'nov') then M := 11 else
        if (MStr = 'dec') then M := 12 else
        M := 0;
        D := StrToIntDef(Copy(Buffer, 6, 2), 0);
        H := StrToIntDef(Copy(Buffer, 18, 2), MAXWORD);
        N := StrToIntDef(Copy(Buffer, 21, 2), MAXWORD);
        S := StrToIntDef(Copy(Buffer, 24, 2), MAXWORD);

// なぜか世界標準時が返されるので、 Hに +9時間としている。

        if TryEncodeDateTime(Y, M, D, H + 9, N, S, 0, HttpDateTime) then
            begin
            Result := HttpDateTime;
            end
        else
            Result := now;
      end;
    finally
      InternetCloseHandle(IOpenHandle);
    end;
  finally
    InternetCloseHandle(InetHandle);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text:= DateTimeToStr(GetMyServerTime);
end;

end.

ss 2013-08-05 09:00:11 No: 44983

すみません。
環境を書いていませんでした。
WinXp Sp3 Delphi7です。
よろしくお願いします。

monaa 2013-08-05 19:30:12 No: 44984

ぱっと見ですが、
タイムアウト設定してなんじゃないですか？
InternetSetOption INTERNET_OPTION_CONNECT_TIMEOUT

ｓｓ 2013-08-08 08:24:43 No: 44985

monaaさんありがとうございます。
InternetSetOption INTERNET_OPTION_CONNECT_TIMEOUTで解決しました。