idhttpheaderinfo.pas

Indy控件的使用源代码

{ $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:  10193: IdHTTPHeaderInfo.pas
{
{   Rev 1.2    20/4/2003 3:48:34 PM  SGrobety
{ Fix to previous fix (Dumb me)
}
{
{   Rev 1.0    2002.11.12 10:41:12 PM  czhower
}
{
  HTTP Header definition - RFC 2616

  Copyright: (c) Chad Z. Hower and The Indy Pit Crew.

  Author: Doychin Bondzhev ([e-mail])
}


unit IdHTTPHeaderInfo;

{
REVIEW:   public - Authentication: TIdAuthentication;
  This nees to be a property
}

interface

uses
  Classes, SysUtils, IdAuthentication, IdGlobal, IdHeaderList;

Type
  TIdEntityHeaderInfo = class(TPersistent)
  protected
    FCacheControl: String;
    FRawHeaders: TIdHeaderList;
    FConnection: string;
    FContentEncoding: string;
    FContentLanguage: string;
    FContentLength: Integer;
    FContentRangeEnd: Cardinal;
    FContentRangeStart: Cardinal;
    FContentType: string;
    FContentVersion: string;
    FCustomHeaders: TIdHeaderList;
    FDate: TDateTime;
    FExpires: TDateTime;
    FLastModified: TDateTime;
    FPragma: string;
    FHasContentLength: Boolean;
    //
    procedure AssignTo(Destination: TPersistent); override;
    procedure ProcessHeaders; virtual;
    procedure SetHeaders; virtual;
    procedure SetContentLength(const AValue: Integer);
    procedure SetCustomHeaders(const AValue: TIdHeaderList);
  public
    procedure Clear; virtual;
    constructor Create; virtual;
    destructor Destroy; override;
    //
    property HasContentLength: Boolean read FHasContentLength;
    property RawHeaders: TIdHeaderList read FRawHeaders;
  published
    property CacheControl: String read FCacheControl write FCacheControl;
    property Connection: string read FConnection write FConnection;
    property ContentEncoding: string read FContentEncoding write FContentEncoding;
    property ContentLanguage: string read FContentLanguage write FContentLanguage;
    property ContentLength: Integer read FContentLength write SetContentLength;
    property ContentRangeEnd: Cardinal read FContentRangeEnd write FContentRangeEnd;
    property ContentRangeStart: Cardinal read FContentRangeStart write FContentRangeStart;
    property ContentType: string read FContentType write FContentType;
    property ContentVersion: string read FContentVersion write FContentVersion;
    property CustomHeaders: TIdHeaderList read FCustomHeaders write SetCustomHeaders;
    property Date: TDateTime read FDate write FDate;
    property Expires: TDateTime read FExpires write FExpires;
    property LastModified: TDateTime read FLastModified write FLastModified;
    property Pragma: string read FPragma write FPragma;
  end;

  TIdProxyConnectionInfo = class(TPersistent)
  protected
    FAuthentication: TIdAuthentication;
    FPassword: string;
    FPort: Integer;
    FServer: string;
    FUsername: string;
    FBasicByDefault: Boolean;

    procedure AssignTo(Destination: TPersistent); override;
    procedure SetProxyPort(const Value: Integer);
    procedure SetProxyServer(const Value: string);
  public
    constructor Create;
    procedure Clear;
    destructor Destroy; override;
    procedure SetHeaders(Headers: TIdHeaderList);
    //
    property Authentication: TIdAuthentication read FAuthentication write FAuthentication;
  published

    property BasicAuthentication: boolean read FBasicByDefault write FBasicByDefault;
    property ProxyPassword: string read FPassword write FPassword;
    property ProxyPort: Integer read FPort write SetProxyPort;
    property ProxyServer: string read FServer write SetProxyServer;
    property ProxyUsername: string read FUsername write FUserName;
  end;

  TIdRequestHeaderInfo = class(TIdEntityHeaderInfo)
  protected
    FAccept: string;
    FAcceptCharSet: string;
    FAcceptEncoding: string;
    FAcceptLanguage: string;
    FExpect: string;
    FFrom: string;
    FPassword: string;
    FReferer: string;
    FUserAgent: string;
    FUserName: string;
    FHost: string;
    FBasicByDefault: Boolean;
    FProxyConnection: string;
    //
    procedure AssignTo(Destination: TPersistent); override;
  public
    Authentication: TIdAuthentication;
    //
    procedure Clear; override;
    procedure ProcessHeaders; override;
    procedure SetHeaders; override;
  published
    property Accept: string read FAccept write FAccept;
    property AcceptCharSet: string read FAcceptCharSet write FAcceptCharSet;
    property AcceptEncoding: string read FAcceptEncoding write FAcceptEncoding;
    property AcceptLanguage: string read FAcceptLanguage write FAcceptLanguage;
    property BasicAuthentication: boolean read FBasicByDefault write FBasicByDefault;
    property Host: string read FHost write FHost;
    property From: string read FFrom write FFrom;
    property Password: String read FPassword write FPassword;
    property Referer: string read FReferer write FReferer;
    property UserAgent: string read FUserAgent write FUserAgent;
    property Username: String read FUsername write FUsername;
    property ProxyConnection: string read FProxyConnection write FProxyConnection;
  end;

  TIdResponseHeaderInfo = class(TIdEntityHeaderInfo)
  protected
    FLocation: string;
    FServer: string;
    FProxyConnection: string;
    FProxyAuthenticate: TIdHeaderList;
    FWWWAuthenticate: TIdHeaderList;
    //
    procedure SetProxyAuthenticate(const Value: TIdHeaderList);
    procedure SetWWWAuthenticate(const Value: TIdHeaderList);
  public
    procedure Clear; override;
    constructor Create; override;
    destructor Destroy; override;
    procedure ProcessHeaders; override;
  published
    property Location: string read FLocation write FLocation;
    property ProxyConnection: string read FProxyConnection write FProxyConnection;
    property ProxyAuthenticate: TIdHeaderList read FProxyAuthenticate write SetProxyAuthenticate;
    property Server: string read FServer write FServer;
    property WWWAuthenticate: TIdHeaderList read FWWWAuthenticate write SetWWWAuthenticate;
  end;

implementation

const
  DefaultUserAgent = 'Mozilla/3.0 (compatible; Indy Library)'; {do not localize}

{ TIdGeneralHeaderInfo }

constructor TIdEntityHeaderInfo.Create;
begin
  inherited Create;

  FRawHeaders := TIdHeaderList.Create;
  FRawHeaders.FoldLength := 1024;

  FCustomHeaders := TIdHeaderList.Create;

  Clear;
end;

destructor TIdEntityHeaderInfo.Destroy;
begin
  FreeAndNil(FRawHeaders);
  FreeAndNil(FCustomHeaders);
  inherited Destroy;
end;

procedure TIdEntityHeaderInfo.AssignTo(Destination: TPersistent);
begin
  if Destination is TIdEntityHeaderInfo then
  begin
    with Destination as TIdEntityHeaderInfo do
    begin
      FRawHeaders.Assign(Self.FRawHeaders);
      FContentEncoding := Self.FContentEncoding;
      FContentLanguage := Self.FContentLanguage;
      FContentLength := Self.FContentLength;
      FContentRangeEnd:= Self.FContentRangeEnd;
      FContentRangeStart:= Self.FContentRangeStart;
      FContentType := Self.FContentType;
      FContentVersion := Self.FContentVersion;
      FDate := Self.FDate;
      FExpires := Self.FExpires;
      FLastModified := Self.FLastModified;
    end;
  end
  else
    inherited AssignTo(Destination);
end;

procedure TIdEntityHeaderInfo.Clear;
begin
  FConnection := '';
  FContentVersion := '';
  FContentEncoding := '';
  FContentLanguage := '';
  // S.G. 20/4/2003: Was FContentType := 'Text/HTML'
  // S.G. 20/4/2003: Shouldn't be set here but in response.
  // S.G. 20/4/2003: Requests, by default, have NO content-type. This caused problems
  // S.G. 20/4/2003: with some netscape servers
  FContentType := '';
  FContentLength := -1;
  FContentRangeStart := 0;
  FContentRangeEnd := 0;
  FDate := 0;
  FLastModified := 0;
  FExpires := 0;
  FRawHeaders.Clear;
end;

procedure TIdEntityHeaderInfo.ProcessHeaders;
Var
  LSecs, LMinutes, LHours: Integer;
begin
  // Set and Delete so that later we copy remaining to optional headers
  with FRawHeaders do
  begin
    FConnection := Values['Connection']; {do not localize}
    FContentVersion := Values['Content-Version']; {do not localize}
    FContentEncoding := Values['Content-Encoding']; {do not localize}
    FContentLanguage := Values['Content-Language']; {do not localize}
    FContentType := Values['Content-Type']; {do not localize}
    FContentLength := StrToIntDef(Trim(Values['Content-Length']), -1); {do not localize}
    FHasContentLength := FContentLength >= 0;

    FDate := idGlobal.GMTToLocalDateTime(Values['Date']); {do not localize}
    FLastModified := GMTToLocalDateTime(Values['Last-Modified']); {do not localize}
    if StrToIntDef(Values['Expires'], -1) <> -1 then begin
      // This is happening when expires is returned as integer number in seconds
      LSecs := StrToInt(Values['Expires']);
      LHours := LSecs div 3600;
      LMinutes := (LSecs mod 3600) div 60;
      LSecs := (LSecs mod 3600) mod 60;
      FExpires := Now + EncodeTime(LHours, LMinutes, LSecs, 0);
    end
    else begin
      FExpires := GMTToLocalDateTime(Values['Expires']); {do not localize}
    end;
    FPragma := Values['Pragma'];  {do not localize}
  end;
end;

procedure TIdEntityHeaderInfo.SetHeaders;
begin
  RawHeaders.Clear;
  with RawHeaders do
  begin
    if Length(FConnection) > 0 then
    begin
      Values['Connection'] := FConnection; {do not localize}
    end;
    if Length(FContentVersion) > 0 then
    begin
      Values['Content-Version'] := FContentVersion; {do not localize}
    end;
    if Length(FContentEncoding) > 0 then
    begin
      Values['Content-Encoding'] := FContentEncoding; {do not localize}
    end;
    if Length(FContentLanguage) > 0 then
    begin
      Values['Content-Language'] := FContentLanguage; {do not localize}
    end;
    if Length(FContentType) > 0 then
    begin
      Values['Content-Type'] := FContentType; {do not localize}
    end;
    if FContentLength >= 0 then
    begin
      Values['Content-Length'] := IntToStr(FContentLength); {do not localize}
    end;
    if Length(FCacheControl) > 0 then
    begin
      Values['Cache-control'] := FCacheControl; {do not localize}
    end;
    if FDate > 0 then
    begin
      Values['Date'] := DateTimeToInternetStr(FDate); {do not localize}
    end;
    if FExpires > 0 then
    begin
      Values['Expires'] := DateTimeToInternetStr(FExpires); {do not localize}
    end;

    if (FLastModified > 0) then
    begin
      Values['Last-Modified'] := DateTimeGMTToHttpStr(FLastModified); { do not localize}
    end;

    if Length(FPragma) > 0 then
    begin
      Values['Pragma'] := FPragma; {do not localize}
    end;

    if FCustomHeaders.Count > 0 then
    begin
      // Append Custom headers
      Text := Text + FCustomHeaders.Text;
    end;
  end;