ubreakpoint.pas

来自「断点续传的整理演示代码 断点续传的整理演示代码」· PAS 代码 · 共 338 行

unit UBreakPoint;

interface

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

type
  TBufChar = array [0..4095] of Char;
  TBufByte = array [0..4095] of Byte;

type
  TfrmBreakPoint = class(TForm)
    ClientSocket1: TClientSocket;
    pnlMain: TPanel;
    edtHostAddr: TEdit;
    btnStartDownload: TButton;
    edtSaveFile: TEdit;
    btnGetHeadInfo: TButton;
    btnStopDownload: TButton;
    Label2: TLabel;
    Label3: TLabel;
    lblStatusInfo: TLabel;
    Memo1: TMemo;
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure btnStartDownloadClick(Sender: TObject);
    procedure edtHostAddrChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure edtSaveFileChange(Sender: TObject);
    procedure btnGetHeadInfoClick(Sender: TObject);
    procedure btnStopDownloadClick(Sender: TObject);
    procedure edtHostAddrClick(Sender: TObject);
  private
    procedure MessageInfo(SetInfo: string);
    { Private declarations }
  public
    { Public declarations }
    LocalFileName: string;    {本地文件名}
    ServerFileName: string;   {服务器端文件名}
    ServerHost: string;       {服务器地址}
    IsRev: Boolean;           {是否可以接收}
    IsStop: Boolean;          {是否停止}
  end;

var
  frmBreakPoint: TfrmBreakPoint;
  RecDownPoint: 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
  bufInfo: TBufChar;
  i: Integer;
  strStream: TStringStream; {保存所有的数据}
  FSocketStream: TWinSocketStream;
begin
  strStream := TStringStream.Create('');
  FSocketStream := TWinSocketStream.Create(Socket, TimeOut);
  while Socket.Connected do
  begin
    {确定接收的超时，可见WaitForData的源码}
    if not FSocketStream.WaitForData(TimeOut) then Break;
    ZeroMemory(@bufInfo, SizeOf(bufInfo));
    {每次只读一个字符，以免读入了命令外的数据}
    i := FsocketStream.Read(bufInfo, 1);
    if i = 0 then Break;
    strStream.Write(bufInfo, i);
    if pos(EndStr, strStream.DataString) <> 0 then Break;
  end;
  Result := strStream.DataString;
  {没有读到回车换行符,就表示有超时错，这时返回空字符串}
  if Pos(EndStr, Result) = 0 then Result := '';
  strStream.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 TfrmBreakPoint.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  memo1.Lines.Add(Socket.ReceiveText);
end;

procedure TfrmBreakPoint.btnStartDownloadClick(Sender: TObject);
var
  URLAppPath: string;
  BufInfo: TBufByte;
  Rec: Longint;
  TempFile: File;
  cmd1: string; //这一行的内容
  RecLen, RealRecLen: LongInt; //服务器返回的长度;实际已经收到的长度
  value1:string; //标志们的值
  TotalLen: LongInt; //数据总长
begin
  if Trim(edtHostAddr.Text) = '' then Exit;
  try
    AssignFile(TempFile, LocalFileName);
    IsRev := False;
    IsStop := False;
    if FileExists(LocalFileName) then
    begin
      ReSet(TempFile, 1);
      RecDownPoint := FileSize(TempFile);
    end
    else
    begin
      ReWrite(TempFile, 1);
      RecDownPoint := 0;
    end;
    Seek(TempFile, RecDownPoint);
    ClientSocket1.Active := False;
    ClientSocket1.Host := GetHost(edtHostAddr.Text);
    ClientSocket1.Port := 80;
    URLAppPath := '';
    ServerFileName := GetFile(edtHostAddr.Text);
    ServerHost := GetHost(edtHostAddr.Text);
    ClientSocket1.Active := False;
    ClientSocket1.Active := True;
    URLAppPath := '';
    URLAppPath := URLAppPath + 'HEAD /' + Self.ServerFileName + ' HTTP/1.1' + #13#10;
    URLAppPath := URLAppPath + 'Pragma: no-cache' + #13#10;
    URLAppPath := URLAppPath + 'Cache-Control: no-cache' + #13#10;
    URLAppPath := URLAppPath + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
    URLAppPath := URLAppPath + 'Host: ' + ServerHost + #13#10;
    URLAppPath := URLAppPath + #13#10;
    ClientSocket1.Socket.SendText(URLAppPath);
    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));
        TotalLen:= StrToInt(Trim(value1));
      end;
      if cmd1 = #13#10 then Break;
    end;
    clientsocket1.Active := False;
    clientsocket1.Active := True;
    URLAppPath := '';
    URLAppPath := URLAppPath + 'GET /' + Self.ServerFileName + ' HTTP/1.1'+#13#10;
    URLAppPath := URLAppPath + 'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
    URLAppPath := URLAppPath + 'Cache-Control: no-cache' + #13#10;
    URLAppPath := URLAppPath + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
    URLAppPath := URLAppPath + 'RANGE: bytes=' + IntToStr(RecDownPoint) + '-' + #13#10;
    URLAppPath := URLAppPath + 'Host: ' + Self.ServerHost + #13#10;
    URLAppPath := URLAppPath + #13#10;
    ClientSocket1.Socket.SendText(URLAppPath);
    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;
      if Pos(LowerCase('Content-Length: '), LowerCase(cmd1)) = 1 then
      begin
        value1 := Copy(cmd1, Length('Content-Length: ')+1, Length(cmd1));
        RecLen := StrToInt(Trim(value1));
      end;
      if cmd1 = #13#10 then Break;
    end;
    RealRecLen := 0;
    while ClientSocket1.Active = True do
    begin
      if IsStop then Break;
      {不能接收则退出}
      if not IsRev then Break;
      {如果文件当前的长度大于服务器标识的长度,则是出错了，不要写入文件中}
      if FileSize(TempFile) >= TotalLen then
      begin
        MessageInfo('当前文件已下载完成');
        Break;
      end;
      ZeroMemory(@BufInfo, SizeOf(BufInfo));
      Rec := ClientSocket1.Socket.ReceiveBuf(BufInfo, SizeOf(BufInfo));
      {如果实际收到的长度大于服务器标识的长度,则是出错了，不要写入文件中}
      if RealRecLen >= RecLen then
      begin
        MessageInfo('当前文件已下载完成');
        Break;
      end;
      {如果当前的长度大于服务器标识的长度,则是出错了，不要写入文件中}
      if RecDownPoint = RecLen then
      begin
        MessageInfo('当前文件已下载完成');
        Break;
      end;
      BlockWrite(TempFile, BufInfo, Rec);
      RealRecLen := RealRecLen + Rec;
      lblStatusInfo.Caption := FormatFloat('#,##',RealRecLen) + '/' + FormatFloat('#,##', RecLen);
      lblStatusInfo.Caption := lblStatusInfo.Caption + '->' + IntToStr(Trunc((RealRecLen/RecLen)*100)) + '%';
      Application.ProcessMessages;
    end;
    CloseFile(TempFile);
    ClientSocket1.Active := False;
  except
    CloseFile(TempFile);
    MessageInfo('无法链接到远程主机');
  end;
