unit1.pas

这两个函数 function app_path1:string function socket_rec_line1(socket1:TCustomWinSocket timeout1:integ

unit Unit1;

interface

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

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

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;

procedure TForm1.Button4Click(Sender: TObject);
begin
  self.stop1:=true;
end;

end.