Начало Каталог Помощ
Вход
pascal
/
innosetup
огледало от https://github.com/jrsoftware/issrc.git
2
0
Разклонения 0
Файлове Задачи 0 Уики
Преглед на файлове

Merge branch 'logoutput'

Martijn Laan преди 1 година
родител
0c62f26505 4040e4501c
ревизия
0989fdcc43
променени са 20 файла, в които са добавени 489 реда и са изтрити 133 реда
Обединен изглед Покажи статистика за разликите
  1. 5 3
      Components/ScintStylerInnoSetup.pas
  2. 8 0
      ISHelp/isetup.xml
  3. 16 3
      ISHelp/isxfunc.xml
  4. 4 3
      Projects/ISPP/Help/ispp.xml
  5. 83 44
      Projects/ISPP/IsppFuncs.pas
  6. 165 0
      Projects/Src/CmnFunc2.pas
  7. 1 0
      Projects/Src/CompMsgs.pas
  8. 60 22
      Projects/Src/Compile.pas
  9. 49 26
      Projects/Src/InstFunc.pas
  10. 2 0
      Projects/Src/Install.pas
  11. 8 4
      Projects/Src/Logging.pas
  12. 9 1
      Projects/Src/Main.pas
  13. 2 1
      Projects/Src/ScriptFunc.pas
  14. 1 0
      Projects/Src/ScriptFunc_C.pas
  15. 45 11
      Projects/Src/ScriptFunc_R.pas
  16. 7 5
      Projects/Src/SpawnClient.pas
  17. 1 1
      Projects/Src/SpawnServer.pas
  18. 2 1
      Projects/Src/Struct.pas
  19. 10 1
      Projects/Src/Undo.pas
  20. 11 7
      whatsnew.htm

+ 5 - 3
Components/ScintStylerInnoSetup.pas
Целия файл 

@@ -2,7 +2,7 @@ unit ScintStylerInnoSetup;
 
 

 

 {

 {

   Inno Setup

   Inno Setup

-  Copyright (C) 1997-2020 Jordan Russell

+  Copyright (C) 1997-2024 Jordan Russell

   Portions by Martijn Laan

   Portions by Martijn Laan

   For conditions of distribution and use, see LICENSE.TXT.

   For conditions of distribution and use, see LICENSE.TXT.

 

 

@@ -384,11 +384,12 @@ const
 
     (Name: 'Verb'),

     (Name: 'Verb'),

     (Name: 'WorkingDir'));

     (Name: 'WorkingDir'));

 

 

-  RunSectionFlags: array[0..17] of TInnoSetupStylerParamInfo = (

+  RunSectionFlags: array[0..18] of TInnoSetupStylerParamInfo = (

     (Name: '32bit'),

     (Name: '32bit'),

     (Name: '64bit'),

     (Name: '64bit'),

     (Name: 'dontlogparameters'),

     (Name: 'dontlogparameters'),

     (Name: 'hidewizard'),

     (Name: 'hidewizard'),

+    (Name: 'logoutput'),

     (Name: 'nowait'),

     (Name: 'nowait'),

     (Name: 'postinstall'),

     (Name: 'postinstall'),

     (Name: 'runascurrentuser'),

     (Name: 'runascurrentuser'),

@@ -420,11 +421,12 @@ const
 
     (Name: 'Verb'),

     (Name: 'Verb'),

     (Name: 'WorkingDir'));

     (Name: 'WorkingDir'));

 

 

