frmminiupdate.pas

delphi 开发的自动升级源码

unit frmMiniUpdate;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RzPrgres, StdCtrls, RzLabel, ExtCtrls, RzPanel, hxClientApp, hxFileRes,
  hxUpdate, hxSysUtils, RzButton, ShellApi;

type
  TMiniUpdateForm = class(TForm)
    RzPanel4: TRzPanel;
    Notebook1: TNotebook;
    pnlFirst: TRzPanel;
    lblDownloadTip: TRzLabel;
    pbDownload: TRzProgressBar;
    pnlSecond: TRzPanel;
    RzLabel1: TRzLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Notebook1PageChanged(Sender: TObject);
  private
    { Private declarations }
    FNewFiles: TStringList;
    FVersionList: TVersionList;
    procedure DoDownloadFileList(Sender: TObject; DownloadStatus: TDownloadStatus;
      const WorkCount: Integer);
    procedure DoDownloadFiles(Sender: TObject; DownloadStatus: TDownloadStatus;
      const WorkCount: Integer);

    procedure RefreshNewFileList(ResTree: TResTree; var TotalSize: Integer);
    function GetNewVersion(FileName: string): TVersion;
    function GetOldVersion(FileName: string): TVersion;
  public
    { Public declarations }
  end;

var
  MiniUpdateForm: TMiniUpdateForm;

implementation

uses
  hxClasses, frmConfig;

{$R *.dfm}

procedure TMiniUpdateForm.DoDownloadFileList(Sender: TObject;
  DownloadStatus: TDownloadStatus; const WorkCount: Integer);
var
  I, TotalFileSize: Integer;
  slFiles: TStringList;
begin
  case DownloadStatus of
    dsBegin:
    begin
      pbDownload.Percent:= 0;
      lblDownloadTip.Caption:= '正在下载最新文件列表...';
    end;
    dsEnd:
    begin
      TotalFileSize:= 0;
      RefreshNewFileList((Sender as TDownloadFileListThread).ResTree, TotalFileSize);
      lblDownloadTip.Caption:= '正在下载文件...';
      Application.ProcessMessages;
      pbDownload.Percent:= 0;
      if FNewFiles.Count <> 0 then
      begin
        pbDownload.TotalParts:= TotalFileSize;
        slFiles:= TStringList.Create;
        try
          for I:= 0 to FNewFiles.Count - 1 do
          begin
            slFiles.Add(FNewFiles.Names[I]);
          end;
          GetClientApp.UpdateClient.DownloadFiles(slFiles, DoDownloadFiles);
        finally
          slFiles.Free;
        end;
      end
      else
      begin
        Application.Terminate;
      end;
    end;
  end;
end;

procedure TMiniUpdateForm.DoDownloadFiles(Sender: TObject;
  DownloadStatus: TDownloadStatus; const WorkCount: Integer);
var
  FileName: string;
  NewVersion: TVersion;
begin
  case DownloadStatus of
    dsBegin:
    begin
      pbDownload.PartsComplete:= 0;
    end;
    dsFileBegin:
    begin
      lblDownloadTip.Caption:= '正在下载 ' + (Sender as TDownloadFilesThread).DownloadFileName;
    end;
    dsFileData:
    begin
      pbDownload.IncParts(WorkCount);
    end;
    dsFileEnd:
    begin
      // 更新历史版本号
      FileName:= (Sender as TDownloadFilesThread).DownloadFileName;
      NewVersion:= GetNewVersion(FileName);
      FVersionList.Update(FileName, NewVersion);
      Application.ProcessMessages;
    end;
    dsEnd:
    begin
      Notebook1.PageIndex:= 1;
    end;
  end;
end;

procedure TMiniUpdateForm.FormCreate(Sender: TObject);
begin
  FNewFiles:= TStringList.Create;
  G_ClientApp:= ThxClientApp.Create(ParamStr(1));
  Notebook1.PageIndex:= 0;
end;

procedure TMiniUpdateForm.FormDestroy(Sender: TObject);
begin
  FVersionList.Free;
  G_ClientApp.Free;
  FNewFiles.Free;
end;

function TMiniUpdateForm.GetOldVersion(FileName: string): TVersion;
var
  Index: Integer;
begin
  Index:= FVersionList.IndexOf(FileName);
  if Index <> -1 then
    Result:= FVersionList[Index].Version
  else
    Result:= 'Unknown';
end;

procedure TMiniUpdateForm.FormShow(Sender: TObject);
begin
  // 显示已安装的文件列表
  FVersionList:= TVersionList.Create(ExtractFilePath(ParamStr(0)) + ParamStr(1) + '.ver');
  lblDownloadTip.Caption:= '正在连接服务器...';
  with GetClientApp.Settings do
  try
    GetClientApp.UpdateClient.Open(ServerIP, ServerPort);
  except
    on E: Exception do
    begin
      MessageBox(0, PChar(E.Message), '网络故障', MB_OK + MB_ICONERROR);
      ShowConfigForm;
      Close;
    end;
  end;
  GetClientApp.UpdateClient.DownloadFileList(DoDownloadFileList);
end;

function TMiniUpdateForm.GetNewVersion(FileName: string): TVersion;
begin
  Result:= FNewFiles.Values[FileName];
end;

procedure TMiniUpdateForm.RefreshNewFileList(ResTree: TResTree; var TotalSize: Integer);

  procedure TravelTree(Node: TNode);
  var
    I: Integer;
    pInfo: PResInfo;
  begin
    if Node = nil then Exit;
    pInfo:= PResInfo(Node.Data);
    if pInfo^.ResType = rtFile then
    begin
      if not SameVersion(pInfo^.Version, GetOldVersion(pInfo^.DownloadURL)) then
      begin
        FNewFiles.Values[pInfo^.DownloadURL]:= pInfo^.Version;
        Inc(TotalSize, pInfo^.FileSize);
      end;
    end;

    for I:= 0 to Node.Count - 1 do
      TravelTree(Node.Children[I]);
  end;

var
  I: Integer;
  Node: TNode;
begin
  FNewFiles.Clear;
  Node:= ResTree.RootNode;
  for I:= 0 to Node.Count - 1 do
    TravelTree(Node.Children[I]);
end;

procedure TMiniUpdateForm.Notebook1PageChanged(Sender: TObject);
begin
  if (Sender as TNotebook).PageIndex = 1 then
  begin
    ShellExecute(0, 'open', PChar(ParamStr(3)), '', '', SW_NORMAL);
    Close;
  end;
end;

end.