这篇文章主要讲解了“delphi怎么实现应用程序自动更新”,文中的讲解内容简单清晰,易于学习与理解,下面请大家跟着小编的思路慢慢深入,一起来研究和学习“delphi怎么实现应用程序自动更新”吧!
前段时间,在现场调试程序,因为系统已经投入运行,然后用户端有十几个。每次修改了bug后,都要跑到每个用户端去拷贝一次,实在忍受不了。就实现了应用程序版本检查及更新的功能。
实现思路如下:
1.下载更新使用单独的更新程序:
从服务端下载程序文件,然后覆盖旧版本。
2. 主程序启动时检查版本(从服务端获取最新版本信息,比较自身版本信息),如果版本不一致则启动更新程序,并结束主程序的运行。
因为我这个项目的服务端已经采用了ftp技术,因此只需要在服务端建立一个程序更新目录即可.
更新程序的实现如下:
使用IdFTP连接ftp服务端,更新程序启动后检测主程序是否在运行,如果主程序在运行,就提示要先退出主程序,并退出更新程序(用户可以再次运行主程序,然后主程序会自动启动更新程序)。
因为主程序退出需要时间,因此在更新程序上加了一个timer来延时。
主界面及实现代码如下:
unit main; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase, IdFTP, Vcl.ExtCtrls; type TmainForm = class(TForm) IdFTP: TIdFTP; Timer1: TTimer; Label1: TLabel; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Timer1Timer(Sender: TObject); private { Private declarations } fileList: TStringList; procedure initialFTPSettings; function FindMainProcess: boolean; function getDefaultHost: string; function isExistInServer(fileName: string): boolean; procedure updateStatus(status: string); function update: boolean; procedure Delay(second: integer); public { Public declarations } end; var mainForm: TmainForm; implementation uses TLHelp32, iniFiles, Registry, IdAllFTPListParsers, DateUtils; {$R *.dfm} { TmainForm } procedure TmainForm.Delay(second: integer); var startTime: TDatetime; begin startTime := now(); while SecondsBetween(now(), startTime) < second do Application.ProcessMessages; end; function TmainForm.FindMainProcess: boolean; var hSnapshot: THandle; lppe: TProcessEntry32; isFound: Boolean; FileName: string; begin Result := False; FileName := 'mainApp.exe'; hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); //获得系统进程列表 lppe.dwSize := SizeOf(TProcessEntry32); //在调用Process32First API之前,需要初始化lppe记录的大小 isFound := Process32First(hSnapshot, lppe); //将进程列表的第一个进程信息读入ppe记录中 while isFound do begin if ((UpperCase(ExtractFileName(lppe.szExeFile))= UpperCase(FileName)) or (UpperCase(lppe.szExeFile) = UpperCase(FileName))) then begin Result := True; break; end; isFound := Process32Next(hSnapshot, lppe);//将进程列表的下一个进程信息读入lppe记录中 end; end; procedure TmainForm.FormCreate(Sender: TObject); begin fileList := TStringList.Create; end; procedure TmainForm.FormDestroy(Sender: TObject); begin fileList.Free; end; function TmainForm.getDefaultHost: string; const REGROOTKEY = HKEY_CURRENT_USER; //注册表主键 var reg: TRegistry; FRootkey: string; begin result := ''; reg := TRegistry.Create; try Reg.RootKey := REGROOTKEY; if Reg.OpenKey(FRootkey, True) then result := Reg.ReadString('DBHome'); finally Reg.CloseKey; Reg.free; end; end; procedure TmainForm.initialFTPSettings; var ini: TIniFile; begin ini := TIniFile.Create(ExtractFilePath(Application.ExeName)+'\adms.ini'); try IdFtp.Host := ini.ReadString('ftp', 'host', getDefaultHost); if IdFtp.Host = '' then raise Exception.Create('没有找到服务相关的设置。'); IdFtp.Port := ini.ReadInteger('ftp', 'port', 21); IdFtp.Username := ini.ReadString('ftp', 'user', 'ftpuser'); IdFtp.Password := ini.ReadString('ftp', 'password', 'ftp123'); IdFtp.Passive := true; //被动模式 finally ini.Free; end; end; function TmainForm.isExistInServer(fileName: string): boolean; var i: integer; begin result := false; if self.fileList.Count = 0 then exit; for i := 0 to fileList.Count - 1 do begin if UpperCase(self.IdFTP.DirectoryListing.Items[i].FileName) = UpperCase(fileName) then begin result := true; break; end; end; end; procedure TmainForm.Timer1Timer(Sender: TObject); var startTime, endTime: TDatetime; begin Timer1.Enabled := false; update; Application.Terminate; end; function TmainForm.update: boolean; var newFileName: string; checkCount: integer; begin result := false; checkCount := 1; while FindMainProcess do begin if checkCount = 5 then begin updateStatus('主程序还在运行,无法完成升级。'); exit; end; updateStatus('主程序还在运行,请先退出主程序。'); self.Delay(2); inc(checkCount); end; self.initialFTPSettings; try self.IdFTP.Connect; except on e: exception do begin updateStatus('无法连接更新服务器.'#13+e.Message); self.Delay(2); exit; end; end; try IdFtp.List(fileList); if not isExistInServer('mainappUpdate') then begin updateStatus('更新服务器上不存在更新程序,请联系系统管理员检查更新服务器。'); self.Delay(2); exit; end; IdFtp.ChangeDir('mainappUpdate'); fileList.Clear; IdFtp.List(fileList); if not isExistInServer('mainapp.exe') then begin updateStatus('更新服务器上不存在主程序,请联系系统管理员检查更新服务器。'); self.Delay(2); exit; end; //检查目录下是否存在备份文件,如果存在就删除 newFileName := ExtractFilePath(Application.ExeName)+'mainapp_bak.exe'; if fileExists(newFileName) then deletefile(newFileName); //将当前文件更名为备用名 renamefile(ExtractFilePath(Application.ExeName)+'mainapp.exe', newFileName); try IdFtp.Get('mainapp.exe', ExtractFilePath(Application.ExeName)+'mainapp.exe', true); updateStatus('更新成功。'); Delay(1); result := true; except on e: exception do begin renamefile(newFileName, ExtractFilePath(Application.ExeName)+'mainapp.exe'); updateStatus('下载新版本失败。错误信息:'#13+e.Message); Delay(3); end; end; finally IdFtp.Quit; Idftp.Disconnect; end; end; procedure TmainForm.updateStatus(status: string); begin self.Label1.Caption := status; end; end.
主程序的project文件里加入版本检测功能,如果版本需要更新,则结束自己并启动更新程序。
if not checkVersion then begin Application.Terminate; ShellExecute(updaterHandle, 'open', 'updater.exe', '', '', 1); exit; end;
我们再其他模块里实现checkVersion这个函数,
function CheckSystemVersion: boolean; var servVersion: integer; begin result := true; servVersion:= getLastVersionFromServer; //从服务端获取版本信息 if servVersion > currentVersion then result := false; end;
这样就实现了程序的自动更新。
终于不用再跑到用户端一个一个的拷贝文件了。可以闲下来喝口可乐了。
感谢各位的阅读,以上就是“delphi怎么实现应用程序自动更新”的内容了,经过本文的学习后,相信大家对delphi怎么实现应用程序自动更新这一问题有了更深刻的体会,具体使用情况还需要大家实践验证。这里是亿速云,小编将为大家推送更多相关知识点的文章,欢迎关注!
免责声明:本站发布的内容(图片、视频和文字)以原创、转载和分享为主,文章观点不代表本网站立场,如果涉及侵权请联系站长邮箱:is@yisu.com进行举报,并提供相关证据,一经查实,将立刻删除涉嫌侵权内容。