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即可实现自动升级。
作者：Jeremy.Wu
出处：https://www.cnblogs.com/jeremywucnblog/
本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。
来源：oschina
链接：https://my.oschina.net/u/4404738/blog/3411770