整容说文库 > 程序代码 > 教育资讯

关于多线程下载(Http)!

来源:学生作业帮助网 编辑:整容说文库 时间:2020/03/30 15:37:36 程序代码
关于多线程下载(Http)!程序代码
最近想做一个多线程下载的东东遇到一个问题,怎样控制每个线程下载的字节数(我用的是TClientSocket)!
一个例子:
unit Unit1;

interface

uses
  filectrl,IniFiles,Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, ExtCtrls,Variants;

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

type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    Memo1: TMemo;
    Panel1: TPanel;
    Edit1: TEdit;
    Button1: TButton;
    Edit2: TEdit;
    Button3: TButton;
    Button4: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Label1: TLabel;
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Edit1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    filename1:string; //本地文件名
    serfilename:string;  //服务器端文件名
    serhost1:string;  //服务器地址
    can_rec1:boolean; //是否可以接收
    stop1:boolean; //是否停止
  end;

var
  Form1: TForm1;
  pos1:longint; //上次下载到的位置

implementation

{$R *.dfm}

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 (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;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  memo1.Lines.Add(socket.ReceiveText);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  url1:string;
  buf1:Tbuf_byte;
  rec1:longint;
  f1:file;
  cmd1:string; //这一行的内容
  reclen1,real_reclen1:longint; //服务器返回的长度;实际已经收到的长度
  value1:string; //标志们的值
  total_len1:longint; //数据总长
begin
  try
    //self.filename1:='c:\temp1.dat';
    assignfile(f1,self.filename1);
    can_rec1:=false;
    self.stop1:=false;
    if FileExists(self.filename1)=true then
    begin
      reset(f1,1);
      pos1:=filesize(f1);
    end
    else
    begin
      rewrite(f1,1);
      pos1:=0;
    end;
    seek(f1,pos1);
    ClientSocket1.Active:=false;
    ClientSocket1.Host:=get_host1(edit1.Text);
    ClientSocket1.Port:=80;
    url1:='';
    self.serfilename:=get_file1(edit1.Text);
    self.serhost1:=get_host1(edit1.Text);
    //取得文件长度以确定什么时候结束接收[通过"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+'GET http://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;
    closefile(f1);
    showmessage('ok');
    //发送get请求,以得到实际的文件数据_end;
    ClientSocket1.Active:=false;
  except
    closefile(f1);
    showmessage('discon...');
  end;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  url1:string;
begin
  {  url1:='';
  url1:=url1+'GET http://clq.51.net/textfile.zip 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+'Host: clq.51.net'+#13#10;
  url1:=url1+'Connection: Keep-Alive'+#13#10;
  url1:=url1+#13#10;
  ClientSocket1.Socket.SendText(url1);
 }
end;

procedure TForm1.Edit1Change(Sender: TObject);
var
  ini1:tinifile;
begin
  ini1:=tinifile.Create(app_path1+'sys1.ini');
  ini1.WriteString('file1','host1',edit1.Text);
  ini1.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ini1:tinifile;
begin
  ini1:=tinifile.Create(app_path1+'sys1.ini');
  edit1.Text:=ini1.ReadString('file1','host1',edit1.Text);
  self.filename1:=ini1.ReadString('file1','filename1','c:\temp1.dat');
  edit2.Text:=self.filename1;
  //pos1:=filesize(
  ini1.Free;
end;

procedure TForm1.Edit2Change(Sender: TObject);
var
  ini1:tinifile;
begin
  ini1:=tinifile.Create(app_path1+'sys1.ini');
  ini1.WriteString('file1','filename1',edit2.Text);
  self.filename1:=edit2.Text;
  ini1.Free;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  url1:string;
  buf1:Tbuf_byte;
  rec1:longint;
  f1:file;
  cmd1:string; //这一行的内容
  reclen1,real_reclen1:longint; //服务器返回的长度;实际已经收到的长度
  value1:string; //标志们的值
begin
    self.stop1:=false;
    ClientSocket1.Active:=false;
    ClientSocket1.Host:=get_host1(edit1.Text);
    ClientSocket1.Port:=80;
    ClientSocket1.Active:=true;
    url1:='';
    self.serfilename:=get_file1(edit1.Text);
    self.serhost1:=get_host1(edit1.Text);
    //url1:=url1+'GET http://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+'HEAD /'+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(533263)+'-533263'+#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
      zeromemory(@buf1,sizeof(buf1));
      rec1:=ClientSocket1.Socket.ReceiveBuf(buf1,sizeof(buf1));
      real_reclen1:=real_reclen1+rec1;
      memo1.Lines.Add(strpas(@buf1));
      application.ProcessMessages;
      //if self.stop1=true then break;
    end;
    ClientSocket1.Active:=false;
    showmessage('ok');
end;
谢谢!不过,这不是多线程呀!?????
GZ
程序代码