首页 发现 帮助
登录
pascal
/
innosetup
镜像自地址 https://github.com/jrsoftware/issrc.git
2
0
派生 0
文件 工单管理 0 Wiki
浏览代码

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

-  Copyright (C) 1997-2020 Jordan Russell

+  Copyright (C) 1997-2024 Jordan Russell

   Portions by Martijn Laan

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

 

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

     (Name: 'WorkingDir'));

 

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

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

     (Name: '32bit'),

     (Name: '64bit'),

     (Name: 'dontlogparameters'),

     (Name: 'hidewizard'),

+    (Name: 'logoutput'),

     (Name: 'nowait'),

     (Name: 'postinstall'),

     (Name: 'runascurrentuser'),

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

     (Name: 'WorkingDir'));

 

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

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

     (Name: '32bit'),

     (Name: '64bit'),

     (Name: 'dontlogparameters'),

     (Name: 'hidewizard'),

+    (Name: 'logoutput'),

     (Name: 'nowait'),

     (Name: 'runascurrentuser'),

     (Name: 'runhidden'),

+ 8 - 0
ISHelp/isetup.xml
查看文件 

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

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

 </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">

 <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>

@@ -4479,6 +4483,8 @@ UninstallDisplayIcon={app}\MyProg.exe,1
 
 <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>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>

 </setuptopic>

 

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

 <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><b>See also:</b><br/>

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

 </body>

 </setuptopic>

+ 16 - 3
ISHelp/isxfunc.xml
查看文件 

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

         <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>

-        <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

   I: Integer;

 begin

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

   end;

 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>

         <name>ExecAsOriginalUser</name>

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

         <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>

-        <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>

     </subcategory>

   </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">

 				<title>Exec</title>

 				<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>

 				<description>

 					<para>Executes specified executable file.</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>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>

 				</description>

 			</topic>

+ 83 - 44
Projects/ISPP/IsppFuncs.pas
查看文件 

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

 

 uses

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

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

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

   

 var

   IsWin64: Boolean;

 

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

-var

-  Preprocessor: TPreprocessor;

 begin

-  Preprocessor := TObject(Ext) as TPreprocessor;

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

   Result := PathExpand(Preprocessor.PrependDirName(Filename,

     Preprocessor.SourcePath));

 end;

@@ -632,16 +630,16 @@ begin
 
   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

   CmdLine: String;

   WorkingDirP: PChar;

   StartupInfo: TStartupInfo;

   ProcessInfo: TProcessInformation;

 begin

-  Result := True;

   CmdLine := Filename + ' ' + Params;

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

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

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

   else

     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 }

-    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

           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;

 

@@ -689,33 +719,42 @@ begin
 
   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;

   const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;

-var

-  P, W: string;

-  Wait, S: Integer;

-  Success: Boolean;

-  R: Cardinal;

 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

     with IInternalFuncParams(Params) do

     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)

       else

-        MakeInt(ResPtr^, R);

+        MakeInt(ResPtr^, ResultCode);

     end;

   except

     on E: Exception do

+ 165 - 0
Projects/Src/CmnFunc2.pas
查看文件 

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

   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);

 const

   RegViews64Bit = [rv64Bit];

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

 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.

+ 1 - 0
Projects/Src/CompMsgs.pas
查看文件 

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

   SCompilerParamFlagMissing = 'Flag "%s" must be used if flag "%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 }

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

+ 60 - 22
Projects/Src/Compile.pas
查看文件 

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

     (Name: ParamCommonMinVersion; Flags: []),

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

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

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

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

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

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

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

-    'runascurrentuser', 'dontlogparameters');

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

 var

   Values: array[TParam] of TParamValue;

   NewRunEntry: PSetupRunEntry;

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

           17: RunAsCurrentUser := True;

           18: Include(Options, roDontLogParameters);

+          19: Include(Options, roLogOutput);

         end;

 

       if not WaitFlagSpecified then begin

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

         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 }

       Name := Values[paFilename].Data;

 

@@ -7280,6 +7296,14 @@ begin
 
   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);

 

   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;

-  

+

   procedure InternalSignCommand(const AFormattedCommand: String;

     const Delay: Cardinal);

   var

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

     StartupInfo.dwFlags := STARTF_USESHOWWINDOW;

     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

-      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;

+        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;

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

-        AbortCompile('Sign: GetExitCodeProcess failed');

-      if ExitCode <> 0 then

-        AbortCompileFmt(SCompilerSignToolNonZeroExitCode, [ExitCode]);

     finally

-      CloseHandle(ProcessInfo.hProcess);

+      OutputReader.Free;

     end;

   end;

+ 49 - 26
Projects/Src/InstFunc.pas
查看文件 

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

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

   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;

   const Wait: TExecWait; const ShowCmd: Integer;

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

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

 uses

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

-  Hash, Classes, RegStr;

+  Hash, Classes, RegStr, Math;

 

 procedure InternalError(const Id: String);

 begin

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

 

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

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

+  const ProcessMessagesProc: TProcedure; const OutputReader: TCreateProcessOutputReader;

