Delphi

Delphi 实现可执行程序的自动升级

准备工作：

1：Delphi调用TIdHTTP方式开发程序，生成程序打包外壳

说明：程序工程命名为ERP_Update

界面布局如下：

代码实现如下：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,
  IdTCPConnection, SHELLAPI, ComCtrls, jpeg, IdHTTP,
  IdTCPClient, IdBaseComponent, IdComponent, Registry;

type
  TFrm_FTP = class(TForm)
    Label4: TLabel;
    IdHTTP1: TIdHTTP;
    Image1: TImage;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    procedure RUN_START;
    procedure FormCreate(Sender: TObject);
    procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    function HttpDownLoad(aURL, aFile: string): Boolean;
    function GetURLFileName(aURL: string): string;
    function GET_CODE(V_s: TstringS; V_CODE: string): string;
    function GET_SubStr(V_s: string; V_CODE1, V_CODE2: string): string;
    procedure DelFile(V_Name: string);
    function GET_Ora_Home(): string;
  private
        { Private declarations }

  public
        { Public declarations }
  end;

var
  Frm_FTP: TFrm_FTP;
  ss: Tstrings;
  V_Err: Boolean;
  BytesToTransfer: LongWord;

implementation

{$R *.dfm}

function TFrm_FTP.GET_Ora_Home(): string;
var
  v_Result: string;
begin
  v_Result := '';
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    if OpenKey('SoftwareORACLE', false) then
    begin
      v_Result := ReadString('ORACLE_HOME');
      if v_Result <> '' then
        v_Result := v_Result + '
etworkadmin	nsnames.ora';
      CloseKey;
    end;
  finally
    Free;
  end;
  Result := v_Result;
end;

procedure TFrm_FTP.RUN_start;
var
  V_LiveUpdate, V_version, C_ServerIP, C_ServerVer, C_ExeVer, c_ExeName, C_ExePath: string;
  i: Integer;
begin
  V_Err := False;
  C_ExePath := ExtractFilePath(Application.ExeName); //可执行程序的路径[D:CDERP长电包装生产管理系统]
  //获取本地的版本信息等数据
  ss := Tstringlist.create;
  ss.loadfromfile(C_ExePath + 'LiveUpdate.ini');
  V_version := GET_SubStr(ss.Strings[1], 'url=', ''); //服务器地址
  V_LiveUpdate := stringreplace(UpperCase(V_version), 'VERSION.INF', 'LIVEUPDATE.INI', [rfReplaceAll]); //服务器地址
  C_ExeVer := GET_SubStr(ss.Strings[2], 'version=', ''); //本地程序的版本
  C_ExeName := GET_SubStr(ss.Strings[3], 'exe=', ''); //本地程序的名称
  //获取服务器的版本
  if HttpDownLoad(V_version, C_ExePath + GetURLFileName(V_version)) then
  begin
    ss.loadfromfile(C_ExePath + 'version.inf');
    C_ServerVer := get_code(ss, '#version=');
  end
  else
    C_ServerVer := C_ExeVer; //如果升级服务器异常就不升级
  if (trim(ParamStr(1)) = '') or (trim(ParamStr(1)) = '/afterupgrade0') then
  begin
    //程序在本地第一次执行，如果需要升级将下载cderp.exe到本地update.exe并执行
    //比较版本信息
    if C_ServerVer > C_ExeVer then
    begin
      C_ExeVer := C_ServerVer;
      DelFile(C_ExePath + 'update.exe');
      HttpDownLoad(GET_SubStr(V_version, '', '/exe/') + '/exe/ERP_Update.exe', C_ExePath + 'update.exe');
      ShellExecute(handle, 'open', pchar(C_ExePath + 'ERP_Update.exe'), pchar('"' + C_ExePath + '" "' + C_ExeVer + '"'), nil, SW_ShowNormal);
    end
    else
      ShellExecute(handle, 'open', pchar(C_ExePath + C_ExeName), nil, nil, SW_ShowNormal);
    application.Terminate;
  end
  else
  begin
    Frm_FTP.WindowState := wsNormal;
    Frm_FTP.Visible := true;
    Frm_FTP.Refresh;
    V_Err := False;
    //防止可执行程序没有完全关闭， 等待一会
    ProgressBar1.max := 100;
    for i := 1 to 100 do
    begin
      Label4.Caption := '升级准备...';
      ProgressBar1.Position := i;
      Application.ProcessMessages;
      Sleep(50);
    end;
    for i := 1 to 100 do
    begin
      C_ServerIP := get_code(ss, '#url' + trim(IntToStr(i)) + '=');
      if C_ServerIP = '' then
      begin
        Break;
      end;
      HttpDownLoad(C_ServerIP, C_ExePath + GetURLFileName(C_ServerIP));
    end;
    HttpDownLoad(V_LiveUpdate, C_ExePath + GetURLFileName(V_LiveUpdate));
    if not V_Err then
    begin
      ss.loadfromfile(C_ExePath + GetURLFileName(V_LiveUpdate));
      ss.delete(3);
      ss.delete(2);
      ss.Add('version=' + C_ServerVer);
      ss.Add('exe=' + C_ExeName);
      ss.savetofile(C_ExePath + GetURLFileName(V_LiveUpdate));
      ss.free;
      Application.MessageBox('程序已经升级完成！', '升级完成', MB_ICONINFORMATION + MB_OK);
      ShellExecute(handle, 'open', pchar(C_ExePath + C_ExeName), nil, nil, SW_ShowNormal);
    end;
    application.Terminate;
  end;
end;

procedure TFrm_FTP.FormCreate(Sender: TObject);
begin
  RUN_start;
end;

