freepascal.compiler/fcl/net/httpclient.pp

{
    $Id$

    HTTPClient: HTTP client component
    Copyright (C) 2000-2003 by Sebastian Guenther ([email protected])

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}


unit HTTPClient;

interface

uses Classes, HTTPBase, fpSock, fpAsync;

type

  TCustomHTTPClient = class(TCustomTCPClient)
  protected
    SendBuffer: TAsyncWriteStream;
    FOnPrepareSending: TNotifyEvent;
    FOnHeaderSent: TNotifyEvent;
    FOnStreamSent: TNotifyEvent;
    FOnPrepareReceiving: TNotifyEvent;
    FOnHeaderReceived: TNotifyEvent;
    FOnStreamReceived: TNotifyEvent;
    FOnDestroy: TNotifyEvent;
    RecvSize: Integer;	// How many bytes are still to be read. -1 if unknown.
    DataAvailableNotifyHandle: Pointer;
    ReceivedHTTPVersion: String;

    procedure HeaderToSendCompleted(Sender: TObject);
    procedure StreamToSendCompleted(Sender: TObject);
    procedure ReceivedHeaderCompleted(Sender: TObject);
    procedure ReceivedHeaderEOF(Sender: TObject);
    procedure DataAvailable(Sender: TObject);
    procedure ReceivedStreamCompleted(Sender: TObject);

    property OnPrepareSending: TNotifyEvent read FOnPrepareSending write FOnPrepareSending;
    property OnHeaderSent: TNotifyEvent read FOnHeaderSent write FOnHeaderSent;
    property OnStreamSent: TNotifyEvent read FOnStreamSent write FOnStreamSent;
    property OnPrepareReceiving: TNotifyEvent read FOnPrepareReceiving write FOnPrepareReceiving;
    property OnHeaderReceived: TNotifyEvent read FOnHeaderReceived write FOnHeaderReceived;
    property OnStreamReceived: TNotifyEvent read FOnStreamReceived write FOnStreamReceived;
    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;

  public
    HeaderToSend: THttpHeader;
    StreamToSend: TStream;
    ReceivedHeader: THttpHeader;
    ReceivedStream: TStream;
    DoDestroy: Boolean;

    destructor Destroy; override;
    procedure Receive;
    procedure Send;
  end;

  THttpClient = class(TCustomHttpClient)
  public
    property OnPrepareSending;
    property OnHeaderSent;
    property OnStreamSent;
    property OnPrepareReceiving;
    property OnHeaderReceived;
    property OnStreamReceived;
    property OnDestroy;
  end;

  {TCustomHTTPClient = class
  protected
    FEventLoop: TEventLoop;
    FSocket: TInetSocket;
    SendBuffer: TAsyncWriteStream;
    FOnPrepareSending: TNotifyEvent;
    FOnHeaderSent: TNotifyEvent;
    FOnStreamSent: TNotifyEvent;
    FOnPrepareReceiving: TNotifyEvent;
    FOnHeaderReceived: TNotifyEvent;
    FOnStreamReceived: TNotifyEvent;
    FOnDestroy: TNotifyEvent;
    RecvSize: Integer;	// How many bytes are still to be read. -1 if unknown.
    DataAvailableNotifyHandle: Pointer;
    ReceivedHTTPVersion: String;

    procedure HeaderToSendCompleted(Sender: TObject);
    procedure StreamToSendCompleted(Sender: TObject);
    procedure ReceivedHeaderCompleted(Sender: TObject);
    procedure ReceivedHeaderEOF(Sender: TObject);
    procedure DataAvailable(Sender: TObject);
    procedure ReceivedStreamCompleted(Sender: TObject);

    property OnPrepareSending: TNotifyEvent read FOnPrepareSending write FOnPrepareSending;
    property OnHeaderSent: TNotifyEvent read FOnHeaderSent write FOnHeaderSent;
    property OnStreamSent: TNotifyEvent read FOnStreamSent write FOnStreamSent;
    property OnPrepareReceiving: TNotifyEvent read FOnPrepareReceiving write FOnPrepareReceiving;
    property OnHeaderReceived: TNotifyEvent read FOnHeaderReceived write FOnHeaderReceived;
    property OnStreamReceived: TNotifyEvent read FOnStreamReceived write FOnStreamReceived;
    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;

  public
    HeaderToSend: THttpHeader;
    StreamToSend: TStream;
    ReceivedHeader: THttpHeader;
    ReceivedStream: TStream;
    DoDestroy: Boolean;

    constructor Create(AEventLoop: TEventLoop; ASocket: TInetSocket);
    destructor Destroy; override;
    procedure Receive;
    procedure Send;
  end;}


implementation

uses SysUtils;

procedure TCustomHttpClient.HeaderToSendCompleted(Sender: TObject);
begin
  // WriteLn('TCustomHttpClient.HeaderToSendCompleted');
  if Assigned(FOnHeaderSent) then
    FOnHeaderSent(Self);
  if Assigned(StreamToSend) then
  begin
    SendBuffer := TAsyncWriteStream.Create(EventLoop, Stream);
    SendBuffer.CopyFrom(StreamToSend, StreamToSend.Size);
    SendBuffer.OnBufferSent := @StreamToSendCompleted;
  end else
  begin
    StreamToSendCompleted(nil);
    if DoDestroy then
      Self.Free;
  end;
end;

procedure TCustomHttpClient.StreamToSendCompleted(Sender: TObject);
begin
  // WriteLn('TCustomHttpClient.StreamToSendCompleted');
  if Assigned(FOnStreamSent) then
    FOnStreamSent(Self);
  FreeAndNil(SendBuffer);
  if DoDestroy then
    Self.Free
  else
    Receive;
