frmmain.~pas

delphi 开发的自动升级源码

unit frmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, StdCtrls, hxUpdate, ComCtrls, RzButton, ExtCtrls,
  RzPanel, GIFImage, RzTreeVw, RzBorder, RzPrgres, RzLabel, RzListVw,
  RzLstBox, hxFileRes, hxClasses, hxVersion, {hxPopup,} Menus;

type
  TMainForm = class(TForm)
    RzPanel1: TRzPanel;
    RzPanel2: TRzPanel;
    RzPanel3: TRzPanel;
    Notebook1: TNotebook;       
    ActionList1: TActionList;
    actOpen: TAction;
    actClose: TAction;
    actDownloadFileList: TAction;
    actDowloadSelectedFiles: TAction;
    actDownloadNewFiles: TAction;
    actBack: TAction;
    actNext: TAction;
    actCancel: TAction;
    actFinish: TAction;
    RzButton2: TRzButton;
    RzButton3: TRzButton;
    RzButton4: TRzButton;
    RzPanel4: TRzPanel;
    Image1: TImage;
    RzPanel5: TRzPanel;
    tvNewFiles: TRzCheckTree;
    RzPanel6: TRzPanel;
    lvUpdateFiles: TRzListView;
    RzLabel1: TRzLabel;
    pbTotalDownload: TRzProgressBar;
    lblDownloadFileName: TRzLabel;
    pbFileDownload: TRzProgressBar;
    RzPanel7: TRzPanel;
    RzLabel3: TRzLabel;
    RzLabel4: TRzLabel;
    RzLabel5: TRzLabel;
    lbInstalled: TRzListBox;
    RzLabel6: TRzLabel;
    RzLabel7: TRzLabel;
    RzButton1: TRzButton;
    actConfig: TAction;
    RzLabel8: TRzLabel;
    RzLabel9: TRzLabel;
    RzLabel10: TRzLabel;
    pbFileList: TRzProgressBar;
    lblDownloadFileList: TRzLabel;
    RzLabel12: TRzLabel;
    RzLabel2: TRzLabel;
    actViewFileInfo: TAction;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    Label1: TRzLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure actOpenUpdate(Sender: TObject);
    procedure actCloseUpdate(Sender: TObject);
    procedure actOpenExecute(Sender: TObject);
    procedure actCloseExecute(Sender: TObject);
    procedure actDownloadFileListUpdate(Sender: TObject);
    procedure actDowloadSelectedFilesExecute(Sender: TObject);
    procedure actDowloadSelectedFilesUpdate(Sender: TObject);
    procedure actDownloadFileListExecute(Sender: TObject);
    procedure actDownloadNewFilesUpdate(Sender: TObject);
    procedure actBackUpdate(Sender: TObject);
    procedure actNextUpdate(Sender: TObject);
    procedure actFinishUpdate(Sender: TObject);
    procedure actBackExecute(Sender: TObject);
    procedure actNextExecute(Sender: TObject);
    procedure actCancelExecute(Sender: TObject);
    procedure actFinishExecute(Sender: TObject);
    procedure actCancelUpdate(Sender: TObject);
    procedure actConfigExecute(Sender: TObject);
    procedure actViewFileInfoUpdate(Sender: TObject);
    procedure actViewFileInfoExecute(Sender: TObject);
  private
    { Private declarations }
    //FPopup: ThxPopup;
    FVersionList: TVersionList;
    procedure DoDownloadFileList(Sender: TObject; DownloadStatus: TDownloadStatus;
      const WorkCount: Integer);
    procedure DoDownloadFiles(Sender: TObject; DownloadStatus: TDownloadStatus;
      const WorkCount: Integer);

    function GetNewVersion(FileName: string): TVersion;
    function GetOldVersion(FileName: string): TVersion;
    procedure RefreshInstalledFiles;
    procedure RefreshFileList(TreeNodes: TTreeNodes; Tree: TResTree);
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses
  frmConfig, hxClientApp, hxSysUtils;

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Caption:= 'LiveUpdate - ' + ParamStr(1);
  //FPopup:= ThxPopup.Create(nil);
  G_ClientApp:= ThxClientApp.Create(ParamStr(1));
  // 显示已安装的文件列表
  FVersionList:= TVersionList.Create(ExtractFilePath(ParamStr(0)) + ParamStr(1) + '.ver');
  RefreshInstalledFiles;
  Notebook1.PageIndex:= 0;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FVersionList.Free;
  G_ClientApp.Free;
  //FPopup.Free;