+  var ResultCode: Integer);

 begin

   try

     if Wait = ewWaitUntilIdle then begin

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

     if Wait = ewWaitUntilTerminated then begin

       { 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

         { 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 terminate and new messages arrive simultaneously. (Can't leave

         unprocessed messages waiting, or a subsequent call to WaitMessage

         won't see them.) }

       ProcessMessagesProc;

+      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(ProcessHandle, DWORD(ResultCode)) then

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

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

   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

   CmdLine: String;

   StartupInfo: TStartupInfo;

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

     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;

 

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

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

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

   if Info.hProcess <> 0 then

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

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

 end;

 

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

 

   function MutexPos(const S: String): Integer;

-  var

-    I: Integer;

   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;

   end;

+ 2 - 0
Projects/Src/Install.pas
查看文件 

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

         if roDontLogParameters in RunEntry.Options then

           Flags := Flags or utRun_DontLogParameters;

+        if roLogOutput in RunEntry.Options then

+          Flags := Flags or utRun_LogOutput;

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

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

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

+ 8 - 4
Projects/Src/Logging.pas
查看文件 

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

 {

   Inno Setup

-  Copyright (C) 1997-2007 Jordan Russell

+  Copyright (C) 1997-2024 Jordan Russell

   Portions by Martijn Laan

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

 

   Logging functions

-

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

 }

 

 interface

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

 procedure StartLoggingWithFixedFilename(const Filename: String);

 function GetLogFileName: String;

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

 

 const

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

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

 end;

 

+function GetLogActive: Boolean;

+begin

+  Result := Assigned(LogFile) or Debugging;

+end;

+

 procedure Log(const S: String);

 

   procedure WriteStr(const S: String);

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

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

 begin

-  if Assigned(LogFile) or Debugging then

+  if GetLogActive then

     Log(Format(S, Args));

 end;

+ 9 - 1
Projects/Src/Main.pas
查看文件 

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

 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);

 begin

   CurStep := AStep;

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

         if not InstExecEx(RunAsOriginalUser, DisableFsRedir, ExpandedFilename,

            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) +

             SNewLine2 + FmtSetupMessage(msgErrorFunctionFailedWithMessage,

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

+ 2 - 1
Projects/Src/ScriptFunc.pas
查看文件 

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

 

   { InstFunc }

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

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

   (

     'function CheckForMutexes(Mutexes: 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;

     '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 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 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;',

+ 1 - 0
Projects/Src/ScriptFunc_C.pas
查看文件 

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

 

   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(NewDiskTable);

+ 45 - 11
Projects/Src/ScriptFunc_R.pas
查看文件 

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

   NewOutputMarqueeProgressPage: TOutputMarqueeProgressWizardPage;

   NewDownloadPage: TDownloadWizardPage;

-  P: PPSVariantProcPtr;

   OnDownloadProgress: TOnDownloadProgress;

   NewSetupForm: TSetupForm;

 begin

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

     if IsUninstaller then

       NoUninstallFuncError(Proc.Name);

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

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

     { ProcNo 0 means nil was passed by the script }

     if P.ProcNo <> 0 then

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

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

 var

   PStart: Cardinal;

-  P: PPSVariantProcPtr;

   OnDownloadProgress: TOnDownloadProgress;

 begin

   if IsUninstaller then

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

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

   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 }

     if P.ProcNo <> 0 then

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

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

 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;

 var

   PStart: Cardinal;

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

   ResultCode, ErrorCode: Integer;

   FreeBytes, TotalBytes: Integer64;

-  RunAsOriginalUser: Boolean;

 begin

   PStart := Stack.Count-1;

   Result := True;

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

     else

       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

-      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);

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

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

         Stack.SetBool(PStart, InstExecEx(RunAsOriginalUser,

           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

         WindowDisabler.Free;

       end;

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

     end;

   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

       NoUninstallFuncError(Proc.Name);

+ 7 - 5
Projects/Src/SpawnClient.pas
查看文件 

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

 

 uses

-  Windows, SysUtils, Messages, InstFunc;

+  Windows, SysUtils, Messages, InstFunc, CmnFunc2;

 

 procedure InitializeSpawnClient(const AServerWnd: HWND);

 function InstExecEx(const RunAsOriginalUser: Boolean;

   const DisableFsRedir: Boolean; const Filename, Params, 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 InstShellExecEx(const RunAsOriginalUser: Boolean;

   const Verb, Filename, Params, WorkingDir: String;

   const Wait: TExecWait; const ShowCmd: Integer;

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

 

 uses

-  Classes, CmnFunc2, SpawnCommon;

+  Classes, SpawnCommon;

 

 var

   SpawnServerPresent: Boolean;

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

   const DisableFsRedir: Boolean; const Filename, Params, 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

   M: TMemoryStream;

 begin

   if not RunAsOriginalUser or not SpawnServerPresent then begin

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

-      Wait, ShowCmd, ProcessMessagesProc, ResultCode);

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

     Exit;

   end;

+ 1 - 1
Projects/Src/SpawnServer.pas
查看文件 

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

       else begin

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

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

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

       end;

       if ExecResult then

         FCallStatus := SPAWN_STATUS_RETURNED_TRUE

+ 2 - 1
Projects/Src/Struct.pas
查看文件 

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

     Options: set of (roShellExec, roSkipIfDoesntExist,

       roPostInstall, roUnchecked, roSkipIfSilent, roSkipIfNotSilent,

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

+      roHideWizard, roRun32Bit, roRun64Bit, roRunAsOriginalUser,

+      roDontLogParameters, roLogOutput);

   end;

 

 const

+ 10 - 1
Projects/Src/Undo.pas
查看文件 

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

   utRun_DisableFsRedir = 256;

   utRun_DontLogParameters = 512;

+  utRun_LogOutput = 1024;

   utDeleteFile_ExistedBeforeInstall = 1;

   utDeleteFile_Extra = 2;

   utDeleteFile_IsFont = 4;

@@ -549,6 +550,13 @@ begin
 
   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;

   const DeleteUninstallDataFilesProc: TDeleteUninstallDataFilesProc): Boolean;

 { 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

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

                      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]);

                     Result := False;

                   end

+ 11 - 7
whatsnew.htm
查看文件 

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

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

 <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>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>

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

 <ul>

   <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>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>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 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>

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

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

 <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>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>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 official Korean translation.</li>

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