无论是windows、linux下还是android下，程序升级更新功能都是很常用的功能，本文介绍利用miniframe开源Web框架分别在lazarus、delphi下实现程序自动升级更新的功能。升级更新原理：先从服务器读取源文件的大小和修改时间和客户端对应的文件对比，任何一项不一至或客户端不存此文件，都要下载。下载时先压缩，传输采用二进制传输，客户端收到文件后再解压替换为新文件。说明：以下代码lazarus或delphi环境下都能使用。全部源码及Demo请到miniframe开源web框架下载: https://www.wyeditor.com/miniframe/或https://github.com/dajingshan/miniframe。
服务器端代码
要实现自动更新功能，肯定得先从服务器读取最新文件的大小、时间，以便与客户端已有文件对比，确定要更新哪些文件。
以下是服务器获取文件信息和下载一个文件的代码：
<%@//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;以下是Demo运行界面：
