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

下载大文件时，断点续传是很有必要的，特别是网速度慢且不稳定的情况下，很难保证不出意外，一旦意外中断，又要从头下载，会很让人抓狂。断点续传就能很好解决意外中断情况，再次下载时不需要从头下载，从上次中断处继续下载即可，这样下载几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运行界面：