-  UninstallRunSectionFlags: array[0..12] of TInnoSetupStylerParamInfo = (

+  UninstallRunSectionFlags: array[0..13] of TInnoSetupStylerParamInfo = (

     (Name: '32bit'),

     (Name: '32bit'),

     (Name: '64bit'),

     (Name: '64bit'),

     (Name: 'dontlogparameters'),

     (Name: 'dontlogparameters'),

     (Name: 'hidewizard'),

     (Name: 'hidewizard'),

+    (Name: 'logoutput'),

     (Name: 'nowait'),

     (Name: 'nowait'),

     (Name: 'runascurrentuser'),

     (Name: 'runascurrentuser'),

     (Name: 'runhidden'),

     (Name: 'runhidden'),

+ 8 - 0
ISHelp/isetup.xml
Целия файл 

@@ -2608,6 +2608,10 @@ Filename: "{app}\MYPROG.EXE"; Description: "Launch application"; Flags: postinst
 
 <flag name="hidewizard">

 <flag name="hidewizard">

 <p>If this flag is specified, the wizard will be hidden while the program is running.</p>

 <p>If this flag is specified, the wizard will be hidden while the program is running.</p>

 </flag>

 </flag>

+<flag name="logoutput">

+<p>If this flag is specified, the output of the program will be included in the log file.</p>

+<p>This flag cannot be combined with the <tt>nowait</tt>, <tt>runasoriginaluser</tt>, <tt>shellexec</tt>, and <tt>waituntilidle</tt> flags.</p>

+</flag>

 <flag name="nowait">

 <flag name="nowait">

 <p>If this flag is specified, it will not wait for the process to finish executing before proceeding to the next [Run] entry, or completing Setup. Cannot be combined with <tt>waituntilidle</tt> or <tt>waituntilterminated</tt>.</p>

 <p>If this flag is specified, it will not wait for the process to finish executing before proceeding to the next [Run] entry, or completing Setup. Cannot be combined with <tt>waituntilidle</tt> or <tt>waituntilterminated</tt>.</p>

 </flag>

 </flag>

@@ -4479,6 +4483,8 @@ UninstallDisplayIcon={app}\MyProg.exe,1
 
 <body>

 <body>

 <p>If set to <tt>yes</tt>, the uninstaller will always create a log file if it is launched from the <i>Add/Remove Programs</i> Control Panel applet. Equivalent to passing <link topic="uninstcmdline" anchor="LOG">/LOG</link> on the command line.</p>

 <p>If set to <tt>yes</tt>, the uninstaller will always create a log file if it is launched from the <i>Add/Remove Programs</i> Control Panel applet. Equivalent to passing <link topic="uninstcmdline" anchor="LOG">/LOG</link> on the command line.</p>

 <p>This directive has no effect if <tt>CreateUninstallRegKey</tt> is not set to <tt>yes</tt>.</p>

 <p>This directive has no effect if <tt>CreateUninstallRegKey</tt> is not set to <tt>yes</tt>.</p>

+<p><b>See also:</b><br/>

+<link topic="setup_setuplogging">SetupLogging</link></p>

 </body>

 </body>

 </setuptopic>

 </setuptopic>

 

 

@@ -5392,6 +5398,8 @@ ArchitecturesInstallIn64BitMode=x64compatible
 
 <setupdefault><tt>no</tt></setupdefault>

 <setupdefault><tt>no</tt></setupdefault>

 <body>

 <body>

 <p>If set to <tt>yes</tt>, Setup will always create a log file. Equivalent to passing <link topic="setupcmdline" anchor="LOG">/LOG</link> on the command line.</p>

 <p>If set to <tt>yes</tt>, Setup will always create a log file. Equivalent to passing <link topic="setupcmdline" anchor="LOG">/LOG</link> on the command line.</p>

+<p><b>See also:</b><br/>

+<link topic="setup_uninstalllogging">UninstallLogging</link></p>

 </body>

 </body>

 </setuptopic>

 </setuptopic>

+ 16 - 3
ISHelp/isxfunc.xml
Целия файл 

@@ -321,7 +321,7 @@ end;</pre></example>
 
         <name>ShowExceptionMessage</name>

         <name>ShowExceptionMessage</name>

         <prototype>procedure ShowExceptionMessage;</prototype>

         <prototype>procedure ShowExceptionMessage;</prototype>

         <description><p>Shows the message associated with the current exception in a message box. This function should only be called from within an <tt>except</tt> section, or a function called from an <tt>except</tt> section.</p></description>

         <description><p>Shows the message associated with the current exception in a message box. This function should only be called from within an <tt>except</tt> section, or a function called from an <tt>except</tt> section.</p></description>

-        <remarks><p>If logging is enabled (via the <link topic="setupcmdline">/LOG</link> command line parameter or the <link topic="setup_setuplogging">SetupLogging</link> [Setup] section directive or debugging from the Compiler IDE) the message will be recorded in the log file and/or in the Compiler IDE's "Debug Output" view in addition to being shown.</p></remarks>

+        <remarks><p>If logging is enabled (via the <link topic="setupcmdline">/LOG</link> command line parameter or the <link topic="setup_setuplogging">SetupLogging</link> [Setup] section directive or the <link topic="setup_uninstalllogging">UninstallLogging</link> [Setup] section directive or debugging from the Compiler IDE) the message will be recorded in the log file and/or in the Compiler IDE's "Debug Output" view in addition to being shown.</p></remarks>

         <example><pre>var

         <example><pre>var

   I: Integer;

   I: Integer;

 begin

 begin

@@ -1641,7 +1641,8 @@ begin
 
     // handle failure if necessary; ResultCode contains the error code

     // handle failure if necessary; ResultCode contains the error code

   end;

   end;

 end;</pre></example>

 end;</pre></example>

-        <seealso><p><link topic="isxfunc_ExecAsOriginalUser">ExecAsOriginalUser</link></p></seealso>

+        <seealso><p><link topic="isxfunc_ExecAndLogOutput">ExecAndLogOutput</link><br />

+<link topic="isxfunc_ExecAsOriginalUser">ExecAsOriginalUser</link></p></seealso>

       </function>

       </function>

       <function>

       <function>

         <name>ExecAsOriginalUser</name>

         <name>ExecAsOriginalUser</name>

@@ -2838,7 +2839,19 @@ end;</pre></example>
 
         <name>Log</name>

         <name>Log</name>

         <prototype>procedure Log(const S: String);</prototype>

         <prototype>procedure Log(const S: String);</prototype>

         <description><p>Logs the specified string in Setup's or Uninstall's log file and/or in the Compiler IDE's "Debug Output" view.</p></description>

         <description><p>Logs the specified string in Setup's or Uninstall's log file and/or in the Compiler IDE's "Debug Output" view.</p></description>

-        <remarks><p>Calls to this function are ignored if logging is not enabled (via the <link topic="setupcmdline">/LOG</link> command line parameter or the <link topic="setup_setuplogging">SetupLogging</link> [Setup] section directive or debugging from the Compiler IDE).</p></remarks>

+        <remarks><p>Calls to this function are ignored if logging is not enabled (via the <link topic="setupcmdline">/LOG</link> command line parameter or the <link topic="setup_setuplogging">SetupLogging</link> [Setup] section directive or the <link topic="setup_uninstalllogging">UninstallLogging</link> [Setup] section directive or debugging from the Compiler IDE).</p></remarks>

+      </function>

+      <function>

+        <name>ExecAndLogOutput</name>

+        <prototype>function ExecAndLogOutput(const Filename, Params, WorkingDir: String; const ShowCmd: Integer; const Wait: TExecWait; var ResultCode: Integer; const OnLog: TOnLog): Boolean;</prototype>

+        <description><p>Identical to <tt>Exec</tt> except that the output of the executed executable or batch file is logged in Setup's or Uninstall's log file and/or in the Compiler IDE's "Debug Output" view if OnLog is set to <tt>nil</tt>.</p>

+<p>If OnLog is not set to <tt>nil</tt> then the output is sent to the specified function, line by line.</p>

+<p>See <link topic="isxfunc_Exec">Exec</link> for more information.</p></description>

+        <remarks><p>Completely identical to <tt>Exec</tt> if OnLog is set to <tt>nil</tt> and logging is not enabled (via the <link topic="setupcmdline">/LOG</link> command line parameter or the <link topic="setup_setuplogging">SetupLogging</link> [Setup] section directive or the <link topic="setup_uninstalllogging">UninstallLogging</link> [Setup] section directive or debugging from the Compiler IDE).</p>

+<p>Parameter <tt>Wait</tt> must always be set to <tt>ewWaitUntilTerminated</tt> when calling this function.</p>

+<p>TOnLog is defined as:</p>

+<p><tt>TOnLog = procedure(const S: String; const Error, FirstLine: Boolean);</tt></p></remarks>

+        <seealso><p><link topic="isxfunc_Exec">Exec</link></p></seealso>

       </function>

       </function>

     </subcategory>

     </subcategory>

   </category>

   </category>

+ 4 - 3
Projects/ISPP/Help/ispp.xml
Целия файл 

@@ -809,15 +809,16 @@ The list of options is provided at the end of this topic.</para>
 
 			<topic id="Exec">

 			<topic id="Exec">

 				<title>Exec</title>

 				<title>Exec</title>

 				<section title="Prototype">

 				<section title="Prototype">

-					<pre><line><b>int</b> Exec(<b>str</b> 1, <b>str</b>? 2, <b>str</b>? 3, <b>int</b>? 4, <b>int</b>? 5)</line></pre>

+					<pre><line><b>int</b> Exec(<b>str</b> 1, <b>str</b>? 2, <b>str</b>? 3, <b>int</b>? 4, <b>int</b>? 5, <b>int</b>? 6)</line></pre>

 				</section>

 				</section>

 				<description>

 				<description>

 					<para>Executes specified executable file.</para>

 					<para>Executes specified executable file.</para>

 					<para>First argument specifies the filename of the module to execute.</para>

 					<para>First argument specifies the filename of the module to execute.</para>

 					<para>Second argument may be used to specify command line to execute.</para>

 					<para>Second argument may be used to specify command line to execute.</para>

 					<para>Third argument may be used to specify the working directory of the process.</para>

 					<para>Third argument may be used to specify the working directory of the process.</para>

-					<para>Fourth argument should be set to zero, if you don't wish to wait for the process to finish, and non-zero otherwise. By default, non-zero value is assumed.</para>

-					<para>Fifth argument can be any of the <synel>SW_*</synel> constants defined in &builtins;. For GUI processes, it specifies the default value the first time ShowWindow is called. By default, SW_SHOWNORMAL (i. e. 1) is assumed.</para>

+					<para>Fourth argument may be set to zero if you don't wish to wait for the process to finish, and non-zero otherwise. By default, non-zero value is assumed.</para>

+					<para>Fifth argument may be any of the <synel>SW_*</synel> constants defined in &builtins;. For GUI processes, it specifies the default value the first time ShowWindow is called. By default, SW_SHOWNORMAL (i. e. 1) is assumed.</para>

+					<para>Sixth argument may be set to zero if you don't wish to log output, and non-zero otherwise. By default, non-zero value is assumed. Has no effect if the fourth argument is set to zero.</para>

 					<para>If fourth argument is omitted or is non-zero, the function returns the exit code of the process. Otherwise, the function result indicates whether the process has been successfully launched (non-zero for success).</para>

 					<para>If fourth argument is omitted or is non-zero, the function returns the exit code of the process. Otherwise, the function result indicates whether the process has been successfully launched (non-zero for success).</para>

 				</description>

 				</description>

 			</topic>

 			</topic>

+ 83 - 44
Projects/ISPP/IsppFuncs.pas
Целия файл 

@@ -20,17 +20,15 @@ procedure RegisterFunctions(Preproc: TPreprocessor);
 
 implementation

 implementation

 

 

 uses

 uses

-  SysUtils, IniFiles, Registry, IsppConsts, IsppBase, IsppIdentMan,

+  SysUtils, IniFiles, Registry, Math, IsppConsts, IsppBase, IsppIdentMan,

   IsppSessions, DateUtils, FileClass, MD5, SHA1, PathFunc, CmnFunc2, Int64Em;

   IsppSessions, DateUtils, FileClass, MD5, SHA1, PathFunc, CmnFunc2, Int64Em;

   

   

 var

 var

   IsWin64: Boolean;

   IsWin64: Boolean;

 

 

 function PrependPath(const Ext: Longint; const Filename: String): String;

 function PrependPath(const Ext: Longint; const Filename: String): String;

-var

-  Preprocessor: TPreprocessor;

 begin

 begin

-  Preprocessor := TObject(Ext) as TPreprocessor;

+  var Preprocessor := TObject(Ext) as TPreprocessor;

   Result := PathExpand(Preprocessor.PrependDirName(Filename,

   Result := PathExpand(Preprocessor.PrependDirName(Filename,

     Preprocessor.SourcePath));

     Preprocessor.SourcePath));

 end;

 end;

@@ -632,16 +630,16 @@ begin
 
   end;

   end;

 end;

 end;

 

 

-function InstExec(const Filename, Params: String; WorkingDir: String;

-  const WaitUntilTerminated, WaitUntilIdle: Boolean; const ShowCmd: Integer;

-  const ProcessMessagesProc: TProcedure; var ErrorCode: Cardinal): Boolean;

+function Exec(const Filename, Params: String; WorkingDir: String;

+  const WaitUntilTerminated: Boolean; const ShowCmd: Integer;

+  const ProcessMessagesProc: TProcedure; const Log: Boolean; const LogProc: TLogProc;

+  const LogProcData: NativeInt; var ResultCode: Integer): Boolean;

 var

 var

   CmdLine: String;

   CmdLine: String;

   WorkingDirP: PChar;

   WorkingDirP: PChar;

   StartupInfo: TStartupInfo;

   StartupInfo: TStartupInfo;

   ProcessInfo: TProcessInformation;

   ProcessInfo: TProcessInformation;

 begin

 begin

-  Result := True;

   CmdLine := Filename + ' ' + Params;

   CmdLine := Filename + ' ' + Params;

   if WorkingDir = '' then WorkingDir := ExtractFilePath(Filename);

   if WorkingDir = '' then WorkingDir := ExtractFilePath(Filename);

   FillChar (StartupInfo, SizeOf(StartupInfo), 0);

   FillChar (StartupInfo, SizeOf(StartupInfo), 0);

@@ -652,29 +650,61 @@ begin
 
     WorkingDirP := PChar(WorkingDir)

     WorkingDirP := PChar(WorkingDir)

   else

   else

     WorkingDirP := nil;

     WorkingDirP := nil;

-  if not CreateProcess(nil, PChar(CmdLine), nil, nil, False, 0, nil,

-     WorkingDirP, StartupInfo, ProcessInfo) then begin

-    Result := False;

-    ErrorCode := GetLastError;

-    Exit;

-  end;

-  with ProcessInfo do begin

+    

+  var OutputReader: TCreateProcessOutputReader := nil;

+  var InheritHandles := False;

+  try

+    if Log and Assigned(LogProc) and WaitUntilTerminated then begin

+      OutputReader := TCreateProcessOutputReader.Create(LogProc, LogProcData);

+      OutputReader.UpdateStartupInfo(StartupInfo, InheritHandles);

+    end;

+

+    Result := CreateProcess(nil, PChar(CmdLine), nil, nil, InheritHandles, 0, nil,

+       WorkingDirP, StartupInfo, ProcessInfo);

+    if not Result then begin

+      ResultCode := GetLastError;

+      Exit;

+    end;

+    

     { Don't need the thread handle, so close it now }

     { Don't need the thread handle, so close it now }

-    CloseHandle (hThread);

-    if WaitUntilIdle then

-      WaitForInputIdle (hProcess, INFINITE);

-    if WaitUntilTerminated then

-      { Wait until the process returns, but still process any messages that

-        arrive. }

-      repeat

-        { Process any pending messages first because MsgWaitForMultipleObjects

-          (called below) only returns when *new* messages arrive }

+    CloseHandle(ProcessInfo.hThread);

+    if OutputReader <> nil then

+      OutputReader.NotifyCreateProcessDone;

+      

+    try

+      if WaitUntilTerminated then begin

+        { Wait until the process returns, but still process any messages that

+          arrive and read the output. }

+        var WaitMilliseconds := IfThen(OutputReader <> nil, 50, INFINITE);

+        var WaitResult: DWORD := 0;

+        repeat

+          { Process any pending messages first because MsgWaitForMultipleObjects

+            (called below) only returns when *new* messages arrive, unless there's

+            a timeout }

+          if WaitResult <> WAIT_TIMEOUT then

+            ProcessMessagesProc;

+          if OutputReader <> nil then

+            OutputReader.Read(False);

+          WaitResult := MsgWaitForMultipleObjects(1, ProcessInfo.hProcess, False,

+            WaitMilliseconds, QS_ALLINPUT);

+        until (WaitResult <> WAIT_OBJECT_0+1) and (WaitResult <> WAIT_TIMEOUT);

+        { Process messages once more in case MsgWaitForMultipleObjects saw the

+          process terminate and new messages arrive simultaneously. (Can't leave

+          unprocessed messages waiting, or a subsequent call to WaitMessage

+          won't see them.) }

         if Assigned(ProcessMessagesProc) then

         if Assigned(ProcessMessagesProc) then

           ProcessMessagesProc;

           ProcessMessagesProc;

-      until MsgWaitForMultipleObjects(1, hProcess, False, INFINITE, QS_ALLINPUT) <> WAIT_OBJECT_0+1;

-    { Then close the process handle }

-    GetExitCodeProcess(hProcess, ErrorCode);

-    CloseHandle (hProcess);

+        if OutputReader <> nil then

+          OutputReader.Read(True);

+      end;

+      { Get the exit code. Will be set to STILL_ACTIVE if not yet available }

+      if not GetExitCodeProcess(ProcessInfo.hProcess, DWORD(ResultCode)) then

+        ResultCode := -1;  { just in case }

+    finally

+      CloseHandle(ProcessInfo.hProcess);

+    end;

+  finally

+    OutputReader.Free;

   end;

   end;

 end;

 end;

 

 

@@ -689,33 +719,42 @@ begin
 
   end;

   end;

 end;

 end;

 

 

+procedure ExecLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);

+begin

+  var Preprocessor := TPreprocessor(Data);

+  if Error then

+    Preprocessor.WarningMsg(S, [])

+  else

+    Preprocessor.StatusMsg(S, []);

+end;

+

 {

 {

-  int Exec(str FileName, str Params, str WorkingDir, int Wait, int ShowCmd)

+  int Exec(str FileName, str Params, str WorkingDir, int Wait, int ShowCmd, int Log)

 }

 }

 

 

 function ExecFunc(Ext: Longint; const Params: IIsppFuncParams;

 function ExecFunc(Ext: Longint; const Params: IIsppFuncParams;

   const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;

   const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;

-var

-  P, W: string;

-  Wait, S: Integer;

-  Success: Boolean;

-  R: Cardinal;

 begin

 begin

-  if CheckParams(Params, [evStr, evStr, evStr, evInt, evInt], 1, Result) then

+  if CheckParams(Params, [evStr, evStr, evStr, evInt, evInt, evInt], 1, Result) then

   try

   try

     with IInternalFuncParams(Params) do

     with IInternalFuncParams(Params) do

     begin

     begin

-      Wait := 1;

-      S := SW_SHOWNORMAL;

-      if GetCount > 1 then P := Get(1).AsStr;

-      if GetCount > 2 then W := PrependPath(Ext, Get(2).AsStr);

-      if (GetCount > 3) and (Get(3).Typ <> evNull) then Wait := Get(3).AsInt;

-      if (GetCount > 4) and (Get(4).Typ <> evNull) then S := Get(4).AsInt;

-      Success := InstExec(Get(0).AsStr, P, W, Wait <> 0, False, S, MsgProc, R);

-      if Wait = 0 then

+      var ParamsS, WorkingDir: String;

+      var WaitUntilTerminated := True;

+      var ShowCmd := SW_SHOWNORMAL;

+      var Log := True;

+      if GetCount > 1 then ParamsS := Get(1).AsStr;

+      if GetCount > 2 then WorkingDir := PrependPath(Ext, Get(2).AsStr);

+      if (GetCount > 3) and (Get(3).Typ <> evNull) then WaitUntilTerminated := Get(3).AsInt <> 0;

+      if (GetCount > 4) and (Get(4).Typ <> evNull) then ShowCmd := Get(4).AsInt;

+      if (GetCount > 5) and (Get(5).Typ <> evNull) then Log := Get(5).AsInt <> 0;

+      var ResultCode: Integer;

+      var Success := Exec(Get(0).AsStr, ParamsS, WorkingDir, WaitUntilTerminated,

+        ShowCmd, MsgProc, Log, ExecLog, Ext, ResultCode);

+      if not WaitUntilTerminated then

         MakeBool(ResPtr^, Success)

         MakeBool(ResPtr^, Success)

       else

       else

-        MakeInt(ResPtr^, R);

+        MakeInt(ResPtr^, ResultCode);

     end;

     end;

   except

   except

     on E: Exception do

     on E: Exception do

+ 165 - 0
Projects/Src/CmnFunc2.pas
Целия файл 

@@ -33,6 +33,32 @@ type
 
     function TimeRemaining: Cardinal;

     function TimeRemaining: Cardinal;

   end;

   end;

 

 

+  TLogProc = procedure(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);

+

+  TCreateProcessOutputReader = class

+  private

+    FCreatedPipe: Boolean;

+    FOKToRead: Boolean;

+    FMaxTotalBytesToRead: Cardinal;

+    FTotalBytesRead: Cardinal;

+    FStdOutPipeRead: THandle;

+    FStdOutPipeWrite: THandle;

+    FLogProc: TLogProc;

+    FLogProcData: NativeInt;

+    FReadBuffer: AnsiString;

+    FNextLineIsFirstLine: Boolean;

+    procedure CloseAndClearHandle(var Handle: THandle);

+    procedure LogErrorFmt(const S: String; const Args: array of const);

+  public

+    constructor Create(const ALogProc: TLogProc; const ALogProcData: NativeInt);

+    destructor Destroy; override;

+    procedure UpdateStartupInfo(var StartupInfo: TStartupInfo;

+      var InheritHandles: Boolean);

+    procedure NotifyCreateProcessDone;

+    procedure Read(const LastRead: Boolean);

+    property MaxTotalBytesToRead: Cardinal read FMaxTotalBytesToRead write FMaxTotalBytesToRead;

+  end;

+

   TRegView = (rvDefault, rv32Bit, rv64Bit);

   TRegView = (rvDefault, rv32Bit, rv64Bit);

 const

 const

   RegViews64Bit = [rv64Bit];

   RegViews64Bit = [rv64Bit];

@@ -1568,4 +1594,143 @@ begin
 
     Result := 0;

     Result := 0;

 end;

 end;

 

 

+{ TCreateProcessOutputReader }

+

+constructor TCreateProcessOutputReader.Create(const ALogProc: TLogProc;

+  const ALogProcData: NativeInt);

+begin

+  if not Assigned(ALogProc) then

+    raise Exception.Create('ALogProc is required');

+

+  FLogProc := ALogProc;

+  FNextLineIsFirstLine := True;

+  FLogProcData := ALogProcData;

+

+  var SecurityAttributes: TSecurityAttributes;

+  SecurityAttributes.nLength := SizeOf(SecurityAttributes);

+  SecurityAttributes.bInheritHandle := True;

+  SecurityAttributes.lpSecurityDescriptor := nil;

+

+  FCreatedPipe := CreatePipe(FStdOutPipeRead, FStdOutPipeWrite, @SecurityAttributes, 0);

+  if not FCreatedPipe then

+    LogErrorFmt('CreatePipe failed (%d).', [GetLastError])

+  else if not SetHandleInformation(FStdOutPipeRead, HANDLE_FLAG_INHERIT, 0) then

+    LogErrorFmt('SetHandleInformation failed (%d).', [GetLastError]);

+

+  FOKToRead := FCreatedPipe;

+  FMaxTotalBytesToRead := 10*1024*1024;

+end;

+

+destructor TCreateProcessOutputReader.Destroy;

+begin

+  CloseAndClearHandle(FStdOutPipeRead);

+  CloseAndClearHandle(FStdOutPipeWrite);

+  inherited;

+end;

+

+procedure TCreateProcessOutputReader.CloseAndClearHandle(var Handle: THandle);

+begin

+  if Handle <> 0 then begin

+    CloseHandle(Handle);

+    Handle := 0;

+  end;

+end;

+

+procedure TCreateProcessOutputReader.LogErrorFmt(const S: String; const Args: array of const);

+begin

+  FLogProc(Format(S, Args), False, True, FLogProcData);

+end;

+

+procedure TCreateProcessOutputReader.UpdateStartupInfo(var StartupInfo: TStartupInfo;

+  var InheritHandles: Boolean);

+begin

+  if FCreatedPipe then begin

+    StartupInfo.dwFlags := StartupInfo.dwFlags or STARTF_USESTDHANDLES;

+    StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);

+    StartupInfo.hStdOutput := FStdOutPipeWrite;

+    StartupInfo.hStdError := FStdOutPipeWrite;

+    InheritHandles := True;

+  end else

+    InheritHandles := False;

+end;

+

+procedure TCreateProcessOutputReader.NotifyCreateProcessDone;

+begin

+  CloseAndClearHandle(FStdOutPipeWrite);

+end;

+

+procedure TCreateProcessOutputReader.Read(const LastRead: Boolean);

+

+  function FindNewLine(const S: AnsiString; const LastRead: Boolean): Integer;

+  begin

+    { This will return the position of the first #13 or #10. If a #13 is at

+      the very end of the string it's only accepted if we are certain we can't

+      be looking at a split #13#10 because there will be no more reads }

+    var N := Length(S);

+    for var I := 1 to N do

+      if ((S[I] = #13) and ((I < N) or LastRead)) or

+         (S[I] = #10) then

+        Exit(I);

+    Result := 0;

+  end;

+

+  procedure LogLine(const S: AnsiString);

+  begin

+    FLogProc(Utf8Decode(S), False, FNextLineIsFirstLine, FLogProcData);

+    FNextLineIsFirstLine := False;

+  end;

+

+begin

+  if FOKToRead then begin

+    var TotalBytesAvail: DWORD;

+    FOKToRead := PeekNamedPipe(FStdOutPipeRead, nil, 0, nil, @TotalBytesAvail, nil);

+    if not FOKToRead then begin

+      var LastError := GetLastError;

+      if LastError <> ERROR_BROKEN_PIPE then

+        LogErrorFmt('PeekNamedPipe failed (%d).', [GetLastError]);

+    end else if TotalBytesAvail > 0 then begin

+      { Don't read more than our read limit }

+      if TotalBytesAvail > FMaxTotalBytesToRead - FTotalBytesRead then

+        TotalBytesAvail := FMaxTotalBytesToRead - FTotalBytesRead;

+      { Append newly available data to the incomplete line we might already have }

+      var TotalBytesHave: DWORD := Length(FReadBuffer);

+      SetLength(FReadBuffer, TotalBytesHave+TotalBytesAvail);

+      var BytesRead: DWORD;

+      FOKToRead := ReadFile(FStdOutPipeRead, FReadBuffer[TotalBytesHave+1],

+        TotalBytesAvail, BytesRead, nil);

+      if not FOKToRead then

+        LogErrorFmt('ReadFile failed (%d).', [GetLastError])

+      else if BytesRead > 0 then begin

+        { Correct length if less bytes were read than requested }

+        SetLength(FReadBuffer, TotalBytesHave+BytesRead);

+

+        { Check for completed lines thanks to the new data }

+        var P := FindNewLine(FReadBuffer, LastRead);

+        while P <> 0 do begin

+          LogLine(Copy(FReadBuffer, 1, P-1));

+          if (FReadBuffer[P] = #13) and (P < Length(FReadBuffer)) and (FReadBuffer[P+1] = #10) then

+            Inc(P);

+          Delete(FReadBuffer, 1, P);

+          P := FindNewLine(FReadBuffer, LastRead);

+        end;

+

+        Inc(FTotalBytesRead, BytesRead);

+        if FTotalBytesRead >= FMaxTotalBytesToRead then begin

+          { Read limit reached: break the pipe, throw away the incomplete line, and log an error }

+          FOKToRead := False;

+          FReadBuffer := '';

+          LogErrorFmt('Maximum output length (%d) reached, ignoring remainder.', [FMaxTotalBytesToRead]);

+        end;

+      end;

+    end;

+

+    { Unblock the child process's write, and cause further writes to fail immediately }

+    if not FOkToRead then

+      CloseAndClearHandle(FStdOutPipeRead);

+  end;

+

+  if LastRead and (FReadBuffer <> '') then

+    LogLine(FReadBuffer);

+end;

+

 end.

 end.

+ 1 - 0
Projects/Src/CompMsgs.pas
Целия файл 

@@ -294,6 +294,7 @@ const
 
   SCompilerParamUnsupportedFlag = 'Parameter "%s" includes a flag that is not supported in this section';

   SCompilerParamUnsupportedFlag = 'Parameter "%s" includes a flag that is not supported in this section';

   SCompilerParamFlagMissing = 'Flag "%s" must be used if flag "%s" is used';

   SCompilerParamFlagMissing = 'Flag "%s" must be used if flag "%s" is used';

   SCompilerParamFlagMissing2 = 'Flag "%s" must be used if parameter "%s" is used';

   SCompilerParamFlagMissing2 = 'Flag "%s" must be used if parameter "%s" is used';

+  SCompilerParamFlagMissing3 = 'Flag "%s" must be used if flags "%s" and "%s" are both used';

 

 

   { Types, components, tasks, check, beforeinstall, afterinstall }

   { Types, components, tasks, check, beforeinstall, afterinstall }

   SCompilerParamUnknownType = 'Parameter "%s" includes an unknown type';

   SCompilerParamUnknownType = 'Parameter "%s" includes an unknown type';

+ 60 - 22
Projects/Src/Compile.pas
Целия файл 

@@ -6425,12 +6425,12 @@ const
 
     (Name: ParamCommonAfterInstall; Flags: []),

     (Name: ParamCommonAfterInstall; Flags: []),

     (Name: ParamCommonMinVersion; Flags: []),

     (Name: ParamCommonMinVersion; Flags: []),

     (Name: ParamCommonOnlyBelowVersion; Flags: []));

     (Name: ParamCommonOnlyBelowVersion; Flags: []));

-  Flags: array[0..18] of PChar = (

+  Flags: array[0..19] of PChar = (

     'nowait', 'waituntilidle', 'shellexec', 'skipifdoesntexist',

     'nowait', 'waituntilidle', 'shellexec', 'skipifdoesntexist',

     'runminimized', 'runmaximized', 'showcheckbox', 'postinstall',

     'runminimized', 'runmaximized', 'showcheckbox', 'postinstall',

     'unchecked', 'skipifsilent', 'skipifnotsilent', 'hidewizard',

     'unchecked', 'skipifsilent', 'skipifnotsilent', 'hidewizard',

     'runhidden', 'waituntilterminated', '32bit', '64bit', 'runasoriginaluser',

     'runhidden', 'waituntilterminated', '32bit', '64bit', 'runasoriginaluser',

-    'runascurrentuser', 'dontlogparameters');

+    'runascurrentuser', 'dontlogparameters', 'logoutput');

 var

 var

   Values: array[TParam] of TParamValue;

   Values: array[TParam] of TParamValue;

   NewRunEntry: PSetupRunEntry;

   NewRunEntry: PSetupRunEntry;

@@ -6511,6 +6511,7 @@ begin
 
              end;

              end;

           17: RunAsCurrentUser := True;

           17: RunAsCurrentUser := True;

           18: Include(Options, roDontLogParameters);

           18: Include(Options, roDontLogParameters);

+          19: Include(Options, roLogOutput);

         end;

         end;

 

 

       if not WaitFlagSpecified then begin

       if not WaitFlagSpecified then begin

@@ -6527,6 +6528,21 @@ begin
 
          (not RunAsCurrentUser and (roPostInstall in Options)) then

          (not RunAsCurrentUser and (roPostInstall in Options)) then

         Include(Options, roRunAsOriginalUser);

         Include(Options, roRunAsOriginalUser);

 

 

+      if roLogOutput in Options then begin

+        if roShellExec in Options then

+          AbortCompileOnLineFmt(SCompilerParamErrorBadCombo2,

+            [ParamCommonFlags, 'logoutput', 'shellexec']);

+        if (Wait <> rwWaitUntilTerminated) then

+          AbortCompileOnLineFmt(SCompilerParamFlagMissing,

+            ['waituntilterminated', 'logoutput']);

+        if RunAsOriginalUser then

+          AbortCompileOnLineFmt(SCompilerParamErrorBadCombo2,

+            [ParamCommonFlags, 'logoutput', 'runasoriginaluser']);

+        if roRunAsOriginalUser in Options then

+          AbortCompileOnLineFmt(SCompilerParamFlagMissing3,

+            ['runascurrentuser', 'logoutput', 'postinstall']);

+      end;

+

       { Filename }

       { Filename }

       Name := Values[paFilename].Data;

       Name := Values[paFilename].Data;

 

 

@@ -7280,6 +7296,14 @@ begin
 
   end;

   end;

 end;

 end;

 

 

+  procedure SignCommandLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);

+  begin

+    if S <> '' then begin

+      var SetupCompiler := TSetupCompiler(Data);

+      SetupCompiler.AddStatus('   ' + S, Error);

+    end;

+  end;

+

 procedure TSetupCompiler.SignCommand(const AName, ACommand, AParams, AExeFilename: String; const RetryCount, RetryDelay, MinimumTimeBetween: Integer; const RunMinimized: Boolean);

 procedure TSetupCompiler.SignCommand(const AName, ACommand, AParams, AExeFilename: String; const RetryCount, RetryDelay, MinimumTimeBetween: Integer; const RunMinimized: Boolean);

 

 

   function FmtCommand(S: PChar; const AParams, AFileName: String; var AFileNameSequenceFound: Boolean): String;

   function FmtCommand(S: PChar; const AParams, AFileName: String; var AFileNameSequenceFound: Boolean): String;

@@ -7323,7 +7347,7 @@ procedure TSetupCompiler.SignCommand(const AName, ACommand, AParams, AExeFilenam
 
       end;

       end;

     end;

     end;

   end;

   end;

-  

+

   procedure InternalSignCommand(const AFormattedCommand: String;

   procedure InternalSignCommand(const AFormattedCommand: String;

     const Delay: Cardinal);

     const Delay: Cardinal);

   var

   var

@@ -7343,29 +7367,43 @@ procedure TSetupCompiler.SignCommand(const AName, ACommand, AParams, AExeFilenam
 
     StartupInfo.cb := SizeOf(StartupInfo);

     StartupInfo.cb := SizeOf(StartupInfo);

     StartupInfo.dwFlags := STARTF_USESHOWWINDOW;

     StartupInfo.dwFlags := STARTF_USESHOWWINDOW;

     StartupInfo.wShowWindow := IfThen(RunMinimized, SW_SHOWMINNOACTIVE, SW_SHOW);

     StartupInfo.wShowWindow := IfThen(RunMinimized, SW_SHOWMINNOACTIVE, SW_SHOW);

-    

-    if not CreateProcess(nil, PChar(AFormattedCommand), nil, nil, False,

-       CREATE_DEFAULT_ERROR_MODE, nil, PChar(CompilerDir), StartupInfo, ProcessInfo) then begin

-      LastError := GetLastError;

-      AbortCompileFmt(SCompilerSignToolCreateProcessFailed, [LastError,

-        Win32ErrorString(LastError)]);

-    end;

-    CloseHandle(ProcessInfo.hThread);

+

+    var OutputReader := TCreateProcessOutputReader.Create(SignCommandLog, NativeInt(Self));

     try

     try

-      while True do begin

-        case WaitForSingleObject(ProcessInfo.hProcess, 50) of

-          WAIT_OBJECT_0: Break;

-          WAIT_TIMEOUT: CallIdleProc;

-        else

-          AbortCompile('Sign: WaitForSingleObject failed');

+      var InheritHandles: Boolean;

+      OutputReader.UpdateStartupInfo(StartupInfo, InheritHandles);

+

+      if not CreateProcess(nil, PChar(AFormattedCommand), nil, nil, InheritHandles,

+         CREATE_DEFAULT_ERROR_MODE, nil, PChar(CompilerDir), StartupInfo, ProcessInfo) then begin

+        LastError := GetLastError;

+        AbortCompileFmt(SCompilerSignToolCreateProcessFailed, [LastError,

+          Win32ErrorString(LastError)]);

+      end;

+      CloseHandle(ProcessInfo.hThread);

+      OutputReader.NotifyCreateProcessDone;

+      try

+        while True do begin

+          case WaitForSingleObject(ProcessInfo.hProcess, 50) of

+            WAIT_OBJECT_0: Break;

+            WAIT_TIMEOUT:

+              begin

+                OutputReader.Read(False);

+                CallIdleProc;

+              end;

+          else

+            AbortCompile('Sign: WaitForSingleObject failed');

+          end;

         end;

         end;

+        OutputReader.Read(True);

+        if not GetExitCodeProcess(ProcessInfo.hProcess, ExitCode) then

+          AbortCompile('Sign: GetExitCodeProcess failed');

+        if ExitCode <> 0 then

+          AbortCompileFmt(SCompilerSignToolNonZeroExitCode, [ExitCode]);

+      finally

+        CloseHandle(ProcessInfo.hProcess);

       end;

       end;

-      if not GetExitCodeProcess(ProcessInfo.hProcess, ExitCode) then

-        AbortCompile('Sign: GetExitCodeProcess failed');

-      if ExitCode <> 0 then

-        AbortCompileFmt(SCompilerSignToolNonZeroExitCode, [ExitCode]);

     finally

     finally

-      CloseHandle(ProcessInfo.hProcess);

+      OutputReader.Free;

     end;

     end;

   end;

   end;

+ 49 - 26
Projects/Src/InstFunc.pas
Целия файл 

@@ -87,7 +87,8 @@ procedure IncrementSharedCount(const RegView: TRegView; const Filename: String;
 
   const AlreadyExisted: Boolean);

   const AlreadyExisted: Boolean);

 function InstExec(const DisableFsRedir: Boolean; const Filename, Params: String;

 function InstExec(const DisableFsRedir: Boolean; const Filename, Params: String;

   WorkingDir: String; const Wait: TExecWait; const ShowCmd: Integer;

   WorkingDir: String; const Wait: TExecWait; const ShowCmd: Integer;

-  const ProcessMessagesProc: TProcedure; var ResultCode: Integer): Boolean;

+  const ProcessMessagesProc: TProcedure; const Log: Boolean; const LogProc: TLogProc;

+  const LogProcData: NativeInt; var ResultCode: Integer): Boolean;

 function InstShellExec(const Verb, Filename, Params: String; WorkingDir: String;

 function InstShellExec(const Verb, Filename, Params: String; WorkingDir: String;

   const Wait: TExecWait; const ShowCmd: Integer;

   const Wait: TExecWait; const ShowCmd: Integer;

   const ProcessMessagesProc: TProcedure; var ResultCode: Integer): Boolean;

   const ProcessMessagesProc: TProcedure; var ResultCode: Integer): Boolean;

@@ -115,7 +116,7 @@ implementation
 
 

 

 uses

 uses

   Messages, ShellApi, PathFunc, Msgs, MsgIDs, FileClass, RedirFunc, SetupTypes,

   Messages, ShellApi, PathFunc, Msgs, MsgIDs, FileClass, RedirFunc, SetupTypes,

-  Hash, Classes, RegStr;

+  Hash, Classes, RegStr, Math;

 

 

 procedure InternalError(const Id: String);

 procedure InternalError(const Id: String);

 begin

 begin

@@ -813,7 +814,8 @@ begin
 
 end;

 end;

 

 

 procedure HandleProcessWait(ProcessHandle: THandle; const Wait: TExecWait;

 procedure HandleProcessWait(ProcessHandle: THandle; const Wait: TExecWait;

-  const ProcessMessagesProc: TProcedure; var ResultCode: Integer);

+  const ProcessMessagesProc: TProcedure; const OutputReader: TCreateProcessOutputReader;

+  var ResultCode: Integer);

 begin

 begin

   try

   try

     if Wait = ewWaitUntilIdle then begin

     if Wait = ewWaitUntilIdle then begin

@@ -823,17 +825,27 @@ begin
 
     end;

     end;

     if Wait = ewWaitUntilTerminated then begin

     if Wait = ewWaitUntilTerminated then begin

       { Wait until the process returns, but still process any messages that

       { Wait until the process returns, but still process any messages that

-        arrive. }

+        arrive and read the output if requested. }

+      var WaitMilliseconds := IfThen(OutputReader <> nil, 50, INFINITE);

+      var WaitResult: DWORD := 0;

       repeat

       repeat

         { Process any pending messages first because MsgWaitForMultipleObjects

         { Process any pending messages first because MsgWaitForMultipleObjects

-          (called below) only returns when *new* messages arrive }

-        ProcessMessagesProc;

-      until MsgWaitForMultipleObjects(1, ProcessHandle, False, INFINITE, QS_ALLINPUT) <> WAIT_OBJECT_0+1;

+          (called below) only returns when *new* messages arrive, unless there's

+          a timeout }

+        if WaitResult <> WAIT_TIMEOUT then

+          ProcessMessagesProc;

+        if OutputReader <> nil then

+          OutputReader.Read(False);

+        WaitResult := MsgWaitForMultipleObjects(1, ProcessHandle, False,

+          WaitMilliseconds, QS_ALLINPUT);

+      until (WaitResult <> WAIT_OBJECT_0+1) and (WaitResult <> WAIT_TIMEOUT);

       { Process messages once more in case MsgWaitForMultipleObjects saw the

       { Process messages once more in case MsgWaitForMultipleObjects saw the

         process terminate and new messages arrive simultaneously. (Can't leave

         process terminate and new messages arrive simultaneously. (Can't leave

         unprocessed messages waiting, or a subsequent call to WaitMessage

         unprocessed messages waiting, or a subsequent call to WaitMessage

         won't see them.) }

         won't see them.) }

       ProcessMessagesProc;

       ProcessMessagesProc;

+      if OutputReader <> nil then

+        OutputReader.Read(True);

     end;

     end;

     { Get the exit code. Will be set to STILL_ACTIVE if not yet available }

     { Get the exit code. Will be set to STILL_ACTIVE if not yet available }

     if not GetExitCodeProcess(ProcessHandle, DWORD(ResultCode)) then

     if not GetExitCodeProcess(ProcessHandle, DWORD(ResultCode)) then

@@ -845,7 +857,8 @@ end;
 
 

 

 function InstExec(const DisableFsRedir: Boolean; const Filename, Params: String;

 function InstExec(const DisableFsRedir: Boolean; const Filename, Params: String;

   WorkingDir: String; const Wait: TExecWait; const ShowCmd: Integer;

   WorkingDir: String; const Wait: TExecWait; const ShowCmd: Integer;

-  const ProcessMessagesProc: TProcedure; var ResultCode: Integer): Boolean;

+  const ProcessMessagesProc: TProcedure; const Log: Boolean; const LogProc: TLogProc;

+  const LogProcData: NativeInt; var ResultCode: Integer): Boolean;

 var

 var

   CmdLine: String;

   CmdLine: String;

   StartupInfo: TStartupInfo;

   StartupInfo: TStartupInfo;

@@ -883,16 +896,31 @@ begin
 
   if WorkingDir = '' then

   if WorkingDir = '' then

     WorkingDir := GetSystemDir;

     WorkingDir := GetSystemDir;

 

 

-  Result := CreateProcessRedir(DisableFsRedir, nil, PChar(CmdLine), nil, nil, False,

-    CREATE_DEFAULT_ERROR_MODE, nil, PChar(WorkingDir), StartupInfo, ProcessInfo);

-  if not Result then begin

-    ResultCode := GetLastError;

-    Exit;

-  end;

+  var OutputReader: TCreateProcessOutputReader := nil;

+  var InheritHandles := False;

+  try

+    if Log and Assigned(LogProc) and (Wait = ewWaitUntilTerminated) then begin

+      OutputReader := TCreateProcessOutputReader.Create(LogProc, LogProcData);

+      OutputReader.UpdateStartupInfo(StartupInfo, InheritHandles);

+    end;

 

 

-  { Don't need the thread handle, so close it now }

-  CloseHandle(ProcessInfo.hThread);

-  HandleProcessWait(ProcessInfo.hProcess, Wait, ProcessMessagesProc, ResultCode);

+    Result := CreateProcessRedir(DisableFsRedir, nil, PChar(CmdLine), nil, nil,

+      InheritHandles, CREATE_DEFAULT_ERROR_MODE, nil, PChar(WorkingDir),

+      StartupInfo, ProcessInfo);

+    if not Result then begin

+      ResultCode := GetLastError;

+      Exit;

+    end;

+

+    { Don't need the thread handle, so close it now }

+    CloseHandle(ProcessInfo.hThread);

+    if OutputReader <> nil then

+      OutputReader.NotifyCreateProcessDone;

+    HandleProcessWait(ProcessInfo.hProcess, Wait, ProcessMessagesProc,

+      OutputReader, ResultCode);

+  finally

+    OutputReader.Free;

+  end;

 end;

 end;

 

 

 function InstShellExec(const Verb, Filename, Params: String; WorkingDir: String;

 function InstShellExec(const Verb, Filename, Params: String; WorkingDir: String;

@@ -926,21 +954,16 @@ begin
 
   ResultCode := STILL_ACTIVE;

   ResultCode := STILL_ACTIVE;

   { A process handle won't always be returned, e.g. if DDE was used }

   { A process handle won't always be returned, e.g. if DDE was used }

   if Info.hProcess <> 0 then

   if Info.hProcess <> 0 then

-    HandleProcessWait(Info.hProcess, Wait, ProcessMessagesProc, ResultCode);

+    HandleProcessWait(Info.hProcess, Wait, ProcessMessagesProc, nil, ResultCode);

 end;

 end;

 

 

 function CheckForOrCreateMutexes(Mutexes: String; const Create: Boolean): Boolean;

 function CheckForOrCreateMutexes(Mutexes: String; const Create: Boolean): Boolean;

 

 

   function MutexPos(const S: String): Integer;

   function MutexPos(const S: String): Integer;

-  var

-    I: Integer;

   begin

   begin

-    for I := 1 to Length(S) do begin

-      if (S[I] = ',') and ((I = 1) or (S[I-1] <> '\')) then begin

-        Result := I;

-        Exit;

-      end;

-    end;

+    for var I := 1 to Length(S) do

+      if (S[I] = ',') and ((I = 1) or (S[I-1] <> '\')) then

+        Exit(I);

     Result := 0;

     Result := 0;

   end;

   end;

+ 2 - 0
Projects/Src/Install.pas
Целия файл 

@@ -2792,6 +2792,8 @@ var
 
         end;

         end;

         if roDontLogParameters in RunEntry.Options then

         if roDontLogParameters in RunEntry.Options then

           Flags := Flags or utRun_DontLogParameters;

           Flags := Flags or utRun_DontLogParameters;

+        if roLogOutput in RunEntry.Options then

+          Flags := Flags or utRun_LogOutput;

         UninstLog.Add(utRun, [ExpandConst(RunEntry.Name),

         UninstLog.Add(utRun, [ExpandConst(RunEntry.Name),

           ExpandConst(RunEntry.Parameters), ExpandConst(RunEntry.WorkingDir),

           ExpandConst(RunEntry.Parameters), ExpandConst(RunEntry.WorkingDir),

           ExpandConst(RunEntry.RunOnceId), ExpandConst(RunEntry.Verb)],

           ExpandConst(RunEntry.RunOnceId), ExpandConst(RunEntry.Verb)],

+ 8 - 4
Projects/Src/Logging.pas
Целия файл 

@@ -2,13 +2,11 @@ unit Logging;
 
 

 

 {

 {

   Inno Setup

   Inno Setup

-  Copyright (C) 1997-2007 Jordan Russell

+  Copyright (C) 1997-2024 Jordan Russell

   Portions by Martijn Laan

   Portions by Martijn Laan

   For conditions of distribution and use, see LICENSE.TXT.

   For conditions of distribution and use, see LICENSE.TXT.

 

 

   Logging functions

   Logging functions

-

-  $jrsoftware: issrc/Projects/Logging.pas,v 1.12 2009/03/23 23:27:14 mlaan Exp $

 }

 }

 

 

 interface

 interface

@@ -18,6 +16,7 @@ procedure LogFmt(const S: String; const Args: array of const);
 
 procedure StartLogging(const Prefix: String);

 procedure StartLogging(const Prefix: String);

 procedure StartLoggingWithFixedFilename(const Filename: String);

 procedure StartLoggingWithFixedFilename(const Filename: String);

 function GetLogFileName: String;

 function GetLogFileName: String;

+function GetLogActive: Boolean; { Returns True if logging was started or when debugging from the IDE }

 

 

 const

 const

   SYesNo: array[Boolean] of String = ('No', 'Yes');

   SYesNo: array[Boolean] of String = ('No', 'Yes');

@@ -127,6 +126,11 @@ begin
 
   Result := LogFileName;

   Result := LogFileName;

 end;

 end;

 

 

+function GetLogActive: Boolean;

+begin

+  Result := Assigned(LogFile) or Debugging;

+end;

+

 procedure Log(const S: String);

 procedure Log(const S: String);

 

 

   procedure WriteStr(const S: String);

   procedure WriteStr(const S: String);

@@ -172,7 +176,7 @@ end;
 
 

 

 procedure LogFmt(const S: String; const Args: array of const);

 procedure LogFmt(const S: String; const Args: array of const);

 begin

 begin

-  if Assigned(LogFile) or Debugging then

+  if GetLogActive then

     Log(Format(S, Args));

     Log(Format(S, Args));

 end;

 end;

+ 9 - 1
Projects/Src/Main.pas
Целия файл 

@@ -3827,6 +3827,13 @@ begin
 
   Application.ProcessMessages;

   Application.ProcessMessages;

 end;

 end;

 

 

+procedure RunExecLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);

+begin

+  if not Error and FirstLine then

+    Log('Output:');

+  Log(S);

+end;

+

 procedure TMainForm.SetStep(const AStep: TSetupStep; const HandleExceptions: Boolean);

 procedure TMainForm.SetStep(const AStep: TSetupStep; const HandleExceptions: Boolean);

 begin

 begin

   CurStep := AStep;

   CurStep := AStep;

@@ -3917,7 +3924,8 @@ begin
 
          NewFileExistsRedir(DisableFsRedir, ExpandedFilename) then begin

          NewFileExistsRedir(DisableFsRedir, ExpandedFilename) then begin

         if not InstExecEx(RunAsOriginalUser, DisableFsRedir, ExpandedFilename,

         if not InstExecEx(RunAsOriginalUser, DisableFsRedir, ExpandedFilename,

            ExpandedParameters, ExpandConst(RunEntry.WorkingDir),

            ExpandedParameters, ExpandConst(RunEntry.WorkingDir),

-           Wait, RunEntry.ShowCmd, ProcessMessagesProc, ErrorCode) then

+           Wait, RunEntry.ShowCmd, ProcessMessagesProc, GetLogActive and (roLogOutput in RunEntry.Options),

+           RunExecLog, 0, ErrorCode) then

           raise Exception.Create(FmtSetupMessage1(msgErrorExecutingProgram, ExpandedFilename) +

           raise Exception.Create(FmtSetupMessage1(msgErrorExecutingProgram, ExpandedFilename) +

             SNewLine2 + FmtSetupMessage(msgErrorFunctionFailedWithMessage,

             SNewLine2 + FmtSetupMessage(msgErrorFunctionFailedWithMessage,

             ['CreateProcess', IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));

             ['CreateProcess', IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));

+ 2 - 1
Projects/Src/ScriptFunc.pas
Целия файл 

@@ -133,7 +133,7 @@ const
 
   );

   );

 

 

   { InstFunc }

   { InstFunc }

-  InstFuncTable: array [0..30] of AnsiString =

+  InstFuncTable: array [0..31] of AnsiString =

   (

   (

     'function CheckForMutexes(Mutexes: String): Boolean;',

     'function CheckForMutexes(Mutexes: String): Boolean;',

     'function DecrementSharedCount(const Is64Bit: Boolean; const Filename: String): Boolean;',

     'function DecrementSharedCount(const Is64Bit: Boolean; const Filename: String): Boolean;',

@@ -158,6 +158,7 @@ const
 
     //function GrantPermissionOnKey(const RootKey: HKEY; const Subkey: String; const Entries: TGrantPermissionEntry; const EntryCount: Integer): Boolean;

     //function GrantPermissionOnKey(const RootKey: HKEY; const Subkey: String; const Entries: TGrantPermissionEntry; const EntryCount: Integer): Boolean;

     'procedure IncrementSharedCount(const Is64Bit: Boolean; const Filename: String; const AlreadyExisted: Boolean);',

     'procedure IncrementSharedCount(const Is64Bit: Boolean; const Filename: String; const AlreadyExisted: Boolean);',

     'function Exec(const Filename, Params, WorkingDir: String; const ShowCmd: Integer; const Wait: TExecWait; var ResultCode: Integer): Boolean;',

     'function Exec(const Filename, Params, WorkingDir: String; const ShowCmd: Integer; const Wait: TExecWait; var ResultCode: Integer): Boolean;',

+    'function ExecAndLogOutput(const Filename, Params, WorkingDir: String; const ShowCmd: Integer; const Wait: TExecWait; var ResultCode: Integer; const OnLog: TOnLog): Boolean;',

     'function ExecAsOriginalUser(const Filename, Params, WorkingDir: String; const ShowCmd: Integer; const Wait: TExecWait; var ResultCode: Integer): Boolean;',

     'function ExecAsOriginalUser(const Filename, Params, WorkingDir: String; const ShowCmd: Integer; const Wait: TExecWait; var ResultCode: Integer): Boolean;',

     'function ShellExec(const Verb, Filename, Params, WorkingDir: String; const ShowCmd: Integer; const Wait: TExecWait; var ErrorCode: Integer): Boolean;',

     'function ShellExec(const Verb, Filename, Params, WorkingDir: String; const ShowCmd: Integer; const Wait: TExecWait; var ErrorCode: Integer): Boolean;',

     'function ShellExecAsOriginalUser(const Verb, Filename, Params, WorkingDir: String; const ShowCmd: Integer; const Wait: TExecWait; var ErrorCode: Integer): Boolean;',

     'function ShellExecAsOriginalUser(const Verb, Filename, Params, WorkingDir: String; const ShowCmd: Integer; const Wait: TExecWait; var ErrorCode: Integer): Boolean;',

+ 1 - 0
Projects/Src/ScriptFunc_C.pas
Целия файл 

@@ -142,6 +142,7 @@ begin
 
     'end');

     'end');

 

 

   RegisterType('TOnDownloadProgress', 'function(const Url, FileName: string; const Progress, ProgressMax: Int64): Boolean;');

   RegisterType('TOnDownloadProgress', 'function(const Url, FileName: string; const Progress, ProgressMax: Int64): Boolean;');

+  RegisterType('TOnLog', 'procedure(const S: String; const Error, FirstLine: Boolean);');

 

 

   RegisterFunctionTable(ScriptDlgTable);

   RegisterFunctionTable(ScriptDlgTable);

   RegisterFunctionTable(NewDiskTable);

   RegisterFunctionTable(NewDiskTable);

+ 45 - 11
Projects/Src/ScriptFunc_R.pas
Целия файл 

@@ -125,7 +125,6 @@ var
 
   NewOutputProgressPage: TOutputProgressWizardPage;

   NewOutputProgressPage: TOutputProgressWizardPage;

   NewOutputMarqueeProgressPage: TOutputMarqueeProgressWizardPage;

   NewOutputMarqueeProgressPage: TOutputMarqueeProgressWizardPage;

   NewDownloadPage: TDownloadWizardPage;

   NewDownloadPage: TDownloadWizardPage;

-  P: PPSVariantProcPtr;

   OnDownloadProgress: TOnDownloadProgress;

   OnDownloadProgress: TOnDownloadProgress;

   NewSetupForm: TSetupForm;

   NewSetupForm: TSetupForm;

 begin

 begin

@@ -271,7 +270,7 @@ begin
 
   end else if Proc.Name = 'CREATEDOWNLOADPAGE' then begin

   end else if Proc.Name = 'CREATEDOWNLOADPAGE' then begin

     if IsUninstaller then

     if IsUninstaller then

       NoUninstallFuncError(Proc.Name);

       NoUninstallFuncError(Proc.Name);

-    P := Stack.Items[PStart-3];

+    var P: PPSVariantProcPtr := Stack.Items[PStart-3];

     { ProcNo 0 means nil was passed by the script }

     { ProcNo 0 means nil was passed by the script }

     if P.ProcNo <> 0 then

     if P.ProcNo <> 0 then

       OnDownloadProgress := TOnDownloadProgress(Caller.GetProcAsMethod(P.ProcNo))

       OnDownloadProgress := TOnDownloadProgress(Caller.GetProcAsMethod(P.ProcNo))

@@ -765,7 +764,6 @@ end;
 
 function InstallProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;

 function InstallProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;

 var

 var

   PStart: Cardinal;

   PStart: Cardinal;

-  P: PPSVariantProcPtr;

   OnDownloadProgress: TOnDownloadProgress;

   OnDownloadProgress: TOnDownloadProgress;

 begin

 begin

   if IsUninstaller then

   if IsUninstaller then

@@ -779,7 +777,7 @@ begin
 
   end else if Proc.Name = 'EXTRACTTEMPORARYFILES' then begin

   end else if Proc.Name = 'EXTRACTTEMPORARYFILES' then begin

     Stack.SetInt(PStart, ExtractTemporaryFiles(Stack.GetString(PStart-1)));

     Stack.SetInt(PStart, ExtractTemporaryFiles(Stack.GetString(PStart-1)));

   end else if Proc.Name = 'DOWNLOADTEMPORARYFILE' then begin

   end else if Proc.Name = 'DOWNLOADTEMPORARYFILE' then begin

-    P := Stack.Items[PStart-4];

+    var P: PPSVariantProcPtr := Stack.Items[PStart-4];

     { ProcNo 0 means nil was passed by the script }

     { ProcNo 0 means nil was passed by the script }

     if P.ProcNo <> 0 then

     if P.ProcNo <> 0 then

       OnDownloadProgress := TOnDownloadProgress(Caller.GetProcAsMethod(P.ProcNo))

       OnDownloadProgress := TOnDownloadProgress(Caller.GetProcAsMethod(P.ProcNo))

@@ -802,6 +800,20 @@ begin
 
   Application.ProcessMessages;

   Application.ProcessMessages;

 end;

 end;

 

 

+procedure ExecAndLogOutputLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);

+begin

+  Log(S);

+end;

+

+type

+  TOnLog = procedure(const S: String; const Error, FirstLine: Boolean) of object;

+

+procedure ExecAndLogOutputLogCustom(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);

+begin

+  var OnLog := TOnLog(PMethod(Data)^);

+  OnLog(S, Error, FirstLine);

+end;

+

 function InstFuncProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;

 function InstFuncProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;

 var

 var

   PStart: Cardinal;

   PStart: Cardinal;

@@ -809,7 +821,6 @@ var
 
   WindowDisabler: TWindowDisabler;

   WindowDisabler: TWindowDisabler;

   ResultCode, ErrorCode: Integer;

   ResultCode, ErrorCode: Integer;

   FreeBytes, TotalBytes: Integer64;

   FreeBytes, TotalBytes: Integer64;

-  RunAsOriginalUser: Boolean;

 begin

 begin

   PStart := Stack.Count-1;

   PStart := Stack.Count-1;

   Result := True;

   Result := True;

@@ -883,10 +894,32 @@ begin
 
     end

     end

     else

     else

       IncrementSharedCount(rv32Bit, Stack.GetString(PStart-1), Stack.GetBool(PStart-2));

       IncrementSharedCount(rv32Bit, Stack.GetString(PStart-1), Stack.GetBool(PStart-2));

-  end else if (Proc.Name = 'EXEC') or (Proc.Name = 'EXECASORIGINALUSER') then begin

-    RunAsOriginalUser := Proc.Name = 'EXECASORIGINALUSER';

+  end else if (Proc.Name = 'EXEC') or (Proc.Name = 'EXECASORIGINALUSER') or

+              (Proc.Name = 'EXECANDLOGOUTPUT') then begin

+    var RunAsOriginalUser := Proc.Name = 'EXECASORIGINALUSER';

+    var LogOutput: Boolean;

+    var LogProc: TLogProc := nil;

+    var LogProcData: NativeInt := 0;

+    var Method: TMethod;

+    if Proc.Name = 'EXECANDLOGOUTPUT' then begin

+      var P: PPSVariantProcPtr := Stack.Items[PStart-7];

+      { ProcNo 0 means nil was passed by the script }

+      if P.ProcNo <> 0 then begin

+        LogOutput := True;

+        LogProc := ExecAndLogOutputLogCustom;

+        Method := Caller.GetProcAsMethod(P.ProcNo); { This is a TOnLog }

+        LogProcData := NativeInt(@Method);

+      end else begin

+        LogOutput := GetLogActive;

+        LogProc := ExecAndLogOutputLog;

+      end;

+    end else

+      LogOutput := False;

+    var ExecWait := TExecWait(Stack.GetInt(PStart-5));

     if IsUninstaller and RunAsOriginalUser then

     if IsUninstaller and RunAsOriginalUser then

-      NoUninstallFuncError(Proc.Name);

+      NoUninstallFuncError(Proc.Name)

+    else if LogOutput and (ExecWait <> ewWaitUntilTerminated) then

+      InternalError(Format('Must call "%s" function with Wait = ewWaitUntilTerminated', [Proc.Name]));

 

 

     Filename := Stack.GetString(PStart-1);

     Filename := Stack.GetString(PStart-1);

     if PathCompare(Filename, SetupLdrOriginalFilename) <> 0 then begin

     if PathCompare(Filename, SetupLdrOriginalFilename) <> 0 then begin

@@ -896,8 +929,9 @@ begin
 
       try

       try

         Stack.SetBool(PStart, InstExecEx(RunAsOriginalUser,

         Stack.SetBool(PStart, InstExecEx(RunAsOriginalUser,

           ScriptFuncDisableFsRedir, Filename, Stack.GetString(PStart-2),

           ScriptFuncDisableFsRedir, Filename, Stack.GetString(PStart-2),

-          Stack.GetString(PStart-3), TExecWait(Stack.GetInt(PStart-5)),

-          Stack.GetInt(PStart-4), ProcessMessagesProc, ResultCode));

+          Stack.GetString(PStart-3), ExecWait,

+          Stack.GetInt(PStart-4), ProcessMessagesProc, LogOutput,

+          LogProc, LogProcData, ResultCode));

       finally

       finally

         WindowDisabler.Free;

         WindowDisabler.Free;

       end;

       end;

@@ -907,7 +941,7 @@ begin
 
       Stack.SetInt(PStart-6, ERROR_ACCESS_DENIED);

       Stack.SetInt(PStart-6, ERROR_ACCESS_DENIED);

     end;

     end;

   end else if (Proc.Name = 'SHELLEXEC') or (Proc.Name = 'SHELLEXECASORIGINALUSER') then begin

   end else if (Proc.Name = 'SHELLEXEC') or (Proc.Name = 'SHELLEXECASORIGINALUSER') then begin

-    RunAsOriginalUser := Proc.Name = 'SHELLEXECASORIGINALUSER';

+    var RunAsOriginalUser := Proc.Name = 'SHELLEXECASORIGINALUSER';

     if IsUninstaller and RunAsOriginalUser then

     if IsUninstaller and RunAsOriginalUser then

       NoUninstallFuncError(Proc.Name);

       NoUninstallFuncError(Proc.Name);

+ 7 - 5
Projects/Src/SpawnClient.pas
Целия файл 

@@ -15,13 +15,14 @@ unit SpawnClient;
 
 interface

 interface

 

 

 uses

 uses

-  Windows, SysUtils, Messages, InstFunc;

+  Windows, SysUtils, Messages, InstFunc, CmnFunc2;

 

 

 procedure InitializeSpawnClient(const AServerWnd: HWND);

 procedure InitializeSpawnClient(const AServerWnd: HWND);

 function InstExecEx(const RunAsOriginalUser: Boolean;

 function InstExecEx(const RunAsOriginalUser: Boolean;

   const DisableFsRedir: Boolean; const Filename, Params, WorkingDir: String;

   const DisableFsRedir: Boolean; const Filename, Params, WorkingDir: String;

   const Wait: TExecWait; const ShowCmd: Integer;

   const Wait: TExecWait; const ShowCmd: Integer;

-  const ProcessMessagesProc: TProcedure; var ResultCode: Integer): Boolean;

+  const ProcessMessagesProc: TProcedure; const Log: Boolean; const LogProc: TLogProc;

+  const LogProcData: NativeInt; var ResultCode: Integer): Boolean;

 function InstShellExecEx(const RunAsOriginalUser: Boolean;

 function InstShellExecEx(const RunAsOriginalUser: Boolean;

   const Verb, Filename, Params, WorkingDir: String;

   const Verb, Filename, Params, WorkingDir: String;

   const Wait: TExecWait; const ShowCmd: Integer;

   const Wait: TExecWait; const ShowCmd: Integer;

@@ -30,7 +31,7 @@ function InstShellExecEx(const RunAsOriginalUser: Boolean;
 
 implementation

 implementation

 

 

 uses

 uses

-  Classes, CmnFunc2, SpawnCommon;

+  Classes, SpawnCommon;

 

 

 var

 var

   SpawnServerPresent: Boolean;

   SpawnServerPresent: Boolean;

@@ -137,13 +138,14 @@ end;
 
 function InstExecEx(const RunAsOriginalUser: Boolean;

 function InstExecEx(const RunAsOriginalUser: Boolean;

   const DisableFsRedir: Boolean; const Filename, Params, WorkingDir: String;

   const DisableFsRedir: Boolean; const Filename, Params, WorkingDir: String;

   const Wait: TExecWait; const ShowCmd: Integer;

   const Wait: TExecWait; const ShowCmd: Integer;

-  const ProcessMessagesProc: TProcedure; var ResultCode: Integer): Boolean;

+  const ProcessMessagesProc: TProcedure; const Log: Boolean; const LogProc: TLogProc;

+  const LogProcData: NativeInt; var ResultCode: Integer): Boolean;

 var

 var

   M: TMemoryStream;

   M: TMemoryStream;

 begin

 begin

   if not RunAsOriginalUser or not SpawnServerPresent then begin

   if not RunAsOriginalUser or not SpawnServerPresent then begin

     Result := InstExec(DisableFsRedir, Filename, Params, WorkingDir,

     Result := InstExec(DisableFsRedir, Filename, Params, WorkingDir,

-      Wait, ShowCmd, ProcessMessagesProc, ResultCode);

+      Wait, ShowCmd, ProcessMessagesProc, Log, LogProc, LogProcData, ResultCode);

     Exit;

     Exit;

   end;

   end;

+ 1 - 1
Projects/Src/SpawnServer.pas
Целия файл 

@@ -380,7 +380,7 @@ begin
 
       end

       end

       else begin

       else begin

         ExecResult := InstExec(EDisableFsRedir <> 0, EFilename, EParams, EWorkingDir,

         ExecResult := InstExec(EDisableFsRedir <> 0, EFilename, EParams, EWorkingDir,

-          TExecWait(EWait), EShowCmd, ProcessMessagesProc, FResultCode);

+          TExecWait(EWait), EShowCmd, ProcessMessagesProc, False, nil, 0, FResultCode);

       end;

       end;

       if ExecResult then

       if ExecResult then

         FCallStatus := SPAWN_STATUS_RETURNED_TRUE

         FCallStatus := SPAWN_STATUS_RETURNED_TRUE

+ 2 - 1
Projects/Src/Struct.pas
Целия файл 

@@ -332,7 +332,8 @@ type
 
     Wait: (rwWaitUntilTerminated, rwNoWait, rwWaitUntilIdle);

     Wait: (rwWaitUntilTerminated, rwNoWait, rwWaitUntilIdle);

     Options: set of (roShellExec, roSkipIfDoesntExist,

     Options: set of (roShellExec, roSkipIfDoesntExist,

       roPostInstall, roUnchecked, roSkipIfSilent, roSkipIfNotSilent,

       roPostInstall, roUnchecked, roSkipIfSilent, roSkipIfNotSilent,

-      roHideWizard, roRun32Bit, roRun64Bit, roRunAsOriginalUser, roDontLogParameters);

+      roHideWizard, roRun32Bit, roRun64Bit, roRunAsOriginalUser,

+      roDontLogParameters, roLogOutput);

   end;

   end;

 

 

 const

 const

+ 10 - 1
Projects/Src/Undo.pas
Целия файл 

@@ -65,6 +65,7 @@ const
 
   utRun_ShellExecRespectWaitFlags = 128;

   utRun_ShellExecRespectWaitFlags = 128;

   utRun_DisableFsRedir = 256;

   utRun_DisableFsRedir = 256;

   utRun_DontLogParameters = 512;

   utRun_DontLogParameters = 512;

+  utRun_LogOutput = 1024;

   utDeleteFile_ExistedBeforeInstall = 1;

   utDeleteFile_ExistedBeforeInstall = 1;

   utDeleteFile_Extra = 2;

   utDeleteFile_Extra = 2;

   utDeleteFile_IsFont = 4;

   utDeleteFile_IsFont = 4;

@@ -549,6 +550,13 @@ begin
 
   end;

   end;

 end;

 end;

 

 

+procedure RunExecLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);

+begin

+  if not Error and FirstLine then

+    Log('Running Exec output:');

+  Log(S);

+end;

+

 function TUninstallLog.PerformUninstall(const CallFromUninstaller: Boolean;

 function TUninstallLog.PerformUninstall(const CallFromUninstaller: Boolean;

   const DeleteUninstallDataFilesProc: TDeleteUninstallDataFilesProc): Boolean;

   const DeleteUninstallDataFilesProc: TDeleteUninstallDataFilesProc): Boolean;

 { Undoes all the changes in the uninstall list, in reverse order they were

 { Undoes all the changes in the uninstall list, in reverse order they were

@@ -808,7 +816,8 @@ begin
 
                    NewFileExistsRedir(CurRec^.ExtraData and utRun_DisableFsRedir <> 0, CurRecData[0]) then begin

                    NewFileExistsRedir(CurRec^.ExtraData and utRun_DisableFsRedir <> 0, CurRecData[0]) then begin

                   if not InstExec(CurRec^.ExtraData and utRun_DisableFsRedir <> 0,

                   if not InstExec(CurRec^.ExtraData and utRun_DisableFsRedir <> 0,

                      CurRecData[0], CurRecData[1], CurRecData[2], Wait,

                      CurRecData[0], CurRecData[1], CurRecData[2], Wait,

-                     ShowCmd, ProcessMessagesProc, ErrorCode) then begin

+                     ShowCmd, ProcessMessagesProc, GetLogActive and (CurRec^.ExtraData and utRun_LogOutput <> 0),

+                     RunExecLog, 0, ErrorCode) then begin

                     LogFmt('CreateProcess failed (%d).', [ErrorCode]);

                     LogFmt('CreateProcess failed (%d).', [ErrorCode]);

                     Result := False;

                     Result := False;

                   end

                   end

+ 11 - 7
whatsnew.htm
Целия файл 

@@ -112,17 +112,19 @@ end;</pre>
 
 </ul>

 </ul>

 <p><span class="head2">Support for Windows Vista, Windows Server 2008 and the Itanium processor architecture removed</span></p>

 <p><span class="head2">Support for Windows Vista, Windows Server 2008 and the Itanium processor architecture removed</span></p>

 <ul>

 <ul>

-  <li><b>OS requirements change:</b> Windows Vista and Windows Server 2008 are no longer supported. Windows 7 and Windows Server 2008 R2 are now the minimum supported operating systems. [Setup] section directive <tt>MinVersion</tt> still defaults to <tt>6.1sp1</tt>, so by default Setup will still not run versions of Windows 7 and Windows Server 2008 R2 which have not been updated.</li>

+  <li><b>OS requirements change:</b> Windows Vista and Windows Server 2008 are no longer supported. Windows 7 and Windows Server 2008 R2 are now the minimum supported operating systems. <tt>[Setup]</tt> section directive <tt>MinVersion</tt> still defaults to <tt>6.1sp1</tt>, so by default Setup will still not run versions of Windows 7 and Windows Server 2008 R2 which have not been updated.</li>

   <li>The Itanium processor architecture is no longer supported. The <tt>ia64</tt> platform identifier has been removed and instead Setup will always display an error message and exit if it's started on an Itanium system anyway.</li>

   <li>The Itanium processor architecture is no longer supported. The <tt>ia64</tt> platform identifier has been removed and instead Setup will always display an error message and exit if it's started on an Itanium system anyway.</li>

-  <li>Removed [Icons] section flag <tt>foldershortcut</tt> which was already ignored except when running on Windows Vista or Windows Server 2008, as folder shortcuts do not expand properly on the Start Menu anymore.</li>

+  <li>Removed <tt>[Icons]</tt> section flag <tt>foldershortcut</tt> which was already ignored except when running on Windows Vista or Windows Server 2008, as folder shortcuts do not expand properly on the Start Menu anymore.</li>

 </ul>

 </ul>

 <p><span class="head2">Compiler IDE changes</span></p>

 <p><span class="head2">Compiler IDE changes</span></p>

 <ul>

 <ul>

   <li>The New Script Wizard now offers an option to import a Windows registry .reg file.</li>

   <li>The New Script Wizard now offers an option to import a Windows registry .reg file.</li>

   <li>The New Script Wizard now automatically sets <tt>ArchitecturesInstallIn64BitMode</tt> and <tt>ArchitecturesAllowed</tt> to <tt>x64compatible</tt> if it detects that the chosen main executable file is 64-bit. The default main executable file is now the 64-bit MyProg-x64.exe example executable instead of 32-bit MyProg.exe.</li>

   <li>The New Script Wizard now automatically sets <tt>ArchitecturesInstallIn64BitMode</tt> and <tt>ArchitecturesAllowed</tt> to <tt>x64compatible</tt> if it detects that the chosen main executable file is 64-bit. The default main executable file is now the 64-bit MyProg-x64.exe example executable instead of 32-bit MyProg.exe.</li>

-  <li>Added new <i>Generate [Registry] Entries... (Ctrl+Shift+R)</i> menu item to the <i>Tools</i> menu to import a Windows registry .reg file as extra entries to the [Registry] section at the cursor position, or to a new section.</li>

-  <li>Added new <i>Generate [Files] Entries... (Ctrl+Shift+I)</i> menu item to the <i>Tools</i> menu to design and insert extra entries to the [Files] section at the cursor position, or to a new section.</li>

+  <li>Added new <i>Generate [Registry] Entries... (Ctrl+Shift+R)</i> menu item to the <i>Tools</i> menu to import a Windows registry .reg file as extra entries to the <tt>[Registry]</tt> section at the cursor position, or to a new section.</li>

+  <li>Added new <i>Generate [Files] Entries... (Ctrl+Shift+I)</i> menu item to the <i>Tools</i> menu to design and insert extra entries to the <tt>[Files]</tt> section at the cursor position, or to a new section.</li>

   <li>The <i>Generate MsgBox/TaskDialogMsgBox Call... (Ctrl+Shift+M)</i> tool (previously named <i>MsgBox/TaskDialogMsgBox Designer</i>) now respects the tab width and tab character settings, indents the generated Pascal script one extra level, and warns if the cursor position is not in the [Code] section.</li>

   <li>The <i>Generate MsgBox/TaskDialogMsgBox Call... (Ctrl+Shift+M)</i> tool (previously named <i>MsgBox/TaskDialogMsgBox Designer</i>) now respects the tab width and tab character settings, indents the generated Pascal script one extra level, and warns if the cursor position is not in the [Code] section.</li>

+  <li>Digital signing change: Sign Tool output is now always logged in the "Compiler Output" view, making it easier to debug issues.</li>

+  <li>ISPP change: Output of programs executed using the <tt>Exec</tt> support function is now logged in the "Compiler Output" view by default. This can be disabled via a new sixth parameter.</li>

   <li>Added dark mode support to the title bar on Windows 10 Version 2004 and later.</i>

   <li>Added dark mode support to the title bar on Windows 10 Version 2004 and later.</i>

   <li>Added dark mode support to the main menu bar on all versions of Windows.</i>

   <li>Added dark mode support to the main menu bar on all versions of Windows.</i>

   <li>Added dark mode support to the menus on Windows 10 Version 1903 and later up to Windows 11 Version 23H2 which is currently the latest version of Windows 11.</i>

   <li>Added dark mode support to the menus on Windows 10 Version 1903 and later up to Windows 11 Version 23H2 which is currently the latest version of Windows 11.</i>

@@ -132,13 +134,15 @@ end;</pre>
 
 </ul>

 </ul>

 <p><span class="head2">Other changes</span></p>

 <p><span class="head2">Other changes</span></p>

 <ul>

 <ul>

-  <li>Added new [Setup] section directive <tt>UninstallLogging</tt>, which defaults to <tt>no</tt>. If set to <tt>yes</tt>, the uninstaller will always create a log file if it is launched from the <i>Add/Remove Programs</i> Control Panel applet. Equivalent to passing /LOG on the command line.</li>

-  <li>Added new [Files] section flags <tt>signcheck</tt>. Instructs the compiler check the original source files for a digital signature before storing them.</li>

+  <li>Console-mode compiler (ISCC) change: Added support for Unicode output.</li>

+  <li>Added new <tt>[Run]</tt> and <tt>[UninstallRun]</tt> section flag <tt>logoutput</tt>. Instructs Setup and Uninstall to log the output of the executed program. Cannot be combined with the <tt>nowait</tt>, <tt>runasoriginaluser</tt>, <tt>shellexec</tt>, and <tt>waituntilidle</tt> flags. Has no effect if logging is not enabled.</li>

+  <li>Pascal Scripting change: Added new <tt>ExecAndLogOutput</tt> support function. Can be used to log the output of the executed program to Setup and Uninstall's log, or to receive the output line by line in your own <tt>[Code]</tt> function.</li>

+  <li>Added new <tt>[Setup]</tt> section directive <tt>UninstallLogging</tt>, which defaults to <tt>no</tt>. If set to <tt>yes</tt>, the uninstaller will always create a log file if it is launched from the <i>Add/Remove Programs</i> Control Panel applet. Equivalent to passing /LOG on the command line.</li>

+  <li>Added new <tt>[Files]</tt> section flag <tt>signcheck</tt>. Instructs the compiler check the original source files for a digital signature before storing them.</li>

   <li>During startup Setup would always ask Windows to create any missing <tt>{usercf}</tt>, <tt>{userpf}</tt>, and <tt>{usersavedgames}</tt> folders. It no longer does until the script asks for the folder. Note that scripts running in administrative install mode should not do this because it violates the <a href="ishelp/index.php?topic=setup_useduserareaswarning">used user areas warning</a>.</li>

   <li>During startup Setup would always ask Windows to create any missing <tt>{usercf}</tt>, <tt>{userpf}</tt>, and <tt>{usersavedgames}</tt> folders. It no longer does until the script asks for the folder. Note that scripts running in administrative install mode should not do this because it violates the <a href="ishelp/index.php?topic=setup_useduserareaswarning">used user areas warning</a>.</li>

   <li>Added support for IIS group users identifiers (<tt>iisiusrs</tt>) for use in <tt>Permissions</tt> parameters.</li> 

   <li>Added support for IIS group users identifiers (<tt>iisiusrs</tt>) for use in <tt>Permissions</tt> parameters.</li> 

   <li>Pascal Scripting change: Type <tt>TShellFolderID</tt> was removed because it wasn't used by any support function.</li>

   <li>Pascal Scripting change: Type <tt>TShellFolderID</tt> was removed because it wasn't used by any support function.</li>

   <li>Improved the icons used by the <i>Select Language</i> dialog and the <i>Select Destination Location</i>, <i>Select Start Menu Folder</i>, and <i>Preparing to Install</i> wizard pages at 150% DPI and at 200% DPI.</li>

   <li>Improved the icons used by the <i>Select Language</i> dialog and the <i>Select Destination Location</i>, <i>Select Start Menu Folder</i>, and <i>Preparing to Install</i> wizard pages at 150% DPI and at 200% DPI.</li>

-  <li>Console-mode compiler (ISCC) change: Added support for Unicode output.</li>

   <li>Added modern icons to the MyProg example executables, now compiled with Visual Studio 2022.</li>

   <li>Added modern icons to the MyProg example executables, now compiled with Visual Studio 2022.</li>

   <li>Added official Korean translation.</li>

   <li>Added official Korean translation.</li>

   <li>Inno Setup is now built using Delphi 11.3 Alexandria instead of Delphi 10.3 Rio.</li>

   <li>Inno Setup is now built using Delphi 11.3 Alexandria instead of Delphi 10.3 Rio.</li>