delphi ftp下载文件问题

Posted 2023-05-04

begin
idFtp.Disconnect;
Try
With idFtp do
begin
if Not Connected then
begin
Host := '192.168.0.13 ';
Port := 21;
Username := 123;
Password := 123;
Connect;
end;
end;
Except
On E:Exception do
begin
Exit;
end;
end;
ChangeDir( 'd:\ ');
Get( 'd:\dd\ree\d.txt ', 'e:\', True);
end;
为什么总是执行到ChangeDir( 'd:\ ');时提示no such file or directory,请各位高手帮忙，谢谢！！

Delphi FTP例子源码

unit TransferThread;
////////////////////////////////////////////////////////////////////////////////
// 模块说明: FTP传输核心模块类
// 功能: 指定一个下载（上传)的日期或文件名，系统执行传输功能(支持续传）
// 备注：该模块属于传输类的一个子线程模块.
////////////////////////////////////////////////////////////////////////////////
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ComCtrls,StdCtrls,IniFiles,IdIntercept, IdLogBase, IdLogEvent, IdAntiFreezeBase,
IdAntiFreeze, IdFTPList,IdBaseComponent,IdGlobal,IdComponent, IdTCPConnection, IdTCPClient,IdFTPCommon,
IdFTP;

type

TTransferThread = class(TObject)
private
Private declarations
//进度显示
FProgressbar:TProgressbar;
//上传核心组件
FFTP:TIdFTP;
//上传列表内部类
FCombobox:TCombobox;
//上传信息显示
FLabel:TLabel;
//FTP地址
FFTP_STR_HOST:String;
//FTP用户名
FFTP_STR_USN:String;
//FTP用户密码
FFTP_STR_PWD:String;
//FTP端口
FFTP_STR_PORT:String;
//FTP上传标记
FFTP_STR_UTAG:String;
//FTP下载标记
FFTP_STR_DTAG:String;
//FTP指定的文件夹
FFTP_STR_FLODER:STring;
//传输文件大小
FFTP_LWD_BYTES:LongWord;
//传输开始时间
FFTP_DT_BEGINTIME:TDateTime;
//传输速度
FFTP_DUB_SPEED:Double;
//是否删除源文件.
FFTP_BOL_DEL:Boolean;
//是否正在传输文件
FFTP_BOL_ISTRANSFERRING:Boolean;

//类内部通用对话框函数
function MsgBox(Msg:string;iValue:integer):integer;
//获取用户当前的Windows临时文件夹
function GetWinTempPath:String;
//根据日期生成的日期文件名
function DateToFileName(DateTime:TDateTime):String;
//根据上传/下载标记生成完整的文件名
function GetFileFullName(sTag:String;DateTime:TDateTime):String;
protected
//传输核心函数
function TransferKernel(iTag:Integer;sFile:string;bDelSFile:boolean=False):boolean;
//传输组件的WorkBegin事件
procedure FFTPOnWorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
//传输组件的WorkEnd事件
procedure FFTPOnWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
//传输组件的Work事件
procedure FFTPOnWork(Sender: TObject; AWorkMode: TWorkMode;const AWorkCount: Integer);
public
//构造函数
constructor Create;
//析构函数
destructor Destroy;
//进度条控件属性
property Progressbar:TProgressbar read FProgressbar write FProgressbar default nil;
//列表控件属性
property Combobox:TCombobox read FCombobox write FCombobox default nil;
//只读的FTP核心组件
property FTP:TidFTP read FFTP;
//标签控件
property oLabel:TLabel read FLabel write FLabel default nil;
//列表方法(该方法需要指定Combobox,否则无效）
procedure List;
//依据日期下载文件
procedure DownLoad(dDate:TDateTime);overload;
//依据文件名下载文件
procedure DownLoad(sFileName:String);overload;
//依据日期上传文件
procedure UpLoad(dDate:TDateTime);overload;
//依据文件名上传文件
procedure UpLoad(sFileName:String);overload;

// procedure Execute; override;
end;

implementation

constructor TTransferThread.Create;
var
FFini:TIniFile;
FFilePath:String;
begin
//完成FTP相关参数的读取.
FFTP_BOL_ISTRANSFERRING:=False;
Try
FFilePath:=ExtractFilePath(APPlication.exeName)+'setup.ini';
FFini:=TIniFile.Create(FFilePath);
FFTP_STR_HOST:=FFini.ReadString('文件传输','服务器地址','');
FFTP_STR_PORT:=FFini.ReadString('文件传输','服务器端口','');
FFTP_STR_USN:=FFini.ReadString('文件传输','用户名','');
FFTP_STR_PWD:=FFini.ReadString('文件传输','密码','');
FFTP_STR_FLODER:=FFini.ReadString('文件传输','文件夹','');
FFTP_STR_UTAG:=FFini.ReadString('文件传输','上传标识码','');
FFTP_STR_DTAG:=FFini.ReadString('文件传输','上传标识码','');
FFTP_BOL_DEL:=FFini.ReadBool('文件传输','删源文件',FALSE);
FFIni.Free;
Except
MsgBox('读取FTP连接配置信息失败!请检查您的Setup.ini文件.',MB_OK+MB_ICONERROR);
Exit;
Abort;
End;
//设置FTP相关参数
Try
FFTP:=TIdFTP.Create(nil);
FFTP.Host:=FFTP_STR_HOST;
FFTP.Port:=strtoint(FFTP_STR_PORT);
FFTP.UserName:=FFTP_STR_USN;
FFTP.Password:=FFTP_STR_PWD;
FFTP.TransferType:=ftASCII;
//事件驱动
FFTP.OnWork:=FFTPOnWork;
FFTP.OnWorkBegin:=FFTPOnWorkBegin;
FFTP.OnWorkEnd:=FFTPOnWorkEnd;
FFTP.Connect(True,-1);
Except
MsgBox('连接远程FTP服务器失败!'#10#13'1.服务器地址错误,或服务器不可用.'#10#13'2.用户名或密码不正确.'#10#13'3.FTP服务端口设置不正确.',MB_OK+MB_ICONERROR);
Exit;
Abort;
End;

end;

function TTransferThread.DateToFileName(DateTime: TDateTime): String;
var
Year, Month, Day:Word;
sYear,sMonth,sDay:String;
begin
DecodeDate(DateTime, Year, Month, Day); //日期
sYear:=inttostr(Year);
sMonth:=inttostr(Month);
sDay:=inttostr(Day);
//年
case Length(sYear) of
4: sYear:=sYear;
3: sYear:='0'+sYear;
2: sYear:='00'+sYear;
1: sYear:='000'+sYear;
else
sYear:='';
end;
//月
case Length(sMonth) of
2: sMonth:=sMonth;
1: sMonth:='0'+sMonth;
else
sMonth:='';
end;
//日
case Length(sDay) of
2: sDay:=sDay;
1: sDay:='0'+sDay;
else
sDay:='';
end;
if (sYear='') or (sMonth='') or (sDay='') then
begin
Result:='';
Exit;
end;
if (sYear<>'') and (sMonth<>'') and (sDay<>'') then
begin
Result:=sYear+sMOnth+sDay;
end;
end;

destructor TTransferThread.Destroy;
begin
FProgressbar:=nil;
FCombobox:=nil;
FLabel:=nil;
FFTP.Quit;
FFTP.Free;
end;

procedure TTransferThread.DownLoad(dDate: TDateTime);
begin
if Not FFTP_BOL_ISTRANSFERRING then
begin
TransferKernel(1,GetFileFullName(FFTP_STR_DTAG,dDate),FFTP_BOL_DEL);
end;
end;

procedure TTransferThread.DownLoad(sFileName: String);
begin
if Not FFTP_BOL_ISTRANSFERRING then
TransferKernel(1,sFileName,FFTP_BOL_DEL);
end;

procedure TTransferThread.FFTPOnWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
var
S,E: String;
H, M, Sec, MS: Word;
TotalTime: TDateTime;
DLTime: Double;
begin
TotalTime := Now - FFTP_DT_BEGINTIME; //总用时
DecodeTime(TotalTime, H, M, Sec, MS); //取出时\分\秒\毫秒
Sec := Sec + M * 60 + H * 3600; //转换成秒
DLTime := Sec + MS / 1000; //最终的下载时间
E:= Format(' 使用时间:%2d:%2d:%2d', [Sec div 3600, (Sec div 60) mod 60, Sec mod 60]);
if DLTime > 0 then
//每秒的平均速度:XX K/s
FFTP_DUB_SPEED := (AverageSpeed + (AWorkCount / 1024) / DLTime) / 2;

if FFTP_DUB_SPEED > 0 then
begin
Sec := Trunc(((FFTP_LWD_BYTES - AWorkCount) / 1024) / FFTP_DUB_SPEED);
S := Format(' 剩余时间:%2d:%2d:%2d', [Sec div 3600, (Sec div 60) mod 60, Sec mod 60]);
S:='速度: ' + FormatFloat('0.00 KB/秒',FFTP_DUB_SPEED) + S + E ;
end
else
S:='';
if (FLabel<>nil) and (assigned(FLabel)) then
begin
FLabel.AutoSize:=True;
FLabel.Caption:=S;
FLabel.Update;
end;
if (FProgressBar<>nil) and (assigned(FProgressBar)) then
begin
FProgressBar.Position:=AWorkCount; //进度显示
FProgressBar.Update;
end;
end;

procedure TTransferThread.FFTPOnWorkBegin(Sender: TObject;
AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
FFTP_BOL_ISTRANSFERRING:=True;
FFTP_DT_BEGINTIME:=Now; //开始时间
FFTP_DUB_SPEED:=0.0; //初始化速率
if (FProgressBar<>nil) and (assigned(FProgressBar)) then
begin
if AWorkCountMax>0 then
begin
FProgressBar.Max:=AWorkCountMax;
FFTP_LWD_BYTES:=FProgressBar.Max;
end
else
FProgressBar.Max:=FFTP_LWD_BYTES;
end;
end;

procedure TTransferThread.FFTPOnWorkEnd(Sender: TObject;
AWorkMode: TWorkMode);
begin
FFTP_BOL_ISTRANSFERRING:=False;
FFTP_DUB_SPEED:=0.00;
if (FLabel<>nil) and (assigned(FLabel)) then
begin
FLabel.AutoSize:=True;
FLabel.Caption:='';
FLabel.Update;
end;

if (FProgressBar<>nil) and (assigned(FProgressBar)) then
begin
FProgressBar.Position:=0;
end;
end;

function TTransferThread.GetFileFullName(sTag:String;DateTime:TDateTime):String;
begin
Result:=sTag+DateToFileName(DateTime)+'FD.HXD';
end;

function TTransferThread.GetWinTempPath: String;
var
TempDir:array [0..255] of char;
begin
GetTempPath(255,@TempDir);
Result:=strPas(TempDir);
end;

procedure TTransferThread.List;
var
Dir_List:TStringList;
FoundFolder:Boolean;
iCount:Integer;
begin
if (FCombobox=nil) or (Not Assigned(FCombobox)) then
begin
Exit;
Abort;
end;
Dir_List:=TStringList.Create; //创建字符串列表类
Try
if Not FFTP.Connected then FFTP.Connect;
FFTP.ChangeDir('/');//根目录 //到服务器的根目录
FFTP.List(Dir_List,'',True); //获取目录列表
FoundFolder:=False;
FFTP.TransferType:=ftASCII; //更改传输类型(ASCII类型)
for iCount:=0 to Dir_List.Count-1 do
begin
if FFTP.DirectoryListing.Items[iCount].ItemType=ditDirectory then
begin
if Dir_List.IndexOf(FFTP_STR_FLODER)= -1 then //判断该文件夹不存在
begin
//如果不存继续循环查找.
Continue;
end
else
begin
//如果存在,则直接退出循环
FoundFolder:=True;
Break;
end;
end;
end;

if FoundFolder then //判断该文件夹不存在
begin
FFTP.MakeDir(FFTP_STR_FLODER); //不存在，则创建一个新的文件夹
end;

FFTP.ChangeDir(FFTP_STR_FLODER);
FFTP.List(Dir_List,'*.HXD',False);
if Dir_List.Count>0 then
begin
FCombobox.Items:=Dir_List;
end;
Finally
Dir_List.Free;
End;
end;

function TTransferThread.MsgBox(Msg: string; iValue: integer): integer;
begin
Result:=MessageBox(application.Handle,pChar(Msg),'系统信息',iValue+MB_APPLMODAL);
end;

function TTransferThread.TransferKernel(iTag: Integer; sFile: string;
bDelSFile: boolean): boolean;
var
sTmpPath:String;
Dir_List:TStringList;
FoundFolder:Boolean;
iCount:Integer;
begin
sTmpPath:=GetWinTempPath; //获取本地系统临时目录
Dir_List:=TStringList.Create; //创建字符串列表类
Try
if Not FFTP.Connected then FFTP.Connect;
FFTP.ChangeDir('/');//根目录 //到服务器的根目录
FFTP.TransferType:=ftASCII; //更改传输类型(ASCII类型)
FFTP.List(Dir_List,'',True); //获取目录列表
FoundFolder:=False;
for iCount:=0 to Dir_List.Count-1 do
begin
if FFTP.DirectoryListing.Items[iCount].ItemType=ditDirectory then //是目录
begin
if Dir_List.IndexOf(FFTP_STR_FLODER)= -1 then //判断该文件夹不存在
begin
//如果不存继续循环查找.
Continue;
end
else
begin
//如果存在,则直接退出循环
FoundFolder:=True;
Break;
end;
end;
end;

if FoundFolder then //判断该文件夹不存在
begin
FFTP.MakeDir(FFTP_STR_FLODER); //不存在，则创建一个新的文件夹
end;

//更改传输类型
FFTP.TransferType:=ftBinary;

Try
//找到相应的目录,则更换路径.
FFTP.ChangeDir(FFTP_STR_FLODER);
//0为上传
if iTag=0 then
begin
Try
FFTP.Put(sTmpPath+sFile,sFile);
Except
MsgBox('上传文件失败！原因如下:'#13#10'1.服务器没有开启写文件的权限!'#10#13'2.程序发生异常，请重新上传！',MB_OK+MB_ICONERROR);
Abort;
End;
FFTP_LWD_BYTES:=FFTP.Size(sFile);
if bDelSFile then //删除本地源文件
begin
DeleteFile(sTmpPath+sFile);
end;
Result:=True;
FFTP.Disconnect;
end;
//1为下载
if iTag=1 then
begin
//文件已经存在
Try
FFTP_LWD_BYTES:=FFTP.Size(sFile);
if FileExists(sTmpPath+sFile) then
begin
case MsgBox('文件已经存在，要续传吗？'#13#10'是--续传'#10#13'否--覆盖'#13#10'取消--取消操作',MB_YESNOCANCEL+MB_ICONINFORMATION) of
IDYES: begin
FFTP_LWD_BYTES:=FFTP_LWD_BYTES-FileSizeByName(sTmpPath+sFile);
//参数说明: 源文件，目标文件,是否覆盖,是否触发异常（True为不触发)。
FFTP.Get(sFile,sTmpPath+sFile,False,True);
end;
IDNO: begin
FFTP.Get(sFile,sTmpPath+sFile,True);
end;
IDCANCEL:
begin
FFTP_BOL_ISTRANSFERRING:=False;
end;
end;
end
else //文件不存在
begin
FFTP.Get(sFile,sTmpPath+sFile,True);
end;
Except
MsgBox('上传文件失败！原因如下:'#13#10'1.服务器没有开启写文件的权限!'#10#13'2.程序发生异常，请重新上传！',MB_OK+MB_ICONERROR);
Abort;
End;
if bDelSFile then //删除远程源文件
begin
FFTP.Delete(sFile);
end;
FFTP.Disconnect;
end;
Except
FFTP.Quit;
Result:=False;
End;
Finally
Dir_List.Free;
End;
end;

procedure TTransferThread.UpLoad(dDate: TDateTime);
begin
if Not FFTP_BOL_ISTRANSFERRING then
TransferKernel(0,GetFileFullName(FFTP_STR_DTAG,dDate),FFTP_BOL_DEL);
end;

procedure TTransferThread.UpLoad(sFileName: String);
begin
if Not FFTP_BOL_ISTRANSFERRING then
TransferKernel(0,sFileName,FFTP_BOL_DEL);
end;

end. 参考技术A 参考例子
http://www.cnblogs.com/DxSoft/archive/2010/02/08/1666100.html 参考技术B 什么问题？

用delphi实现ftp多线程下载源代码(转)

//接收文件 
function TForm1.GetURLFileName(aURL: string): string; 
var 
i: integer; 
s: string; 
begin //返回下载地址的文件名 
s := aURL; 
i := Pos(‘/‘, s); 
while i <> 0 do //去掉"/"前面的内容剩下的就是文件名了 
begin 
Delete(s, 1, i); 
i := Pos(‘/‘, s); 
end; 
Result := s; 
end; 

//得到文件大小 
function TForm1.GetFileSize(aURL: string): integer; 
var 
FileSize : integer; 
tStream: TFileStream; 
FileName: String; 
begin 
//tStream.size := 0; 
IdFTP1.StructureMount(aURL);********************************不知道用的对不对? 
//FileSize := IdFTP1.Response.ContentLength; 
FileSize := IdFTP1.size(FileName); 
//FileSize := IdFTP1.ContentLength(FileName); 
IdFTP1.Abort; 
Result := FileSize; 

end; 


//多线程下载 
procedure TForm1.Button11Click(Sender: TObject); 
var 
m:integer; 
begin 
Showmessage(‘OK!主线程在执行，获得文件名并显示在Edit5中‘); 
aURL := Edit4.Text; //ftp方式下载地址 
aFile := GetURLFileName(Edit4.Text);//得到文件名 
xx:= StrToInt(Edit5.Text); //输入的线程数 
m:=1; 
aFileSize := GetFileSize(aURL); 
avg := trunc(aFileSize/xx); 
try 
GetThread(); 
while m<=xx do 
begin 
MyThread[m].Resume; //唤醒线程 
m :=m+1; 
end; 
except 
Showmessage(‘创建线程失败!‘); 
Exit; 
end; 
end; 

//开始下载前,将ProgressBar1的最大值设置为需要接收的数据大小.******************* 
procedure TForm1.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; 
const AWorkCountMax: Integer); 
begin 
AbortTransfer := False; 
ProgressBar1.Max:=AWorkCountMax; 
ProgressBar1.Min:=0; 
ProgressBar1.Position:=0; 
end; 

//状态显示 
procedure TForm1.IdFTP1Status(ASender: TObject; const AStatus: TIdStatus; 
const AStatusText: String); 
begin 
ListBox1.ItemIndex := ListBox1.Items.Add(AStatusText); 
end; 

// 多线程的产生 
procedure TForm1.GetThread(); 
var 
i ,start,last : integer; 
FileName : String; 
begin 
i:=1; 
while i<=xx do 
begin 
if i=1 then 
begin 
start := 0; 
last := avg*i; 
end 
else 
start := avg*(i-1); 
last := avg*i; 
FileName:=aFile+IntToStr(i); 
MyThread[i]:=TThread1.create(aURL, aFile,FileName, false , i,start,last); 
i :=i+1; 
end; 
end; 

//构造函数 
constructor TThread1.create(aURL, aFile,FileName: String; bResume: Boolean ;Count,start,last:integer); 
begin 
inherited create(true); 
FreeOnTerminate := true; 
tURL := aURL; 
tFile := aFile; 
tCount := Count; 
tResume := bResume; 
tstart :=start; 
tlast :=last; 
temFileName:= FileName; 
end; 

//下载文件函数 
procedure TThread1.DownLodeFile(); 
var 
//ftp: TIdFTP; 
TIdFTP1 : TIdFTP; 
tStream: TFileStream; 
begin 
TIdFTP1 := TIdFTP.Create(nil); 
Form1.IdAntiFreeze1.OnlyWhenIdle:=False;//设置使程序有反应 
if FileExists(temFileName) then //如果文件已经存在 
tStream := TFileStream.Create(temFileName, fmOpenWrite) else 
tStream := TFileStream.Create(temFileName, fmCreate); 

if tResume then //续传方式 
begin 
exit; 
end else //覆盖或新建方式 
begin 
TIdFTP1.MaxLineLength := tstart;(不对)********************文件下载的开始位置用TIdFTP什么属性来设置? 
TIdFTP1.MinLineLength := tlast;(不对)*********************文件下载的结束位置用TIdFTP什么属性来设置? 


end; 
try 
//TIdFTP1.Get(temFileName,tStream,true); //开始下载 
TIdFTP1.Get(tURL,tStream); //开始下载 
Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add(temFileName+‘download‘); 
finally 
tStream.Free; 
end; 
end; 

procedure TThread1.Execute; 
begin 
if Form1.Edit4.Text<>‘‘ then 
synchronize(DownLodeFile) 
else 
exit; 
end;