Wininet Async mode

ダウンロード(Delphi)2004/12/24

MSDNの解説は不完全でThreadを使用しています。そこでスレッドを使わずに非同期通信を行おうと言うわけです。

昔一度公開していましたがあまりにも適当だったので消していました。ちょっと手直ししたので再公開します。

ちょっと大きいけど張っちゃいます。

unit UHTTPDownload;

interface

uses Classes, SysUtils, Windows, WinInet, Winsock;

//INTERNET_STATUS_CTL_RESPONSE_RECEIVED
//  Not currently implemented.
//INTERNET_STATUS_DETECTING_PROXY
//  定義されていない
//INTERNET_STATUS_PREFETCH
//  Not currently implemented.
type
  TInternetConnectedToServerEvent = procedure(Sender: TObject;
    const Address: PSOCKADDR) of Object;
  TInternetConnectingToServerEvent = procedure(Sender: TObject;
    const Address: PSOCKADDR) of Object;
  TInternetHandleCreatedEvent = procedure(Sender: TObject;
    const AsyncResult: PInternetAsyncResult) of Object;

  //INTERNET_STATUS_INTERMEDIATE_RESPONSE
  TInternetNameResolved = procedure(Sender: TObject;
    const IPAddress: PChar) of Object;
  TInternetRedirect = procedure(Sender: TObject;
    const URL: PChar) of Object;
  TInternetRequestComplete = procedure(Sender: TObject;
    const AsyncResult: PInternetAsyncResult) of Object;
  TInternetRequestSent = procedure(Sender: TObject;
    const Size: DWORD) of Object;
  TInternetResolvingName = procedure(Sender: TObject;
    const Name: PChar) of Object;
  TInternetResponceReceived = procedure(Sender: TObject;
    const Size: DWORD) of Object;

  // 終わった
  TInternetReceived = procedure(Sender: TObject;
    const Stream: TStream) of Object;

  THTTPDownload = class(TObject)
  private
    // コールバック
    _FData: Pointer;
  protected
    FInetHandle, FInetFile: HINTERNET;
    FInetBuffer: INTERNET_BUFFERS;
    FBuffer: Array[0..1023] of Byte;

    FDownloading: Boolean;

    FStream: TMemoryStream;

    FOnClosingConnection: TNotifyEvent;
    FOnConnectedToServer: TInternetConnectedToServerEvent;
    FOnConnectingToServer: TInternetConnectingToServerEvent;
    FOnConnectionClosed: TNotifyEvent;
    FOnHandleClosing: TNotifyEvent;
    FOnHandleCreated: TInternetHandleCreatedEvent;
    FOnIntermediateResponse: TNotifyEvent;
    FOnNameResolved: TInternetNameResolved;
    FOnReceivingResponse: TNotifyEvent;
    FOnRedirect: TInternetRedirect;
    FOnRequestComplete: TInternetRequestComplete;
    FOnRequestSent: TInternetRequestSent;
    FOnResolvingName: TInternetResolvingName;
    FOnResponseReceived: TInternetResponceReceived;
    FOnSendingRequest: TNotifyEvent;
    FOnStateChange: TNotifyEvent;

    // 終わった。
    FOnReceived: TInternetReceived;

    procedure ClosingConnection;
    procedure ConnectedToServer(const Address: PSOCKADDR);
    procedure ConnectingToServer(const Address: PSOCKADDR);
    procedure ConnectionClosed;
    procedure HandleClosing;
    procedure HandleCreated(const AsyncResult: PInternetAsyncResult);
    procedure IntermediateResponse;
    procedure NameResolved(const IPAddress: PChar);
    procedure ReceivingResponse;
    procedure Redirect(const URL: PChar);
    procedure RequestComplete(const AsyncResult: PInternetAsyncResult);
    procedure RequestSent(const Size: DWORD);
    procedure ResolvingName(const Name: PChar);
    procedure ResponseReceived(const Size: DWORD);
    procedure SendingRequest;
    procedure StateChange;

    procedure InetCallback(
      hInet: HINTERNET;
      dwContext: DWORD;
      dwInternetStatus: DWORD;
      lpvStatusInformation: Pointer;
      dwStatusInformationLength: DWORD); virtual;

  public
    constructor Create;
    destructor Destroy; override;

    function GetUrl(const Url: string): Boolean;

    property OnClosingConnection: TNotifyEvent read FOnClosingConnection write FOnClosingConnection;
    property OnConnectedToServer: TInternetConnectedToServerEvent read FOnConnectedToServer write FOnConnectedToServer;
    property OnConnectingToServer: TInternetConnectingToServerEvent read FOnConnectingToServer write FOnConnectingToServer;
    property OnConnectionClosed: TNotifyEvent read FOnConnectionClosed write FOnConnectionClosed;
    property OnHandleClosing: TNotifyEvent read FOnHandleClosing write FOnHandleClosing;
    property OnHandleCreated: TInternetHandleCreatedEvent read FOnHandleCreated write FOnHandleCreated;
    property OnIntermediateResponse: TNotifyEvent read FOnIntermediateResponse write FOnIntermediateResponse;
    property OnNameResolved: TInternetNameResolved read FOnNameResolved write FOnNameResolved;
    property OnReceivingResponse: TNotifyEvent read FOnReceivingResponse write FOnReceivingResponse;
    property OnRedirect: TInternetRedirect read FOnRedirect write FOnRedirect;
    property OnRequestComplete: TInternetRequestComplete read FOnRequestComplete write FOnRequestComplete;
    property OnRequestSent: TInternetRequestSent read FOnRequestSent write FOnRequestSent;
    property OnResolvingName: TInternetResolvingName read FOnResolvingName write FOnResolvingName;
    property OnResponseReceived: TInternetResponceReceived read FOnResponseReceived write FOnResponseReceived;
    property OnSendingRequest: TNotifyEvent read FOnSendingRequest write FOnSendingRequest;
    property OnStateChange: TNotifyEvent read FOnStateChange write FOnStateChange;

    // 終わった
    property OnReceived: TInternetReceived read FOnReceived write FOnReceived;
  end;