end;

procedure TMainForm.actOpenUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled:= not GetClientApp.UpdateClient.Active;
end;

procedure TMainForm.actCloseUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled:= GetClientApp.UpdateClient.Active;
end;

procedure TMainForm.actOpenExecute(Sender: TObject);
begin
  with GetClientApp.Settings do
    GetClientApp.UpdateClient.Open(ServerIP, ServerPort);
end;

procedure TMainForm.actCloseExecute(Sender: TObject);
begin
  GetClientApp.UpdateClient.Close;
end;

procedure TMainForm.actDownloadFileListUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled:= GetClientApp.UpdateClient.Active;
end;

procedure TMainForm.actDowloadSelectedFilesExecute(Sender: TObject);
var
  I: Integer;
  slFiles: TStrings;
  TreeNode: TTreeNode;
begin
  slFiles:= TStringList.Create;
  try
    for I:= 0 to tvNewFiles.Items.Count - 1 do
      if tvNewFiles.Items[I].Selected then
      begin
        TreeNode:= tvNewFiles.Items[I];
        case PResInfo(TreeNode.Data)^.ResType of
          rtFile: slFiles.Add(PResInfo(TreeNode.Data)^.DownloadURL);
          rtDirectory:
          begin
            TreeNode:= TreeNode.getFirstChild;
            while TreeNode <> nil do
            begin
              if PResInfo(TreeNode.Data)^.ResType = rtFile then
                slFiles.Add(PResInfo(TreeNode.Data)^.DownloadURL);
              TreeNode:= TreeNode.getNextSibling;
            end;
          end;
        end;
      end;

    GetClientApp.UpdateClient.DownloadFiles(slFiles, nil);
  finally
    slFiles.Free;
  end;
end;

procedure TMainForm.actDowloadSelectedFilesUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled:= GetClientApp.UpdateClient.Active;
end;

procedure TMainForm.actDownloadFileListExecute(Sender: TObject);
begin
  GetClientApp.UpdateClient.DownloadFileList(nil);
end;

procedure TMainForm.actDownloadNewFilesUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled:= GetClientApp.UpdateClient.Active;
end;

procedure TMainForm.actBackUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled:= (Notebook1.PageIndex > 0) and
    (Notebook1.PageIndex <> Notebook1.Pages.Count - 1) and
    ((Sender as TAction).Tag = 0);
end;

procedure TMainForm.actNextUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled:= Notebook1.PageIndex < Notebook1.Pages.Count - 1;
end;

procedure TMainForm.actFinishUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled:= Notebook1.PageIndex = Notebook1.Pages.Count - 1;
end;

procedure TMainForm.actBackExecute(Sender: TObject);
begin
  Notebook1.PageIndex:= Notebook1.PageIndex - 1;
end;

procedure TMainForm.actNextExecute(Sender: TObject);
var
  I: Integer;
  slFiles: TStrings;
  FileSize: Integer;
  pInfo: PResInfo;
