delphi 文件下载汇总

delphi 文件下载汇总
2011年03月22日
　　现在很多应用都需要上传与下载大型文件，通过HTTP方式上传大文件有一定的局限性。幸好FTP作为一个非常老而且非常成熟的协议可以高效稳定地完成大文件的上传下载，并且可以完美地实现续传。就拿我写的电影服务器管理端程序来说，各种方案比较后，发现使用FTP可以完美地实现要求。但是要通过WinSocket库实现FTP比较麻烦，幸好有Indy--一个包装了大多数网络协议的组件包。
　　通过Indy，程序设计人员可以通过阻塞方式进行编程，可以抛开蹩脚的Winsocket异步模式，采用与Unix系统上等同的阻塞编程模式进行。这样，程序员就可以很好的处理程序的运行流程。 下面，我们进入到Indy的TIdFtp世界。 
　　1.控件的说明
　　使用Indy 9中的TIdFtp控件可以实现通过FTP方式进行文件的上传与下载。
　　2.控件的具体使用
　　（1）控件属性设置
　　默认属性即可，与服务器连接直接相关的属性如主机名与用户等在建立连接时进行设定。需要设定的是RecvBufferSize和SendBufferSize两属性的值。另外需要根据要传输的文件类型指定TransferType属性，而其他属性按默认值设定即可。
　　RecvBufferSize说明（默认值为8192字节）：该属性为整型变量，用于指定连接所用的接受缓冲区大小。
　　SendBufferSize说明（默认值为32768字节）：该属性也为整型变量，用于指定连接所用的发送缓冲区的最大值。该属性在WriteStream方法中时，可用于TStream指定要发送内容的块数。如果要发送的内容大于本属性值，则发送内容被分为多个块发送。
　　TransferType说明（默认值为ftBinary）：该属性为TIdFTPTransferType型变量。用于指定传输内容是二进制文件（ftBinary ）还是ASCII文件（ftASCII）。应用程序需要使用二进制方式传输可执行文件、压缩文件和多媒体文件等；而使用ASCII方式传输文本或超文本等文本型数据。
　　（2）控件的事件响应
　　OnDisconnected响应：TNotifyEvent类，用于响应断开（disconnect）事件。当Disconnect方法被调用用来关闭Socket的时候，触发该响应。应用程序必须指定该事件响应的过程，以便对该断开事件进行相应。
　　OnStatus响应：TIdStatusEvent类。该响应在当前连接的状态变化时被触发。该事件可由DoStatus方法触发并提供给事件控制器属性。axStatus是当前连接的TIdStatus值；aaArgs是一个可选的参数用于格式化函数，它将用于构造表现当前连接状态的文本消息。
　　OnWork响应：OnWord是TWorkEvent类事件的响应控制器。OnWork用于关联DoWork方法当缓冲区读写操作被调用时通知Indy组件和类。它一般被用于控制进度条和视窗元素的更新。AWorkMode表示当前操作的模式，其中：wmRead-组件正在读取数据；wmWrite-组件正在发送数据。AWorkCount指示当前操作的字节计数。
　　OnWorkBegin响应：TWorkBeginEvent类。当缓冲区读写操作初始化时，该事件关联BeginWork方法用于通知Indy组件和类。它一般被用于控制进度条和视窗元素的更新。AWorkMode表示当前操作的模式，其中：wmRead-组件正在读取数据；wmWrite-组件正在发送数据。AWorkCountMax用于指示发送到OnWorkBegin事件的操作的最大字节数，0值代表未知。
　　OnWorkEnd响应：TWorkEndEvent类。当缓冲区读写操作终止时，该事件关联EndWork方法用于通知Indy组件和类。AWorkMode表示当前操作的模式，其中：wmRead-组件正在读取数据；wmWrite-组件正在发送数据。AWorkCount表示操作的字节数。
　　在事件响应中，主要通过上述五种事件响应来控制程序。在一般情况下，在OnDisconnected中设定连接断开的界面通知；在OnStatus中设定当前操作的状态；在OnWork中实现传输中状态条和其他参数的显示；而在OnWorkBegin和OnWorkEnd中分别设定开始传输和传输结束时的界面。
　　（3）连接远程服务器
　　完成了设定控件属性和实现了控件的事件响应后，就可以与服务器进行交互和传输了。在连接之前，应首先判断IdFtp是否处于连接状态，如果Connected为False，则通过界面控件或其他方式指定与服务器连接相关的一些TCP类属性的设置，分别是：Host（主机名）:String、Username（用户名）:String、Password（密码）:String，也可以指定Port(端口)。之后调用Connect方法连接远程服务器，如果无异常出现则连接成功建立。
　　过程说明：procedure Connect(AAutoLogin: boolean; const ATimeout: Integer);
　　该过程连接远程FTP服务器
　　属性：AAutoLogin: boolean = True
　　连接后自动登录，该参数默认为True。
　　const ATimeout: Integer = IdTimeoutDefault 
　　超时时间，单位：秒。
　　示例代码：
　　if IdFTP1.Connected then 
　　try
　　if TransferrignData then IdFTP1.Abort;
　　IdFTP1.Quit;
　　finally
　　end
　　else
　　with IdFTP1 do try
　　Username := UserIDEdit.Text;
　　Password := PasswordEdit.Text;
　　Host := FtpServerEdit.Text;
　　Connect;
　　ChangeDir(CurrentDirEdit.Text);
　　finally
　　end; 
　　（4）改变目录
　　连接建立后，可以改变当前FTP会话所在的目录。对于已知绝对路径的情况下，可以直接调用ChangeDir(const ADirName: string)方法来转换目录，ADirName表示服务器上的文件系统目录，另外还可以调用ChangeDirUp回到上级目录。
　　如果未知路径，则可以通过List(ADest: TStrings; const ASpecifier: string; const ADetails: boolean)过程获取远程服务器的当前目录结构，此时必须设定TransferType为ftASCII（ASCII模式），其中：ADest保存当前目录结构，可以在后续程序中调用该列表。另外可以通过RetrieveCurrentDir方法获取当前目录名。
　　过程说明：
　　procedure ChangeDir(const ADirName: string); 
　　改变工作目录
　　属性
　　const ADirName: string 
　　远程服务器的目录描述
　　说明：该过程实际上是实现了FTP CWD命令。
　　procedure ChangeDirUp; 
　　到上一级目录
　　function RetrieveCurrentDir: string; 
　　该函数返回当前目录名
　　procedure List(ADest: TStrings; const ASpecifier: string; const ADetails: boolean); 
　　列出当前目录所有文件和子目录及其属性
　　参数：
　　ADest: TStrings 
　　保存文件及子目录的返回结果
　　const ASpecifier: string = '' 
　　文件掩码，用于列出符合条件的文件
　　const ADetails: boolean = true 
　　包含文件和子目录属性
　　property DirectoryListing: TIdFTPListItems; 
　　返回文件及目录结构的列表
　　示例代码：
　　LS := TStringList.Create;
　　try
　　IdFTP1.ChangeDir(DirName);
　　IdFTP1.TransferType := ftASCII;
　　CurrentDirEdit.Text := IdFTP1.RetrieveCurrentDir;
　　DirectoryListBox.Items.Clear;
　　IdFTP1.List(LS);
　　DirectoryListBox.Items.Assign(LS);
　　if DirectoryListBox.Items.Count > 0 then
　　if AnsiPos('total', DirectoryListBox.Items[0]) > 0 then DirectoryListBox.Items.Delete(0);
　　finally
　　LS.Free;
　　end; 
　　（5）实现下载
　　在下载之前，必须查看DirectoryListing.Items[sCurrFile].ItemType是否为文件，如返回为ditDirectory则代表当前文件名为目录，不能下载，必须导向到文件才可。如为文件，则可以进行下载。在下载前，设定传输的类型为二进制文件，并且指定本地要保存的路径。通过调用Get方法，实现文件的下载。下载过程较慢，可以考虑将其放到线程中实现。
　　过程说明：
　　procedure Get(const ASourceFile: string; ADest: TStream; AResume: Boolean); overload;
　　procedure Get(const ASourceFile: string; const ADestFile: string; const ACanOverwrite: boolean; AResume: Boolean); overload; 
　　从远程服务器上获取文件。
　　属性说明：
　　const ASourceFile: string 
　　远程服务器上的源文件名
　　const ADestFile: string 
　　保存到客户机上的文件名
　　const ACanOverwrite: boolean = false 
　　重写同名文件
　　AResume: Boolean = false 
　　是否进行断点续传
　　示例代码：
　　SaveDialog1.FileName := Name;
　　if SaveDialog1.Execute then begin
　　SetFunctionButtons(false);
　　IdFTP1.TransferType := ftBinary;
　　BytesToTransfer := IdFTP1.Size(Name);
　　if FileExists(Name) then begin
　　case MessageDlg('File aready exists. Do you want to resume the download operation?',
　　mtConfirmation, mbYesNoCancel, 0) of
　　mrYes: begin
　　BytesToTransfer := BytesToTransfer - FileSizeByName(Name);
　　IdFTP1.Get(Name, SaveDialog1.FileName, false, true);
　　end;
　　mrNo: begin
　　IdFTP1.Get(Name, SaveDialog1.FileName, true);
　　end;
　　mrCancel: begin
　　exit;
　　end;
　　end;
　　end
　　else begin
　　IdFTP1.Get(Name, SaveDialog1.FileName, false);
　　end;
　　（6）上传的实现
　　上传的实现与下载类似，通过put方法即可。
　　过程说明：
　　procedure Put(const ASource: TStream; const ADestFile: string; const AAppend: boolean); overload;
　　procedure Put(const ASourceFile: string; const ADestFile: string; const AAppend: boolean); overload; 
　　上传文件至服务器
　　属性说明：
　　const ASourceFile: string 
　　将要被上传的文件
　　const ADestFile: string = '' 
　　服务器上的目标文件名
　　const AAppend: boolean = false 
　　是否继续上传
　　代码示例：
　　if IdFTP1.Connected then begin
　　if UploadOpenDialog1.Execute then try
　　IdFTP1.TransferType := ftBinary;
　　IdFTP1.Put(UploadOpenDialog1.FileName, ExtractFileName(UploadOpenDialog1.FileName));
　　//可以在此添加改变目录的代码;
　　finally
　　//完成清除工作
　　end;
　　end; 
　　（7）删除的实现
　　删除文件使用Delete方法，该方法删除指定的文件，删除对象必须为文件。如果要删除目录则使用RemoveDir方法。
　　过程说明：
　　procedure Delete(const AFilename: string); 
　　删除文件
　　procedure RemoveDir(const ADirName: string); 
　　删除文件夹，根据不同的服务器删除文件夹有不同的要求。有些服务器不允许删除非空文件夹，程序员需要添加清空目录的代码。
　　上述两个过程的参数均为目标名称
　　代码示例：
　　if not IdFTP1.Connected then exit;
　　Name := IdFTP1.DirectoryListing.Items[iCurrSelect].FileNam e;
　　if IdFTP1.DirectoryListing.Items[iCurrSelect].ItemTyp e = ditDirectory then try
　　idftp1.RemoveDir(Name);
　　finally
　　end
　　else
　　try
　　idftp1.Delete(Name);
　　finally
　　end; 
　　（8）后退的实现
　　后退在实际上是目录操作的一种，可以简单的改变当前目录为..来实现，也可以通过回到上级目录来实现。
　　（9）取消的实现
　　在IdFtp的传输过程中，可以随时使用abort方法取消当前操作。可以的OnWork事件的实现中来确定何时取消操作。
　　代码示例：
　　//取消按钮的OnClick响应
　　procedure TMainForm.AbortButtonClick(Sender: TObject);
　　begin
　　AbortTransfer := true;
　　end;
　　//IdFTP的OnWork事件响应
　　procedure TMainForm.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
　　const AWorkCount: Integer);
　　begin
　　... 
　　if AbortTransfer then IdFTP1.Abort;
　　AbortTransfer := false;
　　end; 
　　（10）断点续传的实现
　　断点续传就是在上传或下载过程开始时，判断已经传输过的文件是否上传输完毕，如果传输没有成功完成，则在上次中断处继续进行传输工作。实现该功能需要两个重要的操作，首先是判断文件的大小信息，其次是在传输过程Get和Put中指定上传的行为。
　　判断服务器上文件的大小使用函数Size(FileName)。在下载过程中，比较本地文件和远程文件的信息，然后在Get中指定AResume := True即可。而上传也一样，指定Put的AAppend := True就可以了。 
　　在前面我们讲过，Indy的网络操作大部分是阻塞模式的，TIdFtp也不例外。这样在上述各个操作运行过程的时候用户界面被暂时冻结，必须要等待调用返回才能继续用户操作界面响应。所以在实际编程中，需要使用多线程的方式来保证户界面的响应。Windows系统可以使用CreateThread系统调用来创建线程，但是在使用的时候需要开发人员做很多额外的工作来保证线程的同步等问题。而Indy中也包含了实现多线程的控件TIdThreadComponent，相对比之下该控件实现多线程时更加方便，也更容易控制。
　　Delphi(Pascal) code
　　//下载文件 procedure TProgForm.DownFile(fileUrl: string); var fileName:string; tStream: TFileStream; begin fileName:='setup'+ IntToStr(mForm.lpNode.iSoft_Id) +'.exe'; //从下载路径中获取文件名 if FileExists(fileName) then//如果文件已经存在 tStream := TFileStream.Create(fileName, fmOpenWrite) else tStream := TFileStream.Create(fileName, fmCreate); {if not FileExists(fileName) then //初次下载 begin idhtp1.Request.ContentRangeStart:=0; //从指定文件偏移处请求下载文件 startIndex:=0; end else begin //续传} try startIndex:=tStream.Size-1; if startIndex 发送HEAD请求 //end; self.idhtp1.Get(fileUrl,tStream); except end; tStream.Free; end; 
　　urlmon.dll中有一个用于下载的API，MSDN中的定义如下：
　　HRESULT URLDownloadToFile(      
　　LPUNKNOWN pCaller,
　　LPCTSTR szURL,
　　LPCTSTR szFileName,
　　DWORD dwReserved,
　　LPBINDSTATUSCALLBACK lpfnCB
　　);
　　Delphi的UrlMon.pas中有它的Pascal声明：
　　function URLDownloadToFile(      
　　pCaller: IUnKnown,
　　szURL: PAnsiChar,
　　szFileName: PAnsiChar,
　　dwReserved: DWORD,
　　lpfnCB: IBindStatusCallBack;
　　);HRESULT;stdcall;
　　szURL是要下载的文件的URL地址，szFileName是另存文件名，dwReserved是保留参数，传递0。如果不需要进度提示的话，调用这个函数很简单。比如要下载http://218.95.47.224/page/jxzy/XSZB/web/fourteens/ Music/qili.mp3 这首歌，并保存为D:\ Music\七里香.mp3，就可以这样调用：
　　URLDownloadToFile(nil,'http://218.95.47.224/page/j xzy/XSZB/web/fourteens/Music/qili.mp3 ','D:\ Music\七里香.mp3',0,nil);
　　不过这样做的缺点是没有进度提示，而且会阻塞调用线程。如果要获得进度提示就要用到最后一个参数lpfnCB了，它是一个接口类型IBindStatusCallBack，定义如下：
　　IBindStatusCallback = interface
　　['{79eac9c1-baf9-11ce-8c82-00aa004ba90b}']
　　function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
　　function GetPriority(out nPriority): HResult; stdcall;
　　function OnLowResource(reserved: DWORD): HResult; stdcall;
　　function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
　　szStatusText: LPCWSTR): HResult; stdcall;
　　function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
　　function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
　　function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
　　stgmed: PStgMedium): HResult; stdcall;
　　function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
　　end;
　　进度提示就靠这个接口的OnProgress方法了。我们可以定义一个实现 IBindStatusCallback 接口的类，只处理一下OnProgress方法就可以了，其它方法咱啥都不做，就返回S_OK。下面简要说一下OnProgress：
　　ulProgress ：当前进度值
　　ulProgressMax ：总进度
　　ulStatusCode: 状态值，是tagBINDSTATUS枚举。表明正在寻找资源啊，正在连接啊这些状态。具体请查看MSDN，我们这里不需要关心它
　　szStatusText：状态字符串，咱也不关心它
　　所以我们用百分比来表示进度的话就是FloatToStr(ulProgress*100/ulProgressMax)+'/%'，简单吧。如果要在下载完成前取消任务，可以在OnProgress中返回E_ABORT。
　　我把UrlDownloadToFile及其进度提示功能都封装进了一个线程类中，这个类的源码如下： 
　　{ Delphi File Download Thread Class , Copyright (c) Zhou Zuoji }
　　unit FileDownLoadThread;
　　interface
　　uses
　　Classes,
　　SysUtils,
　　Windows,
　　ActiveX,
　　UrlMon;
　　const
　　S_ABORT = HRESULT($80004004);
　　type
　　TFileDownLoadThread = class;
　　TDownLoadProcessEvent = procedure(Sender:TFileDownLoadThread;Progress, ProgressMax:Cardinal) of object;
　　TDownLoadCompleteEvent = procedure(Sender:TFileDownLoadThread) of object ;
　　TDownLoadFailEvent = procedure(Sender:TFileDownLoadThread;Reason:LongIn t) of object ;
　　TDownLoadMonitor = class( TInterfacedObject, IBindStatusCallback )
　　private
　　FShouldAbort: Boolean;
　　FThread:TFileDownLoadThread;
　　protected
　　function OnStartBinding( dwReserved: DWORD; pib: IBinding ): HResult; stdcall;
　　function GetPriority( out nPriority ): HResult; stdcall;
　　function OnLowResource( reserved: DWORD ): HResult; stdcall;
　　function OnProgress( ulProgress, ulProgressMax, ulStatusCode: ULONG;
　　szStatusText: LPCWSTR): HResult; stdcall;
　　function OnStopBinding( hresult: HResult; szError: LPCWSTR ): HResult; stdcall;
　　function GetBindInfo( out grfBINDF: DWORD; var bindinfo: TBindInfo ): HResult; stdcall;
　　function OnDataAvailable( grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
　　stgmed: PStgMedium ): HResult; stdcall;
　　function OnObjectAvailable( const iid: TGUID; punk: IUnknown ): HResult; stdcall;
　　public
　　constructor Create(AThread:TFileDownLoadThread);
　　property ShouldAbort: Boolean read FShouldAbort write FShouldAbort;
　　end;
　　TFileDownLoadThread = class( TThread )
　　private
　　FSourceURL: string;
　　FSaveFileName: string;
　　FProgress,FProgressMax:Cardinal;
　　FOnProcess: TDownLoadProcessEvent;
　　FOnComplete: TDownLoadCompleteEvent;
　　FOnFail: TDownLoadFailEvent;
　　FMonitor: TDownLoadMonitor;
　　protected
　　procedure Execute; override;
　　procedure UpdateProgress(Progress, ProgressMax, StatusCode: Cardinal; StatusText:string);
　　procedure DoUpdateUI;
　　public
　　constructor Create( ASrcURL, ASaveFileName: string; AProgressEvent:TDownLoadProcessEvent = nil;
　　ACompleteEvent:TDownLoadCompleteEvent = nil;AFailEvent:TDownLoadFailEvent=nil;CreateSuspen ded: Boolean=False );
　　property SourceURL: string read FSourceURL;
　　property SaveFileName: string read FSaveFileName;
　　property OnProcess: TDownLoadProcessEvent read FOnProcess write FOnProcess;
　　property OnComplete: TDownLoadCompleteEvent read FOnComplete write FOnComplete;
　　property OnFail: TDownLoadFailEvent read FOnFail write FOnFail;
　　end;
　　implementation
　　constructor TDownLoadMonitor.Create(AThread: TFileDownLoadThread);
　　begin
　　inherited Create;
　　FThread:=AThread;
　　FShouldAbort:=False;
　　end;
　　function TDownLoadMonitor.GetBindInfo( out grfBINDF: DWORD; var bindinfo: TBindInfo ): HResult;
　　begin
　　result := S_OK;
　　end;
　　function TDownLoadMonitor.GetPriority( out nPriority ): HResult;
　　begin
　　Result := S_OK;
　　end;
　　function TDownLoadMonitor.OnDataAvailable( grfBSCF, dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium ): HResult;
　　begin
　　Result := S_OK;
　　end;
　　function TDownLoadMonitor.OnLowResource( reserved: DWORD ): HResult;
　　begin
　　Result := S_OK;
　　end;
　　function TDownLoadMonitor.OnObjectAvailable( const iid: TGUID; punk: IInterface ): HResult;
　　begin
　　Result := S_OK;
　　end;
　　function TDownLoadMonitor.OnProgress( ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR ): HResult;
　　begin
　　if FThreadnil then
　　FThread.UpdateProgress(ulProgress,ulProgressMax,ul StatusCode,'');
　　if FShouldAbort then
　　Result := E_ABORT
　　else
　　Result := S_OK;
　　end;
　　function TDownLoadMonitor.OnStartBinding( dwReserved: DWORD; pib: IBinding ): HResult;
　　begin
　　Result := S_OK;
　　end;
　　function TDownLoadMonitor.OnStopBinding( hresult: HResult; szError: LPCWSTR ): HResult;
　　begin
　　Result := S_OK;
　　end;
　　{ TFileDownLoadThread }
　　constructor TFileDownLoadThread.Create( ASrcURL, ASaveFileName: string;AProgressEvent:TDownLoadProcessEvent ;
　　ACompleteEvent:TDownLoadCompleteEvent;AFailEvent:T DownLoadFailEvent; CreateSuspended: Boolean );
　　begin
　　if (@AProgressEvent=nil) or (@ACompleteEvent=nil) or (@AFailEvent=nil) then
　　CreateSuspended:=True;
　　inherited Create( CreateSuspended );
　　FSourceURL:=ASrcURL;
　　FSaveFileName:=ASaveFileName;
　　FOnProcess:=AProgressEvent;
　　FOnComplete:=ACompleteEvent;
　　FOnFail:=AFailEvent;
　　end;
　　procedure TFileDownLoadThread.DoUpdateUI;
　　begin
　　if Assigned(FOnProcess) then
　　FOnProcess(Self,FProgress,FProgressMax);
　　end;
　　procedure TFileDownLoadThread.Execute;
　　var
　　DownRet:HRESULT;
　　begin
　　inherited;
　　FMonitor:=TDownLoadMonitor.Create(Self);
　　DownRet:= URLDownloadToFile( nil, PAnsiChar( FSourceURL ), PAnsiChar( FSaveFileName ), 0,FMonitor as IBindStatusCallback);
　　if DownRet=S_OK then
　　begin
　　if Assigned(FOnComplete) then
　　FOnComplete(Self);
　　end
　　else
　　begin
　　if Assigned(FOnFail) then
　　FOnFail(Self,DownRet);
　　end;
　　FMonitor:=nil;
　　end;
　　procedure TFileDownLoadThread.UpdateProgress(Progress, ProgressMax, StatusCode: Cardinal; StatusText: string);
　　begin
　　FProgress:=Progress;
　　FProgressMax:=ProgressMax;
　　Synchronize(DoUpdateUI);
　　if Terminated then
　　FMonitor.ShouldAbort:=True;
　　end;
　　end.
　　4.Delphi WinInet带进度下载Http文件