Inno-Setup-issrc/Projects/Src/Setup.MainForm.pas

unit Setup.MainForm;

{
  Inno Setup
  Copyright (C) 1997-2025 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.
}

interface

uses
  Windows, SysUtils, Classes,
  Shared.SetupSteps;

type
  TMainForm = class(TComponent)
  private
    class procedure AppOnGetActiveFormHandle(var AHandle: HWND);
  public
    CurStep: TSetupStep;
    destructor Destroy; override;
    procedure Close;
    procedure Finish(const FromPreparingPage: Boolean);
    function Install: Boolean;
    procedure SetStep(const AStep: TSetupStep; const HandleExceptions: Boolean);
    class procedure ShowException(Sender: TObject; E: Exception);
    class procedure ShowExceptionMsg(const S: String);
  end;

var
  MainForm: TMainForm;

implementation

uses
  Messages, ShlObj,
  Forms,
  SHA256, RestartManager,
  Shared.Struct, Shared.CommonFunc, Shared.CommonFunc.Vcl, Shared.SetupMessageIDs,
  SetupLdrAndSetup.Messages, Setup.Install,
  Setup.MainFunc, Setup.InstFunc, Setup.WizardForm, Setup.LoggingFunc, Shared.SetupTypes;

destructor TMainForm.Destroy;
begin
  MainForm := nil;  { just to detect use-after-free }
  inherited;
end;

class procedure TMainForm.ShowExceptionMsg(const S: String);
begin
  Log('Exception message:');
  LoggedAppMessageBox(PChar(S), PChar(Application.Title), MB_OK or MB_ICONSTOP, True, IDOK);
end;

class procedure TMainForm.ShowException(Sender: TObject; E: Exception);
begin
  ShowExceptionMsg(AddPeriod(E.Message));
end;

procedure TMainForm.SetStep(const AStep: TSetupStep; const HandleExceptions: Boolean);
begin
  CurStep := AStep;
  if CodeRunner <> nil then begin
    try
      CodeRunner.RunProcedures('CurStepChanged', [Ord(CurStep)], False);
    except
      if HandleExceptions then begin
        Log('CurStepChanged raised an exception.');
        Application.HandleException(Self);
      end
      else begin
        Log('CurStepChanged raised an exception (fatal).');
        raise;
      end;
    end;
  end;
end;

procedure TerminateApp;
begin
  { Work around shell32 bug: Don't use PostQuitMessage/Application.Terminate
    here.
    When ShellExecute is called with the name of a folder, it internally
    creates a window used for DDE communication with Windows Explorer. After
    ShellExecute returns, this window eventually receives a posted WM_DDE_ACK
    message back from the DDE server (Windows Explorer), and in response, it
    tries to flush the queue of DDE messages by using a PeekMessage loop.
    Problem is, PeekMessage will return WM_QUIT messages posted with
    PostQuitMessage regardless of the message range specified, and the loop was
    not written with this in mind.
    In previous IS versions, this was causing our WM_QUIT message to be eaten
    if Application.Terminate was called very shortly after a shellexec [Run]
    entry was processed (e.g. if DisableFinishedPage=yes).
    A WM_QUIT message posted with PostMessage instead of PostQuitMessage will
    not be returned by a GetMessage/PeekMessage call with a message range that
    does not include WM_QUIT. }
  PostMessage(0, WM_QUIT, 0, 0);
end;

