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

  • 主题发起人 主题发起人 王思佳
  • 开始时间 开始时间

王思佳

Unregistered / Unconfirmed
GUEST, unregistred user!
敬请高手指点迷津!我送上100分,我多谢了!
//接收文件
function TForm1.GetURLFileName(aURL: string): string;
var
i: integer;
s: string;
begin
//返回下载地址的文件名
s := aURL;
i := Pos('/', s);
while i <> 0do
//去掉&quot;/&quot;前面的内容剩下的就是文件名了
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;(IdFTP1的属性不对)***********怎么得到(IdFTP1从aURL里下载的文件内容的大小)
//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<=xxdo
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<=xxdo
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:=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;
 
我这个是多线程下载的,不过没有做全,你可以看看unit IEDownload;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ScktComp;
type
Tbufchar=array[0..4095] of char;
Tbufbyte=array[0..4095] of byte;
type
TFileData=Record
FileName:String;
Filebegin
Pos:Integer;
end;
type
TIEDownloadThread=Class(TThread)
private
FClientSocket:TClientSocket;
FRecLength:Integer;
FRelRecLength:Integer;
FTotalLength:Integer;
FPos:Integer;
FBufByte:Tbufbyte;
FBufChar:Tbufchar;
FUrlHost:String;
FUrlFile:String;
FFileName:String;
FUrl:String;
FCanReceive:Bool;
do
wnLoadFile:file;
FThreadIndex:Integer;
FThreadCount:Integer;
FFilePosbegin
:Integer;
FFilePosEnd:Integer;
procedure SetRecLength(const Value: Integer);
procedure SetRelRecLength(const Value: Integer);
procedure SetPos(const Value: Integer);
procedure SetUrlFile(const Value: String);
procedure SetUrlHost(const Value: String);
procedure SetCanReceive(const Value: Bool);
procedure SetTotalLength(const Value: Integer);
procedure SetFileName(const Value: String);
procedure SetThreadIndex(const Value: Integer);
procedure SetFilePosbegin
(const Value: Integer);
procedure SetFilePosEnd(const Value: Integer);
procedure SetThreadCount(const Value: Integer);
procedure GetFilePos();
procedure GetRecLength();
procedure GetFilePosbegin
End();
procedure SetUrl(const Value: String);
function BeforeDownLoad():Bool;
Procedure begin
DownLoad(FilePosbegin
, FilePosEnd: Integer);
Procedure AfterDownLoad();
procedure Execute();
override;
procedure DisPlayMessage(MessageStr:String);
function InitSocket():Boolean;
function FinalSocket():Boolean;
constructor Create(ThreadIndex,ThreadCount:integer);
protected
FileData:TFileData;
public
property TotalLength:Integer read FTotalLength write SetTotalLength;
property RecLength:Integer read FRecLength write SetRecLength;
property RelRecLength:Integer read FRelRecLength write SetRelRecLength;
property FilePos:Integer read FPos write SetPos;
property UrlFile:String read FUrlFile write SetUrlFile;
property UrlHost:String read FUrlHost write SetUrlHost;
property ClientSocket:TClientSocket read FClientSocket write FClientSocket;
property CanReceive:Bool read FCanReceive write SetCanReceive;
property FileName:String read FFileName write SetFileName;
property Url:String read FUrl write SetUrl;
property ThreadIndex:Integer read FThreadIndex write SetThreadIndex;
property ThreadCount:Integer read FThreadCount write SetThreadCount;
property FilePosbegin
:Integer read FFilePosbegin
write SetFilePosbegin
;
property FilePosEnd:Integer read FFilePosEnd write SetFilePosend;
end;

