CODEWITHSUNDEEP
inno-setuppascalscript
Aslam Khan
Aslam Khan

Reputation: 23

Create a button on Inno Setup custom wizard page to interrupt an program executed from the installer

I am creating a setup package using Inno Setup to run my cmd script. Using the articles available on Stack Overflow, I have managed to create a custom page that displays the output of the script on the setup wizard. However, during the script execution phase, I can't move the wizard window and can't even click on it. Here is the link that I used to create the custom page.
Embedded CMD in Inno Setup installer (show command output on a custom page)

Now, I want two things:

  1. To be able to move the wizard window during the script execution phase.
  2. Add a button to the custom page that passes Ctrl + C command to script that will stop the script execution.

For your reference, I am using following code in iss file.

[Code]
// Add next button on ready to install page.
procedure CurPageChanged(CurPageID: Integer);
begin
  // On fresh install the last pre-install page is "Select Program Group".
  // On upgrade the last pre-install page is "Read to Install"
  // (forced even with DisableReadyPage)
  // 1. Change text on Finish page
  WizardForm.FinishedLabel.Caption := 'Setup has finished running the ResetWU script on this computer. Please restart your computer and check for Windows updates again. Click Finish to exit the setup wizard.';
  WizardForm.FinishedHeadingLabel.Caption := 'Finishing the ResetWU script wizard';
  // 2. Change button caption on ready-to-install and Finish pages.
  if (CurPageID = wpSelectProgramGroup) or (CurPageID = wpReady) then
    WizardForm.NextButton.Caption := SetupMessage(msgButtonNext)
    // On the Finished page, use "Finish" caption.
  else if (CurPageID = wpFinished) then
    WizardForm.NextButton.Caption := SetupMessage(msgButtonFinish)
    // On all other pages, use "Next" caption.
  else
    WizardForm.NextButton.Caption := SetupMessage(msgButtonNext);
end;

// Embed installation bat into installation progress page
var
  ProgressPage: TOutputProgressWizardPage;
  ProgressListBox: TNewListBox;

function SetTimer(
  Wnd: LongWord; IDEvent, Elapse: LongWord; TimerFunc: LongWord): LongWord;
  external '[email protected] stdcall';

function KillTimer(hWnd: LongWord; uIDEvent: LongWord): BOOL;
  external '[email protected] stdcall';

var
  ProgressFileName: string;

function BufferToAnsi(const Buffer: string): AnsiString;
  var
    W: Word;
    I: Integer;
  begin
    SetLength(Result, Length(Buffer) * 2);
    for I := 1 to Length(Buffer) do
    begin
      W := Ord(Buffer[I]);
      Result[(I * 2)] := Chr(W shr 8); { high byte }
      Result[(I * 2) - 1] := Chr(Byte(W)); { low byte }
    end;
  end;

procedure UpdateProgress;
  var
    S: AnsiString;
    I, L, Max: Integer;
    Buffer: string;
    Stream: TFileStream;
    Lines: TStringList;
  begin
    if not FileExists(ProgressFileName) then
      begin
        Log(Format('Progress file %s does not exist', [ProgressFileName]));
      end
    else
      begin
        try
          { Need shared read as the output file is locked for writting, }
          { so we cannot use LoadStringFromFile }
          Stream := TFileStream.Create(ProgressFileName, fmOpenRead or fmShareDenyNone);
          try
            L := Stream.Size;
            Max := 100*2014;
            if L > Max then
            begin
              Stream.Position := L - Max;
              L := Max;
            end;
            SetLength(Buffer, (L div 2) + (L mod 2));
            Stream.ReadBuffer(Buffer, L);
            S := BufferToAnsi(Buffer);
          finally
            Stream.Free;
          end;
        except
          Log(Format('Failed to read progress from file %s - %s', [
                     ProgressFileName, GetExceptionMessage]));
        end;
    end;

    if S <> '' then
      begin
        Log('Progress len = ' + IntToStr(Length(S)));
        Lines := TStringList.Create();
        Lines.Text := S;
        for I := 0 to Lines.Count - 1 do
        begin
          if I < ProgressListBox.Items.Count then
          begin
            ProgressListBox.Items[I] := Lines[I];
          end
            else
          begin
            ProgressListBox.Items.Add(Lines[I]);
          end
        end;
        ProgressListBox.ItemIndex := ProgressListBox.Items.Count - 1;
        ProgressListBox.Selected[ProgressListBox.ItemIndex] := False;
        Lines.Free;
      end;

    { Just to pump a Windows message queue (maybe not be needed) }
    ProgressPage.SetProgress(0, 1);
  end;

procedure UpdateProgressProc(
  H: LongWord; Msg: LongWord; Event: LongWord; Time: LongWord);
begin
  UpdateProgress;
end;

