ALHttpClient.pas | searchcode

/ALHttpClient.pas

http://wot-stat-utility.googlecode.com/ · Pascal · 329 lines · 255 code · 36 blank · 38 comment · 3 complexity · 1d17ce986df2660ba4cd019da7a206da MD5 · raw file

unit ALHttpClient;



interface



uses SysUtils, Classes, ALHttpCommon;



type



  {---------------------------------------}

  EALHTTPClientException = class(Exception)

  private

    FStatusCode: Integer;

  public

    constructor Create(const Msg: string; SCode: Integer = 0);

    constructor CreateFmt(const Msg: string; const Args: array of const; SCode: Integer = 0);

    property StatusCode: Integer read FStatusCode write FStatusCode;

  end;



  {-------------------------------------------}

  TALHTTPClientProxyParams = Class(TPersistent)

  Private

    FProxyBypass: String;

    FproxyServer: String;

    FProxyUserName: String;

    FProxyPassword: String;

    FproxyPort: integer;

    FOnChange: TALHTTPPropertyChangeEvent;

    procedure SetProxyBypass(const Value: String);

    procedure SetProxyPassword(const Value: String);

    procedure SetProxyPort(const Value: integer);

    procedure SetProxyServer(const Value: String);

    procedure SetProxyUserName(const Value: String);

    Procedure DoChange(propertyIndex: Integer);

  protected

    procedure AssignTo(Dest: TPersistent); override;

  public

    constructor Create; virtual;

    procedure Clear;

  published

    Property ProxyBypass: String read FProxyBypass write SetProxyBypass; //index 0

    property ProxyServer: String read FProxyServer write SetProxyServer; //index 1

    property ProxyPort: integer read FProxyPort write SetProxyPort default 0; //index 2

    property ProxyUserName: String read FProxyUserName write SetProxyUserName; //index 3

    property ProxyPassword: String read FProxyPassword write SetProxyPassword; //index 4

    property OnChange: TALHTTPPropertyChangeEvent read FOnChange write FOnChange;

  end;



  {----------------------------------------------------------------------------------------------}

  TAlHTTPClientRedirectEvent         = procedure(sender: Tobject; const NewURL: String) of object;

  TALHTTPClientUploadProgressEvent   = procedure(sender: Tobject; Sent: Integer; Total: Integer) of object;

  TALHTTPClientDownloadProgressEvent = procedure(sender: Tobject; Read: Integer; Total: Integer) of object;



  {-------------------------------}

  TALHTTPClient = class(TComponent)

  private

    FProxyParams: TALHTTPClientProxyParams;

    FRequestHeader: TALHTTPRequestHeader;

    FProtocolVersion: TALHTTPProtocolVersion;

    FRequestMethod: TALHTTPRequestMethod;

    FURL: string;

    FUserName: string;

    FPassword: string;

    FConnectTimeout: Integer;

    FSendTimeout: Integer;

    FReceiveTimeout: Integer;

    FOnUploadProgress: TALHTTPClientUploadProgressEvent;

    FOnDownloadProgress: TALHTTPClientDownloadProgressEvent;

    FOnRedirect: TAlHTTPClientRedirectEvent;

    FUploadBufferSize: Integer;

  protected

    procedure SetURL(const Value: string); virtual;

    procedure SetUsername(const NameValue: string); virtual;

    procedure SetPassword(const PasswordValue: string); virtual;

    procedure OnProxyParamsChange(sender: Tobject; Const PropertyIndex: Integer); virtual;

    procedure OnRequestHeaderChange(sender: Tobject; Const PropertyIndex: Integer); virtual;

    procedure SetUploadBufferSize(const Value: Integer); virtual;

  public

    constructor Create(Owner: TComponent); override;

    destructor Destroy; override;

    procedure Execute(const aRequestDataStream: TStream; aResponseContentStream: TStream; aResponseContentHeader: TALHTTPResponseHeader); virtual;

    Procedure Get(aUrl:String; aResponseContentStream: TStream; aResponseContentHeader: TALHTTPResponseHeader); overload;

    Function  Get(aUrl:String): String; overload;

  published

    property  URL: string read FURL write SetURL;

    property  ConnectTimeout: Integer read FConnectTimeout write FConnectTimeout default 0;

    property  SendTimeout: Integer read FSendTimeout write FSendTimeout default 0;

    property  ReceiveTimeout: Integer read FReceiveTimeout write FReceiveTimeout default 0;

    property  UploadBufferSize: Integer read FUploadBufferSize write SetUploadBufferSize default $8000;

    property  ProxyParams: TALHTTPClientProxyParams read FProxyParams;

    property  RequestHeader: TALHTTPRequestHeader read FRequestHeader;

    Property  ProtocolVersion: TALHTTPProtocolVersion read FProtocolVersion write FProtocolVersion default HTTPpv_1_1;

    Property  RequestMethod: TALHTTPRequestMethod read FRequestMethod write fRequestMethod default HTTPrm_get;

    property  UserName: string read FUserName write SetUserName;

    property  Password: string read FPassword write SetPassword;

    property  OnUploadProgress: TALHTTPClientUploadProgressEvent read FOnUploadProgress write FOnUploadProgress;

    property  OnDownloadProgress: TALHTTPClientDownloadProgressEvent read FonDownloadProgress write FonDownloadProgress;

    property  OnRedirect: TAlHTTPClientRedirectEvent read FOnRedirect write FOnRedirect;

  end;



 ResourceString



  CALHTTPCLient_MsgInvalidURL         = 'Invalid url ''%s'' - only supports ''http'' and ''https'' schemes';

  CALHTTPCLient_MsgInvalidHTTPRequest = 'Invalid HTTP Request: Length is 0';

  CALHTTPCLient_MsgEmptyURL           = 'Empty URL';



 implementation



