为什么IDFTP放在线程里就连接不上服务器?

beginlove 2007-04-03 12:01:16
主代码如下:

unit Main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, StrUtils;

type
TFrm_Main = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
TFtp:array[1..5] of TThread;
function CreateDestFileUrl(dirs:TStringList;dirroot:string):string;
function UrlToFtpDir(Url:string):string;
function SplitString(const Source,ch:string):TStringList;
public
{ Public declarations }
end;

var
Frm_Main: TFrm_Main;

implementation

uses ThreadFTP;

{$R *.dfm}

function TFrm_Main.SplitString(const Source,ch:string):TStringList; //把一个字符串拆分成一个字符列表
var temp:String;
i:Integer;
begin
Result:=TStringList.Create;
try
if Source='' then exit;
temp:=Source;
i:=pos(ch,Source);
while i<>0 do
begin
Result.add(copy(temp,0,i-1));
Delete(temp,1,i);
i:=pos(ch,temp);
end;
Result.add(temp);
except
showmessage('分解字符出错'+Source);
end;
end;

function TFrm_Main.UrlToFtpDir(Url:string):string;
var i:integer;
begin
try
if Url='' then exit;
Url:=trim(Url);
i:=pos(':',Url);
Delete(Url,i,1);
Result:=AnsiReplaceText(Url,'\','/');
except
showmessage('转换出错');
end;
end;

function TFrm_Main.CreateDestFileUrl(dirs:TStringList;dirroot:string):string;
var i:integer;
DestFile:string;
begin
try
DestFile:=dirroot;
for i:=1 to dirs.Count-1 do
begin
DestFile:=DestFile+'\'+dirs.Strings[i];
end;
Result:=DestFile;
except
showmessage('获取目的文件路径出错');
end;
end;


procedure TFrm_Main.Button1Click(Sender: TObject);
var TIP,TUser,TPassword,TDfile,TDirroot,Url:string;
TPort:integer;
TDirs:TStringlist;
begin
TIP:='60.191.244.136';
TUser:='blues';
TPassword:='beginlove';
TPort:=210;
TDirroot:='E:';
Url:=UrlToFtpDir('G:\MOV_3\MOV\KB\SLEEPING_WITH_THE_DEAD\A.RM');
TDirs:=SplitString(Url,'/');
TDfile:=CreateDestFileUrl(TDirs,TDirroot);
TFtp[1]:=MyThreadFtp.Create(False,TIP,TPort,TUser,TPassword,TDirs,TDfile,TDirroot);
end;

end.
...全文
247 1 打赏 收藏 转发到动态 举报
写回复
用AI写文章
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
beginlove 2007-04-03
  • 打赏
  • 举报
回复
线程代码如下:

unit ThreadFTP;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdFTPCommon,IdComponent, IdTCPConnection, IdTCPClient,
IdFTP, StdCtrls, StrUtils;

type
MyThreadFtp = class(TThread)
private
fPort:integer;
fIP,fUser,fPassword,fDfile,fDirroot:string;
fDirs:TStringList;
fFtp:TIdFTP;
function FtpConnect(IP:string;Port:integer;User:string;Password:string):Boolean;
function FtpDisConnect():Boolean;
function FtpChangeDir(var Dirs:TStringList):Boolean;
function FtpGetFile(var Dirs:TStringList;Dfile:string;Dirroot:string):Integer;
{Result=0:下载成功
Result=1:服务器上文件获取出错
Result=2:服务器上文件不存在
Result=3:已经有完整的影片
Result=4:断点下载出错
Result=5:文件校验出错
Result=6:创建目录出错
Result=7:下载过程出错
Result=8:部分下载
Result=9:下载失败
}

function CreateDestFileUrl(Dirs:TStringList;Dirroot:string):string;
protected
procedure Execute; override;
procedure ReturnResult();
public
constructor Create(CreateSuspended:Boolean;IP:string;Port:integer;User:string;Password:string;Dirs:TStringList;Dfile:string;Dirroot:string);
published

end;

var n:integer;

implementation

uses Main;

constructor MyThreadFtp.Create(CreateSuspended:Boolean;IP:string;Port:integer;User:string;Password:string;Dirs:TStringList;Dfile:string;Dirroot:string);
begin
FreeOnTerminate:=true;
fIP:=IP;
fPort:=Port;
fUser:=User;
fPassword:=Password;
fDirs:=Dirs;
fDfile:=Dfile;
fDirroot:=Dirroot;
fFtp:=TIdFTP.Create(nil);
inherited Create(CreateSuspended);
end;

function MyThreadFtp.FtpConnect(IP:string;Port:integer;User:string;Password:string):Boolean;
begin
with fFtp do
try
Host:=IP;
Port:=Port;
Username:=User;
Password:=Password;
Passive:=True;
ASCIIFilter:=False;
TransferType:=ftBinary;
Connect;
except
Result:=False;
end;
Result:=True;
end;

function MyThreadFtp.FtpDisConnect():Boolean;
begin
try
fFtp.Disconnect;
except
Result:=False;
end;
Result:=True;
end;

function MyThreadFtp.FtpChangeDir(var Dirs:TStringList):Boolean;
var i:integer;
begin
for i:=0 to Dirs.Count-2 do
begin
try
fFTP.ChangeDir(Dirs.Strings[i]);
except
begin//改变目录时出错
Result:=False;
showmessage('改变目录时出错');
exit;
end;
end;
end;
Result:=True;
end;

function MyThreadFtp.FtpGetFile(var Dirs:TStringList;Dfile:string;Dirroot:string):Integer;
var tempath:string;
i:integer;
fs: TSearchRec;
FileSize,ResumeSize:longint;
begin
try
FileSize:=fFTP.Size(dirs.Strings[dirs.Count-1]);
if FileSize<1 then
begin
Result:=1;
showmessage('服务器上文件获取出错');
exit;
end;
except
begin
Result:=2;
showmessage('服务器上文件不存在');
exit;
end;
end;

if FindFirst(dfile,faAnyFile,fs)=0 then
begin //如果文件存在
ResumeSize:=FileSize-fs.Size;
FindClose(fs);
if ResumeSize=0 then
begin//已经有完整的影片
Result:=3;
exit;
end
else if ResumeSize>0 then
begin//断点下载
try
fFTP.Get(dirs.Strings[dirs.Count-1],dfile,false,true);
except
begin
Result:=4;
showmessage('断点下载出错');
exit;
end;
end;
end
else
begin//文件校验出错
Result:=5;
showmessage('文件校验出错');
exit;
end;
end
else //文件不存在
begin
tempath:=dirroot;
for i:=1 to dirs.Count-2 do
begin
tempath:=tempath+'\'+dirs.Strings[i];
try
CreateDir(tempath);
except //创建目录时出错
begin
Result:=6;
showmessage('创建目录时出错');
exit;
end;
end;
end;
try
fFTP.Get(dirs.Strings[dirs.Count-1],dfile);
except
begin
Result:=7;
showmessage('下载过程出错');
exit;
end;
end;
end;
//判断文件是否下载成功
if FindFirst(dfile,faAnyFile,fs)=0 then
begin
if fs.Size=FileSize then
Result:=0 //下载成功
else
Result:=8; //部分下载
FindClose(fs);
end
else
Result:=9; //下载失败
end;

function MyThreadFtp.CreateDestFileUrl(Dirs:TStringList;Dirroot:string):string;
var i:integer;
DestFile:string;
begin
try
DestFile:=Dirroot;
for i:=1 to Dirs.Count-1 do
begin
DestFile:=DestFile+'\'+Dirs.Strings[i];
end;
Result:=DestFile;
except
showmessage('获取目的文件路径出错');
end;
end;


{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure ThreadFtp.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }

{ ThreadFtp }

procedure MyThreadFtp.ReturnResult();
begin
Frm_Main.Label1.Caption:=inttostr(n);
end;

procedure MyThreadFtp.Execute;
begin
FtpConnect(fIP,fPort,fUser,fPassword);
FtpChangeDir(fDirs);
n:=FtpGetFile(fDirs,fDfile,fDirroot);
FtpDisConnect;
Synchronize(ReturnResult);
fFtp.Free;
end;

end.

本想实现多线程下载多个文件,但下载第一个就出现问题,同样的一些代码以主FORM 的 IDFTP 控件 就能实现,各位大侠帮忙看一下

1,593

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 网络通信/分布式开发
社区管理员
  • 网络通信/分布式开发社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