common.pas

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

unit Common;

interface

uses
  Windows,
  SysUtils,
  StrUtils,
  Classes,
  ShlObj,
  ComObj;

type
  TDirectoryMapping = record
    Name: string;
    Value: DWORD;
  end;

const
  TDirectoryDefine: array[0..24] of TDirectoryMapping = (
    (Name: 'Windows'; Value: 0)
    , (Name: 'System'; Value: 0)
    , (Name: 'Temp'; Value: 0)
    , (Name: 'Desktop'; Value: CSIDL_DESKTOP)
    , (Name: 'Programs'; Value: CSIDL_PROGRAMS)
    , (Name: 'Personal'; Value: CSIDL_PERSONAL)
    , (Name: 'Favorites'; Value: CSIDL_FAVORITES)
    , (Name: 'Startup'; Value: CSIDL_STARTUP)
    , (Name: 'Recent'; Value: CSIDL_RECENT)
    , (Name: 'SendTo'; Value: CSIDL_SENDTO)
    , (Name: 'StartMenu'; Value: CSIDL_STARTMENU)
    , (Name: 'DesktopDirectory'; Value: CSIDL_DESKTOPDIRECTORY)
    , (Name: 'NetHood'; Value: CSIDL_NETHOOD)
    , (Name: 'Fonts'; Value: CSIDL_FONTS)
    , (Name: 'Templates'; Value: CSIDL_TEMPLATES)
    , (Name: 'Common_StartMenu'; Value: CSIDL_COMMON_STARTMENU)
    , (Name: 'Common_Programs'; Value: CSIDL_COMMON_PROGRAMS)
    , (Name: 'Common_Startup'; Value: CSIDL_COMMON_STARTUP)
    , (Name: 'Common_DesktopDirectory'; Value: CSIDL_COMMON_DESKTOPDIRECTORY)
    , (Name: 'AppData'; Value: CSIDL_APPDATA)
    , (Name: 'PrintHood'; Value: CSIDL_PRINTHOOD)
    , (Name: 'Common_Favorites'; Value: CSIDL_COMMON_FAVORITES)
    , (Name: 'Internet_Cache'; Value: CSIDL_INTERNET_CACHE)
    , (Name: 'Cookies'; Value: CSIDL_COOKIES)
    , (Name: 'History'; Value: CSIDL_HISTORY)
    );

  TEMPFILE_EXTENDNAME = '.~up'; //临时文件追加扩展名
  BACKUPFILE_EXTENDNAME = '.~bf'; //备份文件追加扩展名
  FINISHED_FILENAME = '~finished.file'; //完成下载任务的文件列表
  UPGRADER_FILENAME = '~upgrader.exe'; //upgrader的文件名
  PROCESSID_LISTFILE = '~tpid.file'; //需终止的进程列表文件

procedure CheckMessageQueue;
function GetTempPath: string;
function GetTempFileName: string; overload;
function GetHttpFileSize(const url: string): Int64;
function ExtractFileFromRes(const Instance: THandle; const ResName, ResType: string; const FilePath: string): LongBool;
procedure RollBack(FileList: TStrings); overload;
procedure RollBack(FileName: string); overload;
procedure DeleteBackupFile(FileList: TStrings);
procedure UpgraderWork(FileName: string);
procedure Suicide;
function GetRemnantTime(const RunoutTime, Speed: Cardinal; Total: LONGLONG): Cardinal;
function GetSpeed(const RunoutTime: Cardinal; const Finished: LONGLONG): Cardinal;
function GetOSDirectory(hwndOwenr: HWND; nFolder: Integer): string;
function ExpandFilePath(APath: string): string;

implementation

function GetOSDirectory(hwndOwenr: HWND; nFolder: Integer): string;
var
  Path: array[0..MAX_PATH] of Char;
  pitem: PITEMIDLIST;
begin
  shGetSpecialFolderLocation(hwndOwenr, nFolder, pitem);
  shGetPathFromIDList(pitem, Path);
  Result := StrPas(Path);
end;

function ExpandFilePath(APath: string): string;
var
  iIndex, iCount: Integer;
  SysDir, DirName: string;
  Path: array[0..MAX_PATH] of Char;
