delphi怎么實現(xiàn)應(yīng)用程序自動更新

這篇文章主要講解了“delphi怎么實現(xiàn)應(yīng)用程序自動更新”，文中的講解內(nèi)容簡單清晰，易于學(xué)習(xí)與理解，下面請大家跟著小編的思路慢慢深入，一起來研究和學(xué)習(xí)“delphi怎么實現(xiàn)應(yīng)用程序自動更新”吧！

前段時間，在現(xiàn)場調(diào)試程序，因為系統(tǒng)已經(jīng)投入運行，然后用戶端有十幾個。每次修改了bug后，都要跑到每個用戶端去拷貝一次，實在忍受不了。就實現(xiàn)了應(yīng)用程序版本檢查及更新的功能。

實現(xiàn)思路如下：

1.下載更新使用單獨的更新程序：

   從服務(wù)端下載程序文件，然后覆蓋舊版本。

2. 主程序啟動時檢查版本（從服務(wù)端獲取最新版本信息，比較自身版本信息），如果版本不一致則啟動更新程序，并結(jié)束主程序的運行。

因為我這個項目的服務(wù)端已經(jīng)采用了ftp技術(shù)，因此只需要在服務(wù)端建立一個程序更新目錄即可.

更新程序的實現(xiàn)如下：

使用IdFTP連接ftp服務(wù)端，更新程序啟動后檢測主程序是否在運行，如果主程序在運行，就提示要先退出主程序，并退出更新程序（用戶可以再次運行主程序，然后主程序會自動啟動更新程序）。

因為主程序退出需要時間，因此在更新程序上加了一個timer來延時。

主界面及實現(xiàn)代碼如下：

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); //獲得系統(tǒng)進(jìn)程列表
  lppe.dwSize := SizeOf(TProcessEntry32);                         //在調(diào)用Process32First   API之前，需要初始化lppe記錄的大小
  isFound := Process32First(hSnapshot, lppe);                     //將進(jìn)程列表的第一個進(jìn)程信息讀入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);//將進(jìn)程列表的下一個進(jìn)程信息讀入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('沒有找到服務(wù)相關(guān)的設(shè)置。');
    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('無法連接更新服務(wù)器.'#13+e.Message);
      self.Delay(2);
      exit;
    end;
  end;
 
  try
    IdFtp.List(fileList);
    if not isExistInServer('mainappUpdate') then
    begin
      updateStatus('更新服務(wù)器上不存在更新程序，請聯(lián)系系統(tǒng)管理員檢查更新服務(wù)器。');
      self.Delay(2);
      exit;
    end;
    IdFtp.ChangeDir('mainappUpdate');
    fileList.Clear;
    IdFtp.List(fileList);
    if not isExistInServer('mainapp.exe') then
    begin
      updateStatus('更新服務(wù)器上不存在主程序，請聯(lián)系系統(tǒng)管理員檢查更新服務(wù)器。');
      self.Delay(2);
      exit;
    end;
 
    //檢查目錄下是否存在備份文件，如果存在就刪除
    newFileName := ExtractFilePath(Application.ExeName)+'mainapp_bak.exe';
    if fileExists(newFileName) then
      deletefile(newFileName);
    //將當(dāng)前文件更名為備用名
    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文件里加入版本檢測功能，如果版本需要更新，則結(jié)束自己并啟動更新程序。

if not checkVersion then
begin
   Application.Terminate;
   ShellExecute(updaterHandle, 'open', 'updater.exe', '', '', 1);
   exit;
end;

我們再其他模塊里實現(xiàn)checkVersion這個函數(shù)，

function CheckSystemVersion: boolean;
var
  servVersion: integer;
begin
  result := true;
  servVersion:= getLastVersionFromServer;  //從服務(wù)端獲取版本信息
  if servVersion > currentVersion then
    result := false;
end;

這樣就實現(xiàn)了程序的自動更新。

終于不用再跑到用戶端一個一個的拷貝文件了?？梢蚤e下來喝口可樂了。

感謝各位的閱讀，以上就是“delphi怎么實現(xiàn)應(yīng)用程序自動更新”的內(nèi)容了，經(jīng)過本文的學(xué)習(xí)后，相信大家對delphi怎么實現(xiàn)應(yīng)用程序自動更新這一問題有了更深刻的體會，具體使用情況還需要大家實踐驗證。這里是億速云，小編將為大家推送更多相關(guān)知識點的文章，歡迎關(guān)注！