Delphi http传输备忘

unit uProxySetting;

interface

uses
  Classes, SysUtils;

type

  TProxySetting = class
  private
    FIsApplyProxySettingsToIE: Boolean;
    FIsEnableProxy: Boolean;
    FProxyType: Byte;
    FProxyHost: String;
    FProxyDomain: String;
    FProxyPassword: String;
    FProxyPort: Word;
    FProxyUser: String;
    procedure SetIsEnableProxy(const Value: Boolean);
    procedure SetIsApplyProxySettingsToIE(const Value: Boolean);
    procedure SetProxyDomain(const Value: String);
    procedure SetProxyHost(const Value: String);
    procedure SetProxyPassword(const Value: String);
    procedure SetProxyPort(const Value: Word);
    procedure SetProxyType(const Value: Byte);
    function getProxyUserName: String;
    function GetProxyPassword : String;
    procedure SetProxyUser(const Value: String);
  public
    function ToXML : String;
    procedure Init ( ANode : string ) ;
    function Clone : TProxySetting;
  published
    //是否使用代理，对应于<proxySettings>节点中的"proxyEnable"属性。
    property IsEnableProxy : Boolean read FIsEnableProxy write SetIsEnableProxy;
    //是否将此代理设置使用到IE中，对应于<proxySettings>节点中的"applyToIE"属性。
    property IsApplyProxySettingsToIE : Boolean read FIsApplyProxySettingsToIE write SetIsApplyProxySettingsToIE;
    //代理类型，对应于<proxySettings>节点中的"proxyType"属性。
    //代理服务器类型；0:HTTP; 1:SOCKS4;
    property ProxyType : Byte  read FProxyType write SetProxyType;
    //代理服务器地址，对应于<proxySettings>节点中的"proxyHost"属性。
    property ProxyHost : String  read FProxyHost write SetProxyHost;
    //代理服务器端口，对应于<proxySettings>节点中的"proxyPort"属性。
    property ProxyPort : Word  read FProxyPort write SetProxyPort;
    //代理服务器域，对应于<proxySettings>节点中的"domainName"属性。
    property ProxyDomain : String read FProxyDomain write SetProxyDomain;
    //代理服务器域用户ID，对应于<proxySettings>节点中的"proxyUserName"属性。
    property ProxyUser : String read FProxyUser write SetProxyUser;
    //代理服务器域用户密码，对应于<proxySettings>节点中的"proxyPasswordEncrypt"属性。
    //为了支持老版的文件，当proxyPasswordEncrypt为空时，将去找 "proxyPassword",
    //将老的值加密保存
    property ProxyPassword : String read GetProxyPassword write SetProxyPassword;
    //代理服务器完整的用户名 ProxyDomain\ProxyUser
    property ProxyUserName : String read getProxyUserName;
  end;

implementation

{ TProxySetting }

procedure TProxySetting.Init(ANode: string);
begin
  { TODO : xml to setting }
end;

function TProxySetting.getProxyUserName: String;
begin
  if SameText(trim(FProxyDomain),'') then
    Result := FProxyUser
  else
    Result := FProxyDomain + '\' + FProxyUser;
end;

procedure TProxySetting.SetIsEnableProxy(const Value: Boolean);
begin
  FIsEnableProxy := Value;
end;

procedure TProxySetting.SetIsApplyProxySettingsToIE(const Value: Boolean);
begin
  FIsApplyProxySettingsToIE := Value;
end;

procedure TProxySetting.SetProxyDomain(const Value: String);
begin
  FProxyDomain := Value;
end;

procedure TProxySetting.SetProxyHost(const Value: String);
begin
  FProxyHost := Value;
end;

procedure TProxySetting.SetProxyPassword(const Value: String);
begin
  FProxyPassword := Value; //加密
end;

procedure TProxySetting.SetProxyPort(const Value: Word);
begin
  FProxyPort := Value;
end;

procedure TProxySetting.SetProxyType(const Value: Byte);
begin
  FProxyType := Value;
end;

procedure TProxySetting.SetProxyUser(const Value: String);
begin
  FProxyUser := Value;
end;

function TProxySetting.ToXML: String;
var
  LContents : TStringList;
begin
  LContents := TStringList.Create;
  try
    LContents.Append('<proxySettings ');
    LContents.Append('proxyEnable="' + BoolToStr(FIsEnableProxy, True) + '"' );
    LContents.Append('applyToIE="' + BoolToStr(FIsApplyProxySettingsToIE, True) + '"' );
    LContents.Append('proxyType="' + IntToStr(FProxyType) + '"');
    LContents.Append('proxyHost="' + FProxyHost + '"');
    LContents.Append('proxyPort="' + IntToStr(FProxyPort) + '"');
    LContents.Append('domainName="' + FProxyDomain + '"' );
    LContents.Append('proxyUserName="' + FProxyUser + '"' );
    LContents.Append('proxyPasswordEncrypt="' + FProxyPassword + '"' );
    LContents.Append('/>');
    Result := LContents.Text;
  finally
    LContents.Free;
  end;
