我们在上传大文件时，断点续传是很有必要的，特别是网速度慢且不稳定的情况下，很难保证不出意外，一旦意外中断，又要从头上传，会很让人抓狂。断点续传就能很好解决意外中断情况，再次上传文件时不需要从头上传，从上次中断处继续上传即可，这样上传几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
ToPath, RelativePath, FileName, OldPath, ErrStr, TmpPath: string;
Json: TminiJson;
Ms: TMemoryStream;
Fs: TFileStream;
SL: TStringlist;
lp: integer;
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
begin
FileName := Path + SearchRec.Name;
json_sub := Pub.GetJson;
json_sub.SO; //初始化 或 json.Init;
json_sub.S['isdir'] := '1';
json_sub.S['filename'] := FileName;
json_sub.S['RelativePath'] := GetDeliBack(FileName, OldPath);
json_sub.S['FileTime'] := '';
json_sub.I['size'] := 0;
json.A['list'] := json_sub;
GetOneDirFileInfo(Json, Path + SearchRec.Name + '\');
end;
end else
begin
FileName := Path + SearchRec.Name;
try
if FileExists(FileName) and (Pos('@_', SearchRec.Name) < 1) then
begin
json_sub := Pub.GetJson;
json_sub.SO; //初始化 或 json.Init;
json_sub.S['isdir'] := '0';
json_sub.S['filename'] := SearchRec.name;
json_sub.S['RelativePath'] := GetDeliBack(FileName, OldPath);
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
Response.ContentType := 'application/json;charset=UTF-8'; //返回的数据类型
json := Pub.GetJson; //这样创建json对象不需要自己释放，系统自动管理
json.SO;
json.S['retcode'] := '100';
ToPath := 'D:\同步测试\服务上';
{// 验证是否登录代码
if not Request.IsLogin('Logined') then
begin
json.S['retcode'] := '300';
json.S['retmsg'] := '你还没有登录(no logined)！';
print(json.AsJson(true));
exit;
end;//}
ToPath := PathWithSlash(ToPath);
OldPath := ToPath;
RelativePath := Request.V('fn');
TmpPath := FileGetTemporaryPath; // ToPath;//
FileName := TmpPath + RelativePath;
if Request.V('opr') = '1' then
begin //获取服务上指定目录的文件信息
json.S['retcode'] := '200';
json.S['retmsg'] := '获取文件表成功！';
GetOneDirFileInfo(Json, OldPath);
print(json.AsJson(true));
end else
if Request.V('opr') = '2' then
begin //删除文件
DeleteFile(ToPath + RelativePath);
json.S['retcode'] := '200';
json.S['retmsg'] := '文件【' + RelativePath + '】已删除!';
print(json.AsJson(true));
end else
if Request.V('opr') = '6' then //判断是否已存在文件，续点传输
begin
if FileExists(ToPath + Request.V('newfn')) then
begin
SL := Pub.GetSL;
SL.LoadFromFile(ToPath + Request.V('newfn'));
json.S['pos'] := trim(SL.Text);
json.S['retcode'] := '210';
json.S['retmsg'] := '文件【' + RelativePath + '】已存在!';
end else
begin
json.S['retcode'] := '200';
json.S['retmsg'] := '文件【' + RelativePath + '】不存在!';
end;
print(json.AsJson(true));
end else
if (Request.V('opr') = '3') or (Request.V('opr') = '5') then
begin //接收上传文件
Request.PostStream.Position := 0;
//ForceDirectories(ExtractFilePath(FileName));
//Request.PostStream.Savetofile(ToPath + Request.V('pos'));
if lastError <> '' then
begin
json.S['retmsg'] := lastError;
print(json.AsJson(true));
exit;
end;
FileName := ToPath + Request.V('oldfn');
if (Request.V('opr') = '5') and (Request.V('Num') = '1') then
begin
DeleteFile(FileName);
Fs := Pub.GetFS(FileName, fmCreate, ErrStr);
if ErrStr <> '' then
begin
json.S['retmsg'] := ErrStr;
print(json.AsJson(true));
exit;
end;
end else
begin
Fs := Pub.GetFS(FileName, fmOpenWrite, ErrStr);
if ErrStr <> '' then
begin
json.S['retmsg'] := ErrStr;
print(json.AsJson(true));
exit;
end;
end;
Fs.Position := StrToInt64(Request.V('pos')); // Fs.Size;
Fs.CopyFrom(Request.PostStream, Request.PostStream.Size);
SL := Pub.GetSL;
SL.Text := Request.V('Num');
SL.SaveToFile(ToPath + Request.V('newfn'));
//修改文件时间 filetime
if (Request.V('opr') = '3') or (Request.V('opr') = '5') and (Request.V('isend') = '1') then
begin
Fs.Free;
Sleep(10);
FileChangeFileDate(FileName, Request.V('filetime'));
DeleteFile(ToPath + Request.V('newfn'));;
end;
json.S['retcode'] := '200';
json.S['retmsg'] := '文件【' + RelativePath + '】已保存至服务器上!';
print(json.AsJson(true));
end else
if Request.V('opr') = '4' then
begin //删除文件夹
RemoveDir(ToPath + RelativePath);
json.S['retcode'] := '200';
json.S['retmsg'] := '文件【' + RelativePath + '】已删除!';
print(json.AsJson(true));
end else
begin
json.S['retcode'] := '300';
json.S['retmsg'] := '调用参数不正确！';
print(json.AsJson(true));
exit;
end;
end;
%>
客户端发起上传操作，分块上传。以下是客户端实现的主代码：
procedure TMainForm.Syncfile_Run(var ThreadRetInfo: TThreadRetInfo);
var
HTML, FromPath, RelativePath, FN, Tmp, TmpFileName, FailFiles, SuccFiles, DelFiles: string;
Json, TmpJson: TminiJson;
lp: integer;
Flag: boolean;
SL, SLDate: TStringlist;
MS: TMemoryStream;
Fs: TFileStream;
procedure HintMsg(Msg: string);
begin
FMyMsg := Msg; // '正在获取文件列表。。。';
ThreadRetInfo.Self.Synchronize(ThreadRetInfo.Self, MyUpdateface); //为什么不直接用匿名，因为laz不支持
end;
procedure GetNewFiles(sDir: string);
var
SearchRec: System.SysUtils.TSearchRec;
Status, lp: Integer;
begin
sDir := PubFile.PathWithSlash(sDir);
Status := FindFirst(sDir + '*.*', faAnyFile, SearchRec);
try
while Status = 0 do
begin
if SearchRec.Attr and faDirectory = faDirectory then
begin
if (SearchRec.name <> '.') and (SearchRec.name <> '..') then
GetNewFiles(sDir + SearchRec.name);
end else
begin
RelativePath := Pub.GetDeliBack(sDir + SearchRec.name, FromPath);
Flag := false;
for lp := 0 to TmpJson.length - 1 do
begin
HintMsg(lp.ToString + '/' + TmpJson.length.ToString + '正在检查文件:' + RelativePath);
if (TmpJson[lp].S['isdir'] <> '1') and (LowerCase(RelativePath) = LowerCase(TmpJson[lp].S['RelativePath'])) then
begin
Flag := true;
break;
end;
end;
if not Flag then
begin //需要在服务新增加
SL.Add('@add@@' + RelativePath);
SLDate.Add(PubFile.FileGetFileTimeA(FromPath + RelativePath));
end;
end;
Status := FindNext(SearchRec);
end;
finally
FindClose(SearchRec);
end;
end;
begin
FromPath := 'D:\同步测试\本地'; //将本地文件同步到服务器
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;
FromPath := Pub.PathWithSlash(FromPath);
Json := TminiJson.Create;
SL := TStringlist.Create;
SLDate := TStringlist.Create;
try
Json.LoadFromString(ThreadRetInfo.HTML);
if json.S['retcode'] = '200' then
begin
TmpJson := json.A['list'];
//获取要上传或删除的文件
SL.Clear;
SLdate.Clear;
for lp := 0 to TmpJson.length - 1 do
begin
RelativePath := TmpJson[lp].S['RelativePath'];
HintMsg(lp.ToString + '/' + TmpJson.length.ToString + '正在检查文件:' + RelativePath);
if (TmpJson[lp].S['isdir'] = '1') then
begin
if not DirectoryExists(FromPath + RelativePath) then
begin
SL.Add('@deldir@@' + RelativePath);
SLDate.Add('');
end;
end else
begin
if trim(RelativePath) = '' then Continue;
Flag := FileExists(FromPath + RelativePath);
if Flag then
begin
if (PubFile.FileGetFileTimeA(FromPath + RelativePath) = TmpJson[lp].S['FileTime']) and
(PubFile.FileGetFileSize(FromPath + RelativePath) = TmpJson[lp].I['Size']) then
else
begin //需要更新的
SL.Add('@udp@@' + RelativePath);
SLDate.Add(TmpJson[lp].S['FileTime']);
end;
end;
if not Flag then //需要从服务器上删除的
begin
SL.Add('@del@@' + RelativePath);
SLDate.Add('');
end;
end;
end;
//获取要新增加文件
GetNewFiles(FromPath);
//ThreadRetInfo.Self.Synchronize(ThreadRetInfo.Self, procedure begin
// ShowMessage(SL.Text);
//end);
//开始上传
FailFiles := '';
SuccFiles := '';
DelFiles := '';
HintMsg('需要更新的文件共有' + IntToStr(SL.Count) + '个。。。');
for lp := 0 to SL.Count - 1 do
begin
RelativePath := SL[lp];
HintMsg(IntToStr(lp + 1) + '/' + IntToStr(SL.Count) + ', 正在处理[' + Pub.GetDeliBack(RelativePath, '@@') + ']' + '。。。');
if Pos('@del@@', RelativePath) = 1 then
begin //删除
RelativePath := Pub.GetDeliBack(RelativePath, '@@');
if not HttpPost('/接口/同步文件到服务器.html?opr=2fn=' + UrlEncode(RelativePath),
'', ThreadRetInfo.ErrStr, ThreadRetInfo.HTML) then
begin
FailFiles := FailFiles + #13#10 + RelativePath;
exit;
end;
Json.LoadFromString(ThreadRetInfo.HTML);
if json.S['retcode'] <> '200' then
begin
ThreadRetInfo.ErrStr := Json.S['retmsg'];
exit;
end;
DelFiles := DelFiles + #13#10 + RelativePath;
end else
if Pos('@deldir@@', RelativePath) = 1 then
begin //删除目录，在后面删除
end else
begin //上传
RelativePath := Pub.GetDeliBack(RelativePath, '@@');
if RelativePath[1] = '\' then RelativePath := Copy(RelativePath, 2, MaxInt);
Fs := TFileStream.Create(FromPath + RelativePath, fmShareDenyWrite);
try
if not HttpPost('/接口/同步文件到服务器.html?opr=3fn=' + UrlEncode(RelativePath) + 'filetime=' + UrlEncode(SLDate[lp]),
fs, ThreadRetInfo.ErrStr, ThreadRetInfo.HTML) then
begin
FailFiles := FailFiles + #13#10 + RelativePath;
exit;
end;
Json.LoadFromString(ThreadRetInfo.HTML);
if json.S['retcode'] <> '200' then
begin
ThreadRetInfo.ErrStr := Json.S['retmsg'];
exit;
end;
finally
Fs.Free;
end;
SuccFiles := SuccFiles + #13#10 + RelativePath;
end;
end;
//文件夹要最后删除，不然删除不掉的
for lp := 0 to SL.Count - 1 do
begin
RelativePath := SL[lp];
HintMsg(IntToStr(lp + 1) + '/' + IntToStr(SL.Count) + ', 正在处理[' + Pub.GetDeliBack(RelativePath, '@@') + ']' + '。。。');
if Pos('@deldir@@', RelativePath) = 1 then
begin //删除目录
RelativePath := Pub.GetDeliBack(RelativePath, '@@');
if not HttpPost('/接口/同步文件到服务器.html?opr=4fn=' + UrlEncode(RelativePath),
'', ThreadRetInfo.ErrStr, ThreadRetInfo.HTML) then
begin
FailFiles := FailFiles + #13#10 + RelativePath;
exit;
end;
Json.LoadFromString(ThreadRetInfo.HTML);
if json.S['retcode'] <> '200' then
begin
ThreadRetInfo.ErrStr := Json.S['retmsg'];
exit;
end;
DelFiles := DelFiles + #13#10 + RelativePath;
end;
end;
ThreadRetInfo.HTML := '';
if trim(SuccFiles) <> '' then
ThreadRetInfo.HTML := '本次上传了以下文件：'#13#10 + SuccFiles;
if trim(DelFiles) <> '' then
ThreadRetInfo.HTML := '本次删除了以下文件或文件夹：'#13#10 + DelFiles;
if trim(FailFiles) <> '' then
ThreadRetInfo.HTML := trim(ThreadRetInfo.HTML + #13#10'以下文件更新失败：'#13#10 + FailFiles);
end;
finally
SL.Free;
Json.Free;
SLDate.Free;
end;
ThreadRetInfo.Ok := true;
end;
以下是lazarus编译的Demo运行界面，delphi是一样的：
