Delphi实现Ftp客户端下载（支持断点续传，多线程传输）

最新推荐文章于 2021-07-29 17:59:43 发布

delphizhou

最新推荐文章于 2021-07-29 17:59:43 发布

阅读量1.8k

点赞数

文章标签：多线程线程

以前写的一个ftp客户端下载的玩意！支持了断点续传，多线程传输等（实际上并非是一个真正多线程的传输与下载模式，是一个伪多线程方式，仅仅是多开ftp端口，连接上之后从指定的数据段位置开始下载，所以要想真正意义上实现一个多线程的模式还是需要在服务器端做相应的处理才能实现！）代码写的很简陋，仅仅提供了一个DownLoad方法，传递一个Ftp格式的URL然后解析出实际地址与文件名等开始实现下载！大致代码：

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

   
   {
   
                                                          
   
   }
   
   

   
   {
   
          得闲工作室  Ftp客户端下载控件单元               
   
   }
   
   

   
   {
   
          FtpClient                                       
   
   }
   
   

   
   {
   
          作者: 不得闲    2009年2月25日, 9:09:04                
   
   }
   
   

   
   {
   
                                                          
   
   }
   
   

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


   
   unit
   
    FtpClient;


   
   interface
   
   

   
   uses
   
    Windows,Classes,SysUtils,StrUtils,ScktComp,WinInet, Messages,Forms,IniFiles;


   
   type
   
   
  TDxFtpClient 
   
   =
   
    
   
   class
   
   ;

  TDxSockState 
   
   =
   
    (Ds_DataOk,Ds_UserTerminate,Ds_DataErr);

  TReadWriteThread 
   
   =
   
    
   
   class
   
   (TThread)
  
   
   private
   
   
    FDataSocket: TClientSocket;
    Owner: TDxFtpClient;
    SocketDataStream: TWinSocketStream;
    
   
   procedure
   
    DownLoad;
    
   
   procedure
   
    UpLoad;
  
   
   protected
   
   
    
   
   procedure
   
    Execute;
   
   override
   
   ;
    
   
   procedure
   
    UpdateProgress;
  
   
   public
   
   
    
   
   constructor
   
    Create(bSuspend:Boolean;AOwnerFtp: TDxFtpClient;Host: 
   
   string
   
   ;Port: Word);
    
   
   destructor
   
    Destroy;
   
   override
   
   ;
  
   
   end
   
   ;

  TDxFtp 
   
   =
   
    
   
   class
   
   ;


  
   
   {
   
   FTP的双线连接,数据连接与命令连接
   
   }
   
   
  TDxFtpClient 
   
   =
   
    
   
   class
   
   (TComponent)
  
   
   private
   
   
    FCmdSocket: TClientSocket;
   
   //
   
   数据连接与命令连接
    DataStream: TMemoryStream;
  
   
   protected
   
   
    DataSize,ReadySize: Int64;
    OwnerFtp: TDxFtp;
    SocketIndex: Integer;
    ReadWriteThread: TReadWriteThread;
    User,PassWord,DirName,FileName,Host: 
   
   string
   
   ;
    ConPort: Word;
    
   
   procedure
   
    DoCmdSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    
   
   procedure
   
    DoCmdSocketError(Sender: TObject; Socket: TCustomWinSocket;ErrorEvent: TErrorEvent; 
   
   var
   
    ErrorCode: Integer);
    
   
   procedure
   
    DoReadWriteEnd(Sender: TObject);
  
   
   public
   
   
    
   
   constructor
   
    Create(AOwner: TComponent);
   
   override
   
   ;
    
   
   destructor
   
    Destroy;
   
   override
   
   ;
    
   
   procedure
   
    Open;
  
   
   end
   
   ;

  
  
   
   //
   
   下载开始事件,Conindex指定下载的线程号,startPos和TotalSize分别指定下载开始位置和总数据量
  TOnDownStartEvent 
   
   =
   
    
   
   procedure
   
    (sender:TObject;conindex: integer;startPos,totalSize:Int64) 
   
   of
   
    
   
   object
   
   ;
  
   
   //
   
   进度事件，分别指定为当前进度，以及下载速度
  TOnProgressEvent 
   
   =
   
    
   
   procedure
   
   (Sender: TObject;Const FileReadySize,FileTotalSize: int64;
   
   const
   
    Progress: Single;
   
   const
   
    ReadWriteRate: Single) 
   
   of
   
    
   
   object
   
   ;
  
   
   //
   
   上传下载完成时候触发的事件,ReadyState指定完成的状态
  TOnUpDownReadyEvent 
   
   =
   
    
   
   procedure
   
   (Sender: TObject;
   
   const
   
    FileReadySize,FileTotalSize: Int64;
   
   const
   
    ReadyState: TDxSockState) 
   
   of
   
    
   
   object
   
   ;
  
   
   //
   
   在下载和上传时，SockStream在读取和写入数据失败的时候触发的事件！WaitAgain表示是否继续等待下一次读取和写入，默认是不等待，
  
   
   //
   
   如果不等待，则直接中止数据传输，否则一直等待直到有数据读取和写入
  
   
   //
   
   如果不指定该事件，自动检测10次，如果超过10没有读取或写入数据，代表异常，传输数据中止

  TSocketError 
   
   =
   
    
   
   procedure
   
   (Sender: TObject;ErrorEvent: TErrorEvent; 
   
   var
   
    ErrorCode: Integer) 
   
   of
   
    
   
   object
   
   ;

  TReadWritDataErrEvent 
   
   =
   
    
   
   procedure
   
   (Sender: TObject;
   
   var
   
    WaitAgain: Boolean
   
   {
   
   继续等待
   
   }
   
   ) 
   
   of
   
    
   
   object
   
   ;
  TDxFtp 
   
   =
   
    
   
   class
   
   (TComponent)
  
   
   private
   
   
    FThreadCount: Integer;
    FtpSocketArr: 
   
   array
   
    
   
   of
   
    TDxFtpClient;
    Ini: TMemIniFile;
    FileTotalSize: Int64;
    FOnDownStart: TOnDownStartEvent;
    FOnProgress: TOnProgressEvent;
    ReadyCount: Integer;
   
   //
   
   执行完成的数量
    DownStartTick: DWORD;
    BeginSize: Int64;
    SaveFileName: 
   
   string
   
   ;
    UserTerminated: Boolean;
   
   //
   
   用户终止
    CriticalSection: TRTLCriticalSection;
   
   //
   
   创建一个临界区
    FileStream: TFileStream;
    SaveFileIntime: Boolean;
   
   //
   
   实时保存数据文件
    IsUpLoad: Boolean;
    FOnUpDownReady: TOnUpDownReadyEvent;
    SockState: TDxSockState;
    FOnReadWriteDataError: TReadWritDataErrEvent;
    FOnSocketError: TSocketError;
    
   
   procedure
   
    SetThreadCount(
   
   const
   
    Value: Integer);
    
   
   function
   
    GetActive: Boolean;
    
   
   procedure
   
    DownReady;
   
   //
   
   全部完成，文件合并
    
   
   procedure
   
    Ready;
  
   
   public
   
   
    
   
   constructor
   
    Create(AOwner: TComponent);
   
   override
   
   ;
    
   
   destructor
   
    Destroy;
   
   override
   
   ;
    
   
   property
   
    ThreadCount: Integer 
   
   read
   
    FThreadCount 
   
   write
   
    SetThreadCount 
   
   default
   
    
   
   2
   
   ;
   
   //
   
   线程数量
    
   
   procedure
   
    Suspend;
   
   //
   
   暂停
    
   
   procedure
   
    Resume;
   
   //
   
   继续
    
   
   procedure
   
    Terminate;
   
   //
   
   终止数据传输
    
   
   property
   
    Active: Boolean 
   
   read
   
    GetActive;  
   
   //
   
   是否活动
    
   
   procedure
   
    DownLoad(
   
   const
   
    FptUrl: 
   
   string
   
   ;SaveToFile:
   
   string
   
   ;
   
   const
   
    SaveInTime: Boolean 
   
   =
   
    False);
   
   //
   
   下载
    
   
   procedure
   
    UpLoad(
   
   const
   
    FileName,FtpUrl: 
   
   string
   
   );
    
   
   procedure
   
    SaveCfg(CfgFile: 
   
   string
   
   );
   
   //
   
   生成配置文件
    
   
   property
   
    OnDownStart: TOnDownStartEvent 
   
   read
   
    FOnDownStart 
   
   write
   
    FOnDownStart;
    
   
   property
   
    OnProgress: TOnProgressEvent 
   
   read
   
    FOnProgress 
   
   write
   
    FOnProgress;
    
   
   property
   
    OnUpDownReady: TOnUpDownReadyEvent 
   
   read
   
    FOnUpDownReady 
   
   write
   
    FOnUpDownReady;
    
   
   property
   
    OnReadWriteDataError: TReadWritDataErrEvent 
   
   read
   
    FOnReadWriteDataError 
   
   write
   
    FOnReadWriteDataError;
    
   
   property
   
    OnSocketError: TSocketError 
   
   read
   
    FOnSocketError 
   
   write
   
    FOnSocketError; 
  
   
   end
   
   ;
  

   
   function
   
    CheckFileName(
   
   const
   
    FileName: 
   
   string
   
   ): 
   
   string
   
   ;

   
   function
   
    RightPos(Const SubStr,Str: 
   
   string
   
   ;
   
   const
   
    index: integer
   
   =-
   
   1
   
   ): integer;

   
   implementation
   
   

   
   const
   
   
  RecvTmpBufSize
   
   =
   
   64
   
   *
   
   1024
   
   ;

   
   end
   
   .