下载大文件时，断点续传是很有必要的，特别是网速度慢且不稳定的情况下，很难保证不出意外，一旦意外中断，又要从头下载，会很让人抓狂。断点续传就能很好解决意外中断情况，再次下载时不需要从头下载，从上次中断处继续下载即可，这样下载几G或十几G大小的一个文件都没问题。本文介绍利用miniframe开源Web框架分别在lazarus、delphi下实现文件HTTP下载断点续传的功能。

本文Demo还实现了批量下载文件，同步服务器上的文件到客户端的功能。文件断点续传原理：分块下载，下载后客户端逐一合并，同时保存已下载的位置，当意外中断再次下载时从保存的位置开始下载即可。这其中还要保证，中断后再次下载时服务器上相应的文件如果更新了，还得重新下载，不然下载到的文件是错了。说明：以下代码lazarus或delphi环境下都能使用。全部源码及Demo请到miniframe开源web框架下载: https://www.wyeditor.com/miniframe/或https://github.com/dajingshan/miniframe。

服务器端代码

文件下载断点续传服务器端很简单，只要提供客户端要求下载的开始位置和指定大小的块即可。

以下是服务器获取文件信息和下载一个文件一块的代码：

<%@//Script头、过程和函数定义
program codes;
%>
 
<%!//声明变量
var
  i,lp: integer;
  FileName, RelativePath, FromPath, ErrStr: string;
  json: TminiJson;
  FS: TFileStream;
  
function GetOneDirFileInfo(Json: TminiJson; Path: string): string;
var
  Status: Integer;
  SearchRec: TSearchRec;
  json_sub: TminiJson;
