Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)

作者:老猫 发布于:2012-3-20 10:25 Tuesday 分类:Delphi

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

{*******************************************************}
{                                                       }
{       Ftp客户端下载控件单元               }
{       FtpClient                                       }
{                                                       }
{*******************************************************}

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.

1.jpg

本文出自 老猫的博客,转载时请注明出处及相应链接。

0标签: ftp

评论

  1. gucci bags for cheap 12 分钟前
    This web page Delphi实现的Ftp客户端下载(支持断点续传和多线程传输) provides pleasant quality YouTube videos; I always download the dance competition show video tutorials from this web page.
    gucci bags for cheap http://sotoaviation.com/shop/cheapguccioutlet.php
  2. bsmlrmysi 14 分钟前
    Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)
    <a href="http://www.g55gf0ult7y516p788vq5qqwc5ih4877s.org/">absmlrmysi</a>
    [url=http://www.g55gf0ult7y516p788vq5qqwc5ih4877s.org/]ubsmlrmysi[/url]
    bsmlrmysi http://www.g55gf0ult7y516p788vq5qqwc5ih4877s.org/
  3. ymtfikcsz 31 分钟前
    Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)
    [url=http://www.g0h85yff3z73bvvw37669ie4y8f61ra9s.org/]uymtfikcsz[/url]
    <a href="http://www.g0h85yff3z73bvvw37669ie4y8f61ra9s.org/">aymtfikcsz</a>
    ymtfikcsz http://www.g0h85yff3z73bvvw37669ie4y8f61ra9s.org/
  4. air max classique 约 1 小时前
    Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)
    [url=http://amicalenc.com/lunettes/air-max-classique.html]air max classique[/url]
  5. lunet ray ban prix 约 1 小时前
    Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)
    [url=http://tnhistoirexx.tableau-noir.net/clubmaster/lunet-ray-ban-prix.html]lunet ray ban prix[/url]
  6. Johniepor 约 1 小时前
    レプリカブルガリ時計 - レプリカのブルガリ時計するGreatラグジュアリーあなたが逃すことができない素晴らしいものです。模造品のこのタイプを受け入れるほとんどの人々が増えて、ますます時計モデルが驚くほどの腕時計のための多数の傾斜を満たすために模倣されています。ただブルガリ時計のレプリカプラスあなたを驚かせる取り除くヒットの数量の検索を行う。若い世代ははるかにさらに資金を稼いでいると、彼らは彼らが正しいブルガリレプリカを見つけようとする上で維持正確にネットへの非常に容易なアクセスを持っている。レプリカブルガリの時計は、特定の美しさと優雅さで皆を魅了魔法の痕跡を持っています。これらの時計は、ユニークな方法の中に作成され、いくつかの合併症を持っている。これは、彼らが間違いなく最も例外的なtimepieces.watchcopiez.comを参照しますと、ブルガリ、オメガデビルグランプリはあなたが支払いたい本格的なもののために求めなくても、見て、あなたをもたらす可能性があります。ブルガリレプリカ時計は、専門家があなたの人格のために表示されます与えます。ブルガリによって提供時計はフォーマルドレスで、より精悍に表示されます。ブルガリは、男の腕時計の最高のコレクションを持っています。これらの時計は、細かい職人の技と現代的なデザインが付属しています。レプリカブルガリディアゴノ腕時計は、市場動向を変更した。これらの時計は、美しいルックスと素晴らしいデザインを含む。時計の最高品質の重複はオリジナルと同一であっても同等の部品を使用して作成し、元からのすべての権利のマーキングを持っている。
    [url=http://www.bundledinprayer.com/p-171.html]http://www.bundledinprayer.com/p-171.html[/url] 【正規品ネックレ最新作】 【新入荷】ブルガリ ネックレス(BVLGARI ネックレス)ブルガリ ブルガリブルガリ パヴェダイヤ ペンダント ホワイトゴールド CL188202
    [url=http://www.bundledinprayer.com/p-364.html]http://www.bundledinprayer.com/p-364.html[/url] ブルガリ コレツィオーネ 1910 カーフレザー 長財布 ブラック&ピンク 32451
    レプリカのブルガリ時計は - ファビュラス·ラグジュアリーそれが自分の自信を表示していますが、毎日のライフスタイルに関わると喜び、熱心にあなたのライフスタイルに燃料を供給することを望んで鈍いと?レプリカのブルガリ時計を右ここに主にあなたが逃すことができない優秀な要因である。模造品は、このフォームを受け入れる全体の多くよりはるかに多くの個人と、全体の多くよりはるかに多くの時計のバージョンは、ゴージャスな時計のための多くの異なる傾斜を満たすために模倣されています。ただレプリカブルガリのための研究を行うことなど、適切にお求めになったヒットの量はあなたを驚かせるように見ています。若々しい時代は、はるかにはるかに多くの収入を稼いでいるプラス、彼らが最も効果的なブルガリのレプリカを探している時に保持場所を正確に彼らは、ネットに向けた複雑でないエントリを取得しています。レプリカブルガリの時計は、特定の優雅さと優雅さを持つすべての人を魅了して魔法の痕跡を保有。これらの時計は、特定の方法で開発され、いくつかのcomplications.Replicaブルガリ時計はあなたの人格のために資格を垣間見ることができます持っている。フォーマルドレスと全体の多くより精悍ブルガリ垣間見るによって提供腕時計。ブルガリは、成人男性の腕時計の最高の選択をしています。これらの時計は良い職人の技と現代的なデザインで表示されます。レプリカブルガリの時計は、市場の動向を変更した。これらの時計は素晴らしいが表示され、素晴らしいデザインが表示されます。時計の優れた重複は原本から、同一または同等の要素を用いて製造し、元の正しいマーキングのすべてを持っています。ブルガリの腕時計は、優雅さと優雅さを愛する皆様の関心をキャッチ。ブルガリの腕時計は、ヘレニズム文化の傑作を彷彿。この類似は、ギリシャから届いたブルガリファミリーメンバーのファクト祖先に、本当に適切な??取得することになります。
  7. gmjthktx 约 2 小时前
    Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)
    [url=http://www.g416v64uc1l4ca4n5y4n8h3w8k5b9g6ms.org/]ugmjthktx[/url]
    gmjthktx http://www.g416v64uc1l4ca4n5y4n8h3w8k5b9g6ms.org/
    <a href="http://www.g416v64uc1l4ca4n5y4n8h3w8k5b9g6ms.org/">agmjthktx</a>
  8. vbghcwhkym 约 2 小时前
    Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)
    <a href="http://www.g0ry25kw50fqzwrv96b52795s1926eeus.org/">avbghcwhkym</a>
    [url=http://www.g0ry25kw50fqzwrv96b52795s1926eeus.org/]uvbghcwhkym[/url]
    vbghcwhkym http://www.g0ry25kw50fqzwrv96b52795s1926eeus.org/
  9. sbcylsskdc 约 2 小时前
    Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)
    <a href="http://www.gi41g4x96cq4g7fxh77nqb05349ud4w8s.org/">asbcylsskdc</a>
    [url=http://www.gi41g4x96cq4g7fxh77nqb05349ud4w8s.org/]usbcylsskdc[/url]
    sbcylsskdc http://www.gi41g4x96cq4g7fxh77nqb05349ud4w8s.org/
  10. ray ban rb4150 约 2 小时前
    Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)
    [url=http://www.arthur-loyd-bretagne.com/collection/ray-ban-rb4150.html]ray ban rb4150[/url]
  11. ray ban imitation 约 2 小时前
    Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)
    [url=http://www.lepavillondubienetre.com/aviator/ray-ban-imitation.html]ray ban imitation[/url]
  12. xkocrkktqs 约 2 小时前
    Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)
    [url=http://www.g6auo69yr588e1cwaz86bx880r8wu300s.org/]uxkocrkktqs[/url]
    <a href="http://www.g6auo69yr588e1cwaz86bx880r8wu300s.org/">axkocrkktqs</a>
    xkocrkktqs http://www.g6auo69yr588e1cwaz86bx880r8wu300s.org/
  13. air jordan rare 约 3 小时前
    Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)
    [url=http://www.sirtompercheornais.com/soleil/air-jordan-rare.html]air jordan rare[/url]
  14. nike requin 约 3 小时前
    Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)
  15. optic 2000 ray ban 约 4 小时前
    Delphi实现的Ftp客户端下载(支持断点续传和多线程传输)
    [url=http://www.clinique-princess.com/imitation/optic-2000-ray-ban.html]optic 2000 ray ban[/url]

发表评论

电子邮件地址不会被公开。必填项已用*标注

Ɣ回顶部