begin
  Notebook1.PageIndex:= Notebook1.PageIndex + 1;
  case Notebook1.PageIndex of
    1:  // download file list
    begin
      if GetClientApp.UpdateClient.Active then
        GetClientApp.UpdateClient.Close;
      lblDownloadFileList.Caption:= '正在连接服务器...';
      with GetClientApp.Settings do
        GetClientApp.UpdateClient.Open(ServerIP, ServerPort);
      GetClientApp.UpdateClient.DownloadFileList(DoDownloadFileList);
    end;
    2: // download files
    begin
      slFiles:= TStringList.Create;
      try
        lvUpdateFiles.Clear;
        FileSize:= 0;
        for I:= 0 to tvNewFiles.Items.Count - 1 do
        begin
          pInfo:= PResInfo(tvNewFiles.Items[I].Data);
          if (tvNewFiles.ItemState[I] = csChecked) and (pInfo^.ResType <> rtDirectory) then
          begin
            slFiles.Add(pInfo^.DownloadURL);
            FileSize:= FileSize + pInfo^.FileSize;

            with lvUpdateFiles.Items.Add do
            begin
              Caption:= pInfo^.FileName;
              SubItems.Add(IntToStr(pInfo^.FileSize));
              SubItems.Add('0');
              Data:= pInfo;
            end;
          end;
        end;

        if slFiles.Count <> 0 then
        begin
          pbTotalDownload.TotalParts:= FileSize;
          GetClientApp.UpdateClient.DownloadFiles(slFiles, DoDownloadFiles);
        end
        else
          Notebook1.PageIndex:= 3;
      finally
        slFiles.Free;
      end;
    end;
  end;
end;

procedure TMainForm.actCancelExecute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.actFinishExecute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.actCancelUpdate(Sender: TObject);
begin
  if Notebook1.PageIndex = Notebook1.Pages.Count - 1 then
    (Sender as TAction).Caption:= '关闭'
  else
    (Sender as TAction).Caption:= '取消';
end;

procedure TMainForm.actConfigExecute(Sender: TObject);
begin
  // Todo:配置网络
  ShowConfigForm;
end;

procedure TMainForm.DoDownloadFileList(Sender: TObject; DownloadStatus: TDownloadStatus;
  const WorkCount: Integer);
begin
  case DownloadStatus of
    dsBegin:
    begin
      pbFileList.Percent:= 0;
      lblDownloadFileList.Caption:= '正在下载最新文件列表...';
    end;
    dsEnd:
    begin
      RefreshFileList(tvNewFiles.Items, (Sender as TDownloadFileListThread).ResTree);
      pbFileList.Percent:= 100;
      lblDownloadFileList.Caption:= '文件列表下载完毕';
    end;
  end;
end;

procedure TMainForm.DoDownloadFiles(Sender: TObject; DownloadStatus: TDownloadStatus;
  const WorkCount: Integer);

  function IndexOfNewFile(FileName: string): Integer;
  var
    I: Integer;
  begin
    Result:= -1;
    for I:= 0 to lvUpdateFiles.Items.Count - 1 do
      if SameText(PResInfo(lvUpdateFiles.Items[I].Data)^.DownloadURL, FileName) then
      begin
        Result:= I;
        Exit;
      end;
  end;

var
  Index: Integer;
  FileName, NewVersion: string;
begin
  case DownloadStatus of
    dsBegin:
    begin
      //pbTotalDownload.TotalParts:= WorkCount;
      pbTotalDownload.PartsComplete:= 0;
    end;
    dsFileBegin:
    begin
      pbFileDownload.TotalParts:= WorkCount;
      pbFileDownload.PartsComplete:= 0;
      lblDownloadFileName.Caption:= (Sender as TDownloadFilesThread).DownloadFileName;
    end;
    dsFileData:
    begin
      pbFileDownload.IncParts(WorkCount);
      pbTotalDownload.IncParts(WorkCount);
      FileName:= (Sender as TDownloadFilesThread).DownloadFileName;
      Index:= IndexOfNewFile(FileName);
      if Index <> -1 then
        lvUpdateFiles.Items[Index].SubItems[1]:= IntToStr(pbFileDownload.Percent);
    end;
    dsFileEnd:
    begin
      // 更新历史版本号
      FileName:= (Sender as TDownloadFilesThread).DownloadFileName;
      Index:= IndexOfNewFile(FileName);
      if Index <> -1 then
      begin
        NewVersion:= PResInfo(lvUpdateFiles.Items[Index].Data)^.Version;
        FVersionList.Update((Sender as TDownloadFilesThread).DownloadFileName, NewVersion);
      end;
      pbFileDownload.Percent:= 100;
      //pbTotalDownload.PartsComplete:= pbTotalDownload.PartsComplete + WorkCount;
    end;
    dsEnd:
    begin
      FPopup.Title:= '提示';
      FPopup.Text:= '程序更新完毕。';
      FPopup.Popup;
      // 自动跳到最后一页
      Notebook1.PageIndex:= Notebook1.Pages.Count - 1;
      actBack.Tag:= 1;
    end;
  end;