begin
  Path := PathWithSlash(Path);
  SearchRec := TSearchRec.Create;
  Status := FindFirst(Path + '*.*', faAnyFile, SearchRec);
  try
    while Status = 0 do
    begin 
      if SearchRec.Attr and faDirectory = faDirectory then
      begin
        if (SearchRec.name <> '.') and (SearchRec.name <> '..') then
          GetOneDirFileInfo(Json, Path + SearchRec.Name + '\');
      end else
      begin
        FileName := Path + SearchRec.Name;
        try
          if FileExists(FileName) then
          begin 
            json_sub := Pub.GetJson;  
            json_sub.SO; //初始化 或 json.Init;    
            json_sub.S['filename'] := SearchRec.name;
            json_sub.S['RelativePath'] := GetDeliBack(FileName, FromPath);
            json_sub.S['FileTime'] := FileGetFileTimeA(FileName);
            json_sub.I['size'] := SearchRec.Size;
            json.A['list'] := json_sub;
          end;
        except
          //print(ExceptionParam)
        end;//}
      end; 
      Status := FindNext(SearchRec);
    end;
  finally
    FindClose(SearchRec);
    SearchRec.Free;
  end;//*) 
end;
%>
<%
begin
  FromPath := 'D:\code\delphi\sign\发行文件'; //下载源目录
  
  json := Pub.GetJson; //这样创建json对象不需要自己释放，系统自动管理
  json.SO; //初始化 或 json.Init;
  
  // 验证是否登录代码
  {if not Request.IsLogin('Logined') then
  begin 
    json.S['retcode'] := '300';
    json.S['retmsg'] := '你还没有登录(no logined)！'; 
    print(json.AsJson(true));
    exit; 
  end;//} 
  
  json.S['retcode'] := '200';
  json.S['retmsg'] := '成功！';
  if Request.V('opr') = '1' then
  begin //获取服务上指定目录的文件信息
    GetOneDirFileInfo(Json, FromPath);
  end else
  if Request.V('opr') = '2' then
  begin //下载指定文件给定大小的块 
    FromPath := PathWithSlash(FromPath);   
    RelativePath := Request.V('fn');
    FileName := FromPath + RelativePath;
    Fs := Pub.GetFS(FileName, fmShareDenyWrite, ErrStr);
    if trim(ErrStr) <> '' then 
    begin
      json.S['retcode'] := '300';
      json.S['retmsg'] := ErrStr;
      print(json.AsJson(true));  
      exit;
    end;
    Fs.Position := StrToInt(Request.V('pos'));
    Response.ContentStream := TMemoryStream.Create; //注意不能用 Pub.GetMs，这是因为Pub.GetMs创建的对象在动态脚本运行完就释放了
    Response.ContentStream.CopyFrom(Fs, StrToInt(Request.V('size')));
    //返回流数据
    Response.ContentType := 'application/octet-stream';   
  end;
  print(json.AsJson(true));
end;
%>

客户端代码

客户端收到块后，进行合并。全部块下载完成后，还要把新下载的文件的文件修改为与服务器上的文件相同。以下是客户端实现的主代码：

procedure TMainForm.UpgradeBlock_Run(var ThreadRetInfo: TThreadRetInfo);
const
  BlockSize = 1024*1024; //1M
var
  HTML, ToPath, RelativePath, FN, Tmp, TmpFileName, FailFiles, SuccFiles, Newfn, TmpToPath: string;
  Json, TmpJson: TminiJson;
  lp, I, Number, HadUpSize, AllSize, AllBlockCount, MySize, MyNumber: Int64;
  Flag: boolean;
  SL, SLDate, SLSize, SLTmp: TStringlist;
  MS: TMemoryStream;
  Fs: TFileStream;
  procedure HintMsg(Msg: string);
  begin
    FMyMsg := Msg; // '正在获取文件列表。。。';
    ThreadRetInfo.Self.Synchronize(ThreadRetInfo.Self, MyUpdateface); //为什么不直接用匿名，因为laz不支持
  end;
begin
  ToPath := 'D:\superhtml'; //如果是当前程序更新  ExtractFilePath(ParamStr(0))
 
  ThreadRetInfo.Ok := false;
 
  HintMsg('正在获取文件列表。。。');
  if not HttpPost('/接口/同步文件到客户端.html?opr=1',
      '', ThreadRetInfo.ErrStr, ThreadRetInfo.HTML) then exit;
  if Pos('{', ThreadRetInfo.HTML) <> 1 then
  begin
    ThreadRetInfo.ErrStr :='请先检查脚本源码是否配置正确！';
    exit;
  end;
  ToPath := Pub.PathWithSlash(ToPath);
 
  Json := TminiJson.Create;
  SL := TStringlist.Create;
  SLDate := TStringlist.Create;
  SLSize := TStringlist.Create;
  SLTmp := TStringlist.Create;
  try
    Json.LoadFromString(ThreadRetInfo.HTML);
    if json.S['retcode'] = '200' then
    begin
      TmpJson := json.A['list'];
      for lp := 0 to TmpJson.length - 1 do
      begin
        HintMsg(lp.ToString + '/' + TmpJson.length.ToString + '正在检查文件:' + RelativePath);
        RelativePath := TmpJson[lp].S['RelativePath'];
        if trim(RelativePath) = '' then Continue;
        Flag := FileExists(ToPath + RelativePath);
        if Flag then
        begin
          if (PubFile.FileGetFileTimeA(ToPath + RelativePath) = TmpJson[lp].S['FileTime']) and
             (PubFile.FileGetFileSize(ToPath + RelativePath) = TmpJson[lp].I['Size']) then
          else
            Flag := false;
        end;
        if not Flag then //此文件需要更新
        begin
          SL.Add(RelativePath);
          SLDate.Add(TmpJson[lp].S['FileTime']);
          SLSize.Add(TmpJson[lp].S['Size']);
        end;
      end;
 
      //开始下载
      FailFiles := '';
      SuccFiles := '';
      HintMsg('需要更新的文件共有' + IntToStr(SL.Count) + '个。。。');
      for lp := 0 to SL.Count - 1 do
      begin
        RelativePath := SL[lp];
        if RelativePath[1] = '\' then RelativePath := Copy(RelativePath, 2, MaxInt);
        FN := ToPath + RelativePath;
 
        //先计算要分几个包，以处理进度
        Number := 0;
        HadUpSize := 0;
        AllSize := StrToInt64(SLSize[lp]);
        AllBlockCount := 0;
        while true do
        begin
          AllBlockCount := AllBlockCount + 1;
          if AllSize - HadUpSize >= BlockSize then
             MySize := BlockSize
          else
             MySize := AllSize - HadUpSize;
          HadUpSize := HadUpSize + MySize;
          if HadUpSize >= AllSize then
            break;
        end;
 
        //开始分块下载
        Number := 0;
        HadUpSize := 0;
        //AllSize := Fs.Size;
        //TmpToPath := PubFile.FileGetTemporaryPath;
        Newfn := '@_' + PubPWD.GetMd5(SLDate[lp] + SLSize[lp]) + ExtractFileName(FN);  //Pub.GetClientUniqueCode;
 
        if FileExists(ToPath + Newfn) and (FileExists(FN)) then
        begin
          SLTmp.LoadFromFile(ToPath + Newfn);
          MyNumber := StrToInt64(trim(SLTmp.Text));
          Fs := TFileStream.Create(FN, fmOpenWrite);
        end else
        begin
          MyNumber := 0;
          Fs := TFileStream.Create(FN, fmCreate);
        end;
        try
          while true do
          begin
            HintMsg('正在下载文件[' + Pub.GetDeliBack(RelativePath, '@@') + ']第[' + IntToStr(Number + 1) + '/' + IntToStr(AllBlockCount) + ']个包。。。');
 
            if AllSize - HadUpSize >= BlockSize then
               MySize := BlockSize
            else
               MySize := AllSize - HadUpSize;
            Number := Number + 1;
            if (MyNumber = 0) or (Number >= MyNumber) or (HadUpSize + MySize >= AllSize) then
            begin
              for I := 1 to 2 do //意外出错重试一次
              begin
                if not HttpPost('/接口/同步文件到客户端.html?opr=2fn=' + UrlEncode(RelativePath) +
                  'pos=' + UrlEncode(IntToStr(HadUpSize)) + 'size=' + UrlEncode(IntToStr(MySize)),
                  '', ThreadRetInfo.ErrStr, ThreadRetInfo.HTML, MS) then
                begin
                  if I = 2 then
                  begin
                    ThreadRetInfo.ErrStr := Json.S['retmsg'];
                    exit;
                  end else
                    Continue;
                end;
                if Pos('{', ThreadRetInfo.HTML) < 1 then
                begin
                  if I = 2 then
                  begin
                    ThreadRetInfo.ErrStr := Json.S['retmsg'];
                    exit;
                  end else
                    Continue;
                end;
 
                Json.LoadFromString(ThreadRetInfo.HTML);
                if json.S['retcode'] <> '200' then
                begin
                  if I = 2 then
                  begin
                    ThreadRetInfo.ErrStr := Json.S['retmsg'];
                    exit;
                  end else
                    Continue;
                end;
                break;
              end;
 
              if MS = nil then
              begin
                ThreadRetInfo.ErrStr := '没能下载到文件[' + RelativePath + ']！' + json.S['retmsg'];
                exit;
              end else
              begin
                Fs.Position := HadUpSize;
                MS.Position := 0;
                Fs.CopyFrom(MS, MS.Size);
                MS.Free;
                MS := nil;
                SLTmp.Text := Number.ToString;
                try
                  SLTmp.SaveToFile(ToPath + Newfn);
                except
                end;
              end;
            end;
            HadUpSize := HadUpSize + MySize;
 
            if HadUpSize >= AllSize then
            begin //全部下载完成
              Fs.Free;
              Fs := nil;
              Sleep(10);
              PubFile.FileChangeFileDate(Fn, SLDate[lp]);
              DeleteFile(ToPath + Newfn);
              SuccFiles := SuccFiles + #13#10 + RelativePath;
              break;
            end;
          end;
        finally
          if Fs <> nil then
            Fs.Free;
        end;
      end;
      ThreadRetInfo.HTML := '';
      if trim(SuccFiles) <> '' then
        ThreadRetInfo.HTML := '本次更新了以下文件：'#13#10 + SuccFiles;
      //if trim(FailFiles) <> '' then
        //ThreadRetInfo.HTML := trim(ThreadRetInfo.HTML + #13#10'以下文件更新失败：'#13#10 + FailFiles);
    end;
  finally
    SLTmp.Free;
    SLSize.Free;
    SL.Free;
    Json.Free;
    SLDate.Free;
  end;
  ThreadRetInfo.Ok := true;
end;

以下是Demo运行界面：