前言:
现在你们对“delphihtml解析”可能比较珍视,朋友们都需要学习一些“delphihtml解析”的相关文章。那么小编同时在网摘上网罗了一些关于“delphihtml解析””的相关内容,希望大家能喜欢,兄弟们快快来学习一下吧!下载大文件时,断点续传是很有必要的,特别是网速度慢且不稳定的情况下,很难保证不出意外,一旦意外中断,又要从头下载,会很让人抓狂。断点续传就能很好解决意外中断情况,再次下载时不需要从头下载,从上次中断处继续下载即可,这样下载几G或十几G大小的一个文件都没问题。本文介绍利用miniframe开源Web框架分别在lazarus、delphi下实现文件HTTP下载断点续传的功能。
本文Demo还实现了批量下载文件,同步服务器上的文件到客户端的功能。文件断点续传原理:分块下载,下载后客户端逐一合并,同时保存已下载的位置,当意外中断再次下载时从保存的位置开始下载即可。这其中还要保证,中断后再次下载时服务器上相应的文件如果更新了,还得重新下载,不然下载到的文件是错了。说明:以下代码lazarus或delphi环境下都能使用。全部源码及Demo请到miniframe开源web框架下载: 或。
服务器端代码
文件下载断点续传服务器端很简单,只要提供客户端要求下载的开始位置和指定大小的块即可。
以下是服务器获取文件信息和下载一个文件一块的代码:
<%@//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; //1Mvar 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运行界面:
标签: #delphihtml解析