end;

procedure TCustomHttpClient.ReceivedHeaderCompleted(Sender: TObject);
var
  BytesInBuffer: Integer;
  NeedMoreData: Boolean;
begin
  // WriteLn('TCustomHttpClient.ReceivedHeaderCompleted');
  ReceivedHeader.DataReceived := False;
  ReceivedHTTPVersion := ReceivedHeader.HttpVersion;
  BytesInBuffer := ReceivedHeader.Reader.BytesInBuffer;
  //WriteLn('BytesInBuffer: ', BytesInBuffer, ', Content length: ', ReceivedHeader.ContentLength);
  if Assigned(FOnHeaderReceived) then
    FOnHeaderReceived(Self);

  RecvSize := ReceivedHeader.ContentLength;
  if Assigned(ReceivedStream) then
  begin
    if BytesInBuffer = 0 then
      NeedMoreData := True
    else
    begin
      ReceivedStream.Write(ReceivedHeader.Reader.Buffer^, BytesInBuffer);
      if RecvSize > 0 then
        Dec(RecvSize, BytesInBuffer);
      if BytesInBuffer = ReceivedHeader.ContentLength then
	NeedMoreData := False
      else
        NeedMoreData := (not ReceivedHeader.InheritsFrom(THttpRequestHeader)) or
	  (THttpRequestHeader(ReceivedHeader).Command <> 'GET');
    end;
  end else
    NeedMoreData := False;

  if NeedMoreData then
    DataAvailableNotifyHandle :=
      EventLoop.SetDataAvailableNotify(Stream.Handle, @DataAvailable, Stream)
  else
    ReceivedStreamCompleted(nil);

  if DoDestroy then
    Self.Free;
end;

procedure TCustomHttpClient.ReceivedHeaderEOF(Sender: TObject);
begin
  Self.Free;
end;

procedure TCustomHttpClient.DataAvailable(Sender: TObject);
var
  FirstRun: Boolean;
  ReadNow, BytesRead: Integer;
  buf: array[0..1023] of Byte;
begin
  FirstRun := True;
  while True do
  begin
    if RecvSize >= 0 then
    begin
      ReadNow := RecvSize;
      if ReadNow > 1024 then
        ReadNow := 1024;
    end else
      ReadNow := 1024;
    BytesRead := Stream.Read(buf, ReadNow);
    // WriteLn('TCustomHttpClient.DataAvailable: Read ', BytesRead, ' bytes; RecvSize=', RecvSize);
    if BytesRead <= 0 then
    begin
      if FirstRun then
        ReceivedStreamCompleted(nil);
      break;
    end;
    FirstRun := False;
    ReceivedStream.Write(buf, BytesRead);
    if RecvSize > 0 then
      Dec(RecvSize, BytesRead);
    if RecvSize = 0 then
    begin
      ReceivedStreamCompleted(nil);
      break;
    end;
  end;
  if DoDestroy then
    Self.Free;
end;

procedure TCustomHttpClient.ReceivedStreamCompleted(Sender: TObject);
begin
  // WriteLn('TCustomHttpClient.ReceivedStreamCompleted');
  if Assigned(DataAvailableNotifyHandle) then
  begin
    EventLoop.ClearDataAvailableNotify(DataAvailableNotifyHandle);
    DataAvailableNotifyHandle := nil;
  end;
  if Assigned(FOnStreamReceived) then
    FOnStreamReceived(Self);
  if DoDestroy then
    Self.Free
  else
    Send;
end;

{constructor TCustomHttpClient.Create(AManager: TEventLoop; ASocket: TInetSocket);
begin
  inherited Create;
  EventLoop := AManager;
  Stream := ASocket;
end;}

destructor TCustomHttpClient.Destroy;
begin
  if Assigned(DataAvailableNotifyHandle) then
    EventLoop.ClearDataAvailableNotify(DataAvailableNotifyHandle);
  if Assigned(OnDestroy) then
    OnDestroy(Self);
  FreeAndNil(SendBuffer);
  inherited Destroy;
end;

procedure TCustomHttpClient.Receive;
begin
  // Start receiver
  ReceivedHttpVersion := '';
  if Assigned(OnPrepareReceiving) then
    OnPrepareReceiving(Self);
  if Assigned(ReceivedHeader) then
  begin
    ReceivedHeader.OnCompleted := @ReceivedHeaderCompleted;
    ReceivedHeader.OnEOF := @ReceivedHeaderEOF;
    ReceivedHeader.AsyncReceive(EventLoop, Stream);
  end;
end;

procedure TCustomHttpClient.Send;
begin
  // Start sender
  if Assigned(OnPrepareSending) then
    OnPrepareSending(Self);
  if Assigned(HeaderToSend) then
  begin
    if ReceivedHttpVersion <> '' then
    begin
      HeaderToSend.HttpVersion := ReceivedHttpVersion;
      ReceivedHttpVersion := '';
    end;
    HeaderToSend.OnCompleted := @HeaderToSendCompleted;
    HeaderToSend.AsyncSend(EventLoop, Stream);
  end;
end;


end.


{
  $Log$
  Revision 1.2  2004-02-02 17:12:01  sg
  * Some small fixes to get the code at least compiling again; the HTTP
    client class is not expected to work at the moment, and the XML-RPC
    client has been fully disabled for now.

  Revision 1.1  2004/01/31 19:13:14  sg
  * Splittet old HTTP unit into httpbase and httpclient
  * Many improvements in fpSock (e.g. better disconnection detection)

}