////////////////////////////////////////////////////////////////////////////////

////////// EALHTTPClientException //////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////



{*******************************************************************************}

constructor EALHTTPClientException.Create(const Msg: string; SCode: Integer = 0);

begin

  inherited Create(Msg);

  FStatusCode := SCode;

end;



{**************************************************************************************************************}

constructor EALHTTPClientException.CreateFmt(const Msg: string; const Args: array of const; SCode: Integer = 0);

begin

  inherited CreateFmt(Msg, Args);

  FStatusCode := SCode;

end;



////////////////////////////////////////////////////////////////////////////////

////////// TALWinInetHTTPClient ////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////



{**************************************************}

constructor TALHTTPClient.Create(Owner: TComponent);

begin

  inherited;

  FUploadBufferSize := $8000;

  FConnectTimeout := 0;

  FSendTimeout := 0;

  FReceiveTimeout := 0;

  FURL:= '';

  FUserName := '';

  FPassword := '';

  FOnUploadProgress := nil;

  FOnDownloadProgress := nil;

  FOnRedirect := nil;

  FProxyParams := TALHTTPClientProxyParams.Create;

  FRequestHeader := TALHTTPRequestHeader.Create(self);

  FRequestHeader.UserAgent := 'Mozilla/3.0 (compatible; TALHTTPClient)';

  FProtocolVersion := HTTPpv_1_1;

  FRequestMethod := HTTPrm_get;

  FrequestHeader.OnChange := OnRequestHeaderChange;

  FProxyParams.OnChange := OnProxyParamsChange;

end;



{*******************************}

destructor TALHTTPClient.Destroy;

begin

  FProxyParams.free;

  FRequestHeader.free;

  inherited;

end;



{**************************************************}

procedure TALHTTPClient.SetURL(const Value: string);

begin

  Furl := Value;

end;



{***********************************************************}

procedure TALHTTPClient.SetUsername(const NameValue: string);

begin

  FUserName := NameValue;

end;



{***************************************************************}

procedure TALHTTPClient.SetPassword(const PasswordValue: string);

begin

  FPassword := PasswordValue;

end;



{****************************************************************}

procedure TALHTTPClient.Execute(const aRequestDataStream: TStream;

                                aResponseContentStream: TStream;

                                aResponseContentHeader: TALHTTPResponseHeader);