implementation

type
  TInetCallbackProc = procedure (
    hInet: HINTERNET;
    dwContext: DWORD;
    dwInternetStatus: DWORD;
    lpvStatusInformation: Pointer;
    dwStatusInformationLength: DWORD) of object;
  PInetCallbackProc = ^TInetCallbackProc;

procedure _InetCallback(
  hInet: HINTERNET;
  dwContext: DWORD;
  dwInternetStatus: DWORD;
  lpvStatusInformation: Pointer;
  dwStatusInformationLength: DWORD); stdcall;
var
  p: PInetCallbackProc;
begin
  p := Pointer(dwContext);
  p^(
    hInet,
    dwContext,
    dwInternetStatus,
    lpvStatusInformation,
    dwStatusInformationLength
  );
end;

constructor THTTPDownload.Create;
begin
  Inherited;
  // コールバック関数
  GetMem(_FData, SizeOf(TInetCallbackProc));
  TInetCallbackProc(_FData^) := InetCallback;
  FStream := TMemoryStream.Create;
  FDownloading := False;

  FOnClosingConnection := nil;
  FOnConnectedToServer := nil;
  FOnConnectingToServer := nil;
  FOnConnectionClosed := nil;
  FOnHandleClosing := nil;
  FOnHandleCreated := nil;
  FOnIntermediateResponse := nil;
  FOnNameResolved := nil;
  FOnReceivingResponse := nil;
  FOnRedirect := nil;
  FOnRequestComplete := nil;
  FOnRequestSent := nil;
  FOnResolvingName := nil;
  FOnResponseReceived := nil;
  FOnSendingRequest := nil;
  FOnStateChange := nil;

  FOnReceived := nil;

  FInetHandle := InternetOpen(
    nil,
    INTERNET_OPEN_TYPE_PRECONFIG,
    nil,
    nil,
    INTERNET_FLAG_ASYNC
  );
  if not Assigned(FInetHandle) then
  begin
    Exit;
  end;
  if Integer(InternetSetStatusCallback(FInetHandle, @_InetCallback)) =
    INTERNET_INVALID_STATUS_CALLBACK then
  begin
    Exit;
  end;
