登录 用户中心() [退出] 后台管理 注册
 

热门搜索:
您的位置:首页 >> 马上代码 >> 马上代码 >> 主题: 断点续传原理代码 [我用它下载dfw的400M数据]
标题 断点续传原理代码 [我用它下载dfw的400M数据]
clq
浏览(1314) 2004-08-01 16:38:36 发表 编辑

关键字:

[hide=0] -------------------------------------------------------------

点击浏览该文件
其实改动不多,我实在是不好意思.一会贴点别的,要不太没面子.
-------------------------------------------------------------
这两个函数
function app_path1:string;
function socket_rec_line1(socket1:TCustomWinSocket;timeout1:integer;crlf1:string=#13#10):string;
实际上是我的一个公用单元中的函数,大家应该养成建立自己的公用单元的习惯。
socket_rec_line1函数中用了唐晓峰大侠的coolmail中的办法:只是简单的一个一个字节收取,找到结束
标志后就算收完一行了,大家实际应用时可能应该找更好的办法。

这个程序的目的是:flashget在下载象51.net系列[如我的clq.51.net]中的程序时,会因为这些网站上的
自定义错误页面而导致下载的文件出错,具体见“大富翁”上的
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1170159
虽然这是一个演示程序,不能下载地址转向的东东。但对于固定地址文件的下载已经很不错了,我的公司
不能装多线程的东东我一直用这个下载我要的大文件,“大富翁”200多M的离线数据这是用它下载的。

大家对源码有什么不明白的请在 http://www.delphibbs.com/delphibbs/dispq.asp?lid=1170159 ”中提
出。

--------------------------------------------------------------------------------------------
本程序能改正flashget的这个bug是因为我们用http的头信息中是否包含
“Content-Range: bytes 533263-533263/565691”
这样的符号来判断服务器返回的是否是我们要的文件信息。而flashget则不是这样的,如果哪位网友能
通知flashget的作者改正这个bug我将感激不尽!我与其作者联系过,但他只回了一封信,问题并没有解
决。:( 如果有网友发现flashget新版本中解决了这个问题,也请您告诉我一声,先谢谢您了!
--------------------------------------------------------------------------------------------


clq
or
real_clq

2002.10.8
--------------------------------------------------------------------------------------------
新版本改为支持delphi7,并打算发布一个让程序象"瑞星"一样自动更新的控件,详情在论坛上 http://clqsoft.com )

clq
or
real_clq

2004.03.03[/hide]

附件[暂不开放下载]
clq
2004-8-1 16:41:13 发表 编辑

从旧论坛转过来的.
clq
2004-8-1 16:44:29 发表 编辑

这是一个程序自动更新的代码片段:(线程部分没写好的,别乱用,我回国后会给新的)
---------------------------------------------------
unit UnitTDownFileThread1;
{
/******************************************************************************/
By clq
程序自动更新组件
版本:1.0
开发日期:2004.2.19
最后更新:2004.2.19
/******************************************************************************/
}

interface

uses
Classes, filectrl, inifiles, Windows, Messages, SysUtils, Variants, ExtCtrls,
Graphics, Controls, Forms,Dialogs, StdCtrls, ScktComp, IdBaseComponent,IdHTTP,
IdComponent, IdTCPConnection, IdTCPClient
;

type
Tbuf_char=array[0..4095] of char;
Tbuf_byte=array[0..4095] of byte;

type
TDownFileThread1 = class(TThread)
private
{ Private declarations }
Files:TStringList;
AllFileReset:boolean; //是否所有的文件都要重新下载
function DownOneFile(url:string;filename:string):boolean;
procedure UpdateFiles;
function GetServerInfo:boolean;
private //本节为临时变量
ClientSocket1: TClientSocket;
IdHTTP1: TIdHTTP;
serfilename:string; //服务器端文件名
serhost1:string; //服务器地址
can_rec1:boolean; //是否可以接收
pos1:longint; //上次下载到的位置
stop1:boolean; //是否停止

protected
procedure Execute; override;
public
ServerInfoUrl:string; //文件列表的url
ServerInfo:TStringList; //文件列表的内容
FilesVer:string; //当前本机上的文件组版本
end;

implementation

{Synchronize()}
{
一个文件列表的内容示例

<data> //标识头 -- 用以保证数据完整性
ver=2004.2.19.001 //文件列表版本号
file_count=10
file1=email.exe //第1个文件
file2=folder1\email.exe //第2个文件
... ...
file10=folder10\email.exe //第10个文件
</data> //标识尾 -- 用以保证数据完整性

}

//****************************************************************************//
//公用函数
function app_path1:string;
begin
result:=extractfilepath(application.ExeName);
end;

//接收一行数据//socket,超时,结束符
function socket_rec_line1(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 true do//下面的一句更安全,不过对本程序好象没起作用
while (socket1.Connected=true) do
begin

//确定是否可以接收数据
//只能确定接收的超时,可见WaitForData的源码
if not FSocketStream.WaitForData(timeout1) then break; //continue;

//这一句是一定要有的,以免返回的数据不正确
zeromemory(@buf1,sizeof(buf1));
r1 := FsocketStream.Read(buf1, 1); //每次只读一个字符,以免读入了命令外的数据
//读不出数据时也要跳出,要不会死循环
if r1=0 then break; //test
//用FsocketStream.Read能设置超时
//r1:=socket1.ReceiveBuf(buf1,sizeof(buf1));
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;


function get_host1(in1:string):string;
begin
in1:=trim(in1);
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 get_file1(in1:string):string;
begin
in1:=trim(in1);
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;

//****************************************************************************//

{ TDownFileThread1 }

procedure TDownFileThread1.UpdateFiles;
begin
showmessage('下载成功');
end;

function TDownFileThread1.DownOneFile(url:string;filename:string):boolean;
var
url1:string;
buf1:Tbuf_byte;
rec1:longint;
f1:file;

cmd1:string; //这一行的内容
reclen1,real_reclen1:longint; //服务器返回的长度;实际已经收到的长度
value1:string; //标志们的值
total_len1:longint; //数据总长

begin
result:=false;
try

ForceDirectories(ExtractFileDir(filename));
//self.filename1:='c:\temp1.dat';
assignfile(f1,filename);
can_rec1:=false;
self.stop1:=false;

if (not AllFileReset)and(FileExists(filename)=true) then
begin
reset(f1,1);
pos1:=filesize(f1);
end
else
begin
//rewrite会自动将文件长度清空为0
rewrite(f1,1);
pos1:=0;
end;

seek(f1,pos1);


ClientSocket1.Active:=false;
ClientSocket1.Host:=get_host1(url);
ClientSocket1.Port:=80;


url1:='';

self.serfilename:=get_file1(url);
self.serhost1:=get_host1(url);

//取得文件长度以确定什么时候结束接收[通过"head"请求得到]

ClientSocket1.Active:=false;
ClientSocket1.Active:=true;
url1:='';

url1:=url1+'HEAD /'+self.serfilename+' HTTP/1.1'+#13#10;

//不使用缓存,我附加的
//与以前的服务器兼容
url1:=url1+'Pragma: no-cache'+#13#10;
//新的
url1:=url1+'Cache-Control: no-cache'+#13#10;

//不使用缓存,我附加的_end;

url1:=url1+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
//下面这句必须要有
//url1:=url1+'Host: clq.51.net'+#13#10;
url1:=url1+'Host: '+self.serhost1+#13#10;
url1:=url1+#13#10;

ClientSocket1.Socket.SendText(url1);

while ClientSocket1.Active=true do
begin

if self.stop1=true then break;

cmd1:=socket_rec_line1(ClientSocket1.Socket,60*1000);

//计算文件的长度

if pos(lowercase('Content-Length: '),lowercase(cmd1))=1 then
begin
value1:=copy(cmd1,length('Content-Length: ')+1,length(cmd1));
total_len1:=strtoint(trim(value1));
end;

//计算文件的长度_end;

if cmd1=#13#10 then break;
end;

//取得文件长度以确定什么时候结束接收_end;

//发送get请求,以得到实际的文件数据

clientsocket1.Active:=false;
clientsocket1.Active:=true;

url1:='';

//url1:=url1+'GEThttp://clq.51.net/textfile.zip HTTP/1.1'+#13#10;
//url1:=url1+'GET /textfile.zip HTTP/1.1'+#13#10;
url1:=url1+'GET /'+self.serfilename+' HTTP/1.1'+#13#10;
url1:=url1+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
//应该可以不要url1:=url1+'Accept-Language: zh-cn'+#13#10;
//应该可以不要url1:=url1+'Accept-Encoding: gzip, deflate'+#13#10;

//不使用缓存,我附加的
//与以前的服务器兼容
//url1:=url1+'Pragma: no-cache'+#13#10;
//新的
//url1:=url1+'Cache-Control: no-cache'+#13#10;

//不使用缓存,我附加的_end;

url1:=url1+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
//接受数据的范围,可选
//url1:=url1+'RANGE: bytes=533200-'+#13#10;
url1:=url1+'RANGE: bytes='+inttostr(pos1)+'-'+#13#10;
//下面这句必须要有
//url1:=url1+'Host: clq.51.net'+#13#10;
url1:=url1+'Host: '+self.serhost1+#13#10;
//应该可以不要
//url1:=url1+'Connection: Keep-Alive'+#13#10;
url1:=url1+#13#10;
ClientSocket1.Socket.SendText(url1);

while ClientSocket1.Active=true do
begin

if self.stop1=true then break;

cmd1:=socket_rec_line1(ClientSocket1.Socket,60*1000);

//是否可接收
if pos(lowercase('Content-Range:'),lowercase(cmd1))=1 then
begin
can_rec1:=true;
end;

//是否可接收_end;

//计算要接收的长度

if pos(lowercase('Content-Length: '),lowercase(cmd1))=1 then
begin
value1:=copy(cmd1,length('Content-Length: ')+1,length(cmd1));
reclen1:=strtoint(trim(value1));
end;

//计算要接收的长度_end;

//头信息收完了
if cmd1=#13#10 then break;
end;

real_reclen1:=0;
while ClientSocket1.Active=true do
begin


if self.stop1=true then break;

//不能接收则退出
if can_rec1=false then break;

//如果文件当前的长度大于服务器标识的长度,则是出错了,不要写入文件中
if filesize(f1)>=total_len1 then
begin
//showmessage('文件已经下载完毕了!');
break;
end;

zeromemory(@buf1,sizeof(buf1));
rec1:=ClientSocket1.Socket.ReceiveBuf(buf1,sizeof(buf1));

//如果实际收到的长度大于服务器标识的长度,则是出错了,不要写入文件中
if real_reclen1>=reclen1 then
begin
//showmessage('文件已经下载完毕了!');
break;

end;
//如果当前的长度大于服务器标识的长度,则是出错了,不要写入文件中
if pos1=reclen1 then
begin
//showmessage('文件已经下载完毕了!');
break;

end;

blockwrite(f1,buf1,rec1);

real_reclen1:=real_reclen1+rec1;

//Label1.Caption:=FormatFloat('#,##',real_reclen1)+'/'+FormatFloat('#,##',reclen1);
//Label1.Caption:=Label1.Caption+'->'+inttostr(trunc((real_reclen1/reclen1)*100))+'%';
//application.ProcessMessages;

end;

if total_len1=filesize(f1) then result:=true;
closefile(f1);
//showmessage('ok');

//发送get请求,以得到实际的文件数据_end;

ClientSocket1.Active:=false;

except

closefile(f1);
//showmessage('discon...');
end;

end;

function TDownFileThread1.GetServerInfo:boolean;
var
i1:integer;
begin
result:=true;

ServerInfo.Text:=IdHTTP1.Get(ServerInfoUrl);

//清除空格
for i1:=0 to ServerInfo.Count-1 do
begin
ServerInfo.Strings[i1]:=trim(ServerInfo.Strings[i1]);
end;

if ServerInfo.IndexOf('<data>')=-1 then result:=false;
if ServerInfo.IndexOf('</data>')=-1 then result:=false;

//文件需要重新下载
if self.ServerInfo.values['ver']<>FilesVer then AllFileReset:=true;
end;

procedure TDownFileThread1.Execute;
var
i1:integer;
u1,f1:string;
b_complete:boolean;
begin
AllFileReset:=false;
try

Files:=TStringList.Create;
ServerInfo:=TStringList.Create;
ClientSocket1:=TClientSocket.Create(nil);
ClientSocket1.ClientType:=ctBlocking;
IdHTTP1:=TIdHTTP.Create(nil);

//得到下载列表的信息
if GetServerInfo then
begin
for i1:=0 to strtoint(self.ServerInfo.values['file_count'])-1 do
begin
u1:=' http://127.0.0.1/down1/'+self.ServerInfo.values ['file'+inttostr(i1+1)];
//u1:=' http://127.0.0.1/down1/1.exe';
f1:=app_path1+'tmp1\'+self.ServerInfo.values['file'+inttostr(i1+1)];
if not self.DownOneFile(u1,f1)
then break;
if i1=strtoint(self.ServerInfo.values['file_count'])-1
then b_complete:=true
else b_complete:=false;
end;

//下载成功后更新整个程序组
if b_complete
then Synchronize(UpdateFiles);
end;


except
end;

IdHTTP1.Free;
ClientSocket1.Free;
ServerInfo.Free;
Files.Free;
end;

end.

     发

clq
2004-8-1 16:45:07 发表 编辑

以前写的,我都回来好几个月了.:)
zhangxins
2009-5-1 0:50:08 发表 编辑

在盒子上面看到过,非常不错的代码。要多少那个自动升级的控件做出来了吗,呵呵
clq
2009-5-1 10:58:32 发表 编辑

什么“自动升级的控件”?另外作为一个有点资本的程序员,我不太喜欢别人在提到我的代码时说“呵呵”。

总数:5 页次:1/1 首页 尾页  


发表评论:
文本/html模式切换 插入图片 文本/html模式切换


附件:




Copyright © 2005-2012 CLQ工作室, All Rights Reserved

CLQ工作室 版权所有