install.pas

源代码

      end;
    end;

    Result := S;
  end;

  procedure RecordStartInstall;
  var
    AppDir: String;
  begin
    if shCreateAppDir in SetupHeader.Options then
      AppDir := WizardDirValue
    else
      AppDir := '';

    UninstLog.Add(utStartInstall, [GetComputerNameString, GetUserNameString,
      AppDir, GetLocalTimeAsStr], 0);
  end;

  procedure RecordCompiledCode;
  var
    LeadBytesStr, ExpandedApp, ExpandedGroup: String;
  begin
    SetString(LeadBytesStr, PChar(@SetupHeader.LeadBytes),
      SizeOf(SetupHeader.LeadBytes));

    { Only use app if Setup creates one }
    if shCreateAppDir in SetupHeader.Options then
      ExpandedApp := ExpandConst('{app}')
    else
      ExpandedApp := '';

    try
      ExpandedGroup := ExpandConst('{group}');
    except
      { Yep, expanding "group" might fail with an exception }
      ExpandedGroup := '';
    end;

    { Record [Code] even if empty to 'overwrite' old versions }
    UninstLog.Add(utCompiledCode, [SetupHeader.CompiledCodeText, LeadBytesStr,
      ExpandedApp, ExpandedGroup, ExpandConst('{groupname}'),
      ExpandConst('{language}')], SetupBinVersion);
  end;

  type
    TRegErrorFunc = (reRegSetValueEx, reRegCreateKeyEx, reRegOpenKeyEx);
  procedure RegError(const Func: TRegErrorFunc; const RootKey: HKEY;
    const KeyName: String; const ErrorCode: Longint);
  const
    ErrorMsgs: array[TRegErrorFunc] of TSetupMessageID =
      (msgErrorRegWriteKey, msgErrorRegCreateKey, msgErrorRegOpenKey);
    FuncNames: array[TRegErrorFunc] of String =
      ('RegSetValueEx', 'RegCreateKeyEx', 'RegOpenKeyEx');
  begin
    raise Exception.Create(FmtSetupMessage(ErrorMsgs[Func],
        [GetRegRootKeyName(RootKey), KeyName]) + SNewLine2 +
      FmtSetupMessage(msgErrorFunctionFailedWithMessage,
        [FuncNames[Func], IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));
  end;

  procedure RegisterUninstallInfo(const UninstallRegKeyBaseName: String);
  { Stores uninstall information in the Registry so that the program can be
    uninstalled through the Control Panel Add/Remove Programs applet. }
  var
    RootKey, H, H2: HKEY;
    Disp: DWORD;
    S, S2, Z: String;

    procedure SetStringValue(const K: HKEY; const ValueName: PChar;
      const Data: String);
    var
      ErrorCode: Longint;
    begin
      ErrorCode := RegSetValueEx(K, ValueName, 0, REG_SZ, PChar(Data),
         Length(Data)+1);
      if ErrorCode <> ERROR_SUCCESS then
        RegError(reRegSetValueEx, RootKey, S2, ErrorCode);
    end;

    procedure SetStringValueUnlessEmpty(const K: HKEY; const ValueName: PChar;
      const Data: String);
    begin
      if Data <> '' then
        SetStringValue(K, ValueName, Data);
    end;

    procedure SetDWordValue(const K: HKEY; const ValueName: PChar;
      const Data: DWord);
    var
      ErrorCode: Longint;
    begin
      ErrorCode := RegSetValueEx(K, ValueName, 0, REG_DWORD, @Data,
         SizeOf(Data));
      if ErrorCode <> ERROR_SUCCESS then
        RegError(reRegSetValueEx, RootKey, S2, ErrorCode);
    end;

    procedure DeleteOldKeys(const K: HKEY; const UninstallRegKeyBaseName: String);
    { Pre-1.3.6 versions of Inno Setup supported creation of multiple uninstall
      keys with the same name but different suffixes, such as "_is1",
      "_is2", "_is3", etc. when an application was installed more than once.
      Version 1.08 introduced this "feature" but I and users of Inno Setup
      quickly realized it was very annoying. Version 1.09 made it optional via
      a [Setup] section directive called "OverwriteUninstRegEntries". In version
      1.3.6, this feature has been removed entirely (it didn't coexist with
      UsePreviousAppDir and other new 1.3.x features), but we still check for
      and delete any "old" keys with suffixes of "_is2" and higher. }
    var
      M, I, J, Numbers: Integer;
      ErrorCode: Longint;
      Buf: array[0..4095] of Char;
      P: PChar;
      Count: Integer;
      N: String;
    begin
      M := Length(UninstallRegKeyBaseName) + 3;
      { ^ Minimum length of key name to look at. Length of UninstallRegKeyBaseName
        plus length of "_is". }
      I := 0;
      while True do begin
        Count := SizeOf(Buf);
        ErrorCode := RegEnumKeyEx(K, I, Buf, DWORD(Count), nil, nil, nil, nil);
        { Break on any error except ERROR_MORE_DATA }
        if (ErrorCode <> ERROR_SUCCESS) and (ErrorCode <> ERROR_MORE_DATA) then
          Break;
        if (ErrorCode = ERROR_SUCCESS) and (Count >= M+1) and
           (Count <= M+3) then begin  { Number in suffix can have 1 to 3 digits }
          { Count the numbers at the end of the key name }
          Numbers := 0;
          P := @Buf[Count];
          for J := 1 to 4 do begin
            Dec(P);  { First pass will compare the last character (Count-1) }
            if P^ in ['0'..'9'] then
              Inc(Numbers)
            else
              Break;
          end;
          if (Numbers >= 1) and (Numbers <= 3) and  { Between 0 and 999? }
             (Count = M + Numbers) then begin  { Make sure the following Dec won't go out of bounds }
            Dec(P, 2);
            if (P[0] = '_') and (P[1] = 'i') and (P[2] = 's') then begin
              N := StrPas(Buf);
              P[0] := #0;  { Truncate starting at '_' in Buf }
              if UninstallRegKeyBaseName = StrPas(Buf) then begin
                { ^ Does it have the same base name? }
                if RegDeleteKeyIncludingSubkeys(K, PChar(N)) = ERROR_SUCCESS then begin
                  { Successfully deleted a key; restart the loop }
                  I := -1;  { will be 0 after the Inc below }
                end;
              end;
            end;
          end;
        end;
        Inc(I);
      end;
    end;

  var
    ErrorCode: Longint;
  begin
    if IsAdmin then
      RootKey := HKEY_LOCAL_MACHINE
    else
      RootKey := HKEY_CURRENT_USER;
    ErrorCode := RegCreateKeyEx(RootKey, NEWREGSTR_PATH_UNINSTALL, 0, nil,
      REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_ENUMERATE_SUB_KEYS,
      nil, H, @Disp);
    if ErrorCode <> ERROR_SUCCESS then
      RegError(reRegCreateKeyEx, RootKey, NEWREGSTR_PATH_UNINSTALL, ErrorCode);
    H2 := 0;
    try
      { Delete any uninstall keys left over from previous installs }
      if IsAdmin then begin
        { Delete any keys under HKEY_CURRENT_USER too }
        if RegOpenKeyEx(HKEY_CURRENT_USER, NEWREGSTR_PATH_UNINSTALL, 0,
           KEY_QUERY_VALUE or KEY_ENUMERATE_SUB_KEYS, H2) = ERROR_SUCCESS then begin
          DeleteOldKeys(H2, UninstallRegKeyBaseName);
          RegCloseKey(H2);
          H2 := 0;
        end
        else
          H2 := 0;
      end;
      DeleteOldKeys(H, UninstallRegKeyBaseName);

      { Create uninstall key }
      S := UninstallRegKeyBaseName + '_is1';
      S2 := NEWREGSTR_PATH_UNINSTALL + '\' + S;
      ErrorCode := RegCreateKeyEx(H, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE,
        nil, H2, @Disp);
      if ErrorCode <> ERROR_SUCCESS then begin
        H2 := 0;
        RegError(reRegCreateKeyEx, RootKey, S2, ErrorCode);
      end;
      { do not localize or change any of the following strings }
      SetStringValue(H2, 'Inno Setup: Setup Version', SetupVersion);
      if shCreateAppDir in SetupHeader.Options then
        Z := WizardDirValue
      else
        Z := '';
      SetStringValue(H2, 'Inno Setup: App Path', Z);
      SetStringValueUnlessEmpty(H2, 'InstallLocation', AddBackslash(Z));
      SetStringValue(H2, 'Inno Setup: Icon Group', WizardGroupValue);
      SetStringValue(H2, 'Inno Setup: User', GetUserNameString);
      if WizardSetupType <> nil then begin
        SetStringValue(H2, 'Inno Setup: Setup Type', WizardSetupType.Name);
        SetStringValue(H2, 'Inno Setup: Selected Components', GetSelectedComponentsStr);
        SetStringValue(H2, 'Inno Setup: Deselected Components', GetDeselectedComponentsStr);
      end;
      if HasTasks then begin
        SetStringValue(H2, 'Inno Setup: Selected Tasks', GetSelectedTasksStr);
        SetStringValue(H2, 'Inno Setup: Deselected Tasks', GetDeselectedTasksStr);
      end;
      if shUserInfoPage in SetupHeader.Options then begin
        SetStringValue(H2, 'Inno Setup: User Info: Name', WizardUserInfoName);
        SetStringValue(H2, 'Inno Setup: User Info: Organization', WizardUserInfoOrg);
        SetStringValue(H2, 'Inno Setup: User Info: Serial', WizardUserInfoSerial);
      end;

      if SetupHeader.UninstallDisplayName <> '' then
        Z := ExpandConst(SetupHeader.UninstallDisplayName)
      else
        Z := ExpandedAppVerName;
      { Note: DisplayName can't exceed 63 chars on Win9x }
      SetStringValue(H2, 'DisplayName', Copy(Z, 1, 63));
      SetStringValueUnlessEmpty(H2, 'DisplayIcon', ExpandConst(SetupHeader.UninstallDisplayIcon));
      SetStringValue(H2, 'UninstallString', AddQuotes(UninstallExeFilename));
      SetStringValue(H2, 'QuietUninstallString', AddQuotes(UninstallExeFilename) + ' /SILENT');
      SetStringValueUnlessEmpty(H2, 'DisplayVersion', ExpandConst(SetupHeader.AppVersion));
      SetStringValueUnlessEmpty(H2, 'Publisher', ExpandConst(SetupHeader.AppPublisher));
      SetStringValueUnlessEmpty(H2, 'URLInfoAbout', ExpandConst(SetupHeader.AppPublisherURL));
      SetStringValueUnlessEmpty(H2, 'HelpLink', ExpandConst(SetupHeader.AppSupportURL));
      SetStringValueUnlessEmpty(H2, 'URLUpdateInfo', ExpandConst(SetupHeader.AppUpdatesURL));
      SetStringValueUnlessEmpty(H2, 'Readme', ExpandConst(SetupHeader.AppReadmeFile));
      SetStringValueUnlessEmpty(H2, 'Contact', ExpandConst(SetupHeader.AppContact));
      SetStringValueUnlessEmpty(H2, 'Comments', ExpandConst(SetupHeader.AppComments));
      Z := ExpandConst(SetupHeader.AppModifyPath);
      if Z <> '' then
        SetStringValue(H2, 'ModifyPath', Z)
      else
        SetDWordValue(H2, 'NoModify', 1);
      SetDWordValue(H2, 'NoRepair', 1);

      { Also see SetPreviousData in ScriptFunc.pas }
      if CodeRunner <> nil then begin
        try
          CodeRunner.RunProcedure('RegisterPreviousData', [Integer(H2)], False);
        except
          Log('RegisterPreviousData raised an exception.');
          Application.HandleException(nil);
        end;
      end;
    finally
      if H2 <> 0 then
        RegCloseKey(H2);
      RegCloseKey(H);
    end;

    UninstLog.Add(utRegDeleteEntireKey, [S2], Integer(RootKey));
  end;

  type
    TMakeDirFlags = set of (mdNoUninstall, mdAlwaysUninstall, mdDeleteAfterInstall,
      mdNotifyChange);
  function MakeDir(Dir: String; const Flags: TMakeDirFlags): Boolean;
  { Returns True if a new directory was created }
  const
    DeleteDirFlags: array[Boolean] of Longint = (0, utDeleteDirOrFiles_CallChangeNotify);
  var
    ErrorCode: DWORD;
  begin
    Result := False;
    Dir := RemoveBackslash(PathExpand(Dir));
    if (Dir = '') or (PathLastChar(Dir)^ = ':') or (PathExtractPath(Dir) = Dir) then
      Exit;
    if DirExists(Dir) then begin
      if not(mdAlwaysUninstall in Flags) then
        Exit;
    end
    else begin
      MakeDir(PathExtractPath(Dir), Flags - [mdAlwaysUninstall]);
      LogFmt('Creating directory: %s', [Dir]);
      if not CreateDirectory(PChar(Dir), nil) then begin
        ErrorCode := GetLastError;
        raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
          [FmtSetupMessage1(msgErrorCreatingDir, Dir), IntToStr(ErrorCode),
           Win32ErrorString(ErrorCode)]));
      end;
      Result := True;
      if mdNotifyChange in Flags then begin
        SHChangeNotify(SHCNE_MKDIR, SHCNF_PATH, PChar(Dir), nil);
        SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH,
          PChar(PathExtractDir(Dir)), nil);
      end;
    end;
    if mdDeleteAfterInstall in Flags then
      DeleteDirsAfterInstallList.Add(Dir)
    else
      if not(mdNoUninstall in Flags) then
        UninstLog.Add(utDeleteDirOrFiles, [Dir],
          utDeleteDirOrFiles_IsDir or DeleteDirFlags[mdNotifyChange in Flags]);
  end;

  procedure CreateDirs;
  { Creates the application's directories }

    procedure ApplyPermissions(const Filename: String; const PermsEntry: Integer);
    var
      P: PSetupPermissionEntry;
    begin
      if PermsEntry <> -1 then begin
        LogFmt('Setting permissions on directory: %s', [Filename]);
        P := Entries[sePermission][PermsEntry];
        if not GrantPermissionOnFile(Filename, TGrantPermissionEntry(Pointer(P.Permissions)^),
           Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then
          Log('Failed to set permissions on directory.');
      end;
    end;

  var
    CurDirNumber: Integer;
    Flags: TMakeDirFlags;
    N: String;
  begin
    { Create main application directory }
    MakeDir(WizardDirValue, []);

    { Create the rest of the directories, if any }