ubreakpoint.pas

可以进行续传的例子代码

unit UBreakPoint;

interface

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

type
  TBufChar = array[0..4095] of Char;
  TBufByte = 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);
    procedure Edit1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    LocalFileName: string;    //本地文件名
    ServerFileName: string;   //服务器端文件名
    ServerHost: string;       //服务器地址
    IsRev: Boolean;           //是否可以接收
    IsStop: Boolean;          //是否停止
  end;

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

implementation

{$R *.dfm}

function GetAppPath: string;
begin
  Result:=ExtractFilePath(Application.ExeName);
end;
//接收一行数据//socket,超时，结束符
function SocketRevLine(Socket: TCustomWinSocket; TimeOut: Integer; EndStr: string = #13#10): string;
var
  buf1:TBufChar;
  r1:integer;
  ts1:TStringStream; //保存所有的数据
  FSocketStream: TWinSocketStream;
begin
  ts1:=TStringStream.Create('');
  FSocketStream:= TWinSocketStream.create(Socket, TimeOut);
  //while true do//下面的一句更安全,不过对本程序好象没起作用
  while Socket.Connected do
  begin
    //确定是否可以接收数据
    //只能确定接收的超时，可见WaitForData的源码
    if not FSocketStream.WaitForData(TimeOut) 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(EndStr, ts1.DataString) <> 0 then break;
  end;
  result:=ts1.DataString;
  //没有读到回车换行符,就表示有超时错，这时返回空字符串
  if pos(EndStr,result) = 0 then result:='';
  ts1.Free;
  FSocketStream.Free;
end;

function GetHost(Input: string): string;
begin
  Input := Trim(Input);
  if pos('http://', lowercase(Input)) = 1 then
  begin
    Input := copy(Input, length('http://') + 1, Length(Input));
  end;
  if pos('/', Input) <> 0 then
  begin
    Input := copy(Input, 0, pos('/', Input) - 1);
  end;
  Result := Input;
end;

function GetFile(Input: string): string;
begin
  Input := Trim(Input);
  if pos('http://',LowerCase(Input)) = 1 then
  begin
    Input := copy(Input, Length('http://') + 1, Length(Input));
  end;
  if pos('/', Input) <> 0 then
  begin
    Input := copy(Input, pos('/', Input) + 1, Length(Input));
  end;
  Result := Input;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  memo1.Lines.Add(socket.ReceiveText);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    url1: string;
    buf1: TBufByte;
    rec1: LongInt;
    f1: File;
    cmd1: string; //这一行的内容
    reclen1,real_reclen1: LongInt; //服务器返回的长度;实际已经收到的长度
    value1:string; //标志们的值
    total_len1: LongInt; //数据总长
begin
    try
        AssignFile(f1, LocalFileName);
        IsRev := False;
        IsStop := False;
        if FileExists(LocalFileName) 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 := GetHost(edit1.Text);
        ClientSocket1.Port := 80;
        url1 := '';
        ServerFileName := GetFile(edit1.Text);
        ServerHost := GetHost(edit1.Text);
        //取得文件长度以确定什么时候结束接收[通过"head"请求得到]
        ClientSocket1.Active:=false;
        ClientSocket1.Active:=true;
        url1:='';
        url1:=url1+'HEAD /'+self.ServerFileName+' 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: ' + ServerHost + #13#10;
        url1 := url1+#13#10;
        ClientSocket1.Socket.SendText(url1);
        while ClientSocket1.Active do
        begin
            if IsStop then break;
            cmd1 := SocketRevLine(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.ServerFileName+' 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.ServerHost+#13#10;
        //应该可以不要
        //url1:=url1+'Connection: Keep-Alive'+#13#10;
        url1:=url1+#13#10;
        ClientSocket1.Socket.SendText(url1);
        while ClientSocket1.Active=true do
        begin
            if IsStop then break;
            cmd1 := SocketRevLine(ClientSocket1.Socket,60*1000);
            //是否可接收
            if pos(LowerCase('Content-Range:'), LowerCase(cmd1)) = 1 then
            begin
                IsRev := 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 IsStop then Break;
            //不能接收则退出
            if not IsRev 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
    ConfigIni: TIniFile;
begin
    ConfigIni := TIniFile.Create(GetAppPath + 'Config.ini');
    ConfigIni.WriteString('File', 'Host', Edit2.Text);
    LocalFileName := Edit2.Text;
    ConfigIni.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
    ConfigIni: TIniFile;
begin
    ConfigIni := TIniFile.Create(GetAppPath + 'Config.ini');
    Edit1.Text := ConfigIni.ReadString('File','Host', Edit1.Text);
    LocalFileName := ConfigIni.ReadString('File','SaveFileName','');
    Edit2.Text := LocalFileName;
    ConfigIni.Free;
end;

procedure TForm1.Edit2Change(Sender: TObject);
var
    ConfigIni: TIniFile;
begin
    ConfigIni := TIniFile.Create(GetAppPath + 'Config.ini');
    ConfigIni.WriteString('File', 'SaveFileName', Edit2.Text);
    LocalFileName := Edit2.Text;
    ConfigIni.Free;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
    url1:string;
    buf1:TBufByte;
    rec1:longint;
    cmd1:string; //这一行的内容
    real_reclen1:longint; //服务器返回的长度;实际已经收到的长度
    value1:string; //标志们的值
begin
    IsStop := False;
    ClientSocket1.Active:=false;
    ClientSocket1.Host:=GetHost(edit1.Text);
    ClientSocket1.Port:=80;
    ClientSocket1.Active:=true;
    url1:='';
    ServerFileName:=GetFile(edit1.Text);
    ServerHost:=GetHost(edit1.Text);
    url1:=url1+'GET /' + ServerFileName + ' 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: ' + ServerHost + #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;
    end;
    ClientSocket1.Active := False;
    //showmessage('ok');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
    IsStop := True;
end;

procedure TForm1.Edit1Click(Sender: TObject);
begin
    Edit1.Text := '';
end;

end.