end;

procedure TfrmBreakPoint.edtHostAddrChange(Sender: TObject);
var
  ConfigIni: TIniFile;
begin
  ConfigIni := TIniFile.Create(GetAppPath + 'Config.ini');
  try
    ConfigIni.WriteString('File', 'Host', edtSaveFile.Text);
    LocalFileName := edtSaveFile.Text;
    edtSaveFile.Text := GetFile(edtHostAddr.Text);
  finally
    ConfigIni.Free;
  end;
end;

procedure TfrmBreakPoint.FormCreate(Sender: TObject);
var
  ConfigIni: TIniFile;
begin
  ConfigIni := TIniFile.Create(GetAppPath + 'Config.ini');
  try
    edtHostAddr.Text := ConfigIni.ReadString('File', 'Host', edtHostAddr.Text);
    LocalFileName := ConfigIni.ReadString('File', 'SaveFileName', '');
    edtSaveFile.Text := LocalFileName;
  finally
    ConfigIni.Free;
  end;
end;

procedure TfrmBreakPoint.edtSaveFileChange(Sender: TObject);
var
  ConfigIni: TIniFile;
begin
  ConfigIni := TIniFile.Create(GetAppPath + 'Config.ini');
  try
    ConfigIni.WriteString('File', 'SaveFileName', edtSaveFile.Text);
    LocalFileName := edtSaveFile.Text;
  finally
    ConfigIni.Free;
  end;
end;

procedure TfrmBreakPoint.btnGetHeadInfoClick(Sender: TObject);
var
  URLAppPath: string;
  bufInfo: TBufByte;
  {服务器返回的长度;实际已经收到的长度}
  //Rec, RecLen: Longint;
begin
  if Trim(edtHostAddr.Text) = '' then Exit;
  IsStop := False;
  ClientSocket1.Active := False;
  ClientSocket1.Host := GetHost(edtHostAddr.Text);
  ClientSocket1.Port := 80;
  ClientSocket1.Active := True;
  URLAppPath := '';
  try
    ServerFileName:=GetFile(edtHostAddr.Text);
    ServerHost:=GetHost(edtHostAddr.Text);
    URLAppPath := URLAppPath + 'GET /' + ServerFileName + ' HTTP/1.1'+#13#10;
    URLAppPath := URLAppPath + 'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*' + #13#10;
    URLAppPath := URLAppPath + 'Cache-Control: no-cache' + #13#10;
    URLAppPath := URLAppPath + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)' + #13#10;
    URLAppPath := URLAppPath + 'RANGE: bytes=' + IntToStr(533263) + '-533263' + #13#10;
    URLAppPath := URLAppPath + 'Host: ' + ServerHost + #13#10;
    URLAppPath := URLAppPath + #13#10;
    ClientSocket1.Socket.SendText(URLAppPath);
    begin
      ZeroMemory(@bufInfo, SizeOf(bufInfo));
      //Rec := ClientSocket1.Socket.ReceiveBuf(bufInfo, SizeOf(bufInfo));
      //RecLen := RecLen + Rec;
      Memo1.Lines.Add(StrPas(@bufInfo));
      Application.ProcessMessages;
    end;
  except
    ShowMessage('ClientSocket Get Data Error');
  end;
  ClientSocket1.Active := False;
end;

procedure TfrmBreakPoint.btnStopDownloadClick(Sender: TObject);
begin
  IsStop := True;
end;

procedure TfrmBreakPoint.edtHostAddrClick(Sender: TObject);
begin
  edtHostAddr.SelectAll;
end;

procedure TfrmBreakPoint.MessageInfo(SetInfo: string);
begin
  MessageBox(Handle, PChar(SetInfo), '信息提示', MB_OK+MB_ICONINFORMATION);
end;

end.