//接收文件
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;
原文地址:https://www.cnblogs.com/sensoft/p/8462492.html