end;

destructor THTTPDownload.Destroy;
begin
  if Assigned(FInetFile) then
    InternetCloseHandle(FInetFile);
  InternetSetStatusCallback(FInetHandle, nil);
  InternetCloseHandle(FInetHandle);
  FStream.Free;
  FreeMem(_FData);
  Inherited;
end;

procedure THTTPDownload.ClosingConnection;
begin
  if Assigned(FOnClosingConnection) then
    FOnClosingConnection(Self);
end;

procedure THTTPDownload.ConnectedToServer(const Address: PSOCKADDR);
begin
  if Assigned(FOnConnectedToServer) then
    FOnConnectedToServer(Self, Address);
end;

procedure THTTPDownload.ConnectingToServer(const Address: PSOCKADDR);
begin
  if Assigned(FOnConnectingToServer) then
    FOnConnectingToServer(Self, Address);
end;

procedure THTTPDownload.ConnectionClosed;
begin
  if Assigned(FOnConnectionClosed) then
    FOnConnectionClosed(Self);
end;

procedure THTTPDownload.HandleClosing;
begin
  if Assigned(FOnHandleClosing) then
    FOnHandleClosing(Self);
end;

procedure THTTPDownload.HandleCreated(const AsyncResult: PInternetAsyncResult);
begin
  if Assigned(FOnHandleCreated) then
    FOnHandleCreated(Self, AsyncResult);

  //というわけでOpenUrlで作られたハンドルを受け取る
  FInetFile := HINTERNET(AsyncResult.dwResult);
end;

procedure THTTPDownload.IntermediateResponse;
begin
  if Assigned(FOnIntermediateResponse) then
    FOnIntermediateResponse(Self);
end;

procedure THTTPDownload.NameResolved(const IPAddress: PChar);
begin
  if Assigned(FOnNameResolved) then
    FOnNameResolved(Self, IPAddress);
end;

procedure THTTPDownload.ReceivingResponse;
begin
  if Assigned(FOnReceivingResponse) then
    FOnReceivingResponse(Self);
end;

procedure THTTPDownload.Redirect(const URL: PChar);
begin
  if Assigned(FOnRedirect) then
    FOnRedirect(Self, URL);
end;

procedure THTTPDownload.RequestComplete(const AsyncResult: PInternetAsyncResult);
begin
  if Assigned(FOnRequestComplete) then
    FOnRequestComplete(Self, AsyncResult);

  // 終わるまで取得
  while True do
  begin
    FInetBuffer.lpvBuffer := @FBuffer;
    FInetBuffer.dwBufferLength := SizeOf(FBuffer);

    if not InternetReadFileEx(FInetFile, @FInetBuffer,
      IRF_ASYNC or IRF_USE_CONTEXT or IRF_NO_WAIT ,0) then
    begin
      if GetLastError = ERROR_IO_PENDING then
        Exit; // 次のRequestCompleteまで待つ
      Exit;   // エラー
    end;

    // 取得したデータの処理。
    if FInetBuffer.dwBufferLength = 0 then
      Break;
    
    FStream.WriteBuffer(PByte(FInetBuffer.lpvBuffer)^, FInetBuffer.dwBufferLength);
    Inc(FInetBuffer.dwBufferTotal, FInetBuffer.dwBufferLength);
  end;
  if Assigned(FOnReceived) then
    FOnReceived(Self, FStream);
  InternetCloseHandle(FInetFile);
  FInetFile := nil;
  FDownloading := False;
end;

procedure THTTPDownload.RequestSent(const Size: DWORD);
begin
  if Assigned(FOnRequestSent) then
    FOnRequestSent(Self, Size);
end;