function TMainForm.Install: Boolean;

  procedure ProcessRunEntries;
  var
    CheckIfRestartNeeded: Boolean;
    ChecksumBefore, ChecksumAfter: TSHA256Digest;
    WindowDisabler: TWindowDisabler;
    I: Integer;
    RunEntry: PSetupRunEntry;
  begin
    if Entries[seRun].Count <> 0 then begin
      CheckIfRestartNeeded := (shRestartIfNeededByRun in SetupHeader.Options) and
        not NeedsRestart;
      if CheckIfRestartNeeded then
        ChecksumBefore := MakePendingFileRenameOperationsChecksum;
      var WizardWasHidden := False;
      WindowDisabler := nil;
      try
        for I := 0 to Entries[seRun].Count-1 do begin
          RunEntry := PSetupRunEntry(Entries[seRun][I]);
          if not(roPostInstall in RunEntry.Options) and
             ShouldProcessRunEntry(WizardComponents, WizardTasks, RunEntry) then begin
            { Disable windows during execution of [Run] entries so that a nice
              "beep" is produced if the user tries clicking on WizardForm }
            if WindowDisabler = nil then
              WindowDisabler := TWindowDisabler.Create;
            if RunEntry.StatusMsg <> '' then begin
              try
                WizardForm.StatusLabel.Caption := ExpandConst(RunEntry.StatusMsg);
              except
                { Don't die if the expansion fails with an exception. Just
                  display the exception message, and proceed with the default
                  status message. }
                Application.HandleException(Self);
                WizardForm.StatusLabel.Caption := SetupMessages[msgStatusRunProgram];
              end;
            end
            else
              WizardForm.StatusLabel.Caption := SetupMessages[msgStatusRunProgram];
            WizardForm.StatusLabel.Update;
            if roHideWizard in RunEntry.Options then begin
              if WizardForm.Visible and not WizardWasHidden then begin
                WizardWasHidden := True;
                WizardForm.Hide;
              end;
            end
            else begin
              if WizardWasHidden then begin
                WizardWasHidden := False;
                WizardForm.Visible := True;
              end;
            end;
            DebugNotifyEntry(seRun, I);
            NotifyBeforeInstallEntry(RunEntry.BeforeInstall);
            ProcessRunEntry(RunEntry);
            NotifyAfterInstallEntry(RunEntry.AfterInstall);
          end;
        end;
      finally
        if WizardWasHidden then
          WizardForm.Visible := True;
        WindowDisabler.Free;
        if CheckIfRestartNeeded then begin
          ChecksumAfter := MakePendingFileRenameOperationsChecksum;
          if not SHA256DigestsEqual(ChecksumBefore, ChecksumAfter) then
            NeedsRestart := True;
        end;
      end;
      if WizardForm.WindowState <> wsMinimized then  { VCL bug workaround }
        Application.BringToFront;
    end;
  end;

  procedure RestartApplications;
  const
    ERROR_FAIL_RESTART = 353;
  var
    Error: DWORD;
    WindowDisabler: TWindowDisabler;
  begin
    if not NeedsRestart then begin
      WizardForm.StatusLabel.Caption := SetupMessages[msgStatusRestartingApplications];
      WizardForm.StatusLabel.Update;

      Log('Attempting to restart applications.');

      { Disable windows during application restart so that a nice
        "beep" is produced if the user tries clicking on WizardForm }
      WindowDisabler := TWindowDisabler.Create;
      try
        Error := RmRestart(RmSessionHandle, 0, nil);
      finally
        WindowDisabler.Free;
      end;
      if WizardForm.WindowState <> wsMinimized then  { VCL bug workaround }
        Application.BringToFront;

      if Error = ERROR_FAIL_RESTART then
        Log('One or more applications could not be restarted.')
      else if Error <> ERROR_SUCCESS then begin
        RmEndSession(RmSessionHandle);
        RmSessionStarted := False;
        LogFmt('RmRestart returned an error: %d', [Error]);
      end;
    end else
      Log('Need to restart Windows, not attempting to restart applications');
  end;

var
  Succeeded, ChangesEnvironment, ChangesAssociations: Boolean;
  S: String;
