upgrader.pas

特性： 1、阻塞模式更新 2、具备比较完备的进度控制 3、与autoupgrader组件相比

{*******************************************************}
{                                                       }
{       upgrader                                        }
{                                                       }
{       版权所有 (C) 2007 whitewolf                     }
{                                                       }
{       Version 1.1                                     }
{                                                       }
{*******************************************************}

unit Upgrader;

interface

uses
  Windows,
  SysUtils,
  UrlMon,
  WinInet,
  IniFiles,
  BindStatusCallback,
  Common,
  Classes;

type
  {单个进度}
  TProgress = packed record
    TotalSize: LONGLONG;
    FinishedSize: LONGLONG;
  end;
  PProgress = ^TProgress;

  {多个进度}
  TProgressEx = packed record
    FirstTickCount: Cardinal; //开始复制时的时间量
    FileCount: Cardinal; //文件数量
    General: TProgress;
    Single: TProgress;
  end;
  PProgressEx = ^TProgressEx;

  TVersionPattern = (vpByDateTime, vpByNumber);
  TOnProgress = procedure(
    const ProgressEx: TProgressEx
    ; const ulStatusCode: ULONG
    ; szStatusText: LPCWSTR) of object;
  TOnProgress2 = procedure(
    const SingleProgress, MultiProgress: Integer
    ; const RemnantTime: ULONG
    ; const Speed: ULONG
    ; const ulStatusCode: ULONG
    ; szStatusText: LPCWSTR) of object;
  TOnFileBegin = procedure(
    const url, localfile: string
    ; const Size: Int64) of object;
  TOnFileEnd = TOnFileBegin;

  TDownloadInfo = class(TStringList)
  private
    FVersionPattern: TVersionPattern;
    FVersionAsDateTime: TDateTime;
    FVersionAsNumber: Integer;
  public
    constructor Create; overload;
    constructor Create(const UpdateInfoURL: string); overload;
    procedure Assign(Source: TPersistent); override;
  public
    property VersionPattern: TVersionPattern read FVersionPattern;
    property VersionAsDateTime: TDateTime read FVersionAsDateTime;
    property VersionAsNumber: Integer read FVersionAsNumber;
  end;

  TUpgrader = class(TComponent)
  private
    FUpdateInfoURL: string; //更新信息文件地址
    FVersionPattern: TVersionPattern; //版本控制类型
    FVersionAsDateTime: TDateTime;
    FVersionAsNumber: Integer;
    FOnProgress: TOnProgress;
    FOnProgress2: TOnProgress2;
    FOnFileBegin: TOnFileBegin;
    FOnFileEnd: TOnFileEnd;
    FPaused: Boolean;
    FStoped: Boolean;
    FInitSize: Int64;
    FAppDir: string;
    FUpgraderFilePath: string;
    FProgressEx: TProgressEx;
  protected
    procedure DownLoad(ADownInfo: TDownloadInfo = nil); virtual;
    function OnWork(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HRESULT;
  public
    constructor Create(AOwner: TComponent); override;
    function Check(ADownInfo: TDownloadInfo = nil): Boolean;
    procedure Start(ADownInfo: TDownloadInfo = nil);
    procedure Pause;
    procedure Resume;
    procedure Stop;
  published
    property UpdateInfoURL: string read FUpdateInfoURL write FUpdateInfoURL;
    property VersionPattern: TVersionPattern read FVersionPattern write FVersionPattern;
    property VersionAsDateTime: TDateTime read FVersionAsDateTime write FVersionAsDateTime;
    property VersionAsNumber: Integer read FVersionAsNumber write FVersionAsNumber;
    property OnProgress: TOnProgress read FOnProgress write FOnProgress;
    property OnProgress2: TOnProgress2 read FOnProgress2 write FOnProgress2;
    property OnFileBegin: TOnFileBegin read FOnFileBegin write FOnFileBegin;
    property OnFileEnd: TOnFileEnd read FOnFileEnd write FOnFileEnd;
    property Name;
  end;

procedure Register;

implementation

{$R update.res}

procedure Register;
begin
  RegisterComponents('Standard', [TUpgrader]);
end;

////////////////////////////////////////////////////////////////////////////////

constructor TDownloadInfo.Create;
begin
  inherited Create;
end;

constructor TDownloadInfo.Create(const UpdateInfoURL: string);
var
  UpdateInfoFile: string;
  IniFile: TIniFile;
begin
  inherited Create;
  if Trim(UpdateInfoURL) = '' then Exit;

  if not FileExists(UpdateInfoURL) then begin //检查是否为本地文件
    UpdateInfoFile := GetTempFileName;
    try
      DeleteUrlCacheEntry(PChar(UpdateInfoURL));
      URLDownloadToFile(nil, PChar(UpdateInfoURL), PChar(UpdateInfoFile), 0, nil);
    except
    end;
  end else begin
    UpdateInfoFile := UpdateInfoURL;
  end;

  {分析文件}
  if not FileExists(UpdateInfoFile) then Exit;
  IniFile := TIniFile.Create(UpdateInfoFile);
  try

    {读取版本信息}
    try
      FVersionPattern := TVersionPattern(IniFile.ReadInteger('Version', 'Pattern', 1));
    except
      FVersionPattern := vpByNumber;
    end;

    case FVersionPattern of
      vpByDateTime: FVersionAsDateTime := IniFile.ReadDateTime('Version', 'Version', 0);
      vpByNumber: FVersionAsNumber := IniFile.ReadInteger('Version', 'Version', 1);
    end;

    {读取文件列表}
    IniFile.ReadSectionValues('Files', Self);

  finally
    FreeAndNil(IniFile);
  end;
  Windows.DeleteFile(PChar(UpdateInfoFile));
end;

procedure TDownloadInfo.Assign(Source: TPersistent);
var
  ADownInfo: TDownloadInfo;
begin
  if Source is TDownloadInfo then begin
    ADownInfo := (Source as TDownloadInfo);
    FVersionPattern := ADownInfo.VersionPattern;
    FVersionAsDateTime := ADownInfo.VersionAsDateTime;
    FVersionAsNumber := ADownInfo.VersionAsNumber;
  end;
  inherited Assign(Source);
end;

////////////////////////////////////////////////////////////////////////////////

constructor TUpgrader.Create(AOwner: TComponent);
var
  FirstTickCount: DWORD;
begin
  inherited Create(AOwner);
  FUpdateInfoURL := '';
  VersionPattern := vpByNumber;
  VersionAsDateTime := Now;
  VersionAsNumber := 1;
  FPaused := True;
  FStoped := True;
  FAppDir := IncludeTrailingPathDelimiter(ExtractFilePath(GetModuleName(HInstance)));
  FUpgraderFilePath := FAppDir + UPGRADER_FILENAME;
  if FileExists(FUpgraderFilePath) then begin
    FirstTickCount := GetTickCount;
    while not Windows.DeleteFile(PChar(FUpgraderFilePath)) do begin
      Sleep(10);
      CheckMessageQueue;
      if GetTickCount - FirstTickCount > 5000 then Break;
    end;
  end;
end;

function TUpgrader.OnWork(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HRESULT;
var
  sProgress, mProgress: Integer;
  RunoutTime, Speed, RemnantTime: Cardinal;
begin
  sProgress := 0;
  mProgress := 0;
  FProgressEx.Single.FinishedSize := ulProgress;
  FProgressEx.Single.TotalSize := ulProgressMax;
  FProgressEx.General.FinishedSize := FInitSize + ulProgress;

  if Assigned(FOnProgress) then begin
    FOnProgress(FProgressEx, ulStatusCode, szStatusText);
  end;

  if Assigned(FOnProgress2) then begin
    if FProgressEx.Single.TotalSize > 0 then begin
      try
        sProgress := FProgressEx.Single.FinishedSize * 100 div FProgressEx.Single.TotalSize;
      except
      end;
    end;

    if FProgressEx.General.TotalSize > 0 then begin
      try
        mProgress := FProgressEx.General.FinishedSize * 100 div FProgressEx.General.TotalSize;
      except
      end;
    end;

    RunoutTime := GetTickCount - FProgressEx.FirstTickCount; //共用的时间
    Speed := GetSpeed(RunoutTime, FProgressEx.General.FinishedSize);
    RemnantTime := GetRemnantTime(RunoutTime, Speed, FProgressEx.General.TotalSize);
    FOnProgress2(sProgress, mProgress, RemnantTime, Speed, ulStatusCode, szStatusText);
  end;

  {停止}
  if FStoped then begin
    Result := E_ABORT;
    Exit;
  end;

  {暂停}
  while FPaused do begin
    Sleep(10);
    CheckMessageQueue;
  end;

  {继续}
  CheckMessageQueue;
  Result := S_OK;
end;

procedure TUpgrader.DownLoad(ADownInfo: TDownloadInfo = nil);
var
  Status: TBindStatusCallback;
  DownloadInfo: TDownloadInfo;
  iIndex, iCount: Integer;
  FileURL, TempFileName, RealFileName, FilePath: string;
  SingleSize: Int64;
  SizeList, FinishedFiles: TStrings;
begin
  FPaused := False;
  FStoped := False;
  try
    DownloadInfo := TDownloadInfo.Create;
    try
      if Assigned(ADownInfo) then begin
        DownloadInfo.Assign(ADownInfo);
      end else begin
        if not Check(DownloadInfo) then Exit;
      end;

      {开始更新}
      Status := TBindStatusCallback.Create;
      try
        Status.OnWork := OnWork;

        iCount := DownloadInfo.Count - 1;
          {取所有文件的大小总和}
        FProgressEx.General.TotalSize := 0;
        FProgressEx.FileCount := DownloadInfo.Count;
        DownloadInfo.Sorted := False;

        SizeList := TStringList.Create;
        try

          for iIndex := 0 to iCount do begin
            SingleSize := GetHttpFileSize(DownloadInfo.ValueFromIndex[iIndex]);
            if SingleSize < 0 then Exit; //文件丢失
            SizeList.Add(IntToStr(SingleSize));
            FProgressEx.General.TotalSize := FProgressEx.General.TotalSize + SingleSize;
          end;

          FinishedFiles := TStringList.Create;
          try
            FProgressEx.FirstTickCount := GetTickCount;
            FProgressEx.General.FinishedSize := 0;
            FInitSize := 0;
            for iIndex := 0 to iCount do begin

              if FStoped then Break;

              FileURL := DownloadInfo.ValueFromIndex[iIndex];
              RealFileName := ExpandFilePath(DownloadInfo.Names[iIndex]);
              DownloadInfo[iIndex] := RealFileName + '=' + DownloadInfo.ValueFromIndex[iIndex]; //全路径=URL
              TempFileName := RealFileName + TEMPFILE_EXTENDNAME;
              FilePath := IncludeTrailingPathDelimiter(ExtractFilePath(TempFileName));

              if not DirectoryExists(FilePath) then begin
                ForceDirectories(FilePath);
                FinishedFiles.Add('1=' + FilePath); //使列表在排序后，目录能够在后面处理
              end;

              SingleSize := StrToInt64Def(SizeList[iIndex], 0);

              if Assigned(FOnFileBegin) then begin
                FOnFileBegin(FileURL, RealFileName, SingleSize);
              end;
              try

                try
                  DeleteUrlCacheEntry(PChar(FileURL));
                  if URLDownloadToFile(nil, PChar(FileURL), PChar(TempFileName), 0, Status) <> S_OK then begin
                    Windows.DeleteFile(PChar(TempFileName));
                    Break;
                  end else begin
                    {便于后面进行回滚操作}
                    FinishedFiles.Add('0=' + RealFileName);
                  end;
                  FInitSize := FInitSize + StrToInt64Def(SizeList[iIndex], 0); //下一个文件的起始大小
                  FProgressEx.General.FinishedSize := FInitSize; //当前文件已经复制完
                except
                  Windows.DeleteFile(PChar(TempFileName));
                  Break;
                end;

              finally
                if Assigned(FOnFileEnd) then begin
                  FOnFileEnd(FileURL, RealFileName, SingleSize);
                end;
              end;

            end;

            if FStoped or (iIndex < iCount) then begin //下载被人为中止或下载不完全则回滚文件操作
              RollBack(FinishedFiles);
            end else if iIndex >= iCount then begin //所有下载成功

                {通过upgrader来做善后工作，并重启应用程序}
              if FileExists(FUpgraderFilePath) or ExtractFileFromRes(HInstance, 'upgrader', 'FILE', FUpgraderFilePath) then begin
                if FinishedFiles.Count <> 0 then begin
                  FinishedFiles.SaveToFile(FAppDir + FINISHED_FILENAME);
                end;
                WinExec(PChar('"' + FUpgraderFilePath + '"' + ' '
                  + ExtractFileName(GetModuleName(HInstance)) + ' '
                  + IntToStr(GetCurrentProcessId)), SW_HIDE);
                Halt(0);
              end else begin
                RollBack(FinishedFiles);
              end;

            end;

          finally
            FreeAndNil(FinishedFiles);
          end;

        finally
          FreeAndNil(SizeList);
        end;

      finally
        FreeAndNil(Status);
      end;

    finally
      FreeAndNil(DownloadInfo);
    end;
  finally
    FStoped := True;
    FPaused := True;
  end;
end;

function TUpgrader.Check(ADownInfo: TDownloadInfo = nil): Boolean;
var
  DownloadInfo: TDownloadInfo;
begin
  Result := False;
  if Assigned(ADownInfo) then begin
    ADownInfo.Clear;
  end;

  DownloadInfo := TDownloadInfo.Create(FUpdateInfoURL);
  try
    if DownloadInfo.Count = 0 then Exit;
    case FVersionPattern of
      vpByDateTime:
        if DownloadInfo.VersionAsDateTime <= FVersionAsDateTime then Exit;
      vpByNumber:
        if DownloadInfo.VersionAsNumber <= FVersionAsNumber then Exit; //版本更低
    else
      Exit;
    end;
    if Assigned(ADownInfo) then ADownInfo.Assign(DownloadInfo);
    Result := True;
  finally
    FreeAndNil(DownloadInfo);
  end;
end;

procedure TUpgrader.Start(ADownInfo: TDownloadInfo = nil);
begin
  if not FStoped then Exit;
  DownLoad(ADownInfo);
end;

procedure TUpgrader.Pause;
begin
  FPaused := True;
  Sleep(100);
end;

procedure TUpgrader.Stop;
begin
  FStoped := True;
  FPaused := False;
  Sleep(100);
end;

procedure TUpgrader.Resume;
begin
  FPaused := False;
end;

end.