install.pas

源代码

          SetProgress(PreviousProgress);
        goto Retry;
      end;
    end;

    { Increment progress meter, if not already done so }
    if not ProgressUpdated then begin
      if Assigned(CurFileLocation) then  { not an "external" file }
        IncProgress64(CurFileLocation^.OriginalSize)
      else
        IncProgress64(AExternalSize);
    end;

    { Process any events between copying files }
    ProcessEvents;
    { Clear previous filename label in case an exception or debugger break
      occurs between now and when the label for the next entry is set }
    SetFilenameLabelText('', False);
  end;

  procedure CopyFiles;
  { Copies all the application's files }

    function RecurseExternalCopyFiles(const SearchBaseDir, SearchSubDir,
      SearchWildcard: String; const SourceIsWildcard: Boolean;
      const CurFile: PSetupFileEntry; const FileLocationFilenames: TStringList;
      var ExpectedBytesLeft: Integer64): Boolean;
    var
      SearchFullPath, FileName, SourceFile, DestName: String;
      H: THandle;
      FindData: TWin32FindData;
      Size: Integer64;
    begin
      SearchFullPath := SearchBaseDir + SearchSubDir + SearchWildcard;
      Result := False;

      H := FindFirstFile(PChar(SearchFullPath), FindData);
      if H <> INVALID_HANDLE_VALUE then begin
        try
          repeat
            if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin

              if SourceIsWildcard then begin
                if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
                  Continue;
                FileName := FindData.cFileName;
              end
              else
                FileName := SearchWildcard;  { use the case specified in the script }

              Result := True;
              SourceFile := SearchBaseDir + SearchSubDir + FileName;
              DestName := ExpandConst(CurFile^.DestName);
              if not(foCustomDestName in CurFile^.Options) then
                DestName := DestName + SearchSubDir + FileName
              else if SearchSubDir <> '' then
                DestName := PathExtractPath(DestName) + SearchSubDir + PathExtractName(DestName);
              Size.Hi := FindData.nFileSizeHigh;
              Size.Lo := FindData.nFileSizeLow;
              if Compare64(Size, ExpectedBytesLeft) > 0 then begin
                { Don't allow the progress bar to overflow if the size of the
                  files is greater than when we last checked }
                Size := ExpectedBytesLeft;
              end;
              ProcessFileEntry(CurFile, SourceFile, DestName,
                FileLocationFilenames, Size);
              Dec6464(ExpectedBytesLeft, Size);
            end;
          until not FindNextFile(H, FindData);
        finally
          Windows.FindClose(H);
        end;
      end;

      if foRecurseSubDirsExternal in CurFile^.Options then begin
        H := FindFirstFile(PChar(SearchBaseDir + SearchSubDir + '*'), FindData);
        if H <> INVALID_HANDLE_VALUE then begin
          try
            repeat
              if IsRecurseableDirectory(FindData) then
                Result := RecurseExternalCopyFiles(SearchBaseDir,
                  SearchSubDir + FindData.cFileName + '\', SearchWildcard,
                  SourceIsWildcard, CurFile, FileLocationFileNames,
                  ExpectedBytesLeft) or Result;
            until not FindNextFile(H, FindData);
          finally
            Windows.FindClose(H);
          end;
        end;
      end;

      if SearchSubDir <> '' then begin
        { If Result is False this subdir won't be created, so create it now if
          CreateAllSubDirs was set }
        if (foCreateAllSubDirs in CurFile.Options) and not Result then begin
          DestName := ExpandConst(CurFile^.DestName);
          if not(foCustomDestName in CurFile^.Options) then
            DestName := DestName + SearchSubDir
          else
            DestName := PathExtractPath(DestName) + SearchSubDir;
          MakeDir(DestName, []);
          Result := True;
        end;
      end;

      { When recursively searching but not picking up every file, we could
        be frozen for a long time when installing from a network. Calling
        ProcessEvents after every directory helps. }
      ProcessEvents;
    end;

  var
    FileLocationFilenames: TStringList;
    I: Integer;
    CurFileNumber: Integer;
    CurFile: PSetupFileEntry;
    ExternalSize: Integer64;
    SourceWildcard: String;
    ProgressBefore, ExpectedBytesLeft: Integer64;
    FoundFiles: Boolean;
  begin
    FileLocationFilenames := TStringList.Create;
    try
      for I := 0 to Entries[seFileLocation].Count-1 do
        FileLocationFilenames.Add('');
      for CurFileNumber := 0 to Entries[seFile].Count-1 do begin
        CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]);
        if ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin
          DebugNotifyEntry(seFile, CurFileNumber);
          NotifyBeforeInstallFileEntry(CurFile);
          if CurFile^.LocationEntry <> -1 then begin
            ExternalSize.Hi := 0;  { not used... }
            ExternalSize.Lo := 0;
            ProcessFileEntry(CurFile, '', '', FileLocationFilenames, ExternalSize);
          end
          else begin
            { File is an 'external' file }
            if CurFile^.FileType <> ftUserFile then
              SourceWildcard := NewParamStr(0)
            else
              SourceWildcard := ExpandConst(CurFile^.SourceFilename);
            ProgressBefore := CurProgress;
            repeat
              SetProgress(ProgressBefore);
              ExpectedBytesLeft := CurFile^.ExternalSize;
              FoundFiles := RecurseExternalCopyFiles(PathExtractPath(SourceWildcard),
                '', PathExtractName(SourceWildcard), IsWildcard(SourceWildcard),
                CurFile, FileLocationFileNames, ExpectedBytesLeft);
            until FoundFiles or
                  (foSkipIfSourceDoesntExist in CurFile^.Options) or
                  AbortRetryIgnoreMsgBox(SetupMessages[msgErrorReadingSource] + SNewLine +
                    AddPeriod(FmtSetupMessage(msgSourceDoesntExist, [SourceWildcard])),
                    SetupMessages[msgFileAbortRetryIgnore]);
            { In case we didn't end up copying all the expected bytes, bump
              the progress bar up to the expected amount }
            Inc6464(ProgressBefore, CurFile^.ExternalSize);
            SetProgress(ProgressBefore);
          end;
          NotifyAfterInstallFileEntry(CurFile);
        end;
      end;
    finally
      FileLocationFilenames.Free;
    end;
  end;

  procedure CreateIcons;
  { Creates the program's group and icons in Program Manager using Dynamic Data
    Exchange. But when compiling with Win32 and the "new shell" is detected, it
    creates the group using MkDir and the icons using COM. }

    procedure CreateAnIcon(Name: String; const Description, Path, Parameters,
      WorkingDir, IconFilename: String; const IconIndex, ShowCmd: Integer;
      const NeverUninstall: Boolean; const CloseOnExit: TSetupIconCloseOnExit;
      const HotKey: Word; const FolderShortcut: Boolean);
    var
      BeginsWithGroup: Boolean;
      LinkFilename, PifFilename, ResultingFilename: String;
      Flags: TMakeDirFlags;
      FolderShortcutCreated: Boolean;
    begin
      BeginsWithGroup := Copy(Name, 1, 8) = '{group}\';
      Name := ExpandConst(Name);
      LinkFilename := Name + '.lnk';
      PifFilename := Name + '.pif';
      Flags := [mdNotifyChange];
      if NeverUninstall then
        Include(Flags, mdNoUninstall)
      else if BeginsWithGroup then
        Include(Flags, mdAlwaysUninstall);

      LogFmt('Filename: %s', [LinkFilename]);
      SetFilenameLabelText(LinkFilename, True);
      MakeDir(PathExtractPath(LinkFilename), Flags);

      { Delete any old .lnk and .pif files first }
      DeleteFile(LinkFilename);
      DeleteFile(PifFilename);

      { Create the shortcut }
      ResultingFilename := CreateShellLink(LinkFilename, Description,
        PathExpand(Path), Parameters, PathExpand(WorkingDir),
        PathExpand(IconFilename), IconIndex, ShowCmd, HotKey, FolderShortcut);
      CreatedIcon := True;
      FolderShortcutCreated := FolderShortcut and DirExists(ResultingFilename);

      { If a .pif file was created, apply the "Close on exit" setting }
      if (CloseOnExit <> icNoSetting) and not FolderShortcutCreated and
         (CompareText(PathExtractExt(ResultingFilename), '.pif') = 0) then begin
        try
          ModifyPifFile(ResultingFilename, CloseOnExit = icYes);
        except
          { Failure isn't important here. Ignore exceptions }
        end;
      end;

      { Notify shell of the change }
      if FolderShortcutCreated then
        SHChangeNotify(SHCNE_MKDIR, SHCNF_PATH, PChar(ResultingFilename), nil)
      else
        SHChangeNotify(SHCNE_CREATE, SHCNF_PATH, PChar(ResultingFilename), nil);
      SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH,
        PChar(PathExtractDir(ResultingFilename)), nil);

      { Add uninstall log entries }
      if not NeverUninstall then begin
        if FolderShortcutCreated then begin
          UninstLog.Add(utDeleteDirOrFiles, [ResultingFilename],
            utDeleteDirOrFiles_IsDir or utDeleteDirOrFiles_CallChangeNotify);
          UninstLog.Add(utDeleteFile, [AddBackslash(ResultingFilename) + 'target.lnk'], 0);
          UninstLog.Add(utDeleteFile, [AddBackslash(ResultingFilename) + 'Desktop.ini'], 0);
        end
        else begin
          { Even though we only created one file, go ahead and try deleting
            both a .lnk and .pif file at uninstall time, in case the user
            alters the shortcut after installation }
          UninstLog.Add(utDeleteFile, [LinkFilename], utDeleteFile_CallChangeNotify);
          UninstLog.Add(utDeleteFile, [PifFilename], utDeleteFile_CallChangeNotify);
        end;
      end;

      { Increment progress meter }
      IncProgress(1000);
    end;

    function ExpandAppPath(const Filename: String): String;
    const
      AppPathsBaseKey = NEWREGSTR_PATH_SETUP + '\App Paths\';
    var
      K: HKEY;
      Found: Boolean;
    begin
      if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(AppPathsBaseKey + Filename),
         0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
        Found := RegQueryStringValue(K, '', Result);
        RegCloseKey(K);
        if Found then
          Exit;
      end;
      Result := Filename;
    end;

  var
    CurIconNumber: Integer;
    CurIcon: PSetupIconEntry;
    FN: String;
  begin
    for CurIconNumber := 0 to Entries[seIcon].Count-1 do begin
      try
        CurIcon := PSetupIconEntry(Entries[seIcon][CurIconNumber]);
        with CurIcon^ do begin
          if ShouldProcessIconEntry(WizardComponents, WizardTasks, WizardNoIcons, CurIcon) then begin
            DebugNotifyEntry(seIcon, CurIconNumber);
            NotifyBeforeInstallEntry(BeforeInstall);
            Log('-- Icon entry --');
            FN := ExpandConst(Filename);
            if ioUseAppPaths in Options then
              FN := ExpandAppPath(FN);
            if not(ioCreateOnlyIfFileExists in Options) or NewFileExists(FN) then
              CreateAnIcon(IconName, ExpandConst(Comment), FN,
                ExpandConst(Parameters), ExpandConst(WorkingDir),
                ExpandConst(IconFilename), IconIndex, ShowCmd,
                ioUninsNeverUninstall in Options, CloseOnExit, HotKey,
                ioFolderShortcut in Options);
            NotifyAfterInstallEntry(AfterInstall);
          end;
        end;
      except
        if not(ExceptObject is EAbort) then
          Application.HandleException(nil)
        else
          raise;
      end;
      ProcessEvents;
      { Clear previous filename label in case an exception or debugger break
        occurs between now and when the label for the next entry is set }
      SetFilenameLabelText('', False);
    end;
  end;

  procedure CreateIniEntries;
  var
    CurIniNumber: Integer;
    CurIni: PSetupIniEntry;
    IniSection, IniEntry, IniValue, IniFilename: String;
  begin
    for CurIniNumber := 0 to Entries[seIni].Count-1 do begin
      CurIni := PSetupIniEntry(Entries[seIni][CurIniNumber]);
      with CurIni^ do begin
        if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
          DebugNotifyEntry(seIni, CurIniNumber);
          NotifyBeforeInstallEntry(BeforeInstall);
          IniSection := ExpandConst(Section);
          IniEntry := ExpandConst(Entry);
          IniValue := ExpandConst(Value);
          IniFilename := ExpandConst(Filename);

          if (IniEntry <> '') and (ioHasValue in Options) and
             (not(ioCreateKeyIfDoesntExist in Options) or
              not IniKeyExists(IniSection, IniEntry, IniFilename)) then
            while not SetIniString(IniSection, IniEntry, IniValue, IniFilename) do begin
              if AbortRetryIgnoreMsgBox(FmtSetupMessage1(msgErrorIniEntry, IniFilename),
                 SetupMessages[msgEntryAbortRetryIgnore]) then
                Break;
            end;

          if ioUninsDeleteEntireSection in Options then
            UninstLog.Add(utIniDeleteSection, [IniFilename, IniSection], 0);
          if ioUninsDeleteSectionIfEmpty in Options then