526互联

lazarus、delphi文件Http下载断点续传的实现

发布时间 2023-08-12 10:38:06作者: 庚金庚金

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

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

服务器端代码

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

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

  1. <%@//Script头、过程和函数定义
  2. program codes;
  3. %>
  4.  
  5. <%!//声明变量
  6. var
  7. i,lp: integer;
  8. FileName, RelativePath, FromPath, ErrStr: string;
  9. json: TminiJson;
  10. FS: TFileStream;
  12. function GetOneDirFileInfo(Json: TminiJson; Path: string): string;
  13. var
  14. Status: Integer;
  15. SearchRec: TSearchRec;
  16. json_sub: TminiJson;
  17. begin
  18. Path := PathWithSlash(Path);
  19. SearchRec := TSearchRec.Create;
  20. Status := FindFirst(Path + '*.*', faAnyFile, SearchRec);
  21. try
  22. while Status = 0 do
  23. begin
  24. if SearchRec.Attr and faDirectory = faDirectory then
  25. begin
  26. if (SearchRec.name <> '.') and (SearchRec.name <> '..') then
  27. GetOneDirFileInfo(Json, Path + SearchRec.Name + '\');
  28. end else
  29. begin
  30. FileName := Path + SearchRec.Name;
  31. try
  32. if FileExists(FileName) then
  33. begin
  34. json_sub := Pub.GetJson;
  35. json_sub.SO; //初始化 或 json.Init;
  36. json_sub.S['filename'] := SearchRec.name;
  37. json_sub.S['RelativePath'] := GetDeliBack(FileName, FromPath);
  38. json_sub.S['FileTime'] := FileGetFileTimeA(FileName);
  39. json_sub.I['size'] := SearchRec.Size;
  40. json.A['list'] := json_sub;
  41. end;
  42. except
  43. //print(ExceptionParam)
  44. end;//}
  45. end;
  46. Status := FindNext(SearchRec);
  47. end;
  48. finally
  49. FindClose(SearchRec);
  50. SearchRec.Free;
  51. end;//*)
  52. end;
  53. %>
  54. <%
  55. begin
  56. FromPath := 'D:\code\delphi\sign\发行文件'; //下载源目录
  58. json := Pub.GetJson; //这样创建json对象不需要自己释放，系统自动管理
  59. json.SO; //初始化 或 json.Init;
  61. // 验证是否登录代码
  62. {if not Request.IsLogin('Logined') then
  63. begin
  64. json.S['retcode'] := '300';
  65. json.S['retmsg'] := '你还没有登录(no logined)！';
  66. print(json.AsJson(true));
  67. exit;
  68. end;//}
  70. json.S['retcode'] := '200';
  71. json.S['retmsg'] := '成功！';
  72. if Request.V('opr') = '1' then
  73. begin //获取服务上指定目录的文件信息
  74. GetOneDirFileInfo(Json, FromPath);
  75. end else
  76. if Request.V('opr') = '2' then
  77. begin //下载指定文件给定大小的块
  78. FromPath := PathWithSlash(FromPath);
  79. RelativePath := Request.V('fn');
  80. FileName := FromPath + RelativePath;
  81. Fs := Pub.GetFS(FileName, fmShareDenyWrite, ErrStr);
  82. if trim(ErrStr) <> '' then
  83. begin
  84. json.S['retcode'] := '300';
  85. json.S['retmsg'] := ErrStr;
  86. print(json.AsJson(true));
  87. exit;
  88. end;
  89. Fs.Position := StrToInt(Request.V('pos'));
  90. Response.ContentStream := TMemoryStream.Create; //注意不能用 Pub.GetMs，这是因为Pub.GetMs创建的对象在动态脚本运行完就释放了
  91. Response.ContentStream.CopyFrom(Fs, StrToInt(Request.V('size')));
  92. //返回流数据
  93. Response.ContentType := 'application/octet-stream';
  94. end;
  95. print(json.AsJson(true));
  96. end;
  97. %>

客户端代码

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

  1. procedure TMainForm.UpgradeBlock_Run(var ThreadRetInfo: TThreadRetInfo);
  2. const
  3. BlockSize = 1024*1024; //1M
  4. var
  5. HTML, ToPath, RelativePath, FN, Tmp, TmpFileName, FailFiles, SuccFiles, Newfn, TmpToPath: string;
  6. Json, TmpJson: TminiJson;
  7. lp, I, Number, HadUpSize, AllSize, AllBlockCount, MySize, MyNumber: Int64;
  8. Flag: boolean;
  9. SL, SLDate, SLSize, SLTmp: TStringlist;
  10. MS: TMemoryStream;
  11. Fs: TFileStream;
  12. procedure HintMsg(Msg: string);
  13. begin
  14. FMyMsg := Msg; // '正在获取文件列表。。。';
  15. ThreadRetInfo.Self.Synchronize(ThreadRetInfo.Self, MyUpdateface); //为什么不直接用匿名，因为laz不支持
  16. end;
  17. begin
  18. ToPath := 'D:\superhtml'; //如果是当前程序更新 ExtractFilePath(ParamStr(0))
  19.  
  20. ThreadRetInfo.Ok := false;
  21.  
  22. HintMsg('正在获取文件列表。。。');
  23. if not HttpPost('/接口/同步文件到客户端.html?opr=1',
  24. '', ThreadRetInfo.ErrStr, ThreadRetInfo.HTML) then exit;
  25. if Pos('{', ThreadRetInfo.HTML) <> 1 then
  26. begin
  27. ThreadRetInfo.ErrStr :='请先检查脚本源码是否配置正确！';
  28. exit;
  29. end;
  30. ToPath := Pub.PathWithSlash(ToPath);
  31.  
  32. Json := TminiJson.Create;
  33. SL := TStringlist.Create;
  34. SLDate := TStringlist.Create;
  35. SLSize := TStringlist.Create;
  36. SLTmp := TStringlist.Create;
  37. try
  38. Json.LoadFromString(ThreadRetInfo.HTML);
  39. if json.S['retcode'] = '200' then
  40. begin
  41. TmpJson := json.A['list'];
  42. for lp := 0 to TmpJson.length - 1 do
  43. begin
  44. HintMsg(lp.ToString + '/' + TmpJson.length.ToString + '正在检查文件:' + RelativePath);
  45. RelativePath := TmpJson[lp].S['RelativePath'];
  46. if trim(RelativePath) = '' then Continue;
  47. Flag := FileExists(ToPath + RelativePath);
  48. if Flag then
  49. begin
  50. if (PubFile.FileGetFileTimeA(ToPath + RelativePath) = TmpJson[lp].S['FileTime']) and
  51. (PubFile.FileGetFileSize(ToPath + RelativePath) = TmpJson[lp].I['Size']) then
  52. else
  53. Flag := false;
  54. end;
  55. if not Flag then //此文件需要更新
  56. begin
  57. SL.Add(RelativePath);
  58. SLDate.Add(TmpJson[lp].S['FileTime']);
  59. SLSize.Add(TmpJson[lp].S['Size']);
  60. end;
  61. end;
  62.  
  63. //开始下载
  64. FailFiles := '';
  65. SuccFiles := '';
  66. HintMsg('需要更新的文件共有' + IntToStr(SL.Count) + '个。。。');
  67. for lp := 0 to SL.Count - 1 do
  68. begin
  69. RelativePath := SL[lp];
  70. if RelativePath[1] = '\' then RelativePath := Copy(RelativePath, 2, MaxInt);
  71. FN := ToPath + RelativePath;
  72.  
  73. //先计算要分几个包，以处理进度
  74. Number := 0;
  75. HadUpSize := 0;
  76. AllSize := StrToInt64(SLSize[lp]);
  77. AllBlockCount := 0;
  78. while true do
  79. begin
  80. AllBlockCount := AllBlockCount + 1;
  81. if AllSize - HadUpSize >= BlockSize then
  82. MySize := BlockSize
  83. else
  84. MySize := AllSize - HadUpSize;
  85. HadUpSize := HadUpSize + MySize;
  86. if HadUpSize >= AllSize then
  87. break;
  88. end;
  89.  
  90. //开始分块下载
  91. Number := 0;
  92. HadUpSize := 0;
  93. //AllSize := Fs.Size;
  94. //TmpToPath := PubFile.FileGetTemporaryPath;
  95. Newfn := '@_' + PubPWD.GetMd5(SLDate[lp] + SLSize[lp]) + ExtractFileName(FN); //Pub.GetClientUniqueCode;
  96.  
  97. if FileExists(ToPath + Newfn) and (FileExists(FN)) then
  98. begin
  99. SLTmp.LoadFromFile(ToPath + Newfn);
  100. MyNumber := StrToInt64(trim(SLTmp.Text));
  101. Fs := TFileStream.Create(FN, fmOpenWrite);
  102. end else
  103. begin
  104. MyNumber := 0;
  105. Fs := TFileStream.Create(FN, fmCreate);
  106. end;
  107. try
  108. while true do
  109. begin
  110. HintMsg('正在下载文件[' + Pub.GetDeliBack(RelativePath, '@@') + ']第[' + IntToStr(Number + 1) + '/' + IntToStr(AllBlockCount) + ']个包。。。');
  111.  
  112. if AllSize - HadUpSize >= BlockSize then
  113. MySize := BlockSize
  114. else
  115. MySize := AllSize - HadUpSize;
  116. Number := Number + 1;
  117. if (MyNumber = 0) or (Number >= MyNumber) or (HadUpSize + MySize >= AllSize) then
  118. begin
  119. for I := 1 to 2 do //意外出错重试一次
  120. begin
  121. if not HttpPost('/接口/同步文件到客户端.html?opr=2fn=' + UrlEncode(RelativePath) +
  122. 'pos=' + UrlEncode(IntToStr(HadUpSize)) + 'size=' + UrlEncode(IntToStr(MySize)),
  123. '', ThreadRetInfo.ErrStr, ThreadRetInfo.HTML, MS) then
  124. begin
  125. if I = 2 then
  126. begin
  127. ThreadRetInfo.ErrStr := Json.S['retmsg'];
  128. exit;
  129. end else
  130. Continue;
  131. end;
  132. if Pos('{', ThreadRetInfo.HTML) < 1 then
  133. begin
  134. if I = 2 then
  135. begin
  136. ThreadRetInfo.ErrStr := Json.S['retmsg'];
  137. exit;
  138. end else
  139. Continue;
  140. end;
  141.  
  142. Json.LoadFromString(ThreadRetInfo.HTML);
  143. if json.S['retcode'] <> '200' then
  144. begin
  145. if I = 2 then
  146. begin
  147. ThreadRetInfo.ErrStr := Json.S['retmsg'];
  148. exit;
  149. end else
  150. Continue;
  151. end;
  152. break;
  153. end;
  154.  
  155. if MS = nil then
  156. begin
  157. ThreadRetInfo.ErrStr := '没能下载到文件[' + RelativePath + ']！' + json.S['retmsg'];
  158. exit;
  159. end else
  160. begin
  161. Fs.Position := HadUpSize;
  162. MS.Position := 0;
  163. Fs.CopyFrom(MS, MS.Size);
  164. MS.Free;
  165. MS := nil;
  166. SLTmp.Text := Number.ToString;
  167. try
  168. SLTmp.SaveToFile(ToPath + Newfn);
  169. except
  170. end;
  171. end;
  172. end;
  173. HadUpSize := HadUpSize + MySize;
  174.  
  175. if HadUpSize >= AllSize then
  176. begin //全部下载完成
  177. Fs.Free;
  178. Fs := nil;
  179. Sleep(10);
  180. PubFile.FileChangeFileDate(Fn, SLDate[lp]);
  181. DeleteFile(ToPath + Newfn);
  182. SuccFiles := SuccFiles + #13#10 + RelativePath;
  183. break;
  184. end;
  185. end;
  186. finally
  187. if Fs <> nil then
  188. Fs.Free;
  189. end;
  190. end;
  191. ThreadRetInfo.HTML := '';
  192. if trim(SuccFiles) <> '' then
  193. ThreadRetInfo.HTML := '本次更新了以下文件：'#13#10 + SuccFiles;
  194. //if trim(FailFiles) <> '' then
  195. //ThreadRetInfo.HTML := trim(ThreadRetInfo.HTML + #13#10'以下文件更新失败：'#13#10 + FailFiles);
  196. end;
  197. finally
  198. SLTmp.Free;
  199. SLSize.Free;
  200. SL.Free;
  201. Json.Free;
  202. SLDate.Free;
  203. end;
  204. ThreadRetInfo.Ok := true;
  205. end;
  206.  

以下是Demo运行界面：

金蜘蛛网页设计器
©2020-2023版权所有