J
jamily
Unregistered / Unconfirmed
GUEST, unregistred user!
///源码如下,
{
//功能利用 idhttp indy组件多线程下载文件。
功能已实现,问题:下载的文件是原文件大小的好几倍,求解!
}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP, IdAntiFreezeBase, IdAntiFreeze,
IdThreadComponent;
type
TThread1 = class(TThread)
private
fCount, tstart, tlast: integer;
tURL, tFile, temFileName: string;
tResume: Boolean;
tStream: TFileStream;
protected
procedure Execute;
override;
public
constructor create1(aURL, aFile, fileName: string;
bResume: Boolean;
Count,
start, last: integer);
proceduredo
wnLodeFile();
//下载文件
end;
type
TForm1 = class(TForm)
ListBox1: TListBox;
ProgressBar1: TProgressBar;
Button1: TButton;
IdHTTP1: TIdHTTP;
Button2: TButton;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Label3: TLabel;
Label4: TLabel;
Button3: TButton;
IdAntiFreeze1: TIdAntiFreeze;
IdThreadComponent1: TIdThreadComponent;
procedure Button1Click(Sender: TObject);
procedure IdHTTP1Workbegin
(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure IdHTTP1Work(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure Button2Click(Sender: TObject);
procedure IdHTTP1Status(ASender: TObject;
const AStatus: TIdStatus;
const AStatusText: String);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
nn, aFileSize, avg: integer;
MyThread: array[1..10] of TThread;
procedure GetThread();
procedure AddFile();
function GetURLFileName(aURL: string): string;
function GetFileSize(aURL: string): integer;
end;
var
Form1: TForm1;
implementation
var
AbortTransfer: Boolean;
aURL, aFile: string;
tcount: integer;
//检查文件是否全部下载完毕
{$R *.dfm}
//得到下载文件名
function TForm1.GetURLFileName(aURL: string): string;
var
i: integer;
s: string;
begin
//返回下载地址的文件名
s := aURL;
i := Pos('/', s);
while i <> 0do
//去掉"/"前面的内容剩下的就是文件名了
begin
Delete(s, 1, i);
i := Pos('/', s);
end;
Result := s;
end;
//得到下载文件大小
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
tcount := 0;
Showmessage('OK!主线程在执行,获得文件名并显示在Edit2中');
aURL := Edit1.Text;
//下载地址
aFile := GetURLFileName(Edit1.Text);
//得到文件名
nn := StrToInt(Edit2.Text);
//线程数
j := 1;
aFileSize := GetFileSize(aURL);
avg := trunc(aFileSize / nn);
begin
try
GetThread();
while j <= nndo
begin
MyThread[j].Resume;
//唤醒线程
j := j + 1;
end;
except
Showmessage('创建线程失败!');
Exit;
end;
end;
end;
//开始下载前,将ProgressBar1的最大值设置为需要接收的数据大小.
procedure TForm1.IdHTTP1Workbegin
(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
AbortTransfer := False;
ProgressBar1.Max := AWorkCountMax;
ProgressBar1.Min := 0;
//ProgressBar1.Owner;
end;
//接收数据的时候,进度将在ProgressBar1显示出来.
procedure TForm1.IdHTTP1Work(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AbortTransfer then
begin
IdHTTP1.Disconnect;
//中断下载
end;
ProgressBar1.Position:=AWorkCount;
//ProgressBar1.;
//*******显示速度极快
Application.ProcessMessages;
//***********************************这样使用不知道对不对
end;
//中断下载
procedure TForm1.Button2Click(Sender: TObject);
begin
AbortTransfer := True;
IdHTTP1.Disconnect;
end;
//状态显示
procedure TForm1.IdHTTP1Status(ASender: TObject;
const AStatus: TIdStatus;
const AStatusText: String);
begin
ListBox1.ItemIndex := ListBox1.Items.Add(AStatusText);
end;
//退出程序
procedure TForm1.Button3Click(Sender: TObject);
begin
application.Terminate;
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 <= nndo
begin
start := avg * (i - 1);
last := avg * i -1;
//这里原先是last:=avg*i;
if i = nn then
begin
last := avg*i + aFileSize-avg*nn;
//这里原先是aFileSize
end;
fileName := aFile + IntToStr(i);
MyThread := TThread1.create1(aURL, aFile, fileName, false, i, start,
last);
i := i + 1;
end;
end;
procedure TForm1.AddFile();
//合并文件
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 <= nndo
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 <= nndo
begin
deletefile(afile + IntToStr(i));
i := i + 1;
end;
except
i:=1;
while i <= nndo
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;
end;
//构造函数
constructor TThread1.create1(aURL, aFile, fileName: string;
bResume: Boolean;
Count, start, last: integer);
begin
inherited create(true);
FreeOnTerminate := true;
tURL := aURL;
tFile := aFile;
fCount := Count;
tResume := bResume;
tstart := start;
tlast := last;
temFileName := fileName;
end;
//下载文件函数
procedure TThread1.DownLodeFile();
var
temhttp: TIdHTTP;
begin
temhttp := TIdHTTP.Create(nil);
temhttp.onWorkbegin
:= Form1.IdHTTP1Workbegin
;
temhttp.onwork := Form1.IdHTTP1work;
temhttp.onStatus := Form1.IdHTTP1Status;
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
temhttp.Request.ContentRangeStart := tstart;
temhttp.Request.ContentRangeEnd := tlast;
end;
try
temhttp.Get(tURL, tStream);
//开始下载
Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add(temFileName +
'download');
finally
//tStream.Free;
freeandnil(tstream);
temhttp.Disconnect;
end;
end;
procedure TThread1.Execute;
begin
if Form1.Edit1.Text <> '' then
//synchronize(DownLodeFile)
do
wnLodeFile
else
exit;
inc(tcount);
if tcount = Form1.nn then
//当tcount=nn时代表全部下载成功
begin
//Showmessage('全部下载成功!');
Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('正在合并删除临时文件');
Form1.AddFile;
end;
end;
end.
{
//功能利用 idhttp indy组件多线程下载文件。
功能已实现,问题:下载的文件是原文件大小的好几倍,求解!
}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP, IdAntiFreezeBase, IdAntiFreeze,
IdThreadComponent;
type
TThread1 = class(TThread)
private
fCount, tstart, tlast: integer;
tURL, tFile, temFileName: string;
tResume: Boolean;
tStream: TFileStream;
protected
procedure Execute;
override;
public
constructor create1(aURL, aFile, fileName: string;
bResume: Boolean;
Count,
start, last: integer);
proceduredo
wnLodeFile();
//下载文件
end;
type
TForm1 = class(TForm)
ListBox1: TListBox;
ProgressBar1: TProgressBar;
Button1: TButton;
IdHTTP1: TIdHTTP;
Button2: TButton;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Label3: TLabel;
Label4: TLabel;
Button3: TButton;
IdAntiFreeze1: TIdAntiFreeze;
IdThreadComponent1: TIdThreadComponent;
procedure Button1Click(Sender: TObject);
procedure IdHTTP1Workbegin
(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure IdHTTP1Work(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure Button2Click(Sender: TObject);
procedure IdHTTP1Status(ASender: TObject;
const AStatus: TIdStatus;
const AStatusText: String);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
nn, aFileSize, avg: integer;
MyThread: array[1..10] of TThread;
procedure GetThread();
procedure AddFile();
function GetURLFileName(aURL: string): string;
function GetFileSize(aURL: string): integer;
end;
var
Form1: TForm1;
implementation
var
AbortTransfer: Boolean;
aURL, aFile: string;
tcount: integer;
//检查文件是否全部下载完毕
{$R *.dfm}
//得到下载文件名
function TForm1.GetURLFileName(aURL: string): string;
var
i: integer;
s: string;
begin
//返回下载地址的文件名
s := aURL;
i := Pos('/', s);
while i <> 0do
//去掉"/"前面的内容剩下的就是文件名了
begin
Delete(s, 1, i);
i := Pos('/', s);
end;
Result := s;
end;
//得到下载文件大小
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
tcount := 0;
Showmessage('OK!主线程在执行,获得文件名并显示在Edit2中');
aURL := Edit1.Text;
//下载地址
aFile := GetURLFileName(Edit1.Text);
//得到文件名
nn := StrToInt(Edit2.Text);
//线程数
j := 1;
aFileSize := GetFileSize(aURL);
avg := trunc(aFileSize / nn);
begin
try
GetThread();
while j <= nndo
begin
MyThread[j].Resume;
//唤醒线程
j := j + 1;
end;
except
Showmessage('创建线程失败!');
Exit;
end;
end;
end;
//开始下载前,将ProgressBar1的最大值设置为需要接收的数据大小.
procedure TForm1.IdHTTP1Workbegin
(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
AbortTransfer := False;
ProgressBar1.Max := AWorkCountMax;
ProgressBar1.Min := 0;
//ProgressBar1.Owner;
end;
//接收数据的时候,进度将在ProgressBar1显示出来.
procedure TForm1.IdHTTP1Work(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AbortTransfer then
begin
IdHTTP1.Disconnect;
//中断下载
end;
ProgressBar1.Position:=AWorkCount;
//ProgressBar1.;
//*******显示速度极快
Application.ProcessMessages;
//***********************************这样使用不知道对不对
end;
//中断下载
procedure TForm1.Button2Click(Sender: TObject);
begin
AbortTransfer := True;
IdHTTP1.Disconnect;
end;
//状态显示
procedure TForm1.IdHTTP1Status(ASender: TObject;
const AStatus: TIdStatus;
const AStatusText: String);
begin
ListBox1.ItemIndex := ListBox1.Items.Add(AStatusText);
end;
//退出程序
procedure TForm1.Button3Click(Sender: TObject);
begin
application.Terminate;
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 <= nndo
begin
start := avg * (i - 1);
last := avg * i -1;
//这里原先是last:=avg*i;
if i = nn then
begin
last := avg*i + aFileSize-avg*nn;
//这里原先是aFileSize
end;
fileName := aFile + IntToStr(i);
MyThread := TThread1.create1(aURL, aFile, fileName, false, i, start,
last);
i := i + 1;
end;
end;
procedure TForm1.AddFile();
//合并文件
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 <= nndo
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 <= nndo
begin
deletefile(afile + IntToStr(i));
i := i + 1;
end;
except
i:=1;
while i <= nndo
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;
end;
//构造函数
constructor TThread1.create1(aURL, aFile, fileName: string;
bResume: Boolean;
Count, start, last: integer);
begin
inherited create(true);
FreeOnTerminate := true;
tURL := aURL;
tFile := aFile;
fCount := Count;
tResume := bResume;
tstart := start;
tlast := last;
temFileName := fileName;
end;
//下载文件函数
procedure TThread1.DownLodeFile();
var
temhttp: TIdHTTP;
begin
temhttp := TIdHTTP.Create(nil);
temhttp.onWorkbegin
:= Form1.IdHTTP1Workbegin
;
temhttp.onwork := Form1.IdHTTP1work;
temhttp.onStatus := Form1.IdHTTP1Status;
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
temhttp.Request.ContentRangeStart := tstart;
temhttp.Request.ContentRangeEnd := tlast;
end;
try
temhttp.Get(tURL, tStream);
//开始下载
Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add(temFileName +
'download');
finally
//tStream.Free;
freeandnil(tstream);
temhttp.Disconnect;
end;
end;
procedure TThread1.Execute;
begin
if Form1.Edit1.Text <> '' then
//synchronize(DownLodeFile)
do
wnLodeFile
else
exit;
inc(tcount);
if tcount = Form1.nn then
//当tcount=nn时代表全部下载成功
begin
//Showmessage('全部下载成功!');
Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('正在合并删除临时文件');
Form1.AddFile;
end;
end;
end.