在线更新的实现2

 将 update.xml 放到服务器上后，通过一个程序读取，并获得更新文件的列表。进行版本比较后，对版本不同的文件进行更新。

 

1. 更新程序的代码：
3. unit frmMain;
5. interface
7. uses
8.    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
9.    Dialogs, xmldom, XMLIntf, RzStatus, ExtCtrls, RzPanel, msxmldom, XMLDoc,
10.    StdCtrls, CheckLst, IdBaseComponent, IdComponent, IdTCPConnection,
11.    IdTCPClient, IdHTTP, StrUtils, DHibernateThread, DHibernateBase,
12.    MD5Real, ActiveX, IdExplicitTLSClientServerBase, IdFTP, untUtils,
13.    DHibernatePodoList, HTTPGet, ComCtrls, DHibernateSQLThread, ShellAPI,
14.    WinSkinData, IniFiles;
16. type
17.    TDownFileRec = class
18.    public
19.      FName: string;
20.      FSize: Integer;
21.      FDir: string;
22.      FCRC: string;
23.      FTrueName: string;
24.    end;
26. type
27.    TFormMain = class(TForm)
28.      HTTPXML: TIdHTTP;
29.      Label1: TLabel;
30.      edtUpdateXml: TEdit;
31.      Label2: TLabel;
32.      lstFiles: TCheckListBox;
33.      btnDownload: TButton;
34.      XML: TXMLDocument;
35.      RzStatusBar1: TRzStatusBar;
36.      spStat: TRzStatusPane;
37.      thrdSF: TDHibernateThread;
38.      HTTPGet1: THTTPGet;
39.      pb: TProgressBar;
40.      SkinData1: TSkinData;
41.      btnGetXml: TButton;
42.      btnSetting: TButton;
43.      spProc: TRzStatusPane;
44.      chkSelAll: TCheckBox;
45.      procedure btnGetXmlClick(Sender: TObject);
46.      procedure FormCreate(Sender: TObject);
47.      procedure btnDownloadClick(Sender: TObject);
48.      procedure HTTPXMLStatus(ASender: TObject; const AStatus: TIdStatus;
49.        const AStatusText: string);
50.      // procedure DHibernateThread1Execute(Sender: TObject; params: IMap);
51.      procedure HTTPXMLWork(ASender: TObject; AWorkMode: TWorkMode;
52.        AWorkCount: Integer);
53.      //     procedure DHibernateThread1Finish(Sender: TObject);
54.      procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
55.      //     procedure SFFound(Sender: TObject; Path: string);
56.      //     procedure SFEnded(Sender: TObject);
57.      procedure thrdSFExecute(Sender: TObject; params: IMap);
58.      procedure thrdSFbegin(Sender: TObject);
59.      procedure thrdSFFinish(Sender: TObject);
60.      procedure HTTPXMLWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
61.        AWorkCountMax: Integer);
62.      procedure HTTPGet1Progress(Sender: TObject; TotalSize, Readed: Integer);
63.      procedure HTTPGet1DoneFile(Sender: TObject; FileName: string;
64.        FileSize: Integer);
65.      procedure btnSettingClick(Sender: TObject);
66.      procedure chkSelAllClick(Sender: TObject);
67.      procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
68.    private
69.      AbortTransfer: Boolean;
70.      isUpdating: boolean;
71.      downloadStr: string;
72.    public
73.      function GetFileSize(aFileName: string): integer;
74.      procedure HttpDownLoad(aURL, aFile: string; bResume: Boolean);
75.      procedure CmdStopService;
76.      procedure CmdStopProcess;
77.      procedure CmdFileOperation;
78.      procedure CmdStartProcess;
79.      procedure CmdStartService;
80.      procedure CmdReboot;
81.      procedure LoadFromIni;
82.      procedure SaveToIni;
83.    end;
85. var
86.    FormMain           : TFormMain;
87.    FileCode           : string;
88.    FileName           : string;
89.    found              : integer;
90.    FileList           : TPodoList;
91.    commandList        : TStringList;
93. implementation
95. {$R *.dfm}
97. function TFormMain.GetFileSize(aFileName: string): integer;
98. var
99.    sr                 : TSearchRec;
100. begin
101.    if FindFirst(aFileName, faAnyFile, sr) = 0 then
102.      Result := sr.Size
103.    else
104.      Result := 0;
105.    FindClose(sr);
106. end;
108. procedure TFormMain.HttpDownLoad(aURL, aFile: string; bResume: Boolean);
109. var
110.    tStream            : TFileStream;
111. begin                                    //Http方式下载
112.    if FileExists(aFile) then              //如果文件已经存在
113.      tStream := TFileStream.Create(aFile, fmOpenWrite)
114.    else
115.      tStream := TFileStream.Create(aFile, fmCreate);
117.    if bResume then                        //续传方式
118.    begin
119.      HTTPXML.Request.ContentRangeStart := tStream.Size - 1;
120.      tStream.Position := tStream.Size - 1; //移动到最后继续下载
121.      HTTPXML.Head(aURL);
122.      // HTTPXML.Request.ContentRangeEnd := HTTPXML.Response.ContentLength;
123.    end
124.    else                                   //覆盖或新建方式
125.    begin
126.      HTTPXML.Request.ContentRangeStart := 0;
127.    end;
129.    try
130.      HTTPXML.Get(aURL, tStream);          //开始下载
131.    finally
132.      tStream.Free;
133.    end;
134. end;
136. procedure TFormMain.btnDownloadClick(Sender: TObject);
137. var
138.    i                  : Integer;
139.    furl               : string;
140.    path               : string;
141.    saveFile           : string;
142. begin
143.    if isUpdating then
144.    begin
145.      AbortTransfer := not AbortTransfer;
146.      if AbortTransfer then
147.      begin
148.        // 暂停下载
149.        HTTPGet1.Abort;
150.        btnDownload.Caption := '续传';
151.      end
152.      else
153.      begin
154.        HTTPGet1.GetFile;
155.        btnDownload.Caption := '暂停';
156.        // DHibernateThread1Execute(Self, nil);
157.      end;
158.    end
159.    else
160.    begin
161.      if lstFiles.Items.Count = 0 then
162.        Exit;
163.      // btnDownload.Enabled := false;
164.      btnDownload.Caption := '暂停';
165.      btnGetXml.Enabled := false;
166.      btnSetting.Enabled := False;
167.      lstFiles.Enabled := False;
168.      isUpdating := True;
170.      // 执行脚本
171.      // stop service
172.      CmdStopService;
174.      // stop process
175.      CmdStopProcess;
176.      // download
177.      path := edtUpdateXml.Text;
178.      for i := 0 to lstFiles.Items.Count - 1 do
179.      begin
180.        if lstFiles.Checked[i] then
181.        begin
182.          furl := path + '/' + TDownFileRec(FileList.Objects[i]).FName;
183.          saveFile := ExtractFilePath(ParamStr(0)) + '/' + TDownFileRec(FileList.Objects[i]).FDir + '/' +
184.            TDownFileRec(FileList.Objects[i]).FTrueName;
185.          if not FileExists(saveFile + '.ini') then
186.            DeleteFile(saveFile);
188.          downloadStr := '正在下载：' + lstFiles.Items[i];
189.          HTTPGet1.FileName := saveFile;
190.          HTTPGet1.URL := furl;
191.          HTTPGet1.GetFile;
192.        end;
194.      end;
195.      // file operation
196.      CmdFileOperation;
197.      // start process
198.      CmdStartProcess;
199.      // start service
200.      CmdStartService;
201.      // reboot?
202.      CmdReboot;
203.      isUpdating := false;
204.      btnDownload.Caption := '下载并更新';
205.      spStat.Caption := '下载完毕！';
206.      spproc.Caption := EmptyStr;
207.      btnGetXml.Enabled := True;
208.      btnSetting.Enabled := True;
209.      lstFiles.Enabled := True;
210.      self.thrdSF.Execute(nil);
211.      pb.Position := 0;
212.    end;
213. end;
215. procedure TFormMain.btnGetXmlClick(Sender: TObject);
216. begin
217.    self.thrdSF.Execute(nil);
218. end;
220. procedure TFormMain.btnSettingClick(Sender: TObject);
221. var
222.    str                : string;
223. begin
224.    str := edtUpdateXml.Text;
225.    str := InputBox('输入网址', '输入更新服务器的所在地址：　　　　', str);
226.    if str <> EmptyStr then
227.      edtUpdateXml.Text := str;
228. end;
230. procedure TFormMain.chkSelAllClick(Sender: TObject);
231. var
232.    i                  : Integer;
233. begin
234.    for i := 0 to lstFiles.Items.Count - 1 do
235.      lstFiles.Checked[i] := chkSelAll.Checked;
236. end;
238. procedure TFormMain.CmdFileOperation;
239. var
240.    i                  : Integer;
241.    cmd                : string;
242. begin
243.    // todo: file operation
244.    for i := 0 to commandList.Count - 1 do
245.    begin
246.      cmd := commandList[i];
247.      if Pos('copy', cmd) > 0 then
248.      begin
249.        DoCopyUpdateFile(cmd);
250.      end;
251.      if Pos('rename', cmd) > 0 then
252.      begin
253.        DoRenameUpdateFile(cmd);
254.      end;
255.      if Pos('delete', cmd) > 0 then
256.      begin
257.        DoDeleteUpdateFile(cmd);
258.      end;
259.    end;
260. end;
262. procedure TFormMain.CmdReboot;
263. var
264.    i                  : Integer;
265. begin
266.    // todo: reboot
267.    for i := 0 to commandList.Count - 1 do
268.    begin
269.      if commandList[i] = '/reboot' then
270.      begin
271.        rebootWindows;
272.        Exit;
273.      end;
274.    end;
275. end;
277. procedure TFormMain.CmdStartProcess;
278. var
279.    i                  : Integer;
280.    cmd                : string;
281. begin
282.    // todo: start process
283.    for i := 0 to commandList.Count - 1 do
284.    begin
285.      Application.ProcessMessages;
286.      // fmt: /run "process Name"
287.      if Pos('run', commandList[i]) > 0 then
288.      begin
289.        cmd := commandList[i];
290.        // 去掉 run
291.        cmd := RightStr(cmd, Length(cmd) - 4);
292.        cmd := StringReplace(cmd, '"', EmptyStr, [rfReplaceAll, rfIgnoreCase]);
293.        cmd := Trim(cmd);
294.        SetCurrentDir(ExtractFilePath(ParamStr(0)));
295.        ShellExecute(0, 'open', PChar(ExtractFilePath(ParamStr(0)) + '/' + cmd), nil,
296.          PChar(ExtractFilePath(ExtractFilePath(ParamStr(0)) + '/' + cmd)), SW_SHOW);
297.      end;
298.    end;
299. end;
301. procedure TFormMain.CmdStartService;
302. var
303.    i                  : Integer;
304.    cmd                : string;
305. begin
306.    // todo: start service
307.    for i := 0 to commandList.Count - 1 do
308.    begin
309.      Application.ProcessMessages;
310.      // fmt: /start "service name"
311.      if Pos('start', commandList[i]) > 0 then
312.      begin
313.        cmd := commandList[i];
314.        // 去掉 /，添加 net
315.        cmd := 'net ' + RightStr(cmd, Length(cmd) - 1);
316.        cmd := StringReplace(cmd, '"', EmptyStr, [rfReplaceAll, rfIgnoreCase]);
317.        ServicesOperation(cmd);
318.      end;
319.    end;
320. end;
322. procedure TFormMain.CmdStopProcess;
323. var
324.    i                  : Integer;
325.    cmd                : string;
326. begin
327.    // todo: stop process
328.    for i := 0 to commandList.Count - 1 do
329.    begin
330.      Application.ProcessMessages;
331.      // fmt: /kill "process Name"
332.      if Pos('kill', commandList[i]) > 0 then
333.      begin
334.        cmd := commandList[i];
335.        // 去掉 kill
336.        cmd := RightStr(cmd, Length(cmd) - 5);
337.        cmd := StringReplace(cmd, '"', EmptyStr, [rfReplaceAll, rfIgnoreCase]);
338.        cmd := Trim(cmd);
339.        KillTask(cmd);
340.      end;
341.    end;
342. end;
344. procedure TFormMain.CmdStopService;
345. var
346.    i                  : Integer;
347.    cmd                : string;
348. begin
349.    // todo: stop service
350.    for i := 0 to commandList.Count - 1 do
351.    begin
352.      Application.ProcessMessages;
353.      // fmt: /stop "service name"
354.      if Pos('stop', commandList[i]) > 0 then
355.      begin
356.        cmd := commandList[i];
357.        // 去掉 /，添加 net
358.        cmd := 'net ' + RightStr(cmd, Length(cmd) - 1);
359.        cmd := StringReplace(cmd, '"', EmptyStr, [rfReplaceAll, rfIgnoreCase]);
360.        ServicesOperation(cmd);
361.      end;
362.    end;
363. end;
365. procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
366. begin
367.    if isUpdating then
368.    begin
369.      //     MessageBox(Handle, '正在更新中，不能关闭！', '提示', MB_OK or
370.      //       MB_ICONINFORMATION);
371.      //     CanClose := False;
372.      HTTPGet1.Abort;
373.    end;
374.    SaveToIni;
375. end;
377. procedure TFormMain.FormCreate(Sender: TObject);
378. begin
379.    LoadFromIni;
380.    if edtUpdateXml.Text <> EmptyStr then
381.      btnGetXmlClick(self);
382.    isUpdating := False;
383. end;
385. procedure TFormMain.FormKeyDown(Sender: TObject; var Key: Word;
386.    Shift: TShiftState);
387. var
388.    path               : string;
389. begin
390.    if Key = VK_F1 then
391.    begin
392.      path := ExtractFilePath(ParamStr(0)) + '/Help/';
393.      ShellExecute(0, 'open', PChar(path + 'help_index.html'), nil, PChar(path), SW_SHOW);
394.    end;
395. end;
397. procedure TFormMain.HTTPGet1DoneFile(Sender: TObject; FileName: string;
398.    FileSize: Integer);
399. var
400.    iniName            : string;
401. begin
402.    ininame := HTTPGet1.FileName + '.ini';
403.    DeleteFile(iniName);
404.    isUpdating := false;
405.    btnDownload.Caption := '下载并更新';
406.    spStat.Caption := '下载完毕！';
407.    spproc.Caption := EmptyStr;
408.    btnGetXml.Enabled := True;
409.    btnSetting.Enabled := True;
410.    lstFiles.Enabled := True;
411.    self.thrdSF.Execute(nil);
412.    pb.Position := 0;
413. end;
415. procedure TFormMain.HTTPGet1Progress(Sender: TObject; TotalSize,
416.    Readed: Integer);
417. begin
418.    Application.ProcessMessages;
419.    spstat.Caption := downloadStr;
420.    spProc.Caption := Format('%d / %d B', [Readed, TotalSize]);
421.    pb.Max := TotalSize;
422.    pb.Position := Readed;
423. end;
425. procedure TFormMain.HTTPXMLStatus(ASender: TObject; const AStatus: TIdStatus;
426.    const AStatusText: string);
427. begin
428.    // spStat.Caption := Format(downloadStr,[AStatusText]);
429. end;
431. procedure TFormMain.HTTPXMLWork(ASender: TObject; AWorkMode: TWorkMode;
432.    AWorkCount: Integer);
433. begin
434.    if AbortTransfer then
435.    begin                                  //中断下载
436.      HTTPXML.Disconnect;
437.    end;
438.    Application.ProcessMessages;
439.    spStat.Caption := Format(downloadStr, [AWorkCount]);
440. end;
442. procedure TFormMain.HTTPXMLWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
443.    AWorkCountMax: Integer);
444. begin
445.    AbortTransfer := False;
446. end;
448. procedure TFormMain.LoadFromIni;
449. var
450.    iniName            : string;
451.    ini                : TIniFile;
452. begin
453.    iniName := ExtractFilePath(ParamStr(0)) + 'update.ini';
454.    ini := TIniFile.Create(iniName);
455.    edtUpdateXml.Text := ini.ReadString('Server', 'Address', EmptyStr);
456.    ini.Free;
457. end;
459. procedure TFormMain.SaveToIni;
460. var
461.    iniName            : string;
462.    ini                : TIniFile;
463. begin
464.    iniName := ExtractFilePath(ParamStr(0)) + 'update.ini';
465.    ini := TIniFile.Create(iniName);
466.    ini.WriteString('Server', 'Address', edtUpdateXml.Text);
467.    ini.Free;
468. end;
470. procedure TFormMain.thrdSFExecute(Sender: TObject; params: IMap);
471. var
472.    furl               : string;
473.    xmlstr             : string;
474.    node               : IXMLNode;
475.    detail             : IXMLNode;
476.    fileRec            : TDownFileRec;
477.    fn                 : string;
478.    // ms                 : TMemoryStream;
479. begin
480.    ActiveX.CoInitialize(nil);
481.    furl := edtUpdateXml.Text + 'update.xml';
482.    xmlstr := HTTPXML.Get(furl);
483.    // ms.ReadBuffer(xmlstr, ms.Size);
484.    // xmlstr := leftstr(xmlstr, Pos('-', xmlstr) - 1);
485.    // ShowMessage(xmlstr);
486.    XML.Active := false;
487.    XML.XML.Text := xmlstr;
488.    xml.Active := true;
489.    node := XML.DocumentElement;
490.    lstFiles.Items.Clear;
491.    FileList.Clear;
492.    if { 3 } node <> nil then
493.    begin
494.      node := XML.DocumentElement.ChildNodes.First;
495.      while node <> nil do
496.      begin
497.        if { 2 } node.NodeName = 'file' then
498.        begin
499.          filerec := TDownFileRec.Create;
500.          // name
501.          detail := node.ChildNodes[0];
502.          fileRec.FName := detail.NodeValue;
503.          // size
504.          detail := node.ChildNodes[1];
505.          fileRec.FSize := detail.NodeValue;
506.          // dir
507.          detail := node.ChildNodes[2];
508.          if detail.NodeValue = null then
509.            fileRec.FDir := EmptyStr
510.          else
511.            fileRec.FDir := detail.NodeValue;
512.          // crc
513.          detail := node.ChildNodes[3];
514.          fileRec.FCRC := detail.NodeValue;
515.          // true name
516.          detail := node.ChildNodes[4];
517.          fileRec.FTrueName := detail.NodeValue;
519.          // check whether need update
520.          fn := ExtractFilePath(ParamStr(0)) + '/' + filerec.FDir + '/' + filerec.FTrueName;
521.          if { 1 } MD5Real.RivestFile(fn) <> fileRec.FCRC then
522.          begin
523.            // add to list
524.            FileList.Add(fileRec);
525.            //         FileName := detail.NodeValue;
526.            lstFiles.Items.Add(fileRec.FTrueName);
527.          end;                             { if 1 }
528.        end;                               { if 2 }
529.        if node.NodeName = 'command' then
530.        begin
531.          if node.NodeValue <> null then
532.            commandList.Add(node.NodeValue);
533.        end;
534.        // lstFiles.Items.Add(node.NodeValue);
535.        node := node.NextSibling;
536.      end;                                 { while }
537.    end;
538.    chkSelAllClick(self);                  { if 3 }
539.    ActiveX.CoUninitialize;
540. end;
542. procedure TFormMain.thrdSFbegin(Sender: TObject);
543. begin
544.    spStat.Caption := '获取更新文件列表';
545.    btnGetXml.Enabled := False;
546.    btnDownload.Enabled := False;
547.    lstFiles.Enabled := False;
548. end;
550. procedure TFormMain.thrdSFFinish(Sender: TObject);
551. begin
552.    btnGetXml.Enabled := True;
553.    btnDownload.Enabled := True;
554.    lstFiles.Enabled := True;
555.    spStat.Caption := '准备就绪';
556.    if lstFiles.Items.Count = 0 then
557.    begin
558.      btnDownload.Caption := '下载并更新';
559.      btnDownload.Enabled := False;
560.    end;
561. end;
563. initialization
564.    FileList := TPodoList.Create;
565.    commandList := TStringList.Create;
567. finalization
568.    FileList.Free;
569.    commandList.Free;
571. end.
573. 更新的原理很简单，先执行 xml 中包含的脚本，然后下载文件，最后再执行脚本，完成整个更新。
575. 用到的控件是 HttpGet，用它来进行断点续传。
577. 程序截图：