Delphi 实现可执行程序的自动升级
准备工作：
1：Delphi调用TIdHTTP方式开发程序，生成程序打包外壳
说明：程序工程命名为ERP_Update
界面布局如下：
代码实现如下：
1 unit Unit1; 2 3 interface 4 5 uses 6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 Dialogs, StdCtrls, ExtCtrls, 8 IdTCPConnection, SHELLAPI, ComCtrls, jpeg, IdHTTP, 9 IdTCPClient, IdBaseComponent, IdComponent, Registry; 10 11 type 12 TFrm_FTP = class(TForm) 13 Label4: TLabel; 14 IdHTTP1: TIdHTTP; 15 Image1: TImage; 16 ProgressBar1: TProgressBar; 17 Label1: TLabel; 18 procedure RUN_START; 19 procedure FormCreate(Sender: TObject); 20 procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode; 21 const AWorkCount: Integer); 22 procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; 23 const AWorkCountMax: Integer); 24 procedure IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode); 25 function HttpDownLoad(aURL, aFile: string): Boolean; 26 function GetURLFileName(aURL: string): string; 27 function GET_CODE(V_s: TstringS; V_CODE: string): string; 28 function GET_SubStr(V_s: string; V_CODE1, V_CODE2: string): string; 29 procedure DelFile(V_Name: string); 30 function GET_Ora_Home(): string; 31 private 32 { Private declarations } 33 34 public 35 { Public declarations } 36 end; 37 38 var 39 Frm_FTP: TFrm_FTP; 40 ss: Tstrings; 41 V_Err: Boolean; 42 BytesToTransfer: LongWord; 43 44 implementation 45 46 {$R *.dfm} 47 48 function TFrm_FTP.GET_Ora_Home(): string; 49 var 50 v_Result: string; 51 begin 52 v_Result := ''; 53 with TRegistry.Create do 54 try 55 RootKey := HKEY_LOCAL_MACHINE; 56 if OpenKey('\Software\ORACLE', false) then 57 begin 58 v_Result := ReadString('ORACLE_HOME'); 59 if v_Result <> '' then 60 v_Result := v_Result + '\network\admin\tnsnames.ora'; 61 CloseKey; 62 end; 63 finally 64 Free; 65 end; 66 Result := v_Result; 67 end; 68 69 procedure TFrm_FTP.RUN_start; 70 var 71 V_LiveUpdate, V_version, C_ServerIP, C_ServerVer, C_ExeVer, c_ExeName, C_ExePath: string; 72 i: Integer; 73 begin 74 V_Err := False; 75 C_ExePath := ExtractFilePath(Application.ExeName); //可执行程序的路径[D:\CDERP\长电包装生产管理系统\] 76 //获取本地的版本信息等数据 77 ss := Tstringlist.create; 78 ss.loadfromfile(C_ExePath + 'LiveUpdate.ini'); 79 V_version := GET_SubStr(ss.Strings[1], 'url=', ''); //服务器地址 80 V_LiveUpdate := stringreplace(UpperCase(V_version), 'VERSION.INF', 'LIVEUPDATE.INI', [rfReplaceAll]); //服务器地址 81 C_ExeVer := GET_SubStr(ss.Strings[2], 'version=', ''); //本地程序的版本 82 C_ExeName := GET_SubStr(ss.Strings[3], 'exe=', ''); //本地程序的名称 83 //获取服务器的版本 84 if HttpDownLoad(V_version, C_ExePath + GetURLFileName(V_version)) then 85 begin 86 ss.loadfromfile(C_ExePath + 'version.inf'); 87 C_ServerVer := get_code(ss, '#version='); 88 end 89 else 90 C_ServerVer := C_ExeVer; //如果升级服务器异常就不升级 91 if (trim(ParamStr(1)) = '') or (trim(ParamStr(1)) = '/afterupgrade0') then 92 begin 93 //程序在本地第一次执行，如果需要升级将下载cderp.exe到本地update.exe并执行 94 //比较版本信息 95 if C_ServerVer > C_ExeVer then 96 begin 97 C_ExeVer := C_ServerVer; 98 DelFile(C_ExePath + 'update.exe'); 99 HttpDownLoad(GET_SubStr(V_version, '', '/exe/') + '/exe/ERP_Update.exe', C_ExePath + 'update.exe'); 100 ShellExecute(handle, 'open', pchar(C_ExePath + 'ERP_Update.exe'), pchar('"' + C_ExePath + '" "' + C_ExeVer + '"'), nil, SW_ShowNormal); 101 end 102 else 103 ShellExecute(handle, 'open', pchar(C_ExePath + C_ExeName), nil, nil, SW_ShowNormal); 104 application.Terminate; 105 end 106 else 107 begin 108 Frm_FTP.WindowState := wsNormal; 109 Frm_FTP.Visible := true; 110 Frm_FTP.Refresh; 111 V_Err := False; 112 //防止可执行程序没有完全关闭， 等待一会 113 ProgressBar1.max := 100; 114 for i := 1 to 100 do 115 begin 116 Label4.Caption := '升级准备...'; 117 ProgressBar1.Position := i; 118 Application.ProcessMessages; 119 Sleep(50); 120 end; 121 for i := 1 to 100 do 122 begin 123 C_ServerIP := get_code(ss, '#url' + trim(IntToStr(i)) + '='); 124 if C_ServerIP = '' then 125 begin 126 Break; 127 end; 128 HttpDownLoad(C_ServerIP, C_ExePath + GetURLFileName(C_ServerIP)); 129 end; 130 HttpDownLoad(V_LiveUpdate, C_ExePath + GetURLFileName(V_LiveUpdate)); 131 if not V_Err then 132 begin 133 ss.loadfromfile(C_ExePath + GetURLFileName(V_LiveUpdate)); 134 ss.delete(3); 135 ss.delete(2); 136 ss.Add('version=' + C_ServerVer); 137 ss.Add('exe=' + C_ExeName); 138 ss.savetofile(C_ExePath + GetURLFileName(V_LiveUpdate)); 139 ss.free; 140 Application.MessageBox('程序已经升级完成！', '升级完成', MB_ICONINFORMATION + MB_OK); 141 ShellExecute(handle, 'open', pchar(C_ExePath + C_ExeName), nil, nil, SW_ShowNormal); 142 end; 143 application.Terminate; 144 end; 145 end; 146 147 procedure TFrm_FTP.FormCreate(Sender: TObject); 148 begin 149 RUN_start; 150 end; 151 152 function TFrm_FTP.GET_CODE(V_s: TstringS; V_CODE: string): string; 153 var 154 i, j, l: integer; 155 v_Result: string; 156 begin 157 j := V_s.Count - 1; 158 l := length(v_code); 159 i := 0; 160 while i <= j do 161 begin 162 if copy(trim(UpperCase(V_s.Strings[i])), 1, l) = UpperCase(V_CODE) then 163 begin 164 v_Result := copy(trim(V_s.Strings[i]), l + 1, 500); 165 j := 0; 166 end; 167 i := i + 1; 168 end; 169 Result := v_Result; 170 end; 171 172 function TFrm_FTP.GET_SubStr(V_s: string; V_CODE1, V_CODE2: string): string; 173 var 174 j, k: integer; 175 v_str: string; 176 begin 177 //Label4.Caption := GET_SubStr('url=http://192.1.1.0/exe/ERP_Update/version.inf', '://', '/exe'); 178 //数据解析，找到字符串中的子串 179 v_str := UpperCase(V_s); 180 k := pos(UpperCase(v_code1), v_str); 181 if v_code1 = '' then 182 begin 183 k := 1; 184 end; 185 if k > 0 then 186 begin 187 v_str := copy(v_str, k + length(v_code1), 500); 188 if v_code2 = '' then 189 k := 500 190 else 191 k := pos(UpperCase(v_code2), v_str); 192 if k > 0 then 193 begin 194 v_str := copy(v_str, 1, k - 1); 195 end 196 else 197 begin 198 v_str := ''; 199 end; 200 end 201 else 202 begin 203 v_str := ''; 204 end; 205 Result := v_str; 206 end; 207 208 procedure TFrm_FTP.DelFile(V_Name: string); 209 var 210 i: integer; 211 begin 212 i := 0; 213 while FileExists(V_Name) do 214 begin 215 DeleteFile(V_Name); 216 Application.ProcessMessages; 217 i := i + 1; 218 if i > 10 then 219 begin 220 if MessageDlg('系统不能执行删除操作[' + V_Name + ']，是否重试?', mtConfirmation, [mbYes, mbNo], 0) = mrNO then 221 begin 222 i := 0; 223 Abort; 224 end; 225 end; 226 end; 227 end; 228 229 procedure TFrm_FTP.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode; 230 const AWorkCount: Integer); 231 begin 232 ProgressBar1.Position := AWorkCount; 233 end; 234 235 procedure TFrm_FTP.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; 236 const AWorkCountMax: Integer); 237 begin 238 if AWorkCountMax > 0 then 239 ProgressBar1.max := AWorkCountMax 240 else 241 ProgressBar1.Max := BytesToTransfer; 242 243 end; 244 245 procedure TFrm_FTP.IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode); 246 begin 247 BytesToTransfer := 0; 248 249 end; 250 //http方式下载 251 252 function TFrm_FTP.HttpDownLoad(aURL, aFile: string): Boolean; 253 var 254 MyStream: TMemoryStream; //如果文件不存在 255 F_Str: string; 256 begin 257 if V_Err then exit; 258 try 259 label4.Caption := '正在升级...' + GetURLFileName(aURL); 260 label4.Refresh; 261 MyStream := TMemoryStream.Create; 262 IdHTTP1.Request.ContentRangeStart := 0; 263 try 264 IdHTTP1.Get(stringreplace(UpperCase(aURL), '192.1.1.0/EXE/', '192.1.1.0/EXE/', [rfReplaceAll]), MyStream); //开始下载 265 MyStream.SaveToFile(aFile); 266 if pos('.REG', UpperCase(aFile)) > 0 then 267 WinExec(pchar('regedit.exe /s "' + aFile + '"'), SW_HIDE); 268 269 if pos('TNSNAMES.ORA', UpperCase(aFile)) > 0 then 270 begin 271 F_Str := GET_Ora_Home; 272 if F_Str <> '' then MyStream.SaveToFile(F_Str); 273 end; 274 275 label4.Caption := '升级完成'; 276 finally 277 MyStream.Free; 278 end; 279 Result := True; 280 except 281 on E: Exception do 282 begin 283 Application.MessageBox(PChar('升级[' + GetURLFileName(aURL) + ']过程中出现错误了,错误信息如下：' + #13 + #10 + E.Message), PChar('系统提示'), Mb_OK + MB_ICONERROR); 284 V_Err := True; 285 Result := False; 286 end; 287 end; 288 end; 289 290 function TFrm_FTP.GetURLFileName(aURL: string): string; 291 var 292 i: integer; 293 s: string; 294 begin 295 s := aURL; 296 i := Pos('/', s); 297 while i <> 0 do //去掉"/"前面的内容剩下的就是文件名了 298 begin 299 Delete(s, 1, i); 300 i := Pos('/', s); 301 end; 302 Result := s; 303 end; 304 305 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 #
#############################################################
# 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
#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服务器\exe\Test\文件夹下。
并手工修改LiveUpdate中的Version，同理Version中也需要这么改。
至此在本地打开ERP_Udapate即可实现自动升级。
请发表评论