procedure RunInstallBatInsideProgress;
  var
    ResultCode: Integer;
    Timer: LongWord;
    AppPath: string;
    AppError: string;
    Command: string;

  begin
    ProgressPage :=
      CreateOutputProgressPage(
        'Running ResetWU Script', 'Please wait until the script finishes...');
    ProgressPage.Show();
    ProgressListBox := TNewListBox.Create(WizardForm);
    ProgressListBox.Parent := ProgressPage.Surface;
    ProgressListBox.Top := 0;
    ProgressListBox.Left := 0;
    ProgressListBox.Width := ProgressPage.SurfaceWidth;
    ProgressListBox.Height := ProgressPage.SurfaceHeight;

    { Fake SetProgress call in UpdateProgressProc will show it, }
    { make sure that user won't see it }
    {ProgressPage.ProgressBar.Top := -100;}

    try
      Timer := SetTimer(0, 0, 250, CreateCallback(@UpdateProgressProc));
      AppPath := ExpandConstant('C:\temp\myscript.cmd');
      ProgressFileName := ExpandConstant('C:\Temp\install-progress.log');
      Log(Format('Expecting progress in %s', [ProgressFileName]));
      Command := Format('""%s" > "%s""', [AppPath, ProgressFileName]);
      if not Exec(ExpandConstant('{cmd}'), '/c ' + Command + ExpandConstant(' {app}\PIPE'), '', SW_HIDE, ewWaitUntilTerminated, ResultCode) then
        begin                                                   
          AppError := 'Cannot start app';
        end
      else
        if ResultCode <> 0 then
          begin
            AppError := Format('App failed with code %d', [ResultCode]);
          end;

      UpdateProgress;
      
    finally
        { Clean up }
        KillTimer(0, Timer);
        ProgressPage.Hide;
        DeleteFile(ProgressFileName);
        ProgressPage.Free();
    end;
     
    if AppError <> '' then
      begin 
        { RaiseException does not work properly while TOutputProgressWizardPage is shown }
        RaiseException(AppError);
      end;
  end;

procedure CurStepChanged(CurStep: TSetupStep);
  begin
    if CurStep=ssPostInstall then
      begin
           RunInstallBatInsideProgress;
      end
  end;  
 
// Add button to custom progress page. 
function GetWindowLong(Wnd: HWnd; Index: Integer): LongInt;
  external '[email protected] stdcall';
function SetWindowLong(Wnd: HWnd; Index: Integer; NewLong: LongInt): LongInt;
  external '[email protected] stdcall';

const
  GWL_STYLE = -16;
  BS_MULTILINE = $2000;
  
procedure StopButtonOnClick(Sender: TObject);
begin
  MsgBox('This is the stop message!', mbInformation, mb_Ok);
end;

procedure InitializeWizard();

var
  Button: TNewButton;
begin
  Button := TNewButton.Create(WizardForm);
  Button.Left := WizardForm.ClientWidth - WizardForm.CancelButton.Left - WizardForm.CancelButton.Width;
  Button.Top := WizardForm.NextButton.Top;
  Button.Width := WizardForm.NextButton.Width;
  Button.Height := WizardForm.NextButton.Height;
  Button.Parent := WizardForm.InnerPage;

  SetWindowLong(Button.Handle, GWL_STYLE, 
    GetWindowLong(Button.Handle, GWL_STYLE) or BS_MULTILINE);

  Button.Caption := 'Stop';
  Button.OnClick := @StopButtonOnClick;
end;

I have tried looking for the jrsoftware documentation, but I am quite new to this and can't understand it properly.

Upvotes: 1

Views: 424

Answers (1)

Martin Prikryl
Martin Prikryl

Reputation: 202534

If you do not want to block the UI while running application (and if you want to be able to manipulate with [kill] the application), you cannot run it using the blocking Exec function.

Instead, you can use ShellExecuteEx API to run the application and then use WaitForSingleObject to query its status. The below code is stripped down version of Inno Setup Get progress from .NET Framework 4.5 (or higher) installer to update progress bar position.

const
  WAIT_OBJECT_0 = 0;
  WAIT_TIMEOUT = $00000102;
  SEE_MASK_NOCLOSEPROCESS = $00000040;
  
function WaitForSingleObject(
  Handle: THandle; Milliseconds: Cardinal): Cardinal;
  external '[email protected] stdcall';

type
  TShellExecuteInfo = record
    cbSize: DWORD;
    fMask: Cardinal;
    Wnd: HWND;
    lpVerb: string;
    lpFile: string;
    lpParameters: string;
    lpDirectory: string;
    nShow: Integer;
    hInstApp: THandle;    
    lpIDList: DWORD;
    lpClass: string;
    hkeyClass: THandle;
    dwHotKey: DWORD;
    hMonitor: THandle;
    hProcess: THandle;
  end;

function ShellExecuteEx(var lpExecInfo: TShellExecuteInfo): BOOL; 
  external '[email protected] stdcall';

function TerminateProcess(Process: THandle; ExitCode: Cardinal): Boolean;
  external '[email protected] stdcall';

var
  ExecInfo: TShellExecuteInfo;

procedure ExecWithoutBlocking;
var
  ProgressPage: TOutputProgressWizardPage;
  R: Cardinal;
  Completed: Boolean;
  AppError: string;
begin
  // Start the installer using ShellExecuteEx to get process ID
  ExecInfo.cbSize := SizeOf(ExecInfo);
  ExecInfo.fMask := SEE_MASK_NOCLOSEPROCESS;
  ExecInfo.Wnd := 0;
  ExecInfo.lpFile := 'notepad.exe';
  ExecInfo.lpParameters := '';
  ExecInfo.nShow := SW_SHOW;

  if not ShellExecuteEx(ExecInfo) then
    RaiseException('Cannot start');

  Log(Format('Program started as process %x', [ExecInfo.hProcess]));
  
  ProgressPage := CreateOutputProgressPage('Running program', '');
  ProgressPage.SetProgress(0, 100);
  ProgressPage.Show;
  try
    Completed := False;

    while not Completed do
    begin
      // Check if the process has finished already
      R := WaitForSingleObject(ExecInfo.hProcess, 0);
      if R = WAIT_OBJECT_0 then
      begin
        Log('Program completed');
        Completed := True;
      end
        else
      if R <> WAIT_TIMEOUT then
      begin
        AppError := 'Error waiting for program to complete';
        Completed := True;
      end;
      // Seemingly pointless as progress did not change,
      // but it pumps a message queue as a side effect
      ProgressPage.SetProgress(0, 100);
      Sleep(100);
    end;
  finally
    ProgressPage.Hide;
  end;

  if AppError <> '' then
  begin 
    // RaiseException does not work properly
    // while TOutputProgressWizardPage is shown
    RaiseException(AppError);
  end;
end;

The ShellExecuteEx gives you a process ID, which you can use to stop/kill the process using TerminateProcess:

procedure StopButtonOnClick(Sender: TObject);
begin
  TerminateProcess(ExecInfo.hProcess, 0);
end;

If you want to combine it with output redirection to a custom page, you can do:

procedure AbortButtonClick(Sender: TObject);
begin
  TerminateProcess(ExecInfo.hProcess, 0);
end;

procedure RunInstallBatInsideProgress;
var
  ResultCode: Integer;
  AppPath: string;
  Command: string;
  Completed: Boolean;
  R: Integer;
  AppError: string;
  AbortButton: TButton;
begin
  ProgressPage :=
    CreateOutputProgressPage(
      'Running ResetWU Script', 'Please wait until the script finishes...');
  ProgressPage.Show();

  AbortButton := TButton.Create(WizardForm);
  AbortButton.Parent := ProgressPage.Surface;
  AbortButton.Caption := 'Abort';
  AbortButton.Top := ProgressPage.SurfaceHeight - AbortButton.Height - ScaleY(8);
  AbortButton.Left := 0;
  AbortButton.OnClick := @AbortButtonClick;

  ProgressListBox := TNewListBox.Create(WizardForm);
  ProgressListBox.Parent := ProgressPage.Surface;
  ProgressListBox.Top := 0;
  ProgressListBox.Left := 0;
  ProgressListBox.Width := ProgressPage.SurfaceWidth;
  ProgressListBox.Height := AbortButton.Top - ScaleY(8);

  // Fake SetProgress call in UpdateProgress will show it,
  // make sure that user won't see it
  ProgressPage.ProgressBar.Top := -100;

  try
    ExtractTemporaryFile('install.bat');
    AppPath := ExpandConstant('{tmp}\install.bat');
    ProgressFileName := ExpandConstant('{tmp}\progress.txt');
    Log(Format('Expecting progress in %s', [ProgressFileName]));
    Command := Format('""%s" > "%s""', [AppPath, ProgressFileName]);

    // Start the installer using ShellExecuteEx to get process ID
    ExecInfo.cbSize := SizeOf(ExecInfo);
    ExecInfo.fMask := SEE_MASK_NOCLOSEPROCESS;
    ExecInfo.Wnd := 0;
    ExecInfo.lpFile := ExpandConstant('{cmd}');
    ExecInfo.lpParameters := '/c ' + Command;
    ExecInfo.nShow := SW_HIDE;

    if not ShellExecuteEx(ExecInfo) then
      RaiseException('Cannot start');

    Log(Format('Program started as process %x', [ExecInfo.hProcess]));
    
    Completed := False;

    while not Completed do
    begin
      // Check if the process has finished already
      R := WaitForSingleObject(ExecInfo.hProcess, 0);
      if R = WAIT_OBJECT_0 then
      begin
        Log('Program completed');
        Completed := True;
      end
        else
      if R <> WAIT_TIMEOUT then
      begin
        AppError := 'Error waiting for program to complete';
        Completed := True;
      end;
      UpdateProgress;
      Sleep(100);
    end;

    UpdateProgress;
  finally
    ProgressPage.Hide;
    DeleteFile(ProgressFileName);
    ProgressPage.Free();
  end;
   
  if AppError <> '' then
  begin 
    // RaiseException does not work properly
    // while TOutputProgressWizardPage is shown
    RaiseException(AppError);
  end;
end;

enter image description here

  • Note that contrary to the original code, this does not need the "timer" code anymore, as the UpdateProgress can be called from the while not Completed do loop.
  • The "Abort" button kills the process. You might want to introduce less violent abort mechanism. E.g. by creating a signal file that would cause the batch file to abort gracefully.

Upvotes: -1

Related Questions