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

Posted 2020-10-25 sensoft

//接收文件 
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;