Delphi http传输备忘

TProxySetting

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 .

 

 

转载于:https://www.cnblogs.com/enli/archive/2010/07/16/1779210.html