procedure THTTPDownload.ResolvingName(const Name: PChar);
begin
  if Assigned(FOnResolvingName) then
    FOnResolvingName(Self, Name);
end;

procedure THTTPDownload.ResponseReceived(const Size: DWORD);
begin
  if Assigned(FOnResponseReceived) then
    FOnResponseReceived(Self, Size);
end;

procedure THTTPDownload.SendingRequest;
begin
  if Assigned(FOnSendingRequest) then
    FOnSendingRequest(Self);
end;

procedure THTTPDownload.StateChange;
begin
  if Assigned(FOnStateChange) then
    FOnStateChange(Self);
end;

procedure THTTPDownload.InetCallback(
  hInet: HINTERNET;
  dwContext: DWORD;
  dwInternetStatus: DWORD;
  lpvStatusInformation: Pointer;
  dwStatusInformationLength: DWORD);
begin
  case dwInternetStatus of
    INTERNET_STATUS_CLOSING_CONNECTION:
      ClosingConnection;
    INTERNET_STATUS_CONNECTED_TO_SERVER:
      ConnectedToServer(lpvStatusInformation);
    INTERNET_STATUS_CONNECTING_TO_SERVER:
      ConnectingToServer(lpvStatusInformation);
    INTERNET_STATUS_CONNECTION_CLOSED:
      ConnectionClosed;
    INTERNET_STATUS_HANDLE_CLOSING:
      HandleClosing;
    INTERNET_STATUS_HANDLE_CREATED:
      HandleCreated(PInternetAsyncResult(lpvStatusInformation));
    INTERNET_STATUS_INTERMEDIATE_RESPONSE:
      IntermediateResponse;
    INTERNET_STATUS_NAME_RESOLVED:
      NameResolved(lpvStatusInformation);
    INTERNET_STATUS_RECEIVING_RESPONSE:
      ReceivingResponse;
    INTERNET_STATUS_REDIRECT:
      Redirect(lpvStatusInformation);
    INTERNET_STATUS_REQUEST_COMPLETE:
      RequestComplete(PInternetAsyncResult(lpvStatusInformation));
    INTERNET_STATUS_REQUEST_SENT:
      RequestSent(PDWORD(lpvStatusInformation)^);
    INTERNET_STATUS_RESOLVING_NAME:
      ResolvingName(lpvStatusInformation);
    INTERNET_STATUS_RESPONSE_RECEIVED:
      ResponseReceived(PDWORD(lpvStatusInformation)^);
    INTERNET_STATUS_SENDING_REQUEST:
      SendingRequest;
    INTERNET_STATUS_STATE_CHANGE:
      StateChange;
  end;
end;

function THTTPDownload.GetUrl(const Url: string): Boolean;
begin
  Result := False;
  if FDownloading then
    Exit;
  FDownloading := True;

  FInetBuffer.dwBufferTotal := 0;
  FInetBuffer.dwOffsetLow := 0;
  FInetBuffer.dwOffsetHigh := 0;
  FInetBuffer.dwStructSize := SizeOf(INTERNET_BUFFERS);
  FInetBuffer.Next := nil;

  FInetFile := InternetOpenUrl(
    FInetHandle,
    PChar(Url),
    nil,
    0,
    INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_RELOAD,
    Cardinal(_FData)
  );
  if not Assigned(FInetFile) then
    Exit;
  Result := True;
end;

end.

解説はありませんがあしからず。若干適当だったり、トリッキーな部分があったりしますが気にしないでください。ようはINTERNET_FLAG_ASYNCを指定してInternetOpenを呼び出し、InternetOpenUrlなどでリクエストを発行したらINTERNET_STATUS_HANDLE_CREATEDイベント(コールバックはあらかじめ定義しておき、InternetOpenに渡すこと)で作成されたハンドルを保存し、INTERNET_STATUS_REQUEST_COMPLETEでInternetReadFileExにIRF_ASYNCをつけて呼び出すだけです(InternetReadFileは同期モード専用のようです)。コールバックについてはこのあたりが参考になるかもしれません。とりあえず以上です。


戻る