type
TIEDownload=Class
private
FClientSocket:TClientSocket;
FUrlHost:String;
FUrlFile:String;
FFileName:String;
FTotalLength:Integer;
FBufByte:Tbufbyte;
FBufChar:Tbufchar;
procedure SetFileName(const Value: String);
procedure SetTotalLength(const Value: Integer);
procedure SetUrlFile(const Value: String);
procedure SetUrlHost(const Value: String);
procedure GetUrlHost(Url:String);
procedure GetUrlFile(Url:String);
procedure GetFileName(Url:String);
procedure GetTotalLength();
procedure DisPlayMessage(MessageStr:String);
function InitSocket():Boolean;
function FinalSocket():Boolean;
protected
public
property UrlFile:String read FUrlFile write SetUrlFile;
property UrlHost:String read FUrlHost write SetUrlHost;
property FileName:String read FFileName write SetFileName;
property TotalLength:Integer read FTotalLength write SetTotalLength;
property ClientSocket:TClientSocket read FClientSocket write FClientSocket;
procedure Start(URL:String);
procedure Stop;
procedure CreateFile;
end;

var
do
wnload:TIEDownload;
do
wnloadThread:Array[1..5] of TIEDownloadThread;
implementation
uses
U_DOWNLOAD;
{ TIEDownloadThread }
////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////IE多线程下载///////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
//----------------------------------------------------------------------系统结束
function TIEDownloadThread.FinalSocket: Boolean;
begin
Result:=False;
try
if Assigned(FClientSocket) then
FClientSocket.Free;
Result:=True;
except
end;
end;

//--------------------------------------------------------------------系统初始化
function TIEDownloadThread.InitSocket: Boolean;
begin
Result:=False;
try
if Not Assigned(FClientSocket) then
FClientSocket:=TClientSocket.Create(nil);
FClientSocket.ClientType:=ctBlocking;
Result:=True;
except
end;
end;

//----------------------------------------------------------------取得文件的位置
procedure TIEDownloadThread.GetFilePos;
begin
AssignFile(DownLoadFile,'C:/DOWNLOAD/'+IntToStr(ThreadIndex)+'-'+FileName);
if FileExists('C:/DOWNLOAD/'+IntToStr(ThreadIndex)+'-'+FileName)=True then
begin
Reset(DownLoadFile,1);
FilePos:=FileSize(DownLoadFile);
end else
begin
rewrite(DownLoadFile,1);
FilePos:=0;
end;
Seek(DownLoadFile,FilePos);
DisPlayMessage('线程编号:'+inttostr(ThreadIndex)+'文件开始位置:'+inttostr(FilePos));
end;