begin
  Result := False;
  try
    if not WizardForm.ValidateDirEdit then
      Abort;
    WizardDirValue := WizardForm.DirEdit.Text;
    if not WizardForm.ValidateGroupEdit then
      Abort;
    WizardGroupValue := WizardForm.GroupEdit.Text;
    WizardNoIcons := WizardForm.NoIconsCheck.Checked;
    WizardSetupType := WizardForm.GetSetupType();
    WizardForm.GetComponents(WizardComponents, WizardDeselectedComponents);
    WizardForm.GetTasks(WizardTasks, WizardDeselectedTasks);
    WizardPreparingYesRadio := WizardForm.PreparingYesRadio.Checked;
    if InitSaveInf <> '' then
      SaveInf(InitSaveInf);

    Application.Restore;
    if InstallMode = imSilent then
      WizardForm.Visible := True;
    WizardForm.Update;

    SetStep(ssInstall, False);
    
    ChangesEnvironment := EvalDirectiveCheck(SetupHeader.ChangesEnvironment);
    ChangesAssociations := EvalDirectiveCheck(SetupHeader.ChangesAssociations);

    PerformInstall(Succeeded, ChangesEnvironment, ChangesAssociations);
    if not Succeeded then begin
      { The user canceled the install or there was a fatal error }
      TerminateApp;
      Exit;
    end;
    { Can't cancel at any point after PerformInstall, so disable the button }
    WizardForm.CancelButton.Enabled := False;

    ProcessRunEntries;

    if RmDoRestart and
       (InitRestartApplications or
        ((shRestartApplications in SetupHeader.Options) and not InitNoRestartApplications)) then
      RestartApplications;

    SetStep(ssPostInstall, True);

    { Notify Windows of assocations/environment changes *after* ssPostInstall
      since user might set more stuff there }
    if ChangesAssociations then
      SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
    if ChangesEnvironment then
      RefreshEnvironment;

    if InstallMode <> imNormal then
      WizardForm.Hide;

    LogFmt('Need to restart Windows? %s', [SYesNo[NeedsRestart]]);
    if NeedsRestart and not InitNoRestart then begin
      with WizardForm do begin
        ChangeFinishedLabel(ExpandSetupMessage(msgFinishedRestartLabel));
        YesRadio.Visible := True;
        NoRadio.Visible := True;
      end;
    end else begin
      if CreatedIcon then
        S := ExpandSetupMessage(msgFinishedLabel)
      else
        S := ExpandSetupMessage(msgFinishedLabelNoIcons);
      with WizardForm do begin
        ChangeFinishedLabel(S + SNewLine2 + SetupMessages[msgClickFinish]);
        if not NeedsRestart then begin
          UpdateRunList(WizardComponents, WizardTasks);
          RunList.Visible := RunList.Items.Count > 0;
        end;
      end;
    end;

    if InstallMode = imNormal then
      Application.Restore;

    Result := True;
  except
    { If an exception was raised, display the message, then terminate }
    Application.HandleException(Self);
    SetupExitCode := ecNextStepError;
    TerminateApp;
  end;
end;

procedure ProcessMessagesProc; far;
begin
  Application.ProcessMessages;
end;

procedure TMainForm.Finish(const FromPreparingPage: Boolean);

  procedure WaitForForegroundLoss;

    function IsForegroundProcess: Boolean;
    var
      W: HWND;
      PID: DWORD;
    begin
      W := GetForegroundWindow;
      Result := False;
      if (W <> 0) and (GetWindowThreadProcessId(W, @PID) <> 0) then
        Result := (PID = GetCurrentProcessId);
    end;

  var
    StartTick: DWORD;
  begin
    StartTick := GetTickCount;
    while IsForegroundProcess do begin
      { Stop if it's taking too long (e.g. if the spawned process never
        displays a window) }
      if Cardinal(GetTickCount - StartTick) >= Cardinal(1000) then
        Break;
      ProcessMessagesProc;
      WaitMessageWithTimeout(10);
      ProcessMessagesProc;
    end;
  end;

  procedure ProcessPostInstallRunEntries;
  var
    WindowDisabler: TWindowDisabler;
    ProcessedNoWait: Boolean;
    I: Integer;
    RunEntry: PSetupRunEntry;
  begin
    WindowDisabler := nil;
    try
      ProcessedNoWait := False;
      with WizardForm do begin
        for I := 0 to RunList.Items.Count-1 do begin
          if RunList.Checked[I] then begin
            { Disable windows before processing the first entry }
            if WindowDisabler = nil then
              WindowDisabler := TWindowDisabler.Create;
            RunEntry := PSetupRunEntry(Entries[seRun][Integer(RunList.ItemObject[I])]);
            DebugNotifyEntry(seRun, Integer(RunList.ItemObject[I]));
            NotifyBeforeInstallEntry(RunEntry.BeforeInstall);
            ProcessRunEntry(RunEntry);
            NotifyAfterInstallEntry(RunEntry.AfterInstall);
            if RunEntry.Wait = rwNoWait then
              ProcessedNoWait := True;
          end;
        end;
      end;
      { Give nowait processes some time to bring themselves to the
        foreground before Setup exits. Without this delay, the application
        underneath Setup can end up coming to the foreground instead.
        (Note: Windows are already disabled at this point.) }
      if ProcessedNoWait then
        WaitForForegroundLoss;
    finally
      WindowDisabler.Free;
    end;
  end;

