http断点续传的单元

{******************************************************************************
    文件名称： uWnDownLoadHelper.pas
    文件功能： 断点续传下载线程单元
    作者    ： enli
--------------------------------------------------------------------------------}

unit  uWnDownLoadHelper;

interface

uses
  IdHTTP, IdAuthentication, IdHeaderList, IniFiles, md5,
  SysUtils, IdAuthenticationSSPI, IdAuthenticationDigest, Classes, IdException,
  IdSocks, IdIOHandlerSocket, DateUtils, IdComponent, Forms,ucchttpClient;

const
  S_TMP_POSTFIX  =   ' .tmp ' ;
  S_INI_POSTFIX  =   ' .sni ' ;

type
  TWnDownloadProgress  =   procedure (APosition,ACount: Int64)  of   object ;

   //  代理设置结构
  TWnProxySetting  =   packed   record
    FIsProxyEnabled: Boolean;
    FSocksVersion: TSocksVersion;
    FProxyHost:  string ;
    FProxyPort: Word;
    FAuthUserName:  string ;
    FAuthPassword:  string ;
    FAuthDomain: string ;
   end ;
  PWnProxySetting  =  ^TWnProxySetting;

  TWnDownLoadThread  =   class (TThread)
   private
    FHttp: TCCHTTPClient;
    FProxy: TWnProxySetting;
    FTarget:  string ;
    FSaveFile:  string ;
    FTempFile:  string ;
    FProgress: TWnDownloadProgress;
    FCurrentFileSize,FFileSize : Int64;
    FSaveLocation:  string ;
    FOnLog: TDolog;
    FWarningMsg:  string ;
    FReLoad: Boolean;
     procedure  SetProxy( const  Value: PWnProxySetting);
     function  GetProxy :PWnProxySetting;
     procedure  SetHttpProxy;
     procedure  SetTarget( const  Value:  string );
     procedure  SetProgress( const  Value: TWnDownloadProgress);
     procedure  DoBeginWork(Sender: TObject; const  APos,ACount: Int64);
     procedure  DoWork(Sender: TObject; const  AWork:Int64);
     procedure  DoEndWork(Sender: TObject);
     procedure  DoUpdateUI;
     procedure  SetSaveLocation( const  Value:  string );
     procedure  SaveIniFile;
     procedure  DelIniFile;
     procedure  DoLog( const  AMsg: string );
     procedure  DoSycLog;
     function  GetTempFile: string ;
     procedure  SetOnLog( const  Value: TDolog);
     procedure  SetReLoad( const  Value: Boolean);
   public
     procedure  Execute;  override ;
     constructor  Create;
     destructor  Destroy;  override ;
     class   procedure  chunkedConvertToFile( const  ASource,ADestination: string );
     property  PProxy:PWnProxySetting  read  GetProxy  write  SetProxy;
     property  Target: string   read  FTarget  write  SetTarget;
     property  SaveLocation : string   read  FSaveLocation  write  SetSaveLocation;
     property  Progress:TWnDownloadProgress  read  FProgress  write  SetProgress;
     property  ReLoad:Boolean  read  FReLoad  write  SetReLoad;
     property  OnLog: TDolog  read  FOnLog  write  SetOnLog;
   end ;

   procedure  DownLoadFile( const  AUrl,ASaveFile: string ;AProxy:PWnProxySetting;AProgress:TWnDownloadProgress;ALog:TDolog;AReLoad:Boolean);

implementation

procedure  DownLoadFile( const  AUrl,ASaveFile: string ;AProxy:PWnProxySetting;AProgress:TWnDownloadProgress;ALog:TDolog;AReLoad:Boolean);
var
  LThread: TWnDownLoadThread;
begin
  LThread : =  TWnDownLoadThread.Create;
  LThread.ReLoad : =  AReLoad;
  LThread.Target : =  AUrl;
  LThread.SaveLocation : =  ASaveFile;
  LThread.PProxy : =  AProxy;
  LThread.Progress : = AProgress;
  LThread.OnLog : =  ALog;
  LThread.Resume;
end ;

{  TWnDownLoadThread  }

class   procedure  TWnDownLoadThread.chunkedConvertToFile( const  ASource,
  ADestination:  string );
var
  LSStream,LDStream: TFileStream;
  LBuff: Byte;
  LFlag: Boolean;
  LTemp :  string ;
  I,LCount : Integer;
