{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  11615: IdHTTP.pas
{
{   Rev 1.31    22/11/2003 12:04:28 AM  GGrieve
{ Add support for HTTP status code 303
}
{
{   Rev 1.30    10/25/2003 06:51:58 AM  JPMugaas
{ Updated for new API changes and tried to restore some functionality.  
}
{
{   Rev 1.29    2003.10.24 10:43:08 AM  czhower
{ TIdSTream to dos
}
{
{   Rev 1.28    24/10/2003 10:58:40 AM  SGrobety
{ Made authentication work even if no OnAnthenticate envent handler present
}
{
{   Rev 1.27    10/18/2003 1:53:10 PM  BGooijen
{ Added include
}
{
    Rev 1.26    10/17/2003 12:08:48 AM  DSiders
  Added localization comments.
}
{
{   Rev 1.25    2003.10.14 1:27:52 PM  czhower
{ DotNet
}
{
{   Rev 1.24    10/7/2003 11:33:54 PM  GGrieve
{ Get works under DotNet
}
{
{   Rev 1.23    10/7/2003 10:07:04 PM  GGrieve
{ Get HTTP compiling for DotNet
}
{
{   Rev 1.22    10/4/2003 9:15:58 PM  GGrieve
{ fix to compile
}
{
{   Rev 1.21    9/26/2003 01:41:48 PM  JPMugaas
{ Fix for problem wihere "identity" was being added more than once to the
{ accepted encoding contents.
}
{
{   Rev 1.20    9/14/2003 07:54:20 PM  JPMugaas
{ Published the Compressor property.
}
{
{   Rev 1.19    7/30/2003 05:34:22 AM  JPMugaas
{ Fix for bug where decompression was not done if the Content Length was
{ specified.  I found that at http://www.news.com.
{ Added Identity to the content encoding to be consistant with Opera.  Identity
{ is the default Accept-Encoding (RFC 2616).
}
{
    Rev 1.18    7/13/2003 10:57:28 PM  BGooijen
  Fixed GZip and Deflate decoding
}
{
{   Rev 1.17    7/13/2003 11:29:06 AM  JPMugaas
{ Made sure some GZIP decompression stub code is in IdHTTP.
}
{
{   Rev 1.15    10.7.2003 ã. 21:03:02  DBondzhev
{ Fixed NTML proxy authorization
}
{
{   Rev 1.14    6/19/2003 02:36:56 PM  JPMugaas
{ Removed a connected check and it seems to work better that way.
}
{
{   Rev 1.13    6/5/2003 04:53:54 AM  JPMugaas
{ Reworkings and minor changes for new Reply exception framework.
}
{
{   Rev 1.12    4/30/2003 01:47:24 PM  JPMugaas
{ Added TODO concerning a ConnectTimeout.
}
{
    Rev 1.11    4/2/2003 3:18:30 PM  BGooijen
  fixed av when retrieving an url when no iohandler was assigned
}
{
    Rev 1.10    3/26/2003 5:13:40 PM  BGooijen
  TIdSSLIOHandlerSocketBase.URIToCheck is now set
}
{
{   Rev 1.9    3/13/2003 11:05:26 AM  JPMugaas
{ Now should work with 3rd party vendor SSL IOHandlers.
}
{
    Rev 1.8    3/11/2003 10:14:52 PM  BGooijen
  Undid the stripping of the CR
}
{
    Rev 1.7    2/27/2003 2:04:26 PM  BGooijen
  If any call to iohandler.readln returns a CR at the end, it is removed now.
}
{
    Rev 1.6    2/26/2003 11:50:08 AM  BGooijen
  things were messed up in TIdHTTPProtocol.RetrieveHeaders, because the call to
  readln doesn't strip the CR at the end (terminator=LF), therefore the end of
  the header was not found.
}
{
    Rev 1.5    2/26/2003 11:42:46 AM  BGooijen
  changed ReadLn (IOerror 6) to IOHandler.ReadLn
}
{
    Rev 1.4    2/4/2003 6:30:44 PM  BGooijen
  Re-enabled SSL-support
}
{
{   Rev 1.3    1/17/2003 04:14:42 PM  JPMugaas
{ Fixed warnings.
}
{
{   Rev 1.2    12/7/2002 05:32:16 PM  JPMugaas
{ Now compiles with destination removed.
}
{
{   Rev 1.1    12/6/2002 05:29:52 PM  JPMugaas
{ Now decend from TIdTCPClientCustom instead of TIdTCPClient.
}
{
{   Rev 1.0    11/13/2002 07:54:12 AM  JPMugaas
}
unit IdHTTP;
                                                                                       
                                       

{
  Implementation of the HTTP protcol as specified in RFC 2616, 2109, 2965.
  (See NOTE below for details of what is exactly implemented)

  Author: Hadi Hariri (hadi@urusoft.com)
  Copyright: (c) Chad Z. Hower and The Winshoes Working Group.

NOTE:
  Initially only GET and POST will be supported. As time goes on more will
  be added. For other developers, please add the date and what you have done
  below.

Initials: Hadi Hariri - HH

Details of implementation
-------------------------
2001-Nov Nick Panteleeff
 - Authentication and POST parameter extentsions
2001-Sept Doychin Bondzhev
 - New internal design and new Authentication procedures.
 - Bug fixes and new features in few other supporting components
2001-Jul-7 Doychin Bondzhev
 - new property AllowCookie
 - There is no more ExtraHeders property in Request/Response. Raw headers is used for that purpose.
2001-Jul-1 Doychin Bondzhev
 - SSL support is up again - Thanks to Gregor
2001-Jun-17 Doychin Bondzhev
 - New unit IdHTTPHeaderInfo.pas that contains the
   TIdHeaderInfo(TIdEntytiHeaderInfo, TIdRequestHeaderInfo and TIdResponseHeaderInfo)
 - Still in development and not verry well tested
   By default when there is no authorization object associated with HTTP compoenet and there is user name and password
   HTTP component creates and instance of TIdBasicAuthentication class. This behaivor is for both web server and proxy server
   authorizations
2001-Apr-17 Doychin Bondzhev
 - Added OnProxyAuthorization event. This event is called on 407 response from the HTTP Proxy.
 - Added 2 new properties in TIdHeaderInfo
    property AuthenticationScheme: TIdAuthenticationScheme - this property contains information for authentication scheme
      requested by the web server
    property ProxyAuthenticationScheme: TIdAuthenticationScheme - this property contains information for authentication scheme
      requested by the proxy server
 - Now the component authomaticly reconginizes the requested authorization scheme and it supports Basic like before and has been
   extend to support Digest authorization
2001-Mar-31 Doychin Bondzhev
 - If there is no CookieManager it does not support cookies.
2001-Feb-18 Doychin Bondzhev
 - Added OnAuthorization event. This event is called on 401 response from the HTTP server.
     This can be used to ask the user program to supply user name and password in order to acces
     the requested resource
2001-Feb-02 Doychin Bondzhev
 - Added Cookie support and relative paths on redirect
2000-Jul-25 Hadi Hariri
 - Overloaded POst and moved clearing to disconect.
2000-June-22 Hadi Hariri
  - Added Proxy support.
2000-June-10 Hadi Hariri
  - Added Chunk-Encoding support and HTTP version number. Some additional
    improvements.
2000-May-23 J. Peter Mugaas
  -added redirect capability and supporting properties.  Redirect is optional
   and is set with HandleRedirects.  Redirection is limited to RedirectMaximum
   to prevent stack overflow due to recursion and to prevent redirects between
   two places which would cause this to go on to infinity.
2000-May-22 J. Peter Mugaas
  -adjusted code for servers which returned LF instead of EOL
  -Headers are now retreived before an exception is raised.  This
   also facilitates server redirection where the server tells the client to
   get a document from another location.
2000-May-01 Hadi Hariri
  -Converted to Mercury
2000-May-01 Hadi Hariri
  -Added PostFromStream and some clean up
2000-Apr-10 Hadi Hariri
  -Re-done quite a few things and fixed GET bugs and finished POST method.
2000-Jan-13 MTL
  -Moved to the New Palette Scheme
2000-Jan-08 MTL
  -Cleaned up a few compiler hints during 7.038 build
1999-Dec-10 Hadi Hariri
  -Started.
}

interface

{$I Core\IdCompilerDefines.inc}

uses
  Classes,
  IdException, IdAssignedNumbers, IdHeaderList, IdHTTPHeaderInfo, IdReplyRFC,
{$IFNDEF DotNetExclude}
  IdSSL, IdZLibCompressorBase,
{$ENDIF}
  IdTCPClient, IdURI, IdCookie, IdCookieManager, IdAuthentication , IdAuthenticationManager,
  IdMultipartFormData, IdCoreGlobal;

type
  // TO DOCUMENTATION TEAM
  // ------------------------
  // For internal use. No need of documentation
  // hmConnect - Used to connect trought CERN proxy to SSL enabled sites.
  TIdHTTPMethod = (hmHead, hmGet, hmPost, hmOptions, hmTrace, hmPut, hmDelete, hmConnect);
  TIdHTTPWhatsNext = (wnGoToURL, wnJustExit, wnDontKnow, wnReadAndGo, wnAuthRequest);
  TIdHTTPConnectionType = (ctNormal, ctSSL, ctProxy, ctSSLProxy);

  // Protocol options
  TIdHTTPOption = (hoInProcessAuth, hoKeepOrigProtocol, hoForceEncodeParams);
  TIdHTTPOptions = set of TIdHTTPOption;

  // Must be documented
  TIdHTTPProtocolVersion = (pv1_0, pv1_1);

  TIdHTTPOnRedirectEvent = procedure(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod) of object;
  TIdOnSelectAuthorization = procedure(Sender: TObject; var AuthenticationClass: TIdAuthenticationClass; AuthInfo: TIdHeaderList) of object;
  TIdOnAuthorization = procedure(Sender: TObject; Authentication: TIdAuthentication; var Handled: boolean) of object;
  // TIdProxyOnAuthorization = procedure(Sender: TObject; Authentication: TIdAuthentication; var Handled: boolean) of object;

const
  Id_TIdHTTP_ProtocolVersion = pv1_1;
  Id_TIdHTTP_RedirectMax = 15;
  Id_TIdHTTP_HandleRedirects = False;

type
  TIdCustomHTTP = class;

  // TO DOCUMENTATION TEAM
  // ------------------------
  // The following classes are used internally and no need of documentation
  // Only TIdHTTP must be documented
  //
  TIdHTTPResponse = class(TIdResponseHeaderInfo)
  protected
    FHTTP: TIdCustomHTTP;
    FResponseCode: Integer;
    FResponseText: string;
    FKeepAlive: Boolean;
    FContentStream: TStream;
    FResponseVersion: TIdHTTPProtocolVersion;
    //
    function GetKeepAlive: Boolean;
    function GetResponseCode: Integer;
  public
    constructor Create(AParent: TIdCustomHTTP); reintroduce; virtual;
    property KeepAlive: Boolean read GetKeepAlive write FKeepAlive;
    property ResponseText: string read FResponseText write FResponseText;
    property ResponseCode: Integer read GetResponseCode write FResponseCode;
    property ResponseVersion: TIdHTTPProtocolVersion read FResponseVersion write FResponseVersion;
    property ContentStream: TStream read FContentStream write FContentStream;
  end;

  TIdHTTPRequest = class(TIdRequestHeaderInfo)
  protected
    FHTTP: TIdCustomHTTP;
    FURL: string;
    FMethod: TIdHTTPMethod;
    FSourceStream: TStream;
    FUseProxy: TIdHTTPConnectionType;
    FIPVersion: TIdIPVersion;
  public
    constructor Create(AHTTP: TIdCustomHTTP); reintroduce; virtual;
    property URL: string read FURL write FURL;
    property Method: TIdHTTPMethod read FMethod write FMethod;
    property Source: TStream read FSourceStream write FSourceStream;
    property UseProxy: TIdHTTPConnectionType read FUseProxy;
    property IPVersion: TIdIPversion read FIPVersion write FIPVersion;
  end;

  TIdHTTPProtocol = class(TObject)
    FHTTP: TIdCustomHTTP;
    FRequest: TIdHTTPRequest;
    FResponse: TIdHTTPResponse;
  public
    constructor Create(AConnection: TIdCustomHTTP);
    destructor Destroy; override;
    function ProcessResponse: TIdHTTPWhatsNext;
    procedure BuildAndSendRequest(AURI: TIdURI);
    procedure RetrieveHeaders;

    property Request: TIdHTTPRequest read FRequest;
    property Response: TIdHTTPResponse read FResponse;
  end;

  TIdCustomHTTP = class(TIdTCPClientCustom)
  protected
    FCookieManager: TIdCookieManager;
{$IFNDEF DotNetExclude}
    FCompressor : TIdZLibCompressorBase;
{$ENDIF}
    FFreeOnDestroy: Boolean;
    {Retries counter for WWW authorization}
    FAuthRetries: Integer;
    {Retries counter for proxy authorization}
    FAuthProxyRetries: Integer;
    {Max retries for authorization}
    FMaxAuthRetries: Integer;
    FAllowCookies: Boolean;
    FAuthenticationManager: TIdAuthenticationManager;
    FProtocolVersion: TIdHTTPProtocolVersion;

    {this is an internal counter for redirercts}
    FRedirectCount: Integer;
    FRedirectMax: Integer;
    FHandleRedirects: Boolean;
    FOptions: TIdHTTPOptions;
    FURI: TIdURI;
    FHTTPProto: TIdHTTPProtocol;
    FProxyParameters: TIdProxyConnectionInfo;
    //
    FOnRedirect: TIdHTTPOnRedirectEvent;
    FOnSelectAuthorization: TIdOnSelectAuthorization;
    FOnSelectProxyAuthorization: TIdOnSelectAuthorization;
    FOnAuthorization: TIdOnAuthorization;
    FOnProxyAuthorization: TIdOnAuthorization;
    //
{
    procedure SetHost(const Value: string); override;
    procedure SetPort(const Value: integer); override;
}
    procedure SetAuthenticationManager(const Value: TIdAuthenticationManager);
    procedure SetCookieManager(ACookieManager: TIdCookieManager);
    procedure SetAllowCookies(AValue: Boolean);
    function GetResponseCode: Integer;
    function GetResponseText: string;
    function DoOnAuthorization(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse): Boolean; virtual;
    function DoOnProxyAuthorization(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse): Boolean; virtual;
    function DoOnRedirect(var Location: string; var VMethod: TIdHTTPMethod; RedirectCount: integer): boolean; virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ProcessCookies(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
    function SetHostAndPort: TIdHTTPConnectionType;
    procedure SetCookies(AURL: TIdURI; ARequest: TIdHTTPRequest);
    procedure ReadResult(AResponse: TIdHTTPResponse);
    procedure PrepareRequest(ARequest: TIdHTTPRequest);
    procedure ConnectToHost(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
    function GetResponseHeaders: TIdHTTPResponse;
    function GetRequestHeaders: TIdHTTPRequest;
    procedure SetRequestHeaders(const Value: TIdHTTPRequest);

    procedure EncodeRequestParams(const AStrings: TStrings);
    function SetRequestParams(const AStrings: TStrings): string;

    procedure CheckAndConnect(AResponse: TIdHTTPResponse);
    procedure DoOnDisconnected; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoRequest(const AMethod: TIdHTTPMethod; AURL: string;
      const ASource, AResponseContent: TStream); virtual;
    procedure Options(AURL: string); overload;
    procedure Get(AURL: string; const AResponseContent: TStream); overload;
    function Get(AURL: string): string; overload;
    procedure Trace(AURL: string; const AResponseContent: TStream); overload;
    function Trace(AURL: string): string; overload;
    procedure Head(AURL: string);

    function Post(AURL: string; const ASource: TStrings): string; overload;
    function Post(AURL: string; const ASource: TStream): string; overload;
    function Post(AURL: string; const ASource: TIdMultiPartFormDataStream): string; overload;
    procedure Post(AURL: string; const ASource: TIdMultiPartFormDataStream; AResponseContent: TStream);
      overload;
    procedure Post(AURL: string; const ASource: TStrings; const AResponseContent: TStream);
      overload;
    {Post data provided by a stream, this is for submitting data to a server}
    procedure Post(AURL: string; const ASource, AResponseContent: TStream);
      overload;
    //
    function Put(AURL: string; const ASource: TStream): string; overload;
    procedure Put(AURL: string; const ASource, AResponseContent: TStream);
      overload;
{$IFNDEF DotNetExclude}
    {This is an object that can compress and decompress HTTP Deflate encoding}
    property Compressor : TIdZLibCompressorBase
     read FCompressor write FCompressor;
{$ENDIF}
    {This is the response code number such as 404 for File not Found}
    property ResponseCode: Integer read GetResponseCode;
    {This is the text of the message such as "404 File Not Found here Sorry"}
    property ResponseText: string read GetResponseText;
    property Response: TIdHTTPResponse read GetResponseHeaders;
    { This is the last processed URL }
    property URL: TIdURI read FURI;
    // Num retries for Authentication
    property AuthRetries: Integer read FMaxAuthRetries write FMaxAuthRetries default 3;
    property AllowCookies: Boolean read FAllowCookies write SetAllowCookies;
    {Do we handle redirect requests or simply raise an exception and let the
     developer deal with it}
    property HandleRedirects: Boolean read FHandleRedirects write FHandleRedirects default Id_TIdHTTP_HandleRedirects;
    property ProtocolVersion: TIdHTTPProtocolVersion read FProtocolVersion write FProtocolVersion default Id_TIdHTTP_ProtocolVersion;
    {This is the maximum number of redirects we wish to handle, we limit this
     to prevent stack overflow due to recursion.  Recursion is safe ONLY if
     prevented for continuing to infinity}
    property RedirectMaximum: Integer read FRedirectMax write FRedirectMax default Id_TIdHTTP_RedirectMax;
    property ProxyParams: TIdProxyConnectionInfo read FProxyParameters write FProxyParameters;
    property Request: TIdHTTPRequest read GetRequestHeaders write SetRequestHeaders;
    property HTTPOptions: TIdHTTPOptions read FOptions write FOptions;
    // Fired when a rediretion is requested.
    property OnRedirect: TIdHTTPOnRedirectEvent read FOnRedirect write FOnRedirect;
    property OnSelectAuthorization: TIdOnSelectAuthorization read FOnSelectAuthorization write FOnSelectAuthorization;
    property OnSelectProxyAuthorization: TIdOnSelectAuthorization read FOnSelectProxyAuthorization write FOnSelectProxyAuthorization;
    property OnAuthorization: TIdOnAuthorization read FOnAuthorization write FOnAuthorization;
    property OnProxyAuthorization: TIdOnAuthorization read FOnProxyAuthorization write FOnProxyAuthorization;
    // Cookie stuff
    property CookieManager: TIdCookieManager read FCookieManager write SetCookieManager;
    //
    property AuthenticationManager: TIdAuthenticationManager read FAuthenticationManager write SetAuthenticationManager;
  end;

  TIdHTTP = class(TIdCustomHTTP)
  published
    // Num retries for Authentication
    property AuthRetries;
    property AllowCookies;
    {Do we handle redirect requests or simply raise an exception and let the
     developer deal with it}
    property HandleRedirects;
    property ProtocolVersion;
    {This is the maximum number of redirects we wish to handle, we limit this
     to prevent stack overflow due to recursion.  Recursion is safe ONLY if
     prevented for continuing to infinity}
    property RedirectMaximum;
    property ProxyParams;
    property Request;
    property HTTPOptions;
    // Fired when a rediretion is requested.
    property OnRedirect;
    property OnSelectAuthorization;
    property OnSelectProxyAuthorization;
    property OnAuthorization;
    property OnProxyAuthorization;
//    property Host;
//    property Port default IdPORT_HTTP;
    // Cookie stuff
    property CookieManager;
    //
{$IFNDEF DotNetExclude}
    // property AuthenticationManager: TIdAuthenticationManager read FAuthenticationManager write SetAuthenticationManager;
    //ZLib compression library object for use with deflate and gzip encoding
    property Compressor;
{$ENDIF}
  end;

  EIdUnknownProtocol = class(EIdException);
  EIdHTTPProtocolException = class( EIdReplyRFCError )
  protected
    FErrorMessage: string;
  public
    constructor CreateError(const anErrCode: Integer; const asReplyMessage: string;
      const asErrorMessage: string); reintroduce; virtual;
    property ErrorMessage: string read FErrorMessage;
  end;

implementation

uses
  SysUtils,
  IdComponent, IdCoderMIME, IdTCPConnection, IdResourceStrings,
  IdGlobal, IdIOHandler,IdIOHandlerSocket, IdStream;

const
  ProtocolVersionString: array[TIdHTTPProtocolVersion] of string = ('1.0', '1.1'); {do not localize}

{ EIdHTTPProtocolException }

constructor EIdHTTPProtocolException.CreateError(const anErrCode: Integer;
  const asReplyMessage: string; const asErrorMessage: string);
begin
  inherited CreateError(anErrCode, asReplyMessage);
  FErrorMessage := asErrorMessage;
end;

{ TIdHTTP }

constructor TIdCustomHTTP.Create(AOwner: TComponent);
begin
  FURI := TIdURI.Create('');

  inherited Create(AOwner);
//  Port := IdPORT_HTTP;

  FAuthRetries := 0;
  FAuthProxyRetries := 0;
  FMaxAuthRetries := 3;
  AllowCookies := true;
  FFreeOnDestroy := false;
  FOptions := [hoForceEncodeParams];

  FRedirectMax := Id_TIdHTTP_RedirectMax;
  FHandleRedirects := Id_TIdHTTP_HandleRedirects;
  //
  FProtocolVersion := Id_TIdHTTP_ProtocolVersion;

  FHTTPProto := TIdHTTPProtocol.Create(self);
  FProxyParameters := TIdProxyConnectionInfo.Create;
  FProxyParameters.Clear;
end;

destructor TIdCustomHTTP.Destroy;
begin
  FreeAndNil(FHTTPProto);
  FreeAndNil(FURI);
  FreeAndNil(FProxyParameters);

  {if FFreeOnDestroy then
  begin
    FreeAndNil(FCookieManager);
  end;}

  inherited Destroy;
end;

procedure TIdCustomHTTP.Options(AURL: string);
begin
  DoRequest(hmOptions, AURL, nil, nil);
end;

procedure TIdCustomHTTP.Get(AURL: string; const AResponseContent: TStream);
begin
  DoRequest(hmGet, AURL, nil, AResponseContent);
end;

procedure TIdCustomHTTP.Trace(AURL: string; const AResponseContent: TStream);
begin
  DoRequest(hmTrace, AURL, nil, AResponseContent);
end;

procedure TIdCustomHTTP.Head(AURL: string);
begin
  DoRequest(hmHead, AURL, nil, nil);
end;

procedure TIdCustomHTTP.Post(AURL: string; const ASource, AResponseContent: TStream);
var
  OldProtocol: TIdHTTPProtocolVersion;
begin
  // PLEASE READ CAREFULLY

  // Currently when issuing a POST, IdHTTP will automatically set the protocol
  // to version 1.0 independently of the value it had initially. This is because
  // there are some servers that don't respect the RFC to the full extent. In
  // particular, they don't respect sending/not sending the Expect: 100-Continue
  // header. Until we find an optimum solution that does NOT break the RFC, we
  // will restrict POSTS to version 1.0.
  if Connected then
  begin
    Disconnect;
  end;
  OldProtocol := FProtocolVersion;
  // If hoKeepOrigProtocol is SET, is possible to assume that the developer
  // is sure in operations of the server
  if not (hoKeepOrigProtocol in FOptions) then
    FProtocolVersion := pv1_0;
  DoRequest(hmPost, AURL, ASource, AResponseContent);
  FProtocolVersion := OldProtocol;
end;

procedure TIdCustomHTTP.EncodeRequestParams(const AStrings: TStrings);
var
  i: Integer;
  S: string;
begin
  for i := 0 to AStrings.Count - 1 do begin
    S := AStrings.Names[i];
    if Length(AStrings.Values[S]) > 0 then begin
      AStrings.Values[S] := TIdURI.ParamsEncode(AStrings.Values[S]);
    end;
  end;
end;

function TIdCustomHTTP.SetRequestParams(const AStrings: TStrings): string;
var
  S: string;
begin
  if Assigned(AStrings) then begin
    if hoForceEncodeParams in FOptions then
      EncodeRequestParams(AStrings);
    if AStrings.Count > 1 then
      S := StringReplace(AStrings.Text, sLineBreak, '&', [rfReplaceall])
    else
      S := AStrings.Text;
    // break trailing CR&LF
    Result := Trim(S);
  end else
    Result := '';
end;

procedure TIdCustomHTTP.Post(AURL: string; const ASource: TStrings; const AResponseContent: TStream);
var
  LParams: TStringStream;
begin
  // Usual posting request have default ContentType is application/x-www-form-urlencoded
  if (Request.ContentType = '') or (AnsiSameText(Request.ContentType, 'text/html')) then {do not localize}
    Request.ContentType := 'application/x-www-form-urlencoded'; {do not localize}

  LParams := TStringStream.Create(SetRequestParams(ASource));
  try
    Post(AURL, LParams, AResponseContent);
  finally
    FreeAndNil(LParams);
  end;
end;

function TIdCustomHTTP.Post(AURL: string; const ASource: TStrings): string;
var
  LResponse: TStringStream;
begin
  LResponse := TStringStream.Create('');
  try
    Post(AURL, ASource, LResponse);
  finally
    result := LResponse.DataString;
    FreeAndNil(LResponse);
  end;
end;

function TIdCustomHTTP.Post(AURL: string; const ASource: TStream): string;
var
  LResponse: TStringStream;
begin
  LResponse := TStringStream.Create('');
  try
    Post(AURL, ASource, LResponse);
  finally
    result := LResponse.DataString;
    FreeAndNil(LResponse);
  end;
end;

procedure TIdCustomHTTP.Put(AURL: string; const ASource, AResponseContent: TStream);
begin
  DoRequest(hmPut, AURL, ASource, AResponseContent);
end;

function TIdCustomHTTP.Put(AURL: string; const ASource: TStream): string;
var
  LResponse: TStringStream;
begin
  LResponse := TStringStream.Create('');
  try
    Put(AURL, ASource, LResponse);
  finally
    result := LResponse.DataString;
    FreeAndNil(LResponse);
  end;
end;

function TIdCustomHTTP.Get(AURL: string): string;
var
  LStream: TMemoryStream;
begin
  LStream := TMemoryStream.Create;
  try
    Get(AURL, LStream);
    LStream.Position := 0;
    result := ReadStringFromStream(LStream, LStream.Size);
  finally
    FreeAndNil(LStream);
  end;
end;

function TIdCustomHTTP.Trace(AURL: string): string;
var
  Stream: TStringStream;
begin
  Stream := TStringStream.Create('');
  try
    Trace(AURL, Stream);
    result := Stream.DataString;
  finally
    FreeAndNil(Stream)
  end;
end;

function TIdCustomHTTP.DoOnRedirect(var Location: string; var VMethod: TIdHTTPMethod; RedirectCount: integer): boolean;
begin
  result := HandleRedirects;
  if assigned(FOnRedirect) then
  begin
    FOnRedirect(self, Location, RedirectCount, result, VMethod);
  end;
end;

procedure TIdCustomHTTP.SetCookies(AURL: TIdURI; ARequest: TIdHTTPRequest);
var
  S: string;
begin
  if Assigned(FCookieManager) then
  begin
    // Send secure cookies only if we have Secured connection
{$IFNDEF DotNetExclude}
    S := FCookieManager.GenerateCookieList(AURL, (IOHandler is TIdSSLIOHandlerSocketBase));
{$ELSE}
    S := FCookieManager.GenerateCookieList(AURL, False);
{$ENDIF}
    if Length(S) > 0 then
    begin
      ARequest.RawHeaders.Values['Cookie'] := S;  {do not localize}
    end;
  end;
end;

// This function sets the Host and Port and returns a boolean depending on
// whether a PROXY is being used or not.

function TIdCustomHTTP.SetHostAndPort: TIdHTTPConnectionType;
var
  LHost:string;
  LPort:integer;
begin

  FPort := StrToIntDef(URL.Port,80);
  FHost := URL.Host;
  LPort := FPort;
{
Destination:= URL.Host+':'+URL.Port;
Result := ctNormal;
}

  // First check to see if a Proxy has been specified.
  if Length(ProxyParams.ProxyServer) > 0 then
  begin

    if ((not AnsiSameText(LHost, ProxyParams.ProxyServer)) or
      (LPort <> ProxyParams.ProxyPort)) and (Connected) then
    begin
      Disconnect;
    end;

    LHost := ProxyParams.ProxyServer;
    LPort := ProxyParams.ProxyPort;

    if AnsiSameText(URL.Protocol, 'HTTPS') then   {do not localize}
    begin
      Result := ctSSLProxy;

      if Assigned(IOHandler) then
      begin
{$IFNDEF DotNetExclude}
        if not (IOHandler is TIdSSLIOHandlerSocketBase) then
        begin
          raise EIdIOHandlerPropInvalid.Create(RSIOHandlerPropInvalid);
        end else begin
          (IOHandler as TIdSSLIOHandlerSocketBase).PassThrough := true;
        end;
{$ENDIF}
      end;
    end
    else begin
      Result := ctProxy;
{$IFNDEF DotNetExclude}
      if Assigned(IOHandler) and (IOHandler is TIdSSLIOHandlerSocketBase) then
      begin
        (IOHandler as TIdSSLIOHandlerSocketBase).PassThrough := true;
      end;
{$ENDIF}
    end;
  end
  else begin
    Result := ctNormal;

    if IOHandler is TIdIOHandlerSocket then begin
      if Assigned(TIdIOHandlerSocket(IOHandler).Binding) then begin
        if false {disabled until IPv6 stuff is rewritten URL.IPVersion <> TIdIOHandlerSocket(IOHandler).Binding.IPVersion} then begin
          if Connected then begin
            Disconnect; // get rid of current socket handle
          end;
        end;
      end;
    end;

    if ((not AnsiSameText(LHost, URL.Host)) or
       (LPort <> StrToInt(URL.Port))) then begin
      if Connected then begin
        Disconnect;
      end;
      LHost := URL.Host;
      LPort := StrToInt(URL.Port);
    end;

{$IFNDEF DotNetExclude}
    if AnsiSameText(URL.Protocol, 'HTTPS') then   {do not localize}
    begin
      // Just check can we do SSL
      if not Assigned(IOHandler) or (not (IOHandler is TIdSSLIOHandlerSocketBase)) then
        raise EIdIOHandlerPropInvalid.Create(RSIOHandlerPropInvalid)
      else begin
        (IOHandler as TIdSSLIOHandlerSocketBase).PassThrough := false;
        result := ctSSL;
      end;
    end
    else
    begin
      if Assigned(IOHandler) then
      begin
        if (IOHandler is TIdSSLIOHandlerSocketBase) then
        begin
          (IOHandler as TIdSSLIOHandlerSocketBase).PassThrough := true;
        end;
      end;
    end;
{$ENDIF}
  end;
  Host := LHost;
  Port := LPort;
end;

procedure TIdCustomHTTP.ReadResult(AResponse: TIdHTTPResponse);
var
  Size: Integer;
  LS : TIdStream;

  function ChunkSize: integer;
  var
    j: Integer;
    s: string;
  begin
    s := IOHandler.ReadLn;
    j := AnsiPos(' ', s);
    if j > 0 then
    begin
      s := Copy(s, 1, j - 1);
    end;
    Result := StrToIntDef('$' + s, 0);
  end;

begin

  if Assigned(AResponse.ContentStream) then // Only for Get and Post
  begin
    LS := TIdStream.Create(AResponse.ContentStream);
    try
      if AResponse.ContentLength > 0 then // If chunked then this is also 0
      begin
        try
          IOHandler.ReadStream(LS, AResponse.ContentLength);
        except
          on E: EIdConnClosedGracefully do
        end;
      end
      else
      begin
        if AnsiPos('chunked', AResponse.RawHeaders.Values['Transfer-Encoding']) > 0 then {do not localize}
        begin // Chunked
          DoStatus(hsStatusText, [RSHTTPChunkStarted]);
          Size := ChunkSize;
          while Size > 0 do
          begin
            IOHandler.ReadStream(LS, Size);
            IOHandler.ReadLn; // blank line
            Size := ChunkSize;
          end;
          IOHandler.ReadLn; // blank line
        end else begin
          if not AResponse.HasContentLength then
          begin
            IOHandler.ReadStream(LS, -1, True);
          end;
        end;
      end;
{$IFNDEF DotNetExclude}
      if Assigned(Compressor) and (Response.ContentEncoding = 'deflate') then begin {do not localize}
        AResponse.ContentStream.Position := 0;
        Compressor.DecompressDeflateStream(AResponse.ContentStream, 1);
      end else if Assigned(Compressor) and (Response.ContentEncoding = 'gzip') then begin {do not localize}
        AResponse.ContentStream.Position := 0;
        Compressor.DecompressGZipStream(AResponse.ContentStream, 1);
      end;
{$ENDIF}
    finally
      FreeAndNil(LS);
    end;
  end;

end;

procedure TIdCustomHTTP.PrepareRequest(ARequest: TIdHTTPRequest);
var
  LURI: TIdURI;
begin
  LURI := TIdURI.Create(ARequest.URL);

  if Length(LURI.Username) > 0 then
  begin
    ARequest.Username := LURI.Username;
    ARequest.Password := LURI.Password;
  end;

  FURI.Username := ARequest.Username;
  FURI.Password := ARequest.Password;

  FURI.Path := ProcessPath(FURI.Path, LURI.Path);
  FURI.Document := LURI.Document;
  FURI.Params := LURI.Params;

  if Length(LURI.Host) > 0 then begin
    FURI.Host := LURI.Host;
  end;

  if Length(LURI.Protocol) > 0 then begin
    FURI.Protocol := LURI.Protocol;
  end
  // non elegant solution - to be recoded, only for pointing the bug / GREGOR
  else if AnsiSameText(FURI.Protocol, 'https') then begin {do not localize}
    FURI.Protocol := 'https'; {do not localize}
  end
  else begin
    FURI.Protocol := 'http';  {do not localize}
  end;

  if Length(LURI.Port) > 0 then begin
    FURI.Port := LURI.Port;
  end
  else begin
    if AnsiSameText(LURI.Protocol, 'http') then begin     {do not localize}
      FURI.Port := IntToStr(IdPORT_HTTP);
    end else begin
      if AnsiSameText(LURI.Protocol, 'https') then begin  {do not localize}
        FURI.Port := IntToStr(IdPORT_SSL);
      end else begin
        if Length(FURI.Port) > 0 then begin
         {  FURI.Port:=FURI.Port; } // do nothing, as the port is already filled in.
        end else begin
          raise EIdUnknownProtocol.Create('');
        end;
      end;
    end;
  end;

  // The URL part is not URL encoded at this place

  ARequest.URL := URL.Path + URL.Document + URL.Params;

  if ARequest.Method = hmOptions then
  begin
    if AnsiSameText(LURI.Document, '*') then
    begin
      ARequest.URL := LURI.Document;
    end;
  end;

  ARequest.IPVersion := LURI.IPVersion;
  FURI.IPVersion := ARequest.IPVersion;

  FreeAndNil(LURI);  // Free URI Object

  // Check for valid HTTP request methods
  if ARequest.Method in [hmTrace, hmPut, hmOptions, hmDelete] then
  begin
    if ProtocolVersion <> pv1_1 then
    begin
      raise EIdException.Create(RSHTTPMethodRequiresVersion);
    end;
  end;

  if ARequest.Method in [hmPost, hmPut] then
  begin
    ARequest.ContentLength := ARequest.Source.Size;
  end
  else ARequest.ContentLength := -1;

  if FURI.Port <> IntToStr(IdPORT_HTTP) then
    ARequest.Host := FURI.Host + ':' + FURI.Port
  else
    ARequest.Host := FURI.Host;
end;

procedure TIdCustomHTTP.CheckAndConnect(AResponse: TIdHTTPResponse);
begin
  if not AResponse.KeepAlive then begin
    Disconnect;
  end;

  CheckForGracefulDisconnect(false);

  if not Connected then try
    if not Assigned(IOHandler) then begin
      // moved here for ipv6 support in URLs
      IOHandler := TIdIOHandler.MakeDefaultIOHandler(Self);
      IOHandler.OnStatus := OnStatus;
      FFreeIOHandlerOnDisconnect := True;
    end;
    if IOHandler is TIdIOHandlerSocket then begin
//      TIdIOHandlerSocket(IOHandler).IPVersion := FURI.IPVersion;
    end;
    Connect;
  except
    on E: EIdSSLProtocolReplyError do
    begin
      Disconnect;
      raise;
    end;
  end;
end;


procedure TIdCustomHTTP.ConnectToHost(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
var
  LLocalHTTP: TIdHTTPProtocol;
  LS : TIdStream;
begin
  ARequest.FUseProxy := SetHostAndPort;

  if ARequest.UseProxy = ctProxy then
  begin
    ARequest.URL := FURI.URI;
  end;

  case ARequest.UseProxy of
    ctNormal:
      if (ProtocolVersion = pv1_0) and (Length(ARequest.Connection) = 0) then
        ARequest.Connection := 'keep-alive';      {do not localize}
    ctSSL, ctSSLProxy: ARequest.Connection := '';
    ctProxy:
      if (ProtocolVersion = pv1_0) and (Length(ARequest.Connection) = 0) then
      begin
        ARequest.ProxyConnection := 'keep-alive'; {do not localize}
      end;
  end;

{$IFNDEF DotNetExclude}
  if Assigned(FCompressor) then
  begin
    if (IndyPos('deflate',Request.AcceptEncoding)=0) and  {do not localize}
      (IndyPos('gizp',Request.AcceptEncoding)=0) then     {do not localize}
    begin
      Request.AcceptEncoding := 'deflate, gzip, ';        {do not localize}
    end;
  end;
{$ENDIF}
  if IndyPos('identity',Request.AcceptEncoding)=0 then             {do not localize}
  begin
    Request.AcceptEncoding := Request.AcceptEncoding + 'identity'; {do not localize}
  end;
  if ARequest.UseProxy = ctSSLProxy then begin
    LLocalHTTP := TIdHTTPProtocol.Create(Self);

    with LLocalHTTP do begin
      Request.UserAgent := ARequest.UserAgent;
      Request.Host := ARequest.Host;
      Request.ContentLength := ARequest.ContentLength;
      Request.Pragma := 'no-cache';                       {do not localize}
      Request.URL := URL.Host + ':' + URL.Port;
      Request.Method := hmConnect;
      Request.ProxyConnection := 'keep-alive';            {do not localize}

      Response.ContentStream := TMemoryStream.Create;
      try
        try
          repeat
            CheckAndConnect(Response);
            BuildAndSendRequest(nil);

            Response.ResponseText := IOHandler.ReadLn;
            if Length(Response.ResponseText) = 0 then begin
              // Support for HTTP responses without status line and headers
              Response.ResponseText := 'HTTP/1.0 200 OK'; {do not localize}
              Response.Connection := 'close';             {do not localize}
            end
            else begin
              RetrieveHeaders;
              ProcessCookies(LLocalHTTP.Request, LLocalHTTP.Response);
            end;

            if Response.ResponseCode = 200 then
            begin
              // Connection established
{$IFNDEF DotNetExclude}
              (IOHandler as TIdSSLIOHandlerSocketBase).PassThrough := false;
{$ENDIF}
              break;
            end
            else begin
              ProcessResponse;
            end;
          until false;
        except
          raise;
                                                                     
        end;
      finally
        LLocalHTTP.Response.ContentStream.Free;
        FreeAndNil(LLocalHTTP);
      end;
    end;
  end
  else begin
    CheckAndConnect(AResponse);
  end;

  FHTTPProto.BuildAndSendRequest(URL);

  if (ARequest.Method in [hmPost, hmPut]) then
  begin
    LS := TIdStream.Create(ARequest.Source);
    try
      IOHandler.Write(LS, 0, false);
    finally
      FreeAndNil(LS);
    end;
  end;
end;

procedure TIdCustomHTTP.DoRequest(const AMethod: TIdHTTPMethod; AURL: string;
  const ASource, AResponseContent: TStream);
var
  LResponseLocation: Integer;
begin
  if Assigned(AResponseContent) then
  begin
    LResponseLocation := AResponseContent.Position;
  end
  else
    LResponseLocation := 0; // Just to avoid the waringing message

  FAuthRetries := 0;
  FAuthProxyRetries := 0;

  Request.URL := AURL;
  Request.Method := AMethod;
  Request.Source := ASource;
  Response.ContentStream := AResponseContent;

  try
    repeat
      Inc(FRedirectCount);

      PrepareRequest(Request);
{$IFNDEF DotNetExclude}
      if IOHandler is TIdSSLIOHandlerSocketBase then begin
        TIdSSLIOHandlerSocketBase(IOHandler).URIToCheck:= FURI.URI;
      end;
{$ENDIF}
      ConnectToHost(Request, Response);

      // Workaround for servers wich respond with 100 Continue on GET and HEAD
      // This workaround is just for temporary use until we have final HTTP 1.1
      // realisation
      repeat
        Response.ResponseText := IOHandler.ReadLn;
        FHTTPProto.RetrieveHeaders;
        ProcessCookies(Request, Response);
      until Response.ResponseCode <> 100;

      case FHTTPProto.ProcessResponse of
        wnAuthRequest: begin
            Dec(FRedirectCount);
            Request.URL := AURL;
          end;
        wnReadAndGo: begin
            ReadResult(Response);
            if Assigned(AResponseContent) then
            begin
              AResponseContent.Position := LResponseLocation;
              AResponseContent.Size := LResponseLocation;
            end;
            FAuthRetries := 0;
            FAuthProxyRetries := 0;
          end;
        wnGoToURL: begin
            if Assigned(AResponseContent) then
            begin
              AResponseContent.Position := LResponseLocation;
              AResponseContent.Size := LResponseLocation;
            end;
            FAuthRetries := 0;
            FAuthProxyRetries := 0;
          end;
        wnJustExit: begin
            break;
          end;
        wnDontKnow:
          raise EIdException.Create(RSHTTPNotAcceptable);
      end;
    until false;
  finally
    if not Response.KeepAlive then begin
      Disconnect;
    end;
  end;
  FRedirectCount := 0;
end;

procedure TIdCustomHTTP.SetAllowCookies(AValue: Boolean);
begin
  FAllowCookies := AValue;
end;

procedure TIdCustomHTTP.ProcessCookies(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
var
  Cookies, Cookies2: TStringList;
  i: Integer;
begin
  Cookies := nil;
  Cookies2 := nil;
  try
    if not Assigned(FCookieManager) and AllowCookies then
    begin
      CookieManager := TIdCookieManager.Create(Self);
      FFreeOnDestroy := true;
    end;

    if Assigned(FCookieManager) then
    begin
      Cookies := TStringList.Create;
      Cookies2 := TStringList.Create;

      AResponse.RawHeaders.Extract('Set-cookie', Cookies);    {do not localize}
      AResponse.RawHeaders.Extract('Set-cookie2', Cookies2);  {do not localize}

      for i := 0 to Cookies.Count - 1 do
        CookieManager.AddCookie(Cookies[i], FURI.Host);

      for i := 0 to Cookies2.Count - 1 do
        CookieManager.AddCookie2(Cookies2[i], FURI.Host);
    end;
  finally
    FreeAndNil(Cookies);
    FreeAndNil(Cookies2);
  end;
end;

procedure TIdCustomHTTP.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if (AComponent = FCookieManager) then
    begin
      FCookieManager := nil;
    end;
    if AComponent = FAuthenticationManager then
    begin
      FAuthenticationManager := nil;
    end;
{$IFNDEF DotNetExclude}
    if AComponent = FCompressor then begin
      FCompressor := nil;
    end;
{$ENDIF}
  end;
end;

procedure TIdCustomHTTP.SetCookieManager(ACookieManager: TIdCookieManager);
begin
  if Assigned(FCookieManager) then
  begin
    if FFreeOnDestroy then begin
      FreeAndNil(FCookieManager);
    end;
  end;

  FCookieManager := ACookieManager;
  FFreeOnDestroy := false;

  if Assigned(FCookieManager) then
  begin
    FCookieManager.FreeNotification(Self);
  end;
end;

function TIdCustomHTTP.DoOnAuthorization(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse): Boolean;
var
  i: Integer;
  S: string;
  Auth: TIdAuthenticationClass;
begin
  Inc(FAuthRetries);
  if not Assigned(ARequest.Authentication) then
  begin
    // Find wich Authentication method is supported from us.
    for i := 0 to AResponse.WWWAuthenticate.Count - 1 do
    begin
      S := AResponse.WWWAuthenticate[i];
      Auth := FindAuthClass(Fetch(S));
      if Auth <> nil then
        break;
    end;

    if Auth = nil then begin
      result := false;
      exit;
    end;

    if Assigned(FOnSelectAuthorization) then
    begin
      OnSelectAuthorization(self, Auth, AResponse.WWWAuthenticate);
    end;

    ARequest.Authentication := Auth.Create;
  end;

  // Clear password and reset autorization if previous failed
  {if (AResponse.FResponseCode = 401) then begin
    ARequest.Password := '';
    ARequest.Authentication.Reset;
  end;}
  // S.G. 20/10/2003: Added part about the password. Not testing user name as some
  // S.G. 20/10/2003: web sites do not require user name, only password.
  result := Assigned(FOnAuthorization) or (trim(ARequest.Password) <> '');

  if Result then
  begin
    with ARequest.Authentication do
    begin
      Username := ARequest.Username;
      Password := ARequest.Password;
      // S.G. 20/10/2003: ToDo: We need to have a marker here to prevent the code to test with the same username/password combo
      // S.G. 20/10/2003: if they are picked up from properties.
      Params.Values['Authorization'] := ARequest.Authentication.Authentication; {do not localize}
      AuthParams := AResponse.WWWAuthenticate;
    end;

    result := false;

    repeat
      case ARequest.Authentication.Next of
        wnAskTheProgram:
          begin // Ask the user porgram to supply us with authorization information
            if Assigned(FOnAuthorization) then
            begin
              ARequest.Authentication.UserName := ARequest.Username;
              ARequest.Authentication.Password := ARequest.Password;

              OnAuthorization(self, ARequest.Authentication, result);

              if result then begin
                ARequest.BasicAuthentication := true;
                ARequest.Username := ARequest.Authentication.UserName;
                ARequest.Password := ARequest.Authentication.Password;
              end
              else begin
                break;
              end;
            end;
          end;
        wnDoRequest:
          begin
            result := true;
            break;
          end;
        wnFail:
          begin
            result := False;
            Break;
          end;
      end;
    until false;
  end;
end;

function TIdCustomHTTP.DoOnProxyAuthorization(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse): Boolean;
var
  i: Integer;
  S: string;
  Auth: TIdAuthenticationClass;
begin
  Inc(FAuthProxyRetries);
  if not Assigned(ProxyParams.Authentication) then
  begin
    // Find which Authentication method is supported from us.
    i := 0;
    while i < AResponse.ProxyAuthenticate.Count do
    begin
      S := AResponse.ProxyAuthenticate[i];
      try
        Auth := FindAuthClass(Fetch(S));
        break;
      except
      end;
      inc(i);
    end;

    if i = AResponse.ProxyAuthenticate.Count then
    begin
      result := false;
      exit;
    end;

    if Assigned(FOnSelectProxyAuthorization) then
    begin
      OnSelectProxyAuthorization(self, Auth, AResponse.ProxyAuthenticate);
    end;

    ProxyParams.Authentication := Auth.Create;
  end;

  result := Assigned(OnProxyAuthorization);

  // Clear password and reset autorization if previous failed
  if (AResponse.FResponseCode = 407) then begin
    ProxyParams.ProxyPassword := '';
    ProxyParams.Authentication.Reset;
  end;

  if Result then
  begin
    with ProxyParams.Authentication do
    begin
      Username := ProxyParams.ProxyUsername;
      Password := ProxyParams.ProxyPassword;

      AuthParams := AResponse.ProxyAuthenticate;
    end;

    result := false;

    repeat
      case ProxyParams.Authentication.Next of
        wnAskTheProgram: // Ask the user porgram to supply us with authorization information
          begin
            if Assigned(OnProxyAuthorization) then
            begin
              ProxyParams.Authentication.Username := ProxyParams.ProxyUsername;
              ProxyParams.Authentication.Password := ProxyParams.ProxyPassword;

              OnProxyAuthorization(self, ProxyParams.Authentication, result);

              if result then begin
                ProxyParams.ProxyUsername := ProxyParams.Authentication.Username;
                ProxyParams.ProxyPassword := ProxyParams.Authentication.Password;
              end
              else begin
                break;
              end;
            end;
          end;
        wnDoRequest:
          begin
            result := true;
            break;
          end;
        wnFail:
          begin
            result := False;
            Break;
          end;
      end;
    until false;
  end;
end;

function TIdCustomHTTP.GetResponseCode: Integer;
begin
  result := Response.ResponseCode;
end;

function TIdCustomHTTP.GetResponseText: string;
begin
  result := Response.FResponseText;
end;

function TIdCustomHTTP.GetResponseHeaders: TIdHTTPResponse;
begin
  result := FHTTPProto.Response;
end;

function TIdCustomHTTP.GetRequestHeaders: TIdHTTPRequest;
begin
  result := FHTTPProto.Request;
end;

procedure TIdCustomHTTP.DoOnDisconnected;
begin
  inherited DoOnDisconnected;

  if Assigned(Request.Authentication) and
    (Request.Authentication.CurrentStep = Request.Authentication.Steps) then begin
    if Assigned(AuthenticationManager) then begin
      AuthenticationManager.AddAuthentication(Request.Authentication, URL);
    end;
    Request.Authentication.Free;
    Request.Authentication := nil;
  end;

  if Assigned(ProxyParams.Authentication) and
    (ProxyParams.Authentication.CurrentStep = ProxyParams.Authentication.Steps) then begin
    ProxyParams.Authentication.Reset;
  end;
end;

procedure TIdCustomHTTP.SetAuthenticationManager(const Value: TIdAuthenticationManager);
begin
  FAuthenticationManager := Value;
  if Assigned(FAuthenticationManager) then
  begin
    FAuthenticationManager.FreeNotification(self);
  end;
end;
{
procedure TIdCustomHTTP.SetHost(const Value: string);
begin
  inherited SetHost(Value);
  URL.Host := Value;
end;

procedure TIdCustomHTTP.SetPort(const Value: integer);
begin
  inherited SetPort(Value);
  URL.Port := IntToStr(Value);
end;
}
procedure TIdCustomHTTP.SetRequestHEaders(const Value: TIdHTTPRequest);
begin
  FHTTPProto.Request.Assign(Value);
end;

procedure TIdCustomHTTP.Post(AURL: string;
  const ASource: TIdMultiPartFormDataStream; AResponseContent: TStream);
begin
  Request.ContentType := ASource.RequestContentType;
  Post(AURL, TStream(ASource), AResponseContent);
end;

function TIdCustomHTTP.Post(AURL: string;
  const ASource: TIdMultiPartFormDataStream): string;
begin
  Request.ContentType := ASource.RequestContentType;
  result := Post(AURL, TStream(ASource));
end;

{ TIdHTTPResponse }

constructor TIdHTTPResponse.Create(AParent: TIdCustomHTTP);
begin
  inherited Create;

  FHTTP := AParent;
end;

function TIdHTTPResponse.GetKeepAlive: Boolean;
var
  S: string;
  i: TIdHTTPProtocolVersion;
begin
  S := Copy(FResponseText, 6, 3);

  for i := Low(TIdHTtpProtocolVersion) to High(TIdHTtpProtocolVersion) do
    if AnsiSameText(ProtocolVersionString[i], S) then
    begin
      ResponseVersion := i;
      break;
    end;

  if FHTTP.Connected then begin
    FHTTP.IOHandler.CheckForDisconnect(false);
  end;
  FKeepAlive := FHTTP.Connected;

  if FKeepAlive then
    case FHTTP.ProtocolVersion of
      pv1_1:
        { By default we assume that keep-alive is by default and will close
          the connection only there is "close" }
        begin
          FKeepAlive :=
            not (AnsiSameText(Trim(Connection), 'CLOSE') or   {do not localize}
            AnsiSameText(Trim(ProxyConnection), 'CLOSE'));    {do not localize}
        end;
      pv1_0:
        { By default we assume that keep-alive is not by default and will keep
          the connection only if there is "keep-alive" }
        begin
          FKeepAlive := AnsiSameText(Trim(Connection), 'KEEP-ALIVE') or  {do not localize}
            AnsiSameText(Trim(ProxyConnection), 'KEEP-ALIVE')            {do not localize}
            { or ((ResponseVersion = pv1_1) and
              (Length(Trim(Connection)) = 0) and
              (Length(Trim(ProxyConnection)) = 0)) };
        end;
    end;
  result := FKeepAlive;
end;

function TIdHTTPResponse.GetResponseCode: Integer;
var
  S: string;
begin
  S := FResponseText;
  Fetch(S);
  S := Trim(S);
  FResponseCode := StrToIntDef(Fetch(S, ' ', False), -1);
  Result := FResponseCode;
end;

{ TIdHTTPRequest }

constructor TIdHTTPRequest.Create(AHTTP: TIdCustomHTTP);
begin
  inherited Create;

  FHTTP := AHTTP;
  FUseProxy := ctNormal;
end;

{ TIdHTTPProtocol }

constructor TIdHTTPProtocol.Create(AConnection: TIdCustomHTTP);
begin
  inherited Create;
  FHTTP := AConnection;
  // Create the headers
  FRequest := TIdHTTPRequest.Create(FHTTP);
  FResponse := TIdHTTPResponse.Create(FHTTP);
end;

destructor TIdHTTPProtocol.Destroy;
begin
  FreeAndNil(FRequest);
  FreeAndNil(FResponse);

  inherited Destroy;
end;

procedure TIdHTTPProtocol.BuildAndSendRequest(AURI: TIdURI);
var
  i: Integer;
begin
  Request.SetHeaders;
  FHTTP.ProxyParams.SetHeaders(Request.RawHeaders);
  if Assigned(AURI) then
  begin
    FHTTP.SetCookies(AURI, Request);
  end;
  // This is a wrokaround for some HTTP servers wich does not implement properly the HTTP protocol
  FHTTP.IOHandler.WriteBufferOpen;
  case Request.Method of
    hmHead: FHTTP.IOHandler.WriteLn('HEAD ' + Request.URL + ' HTTP/' + ProtocolVersionString[FHTTP.ProtocolVersion]); {do not localize}
    hmGet: FHTTP.IOHandler.WriteLn('GET ' + Request.URL + ' HTTP/' + ProtocolVersionString[FHTTP.ProtocolVersion]);   {do not localize}
    hmPost: FHTTP.IOHandler.WriteLn('POST ' + Request.URL + ' HTTP/' + ProtocolVersionString[FHTTP.ProtocolVersion]); {do not localize}
    // HTTP 1.1 only
    hmOptions: FHTTP.IOHandler.WriteLn('OPTIONS ' + Request.URL + ' HTTP/' + ProtocolVersionString[FHTTP.ProtocolVersion]); {do not localize}
    hmTrace: FHTTP.IOHandler.WriteLn('TRACE ' + Request.URL + ' HTTP/' + ProtocolVersionString[FHTTP.ProtocolVersion]);     {do not localize}
    hmPut: FHTTP.IOHandler.WriteLn('PUT ' + Request.URL + ' HTTP/' + ProtocolVersionString[FHTTP.ProtocolVersion]);         {do not localize}
    hmConnect: FHTTP.IOHandler.WriteLn('CONNECT ' + Request.URL + ' HTTP/' + ProtocolVersionString[FHTTP.ProtocolVersion]); {do not localize}
  end;
  // write the headers
  for i := 0 to Request.RawHeaders.Count - 1 do
    if Length(Request.RawHeaders.Strings[i]) > 0 then
      FHTTP.IOHandler.WriteLn(Request.RawHeaders.Strings[i]);
  FHTTP.IOHandler.WriteLn('');
  FHTTP.IOHandler.WriteBufferClose;
end;

procedure TIdHTTPProtocol.RetrieveHeaders;
var
  S: string;
begin
  // Set the response headers
  // Clear headers
  // Don't use Capture.

  Response.RawHeaders.Clear;
  s := FHTTP.IOHandler.ReadLn;
  try
    while Length(s) > 0 do
    begin
      Response.RawHeaders.Add(S);
      s := FHTTP.IOHandler.ReadLn;
    end;
  except
    on E: EIdConnClosedGracefully do begin
      FHTTP.Disconnect;
    end;
  end;
  Response.ProcessHeaders;
end;

function TIdHTTPProtocol.ProcessResponse: TIdHTTPWhatsNext;
  procedure RaiseException;
  var
    LRespStream: TStringStream;
    LTempStream: TStream;
    LTemp: Integer;
  begin
    LTemp := FHTTP.IOHandler.ReadTimeout;
    FHTTP.IOHandler.ReadTimeout := 2000; // Lets wait 2 seconds for any kind of content
    LRespStream := TStringStream.Create('');
    LTempStream := Response.ContentStream;
    Response.ContentStream := LRespStream;
    try
      FHTTP.ReadResult(Response);
      raise EIdHTTPProtocolException.CreateError(Response.ResponseCode, FHTTP.ResponseText, LRespStream.DataString);
    finally
      Response.ContentStream := LTempStream;
      FreeAndNil(LRespStream);
      FHTTP.IOHandler.ReadTimeout := LTemp;
    end;
  end;

  procedure ReadContent;
  Var
    LTempResponse: TStringStream;
    LTempStream: TStream;
  begin
    LTempResponse := TStringStream.Create('');
    LTempStream := Response.ContentStream;
    Response.ContentStream := LTempResponse;
    try
      FHTTP.ReadResult(Response);
    finally
      FreeAndNil(LTempResponse);
      Response.ContentStream := LTempStream;
    end;
  end;

var
  LTemp: Integer;
  LLocation: string;
  LMethod: TIdHTTPMethod;
  LResponseDigit: Integer;
  LNeedAutorization: Boolean;
begin
  result := wnDontKnow;
  LNeedAutorization := False;
  LResponseDigit := Response.ResponseCode div 100;
  // Handle Redirects
  if ((LResponseDigit = 3) and (Response.ResponseCode <> 304)) or (Length(Response.Location) > 0) then
  begin
    // LLocation := TIdURI.URLDecode(Response.Location);
    LLocation := Response.Location;

    if (FHTTP.FHandleRedirects) and (FHTTP.FRedirectCount < FHTTP.FRedirectMax) then
    begin
      LMethod := Request.Method;
      if FHTTP.DoOnRedirect(LLocation, LMethod, FHTTP.FRedirectCount) then
      begin
        result := wnGoToURL;
        Request.URL := LLocation;
        Request.Method := LMethod;
        {GDG 21/11/2003. If it's a 303, we should do a get this time}
        if Response.ResponseCode = 303 then
        begin
          Request.Source := nil;
          Request.Method := hmGet;
        end;
      end
      else
        RaiseException;
    end
    else // Just fire the event
    begin
      LMethod := Request.Method;
      result := wnJustExit;
      if not FHTTP.DoOnRedirect(LLocation, LMethod, FHTTP.FRedirectCount) then // If not Handled
        RaiseException
      else
        Response.Location := LLocation;
    end;

    if FHTTP.Connected then
    begin
      // This is a workaround for buggy HTTP 1.1 servers which
      // does not return any body with 302 response code
      LTemp := FHTTP.IOHandler.ReadTimeout;
      FHTTP.IOHandler.ReadTimeout := 4000; // Lets wait 4 seconds for any kind of content
      try
        ReadContent;
      except end;
      FHTTP.IOHandler.ReadTimeout := LTemp;
    end;
  end
  else
  begin
    // GREGOR Workaround
    // if we get an error we disconnect if we use SSLIOHandler
    if Assigned(FHTTP.IOHandler) then
    begin
{$IFNDEF DotNetExclude}
      Response.KeepAlive := not (FHTTP.Connected and (FHTTP.IOHandler is TIdSSLIOHandlerSocketBase) and Response.KeepAlive);
{$ELSE}
      Response.KeepAlive := not (FHTTP.Connected and Response.KeepAlive);
{$ENDIF}
    end;

    if LResponseDigit <> 2 then
    begin
   //   result := wnGoToURL;
      case Response.ResponseCode of
        401:
          begin // HTTP Server authorization requered
            if (FHTTP.FAuthRetries >= FHTTP.AuthRetries) or not FHTTP.DoOnAuthorization(Request, Response) then
            begin
              if Assigned(Request.Authentication) then
                Request.Authentication.Reset;
              RaiseException;
            end else begin
              if hoInProcessAuth in FHTTP.HTTPOptions then
                LNeedAutorization := True;
            end;
          end;
        407:
          begin // Proxy Server authorization requered
            if (FHTTP.FAuthProxyRetries >= FHTTP.AuthRetries) or not FHTTP.DoOnProxyAuthorization(Request, Response) then
            begin
              if Assigned(FHTTP.ProxyParams.Authentication) then
                FHTTP.ProxyParams.Authentication.Reset;
              RaiseException;
            end else begin
              if hoInProcessAuth in FHTTP.HTTPOptions then
                LNeedAutorization := True;
            end;
          end;
        else begin
          RaiseException;
        end;
      end;
    end;

 //   if FHTTP.Connected then begin
      if LNeedAutorization then begin
        // Read the content of Error message in temporary stream
        LTemp := FHTTP.IOHandler.ReadTimeout;
        FHTTP.IOHandler.ReadTimeout := 4000; // Lets wait 4 seconds for any kind of content
        try
          ReadContent;
        except end;
        FHTTP.IOHandler.ReadTimeout := LTemp;
        result := wnAuthRequest
      end
      else if (Response.ResponseCode <> 204) then
      begin
        FHTTP.ReadResult(Response);
        result := wnJustExit;
      end
      else
        result := wnJustExit;
    end;
  //end;
end;

end.

