通用程序自动更新升级

1）服务端IIS网站上创建新的虚拟路径，给新创建的虚拟路径增加MIME类型：.bpl、.ini等。

2）设置update.ini文件版本号配置文件

[ver]
config.ini=1
bplCommon.bpl=1
bplGoods.bpl=1
bplPower.bpl=1
bplPurchasing.bpl=1
prjMain.exe=2

3)客户端

untAutoUpdate.dfm文件：

object frmAutoUpdate: TfrmAutoUpdate
Left = 0
Top = 0
Caption = #33258#21160#21319#32423#31243#24207
ClientHeight = 140
ClientWidth = 573
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object btnDownload: TButton
Left = 199
Top = 24
Width = 138
Height = 41
Caption = #26816#26597#26356#26032
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 0
OnClick = btnDownloadClick
end
object bar: TProgressBar
Left = 24
Top = 88
Width = 529
Height = 17
TabOrder = 1
end
object cdsLocal: TClientDataSet
Aggregates = <>
IndexFieldNames = 'filename'
Params = <>
Left = 48
Top = 8
object cdsLocalfilename: TStringField
FieldName = 'filename'
Size = 100
end
object cdsLocalver: TIntegerField
FieldName = 'ver'
end
end
object cdsServer: TClientDataSet
Aggregates = <>
IndexFieldNames = 'filename'
Params = <>
Left = 120
Top = 8
object cdsServerfilename: TStringField
FieldName = 'filename'
Size = 100
end
object cdsServerver: TIntegerField
FieldName = 'ver'
end
end
end

untAutoUpdate.pas文件：

{ *******************************************************
单元功用：自动升级
单元设计：陈新光
设计日期：2014-11-17
单元修改：
修改日期：
******************************************************* }

unit untAutoUpdate;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Winapi.UrlMon, Vcl.StdCtrls,
System.IniFiles, Data.DB, Datasnap.DBClient,
Vcl.ComCtrls, Wininet;

type
TfrmAutoUpdate = class(TForm)
btnDownload: TButton;
cdsLocal: TClientDataSet;
cdsServer: TClientDataSet;
cdsLocalfilename: TStringField;
cdsLocalver: TIntegerField;
cdsServerfilename: TStringField;
cdsServerver: TIntegerField;
bar: TProgressBar;
procedure btnDownloadClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
appPath: string;
urlPath: string;
FList: TStringList;
function DownloadFile(Source, Dest: string): Boolean;
procedure InitCdsLocal;
procedure InitCdsServer;
procedure CreateLocalVer;
procedure CreateServerVer;
public
{ Public declarations }
end;

var
frmAutoUpdate: TfrmAutoUpdate;

implementation

{$R *.dfm}
{ TForm1 }

procedure TfrmAutoUpdate.btnDownloadClick(Sender: TObject);
var
Source, Dest: string;
errCount: Integer;

procedure _down;
begin
Source := urlPath + cdsServer.FieldByName('filename').Text;
Dest := appPath + cdsServer.FieldByName('filename').Text;
if not DownloadFile(Source, Dest) then
begin
Inc(errCount);
ShowMessage(cdsServer.FieldByName('filename').Text + '下载失败');
end;
end;
begin
errCount := 0;
// 下载服务端的update.ini
Source := urlPath + 'update.ini';
Dest := appPath + 'update2.ini';
if DownloadFile(Source, Dest) then // 下载update.ini 成功
begin
// 生成服务端文件版本情况列表
CreateServerVer;
if FileExists(appPath + 'update.ini') then // 本地有update.ini
begin
// 生成本地文件版本情况列表
CreateLocalVer;
// 比对文件版本号决定哪些需要下载
bar.Max := cdsServer.RecordCount;
cdsServer.First;
while not cdsServer.Eof do
begin
if not cdsLocal.FindKey([cdsServer.FieldByName('filename').Text]) then
// 新文件要下载
begin
_down;
end
else
begin
if cdsServer.FieldByName('ver').AsInteger > // 版本号低的旧文件要下载
cdsLocal.FieldByName('ver').AsInteger then
begin
_down;
end;
end;
cdsServer.Next;
bar.Position := bar.Position +1;
bar.Update;
end;
end
else
begin // 本地无update.ini 下载所有文件
bar.Max := cdsServer.RecordCount;
cdsServer.First;
while not cdsServer.Eof do
begin
_down;
cdsServer.Next;
bar.Position := bar.Position +1;
bar.Update;
end;
end;
// 更新本地update.ini
CopyFile(PChar(appPath + 'update2.ini'),
PChar(appPath + 'update.ini'), False);
DeleteFile(appPath + 'update2.ini');
end
else
begin // 从服务器下载update.ini 失败
ShowMessage('下载update.ini失败');
Exit;
end;
if errCount = 0 then begin
ShowMessage('更新程序成功');
end else
ShowMessage('更新程序程序失败');
end;

procedure TfrmAutoUpdate.CreateLocalVer;
var
ini: TIniFile;
i: integer;
begin
ini := TIniFile.Create(appPath + 'update.ini');
try
FList.Clear;
ini.ReadSectionValues('ver', FList);
for i := 0 to FList.Count - 1 do
begin
cdsLocal.Append;
cdsLocal.FieldByName('filename').Text :=
Copy(FList[i], 1, pos('=', FList[i]) - 1);
cdsLocal.FieldByName('ver').Text :=
Copy(FList[i], pos('=', FList[i]) + 1,
length(FList[i]));
cdsLocal.Post;
end;
finally
ini.Free;
end;
end;

procedure TfrmAutoUpdate.CreateServerVer;
var
ini: TIniFile;
i: integer;
begin
ini := TIniFile.Create(appPath + 'update2.ini');
try
FList.Clear;
ini.ReadSectionValues('ver', FList);
for i := 0 to FList.Count-1 do
begin
cdsServer.Append;
cdsServer.FieldByName('filename').Text :=
Copy(FList[i], 1, pos('=', FList[i]) - 1);
cdsServer.FieldByName('ver').Text :=
Copy(FList[i], pos('=', FList[i]) + 1,
length(FList[i]));
cdsServer.Post;
end;
finally
ini.Free;
end;
end;

function TfrmAutoUpdate.DownloadFile(Source, Dest: string): Boolean;
begin
try
DeleteUrlCacheEntry(PChar(Source)); // 先要清空缓存
Result := UrlDownloadToFile(nil, PChar(Source), PChar(Dest), 0, nil) = 0;
except
Result := False;
end;
end;

procedure TfrmAutoUpdate.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
frmAutoUpdate:=nil;
end;

procedure TfrmAutoUpdate.FormCreate(Sender: TObject);
begin
FList :=TStringList.Create;
end;

procedure TfrmAutoUpdate.FormDestroy(Sender: TObject);
begin
FreeAndNil(FList);
end;

procedure TfrmAutoUpdate.FormShow(Sender: TObject);
var
ini: TIniFile;
begin
appPath := ExtractFilePath(Application.ExeName);
// 升级文件的url path
ini := TIniFile.Create(appPath + 'config.ini');
try
urlPath := ini.ReadString('appServer', 'update', '');
finally
ini.Free;
end;
InitCdsLocal;
InitCdsServer;
end;

procedure TfrmAutoUpdate.InitCdsLocal;
begin
if not cdsLocal.Active then
cdsLocal.CreateDataSet
else
cdsLocal.EmptyDataSet;
end;

procedure TfrmAutoUpdate.InitCdsServer;
begin
if not cdsServer.Active then
cdsServer.CreateDataSet
else
cdsServer.EmptyDataSet;
end;

end.