procedure TForm1.Button3Click(Sender: TObject);
begin
//application.Terminate;
IdHTTP1.DisconnectSocket;
Form1.close;
end;
//循环产生线程
procedure TForm1.GetThread();
var
i: integer;
start: array[1..100] of integer;
last: array[1..100] of integer; //改用了数组,也可不用
fileName: string;
begin
i := 1;
while i <= nn do
begin
start[i] := avg * (i - 1);
last[i] := avg * i -1; //这里原先是last:=avg*i;
if i = nn then
begin
last[i] := avg*i + aFileSize-avg*nn; //这里原先是aFileSize
end;
fileName := aFile + IntToStr(i);
MyThread[i] := TThread1.create1(aURL, aFile, fileName, false, i, start[i],
last[i]);
i := i + 1;
end;
end;
procedure TForm1.AddFile(); //合并文件
var
mStream1, mStream2: TMemoryStream;
i: integer;
begin
try
i := 1;
mStream1 := TMemoryStream.Create;
mStream2 := TMemoryStream.Create;
mStream1.loadfromfile(afile + '1');
while i < nn do
begin
mStream2.loadfromfile(afile + IntToStr(i + 1));
mStream1.seek(mStream1.size, soFromBeginning);
mStream1.copyfrom(mStream2, mStream2.size);
mStream2.clear;
i := i + 1;
end;
FreeAndNil(mStream2);
mStream1.SaveToFile(afile);
FreeAndNil(mStream1);
//删除临时文件
i:=1;
while i <= nn do
begin
deletefile(afile + IntToStr(i));
i := i + 1;
end;
Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下载成功');
except
i:=1;
while i <= nn do
begin
if FileExists(aFile+inttostr(i)) then
deletefile(afile + IntToStr(i));
i := i + 1;
end;
ShowMessage('下载文件出错,临时文件已删除,请重新下载!')
end;
end;
procedure TForm1.NewAddFile(); //合并文件
var
i: Integer;
InStream, OutStream : TFileStream;
SourceFile : String;
begin
try
i := 1;
OutStream:=TFileStream.Create(aFile,fmCreate);
//OutStream:=TFileStream.Create(('D\1\'+aFile),fmCreate); //此句与savedialog冲突,发生异常,使savedialog指定路径无效。
while i <= nn do
begin
SourceFile := afile + IntToStr(i);
InStream:=TFileStream.Create(SourceFile, fmOpenRead);
OutStream.CopyFrom(InStream,0);
FreeAndNil(InStream);
i:= i+1;
end;
FreeAndNil(OutStream);
//删除临时文件
i:=1;
while i <= nn do
begin
deletefile(afile + IntToStr(i));
i := i + 1;
end;
except
i:=1;
while i <= nn do
begin
if FileExists(aFile+inttostr(i)) then
deletefile(afile + IntToStr(i));
i := i + 1;
end;
end;
if FileExists(aFile) then
begin
FreeAndNil(OutStream);
InStream := TFileStream.Create(aFile, fmOpenWrite);
if InStream.Size < aFileSize then
begin
FreeAndNil(InStream);
deletefile(afile);
//ShowMessage('下载文件出错,临时文件已删除,请重新下载!')
Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下载文件出错,临时文件已删除,请重新下载!');
end
else
begin
FreeAndNil(InStream);
Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下在成功');
end;
end;
if tResume then //续传方式
begin
exit;
end
else //覆盖或新建方式
begin
temhttp.Request.ContentRangeStart := tstart;
temhttp.Request.ContentRangeEnd := tlast;
end;
try
///try
temhttp.Get(tURL, tStream); //开始下载
except
if FileExists(temFileName) then
begin
freeandnil(tstream);
deletefile(temFileName);//本来想用来删除未下完的文件,可惜不成功,有的线程没有删除,只有部分删除了,
//不过这样导致后面合并文件时出错,同样也可以把临时文件删除。
//ShowMessage('下载文件出错,临时文件已删除,请重新下载!');/
end;
temhttp.Disconnect;
end;
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;
//get FileSize
function TForm1.GetFileSize(aURL: string): integer;
var
FileSize: integer;
begin
IdHTTP1.Head(aURL);
FileSize := IdHTTP1.Response.ContentLength;
IdHTTP1.Disconnect;
Result := FileSize;
end;
//执行下载
procedure TForm1.Button1Click(Sender: TObject);
var
j: integer;
begin
//savedialog1.
try
time1 := Now;
tcount := 0;
aURL := Edit1.Text; //下载地址
if aURL = '' then
begin
MessageDlg('请输入下载地址!',mtError,[mbOK],0);
Exit;
end;
aFile := GetURLFileName(Edit1.Text); //得到文件名
savedialog1.FileName :=afile;
if savedialog1.Execute then
if Edit2.Text = '' then
begin
case MessageDlg('请输入线程数,最大支持10个线程,默认为单线程下载!', mtConfirmation, [mbYes, mbNo], 0) of
mrYes: nn:=1; //默认
mrNo: Exit; //重新输入
end;
end
else
nn := StrToInt(Edit2.Text); //线程数
if nn > 10 then
begin
raise MyException1.Create('输入超过线程限制数,请重新输入!');
end;
j := 1;
aFileSize := GetFileSize(aURL);
avg := trunc(aFileSize / nn);
begin
try
GetThread();
while j <= nn do
begin
MyThread[j].Resume; //唤醒线程
j := j + 1;
end;
except
Showmessage('创建线程失败!');
Exit;
end;
end;
except
on E:EConvertError do//捕捉内建的Econverterror异常
begin
//ShowMessage('请输入数字');
MessageDlg('请输入数字'+#13,mtError,[mbOK],0);
Exit;
end;
on E:MyException1 do//捕捉自定义的MyException异常
begin
MessageDlg(E.Message,mtError,[mbOK],0);
Edit2.Text:= '';
Exit;
end;
on E:EIdSocketError do//捕捉内建的EIdSocketError异常
begin
MessageDlg('连接不上服务器,或服务起未开启!',mtError,[mbOK],0);
Exit;
end;
on E:EIdConnectException do//捕捉内建的EIdSocketError异常
begin
MessageDlg('连接不上服务器,或服务起未开启!',mtError,[mbOK],0);
Exit;
end;
on E:EIdHTTPProtocolException do//捕捉内建的EIdSocketError异常
begin
MessageDlg('目标文件找不到!',mtError,[mbOK],0);
Exit;
end;
else
raise //reraise其他异常
procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AbortTransfer then
begin
//IdHTTP1.Disconnect; //中断下载
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i : integer;
begin
try
if AbortTransfer then
begin
i:=1;
while i <= nn do
begin
MyThread[i].Suspend;
i := i + 1;
end;
AbortTransfer := false;
button2.Caption:='开始';
end else
begin
i:=1;
while i <= nn do
begin
MyThread[i].Resume;
i := i + 1;
end;
AbortTransfer := True;
button2.Caption:='暂停';
end;
except
on E:EThread do
begin
end;
else
raise //reraise其他异常
end;
//IdHTTP1.Disconnect;
end;