function TFrm_FTP.GET_CODE(V_s: TstringS; V_CODE: string): string;
var
  i, j, l: integer;
  v_Result: string;
begin
  j := V_s.Count - 1;
  l := length(v_code);
  i := 0;
  while i <= j do
  begin
    if copy(trim(UpperCase(V_s.Strings[i])), 1, l) = UpperCase(V_CODE) then
    begin
      v_Result := copy(trim(V_s.Strings[i]), l + 1, 500);
      j := 0;
    end;
    i := i + 1;
  end;
  Result := v_Result;
end;

function TFrm_FTP.GET_SubStr(V_s: string; V_CODE1, V_CODE2: string): string;
var
  j, k: integer;
  v_str: string;
begin
  //Label4.Caption := GET_SubStr('url=http://192.1.1.0/exe/ERP_Update/version.inf', '://', '/exe');
  //数据解析，找到字符串中的子串
  v_str := UpperCase(V_s);
  k := pos(UpperCase(v_code1), v_str);
  if v_code1 = '' then
  begin
    k := 1;
  end;
  if k > 0 then
  begin
    v_str := copy(v_str, k + length(v_code1), 500);
    if v_code2 = '' then
      k := 500
    else
      k := pos(UpperCase(v_code2), v_str);
    if k > 0 then
    begin
      v_str := copy(v_str, 1, k - 1);
    end
    else
    begin
      v_str := '';
    end;
  end
  else
  begin
    v_str := '';
  end;
  Result := v_str;
end;

procedure TFrm_FTP.DelFile(V_Name: string);
var
  i: integer;
begin
  i := 0;
  while FileExists(V_Name) do
  begin
    DeleteFile(V_Name);
    Application.ProcessMessages;
    i := i + 1;
    if i > 10 then
    begin
      if MessageDlg('系统不能执行删除操作[' + V_Name + ']，是否重试?', mtConfirmation, [mbYes, mbNo], 0) = mrNO then
      begin
        i := 0;
        Abort;
      end;
    end;
  end;
end;

procedure TFrm_FTP.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  ProgressBar1.Position := AWorkCount;
end;

procedure TFrm_FTP.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  if AWorkCountMax > 0 then
    ProgressBar1.max := AWorkCountMax
  else
    ProgressBar1.Max := BytesToTransfer;

end;

procedure TFrm_FTP.IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
  BytesToTransfer := 0;

end;
//http方式下载

function TFrm_FTP.HttpDownLoad(aURL, aFile: string): Boolean;
var
  MyStream: TMemoryStream; //如果文件不存在
  F_Str: string;
begin
  if V_Err then exit;
  try
    label4.Caption := '正在升级...' + GetURLFileName(aURL);
    label4.Refresh;
    MyStream := TMemoryStream.Create;
    IdHTTP1.Request.ContentRangeStart := 0;
    try
      IdHTTP1.Get(stringreplace(UpperCase(aURL), '192.1.1.0/EXE/', '192.1.1.0/EXE/', [rfReplaceAll]), MyStream); //开始下载
      MyStream.SaveToFile(aFile);
      if pos('.REG', UpperCase(aFile)) > 0 then
        WinExec(pchar('regedit.exe /s "' + aFile + '"'), SW_HIDE);

      if pos('TNSNAMES.ORA', UpperCase(aFile)) > 0 then
      begin
        F_Str := GET_Ora_Home;
        if F_Str <> '' then MyStream.SaveToFile(F_Str);
      end;

      label4.Caption := '升级完成';
    finally
      MyStream.Free;
    end;
    Result := True;
  except
    on E: Exception do
    begin
      Application.MessageBox(PChar('升级[' + GetURLFileName(aURL) + ']过程中出现错误了,错误信息如下：' + #13 + #10 + E.Message), PChar('系统提示'), Mb_OK + MB_ICONERROR);
      V_Err := True;
      Result := False;
    end;
  end;
end;

function TFrm_FTP.GetURLFileName(aURL: string): string;
var
  i: integer;
  s: string;
begin
  s := aURL;
  i := Pos('/', s);
  while i <> 0 do //去掉"/"前面的内容剩下的就是文件名了
  begin
    Delete(s, 1, i);
    i := Pos('/', s);
  end;
  Result := s;
end;

end.

2：FTP服务器搭建，FTP用户创建

举例说明如下：

在192.1.1.0上创建FTP账户Test 密码Test，路径 exe;

案例：将Test.exe系统做出一个可以自动升级的系统

文件准备：

1：Test.exe （目标系统）；

2：ERP_Update.exe （自动升级外壳程序）；

3：创建配置文件 （LiveUpdate.ini、Version.inf）；

建立一个记事本文件，命名为LiveUpdate.ini，内容输入

[LiveUpdate]
url=http://192.1.1.0/exe/Test/version.inf
version=0
exe=Test.EXE

建立一个记事本文件，命名为version.inf，内容输入

#############################################################
#   Generated by AutoUpgrader Pro at: 2019-8-29 20:50:39    #
#############################################################

#message={}

#url1=http://192.1.1.0/exe/ERP_Update.exe
#url2=http://192.1.1.0/exe/Test/Test.exe
#url3=http://192.19.1.0/exe/Test/version.inf

#method=0 (self-upgrade)

#version=0

4：FTP操作（文件替换、配置文件更新）；

将Test.exe （目标系统）、ERP_Update.exe （自动升级外壳程序）、创建配置文件 （LiveUpdate.ini、Version.inf）文件同时放到192.1.1.0FTP服务器exeTest文件夹下。

并手工修改LiveUpdate中的Version，同理Version中也需要这么改。

至此在本地打开ERP_Udapate即可实现自动升级。

  作者：Jeremy.Wu
  出处：https://www.cnblogs.com/jeremywucnblog/
  本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。