end;

function TProxySetting.GetProxyPassword: String;
begin
  Result := FProxyPassword;  //Decrypt
end;

function TProxySetting.Clone: TProxySetting;
begin
  Result := TProxySetting.Create;
  Result.FIsApplyProxySettingsToIE := FIsApplyProxySettingsToIE;
  Result.FIsEnableProxy := FIsEnableProxy;
  Result.FProxyType := FProxyType;
  Result.FProxyHost := FProxyHost;
  Result.FProxyDomain := FProxyDomain;
  Result.FProxyPassword := FProxyPassword;
  Result.FProxyPort := FProxyPort;
  Result.FProxyUser := FProxyUser;
end;

end.
uHttpLoader
unit uHttpLoader;

interface

uses
  IdHTTP, IdComponent,IdAuthentication,IdHeaderList,IdSocks, IdIOHandlerSocket,
  IdAuthenticationDigest,IdAuthenticationSSPI,
  //IdException,DateUtils, Forms,
  uProxySetting,
  Classes,SysUtils;
type

  THttpLoader = class
  private
    FHttp: TIdhttp;
    FStop: Boolean;
    FOnWorkBegin: TWorkBeginEvent;
    FOnWorkEnd: TWorkEndEvent;
    FOnWork: TWorkEvent;
    FProxySetting: TProxySetting;
    procedure SetStop(const Value: Boolean);
    procedure DoWorkBeginEvent(Sender: TObject; AWorkMode: TWorkMode;
     const AWorkCountMax: Integer);
    procedure DoWorkEndEvent(Sender: TObject; AWorkMode: TWorkMode);
    procedure DoWorkEvent(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
    procedure IdHTTPSelectProxyAuthorization(Sender: TObject;
      var AuthenticationClass: TIdAuthenticationClass;
      AuthInfo: TIdHeaderList);
    procedure IdHTTPProxyAuthorization(Sender: TObject;
      Authentication: TIdAuthentication; var Handled: Boolean);
    procedure SetProxySetting(const Value: TProxySetting);
  public
    constructor Create;
    destructor Destroy;override;
    procedure Init;
    function Get(AUrl : String; AHeaders : TStringList) : TMemoryStream; overload;
    function Get(AUrl : String) : TMemoryStream; overload;
    procedure Post(AURL: String; AHeaders : TStringList;
      const ASource, AResponseContent: TStream; out AErrMessage : String); overload;
    procedure Post(AURL: String; const ASource, AResponseContent: TStream;
      out AErrMessage : String); overload;
  published
    //代理设置
    property ProxySetting : TProxySetting read FProxySetting write SetProxySetting;
    //是否停止下载
    property Stop : Boolean read FStop write SetStop;
    property OnWork: TWorkEvent read FOnWork write FOnWork;
    property OnWorkBegin: TWorkBeginEvent read FOnWorkBegin write FOnWorkBegin;
    property OnWorkEnd: TWorkEndEvent read FOnWorkEnd write FOnWorkEnd;
  end;

implementation

{ THttpLoader }

constructor THttpLoader.Create;
begin
  FHttp := TIdHTTP.Create(nil);
  FHttp.HandleRedirects := True;
  FHttp.RedirectMaximum := 5;
  FHttp.HTTPOptions := FHttp.HTTPOptions + [hoInProcessAuth];
  FHttp.OnProxyAuthorization := IdHTTPProxyAuthorization;
  FHttp.OnSelectProxyAuthorization := IdHTTPSelectProxyAuthorization;
end;

destructor THttpLoader.Destroy;
begin
  FHttp.Free;
  inherited;
end;

procedure THttpLoader.DoWorkBeginEvent(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin

end;

procedure THttpLoader.DoWorkEndEvent(Sender: TObject;
  AWorkMode: TWorkMode);
begin

end;

procedure THttpLoader.DoWorkEvent(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin

end;

function THttpLoader.Get(AUrl: String): TMemoryStream;
  const QUREYCHAR = '?';
  const QUREYPARAMCHAR = '?';
  function CreateRandomStr(ADestStr : string) : string;
  var
      LGuid: TGUID;
  begin
    CreateGUID(LGuid);
    if Pos(QUREYCHAR, ADestStr)=0 then
    begin
      Result := ADestStr + QUREYCHAR + GUIDToString(LGuid);
    end
    else
    begin
      Result := ADestStr + QUREYPARAMCHAR + GUIDToString(LGuid);
    end;
  end;
var
  I :  Integer;
begin
  Result := TMemoryStream.Create;
  try
    I := 0;
    repeat
      if FStop then
         Exit;
      FHttp.Get(CreateRandomStr(AUrl), Result);
      //Application.ProcessMessages;
      Inc(I);
      if (I>3) then
        break;
    until FHttp.ResponseCode = 200;
  except
  on E: Exception do
      Result := nil;
  end;
end;

function THttpLoader.Get(AUrl: String;
  AHeaders: TStringList): TMemoryStream;
var
  I : Integer;
begin
  FHttp.Request.CustomHeaders.Clear;
  for I := 0 to AHeaders.Count - 1 do
  begin
    FHttp.Request.CustomHeaders.Append(AHeaders.Strings[I]);
  end;
  Result := Get(AUrl);
end;

procedure THttpLoader.IdHTTPProxyAuthorization(Sender: TObject;
  Authentication: TIdAuthentication; var Handled: Boolean);
begin

end;

procedure THttpLoader.IdHTTPSelectProxyAuthorization(Sender: TObject;
  var AuthenticationClass: TIdAuthenticationClass;
  AuthInfo: TIdHeaderList);
var
  LHttp: TIdHTTP;
begin
  // First check for NTLM authentication, as you do not need to
  // set username and password because Indy will automatically
  // handle passing your Windows Domain username and
  // password to the proxy server
  LHttp := Sender as TIdHTTP;

  if Pos(LowerCase('Proxy-Authenticate: NTLM'), LowerCase(LHttp.Response.RawHeaders.Text)) > 0 then
  begin 
   // LHttp.ProxyParams.Clear;
  //  LHttp.ProxyParams.BasicAuthentication := false;
    // Set the authentication class to NTLM 
    AuthenticationClass := TIdSSPINTLMAuthentication;
  end
  else
  begin 
    // Next check for Basic 
    if Pos(LowerCase('Proxy-Authenticate: Basic'), LowerCase(LHttp.Response.RawHeaders.Text)) > 0 then
    begin
      AuthenticationClass := TIdBasicAuthentication;
      LHttp.ProxyParams.BasicAuthentication := true;
    end
    else
    begin
      // Then Digest
      if Pos(LowerCase('Proxy-Authenticate: Digest'), LowerCase(LHttp.Response.RawHeaders.Text)) > 0 then
        AuthenticationClass := TIdDigestAuthentication
    end;
  end;
end;

procedure THttpLoader.Init;
var
  LSocksInfo: TIdSocksInfo;
  LHandlerSocket: TIdIOHandlerSocket;
begin
  FStop := False;
  with FProxySetting do
  begin
    if IsEnableProxy then
    begin
      case ProxyType of
        0:
        begin
          FHttp.IOHandler := nil;
          FHttp.ProxyParams.ProxyServer := ProxyHost;
          FHttp.ProxyParams.ProxyPort := ProxyPort;
          FHttp.ProxyParams.ProxyUsername := ProxyUserName;
          FHttp.ProxyParams.ProxyPassword := ProxyPassword;
        end;
        else
        begin
          FHttp.IOHandler := nil;

          LSocksInfo := TIdSocksInfo.Create(nil);
          LSocksInfo.Version := svSocks4;
          LSocksInfo.Host := ProxyHost;
          LSocksInfo.Port := ProxyPort;

          LHandlerSocket := TIdIOHandlerSocket.Create(nil);
          LHandlerSocket.SocksInfo := LSocksInfo;

          FHttp.IOHandler := LHandlerSocket;
        end;
      end;
    end
    else
    begin
      FHttp.ProxyParams.ProxyServer := '';
      FHttp.ProxyParams.ProxyUsername := '';
      FHttp.ProxyParams.ProxyPassword := '';
      FHttp.ProxyParams.ProxyPort := 80;
      FHttp.IOHandler := nil;
    end;
  end;

  FHttp.OnWork := OnWork;
  FHttp.OnWorkBegin := OnWorkBegin;
  FHttp.OnWorkEnd := OnWorkEnd;
end;

procedure THttpLoader.Post(AURL: String; const ASource,
  AResponseContent: TStream; out AErrMessage: String);
var
  I :  Integer;
begin
  try
    I := 0;
    repeat
      if FStop then
         Exit;
      FHttp.Post(AUrl, ASource, AResponseContent);
      //Application.ProcessMessages;
      Inc(I);
      if (I>3) then
        break;
    until FHttp.ResponseCode = 200;
  except
  on E: Exception do
    AErrMessage := E.Message;
  end;
end;

procedure THttpLoader.Post(AURL: String; AHeaders: TStringList;
  const ASource, AResponseContent: TStream; out AErrMessage: String);
var
  I : Integer;
begin
  FHttp.Request.CustomHeaders.Clear;
  for I := 0 to AHeaders.Count - 1 do
  begin
    FHttp.Request.CustomHeaders.Append(AHeaders.Strings[I]);
  end;
  Post(AURL, ASource,AResponseContent, AErrMessage);
end;

procedure THttpLoader.SetProxySetting(const Value: TProxySetting);
begin
  FProxySetting := Value;
end;

procedure THttpLoader.SetStop(const Value: Boolean);
begin
  FStop := Value;
end;

end.