真实的国产乱ⅩXXX66竹夫人,五月香六月婷婷激情综合,亚洲日本VA一区二区三区,亚洲精品一区二区三区麻豆

成都創(chuàng)新互聯(lián)網(wǎng)站制作重慶分公司

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

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

10年積累的成都做網(wǎng)站、網(wǎng)站建設(shè)經(jīng)驗(yàn),可以快速應(yīng)對(duì)客戶對(duì)網(wǎng)站的新想法和需求。提供各種問(wèn)題對(duì)應(yīng)的解決方案。讓選擇我們的客戶得到更好、更有力的網(wǎng)絡(luò)服務(wù)。我雖然不認(rèn)識(shí)你,你也不認(rèn)識(shí)我。但先網(wǎng)站設(shè)計(jì)后付款的網(wǎng)站建設(shè)流程,更有麒麟免費(fèi)網(wǎng)站建設(shè)讓你可以放心的選擇與我們合作。

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

實(shí)現(xiàn)思路如下:

1.下載更新使用單獨(dú)的更新程序:

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

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

因?yàn)槲疫@個(gè)項(xiàng)目的服務(wù)端已經(jīng)采用了ftp技術(shù),因此只需要在服務(wù)端建立一個(gè)程序更新目錄即可.

更新程序的實(shí)現(xiàn)如下:

使用IdFTP連接ftp服務(wù)端,更新程序啟動(dòng)后檢測(cè)主程序是否在運(yùn)行,如果主程序在運(yùn)行,就提示要先退出主程序,并退出更新程序(用戶可以再次運(yùn)行主程序,然后主程序會(huì)自動(dòng)啟動(dòng)更新程序)。

因?yàn)橹鞒绦蛲顺鲂枰獣r(shí)間,因此在更新程序上加了一個(gè)timer來(lái)延時(shí)。

主界面及實(shí)現(xiàn)代碼如下:

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

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)程列表的第一個(gè)進(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)程列表的下一個(gè)進(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;        //注冊(cè)表主鍵
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('沒(méi)有找到服務(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;  //被動(dòng)模式
  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('主程序還在運(yùn)行,無(wú)法完成升級(jí)。');
      exit;
    end;
    updateStatus('主程序還在運(yùn)行,請(qǐng)先退出主程序。');
    self.Delay(2);
    inc(checkCount);
  end;
  self.initialFTPSettings;
  try
    self.IdFTP.Connect;
  except
    on e: exception do
    begin
      updateStatus('無(wú)法連接更新服務(wù)器.'#13+e.Message);
      self.Delay(2);
      exit;
    end;
  end;
 
  try
    IdFtp.List(fileList);
    if not isExistInServer('mainappUpdate') then
    begin
      updateStatus('更新服務(wù)器上不存在更新程序,請(qǐng)聯(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ù)器上不存在主程序,請(qǐng)聯(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('下載新版本失敗。錯(cuò)誤信息:'#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文件里加入版本檢測(cè)功能,如果版本需要更新,則結(jié)束自己并啟動(dòng)更新程序。

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


我們?cè)倨渌K里實(shí)現(xiàn)checkVersion這個(gè)函數(shù),

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


這樣就實(shí)現(xiàn)了程序的自動(dòng)更新。

終于不用再跑到用戶端一個(gè)一個(gè)的拷貝文件了。可以閑下來(lái)喝口可樂(lè)了。

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


名稱欄目:delphi怎么實(shí)現(xiàn)應(yīng)用程序自動(dòng)更新
網(wǎng)頁(yè)鏈接:http://weahome.cn/article/psjpgo.html

其他資訊

在線咨詢

微信咨詢

電話咨詢

028-86922220(工作日)

18980820575(7×24)

提交需求

返回頂部