G
ghy412
Unregistered / Unconfirmed
GUEST, unregistred user!
现在需要创建5个线程来分别下载5个文件，要求能够适时显示出来每个线程的速度，百分比等数据。那位大哥有相关的例子，能给小弟发一份?ghy412@126.com万分感谢！
W
weiliu
Unregistered / Unconfirmed
GUEST, unregistred user!
话题2163393的标题是： 一个使用socket多线程下载的程序示例，请大家帮忙调试。 (200分)
分类：Internet/TCPIP sodme (2003-09-08 10:19:00)
程序源代码如下：
ftp://csdn:csdn@61.153.34.10:2121/multithreaddown.rar
BUG现象：
只可以下载前4096字节，向后的内容无法下载。请有兴趣或正在作这方面工作的朋友帮忙调试看看问题出在哪，THS。
SuperSoft (2003-09-08 10:22:00)
下不来啊，最好发到http的server上
rlpcdk (2003-09-08 10:24:00)
是否用D6编的
SuperSoft (2003-09-08 10:29:00)
把code贴出来
sodme (2003-09-08 11:14:00)
谢谢两位，问题已经解决，我手头没有HTTP SERVER，只有这个借用的FTP。
由于只是演示，在下载精度方面未作过多考虑，这方面还需要细化。代码如下：
unit MainUnit;
{design by sodme}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, ScktComp;
type
Tbuf_char=array[0..4095] of char;
type
TDownThread = class(TThread)
private
FTempfile: file;
FHostName, FHostFile, FFileName: string;
FBlockSize, FSectionSize, FFileLength, FStartPos, FEndPos, FRevLen: integer;
DownClient : TClientSocket;
protected
procedure Execute;override;
function SocketRecLine(socket1: TCustomWinSocket;timeout1: integer; crlf1:string=#13#10): string;
public
constructor Create(StartPos, FileLength, SectionSize, BlockSize: integer; HostName, HostFile, SaveFile:string);
end;
type
TMainForm = class(TForm)
UrlEdit: TEdit;
SaveFileEdit: TEdit;
downbtn: TButton;
SpeedButton1: TSpeedButton;
closebtn: TBitBtn;
SaveFileDialog: TSaveDialog;
Edit1: TEdit;
Edit2: TEdit;
procedure SpeedButton1Click(Sender: TObject);
procedure closebtnClick(Sender: TObject);
procedure downbtnClick(Sender: TObject);
private
procedure InitDown;
procedure Down;
procedure EndDown;
function SocketRecLine(socket1:TCustomWinSocket;timeout1:integer;crlf1:string=#13#10):string;
{ Private declarations }
public
procedure ThreadDone(Sender : TObject);
function GetHostName(url: string): string;
function GetHostFile(url: string): string;
{ Public declarations }
end;
var
MainForm: TMainForm;
DownloadCS : TRTLCriticalSection;
TempFile : file;
hostname, hostfile, FileDate : string; //主机名，远程文件及文件日期
BlockSize, FileLength, SectionSize : integer; //每次请求的块大小，文件总长，线程长度
CanResume : Boolean;
savefile : string; //本地保存的文件名
WriteDoneFlags : integer; // 线程完成的数目
implementation
{$R *.dfm}
procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
if SaveFileDialog.Execute then
begin
SaveFileEdit.Text := SaveFileDialog.FileName;
end;
end;
procedure TMainForm.closebtnClick(Sender: TObject);
begin
close;
end;
procedure TMainForm.downbtnClick(Sender: TObject);
begin
InitDown;
Down;
// EndDown;
end;
procedure TMainForm.Down;
var
DownThrds : array[1..10] of TDownThread;
i ,test : integer;
TempSecSize, StartPos: integer;
begin
SectionSize := FileLength div 10;
BlockSize := 4096;
for i:=1 to 10 do
begin
startpos := SectionSize*(i-1);
DownThrds := TDownThread.create(StartPos, FileLength, SectionSize, BlockSize, HostName, HostFile, SaveFile);
sleep(10);
end;
//
end;
procedure TMainForm.EndDown;
begin
//
end;
procedure TMainForm.InitDown;
var
TempClient : TClientSocket;
TempURL : string; //用于向HTTP服务器发请求信息的临时变量
TempRecvStr : string; //用于存放发送请求返回的信息
begin
InitializeCriticalSection(DownloadCS);
hostfile := gethostfile(UrlEdit.Text); //获得远程主机文件名
hostname := gethostname(UrlEdit.Text); //获得远程主机名
savefile := SaveFileEdit.text; //取本地保存的文件名
{
assignfile(tempfile,savefile); //文件初始化
if FileExists(savefile) then
reset(tempfile,1)
else
rewrite(tempfile,1); }
TempClient := TClientSocket.Create(application); //创建一临时client，以获得
//以获得文件的一些必要信息
tempclient.Socket.ClientType := ctBlocking;
tempclient.Active := false;
tempclient.Host := hostname;
tempclient.Port := 80;
//11111111---------以下是实现head请求，求出文件总长----------111111111//
tempurl := '';
//此处是给出head请求关键字，http服务器会自动侦听
tempurl := tempurl+'HEAD /'+hostfile+' HTTP/1.1'+#13#10;
tempurl := tempurl+'Pragma: no-cache'+#13#10;
tempurl := tempurl+'Cache-Control: no-cache'+#13#10;
tempurl := tempurl+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
tempurl := tempurl+'Host: '+hostname+#13#10;
tempurl := tempurl+#13#10;
tempclient.Active := true;
tempclient.Socket.SendText(tempurl);
//逐行取出服务器的反馈信息，服务器反馈信息的结束是以独行内容为：#13#10结束的
while tempclient.Active = true do
begin
TempRecvStr := SocketRecLine(tempclient.Socket,60*1000);
if TempRecvStr=#13#10 then break;
if pos(lowercase('Last-Modified: '),lowercase(TempRecvStr))=1 then
FileDate := trim(copy(TempRecvStr,length('Last-Modified: ')+1,length(TempRecvStr)));
if pos(lowercase('Accept-Ranges: '),lowercase(TempRecvStr))=1 then
CanResume := true;
if pos(lowercase('Content-Length: '),lowercase(TempRecvStr))=1 then
FileLength:=strtoint(trim(copy(TempRecvStr,length('Content-Length: ')+1,length(TempRecvStr))));
end;
tempclient.Free;
end;
procedure TMainForm.ThreadDone(Sender : TObject);
var
i : integer;
begin
inc(WriteDoneFlags);
edit2.Text := inttostr(WriteDoneFlags);
if WriteDoneFlags = 10 then
begin
closefile(tempfile);
DeleteCriticalSection(DownloadCS);
end;
end;
function TMainForm.GetHostFile(url: string): string;
//从URL中提取文件名
var
in1 : string;
begin
in1:=trim(url);
if pos('http://',lowercase(in1))=1 then
begin
in1:=copy(in1,length('http://')+1,length(in1));
end;
if pos('/',in1)<>0 then
begin
in1:=copy(in1,pos('/',in1)+1,length(in1));
end;
result:=in1;
end;
function TMainForm.GetHostName(url: string): string;
//从URL中提取主机名
var
in1 : string;
begin
in1:=trim(url);
if pos('http://',lowercase(in1))=1 then
begin
in1:=copy(in1,length('http://')+1,length(in1));
end;
if pos('/',in1)<>0 then
begin
in1:=copy(in1,0,pos('/',in1)-1);
end;
result:=in1;
end;
function TMainForm.SocketRecLine(socket1: TCustomWinSocket;
timeout1: integer; crlf1:string=#13#10): string;
var
buf1:Tbuf_char;
r1:integer;
ts1:TStringStream; //保存所有的数据
FSocketStream: TWinSocketStream;
begin
ts1:=TStringStream.Create('');
FSocketStream:= TWinSocketStream.create(Socket1, timeout1);
while (socket1.Connected=true) do
begin
if not FSocketStream.WaitForData(timeout1) then break;
zeromemory(@buf1,sizeof(buf1));
r1 := FsocketStream.Read(buf1, 1);
if r1=0 then break; //test
ts1.Write(buf1,r1);
if pos(crlf1,ts1.DataString)<>0 then
begin
break;
end;
end;
result:=ts1.DataString;
if pos(crlf1,result)=0 then
begin
result:='';
end;
ts1.Free;
FSocketStream.Free;
end;
{ TDownThread }
constructor TDownThread.Create(StartPos, FileLength, SectionSize, BlockSize: integer; HostName, HostFile, SaveFile:string);
begin
inherited Create(false);
FStartPos := StartPos;
FEndPos := StartPos; //初始化本线程通用变量
FFileLength := FileLength;
FSectionSize := SectionSize;
FBlockSize := BlockSize;
FHostName := HostName;
FHostFile := HostFile;
FFileName := SaveFile;
FRevLen :=0;
DownClient := TClientSocket.Create(application); //初始化下载socket
DownClient.Socket.ClientType := ctBlocking;
DownClient.Active := false;
DownClient.Host := HostName;
DownClient.Port := 80;
FreeOnTerminate := true;
OnTerminate := mainform.ThreadDone;
EnterCriticalSection(DownloadCS); //对读写文件进行临界区保护
assignfile(FTempFile,FFilename);
if FileExists(FFileName) then
begin
reset(FTempFile,1);
end
else
begin
rewrite(FTempFile,1);
end;
LeaveCriticalSection(DownloadCS);
end;
procedure TDownThread.Execute;
var
ReqUrl, TempRcvStr: string;
RealRecLen, CanReceiveLen, TempReceiveLength: integer;
CanReceive : Boolean;
buf1 : Tbuf_char;
i : integer;
begin
repeat
ReqUrl := '';
ReqUrl := ReqUrl+'GET /'+FHostFile+' HTTP/1.1'+#13#10;
ReqUrl := ReqUrl+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
ReqUrl := ReqUrl+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
ReqUrl := ReqUrl+'RANGE: bytes='+inttostr(FEndPos)+'-'+inttostr(FEndPos+FBlockSize)+#13#10;
ReqUrl := ReqUrl+'Host: '+FHostName+#13#10;
ReqUrl := ReqUrl+#13#10;
DownClient.Active := true;
DownClient.Socket.SendText(ReqUrl);
while DownClient.Active=true do
begin
TempRcvStr := SocketRecLine(DownClient.Socket,60*1000);
if TempRcvStr=#13#10 then break;
if pos(lowercase('Content-Range:'),lowercase(TempRcvStr))=1 then //是否可接收
begin
CanReceive:=true;
end;
if pos(lowercase('Content-Length: '),lowercase(TempRcvStr))=1 then //计算要接收的长度
begin
CanReceiveLen:=strtoint(trim(copy(TempRcvStr,length('Content-Length: ')+1,length(TempRcvStr))));
end;
end;
RealRecLen:=0;
while DownClient.Active=true do
begin
if CanReceive=false then break; //不能接收则退出
if filesize(FTempFile)>=FFileLength then //如果文件当前的长度大于服务器标识的长度,则是出错了，不要写入文件中
begin
showmessage('文件已经下载完毕了！');
break;
end;
zeromemory(@buf1,sizeof(buf1));
TempReceiveLength := DownClient.Socket.ReceiveBuf(buf1,sizeof(buf1));
//如果实际收到的长度大于服务器标识的长度,则是出错了，不要写入文件中
if RealRecLen>=CanReceiveLen then
begin
showmessage('文件已经下载完毕了！');
break;
end;
if FEndPos=CanReceiveLen then //如果当前的长度大于服务器标识的长度,则是出错了，不要写入文件中
begin
showmessage('文件已经下载完毕了！');
break;
end;
EnterCriticalSection(DownloadCS); //用临界区同时读写
seek(FTempFile,FEndPos);
//FillChar(buf1,sizeof(buf1),'f');
//blockwrite(FTempFile,buf1,sizeof(buf1));
blockwrite(FTempFile,buf1,TempReceiveLength);
LeaveCriticalSection(DownloadCS);
//FEndPos := FEndPos+4096;
FEndPos := FEndPos+TempReceiveLength;
application.ProcessMessages;
end;
until (FEndPos > FStartPos+FSectionSize);
inherited;
end;
function TDownThread.SocketRecLine(socket1: TCustomWinSocket;
timeout1: integer; crlf1:string=#13#10): string;
var
buf1:Tbuf_char;
r1:integer;
ts1:TStringStream; //保存所有的数据
FSocketStream: TWinSocketStream;
begin
ts1:=TStringStream.Create('');
FSocketStream:= TWinSocketStream.create(Socket1, timeout1);
while (socket1.Connected=true) do
begin
if not FSocketStream.WaitForData(timeout1) then break;
zeromemory(@buf1,sizeof(buf1));
r1 := FsocketStream.Read(buf1, 1);
if r1=0 then break; //test
ts1.Write(buf1,r1);
if pos(crlf1,ts1.DataString)<>0 then
begin
break;
end;
end;
result:=ts1.DataString;
if pos(crlf1,result)=0 then
begin
result:='';
end;
ts1.Free;
FSocketStream.Free;
end;
end.
sodme (2003-09-08 11:16:00)
在研究多线程下载问题的过程中，查阅了大富翁论坛不少朋友的贴子，此处的代码也有不少直接来源于他们的贴子，向他们表示感谢。
sodme (2003-09-08 11:25:00)
这是我写的第一个网络程序，也是第一次进行socket编程，所以，里面不如人意的地方要比如人意的地方多得多。现在，主要需要完善以下方面：
1.下载文件大小精度方面的精确控制。这一点，我在演示程序里没更多考虑，只是很粗略地大致划分为十个线程，然后每个线程有一个大致的大小。
2.在下载过程中的意外中断方面，需要加进异常处理机制。
3.在正常下载结束时，关闭程序时经常出现无响应问题，怀疑是内存泄漏或socket未予正常释放。
以上各点，如果大家对代码进行了完善，可以接着在本贴后跟出自己的完善代码。我会视大家对代码的改进情况给分，没有兴趣改进的代码的朋友请不要跟贴。
分类：Internet/TCPIP sodme (2003-09-08 10:19:00)
程序源代码如下：
ftp://csdn:csdn@61.153.34.10:2121/multithreaddown.rar
BUG现象：
只可以下载前4096字节，向后的内容无法下载。请有兴趣或正在作这方面工作的朋友帮忙调试看看问题出在哪，THS。
SuperSoft (2003-09-08 10:22:00)
下不来啊，最好发到http的server上
rlpcdk (2003-09-08 10:24:00)
是否用D6编的
SuperSoft (2003-09-08 10:29:00)
把code贴出来
sodme (2003-09-08 11:14:00)
谢谢两位，问题已经解决，我手头没有HTTP SERVER，只有这个借用的FTP。
由于只是演示，在下载精度方面未作过多考虑，这方面还需要细化。代码如下：
unit MainUnit;
{design by sodme}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, ScktComp;
type
Tbuf_char=array[0..4095] of char;
type
TDownThread = class(TThread)
private
FTempfile: file;
FHostName, FHostFile, FFileName: string;
FBlockSize, FSectionSize, FFileLength, FStartPos, FEndPos, FRevLen: integer;
DownClient : TClientSocket;
protected
procedure Execute;override;
function SocketRecLine(socket1: TCustomWinSocket;timeout1: integer; crlf1:string=#13#10): string;
public
constructor Create(StartPos, FileLength, SectionSize, BlockSize: integer; HostName, HostFile, SaveFile:string);
end;
type
TMainForm = class(TForm)
UrlEdit: TEdit;
SaveFileEdit: TEdit;
downbtn: TButton;
SpeedButton1: TSpeedButton;
closebtn: TBitBtn;
SaveFileDialog: TSaveDialog;
Edit1: TEdit;
Edit2: TEdit;
procedure SpeedButton1Click(Sender: TObject);
procedure closebtnClick(Sender: TObject);
procedure downbtnClick(Sender: TObject);
private
procedure InitDown;
procedure Down;
procedure EndDown;
function SocketRecLine(socket1:TCustomWinSocket;timeout1:integer;crlf1:string=#13#10):string;
{ Private declarations }
public
procedure ThreadDone(Sender : TObject);
function GetHostName(url: string): string;
function GetHostFile(url: string): string;
{ Public declarations }
end;
var
MainForm: TMainForm;
DownloadCS : TRTLCriticalSection;
TempFile : file;
hostname, hostfile, FileDate : string; //主机名，远程文件及文件日期
BlockSize, FileLength, SectionSize : integer; //每次请求的块大小，文件总长，线程长度
CanResume : Boolean;
savefile : string; //本地保存的文件名
WriteDoneFlags : integer; // 线程完成的数目
implementation
{$R *.dfm}
procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
if SaveFileDialog.Execute then
begin
SaveFileEdit.Text := SaveFileDialog.FileName;
end;
end;
procedure TMainForm.closebtnClick(Sender: TObject);
begin
close;
end;
procedure TMainForm.downbtnClick(Sender: TObject);
begin
InitDown;
Down;
// EndDown;
end;
procedure TMainForm.Down;
var
DownThrds : array[1..10] of TDownThread;
i ,test : integer;
TempSecSize, StartPos: integer;
begin
SectionSize := FileLength div 10;
BlockSize := 4096;
for i:=1 to 10 do
begin
startpos := SectionSize*(i-1);
DownThrds := TDownThread.create(StartPos, FileLength, SectionSize, BlockSize, HostName, HostFile, SaveFile);
sleep(10);
end;
//
end;
procedure TMainForm.EndDown;
begin
//
end;
procedure TMainForm.InitDown;
var
TempClient : TClientSocket;
TempURL : string; //用于向HTTP服务器发请求信息的临时变量
TempRecvStr : string; //用于存放发送请求返回的信息
begin
InitializeCriticalSection(DownloadCS);
hostfile := gethostfile(UrlEdit.Text); //获得远程主机文件名
hostname := gethostname(UrlEdit.Text); //获得远程主机名
savefile := SaveFileEdit.text; //取本地保存的文件名
{
assignfile(tempfile,savefile); //文件初始化
if FileExists(savefile) then
reset(tempfile,1)
else
rewrite(tempfile,1); }
TempClient := TClientSocket.Create(application); //创建一临时client，以获得
//以获得文件的一些必要信息
tempclient.Socket.ClientType := ctBlocking;
tempclient.Active := false;
tempclient.Host := hostname;
tempclient.Port := 80;
//11111111---------以下是实现head请求，求出文件总长----------111111111//
tempurl := '';
//此处是给出head请求关键字，http服务器会自动侦听
tempurl := tempurl+'HEAD /'+hostfile+' HTTP/1.1'+#13#10;
tempurl := tempurl+'Pragma: no-cache'+#13#10;
tempurl := tempurl+'Cache-Control: no-cache'+#13#10;
tempurl := tempurl+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
tempurl := tempurl+'Host: '+hostname+#13#10;
tempurl := tempurl+#13#10;
tempclient.Active := true;
tempclient.Socket.SendText(tempurl);
//逐行取出服务器的反馈信息，服务器反馈信息的结束是以独行内容为：#13#10结束的
while tempclient.Active = true do
begin
TempRecvStr := SocketRecLine(tempclient.Socket,60*1000);
if TempRecvStr=#13#10 then break;
if pos(lowercase('Last-Modified: '),lowercase(TempRecvStr))=1 then
FileDate := trim(copy(TempRecvStr,length('Last-Modified: ')+1,length(TempRecvStr)));
if pos(lowercase('Accept-Ranges: '),lowercase(TempRecvStr))=1 then
CanResume := true;
if pos(lowercase('Content-Length: '),lowercase(TempRecvStr))=1 then
FileLength:=strtoint(trim(copy(TempRecvStr,length('Content-Length: ')+1,length(TempRecvStr))));
end;
tempclient.Free;
end;
procedure TMainForm.ThreadDone(Sender : TObject);
var
i : integer;
begin
inc(WriteDoneFlags);
edit2.Text := inttostr(WriteDoneFlags);
if WriteDoneFlags = 10 then
begin
closefile(tempfile);
DeleteCriticalSection(DownloadCS);
end;
end;
function TMainForm.GetHostFile(url: string): string;
//从URL中提取文件名
var
in1 : string;
begin
in1:=trim(url);
if pos('http://',lowercase(in1))=1 then
begin
in1:=copy(in1,length('http://')+1,length(in1));
end;
if pos('/',in1)<>0 then
begin
in1:=copy(in1,pos('/',in1)+1,length(in1));
end;
result:=in1;
end;
function TMainForm.GetHostName(url: string): string;
//从URL中提取主机名
var
in1 : string;
begin
in1:=trim(url);
if pos('http://',lowercase(in1))=1 then
begin
in1:=copy(in1,length('http://')+1,length(in1));
end;
if pos('/',in1)<>0 then
begin
in1:=copy(in1,0,pos('/',in1)-1);
end;
result:=in1;
end;
function TMainForm.SocketRecLine(socket1: TCustomWinSocket;
timeout1: integer; crlf1:string=#13#10): string;
var
buf1:Tbuf_char;
r1:integer;
ts1:TStringStream; //保存所有的数据
FSocketStream: TWinSocketStream;
begin
ts1:=TStringStream.Create('');
FSocketStream:= TWinSocketStream.create(Socket1, timeout1);
while (socket1.Connected=true) do
begin
if not FSocketStream.WaitForData(timeout1) then break;
zeromemory(@buf1,sizeof(buf1));
r1 := FsocketStream.Read(buf1, 1);
if r1=0 then break; //test
ts1.Write(buf1,r1);
if pos(crlf1,ts1.DataString)<>0 then
begin
break;
end;
end;
result:=ts1.DataString;
if pos(crlf1,result)=0 then
begin
result:='';
end;
ts1.Free;
FSocketStream.Free;
end;
{ TDownThread }
constructor TDownThread.Create(StartPos, FileLength, SectionSize, BlockSize: integer; HostName, HostFile, SaveFile:string);
begin
inherited Create(false);
FStartPos := StartPos;
FEndPos := StartPos; //初始化本线程通用变量
FFileLength := FileLength;
FSectionSize := SectionSize;
FBlockSize := BlockSize;
FHostName := HostName;
FHostFile := HostFile;
FFileName := SaveFile;
FRevLen :=0;
DownClient := TClientSocket.Create(application); //初始化下载socket
DownClient.Socket.ClientType := ctBlocking;
DownClient.Active := false;
DownClient.Host := HostName;
DownClient.Port := 80;
FreeOnTerminate := true;
OnTerminate := mainform.ThreadDone;
EnterCriticalSection(DownloadCS); //对读写文件进行临界区保护
assignfile(FTempFile,FFilename);
if FileExists(FFileName) then
begin
reset(FTempFile,1);
end
else
begin
rewrite(FTempFile,1);
end;
LeaveCriticalSection(DownloadCS);
end;
procedure TDownThread.Execute;
var
ReqUrl, TempRcvStr: string;
RealRecLen, CanReceiveLen, TempReceiveLength: integer;
CanReceive : Boolean;
buf1 : Tbuf_char;
i : integer;
begin
repeat
ReqUrl := '';
ReqUrl := ReqUrl+'GET /'+FHostFile+' HTTP/1.1'+#13#10;
ReqUrl := ReqUrl+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
ReqUrl := ReqUrl+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
ReqUrl := ReqUrl+'RANGE: bytes='+inttostr(FEndPos)+'-'+inttostr(FEndPos+FBlockSize)+#13#10;
ReqUrl := ReqUrl+'Host: '+FHostName+#13#10;
ReqUrl := ReqUrl+#13#10;
DownClient.Active := true;
DownClient.Socket.SendText(ReqUrl);
while DownClient.Active=true do
begin
TempRcvStr := SocketRecLine(DownClient.Socket,60*1000);
if TempRcvStr=#13#10 then break;
if pos(lowercase('Content-Range:'),lowercase(TempRcvStr))=1 then //是否可接收
begin
CanReceive:=true;
end;
if pos(lowercase('Content-Length: '),lowercase(TempRcvStr))=1 then //计算要接收的长度
begin
CanReceiveLen:=strtoint(trim(copy(TempRcvStr,length('Content-Length: ')+1,length(TempRcvStr))));
end;
end;
RealRecLen:=0;
while DownClient.Active=true do
begin
if CanReceive=false then break; //不能接收则退出
if filesize(FTempFile)>=FFileLength then //如果文件当前的长度大于服务器标识的长度,则是出错了，不要写入文件中
begin
showmessage('文件已经下载完毕了！');
break;
end;
zeromemory(@buf1,sizeof(buf1));
TempReceiveLength := DownClient.Socket.ReceiveBuf(buf1,sizeof(buf1));
//如果实际收到的长度大于服务器标识的长度,则是出错了，不要写入文件中
if RealRecLen>=CanReceiveLen then
begin
showmessage('文件已经下载完毕了！');
break;
end;
if FEndPos=CanReceiveLen then //如果当前的长度大于服务器标识的长度,则是出错了，不要写入文件中
begin
showmessage('文件已经下载完毕了！');
break;
end;
EnterCriticalSection(DownloadCS); //用临界区同时读写
seek(FTempFile,FEndPos);
//FillChar(buf1,sizeof(buf1),'f');
//blockwrite(FTempFile,buf1,sizeof(buf1));
blockwrite(FTempFile,buf1,TempReceiveLength);
LeaveCriticalSection(DownloadCS);
//FEndPos := FEndPos+4096;
FEndPos := FEndPos+TempReceiveLength;
application.ProcessMessages;
end;
until (FEndPos > FStartPos+FSectionSize);
inherited;
end;
function TDownThread.SocketRecLine(socket1: TCustomWinSocket;
timeout1: integer; crlf1:string=#13#10): string;
var
buf1:Tbuf_char;
r1:integer;
ts1:TStringStream; //保存所有的数据
FSocketStream: TWinSocketStream;
begin
ts1:=TStringStream.Create('');
FSocketStream:= TWinSocketStream.create(Socket1, timeout1);
while (socket1.Connected=true) do
begin
if not FSocketStream.WaitForData(timeout1) then break;
zeromemory(@buf1,sizeof(buf1));
r1 := FsocketStream.Read(buf1, 1);
if r1=0 then break; //test
ts1.Write(buf1,r1);
if pos(crlf1,ts1.DataString)<>0 then
begin
break;
end;
end;
result:=ts1.DataString;
if pos(crlf1,result)=0 then
begin
result:='';
end;
ts1.Free;
FSocketStream.Free;
end;
end.
sodme (2003-09-08 11:16:00)
在研究多线程下载问题的过程中，查阅了大富翁论坛不少朋友的贴子，此处的代码也有不少直接来源于他们的贴子，向他们表示感谢。
sodme (2003-09-08 11:25:00)
这是我写的第一个网络程序，也是第一次进行socket编程，所以，里面不如人意的地方要比如人意的地方多得多。现在，主要需要完善以下方面：
1.下载文件大小精度方面的精确控制。这一点，我在演示程序里没更多考虑，只是很粗略地大致划分为十个线程，然后每个线程有一个大致的大小。
2.在下载过程中的意外中断方面，需要加进异常处理机制。
3.在正常下载结束时，关闭程序时经常出现无响应问题，怀疑是内存泄漏或socket未予正常释放。
以上各点，如果大家对代码进行了完善，可以接着在本贴后跟出自己的完善代码。我会视大家对代码的改进情况给分，没有兴趣改进的代码的朋友请不要跟贴。
W
weiliu
Unregistered / Unconfirmed
GUEST, unregistred user!
话题124584的标题是： 多线程的下载（比如NETANTS）如何实现？要原理！ (100分)
分类：多线程 meihong (1999-08-07 16:42:00)
多线程的下载（比如NETANTS）如何实现？要原理！
pegasus (1999-08-07 18:44:00)
我就喜欢原理，
实现不会耶！
HTTP的请求头中可以带有一个叫做range的域，指出需要的字节范围
例如：
Get /dephibbs/demo.zip HTTP/1.0
host:www.gislab.ecnu.edu.cn
byte:234-678
就指出只需要234到678字节的内容（从0字节算起是第一个字节）
如果HTTP服务器支持range，那么下载程序就可以根据服务器返回的目标文件
的长度(在返回信息的Content-length里面),生成多个线程序分别负责一个字
节范围，这样就能够多线程下载来提高下载速度。
实现的时候本地哥哥现成的工作情况的日志很重要，不然下载到一半停了之
后就很难重新拼成一个完整的目标文件了
nuke (1999-08-07 18:48:00)
呵呵！
原理很简单的哦
把一个文件分成几块
然后发出几个不同请求分别下载每一块的内容。
然后再连起来组成一个好文件。
就和集装运输一样哦！
pegasus (1999-08-07 19:14:00)
实现的时候本地哥哥现成的工作情况的日志很重要，不然下载到一半停了之
^^^^^^^^^^^^^^^^^^
各个线程， Sorry, 太马虎了
ftp没有HTTP那么好，但是可以指定起始位置，如果服务器支持的话也
能够多线程下载
Another_eYes (1999-08-07 19:52:00)
哦.
敬佩pegasus一丝不苟的精神. 不情之请: 能不能给我一份ftp的命令列表? (eYes网盲, 准备
学了) 不好意思, 用了meihong的分, 一定还一定还.
pegasus (1999-08-08 1:09:00)
OK,
rfc 959中提到了下列标准命令：FTP COMMANDS
1. ACCESS CONTROL COMMANDS
USER NAME (USER)
PASSWORD (PASS)
ACCOUNT (ACCT)
CHANGE WORKING DIRECTORY (CWD)
CHANGE TO PARENT DIRECTORY (CDUP)
STRUCTURE MOUNT (SMNT)
REINITIALIZE (REIN)
LOGOUT (QUIT)
2. TRANSFER PARAMETER COMMANDS
DATA PORT (PORT)
PASSIVE (PASV)
REPRESENTATION TYPE (TYPE)
FILE STRUCTURE (STRU)
TRANSFER MODE (MODE)
3. FTP SERVICE COMMANDS
RETRIEVE (RETR)
STORE (STOR)
STORE UNIQUE (STOU)
APPEND (with create) (APPE)
ALLOCATE (ALLO)
RESTART (REST)
RENAME FROM (RNFR)
RENAME TO (RNTO)
ABORT (ABOR)
DELETE (DELE)
REMOVE DIRECTORY (RMD)
MAKE DIRECTORY (MKD)
PRINT WORKING DIRECTORY (PWD)
LIST (LIST)
NAME LIST (NLST)
SITE PARAMETERS (SITE)
SYSTEM (SYST)
STATUS (STAT)
HELP (HELP)
NOOP (NOOP)
如果需要详细的命令格式的解释，那么我就寄给您rfc959.txt？
Another_eYes (1999-08-08 1:12:00)
寄吧寄吧
pegasus (1999-08-08 1:27:00)
OK, 寄出了
Another_eYes (1999-08-08 1:30:00)
谢谢
sherman (1999-08-08 21:44:00)
我也想要一份了，shermanxie@126.com
邹光先 (1999-08-08 21:57:00)
呵呵，我也要！
zguangxian@263.net
pegasus (1999-08-09 0:55:00)
OK, sent out.
lj2000 (1999-08-10 0:24:00)
呵呵，我也要！
ljfree@21cn.com
scriptman (1999-08-10 13:07:00)
建议你们到上海交通大学自动化研究室的竹叶类面看看
或者在ftp://ftp.shtdu.edu.cn/welcome/delphi里面看看
有绝大多数的RFC
pegasus (1999-08-10 14:57:00)
OK, sent out.
等大富翁B计划完工之后，大家是不是考虑一下进行RFC的汉化工作，
挑选一些主要的翻译一下，加速普及，如何？
cytown (1999-08-23 15:12:00)
什么B计划？说来听听！
DNChen (1999-08-23 19:35:00)
支持这个决定，不过我只能呐喊，不能动手的，*^_^*
geshengping (1999-08-23 20:05:00)
pegaous: 提议很不错，希望到时能帮上忙。
cytown: B计划在大富翁论坛首页有链接，自己去看看吧，嘻嘻。
Liu JZX (1999-09-16 8:48:00)
to me
ljgljg@sohu.com
郑宇轩 (1999-09-16 9:14:00)
也算我一份。
To:xzhengy@263.net
snowtree (1999-10-04 1:46:00)
也算我一份。
To: snowtreehouse@990.net
KCZ (1999-10-08 18:37:00)
给偶一份！
hntangwei (1999-10-08 19:00:00)
有这种好东西,给我一个吗?
hntangwei@netease.com
yiezh (1999-12-09 14:04:00)
好东西,给我一份吗?
阿蒙 (1999-12-09 19:36:00)
不管沈默给我也来一份
还有 netants 是先在本地建立一个*。exe 文件，他是最后下在文件的合并文件
天外客 (1999-12-09 21:39:00)
pegasus,也给我几一分RFC959.txt把
Thank U
天外客 (1999-12-09 21:41:00)
pegasus,也给我几一分RFC959.txt把
Thank U
我的Email: LinLS@km169.net
Energy (1999-12-09 23:33:00)
应该是 http 1.1 , 1.0不支持的。
阿蒙 (1999-12-10 19:42:00)
以前有过这个讨论，你可以把以前的大幅文翁离线版看看，都是前辈（都退隐了）
写的
windynet (2000-04-02 19:30:00)
我也要！
meihong (2000-05-20 13:46:00)
接受答案了.
daozhao (2000-05-20 21:59:00)
有这种好东西,给我一个吗?
daozhao@netease.com
pegasus的回答最终被接受。
分类：多线程 meihong (1999-08-07 16:42:00)
多线程的下载（比如NETANTS）如何实现？要原理！
pegasus (1999-08-07 18:44:00)
我就喜欢原理，
实现不会耶！HTTP的请求头中可以带有一个叫做range的域，指出需要的字节范围
例如：
Get /dephibbs/demo.zip HTTP/1.0
host:www.gislab.ecnu.edu.cn
byte:234-678
就指出只需要234到678字节的内容（从0字节算起是第一个字节）
如果HTTP服务器支持range，那么下载程序就可以根据服务器返回的目标文件
的长度(在返回信息的Content-length里面),生成多个线程序分别负责一个字
节范围，这样就能够多线程下载来提高下载速度。
实现的时候本地哥哥现成的工作情况的日志很重要，不然下载到一半停了之
后就很难重新拼成一个完整的目标文件了
nuke (1999-08-07 18:48:00)
呵呵！
原理很简单的哦
把一个文件分成几块
然后发出几个不同请求分别下载每一块的内容。
然后再连起来组成一个好文件。
就和集装运输一样哦！
pegasus (1999-08-07 19:14:00)
实现的时候本地哥哥现成的工作情况的日志很重要，不然下载到一半停了之
^^^^^^^^^^^^^^^^^^
各个线程， Sorry, 太马虎了
ftp没有HTTP那么好，但是可以指定起始位置，如果服务器支持的话也
能够多线程下载
Another_eYes (1999-08-07 19:52:00)
哦.
敬佩pegasus一丝不苟的精神. 不情之请: 能不能给我一份ftp的命令列表? (eYes网盲, 准备
学了) 不好意思, 用了meihong的分, 一定还一定还.
pegasus (1999-08-08 1:09:00)
OK,
rfc 959中提到了下列标准命令：FTP COMMANDS
1. ACCESS CONTROL COMMANDS
USER NAME (USER)
PASSWORD (PASS)
ACCOUNT (ACCT)
CHANGE WORKING DIRECTORY (CWD)
CHANGE TO PARENT DIRECTORY (CDUP)
STRUCTURE MOUNT (SMNT)
REINITIALIZE (REIN)
LOGOUT (QUIT)
2. TRANSFER PARAMETER COMMANDS
DATA PORT (PORT)
PASSIVE (PASV)
REPRESENTATION TYPE (TYPE)
FILE STRUCTURE (STRU)
TRANSFER MODE (MODE)
3. FTP SERVICE COMMANDS
RETRIEVE (RETR)
STORE (STOR)
STORE UNIQUE (STOU)
APPEND (with create) (APPE)
ALLOCATE (ALLO)
RESTART (REST)
RENAME FROM (RNFR)
RENAME TO (RNTO)
ABORT (ABOR)
DELETE (DELE)
REMOVE DIRECTORY (RMD)
MAKE DIRECTORY (MKD)
PRINT WORKING DIRECTORY (PWD)
LIST (LIST)
NAME LIST (NLST)
SITE PARAMETERS (SITE)
SYSTEM (SYST)
STATUS (STAT)
HELP (HELP)
NOOP (NOOP)
如果需要详细的命令格式的解释，那么我就寄给您rfc959.txt？
Another_eYes (1999-08-08 1:12:00)
寄吧寄吧
pegasus (1999-08-08 1:27:00)
OK, 寄出了
Another_eYes (1999-08-08 1:30:00)
谢谢
sherman (1999-08-08 21:44:00)
我也想要一份了，shermanxie@126.com
邹光先 (1999-08-08 21:57:00)
呵呵，我也要！
zguangxian@263.net
pegasus (1999-08-09 0:55:00)
OK, sent out.
lj2000 (1999-08-10 0:24:00)
呵呵，我也要！
ljfree@21cn.com
scriptman (1999-08-10 13:07:00)
建议你们到上海交通大学自动化研究室的竹叶类面看看
或者在ftp://ftp.shtdu.edu.cn/welcome/delphi里面看看
有绝大多数的RFC
pegasus (1999-08-10 14:57:00)
OK, sent out.
等大富翁B计划完工之后，大家是不是考虑一下进行RFC的汉化工作，
挑选一些主要的翻译一下，加速普及，如何？
cytown (1999-08-23 15:12:00)
什么B计划？说来听听！
DNChen (1999-08-23 19:35:00)
支持这个决定，不过我只能呐喊，不能动手的，*^_^*
geshengping (1999-08-23 20:05:00)
pegaous: 提议很不错，希望到时能帮上忙。
cytown: B计划在大富翁论坛首页有链接，自己去看看吧，嘻嘻。
Liu JZX (1999-09-16 8:48:00)
to me
ljgljg@sohu.com
郑宇轩 (1999-09-16 9:14:00)
也算我一份。
To:xzhengy@263.net
snowtree (1999-10-04 1:46:00)
也算我一份。
To: snowtreehouse@990.net
KCZ (1999-10-08 18:37:00)
给偶一份！
hntangwei (1999-10-08 19:00:00)
有这种好东西,给我一个吗?
hntangwei@netease.com
yiezh (1999-12-09 14:04:00)
好东西,给我一份吗?
阿蒙 (1999-12-09 19:36:00)
不管沈默给我也来一份
还有 netants 是先在本地建立一个*。exe 文件，他是最后下在文件的合并文件
天外客 (1999-12-09 21:39:00)
pegasus,也给我几一分RFC959.txt把
Thank U
天外客 (1999-12-09 21:41:00)
pegasus,也给我几一分RFC959.txt把
Thank U
我的Email: LinLS@km169.net
Energy (1999-12-09 23:33:00)
应该是 http 1.1 , 1.0不支持的。
阿蒙 (1999-12-10 19:42:00)
以前有过这个讨论，你可以把以前的大幅文翁离线版看看，都是前辈（都退隐了）
写的
windynet (2000-04-02 19:30:00)
我也要！
meihong (2000-05-20 13:46:00)
接受答案了.
daozhao (2000-05-20 21:59:00)
有这种好东西,给我一个吗?
daozhao@netease.com
pegasus的回答最终被接受。
W
weiliu
Unregistered / Unconfirmed
GUEST, unregistred user!
话题1768524的标题是： 关于多线程下载的问题？ (200分)
分类：多线程 lxhui99s039 (2003-04-14 21:33:00)
多线程下载同个文件，请问如何控制每个线程的结束位置 ？
xianjun (2003-04-14 21:36:00)
当然是根据下载的字节数来控制了
先取得文件的总大小，然后分配各个线程下载任务：
如一个200K的文件，四个线程下载，则
A 1..50K
B 50K + 1 .. 100K
C 100K + 1 .. 150K
D 150K + 1 .. 200K
lxhui99s039 (2003-04-14 21:45:00)
我也这样分析过，但不知用程序该怎么控制呢？还望多多指教希望能有源码。
zhu_jy (2003-04-14 22:41:00)
服务器要支持多点下载
取得文件大小，分段
每个线程从不同的断点下载
xianjun (2003-04-16 15:25:00)
不知怎么控制？ 你用什么方法下载？
肯定支持从指定字节下载到指定长度的文件内容的。
lxhui99s018 (2003-06-10 15:20:00)
在 RETR 或 STOR 命令发送前先发送一个 REST xxx，表示从文件的偏移 xxx 处
开始传送，注意，有的服务器可能不支持 REST 命令。
如果使用ICS控件，那么
HttpCli.ContentRangeBegin := '100' 表示从100开始
HttpCli.ContentRangeEnd :='' 表示一直到结束
HttpCli.ContentRangeEnd :='200' 表示到200字节处结束
如果使用 TNMHTTP 控件
在OnAboutToSend事件，写：
NMHTTP1.SendHeader.Values['Range'] := 'bytes=100-' 表示从100字节处开始下载到最后
NMHTTP1.SendHeader.Values['Range'] := 'bytes=100-200' 表示从100字节处开始下载到200字节处结束
***************
procedure TForm1.Button6Click(Sender: TObject);
var
f:TSearchRec;
begin
FindFirst('a.doc',faAnyFile,f);
fPreSize:=f.Size;
NMFtp.DoCommand('Rest '+IntToStr(fPreSize));
NMFtp.DownloadRestore('a.doc','a.doc');
end;
这是用TNMFtp来续传的代码。
firstrose (2003-06-29 13:52:00)
如果直接用socket，可以研究一下rfc。里面有命令说明
lxhui99s039 (2004-06-07 11:59:57)
多人接受答案了。
firstrose-20,lxhui99s018-120,xianjun-40,zhu_jy-20,的回答最终被接受。
分类：多线程 lxhui99s039 (2003-04-14 21:33:00)
多线程下载同个文件，请问如何控制每个线程的结束位置 ？
xianjun (2003-04-14 21:36:00)
当然是根据下载的字节数来控制了
先取得文件的总大小，然后分配各个线程下载任务：
如一个200K的文件，四个线程下载，则
A 1..50K
B 50K + 1 .. 100K
C 100K + 1 .. 150K
D 150K + 1 .. 200K
lxhui99s039 (2003-04-14 21:45:00)
我也这样分析过，但不知用程序该怎么控制呢？还望多多指教希望能有源码。
zhu_jy (2003-04-14 22:41:00)
服务器要支持多点下载
取得文件大小，分段
每个线程从不同的断点下载
xianjun (2003-04-16 15:25:00)
不知怎么控制？ 你用什么方法下载？
肯定支持从指定字节下载到指定长度的文件内容的。
lxhui99s018 (2003-06-10 15:20:00)
在 RETR 或 STOR 命令发送前先发送一个 REST xxx，表示从文件的偏移 xxx 处
开始传送，注意，有的服务器可能不支持 REST 命令。
如果使用ICS控件，那么
HttpCli.ContentRangeBegin := '100' 表示从100开始
HttpCli.ContentRangeEnd :='' 表示一直到结束
HttpCli.ContentRangeEnd :='200' 表示到200字节处结束
如果使用 TNMHTTP 控件
在OnAboutToSend事件，写：
NMHTTP1.SendHeader.Values['Range'] := 'bytes=100-' 表示从100字节处开始下载到最后
NMHTTP1.SendHeader.Values['Range'] := 'bytes=100-200' 表示从100字节处开始下载到200字节处结束
***************
procedure TForm1.Button6Click(Sender: TObject);
var
f:TSearchRec;
begin
FindFirst('a.doc',faAnyFile,f);
fPreSize:=f.Size;
NMFtp.DoCommand('Rest '+IntToStr(fPreSize));
NMFtp.DownloadRestore('a.doc','a.doc');
end;
这是用TNMFtp来续传的代码。
firstrose (2003-06-29 13:52:00)
如果直接用socket，可以研究一下rfc。里面有命令说明
lxhui99s039 (2004-06-07 11:59:57)
多人接受答案了。
firstrose-20,lxhui99s018-120,xianjun-40,zhu_jy-20,的回答最终被接受。
G
ghy412
Unregistered / Unconfirmed
GUEST, unregistred user!
晕，怎么看不到回贴的内容呢！