end;

procedure TMainForm.RefreshFileList(TreeNodes: TTreeNodes; Tree: TResTree);

  procedure TravelTree(Node: TNode; TreeNode: TTreeNode);
  var
    I: Integer;
  begin
    if Node = nil then Exit;
    with PResInfo(Node.Data)^ do
      case ResType of
        rtDirectory:
        begin
          TreeNode:= TreeNodes.AddChild(TreeNode, Node.Text);
          TreeNode.Data:= Node.Data;
        end;
      else
        // 在此处比较版本
        if not SameVersion(Version, GetOldVersion(DownloadURL)) then
        begin
          TreeNode:= TreeNodes.AddChild(TreeNode, Node.Text);
          TreeNode.Data:= Node.Data;
          tvNewFiles.ItemState[tvNewFiles.Items.Count - 1]:= csChecked;
        end;
      end;
    for I:= 0 to Node.Count - 1 do
      TravelTree(Node.Children[I], TreeNode);
  end;

var
  I: Integer;
  Node: TNode;
begin
  TreeNodes.BeginUpdate;
  try
    TreeNodes.Clear;
    Node:= Tree.RootNode;
    for I:= 0 to Node.Count - 1 do
      TravelTree(Node.Children[I], nil);

    // 删除空目录
    for I:= TreeNodes.Count - 1 downto 0 do
      if PResInfo(TreeNodes.Item[I].Data)^.ResType = rtDirectory then
        if not TreeNodes.Item[I].HasChildren then
          TreeNodes.Item[I].Delete;

  finally
    TreeNodes.EndUpdate;
  end;
end;


procedure TMainForm.RefreshInstalledFiles;
var
  I: Integer;
begin
  lbInstalled.Items.BeginUpdate;
  try
    lbInstalled.Items.Clear;
    for I:= 0 to FVersionList.Count - 1 do
      lbInstalled.Items.Add(FVersionList[I]^.FileName);
  finally
    lbInstalled.Items.EndUpdate;
  end;
end;

procedure TMainForm.actViewFileInfoUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled:= tvNewFiles.Selected <> nil;
end;

procedure TMainForm.actViewFileInfoExecute(Sender: TObject);
var
  Str: string;
begin
  with PResInfo(tvNewFiles.Selected.Data)^ do
  begin
    Str:= 'FileName:' + FileName + #13#10;
    Str:= Str + 'Description:' + Description + #13#10;
    Str:= Str + 'FileSize:' + IntToStr(FileSize) + #13#10;
    Str:= Str + 'FileAttr:' + IntToStr(FileAttr) + #13#10;
    Str:= Str + 'Version:' + Version + #13#10;
    Str:= Str + 'ResType:' + IntToStr(Integer(ResType)) + #13#10;
    Str:= Str + 'DownloadURL:' + DownloadURL;
    ShowMessage(Str);
  end;
end;

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

function TMainForm.GetNewVersion(FileName: string): TVersion;
var
  I: Integer;
begin
  Result:= '0';
  for I:= 0 to tvNewFiles.Items.Count - 1 do
  begin
    if SameText(PResInfo(tvNewFiles.Items[I].Data)^.FileName, FileName) then
    begin
      Result:= PResInfo(tvNewFiles.Items[I].Data)^.Version;
      Break;
    end;
  end;
end;

end.