* First public version

fcl/inc/http.pp

@@ -0,0 +1,637 @@
+{
+    $Id$
+
+    HTTP: Classes for dealing with HTTP requests
+    Copyright (C) 2000 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.
+}
+
+
+{$MODE objfpc}
+{$H+}
+
+unit HTTP;
+
+interface
+
+uses Classes, AsyncIO, SSockets;
+
+const
+
+  fieldAccept = 'Accept';
+  fieldAcceptCharset = 'Accept-Charset';
+  fieldAcceptEncoding = 'Accept-Encoding';
+  fieldAcceptLanguage = 'Accept-Language';
+  fieldAuthorization = 'Authorization';
+  fieldContentEncoding = 'Content-Encoding';
+  fieldContentLanguage = 'Content-Language';
+  fieldContentLength = 'Content-Length';
+  fieldContentType = 'Content-Type';
+  fieldCookie = 'Cookie';
+  fieldDate = 'Date';
+  fieldExpires = 'Expires';
+  fieldFrom = 'From';
+  fieldIfModifiedSince = 'If-Modified-Since';
+  fieldLastModified = 'Last-Modified';
+  fieldLocation = 'Location';
+  fieldPragma = 'Pragma';
+  fieldReferer = 'Referer';
+  fieldRetryAfter = 'Retry-After';
+  fieldServer = 'Server';
+  fieldSetCookie = 'Set-Cookie';
+  fieldUserAgent = 'User-Agent';
+  fieldWWWAuthenticate = 'WWW-Authenticate';
+
+type
+
+  PHttpField = ^THttpField;
+  THttpField = record
+    Name, Value: String;
+  end;
+
+
+  THttpHeader = class
+  protected
+    FReader: TAsyncStreamLineReader;
+    FWriter: TAsyncWriteStream;
+    FOnCompleted: TNotifyEvent;
+    FFields: TList;
+    CmdReceived: Boolean;
+
+    procedure ParseFirstHeaderLine(const line: String); virtual; abstract;
+    procedure LineReceived(const line: String);
+    function  GetFirstHeaderLine: String; virtual; abstract;
+    procedure WriterCompleted(ASender: TObject);
+
+    function  GetFieldCount: Integer;
+    function  GetFields(AIndex: Integer): String;
+    function  GetFieldNames(AIndex: Integer): String;
+    procedure SetFieldNames(AIndex: Integer; const AName: String);
+    function  GetFieldValues(AIndex: Integer): String;
+    procedure SetFieldValues(AIndex: Integer; const AValue: String);
+
+
+    function  GetAccept: String;
+    procedure SetAccept(const AValue: String);
+    function  GetAcceptCharset: String;
+    procedure SetAcceptCharset(const AValue: String);
+    function  GetAcceptEncoding: String;
+    procedure SetAcceptEncoding(const AValue: String);
+    function  GetAcceptLanguage: String;
+    procedure SetAcceptLanguage(const AValue: String);
+    function  GetAuthorization: String;
+    procedure SetAuthorization(const AValue: String);
+    function  GetContentEncoding: String;
+    procedure SetContentEncoding(const AValue: String);
+    function  GetContentLanguage: String;
+    procedure SetContentLanguage(const AValue: String);
+    function  GetContentLength: Integer;
+    procedure SetContentLength(AValue: Integer);
+    function  GetContentType: String;
+    procedure SetContentType(const AValue: String);
+    function  Get_Cookie: String;
+    procedure Set_Cookie(const AValue: String);
+    function  GetDate: String;
+    procedure SetDate(const AValue: String);
+    function  GetExpires: String;
+    procedure SetExpires(const AValue: String);
+    function  GetFrom: String;
+    procedure SetFrom(const AValue: String);
+    function  GetIfModifiedSince: String;
+    procedure SetIfModifiedSince(const AValue: String);
+    function  GetLastModified: String;
+    procedure SetLastModified(const AValue: String);
+    function  GetLocation: String;
+    procedure SetLocation(const AValue: String);
+    function  GetPragma: String;
+    procedure SetPragma(const AValue: String);
+    function  GetReferer: String;
+    procedure SetReferer(const AValue: String);
+    function  GetRetryAfter: String;
+    procedure SetRetryAfter(const AValue: String);
+    function  GetServer: String;
+    procedure SetServer(const AValue: String);
+    function  Get_SetCookie: String;
+    procedure Set_SetCookie(const AValue: String);
+    function  GetUserAgent: String;
+    procedure SetUserAgent(const AValue: String);
+    function  GetWWWAuthenticate: String;
+    procedure SetWWWAuthenticate(const AValue: String);
+
+  public
+    HttpVersion: String;
+
+    constructor Create;
+    destructor Destroy; override;
+    procedure SetFieldByName(const AName, AValue: String);
+    function  GetFieldByName(const AName: String): String;
+
+    procedure AsyncSend(AManager: TAsyncIOManager; AStream: THandleStream);
+    procedure AsyncReceive(AManager: TAsyncIOManager; AStream: THandleStream);
+
+    property Reader: TAsyncStreamLineReader read FReader;
+    property Writer: TAsyncWriteStream read FWriter;
+    property FieldCount: Integer read GetFieldCount;
+    property Fields[AIndex: Integer]: String read GetFields;
+    property FieldNames[AIndex: Integer]: String read GetFieldNames write SetFieldNames;
+    property FieldValues[AIndex: Integer]: String read GetFieldValues write SetFieldValues;
+
+    property OnCompleted: TNotifyEvent read FOnCompleted write FOnCompleted;
+
+    property Accept: String read GetAccept write SetAccept;
+    property AcceptCharset: String read GetAcceptCharset write SetAcceptCharset;
+    property AcceptEncoding: String read GetAcceptEncoding write SetAcceptEncoding;
+    property AcceptLanguage: String read GetAcceptLanguage write SetAcceptLanguage;
+    property Authorization: String read GetAuthorization write SetAuthorization;
+    property ContentEncoding: String read GetContentEncoding write SetContentEncoding;
+    property ContentLanguage: String read GetContentLanguage write SetContentLanguage;
+    property ContentLength: Integer read GetContentLength write SetContentLength;
+    property ContentType: String read GetContentType write SetContentType;
+    property Cookie: String read Get_Cookie write Set_Cookie;
+    property Date: String read GetDate write SetDate;
+    property Expires: String read GetExpires write SetExpires;
+    property From: String read GetFrom write SetFrom;
+    property IfModifiedSince: String read GetIfModifiedSince write SetIfModifiedSince;
+    property LastModified: String read GetLastModified write SetLastModified;
+    property Location: String read GetLocation write SetLocation;
+    property Pragma: String read GetPragma write SetPragma;
+    property Referer: String read GetReferer write SetReferer;
+    property RetryAfter: String read GetRetryAfter write SetRetryAfter;
+    property Server: String read GetServer write SetServer;
+    property SetCookie: String read Get_SetCookie write Set_SetCookie;
+    property UserAgent: String read GetUserAgent write SetUserAgent;
+    property WWWAuthenticate: String read GetWWWAuthenticate write SetWWWAuthenticate;
+  end;
+
+
+  THttpRequestHeader = class(THttpHeader)
+  protected
+    procedure ParseFirstHeaderLine(const line: String); override;
+    function  GetFirstHeaderLine: String; override;
+  public
+    CommandLine: String;
+    Command: String;
+    URI: String;		// Uniform Resource Identifier
+  end;
+
+
+  THttpAnswerHeader = class(THttpHeader)
+  protected
+    procedure ParseFirstHeaderLine(const line: String); override;
+    function  GetFirstHeaderLine: String; override;
+  public
+    Code: Integer;
+    CodeText: String;
+    constructor Create;
+  end;
+
+
+  TCustomHttpConnection = class
+  protected
+    FManager: TAsyncIOManager;
+    FSocket: TInetSocket;
+    SendBuffer: TAsyncWriteStream;
+    FOnHeaderSent, FOnStreamSent, FOnHeaderReceived, FOnStreamReceived: TNotifyEvent;
+    RecvSize: Integer;	// How many bytes are still to be read. -1 if unknown.
+
+    procedure HeaderToSendCompleted(Sender: TObject);
+    procedure StreamToSendCompleted(Sender: TObject);
+    procedure ReceivedHeaderCompleted(Sender: TObject);
+    procedure DataAvailable(Sender: TObject);
+    procedure ReceivedStreamCompleted(Sender: TObject);
+
+    property OnHeaderSent: TNotifyEvent read FOnHeaderSent write FOnHeaderSent;
+    property OnStreamSent: TNotifyEvent read FOnStreamSent write FOnStreamSent;
+    property OnHeaderReceived: TNotifyEvent read FOnHeaderReceived write FOnHeaderReceived;
+    property OnStreamReceived: TNotifyEvent read FOnStreamReceived write FOnStreamReceived;
+
+  public
+    HeaderToSend: THttpHeader;
+    StreamToSend: TStream;
+    ReceivedHeader: THttpHeader;
+    ReceivedStream: TStream;
+
+    constructor Create(AManager: TAsyncIOManager; ASocket: TInetSocket);
+    destructor Destroy; override;
+    procedure Start;
+  end;
+
+  THttpConnection = class(TCustomHttpConnection)
+  public
+    property OnHeaderSent;
+    property OnStreamSent;
+    property OnHeaderReceived;
+    property OnStreamReceived;
+  end;
+
+
+
+// ===================================================================
+// ===================================================================
+
+implementation
+
+uses SysUtils;
+
+
+// -------------------------------------------------------------------
+//   THttpHeader
+// -------------------------------------------------------------------
+
+procedure THttpHeader.LineReceived(const line: String);
+var
+  i: Integer;
+begin
+  if Length(line) = 0 then
+  begin
+    FReader.OnLine := nil;	// Stop receiving
+    if Assigned(FOnCompleted) then
+      FOnCompleted(Self);
+    FReader.Free;
+    FReader := nil;
+  end else
+    if not CmdReceived then
+    begin
+      CmdReceived := True;
+      ParseFirstHeaderLine(line);
+    end else
+    begin
+      i := Pos(':', line);
+      SetFieldByName(Trim(Copy(line, 1, i - 1)), Trim(Copy(line, i + 1, Length(line))));
+    end;
+end;
+
+procedure THttpHeader.WriterCompleted(ASender: TObject);
+begin
+  if Assigned(FOnCompleted) then
+    FOnCompleted(Self);
+end;
+
+function THttpHeader.GetFieldCount: Integer;
+begin
+  Result := FFields.Count;
+end;
+
+function THttpHeader.GetFields(AIndex: Integer): String;
+begin
+  Result := FieldNames[AIndex] + ': ' + FieldValues[AIndex];
+end;
+
+function THttpHeader.GetFieldNames(AIndex: Integer): String;
+begin
+  Result := PHttpField(FFields.Items[AIndex])^.Name;
+end;
+
+procedure THttpHeader.SetFieldNames(AIndex: Integer; const AName: String);
+begin
+  PHttpField(FFields.Items[AIndex])^.Name := AName;
+end;
+
+function THttpHeader.GetFieldValues(AIndex: Integer): String;
+begin
+  Result := PHttpField(FFields.Items[AIndex])^.Value;
+end;
+
+procedure THttpHeader.SetFieldValues(AIndex: Integer; const AValue: String);
+begin
+  PHttpField(FFields.Items[AIndex])^.Name := AValue;
+end;
+
+function  THttpHeader.GetAccept: String; begin Result := GetFieldByName(fieldAccept) end;
+procedure THttpHeader.SetAccept(const AValue: String); begin SetFieldByName(fieldAccept, AValue) end;
+function  THttpHeader.GetAcceptCharset: String; begin Result := GetFieldByName(fieldAcceptCharset) end;
+procedure THttpHeader.SetAcceptCharset(const AValue: String); begin SetFieldByName(fieldAcceptCharset, AValue) end;
+function  THttpHeader.GetAcceptEncoding: String; begin Result := GetFieldByName(fieldAcceptEncoding) end;
+procedure THttpHeader.SetAcceptEncoding(const AValue: String); begin SetFieldByName(fieldAcceptEncoding, AValue) end;
+function  THttpHeader.GetAcceptLanguage: String; begin Result := GetFieldByName(fieldAcceptLanguage) end;
+procedure THttpHeader.SetAcceptLanguage(const AValue: String); begin SetFieldByName(fieldAcceptLanguage, AValue) end;
+function  THttpHeader.GetAuthorization: String; begin Result := GetFieldByName(fieldAuthorization) end;
+procedure THttpHeader.SetAuthorization(const AValue: String); begin SetFieldByName(fieldAuthorization, AValue) end;
+function  THttpHeader.GetContentEncoding: String; begin Result := GetFieldByName(fieldContentEncoding) end;
+procedure THttpHeader.SetContentEncoding(const AValue: String); begin SetFieldByName(fieldContentEncoding, AValue) end;
+function  THttpHeader.GetContentLanguage: String; begin Result := GetFieldByName(fieldContentLanguage) end;
+procedure THttpHeader.SetContentLanguage(const AValue: String); begin SetFieldByName(fieldContentLanguage, AValue) end;
+function  THttpHeader.GetContentLength: Integer; var s: String; begin s := GetFieldByName(fieldContentLength); if Length(s) = 0 then Result := -1 else Result := StrToInt(s) end;
+procedure THttpHeader.SetContentLength(AValue: Integer); begin SetFieldByName(fieldContentLength, IntToStr(AValue)) end;
+function  THttpHeader.GetContentType: String; begin Result := GetFieldByName(fieldContentType) end;
+procedure THttpHeader.SetContentType(const AValue: String); begin SetFieldByName(fieldContentType, AValue) end;
+function  THttpHeader.Get_Cookie: String; begin Result := GetFieldByName(fieldCookie) end;
+procedure THttpHeader.Set_Cookie(const AValue: String); begin SetFieldByName(fieldCookie, AValue) end;
+function  THttpHeader.GetDate: String; begin Result := GetFieldByName(fieldDate) end;
+procedure THttpHeader.SetDate(const AValue: String); begin SetFieldByName(fieldDate, AValue) end;
+function  THttpHeader.GetExpires: String; begin Result := GetFieldByName(fieldExpires) end;
+procedure THttpHeader.SetExpires(const AValue: String); begin SetFieldByName(fieldExpires, AValue) end;
+function  THttpHeader.GetFrom: String; begin Result := GetFieldByName(fieldFrom) end;
+procedure THttpHeader.SetFrom(const AValue: String); begin SetFieldByName(fieldFrom, AValue) end;
+function  THttpHeader.GetIfModifiedSince: String; begin Result := GetFieldByName(fieldIfModifiedSince) end;
+procedure THttpHeader.SetIfModifiedSince(const AValue: String); begin SetFieldByName(fieldIfModifiedSince, AValue) end;
+function  THttpHeader.GetLastModified: String; begin Result := GetFieldByName(fieldLastModified) end;
+procedure THttpHeader.SetLastModified(const AValue: String); begin SetFieldByName(fieldLastModified, AValue) end;
+function  THttpHeader.GetLocation: String; begin Result := GetFieldByName(fieldLocation) end;
+procedure THttpHeader.SetLocation(const AValue: String); begin SetFieldByName(fieldLocation, AValue) end;
+function  THttpHeader.GetPragma: String; begin Result := GetFieldByName(fieldPragma) end;
+procedure THttpHeader.SetPragma(const AValue: String); begin SetFieldByName(fieldPragma, AValue) end;
+function  THttpHeader.GetReferer: String; begin Result := GetFieldByName(fieldReferer) end;
+procedure THttpHeader.SetReferer(const AValue: String); begin SetFieldByName(fieldReferer, AValue) end;
+function  THttpHeader.GetRetryAfter: String; begin Result := GetFieldByName(fieldRetryAfter) end;
+procedure THttpHeader.SetRetryAfter(const AValue: String); begin SetFieldByName(fieldRetryAfter, AValue) end;
+function  THttpHeader.GetServer: String; begin Result := GetFieldByName(fieldServer) end;
+procedure THttpHeader.SetServer(const AValue: String); begin SetFieldByName(fieldServer, AValue) end;
+function  THttpHeader.Get_SetCookie: String; begin Result := GetFieldByName(fieldSetCookie) end;
+procedure THttpHeader.Set_SetCookie(const AValue: String); begin SetFieldByName(fieldSetCookie, AValue) end;
+function  THttpHeader.GetUserAgent: String; begin Result := GetFieldByName(fieldUserAgent) end;
+procedure THttpHeader.SetUserAgent(const AValue: String); begin SetFieldByName(fieldUserAgent, AValue) end;
+function  THttpHeader.GetWWWAuthenticate: String; begin Result := GetFieldByName(fieldWWWAuthenticate) end;
+procedure THttpHeader.SetWWWAuthenticate(const AValue: String); begin SetFieldByName(fieldWWWAuthenticate, AValue) end;
+
+constructor THttpHeader.Create;
+begin
+  inherited Create;
+  FFields := TList.Create;
+  HttpVersion := '1.0';
+end;
+
+destructor THttpHeader.Destroy;
+var
+  i: Integer;
+  field: PHttpField;
+begin
+  FReader.Free;
+  FWriter.Free;
+  for i := 0 to FFields.Count - 1 do begin
+    field := PHttpField(FFields.Items[i]);
+    SetLength(field^.Name, 0);
+    SetLength(field^.Value, 0);
+    Dispose(field);
+  end;
+  FFields.Free;
+  inherited Destroy;
+end;
+
+function THttpHeader.GetFieldByName(const AName: String): String;
+var
+  i: Integer;
+  name: String;
+begin
+  name := UpperCase(AName);
+  for i := 0 to FFields.Count - 1 do
+    if UpperCase(FieldNames[i]) = name then begin
+      Result := FieldValues[i];
+      exit;
+    end;
+  SetLength(Result, 0);
+end;
+
+procedure THttpHeader.SetFieldByName(const AName, AValue: String);
+var
+  i: Integer;
+  name: String;
+  field: PHttpField;
+begin
+  name := UpperCase(AName);
+  for i := 0 to FFields.Count - 1 do
+    if UpperCase(FieldNames[i]) = name then begin
+      FieldNames[i] := AName;	// preserve case
+      FieldValues[i] := AValue;
+      exit;
+    end;
+  New(field);
+  FillChar(field^, SizeOf(field^), 0);
+  field^.Name := AName;
+  field^.Value := AValue;
+  FFields.Add(field);
+end;
+
+procedure THttpHeader.AsyncSend(AManager: TAsyncIOManager; AStream: THandleStream);
+var
+  i: Integer;
+begin
+  FWriter.Free;
+  FWriter := TAsyncWriteStream.Create(AManager, AStream);
+  FWriter.OnBufferEmpty := @WriterCompleted;
+  FWriter.EndOfLineMarker := #13#10;
+  FWriter.WriteLine(GetFirstHeaderLine);
+  for i := 0 to FFields.Count - 1 do
+    FWriter.WriteLine(Fields[i]);
+  FWriter.WriteLine('');
+end;
+
+procedure THttpHeader.AsyncReceive(AManager: TAsyncIOManager; AStream: THandleStream);
+begin
+  CmdReceived := False;
+  FReader.Free;
+  FReader := TAsyncStreamLineReader.Create(AManager, AStream);
+  FReader.OnLine := @LineReceived;
+end;
+
+
+// -------------------------------------------------------------------
+//   THttpRequestHeader
+// -------------------------------------------------------------------
+
+procedure THttpRequestHeader.ParseFirstHeaderLine(const line: String);
+var
+  i: Integer;
+begin
+  CommandLine := line;
+  i := Pos(' ', line);
+  Command := Copy(line, 1, i - 1);
+  URI := Copy(line, i + 1, Length(line));
+  i := Pos(' ', URI);
+  if i > 0 then begin
+    HttpVersion := Copy(URI, i + 1, Length(URI));
+    URI := Copy(URI, 1, i - 1);
+    HttpVersion := Copy(HttpVersion, Pos('/', HttpVersion) + 1, Length(HttpVersion));
+  end;
+end;
+
+function THttpRequestHeader.GetFirstHeaderLine: String;
+begin
+  Result := Command + ' ' + URI;
+  if Length(HttpVersion) > 0 then
+    Result := Result + ' HTTP/' + HttpVersion;
+end;
+
+
+// -------------------------------------------------------------------
+//   THttpAnswerHeader
+// -------------------------------------------------------------------
+
+procedure THttpAnswerHeader.ParseFirstHeaderLine(const line: String);
+var
+  i: Integer;
+  s: String;
+begin
+  i := Pos('/', line);
+  s := Copy(line, i + 1, Length(line));
+  i := Pos(' ', s);
+  HttpVersion := Copy(s, 1, i - 1);
+  s := Copy(s, i + 1, Length(s));
+  i := Pos(' ', s);
+  if i > 0 then begin
+    CodeText := Copy(s, i + 1, Length(s));
+    s := Copy(s, 1, i - 1);
+  end;
+  Code := StrToInt(s);
+end;
+
+function THttpAnswerHeader.GetFirstHeaderLine: String;
+begin
+  Result := Format('HTTP/%s %d %s', [HttpVersion, Code, CodeText]);
+end;
+
+constructor THttpAnswerHeader.Create;
+begin
+  inherited Create;
+  Code := 200;
+  CodeText := 'OK';
+end;
+
+
+// -------------------------------------------------------------------
+//   TCustomHttpConnection
+// -------------------------------------------------------------------
+
+procedure TCustomHttpConnection.HeaderToSendCompleted(Sender: TObject);
+begin
+  //WriteLn('TCustomHttpConnection.HeaderToSendCompleted');
+  if Assigned(FOnHeaderSent) then
+    FOnHeaderSent(Self);
+  if Assigned(StreamToSend) then begin
+    SendBuffer := TAsyncWriteStream.Create(FManager, FSocket);
+    SendBuffer.CopyFrom(StreamToSend, StreamToSend.Size);
+    SendBuffer.OnBufferEmpty := @StreamToSendCompleted;
+    SendBuffer.Run;
+  end else
+    StreamToSendCompleted(nil);
+end;
+
+procedure TCustomHttpConnection.StreamToSendCompleted(Sender: TObject);
+begin
+  if Assigned(FOnStreamSent) then
+    FOnStreamSent(Self);
+  //WriteLn('TCustomHttpConnection.StreamToSendCompleted');
+  SendBuffer.Free;
+  SendBuffer := nil;
+end;
+
+procedure TCustomHttpConnection.ReceivedHeaderCompleted(Sender: TObject);
+var
+  BytesInBuffer: Integer;
+begin
+  //WriteLn('TCustomHttpConnection.ReceivedHeaderCompleted');
+  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
+    begin
+      ReceivedStream.Write(ReceivedHeader.Reader.Buffer^, BytesInBuffer);
+      if RecvSize > 0 then
+        Dec(RecvSize, BytesInBuffer);
+      if BytesInBuffer = ReceivedHeader.ContentLength then
+      begin
+        ReceivedStreamCompleted(nil);
+	exit;
+      end;
+    end;
+    FManager.SetReadHandler(FSocket.Handle, @DataAvailable, nil);
+  end else
+    ReceivedStreamCompleted(nil);
+end;
+
+procedure TCustomHttpConnection.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 := FSocket.Read(buf, ReadNow);
+    //WriteLn('TCustomHttpConnection.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;
+end;
+
+procedure TCustomHttpConnection.ReceivedStreamCompleted(Sender: TObject);
+begin
+  //WriteLn('TCustomHttpConnection.ReceivedStreamCompleted');
+  if Assigned(FOnStreamReceived) then
+    FOnStreamReceived(Self);
+  FManager.ClearReadHandler(FSocket.Handle);
+end;
+
+constructor TCustomHttpConnection.Create(AManager: TAsyncIOManager; ASocket: TInetSocket);
+begin
+  inherited Create;
+  FManager := AManager;
+  FSocket := ASocket;
+end;
+
+destructor TCustomHttpConnection.Destroy;
+begin
+  FManager.ClearReadHandler(FSocket.Handle);
+  inherited Destroy;
+end;
+
+procedure TCustomHttpConnection.Start;
+begin
+  // Start receiver
+  if Assigned(ReceivedHeader) then begin
+    ReceivedHeader.OnCompleted := @ReceivedHeaderCompleted;
+    ReceivedHeader.AsyncReceive(FManager, FSocket);
+  end;
+
+  // Start sender
+  if Assigned(HeaderToSend) then begin
+    // Set the 'Content-Length' field automatically, if possible
+    if (HeaderToSend.ContentLength = -1) and Assigned(StreamToSend) then
+      HeaderToSend.ContentLength := StreamToSend.Size;
+
+    HeaderToSend.OnCompleted := @HeaderToSendCompleted;
+    HeaderToSend.AsyncSend(FManager, FSocket)
+  end;
+end;
+
+
+end.
+
+
+{
+  $Log$
+  Revision 1.1  2000-07-09 11:49:31  sg
+  * First public version
+
+}