var
  S: String;
begin
  try
    { Deactivate WizardForm so another application doesn't come to the
      foreground when Hide is called. (Needed by WaitForForegroundLoss.) }
    if GetForegroundWindow = WizardForm.Handle then
      SetActiveWindow(Application.Handle);
    WizardForm.Hide;

    if not FromPreparingPage and not NeedsRestart then begin
      ProcessPostInstallRunEntries;
    end else begin
      if FromPreparingPage then
        SetupExitCode := ecPrepareToInstallFailedRestartNeeded
      else if InitRestartExitCode <> 0 then
        SetupExitCode := InitRestartExitCode;

      if InitNoRestart then
        RestartSystem := False
      else begin
        case InstallMode of
          imNormal:
            if FromPreparingPage then
              RestartSystem := WizardForm.PreparingYesRadio.Checked
            else
              RestartSystem := WizardForm.YesRadio.Checked;
          imSilent:
            begin
              if FromPreparingPage then
                S := WizardForm.PrepareToInstallFailureMessage + SNewLine +
                  SNewLine + SNewLine + ExpandSetupMessage(msgPrepareToInstallNeedsRestart)
              else
                S := ExpandSetupMessage(msgFinishedRestartMessage);
              RestartSystem :=
                LoggedMsgBox(S, '', mbConfirmation, MB_YESNO, True, IDYES) = IDYES;
            end;
          imVerySilent:
            RestartSystem := True;
        end;
      end;
      if not RestartSystem then
        Log('Will not restart Windows automatically.');
    end;

    SetStep(ssDone, True);
  except
    Application.HandleException(Self);
    SetupExitCode := ecNextStepError;
  end;
  TerminateApp;
end;

procedure TMainForm.Close;

  function ConfirmCancel(const DefaultConfirm: Boolean): Boolean;
  var
    Cancel, Confirm: Boolean;
  begin
    Cancel := True;
    Confirm := DefaultConfirm;
    WizardForm.CallCancelButtonClick(Cancel, Confirm);
    Result := Cancel and (not Confirm or ExitSetupMsgBox);
  end;

begin
  if Assigned(WizardForm) and WizardForm.HandleAllocated and
     IsWindowVisible(WizardForm.Handle) and IsWindowEnabled(WizardForm.Handle) and
     WizardForm.CancelButton.CanFocus then begin
    case CurStep of
      ssPreInstall:
        if ConfirmCancel((WizardForm.CurPageID <> wpPreparing) or (WizardForm.PrepareToInstallFailureMessage = '')) then begin
          if WizardForm.CurPageID = wpPreparing then
            SetupExitCode := ecPrepareToInstallFailed
          else
            SetupExitCode := ecCancelledBeforeInstall;
          TerminateApp;
        end;
      ssInstall:
        if (shAllowCancelDuringInstall in SetupHeader.Options) and not InitNoCancel then
          if ConfirmCancel(True) then
            NeedToAbortInstall := True;
    end;
  end;
end;

class procedure TMainForm.AppOnGetActiveFormHandle(var AHandle: HWND);
begin
  { IDE's TMainForm has this too; see comments there }
  if Application.MainFormOnTaskBar then begin
    AHandle := GetActiveWindow;
    if ((AHandle = 0) or (AHandle = Application.Handle)) and
       Assigned(Application.MainForm) and
       Application.MainForm.HandleAllocated then
      AHandle := GetLastActivePopup(Application.MainFormHandle);
  end;
end;

initialization
  Application.OnGetActiveFormHandle := TMainForm.AppOnGetActiveFormHandle;
end.