begin
  Result := APath;
  if (LeftStr(APath, 1) = '%') and (PosEx('%', APath, 2) > 0) then begin
    iCount := High(TDirectoryDefine);
    for iIndex := 0 to iCount do begin
      DirName := '%' + TDirectoryDefine[iIndex].Name + '%';
      if AnsiStartsText(DirName, Result) then begin

        case iIndex of
          0:
            begin
              GetWindowsDirectory(Path, MAX_PATH + 1);
              SysDir := StrPas(Path);
            end;
          1:
            begin
              GetSystemDirectory(Path, MAX_PATH + 1);
              SysDir := StrPas(Path);
            end;
          2:
            begin
              Windows.GetTempPath(MAX_PATH + 1, Path);
              SysDir := StrPas(Path);
            end;
        else
          SysDir := GetOSDirectory(0, TDirectoryDefine[iIndex].Value);
        end;
        SysDir := ExcludeTrailingPathDelimiter(SysDir);
        Result := StringReplace(Result, DirName, SysDir, [rfReplaceAll, rfIgnoreCase]);
        Break;
        
      end;
    end;
  end;
  Result := ExpandFileName(Result);
end;

{求速度}
function GetSpeed(const RunoutTime: Cardinal; const Finished: LONGLONG): Cardinal;
begin
  {求速度}
  if RunoutTime > 0 then begin
    Result := Finished div RunoutTime;
  end else begin
    Result := 0;
  end;
end;

{求剩余时间}
function GetRemnantTime(const RunoutTime, Speed: Cardinal; Total: LONGLONG): Cardinal;
begin
  if Speed > 0 then begin
    Result := ((Total div Speed) - RunoutTime) div 1000;
  end else begin
    Result := 4294967295;
  end;
end;

procedure CheckMessageQueue;
var
  Msg: TMsg;
begin
  while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end;

function GetTempPath: string;
var
  Path: array[0..MAX_PATH] of Char;
begin
  Windows.GetTempPath(MAX_PATH + 1, Path);
  Result := StrPas(Path);
end;

function GetTempFileName: string; overload;
var
  FileName: array[0..MAX_PATH] of Char;
begin
  Windows.GetTempFileName(PChar(GetTempPath), nil, 0, FileName);
  Windows.DeleteFile(FileName);
  Result := StrPas(FileName);
end;

{取HTTP服务器上的文件的大小}
{function GetHttpFileSize(const url: string): Int64;
var
  HttpClient: TIdHTTP;
begin
  HttpClient := TIdHTTP.Create(nil);
  try
    HttpClient.AllowCookies := False;
    HttpClient.HandleRedirects := True;
    try
      HttpClient.Head(url);
    except
    end;

    try
      if HttpClient.ResponseCode = 200 then begin
        Result := StrToInt64Def(HttpClient.Response.RawHeaders.Values['Content-Length'], -1);
      end else begin
        Result := -1;
      end;
    except
      Result := -1;
    end;
  finally
    FreeAndNil(HttpClient);
  end;
end;}
function GetHttpFileSize(const url: string): Int64;
var
  objHTTP: OleVariant;
begin
  Result := -1;
  try
    objHTTP := CreateOleObject('Microsoft.XMLHTTP');
    objHTTP.Open('HEAD', url, False);
    objHTTP.Send;

    try
      if objHTTP.status = 200 then begin
        Result := StrToInt64Def(objHTTP.getResponseHeader('Content-Length'), -1);
      end else begin
        Result := -1;
      end;
    except
      Result := -1;
    end;
  except
  end;
end;

function ExtractFileFromRes(const Instance: THandle;
  const ResName, ResType: string; const FilePath: string): LongBool;
var
  FResource: TResourceStream;
begin
  Result := False;
  if FileExists(FilePath) then begin
    SetFileAttributes(PChar(FilePath), 0);
    Windows.DeleteFile(PChar(FilePath));
  end;
  try
    FResource := TResourceStream.Create(Instance, ResName, PChar(ResType));
    try
      FResource.SaveToFile(FilePath);
    finally
      FreeAndNil(FResource);
    end;
    Result := FileExists(FilePath);
  except
  end;
end;

procedure RollBack(FileList: TStrings);
var
  iIndex, iCount: Integer;
