lazarus、delphi程序自动升级更新功能的实现

<%@//Script头、过程和函数定义
program codes;
%>

<%!//声明变量
var
  i,lp: integer;
  FileName, OldPath: string;
  json: TminiJson;
  
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, 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
  //程序升级更新程序思路：要在服务器有一个专门的文件夹存放最新文件，检查哪些文件更新时，
  //客户端与之对应的文件如果修改时间不同，大小不同就要重新下载
  
  OldPath := '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, OldPath);
  end else
  if Request.V('opr') = '2' then
  begin //压缩下载一个文件
    Response.SendFileToClient(ZipOneFile(PathWithSlash(OldPath) + Request.V('RelativePath'), ''));  
  end;
  print(json.AsJson(true));
end;
%>

procedure TMainForm.Upgrade_Run(var ThreadRetInfo: TThreadRetInfo);
var
  HTML, ToPath, RelativePath, FN, Tmp, TmpFileName, FailFiles, SuccFiles: string;
  Json, TmpJson: TminiJson;
  lp: integer;
  Flag: boolean;
  SL, SLDate: TStringlist;
  MS: TMemoryStream;
  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;
  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']);
        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);
        //MS := TMemoryStream.Create;
        try
          HintMsg(IntToStr(lp + 1) + '/' + IntToStr(SL.Count) + ', 正在下载[' + RelativePath + ']' + '。。。');
          if not HttpPost('/接口/程序升级更新文件.html?opr=2',
            'RelativePath=' + UrlEncode(RelativePath), ThreadRetInfo.ErrStr, ThreadRetInfo.HTML, MS) then exit;
          if json.S['retcode'] <> '200' then
          begin
            ThreadRetInfo.ErrStr := Json.S['retmsg'];
            exit;
          end;
          if MS = nil then
          begin
            ThreadRetInfo.ErrStr := json.S['retmsg'];
            exit;
          end else
          begin
            FN := ToPath + RelativePath;
            TmpFileName := PubFile.FileGetTemporaryFileName();
            MS.Position := 0;
            MS.SaveToFile(TmpFileName);
            MS.Free;
            MS := nil;

            //解压到指定目录
            ForceDirectories(ExtractFilePath(FN));
            if FileExists(FN) then
              DeleteFile(FN);
            if FileExists(FN) then //删除不掉只能改名
            begin
              Tmp := ExtractFilePath(FN) + '_Old@_' + ExtractFileName(FN);
              DeleteFile(Tmp);
              RenameFile(FN, Tmp);
            end;
            if FileExists(FN) then //删除不掉，又改名不成功，不能更新！！！！
              FailFiles := FailFiles + #13#10 + RelativePath
            else
            begin
              UnZipFileToFolder(TmpFileName, ExtractFilePath(FN));
              if FileExists(FN) then
              begin
                SuccFiles := SuccFiles + #13#10 + RelativePath;
                //虽然是解压，但文件的修改必须要重置，否则可能会有问题
                PubFile.FileChangeFileDate(Fn, SLDate[lp]);
              end else
                FailFiles := FailFiles + #13#10 + RelativePath;
            end;
          end;
        finally
          //MS.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
    SL.Free;
    Json.Free;
    SLDate.Free;
  end;
  ThreadRetInfo.Ok := true;
end;