begin
   if   not  FileExists(ASource)  then  Exit;
   if  FileExists(ADestination)  then  Exit;
  LSStream : =  TFileStream.Create(ASource,fmOpenRead    );
  LDStream : =  TFileStream.Create(ADestination,fmCreate);
   try
    LSStream.Seek( 0 , 0 );
    LFlag : =  True;
    I : =   0 ;
     while  LFlag  do
     begin
      LSStream.Read(LBuff,SizeOf(Byte));
      Inc(I);
       if  (LBuff  =  $0A)  and  (I > 2 )  and  (LTemp[I - 1 ]  =  #$0D)  then   begin
        LCount : =  StrToIntDef( ' $ ' + trim(LTemp), 1 );
         if  LCount  =   1   then
         begin
          LCount : =   0 ;
          Break;
           // raise  异常
         end ;
         if  LCount  =   0   then
          LFlag : =  False
         else
         begin
          LDStream.CopyFrom(LSStream,LCount);
          I : =   0 ;
          LTemp : =   '' ;
         end ;
       end
       else
        LTemp : =  LTemp  +  Char(LBuff);
     end ;

   finally
    FreeAndNil(LSStream);
    FreeAndNil(LDStream);
   end ;

end ;

constructor  TWnDownLoadThread.Create;
begin
   inherited  Create(True);
  FreeOnTerminate : =  True;
  FTarget : =   '' ;
  FSaveFile : =   '' ;
   // New(FProxy);
end ;

procedure  TWnDownLoadThread.DelIniFile;
begin
  DeleteFile(FSaveLocation  +  FTempFile + S_INI_POSTFIX);
end ;

destructor  TWnDownLoadThread.Destroy;
begin
   // Dispose(FProxy);
   inherited ;
end ;

procedure  TWnDownLoadThread.DoBeginWork(Sender: TObject;
   const  APos,ACount: Int64);
begin
  FFileSize : =  ACount;
  FCurrentFileSize : =  APos ;
  SaveIniFile;
  Synchronize(DoUpdateUI);
end ;

procedure  TWnDownLoadThread.DoEndWork(Sender: TObject);
begin
  FCurrentFileSize : =  FFileSize;
  Synchronize(DoUpdateUI);
end ;

procedure  TWnDownLoadThread.DoLog( const  AMsg:  string );
begin
   if  Assigned(FOnlog)  then
   begin
     /// DoDownLoadLog(AMsg);
    FWarningMsg: =  AMsg;
    Synchronize(DoSycLog);
   end ;
end ;

procedure  TWnDownLoadThread.DoSycLog;
begin
  FOnlog(FWarningMsg);
end ;

procedure  TWnDownLoadThread.DoUpdateUI;
begin
   if  Assigned(FProgress)  then
    FProgress(FCurrentFileSize,FFileSize);
end ;

procedure  TWnDownLoadThread.DoWork(Sender: TObject;  const  AWork: Int64);
begin
  FCurrentFileSize : =  FCurrentFileSize +  AWork;
  Synchronize(DoUpdateUI);
end ;

procedure  TWnDownLoadThread.Execute;
var
  LDoc,
  LHost,
  LPath,
  LProto,
  LPort,
  LBookmark:  string ;
begin
   if  Length(FTarget)  =   0   then  Exit;
   if  Length(FSaveLocation)  =   0   then  Exit;
  FHttp : =  TCCHTTPClient.Create( nil );
   try
    FHttp.IOHandler : =  TIdIOHandlerSocket.Create(FHttp);
    FHttp.Socket.SocksInfo : =  TIdSocksInfo.Create(FHttp);
    FHttp.ProtocolVersion : =  uCCHTTPClient.pv1_ 1 ;    
    SetHttpProxy;
    FHttp.OnDownloadBegin : =   DoBeginWork;
    FHttp.OnDownload : =   DoWork;
    FHttp.OnDownloadEnd : =  DoEndWork;
    FHttp.OnLog : =  DoLog;

    FHttp.ParseURI(FTarget, LProto, LHost, LPath, LDoc, LPort, LBookmark);
    FSaveFile : =  LDoc;
    FTempFile : =  GetTempFile + ' . ' + LDoc;
     if  FReLoad  and  FileExists(FSaveLocation  +  FTempFile + S_TMP_POSTFIX)  then
      DeleteFile(FSaveLocation  +  FTempFile + S_TMP_POSTFIX);
    DoLog( ' 下载开始请求 ' );
     try
      FHttp.DownLoad(FTarget,FSaveLocation  +  FTempFile + S_TMP_POSTFIX);
     except
      on E:Exception  do
        DoLog(e.Message);
     end ;
     if  FileExists(FSaveLocation  +  FTempFile + S_INI_POSTFIX)  then
     begin

       if  FileExists(FSaveLocation  +  LDoc)  then
        DeleteFile(FSaveLocation  +  LDoc);
       if  FHttp.Response.TransferEncoding  =   ' chunked '   then
       begin
        chunkedConvertToFile(FSaveLocation  +  FTempFile + S_TMP_POSTFIX,FSaveLocation  +  LDoc);
        DeleteFile(FSaveLocation  +  FTempFile + S_TMP_POSTFIX);
       end
       else
        RenameFile(FSaveLocation  +  FTempFile + S_TMP_POSTFIX,FSaveLocation  +  LDoc);
      DelIniFile;
     end
     else
      DeleteFile(FSaveLocation  +  FTempFile + S_TMP_POSTFIX);
   finally
    FreeAndNil(FHttp);
    DoLog( ' 下载结束 ' );
   end ;
end ;

function  TWnDownLoadThread.GetProxy: PWnProxySetting;
begin
  Result : =  @FProxy
end ;

function  TWnDownLoadThread.GetTempFile:  string ;
var
  Ltemp:  string ;
begin
  Ltemp : =  MD5Print(MD5String(FTarget));
   // Ltemp : =  copy(Ltemp,  2 , length(Ltemp)  -   2 );
  Result : =  StringReplace(Ltemp, ' - ' , ' . ' ,[rfReplaceAll]    );
end ;

procedure  TWnDownLoadThread.SaveIniFile;
var
  LIni:TIniFile;
begin
  LIni : =  TIniFile.Create(FSaveLocation  +  FTempFile + S_INI_POSTFIX);
   try
    LIni.WriteString( ' Setup ' , ' URL ' ,FTarget);
    LIni.WriteString( ' Setup ' , ' SaveLocation ' ,FSaveLocation);
    LIni.WriteString( ' Setup ' , ' SaveFile ' ,FSaveFile);
    LIni.WriteString( ' Setup ' , ' TempFile ' ,FTempFile);
    LIni.WriteString( ' Setup ' , ' FileSize ' ,FloatToStr(FFileSize));
   finally
    LIni.Free;
   end ;

end ;

procedure  TWnDownLoadThread.SetHttpProxy;
begin
   if   not  Assigned(FHttp)  then  Exit;
   with  FProxy  do
   if  FIsProxyEnabled  then
   begin
    FHttp.Socket.SocksInfo.Version : =  FSocksVersion;
    FHttp.Socket.SocksInfo.Host : =  FProxyHost;
    FHttp.Socket.SocksInfo.Port : =  FProxyPort;

     if  FHttp.Socket.SocksInfo.Username  <>   ''   then
      FHttp.Socket.SocksInfo.Authentication : =  saUsernamePassword
     else
      FHttp.Socket.SocksInfo.Authentication : =  saNoAuthentication;
    FHttp.AuthUsername : =  FAuthUserName;
    FHttp.AuthPassword : =  FAuthPassword;
    FHttp.AuthDomain   : =  FAuthDomain;
    FHttp.ProxyHost    : =  FProxyHost;
    FHttp.ProxyPort    : =  FProxyPort;
   end ;
end ;

procedure  TWnDownLoadThread.SetOnLog( const  Value: TDolog);
begin
  FOnLog : =  Value;
end ;

procedure  TWnDownLoadThread.SetProgress( const  Value: TWnDownloadProgress);
begin
  FProgress : =  Value;
end ;

procedure  TWnDownLoadThread.SetProxy( const  Value: PWnProxySetting);
begin
     // New(FProxy);
    FProxy.FIsProxyEnabled : = Value^.FIsProxyEnabled;
    FProxy.FSocksVersion : =  Value^.FSocksVersion;
    FProxy.FProxyHost : =  Value^.FProxyHost;
    FProxy.FProxyPort : =  Value^.FProxyPort;
    FProxy.FAuthUserName : =  Value^.FAuthUserName;
    FProxy.FAuthPassword : =  Value^.FAuthPassword;
    FProxy.FAuthDomain   : =  Value^.FAuthDomain;
    FProxy.FProxyHost   : =  Value^.FProxyHost;
    FProxy.FProxyPort    : =  Value^.FProxyPort;

end ;

procedure  TWnDownLoadThread.SetReLoad( const  Value: Boolean);
begin
  FReLoad : =  Value;
end ;

procedure  TWnDownLoadThread.SetSaveLocation( const  Value:  string );
begin
  FSaveLocation : =  Value;
   if  FSaveLocation[Length(FSaveLocation)]  <>   ' \ '   then
    FSaveLocation : =  FSaveLocation  + ' \ ' ;
end ;

procedure  TWnDownLoadThread.SetTarget( const  Value:  string );
begin
   if  Length(Value)  =   0   then  Exit;
   if  UpperCase(Copy(Value, 1 , 7 ))  <>   ' HTTP:// '   then  Exit;
  FTarget : =  Value;
end ;

　　end .

  备忘：IdDownLoad

转载于:https://www.cnblogs.com/enli/archive/2011/04/09/2010132.html