这篇文章主要讲解了“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;
这样就实现了程序的自动更新。
终于不用再跑到用户端一个一个的拷贝文件了。可以闲下来喝口可乐了。
支付宝扫一扫
微信扫一扫