begin

// virtual;

end;



{***************************************}

procedure TALHTTPClient.Get(aUrl: String;

                            aResponseContentStream: TStream;

                            aResponseContentHeader: TALHTTPResponseHeader);

begin

  Url := aURL;

  RequestMethod := HTTPrm_get;

  Execute(

          nil,

          aResponseContentStream,

          aResponseContentHeader

         );

end;



{***********************************************}

function TALHTTPClient.Get(aUrl: String): String;

var aResponseContentStream: TStringStream;

begin

  aResponseContentStream := TstringStream.Create('');

  try

    Get(

        aUrl,

        aResponseContentStream,

        nil

       );

    result := aResponseContentStream.DataString;

  finally

    aResponseContentStream.Free;

  end;

end;



{*****************************************************************************************}

procedure TALHTTPClient.OnProxyParamsChange(sender: Tobject; Const PropertyIndex: Integer);

begin

 //virtual

end;



{*******************************************************************************************}

procedure TALHTTPClient.OnRequestHeaderChange(sender: Tobject; Const PropertyIndex: Integer);

begin

 //virtual

end;



{****************************************************************}

procedure TALHTTPClient.SetUploadBufferSize(const Value: Integer);

begin

  If Value >= 0 then FUploadBufferSize := Value;

end;



///////////////////////////////////////////////////////////////////////////////////////

////////// TALHTTPClientProxyParams ///////////////////////////////////////////////////

///////////////////////////////////////////////////////////////////////////////////////



{*************************************************************}

procedure TALHTTPClientProxyParams.AssignTo(Dest: TPersistent);

begin

  if Dest is TALHTTPClientProxyParams then begin

    with Dest as TALHTTPClientProxyParams do begin

      FProxyBypass := self.FProxyBypass;

      FproxyServer := self.FproxyServer;

      FProxyUserName := self.FProxyUserName;

      FProxyPassword := self.FProxyPassword;

      FproxyPort := self.FproxyPort;

    end;

  end

  else inherited AssignTo(Dest);

end;



{***************************************}

procedure TALHTTPClientProxyParams.Clear;

begin

  FProxyBypass := '';

  FproxyServer := '';

  FProxyUserName := '';

  FProxyPassword := '';

  FproxyPort := 0;

  DoChange(-1);

end;



{******************************************}

constructor TALHTTPClientProxyParams.Create;

Begin

  inherited create;

  FProxyBypass := '';

  FproxyServer := '';

  FProxyUserName := '';

  FProxyPassword := '';

  FproxyPort := 0;

  FOnchange := nil;

end;



{******************************************************************}

procedure TALHTTPClientProxyParams.DoChange(propertyIndex: Integer);

begin

  if assigned(FonChange) then FonChange(Self,propertyIndex);

end;



{*********************************************************************}

procedure TALHTTPClientProxyParams.SetProxyBypass(const Value: String);

begin

  If (Value <> FProxyBypass) then begin

    FProxyBypass := Value;

    DoChange(0);

  end;

end;



{***********************************************************************}

procedure TALHTTPClientProxyParams.SetProxyPassword(const Value: String);

begin

  If (Value <> FProxyPassword) then begin

    FProxyPassword := Value;

    DoChange(4);

  end;

end;



{********************************************************************}

procedure TALHTTPClientProxyParams.SetProxyPort(const Value: integer);

begin

  If (Value <> FProxyPort) then begin

    FProxyPort := Value;

    DoChange(2);

  end;

end;



{*********************************************************************}

procedure TALHTTPClientProxyParams.SetProxyServer(const Value: String);

begin

  If (Value <> FProxyServer) then begin

    FProxyServer := Value;

    DoChange(1);

  end;

end;



{***********************************************************************}

procedure TALHTTPClientProxyParams.SetProxyUserName(const Value: String);

begin

  If (Value <> FProxyUserName) then begin

    FProxyUserName := Value;

    DoChange(3);

  end;

end;



end.