//--------------------------------------------------------取得文件应该下载的大小
procedure TIEDownloadThread.GetRecLength;
var
UrlStr:String;
RecLengthOnce:Integer;
FStringStream:TStringStream;
FSocketStream: TWinSocketStream;
begin
if InitSocket then
begin
If Not Assigned(ClientSocket) then
begin
Exit;
end;
CanReceive:=False;
RecLength:=0;
ClientSocket.Active:=False;
ClientSocket.Host:=UrlHost;
ClientSocket.Port:=80;
ClientSocket.Active:=True;
UrlStr:='';
UrlStr:=UrlStr+'GET /'+UrlFile+' HTTP/1.1'+#13#10;
UrlStr:=UrlStr+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
UrlStr:=UrlStr+'Pragma: no-cache'+#13#10;
UrlStr:=UrlStr+'Cache-Control: no-cache'+#13#10;
UrlStr:=UrlStr+'User-Agent: Mozilla/4.0 (compatible;
MSIE 6.0;
Windows NT 5.1;
.NET CLR 1.0.3705)'+#13#10;
UrlStr:=UrlStr+'RANGE: bytes='+inttostr(0)+'-'+#13#10;
UrlStr:=UrlStr+'Host: '+UrlHost+#13#10;
UrlStr:=UrlStr+#13#10;
ClientSocket.Socket.SendText(UrlStr);
RelRecLength:=0;
FStringStream:=TStringStream.Create('');
FSocketStream:=TWinSocketStream.create(ClientSocket.Socket, 60*1000);
//------------------------------------------取得是否可以下载和要接受的文件的大小
While ClientSocket.Activedo
begin
ZeroMemory(@FBufChar,SizeOf(FBufChar));
RecLengthOnce:=FsocketStream.Read(FBufChar, 1);
if RecLengthOnce=0 then
Break;
FStringStream.Write(FBufChar,RecLengthOnce);
if Pos(#13#10,FStringStream.DataString)<>0 then
begin
if Pos('Content-Length:',FStringStream.DataString)>0 then
begin
RecLength:=StrToInt(Trim(Copy(FStringStream.DataString,Pos(':',FStringStream.DataString)+1,Pos(#13#10,FStringStream.DataString)-Pos(':',FStringStream.DataString)+1)));
end;

if Pos('Content-Range:',FStringStream.DataString)>0 then
begin
CanReceive:=True;
end;
if FStringStream.DataString=#13#10 then
begin
FSocketStream.Free;
FStringStream.Free;
Break;
end;
FStringStream.Free;
FStringStream:=TStringStream.Create('');
end;
end;
end;
end;

//--------------------------------------------------得到文件下载的开始和结束位置
procedure TIEDownloadThread.GetFilePosbegin
end;
var
BufCount:Integer;
BufLeft:Integer;
ThreadBufCount:Integer;
ThreadBufCountLeft:Integer;
I:Integer;
begin
FilePosbegin
:=0;
FilePosEnd:=0;
BufCount:=TotalLength Div Length(FBufByte);
BufLeft:=TotalLength Mod Length(FBufByte);
if BufCount>=5 then
//------------------------------------------------数据块>=5
begin
ThreadBufCount:=BufCount Div 5;
ThreadBufCountLeft:=BufCount Mod 5;
if ThreadBufCountLeft=0 then
begin
if ThreadIndex=5 then
begin
FilePosbegin
:=FilePos+(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadIndex*ThreadBufCount*Length(FBufByte)+BufLeft-1;
end else
begin
FilePosbegin
:=FilePos+(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadIndex*ThreadBufCount*Length(FBufByte)-1;
end;
end else
begin
for i:=1 to ThreadBufCountLeftdo
begin
if ThreadIndex=I then
begin
FilePosbegin
:=FilePos+(ThreadIndex-1)*(ThreadBufCount+1)*Length(FBufByte);
FilePosEnd:=ThreadIndex*(ThreadBufCount+1)*Length(FBufByte)-1;
end;
end;
for I:=ThreadBufCountLeft+1 to 5do
begin
if ThreadIndex=I then
begin
if ThreadIndex=5 then
begin
FilePosbegin
:=FilePos+
ThreadBufCountLeft*Length(FBufByte)+
(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadBufCountLeft*Length(FBufByte)+
ThreadIndex*ThreadBufCount*Length(FBufByte)+
BufLeft-1;
end else
begin
FilePosbegin
:=FilePos+
ThreadBufCountLeft*Length(FBufByte)+
(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadBufCountLeft*Length(FBufByte)+
ThreadIndex*ThreadBufCount*Length(FBufByte)-1;
end;
end;
end;
end;
end else
//------------------------------------------------------------数据块<5
begin
if BufCount=0 then
begin
if ThreadIndex=1 then
begin
FilePosbegin
:=FilePos;
FilePosEnd:=BufLeft-1;
end;
end;

for i:=1 to BufCountdo
begin
if ThreadIndex=I then
begin
if ThreadIndex=BufCount then
begin
FilePosbegin
:=FilePos+(I-1)*Length(FBufByte);
FilePosEnd:=I*Length(FBufByte)+BufLeft-1;
end else
begin
FilePosbegin
:=FilePos+(I-1)*Length(FBufByte);
FilePosEnd:=I*Length(FBufByte)-1;
end;
end;
end;
end;
DisPlayMessage('线程编号:'+inttostr(threadindex)
+'文件开始位置:'+inttostr(FilePosbegin
)
+'文件结束位置:'+inttostr(FilePosEnd)
+' '+inttostr(ThreadBufCount)
+' '+inttostr(ThreadBufCountLeft));
end;

constructor TIEDownloadThread.Create(ThreadIndex,ThreadCount:integer);
begin
FThreadIndex:=ThreadIndex;
FThreadCount:=ThreadCount;
Inherited Create(true);
end;

procedure TIEDownloadThread.Execute;
begin
inherited;
if Not BeforeDownLoad then
Exit;
if FilePosbegin
>=FilePosEnd then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
begin
DownLoad(FilePosbegin
,FilePosEnd);
AfterDownLoad;
end;

function TIEDownloadThread.BeforeDownLoad():Bool;
begin
Result:=False;
if InitSocket then
begin
If Not Assigned(ClientSocket) then
begin
Exit;
end;
do
wnLoadFrm.pb.Max:=TotalLength;
GetFilePos;
GetFilePosbegin
end;
do
wnLoadFrm.pb.Position:=DownLoadFrm.pb.Position+FilePos;
GetRecLength;
if RecLength=0 then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
if FilePos=RecLength then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
if FileSize(DownLoadFile)>=RecLength then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
if CanReceive=false then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
Filedata.FileName:=IntToStr(ThreadIndex)+'-'+FileName;
Filedata.Filebegin
Pos:=FilePosbegin
;
end;
Result:=True;

end;

//------------------------------------------------------------------开始下载文件
procedure TIEDownloadThread.begin
DownLoad(FilePosbegin
, FilePosEnd: Integer);
var
UrlStr:String;
RecLengthOnce:Integer;
FStringStream:TStringStream;
FSocketStream:TWinSocketStream;
begin
if InitSocket then
begin
If Not Assigned(ClientSocket) then
begin
Exit;
end;
ClientSocket.Active:=False;
ClientSocket.Host:=UrlHost;
ClientSocket.Port:=80;
ClientSocket.Active:=True;
UrlStr:='';
UrlStr:=UrlStr+'GET /'+UrlFile+' HTTP/1.1'+#13#10;
UrlStr:=UrlStr+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
UrlStr:=UrlStr+'Pragma: no-cache'+#13#10;
UrlStr:=UrlStr+'Cache-Control: no-cache'+#13#10;
UrlStr:=UrlStr+'User-Agent: Mozilla/4.0 (compatible;
MSIE 6.0;
Windows NT 5.1;
.NET CLR 1.0.3705)'+#13#10;
UrlStr:=UrlStr+'RANGE: bytes='+inttostr(FilePosbegin
)+'-'+IntToStr(FilePosEnd)+#13#10;
UrlStr:=UrlStr+'Host: '+UrlHost+#13#10;
UrlStr:=UrlStr+#13#10;
DisPlayMessage('线程编号'+inttostr(ThreadIndex)+'文件开始'+inttostr(FilePosbegin
)+'文件结束'+inttostr(FilePosEnd));
ClientSocket.Socket.SendText(UrlStr);
RelRecLength:=0;
FStringStream:=TStringStream.Create('');
FSocketStream:=TWinSocketStream.create(ClientSocket.Socket, 60*1000);
//--------------------------------------------------------------------去掉头文件
While ClientSocket.Activedo
begin
ZeroMemory(@FBufChar,SizeOf(FBufChar));
RecLengthOnce:=FsocketStream.Read(FBufChar, 1);
if RecLengthOnce=0 then
Break;
FStringStream.Write(FBufChar,RecLengthOnce);
if Pos(#13#10,FStringStream.DataString)<>0 then
begin
if FStringStream.DataString=#13#10 then
begin
FSocketStream.Free;
FStringStream.Free;
Break;
end;
FStringStream.Free;
FStringStream:=TStringStream.Create('');
end;
end;
//----------------------------------------------------------------------下载正文
While ClientSocket.Activedo
begin
if FileSize(DownLoadFile)>=RecLength then
Break;
ZeroMemory(@FBufByte,sizeof(FBufByte));
RecLengthOnce:=ClientSocket.Socket.ReceiveBuf(FBufByte,sizeof(FBufByte));
do
wnLoadFrm.pb.Position:=DownLoadFrm.pb.Position+RecLengthOnce;
BlockWrite(DownLoadFile,FBufByte,RecLengthOnce);
application.ProcessMessages;
end;
DisPlayMessage('文件下载完毕');
ClientSocket.Active:=false;
Closefile(DownLoadFile);
end;
end;

procedure TIEDownloadThread.AfterDownLoad;
begin
end;

procedure TIEDownloadThread.DisPlayMessage(MessageStr: String);
begin
//Form1.Memo1.Lines.Add(MessageStr);
end;

procedure TIEDownloadThread.SetUrlFile(const Value: String);
begin
FUrlFile := Value;
end;

procedure TIEDownloadThread.SetUrlHost(const Value: String);
begin
FUrlHost := Value;
end;

procedure TIEDownloadThread.SetPos(const Value: Integer);
begin
FPos := Value;
end;

procedure TIEDownloadThread.SetRecLength(const Value: Integer);
begin
FRecLength := Value;
end;

procedure TIEDownloadThread.SetRelRecLength(const Value: Integer);
begin
FRelRecLength := Value;
end;

procedure TIEDownloadThread.SetCanReceive(const Value: Bool);
begin
FCanReceive := Value;
end;

procedure TIEDownloadThread.SetTotalLength(const Value: Integer);
begin
FTotalLength := Value;
end;

procedure TIEDownloadThread.SetFileName(const Value: String);
begin
FFileName := Value;
end;

procedure TIEDownloadThread.SetUrl(const Value: String);
begin
FUrl := Value;
end;

procedure TIEDownloadThread.SetThreadIndex(const Value: Integer);
begin
FThreadIndex := Value;
end;

procedure TIEDownloadThread.SetFilePosbegin
(const Value: Integer);
begin
FFilePosbegin
:= Value;
end;

procedure TIEDownloadThread.SetFilePosEnd(const Value: Integer);
begin
FFilePosEnd := Value;
end;

procedure TIEDownloadThread.SetThreadCount(const Value: Integer);
begin
FThreadCount := Value;
end;

{ TIEDownload }
//--------------------------------------------------------------------系统初始化
function TIEDownload.InitSocket: Boolean;
begin
Result:=False;
try
if Not Assigned(FClientSocket) then
FClientSocket:=TClientSocket.Create(nil);
FClientSocket.ClientType:=ctBlocking;
Result:=True;
except
end;
end;

//----------------------------------------------------------------------系统结束
function TIEDownload.FinalSocket: Boolean;
begin
Result:=False;
try
if Assigned(FClientSocket) then
FClientSocket.Free;
Result:=True;
except
end;
end;

//-----------------------------------------------------------------取得URL文件名
procedure TIEDownload.GetUrlFile(Url: String);
var
UrlStr:String;
begin
UrlStr:=trim(Url);
if pos('http://',lowercase(UrlStr))=1 then
begin
UrlStr:=copy(UrlStr,length('http://')+1,length(UrlStr));
end;
If pos('/',UrlStr)<>0 then
begin
UrlStr:=copy(UrlStr,pos('/',UrlStr)+1,length(UrlStr));
end;
UrlFile:=UrlStr;
end;

//-----------------------------------------------------------------取得URL文件名
Procedure TIEDownload.GetFileName(Url:String);
var
UrlStr:String;
begin
UrlStr:=trim(Url);
if pos('http://',lowercase(UrlStr))=1 then
begin
UrlStr:=copy(UrlStr,length('http://')+1,length(UrlStr));
end;
While pos('/',UrlStr)<>0do
begin
UrlStr:=copy(UrlStr,pos('/',UrlStr)+1,length(UrlStr));
end;
FileName:=UrlStr;
end;

//-------------------------------------------------------------------取得URL地址
procedure TIEDownload.GetUrlHost(Url: String);
var
UrlStr:String;
begin
UrlStr:=trim(Url);
if pos('http://',lowercase(UrlStr))=1 then
begin
UrlStr:=copy(UrlStr,length('http://')+1,length(UrlStr));
end;
if pos('/',UrlStr)<>0 then
begin
UrlStr:=copy(UrlStr,0,pos('/',UrlStr)-1);
end;
UrlHost:=UrlStr;
end;

//----------------------------------------------------------------取得文件总长度
procedure TIEDownload.GetTotalLength;
var
UrlStr:String;
UrlHead:String;
RecLengthOnce:Integer;
begin
if InitSocket then
begin
If Not Assigned(ClientSocket) then
begin
TotalLength:=0;
Exit;
end;

ClientSocket.Active:=False;
ClientSocket.Host:=UrlHost;
ClientSocket.Port:=80;
ClientSocket.Active:=True;
UrlStr:='';
UrlStr:=UrlStr+'HEAD /'+UrlFile+' HTTP/1.1'+#13#10;
UrlStr:=UrlStr+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
UrlStr:=UrlStr+'Pragma: no-cache'+#13#10;
UrlStr:=UrlStr+'Cache-Control: no-cache'+#13#10;
UrlStr:=UrlStr+'User-Agent: Mozilla/4.0 (compatible;
MSIE 6.0;
Windows NT 5.1;
.NET CLR 1.0.3705)'+#13#10;
UrlStr:=UrlStr+'Host: '+UrlHost+#13#10;
UrlStr:=UrlStr+#13#10;
ClientSocket.Socket.SendText(UrlStr);
ZeroMemory(@FBufByte,sizeof(FBufByte));
RecLengthOnce:=ClientSocket.Socket.ReceiveBuf(FBufByte,sizeof(FBufByte));
UrlHead:='';
UrlHead:=strpas(@FBufByte);
application.ProcessMessages;
ClientSocket.Active:=false;
if Pos('Content-Length:',UrlHead)>0 then
begin
UrlHead:=Copy(UrlHead,Pos('Content-Length:',UrlHead),Length(UrlHead)-Pos('Content-Length:',UrlHead)+1);
TotalLength:=StrToInt(Trim(Copy(UrlHead,Pos(':',UrlHead)+1,Pos(#13#10,UrlHead)-Pos(':',UrlHead)+1)));
end else
begin
TotalLength:=0;
end;
end;
displaymessage('文件总长度:'+inttostr(TotalLength));
end;

procedure TIEDownload.Start(URL: String);
var
I:Integer;
begin
try
GetUrlFile(Url);
GetUrlHost(Url);
GetFileName(Url);
GetTotalLength;
for i:=1 to 5do
begin
do
wnloadThread:=TIEDownloadThread.Create(i,5);
do
wnloadThread.UrlFile:=UrlFile;
do
wnloadThread.UrlHost:=UrlHost;
do
wnloadThread.FileName:=FileName;
do
wnloadThread.TotalLength:=TotalLength;
do
wnloadThread.Resume;
end;
except
end;
end;

procedure TIEDownload.Stop;
var
I:Integer;
begin
try
for i:=1 to 5do
begin
do
wnloadThread.Suspend;
end;
except
end;
end;

procedure TIEDownload.CreateFile;
var
I:Integer;
f1,f2:file;
str:Tstringlist;
str1:Tstringlist;
filename:string;
begin
str:=tstringlist.Create;
str1:=tstringlist.Create;
str1.Text:='';
for i:=1 to 5do
begin
filename:='C:/download/'+inttostr(i)+'-'+'20050815-008-i32.exe';
str.LoadFromFile(filename);
str1.AddStrings(str);
end;
str1.SaveToFile('c:/download/1.exe');
end;

procedure TIEDownload.DisPlayMessage(MessageStr: String);
begin
//Form1.Memo1.Lines.Add(MessageStr);
end;

procedure TIEDownload.SetFileName(const Value: String);
begin
FFileName := Value;
end;

procedure TIEDownload.SetTotalLength(const Value: Integer);
begin
FTotalLength := Value;
end;

procedure TIEDownload.SetUrlFile(const Value: String);
begin
FUrlFile := Value;
end;

procedure TIEDownload.SetUrlHost(const Value: String);
begin
FUrlHost := Value;
end;

end.
 
着1块是分割文件的代码 我线程指定的是5个 所以我把文件分成了5份
procedure TIEDownloadThread.GetFilePosbegin
end;
var
BufCount:Integer;
BufLeft:Integer;
ThreadBufCount:Integer;
ThreadBufCountLeft:Integer;
I:Integer;
begin
FilePosbegin
:=0;
FilePosEnd:=0;
BufCount:=TotalLength Div Length(FBufByte);
BufLeft:=TotalLength Mod Length(FBufByte);
if BufCount>=5 then
//------------------------------------------------数据块>=5
begin
ThreadBufCount:=BufCount Div 5;
ThreadBufCountLeft:=BufCount Mod 5;
if ThreadBufCountLeft=0 then
begin
if ThreadIndex=5 then
begin
FilePosbegin
:=FilePos+(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadIndex*ThreadBufCount*Length(FBufByte)+BufLeft-1;
end else
begin
FilePosbegin
:=FilePos+(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadIndex*ThreadBufCount*Length(FBufByte)-1;
end;
end else
begin
for i:=1 to ThreadBufCountLeftdo
begin
if ThreadIndex=I then
begin
FilePosbegin
:=FilePos+(ThreadIndex-1)*(ThreadBufCount+1)*Length(FBufByte);
FilePosEnd:=ThreadIndex*(ThreadBufCount+1)*Length(FBufByte)-1;
end;
end;
for I:=ThreadBufCountLeft+1 to 5do
begin
if ThreadIndex=I then
begin
if ThreadIndex=5 then
begin
FilePosbegin
:=FilePos+
ThreadBufCountLeft*Length(FBufByte)+
(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadBufCountLeft*Length(FBufByte)+
ThreadIndex*ThreadBufCount*Length(FBufByte)+
BufLeft-1;
end else
begin
FilePosbegin
:=FilePos+
ThreadBufCountLeft*Length(FBufByte)+
(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadBufCountLeft*Length(FBufByte)+
ThreadIndex*ThreadBufCount*Length(FBufByte)-1;
end;
end;
end;
end;
end else
//------------------------------------------------------------数据块<5
begin
if BufCount=0 then
begin
if ThreadIndex=1 then
begin
FilePosbegin
:=FilePos;
FilePosEnd:=BufLeft-1;
end;
end;

for i:=1 to BufCountdo
begin
if ThreadIndex=I then
begin
if ThreadIndex=BufCount then
begin
FilePosbegin
:=FilePos+(I-1)*Length(FBufByte);
FilePosEnd:=I*Length(FBufByte)+BufLeft-1;
end else
begin
FilePosbegin
:=FilePos+(I-1)*Length(FBufByte);
FilePosEnd:=I*Length(FBufByte)-1;
end;
end;
end;
end;
DisPlayMessage('线程编号:'+inttostr(threadindex)
+'文件开始位置:'+inttostr(FilePosbegin
)
+'文件结束位置:'+inttostr(FilePosEnd)
+' '+inttostr(ThreadBufCount)
+' '+inttostr(ThreadBufCountLeft));
end;
 
看看,关注一下,做个记号
 
不好意思,我说的清楚一点,用delphi7实现TdFTP的ftp的多线程下载(必须是delphi7,可以不用TdFTP控件),你给我的答案不是我想要的答案。
有疑问的地方,我在我自己的程序上都标上了记号!有劳高手费神了!只要用delphi7实现TdFTP(可以不用TdFTP控件)的ftp的多线程下载就可以了
//接收文件
function TForm1.GetURLFileName(aURL: string): string;
var
i: integer;
s: string;
begin
//返回下载地址的文件名
s := aURL;
i := Pos('/', s);
while i <> 0do
//去掉&quot;/&quot;前面的内容剩下的就是文件名了
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;(IdFTP1的属性不对)***********怎么得到(IdFTP1从aURL里下载的文件内容的大小)
//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<=xxdo
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<=xxdo
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:=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;
 
后退
顶部