delphi怎么实现应用程序自动更新

这篇文章主要讲解了“delphi怎么实现应用程序自动更新”，文中的讲解内容简单清晰，易于学习与理解，下面请大家跟着小编的思路慢慢深入，一起来研究和学习“delphi怎么实现应用程序自动更新”吧！

10年积累的成都做网站、网站建设经验，可以快速应对客户对网站的新想法和需求。提供各种问题对应的解决方案。让选择我们的客户得到更好、更有力的网络服务。我虽然不认识你，你也不认识我。但先网站设计后付款的网站建设流程，更有麒麟免费网站建设让你可以放心的选择与我们合作。

前段时间，在现场调试程序，因为系统已经投入运行，然后用户端有十几个。每次修改了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怎么实现应用程序自动更新这一问题有了更深刻的体会，具体使用情况还需要大家实践验证。这里是创新互联，小编将为大家推送更多相关知识点的文章，欢迎关注！