龙空技术网

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

冰宝宝智领未来 108

前言:

现在你们对“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解析