begin
  if not Assigned(FileList) then Exit;
  if FileList.Count = 0 then Exit;

  TStringList(FileList).Sorted := True;
  iCount := FileList.Count - 1;
  for iIndex := 0 to iCount do begin

    if FileList.Names[iIndex] = '0' then begin
      {删除下载的临时文件}
      if FileExists(FileList.ValueFromIndex[iIndex] + TEMPFILE_EXTENDNAME) then begin
        Windows.DeleteFile(PChar(FileList.ValueFromIndex[iIndex] + TEMPFILE_EXTENDNAME));
      end;
      {还原被修改的文件}
      if FileExists(FileList.ValueFromIndex[iIndex] + BACKUPFILE_EXTENDNAME) then begin
        Windows.DeleteFile(PChar(FileList.ValueFromIndex[iIndex]));
        RenameFile(FileList.ValueFromIndex[iIndex] + BACKUPFILE_EXTENDNAME, FileList.ValueFromIndex[iIndex]);
      end;
    end else begin
      RemoveDir(FileList.ValueFromIndex[iIndex]);
    end;

  end;
end;

procedure RollBack(FileName: string);
var
  FileList: TStrings;
begin
  if not FileExists(FileName) then Exit;

  FileList := TStringList.Create;
  try
    FileList.LoadFromFile(FileName);
    RollBack(FileList);
  finally
    FreeAndNil(FileList);
  end;
end;

procedure DeleteBackupFile(FileList: TStrings);
var
  iIndex, iCount: Integer;
begin
  if not Assigned(FileList) then Exit;
  if FileList.Count = 0 then Exit;

  TStringList(FileList).Sorted := True;
  iCount := FileList.Count - 1;
  for iIndex := 0 to iCount do begin
    if FileList.Names[iIndex] = '0' then begin
      Windows.DeleteFile(PChar(FileList.ValueFromIndex[iIndex] + BACKUPFILE_EXTENDNAME));
    end;
  end;
end;

procedure UpgraderWork(FileName: string);
var
  FileList: TStrings;
  iIndex, iCount: Integer;
  RealFileName: string;
  RenameFail: Boolean;
begin
  if not FileExists(FileName) then Exit;

  FileList := TStringList.Create;
  try
    FileList.LoadFromFile(FileName);
    Windows.DeleteFile(PChar(FileName));

    if FileList.Count = 0 then Exit;

    RenameFail := False;
    iCount := FileList.Count - 1;
    for iIndex := 0 to iCount do begin
      if FileList.Names[iIndex] = '0' then begin

        RealFileName := FileList.ValueFromIndex[iIndex];

        if FileExists(RealFileName + TEMPFILE_EXTENDNAME) then begin
          {备份源文件}
          RenameFile(RealFileName, RealFileName + BACKUPFILE_EXTENDNAME);
          {更新源文件}
          if not RenameFile(RealFileName + TEMPFILE_EXTENDNAME, RealFileName) then begin
            RenameFail := True;
            Break;
          end;
        end;

      end;
    end;

    if RenameFail then begin //进行回滚
      RollBack(FileList);
    end else begin //所有都成功，删除备份文件
      DeleteBackupFile(FileList);
    end;

  finally
    FreeAndNil(FileList);
  end;
end;

procedure Suicide;
var
  CmdFile: TStrings;
  curDir, exeFile, batFile: string;
  ProcessInfo: TProcessInformation;
  StartUpInfo: TStartupInfo;
begin
  exeFile := GetModuleName(HInstance);
  curDir := IncludeTrailingPathDelimiter(ExtractFilePath(exeFile));
  batFile := curDir + 'killme.bat';

  CmdFile := TStringList.Create;
  try
    CmdFile.Add('@echo off');
    CmdFile.Add(':loop');
    CmdFile.Add(Format('del "%s"', [exeFile]));
    CmdFile.Add(Format('if exist "%s" goto loop', [exeFile]));
    CmdFile.Add('del %0');
    CmdFile.SaveToFile(batFile);
  finally
    FreeAndNil(CmdFile);
  end;

  SetFileAttributes(PChar(exeFile), 0);
  FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow := SW_HIDE;
  if CreateProcess(
    nil
    , PChar(batFile)
    , nil
    , nil
    , False
    , IDLE_PRIORITY_CLASS
    , nil
    , PChar(curDir)
    , StartUpInfo
    , ProcessInfo) then begin
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
  end;
  Halt(0);
end;

end.