Ver Fonte

Finish. So now the functions which were in InstFunc but were not used by SetupLdr are in a Setup-only unit (Setup.InstFunc) and the rest is in a shared unit (SetupLdrAndSetup.InstFunc). The former has most of the function and has the Git history. The latter appears as a new file.

Martijn Laan há 1 ano atrás
pai
commit
bd49a504c7

+ 1 - 0
Projects/Setup.dpr

@@ -27,6 +27,7 @@ uses
   Shared.Struct in 'Src\Shared.Struct.pas',
   Setup.NewDiskForm in 'Src\Setup.NewDiskForm.pas' {NewDiskForm},
   SetupLdrAndSetup.InstFunc in 'Src\SetupLdrAndSetup.InstFunc.pas',
+  Setup.InstFunc in 'Src\Setup.InstFunc.pas',
   Setup.InstFunc.Ole in 'Src\Setup.InstFunc.Ole.pas',
   Setup.WizardForm in 'Src\Setup.WizardForm.pas' {WizardForm},
   Setup.ScriptFunc in 'Src\Setup.ScriptFunc.pas',

+ 1 - 0
Projects/Setup.dproj

@@ -90,6 +90,7 @@
             <Form>NewDiskForm</Form>
         </DCCReference>
         <DCCReference Include="Src\SetupLdrAndSetup.InstFunc.pas"/>
+        <DCCReference Include="Src\Setup.InstFunc.pas"/>
         <DCCReference Include="Src\Setup.InstFunc.Ole.pas"/>
         <DCCReference Include="Src\Setup.WizardForm.pas">
             <Form>WizardForm</Form>

+ 1 - 1
Projects/Src/Setup.DebugClient.pas

@@ -36,7 +36,7 @@ procedure SetDebugServerWnd(Wnd: HWND; WantCodeText: Boolean);
 implementation
 
 uses
-  Forms, Classes, Shared.CommonFunc, Shared.Struct, SetupLdrAndSetup.InstFunc, Setup.MainForm;
+  Forms, Classes, Shared.CommonFunc, Shared.Struct, Setup.InstFunc, Setup.MainForm;
 
 type
   TDummyClass = class

+ 1 - 1
Projects/Src/Setup.DotNetFunc.pas

@@ -61,7 +61,7 @@ function IsDotNetInstalled(const RegView: TRegView; const MinVersion: TDotNetVer
 implementation
 
 uses
-  SetupLdrAndSetup.InstFunc, PathFunc;
+  Setup.InstFunc, PathFunc;
 
 var
   DotNetRoot: array [TRegView] of String;

+ 1 - 1
Projects/Src/Setup.FileExtractor.pas

@@ -51,7 +51,7 @@ implementation
 
 uses
   PathFunc, Shared.CommonFunc, Setup.MainForm, SetupLdrAndSetup.Messages, Shared.SetupMessageIDs,
-  SetupLdrAndSetup.InstFunc, Compression.Zlib, Compression.bzlib,
+  Setup.InstFunc, Compression.Zlib, Compression.bzlib,
   Compression.LZMADecompressor, SHA1, Setup.LoggingFunc, Setup.NewDiskForm;
 
 var

+ 1 - 1
Projects/Src/Setup.Helper.pas

@@ -31,7 +31,7 @@ implementation
 {x$DEFINE HELPERDEBUG}
 
 uses
-  Forms, Shared.Int64Em, Shared.CommonFunc.Vcl, Shared.CommonFunc, PathFunc, Setup.MainForm, SetupLdrAndSetup.InstFunc,
+  Forms, Shared.Int64Em, Shared.CommonFunc.Vcl, Shared.CommonFunc, PathFunc, Setup.MainForm, Setup.InstFunc,
   Setup.LoggingFunc, SetupLdrAndSetup.Messages, Shared.SetupMessageIDs;
 
 const

+ 1 - 1
Projects/Src/Setup.InstFunc.Ole.pas

@@ -23,7 +23,7 @@ function UnpinShellLink(const Filename: String): Boolean;
 implementation
 
 uses
-  Windows, SysUtils, PathFunc, Shared.CommonFunc, SetupLdrAndSetup.InstFunc, Setup.MainForm,
+  Windows, SysUtils, PathFunc, Shared.CommonFunc, Setup.InstFunc, Setup.MainForm,
   SetupLdrAndSetup.Messages, Shared.SetupMessageIDs,
   ActiveX, ComObj, PropSys, ShellAPI, ShlObj;
 

+ 5 - 312
Projects/Src/Setup.InstFunc.pas

@@ -1,4 +1,4 @@
-unit SetupLdrAndSetup.InstFunc;
+unit Setup.InstFunc;
 
 {
   Inno Setup
@@ -6,13 +6,13 @@ unit SetupLdrAndSetup.InstFunc;
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
 
-  Misc. installation functions. Used only by the Setup and SetupLdr projects.
+  Misc. installation functions. Used only by the Setup project.
 }
 
 interface
 
 uses
-  Windows, SysUtils, Shared.Struct, Shared.Int64Em, MD5, SHA1, Shared.CommonFunc;
+  Windows, SysUtils, Shared.Int64Em, MD5, SHA1, Shared.CommonFunc;
 
 type
   PSimpleStringListArray = ^TSimpleStringListArray;
@@ -44,30 +44,17 @@ type
   { Must keep this in synch with Compiler.ScriptFunc.pas: }
   TExecWait = (ewNoWait, ewWaitUntilTerminated, ewWaitUntilIdle);
 
-  TDetermineDefaultLanguageResult = (ddNoMatch, ddMatch, ddMatchLangParameter);
-  TGetLanguageEntryProc = function(Index: Integer; var Entry: PSetupLanguageEntry): Boolean;
-
 function CheckForMutexes(const Mutexes: String): Boolean;
 procedure CreateMutexes(const Mutexes: String);
-function CreateTempDir(const LimitCurrentUserSidAccess: Boolean;
-  var Protected: Boolean): String; overload;
-function CreateTempDir(const LimitCurrentUserSidAccess: Boolean): String; overload;
 function DecrementSharedCount(const RegView: TRegView; const Filename: String): Boolean;
-procedure DelayDeleteFile(const DisableFsRedir: Boolean; const Filename: String;
-  const MaxTries, FirstRetryDelayMS, SubsequentRetryDelayMS: Integer);
 function DelTree(const DisableFsRedir: Boolean; const Path: String;
   const IsDir, DeleteFiles, DeleteSubdirsAlso, BreakOnError: Boolean;
   const DeleteDirProc: TDeleteDirProc; const DeleteFileProc: TDeleteFileProc;
   const Param: Pointer): Boolean;
-function DetermineDefaultLanguage(const GetLanguageEntryProc: TGetLanguageEntryProc;
-  const Method: TSetupLanguageDetectionMethod; const LangParameter: String;
-  var ResultIndex: Integer): TDetermineDefaultLanguageResult;
 procedure EnumFileReplaceOperationsFilenames(const EnumFunc: TEnumFROFilenamesProc;
   Param: Pointer);
 function GenerateNonRandomUniqueTempDir(const LimitCurrentUserSidAccess: Boolean;
   Path: String; var TempDir: String): Boolean;
-function GenerateUniqueName(const DisableFsRedir: Boolean; Path: String;
-  const Extension: String): String;
 function GetComputerNameString: String;
 function GetFileDateTime(const DisableFsRedir: Boolean; const Filename: String;
   var DateTime: TFileTime): Boolean;
@@ -108,7 +95,6 @@ procedure RefreshEnvironment;
 function ReplaceSystemDirWithSysWow64(const Path: String): String;
 function ReplaceSystemDirWithSysNative(Path: String; const IsWin64: Boolean): String;
 procedure UnregisterFont(const FontName, FontFilename: String; const PerUserFont: Boolean);
-function RestartComputer: Boolean;
 procedure RestartReplace(const DisableFsRedir: Boolean; TempFile, DestFile: String);
 procedure SplitNewParamStr(const Index: Integer; var AName, AValue: String);
 procedure Win32ErrorMsg(const FunctionName: String);
@@ -118,7 +104,8 @@ function ForceDirectories(const DisableFsRedir: Boolean; Dir: String): Boolean;
 implementation
 
 uses
-  Messages, ShellApi, PathFunc, SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Shared.FileClass, SetupLdrAndSetup.RedirFunc, Shared.SetupTypes,
+  Messages, ShellApi, PathFunc, SetupLdrAndSetup.InstFunc, SetupLdrAndSetup.Messages,
+  Shared.SetupMessageIDs, Shared.FileClass, SetupLdrAndSetup.RedirFunc, Shared.SetupTypes,
   Hash, Classes, RegStr, Math;
 
 procedure InternalError(const Id: String);
@@ -171,132 +158,6 @@ begin
   end;
 end;
 
-function ConvertStringSecurityDescriptorToSecurityDescriptorW(
-  StringSecurityDescriptor: PWideChar;
-  StringSDRevision: DWORD; var ppSecurityDescriptor: Pointer;
-  dummy: Pointer): BOOL; stdcall; external advapi32;
-
-function CreateSafeDirectory(const LimitCurrentUserSidAccess: Boolean; Path: String;
-  var ErrorCode: DWORD; out Protected: Boolean): Boolean; overload;
-{ Creates a protected directory if
-  -permissions are supported
-  -it's a subdirectory of c:\WINDOWS\TEMP, or
-  -it's on a local drive and LimitCurrentUserSidAccess is True (latter is true atm if elevated and not debugging)
-  otherwise creates a normal directory. }
-const
-  SDDL_REVISION_1 = 1;
-begin
-  Path := PathExpand(Path);
-  var Drive := PathExtractDrive(Path);
-  var FileSystemFlags: DWORD;
-
-  if GetVolumeInformation(PChar(AddBackslash(Drive)), nil, 0, nil, DWORD(nil^), FileSystemFlags, nil, 0) and
-     ((FileSystemFlags and FILE_PERSISTENT_ACLS) <> 0) then begin
-    var IsUnderWindowsTemp := Pos(PathLowercase(AddBackslash(GetSystemWinDir) + 'TEMP\'),
-      PathLowercase(Path)) = 1;
-    var IsLocalTempToProtect := LimitCurrentUserSidAccess and (Drive <> '') and
-      not PathCharIsSlash(Drive[1]) and
-      (GetDriveType(PChar(AddBackslash(Drive))) <> DRIVE_REMOTE);
-    Protected := IsUnderWindowsTemp or IsLocalTempToProtect;
-  end else
-    Protected := False;
-
-  if Protected then begin
-    var StringSecurityDescriptor :=
-      // D: adds a Discretionary ACL ("DACL", i.e. access control via SIDs)
-      // P: prevents DACL from being modified by inheritable ACEs
-      // AI: says automatic propagation of inheritable ACEs to child objects
-      //     is supported; always supposed to be set on Windows 2000+ ACLs
-      'D:PAI';
-    var CurrentUserSid := GetCurrentUserSid;
-    if CurrentUserSid = '' then
-      CurrentUserSid := 'OW'; // OW: owner rights
-    { Omit the CurrentUserSid ACE if the current user is SYSTEM, because
-      there's already a fixed Full Control ACE for SYSTEM below }
-    if not SameText(CurrentUserSid, 'S-1-5-18') then begin
-      // A: "allow"
-      // OICI: "object and container inherit",
-      //    i.e. files and directories created within the new directory
-      //    inherit these permissions
-      var AccessRights := 'FA'; // FILE_ALL_ACCESS (Full Control)
-      if LimitCurrentUserSidAccess then
-        AccessRights := 'FRFX'; // FILE_GENERIC_READ | FILE_GENERIC_EXECUTE
-      StringSecurityDescriptor := StringSecurityDescriptor +
-        '(A;OICI;' + AccessRights + ';;;' + CurrentUserSid + ')'; // current user
-    end;
-    StringSecurityDescriptor := StringSecurityDescriptor +
-      '(A;OICI;FA;;;BA)' + // BA: built-in Administrators group
-      '(A;OICI;FA;;;SY)'; // SY: local SYSTEM account
-
-    var pSecurityDescriptor: Pointer;
-    if not ConvertStringSecurityDescriptorToSecurityDescriptorW(
-      PWideChar(StringSecurityDescriptor), SDDL_REVISION_1, pSecurityDescriptor, nil
-    ) then begin
-      ErrorCode := GetLastError;
-      Result := False;
-      Exit;
-    end;
-
-    var SecurityAttr: TSecurityAttributes;
-    SecurityAttr.nLength := SizeOf(SecurityAttr);
-    SecurityAttr.bInheritHandle := False;
-    SecurityAttr.lpSecurityDescriptor := pSecurityDescriptor;
-
-    Result := CreateDirectory(PChar(Path), @SecurityAttr);
-    if not Result then
-      ErrorCode := GetLastError;
-
-    LocalFree(pSecurityDescriptor);
-  end else begin
-    Result := CreateDirectory(PChar(Path), nil);
-    if not Result then
-      ErrorCode := GetLastError;
-  end;
-end;
-
-function CreateSafeDirectory(const LimitCurrentUserSidAccess: Boolean; Path: String;
-  var ErrorCode: DWORD): Boolean; overload;
-begin
-  var Protected: Boolean;
-  Result := CreateSafeDirectory(LimitCurrentUserSidAccess, Path, ErrorCode, Protected);
-end;
-
-function IntToBase32(Number: Longint): String;
-const
-  Table: array[0..31] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUV';
-var
-  I: Integer;
-begin
-  Result := '';
-  for I := 0 to 4 do begin
-    Insert(Table[Number and 31], Result, 1);
-    Number := Number shr 5;
-  end;
-end;
-
-function GenerateUniqueName(const DisableFsRedir: Boolean; Path: String;
-  const Extension: String): String;
-var
-  Rand, RandOrig: Longint;
-  Filename: String;
-begin
-  Path := AddBackslash(Path);
-  RandOrig := Random($2000000);
-  Rand := RandOrig;
-  repeat
-    Inc(Rand);
-    if Rand > $1FFFFFF then Rand := 0;
-    if Rand = RandOrig then
-      { practically impossible to go through 33 million possibilities,
-        but check "just in case"... }
-      raise Exception.Create(FmtSetupMessage1(msgErrorTooManyFilesInDir,
-        RemoveBackslashUnlessRoot(Path)));
-    { Generate a random name }
-    Filename := Path + 'is-' + IntToBase32(Rand) + Extension;
-  until not FileOrDirExistsRedir(DisableFsRedir, Filename);
-  Result := Filename;
-end;
-
 function GenerateNonRandomUniqueTempDir(const LimitCurrentUserSidAccess: Boolean;
   Path: String; var TempDir: String): Boolean;
 { Creates a new temporary directory with a non-random name. Returns True if an
@@ -335,31 +196,6 @@ begin
   until False; // continue until a new directory was created
 end;
 
-function CreateTempDir(const LimitCurrentUserSidAccess: Boolean;
-  var Protected: Boolean): String;
-{ This is called by SetupLdr, Setup, and Uninstall. }
-var
-  Dir: String;
-  ErrorCode: DWORD;
-begin
-  while True do begin
-    Dir := GenerateUniqueName(False, GetTempDir, '.tmp');
-    if CreateSafeDirectory(LimitCurrentUserSidAccess, Dir, ErrorCode, Protected) then
-      Break;
-    if ErrorCode <> ERROR_ALREADY_EXISTS then
-      raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
-        [FmtSetupMessage1(msgErrorCreatingDir, Dir), IntToStr(ErrorCode),
-         Win32ErrorString(ErrorCode)]));
-  end;
-  Result := Dir;
-end;
-
-function CreateTempDir(const LimitCurrentUserSidAccess: Boolean): String;
-begin
-  var Protected: Boolean;
-  Result := CreateTempDir(LimitCurrentUserSidAccess, Protected);
-end;
-
 function ReplaceSystemDirWithSysWow64(const Path: String): String;
 { If the user is running 64-bit Windows and Path begins with
   'x:\windows\system32' it replaces it with 'x:\windows\syswow64', like the
@@ -1107,67 +943,6 @@ begin
     Result := '';
 end;
 
-{ Work around problem in D2's declaration of the function }
-function NewAdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL;
-  const NewState: TTokenPrivileges; BufferLength: DWORD;
-  PreviousState: PTokenPrivileges; ReturnLength: PDWORD): BOOL; stdcall;
-  external advapi32 name 'AdjustTokenPrivileges';
-
-function RestartComputer: Boolean;
-{ Restarts the computer. }
-var
-  Token: THandle;
-  TokenPriv: TTokenPrivileges;
-const
-  SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';  { don't localize }
-begin
-  if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
-     Token) then begin
-    Result := False;
-    Exit;
-  end;
-
-  LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME, TokenPriv.Privileges[0].Luid);
-
-  TokenPriv.PrivilegeCount := 1;
-  TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
-
-  NewAdjustTokenPrivileges(Token, False, TokenPriv, 0, nil, nil);
-
-  { Cannot test the return value of AdjustTokenPrivileges. }
-  if GetLastError <> ERROR_SUCCESS then begin
-    Result := False;
-    Exit;
-  end;
-
-  Result := ExitWindowsEx(EWX_REBOOT, 0);
-
-  { ExitWindowsEx returns True immediately. The system then asynchronously
-    sends WM_QUERYENDSESSION messages to all processes, including the current
-    process. The current process is not killed until it has received
-    WM_QUERYENDSESSION and WM_ENDSESSION messages. }
-end;
-
-procedure DelayDeleteFile(const DisableFsRedir: Boolean; const Filename: String;
-  const MaxTries, FirstRetryDelayMS, SubsequentRetryDelayMS: Integer);
-{ Attempts to delete Filename up to MaxTries times, retrying if the file is
-  in use. It sleeps FirstRetryDelayMS msec after the first try, and
-  SubsequentRetryDelayMS msec after subsequent tries. }
-var
-  I: Integer;
-begin
-  for I := 0 to MaxTries-1 do begin
-    if I = 1 then
-      Sleep(FirstRetryDelayMS)
-    else if I > 1 then
-      Sleep(SubsequentRetryDelayMS);
-    if DeleteFileRedir(DisableFsRedir, Filename) or
-       (GetLastError = ERROR_FILE_NOT_FOUND) or
-       (GetLastError = ERROR_PATH_NOT_FOUND) then
-      Break;
-  end;
-end;
-
 function MakePendingFileRenameOperationsChecksum: TMD5Digest;
 { Calculates a checksum of the current PendingFileRenameOperations registry
   value The caller can use this checksum to determine if
@@ -1361,88 +1136,6 @@ begin
   AValue := '';
 end;
 
-function DetermineDefaultLanguage(const GetLanguageEntryProc: TGetLanguageEntryProc;
-  const Method: TSetupLanguageDetectionMethod; const LangParameter: String;
-  var ResultIndex: Integer): TDetermineDefaultLanguageResult;
-{ Finds the index of the language entry that most closely matches the user's
-  UI language / locale. If no match is found, ResultIndex is set to 0. }
-
-  function GetCodePageFromLangID(const ALangID: LANGID): Integer;
-  const
-    LOCALE_RETURN_NUMBER = $20000000;
-  var
-    CodePage: DWORD;
-  begin
-    if GetLocaleInfo(ALangID, LOCALE_IDEFAULTANSICODEPAGE or LOCALE_RETURN_NUMBER,
-       PChar(@CodePage), SizeOf(CodePage) div SizeOf(Char)) > 0 then
-      Result := Integer(CodePage)
-    else
-      Result := -1;
-  end;
-
-var
-  I: Integer;
-  LangEntry: PSetupLanguageEntry;
-  UILang: LANGID;
-begin
-  ResultIndex := 0;
-  Result := ddNoMatch;
-
-  if LangParameter <> '' then begin
-    { Use the language specified on the command line, if available }
-    I := 0;
-    while GetLanguageEntryProc(I, LangEntry) do begin
-      if CompareText(LangParameter, LangEntry.Name) = 0 then begin
-        ResultIndex := I;
-        Result := ddMatchLangParameter;
-        Exit;
-      end;
-      Inc(I);
-    end;
-  end;
-
-  case Method of
-    ldUILanguage: UILang := GetUILanguage;
-    ldLocale: UILang := GetUserDefaultLangID;
-  else
-    { ldNone }
-    UILang := 0;
-  end;
-  if UILang <> 0 then begin
-    { Look for a primary + sub language ID match }
-    I := 0;
-    while GetLanguageEntryProc(I, LangEntry) do begin
-      if LangEntry.LanguageID = UILang then begin
-        ResultIndex := I;
-        Result := ddMatch;
-        Exit;
-      end;
-      Inc(I);
-    end;
-    { Look for just a primary language ID match }
-    I := 0;
-    while GetLanguageEntryProc(I, LangEntry) do begin
-      if (LangEntry.LanguageID and $3FF) = (UILang and $3FF) then begin
-        { On Unicode, there is no LanguageCodePage filter, so we have to check
-          the language IDs to ensure we don't return Simplified Chinese on a
-          Traditional Chinese system, or vice versa.
-          If the default ANSI code pages associated with the language IDs are
-          equal, then there is no Simplified/Traditional discrepancy.
-           Simplified Chinese LANGIDs ($0804, $1004)        use CP 936
-          Traditional Chinese LANGIDs ($0404, $0C04, $1404) use CP 950 }
-        if ((UILang and $3FF) <> LANG_CHINESE) or
-           (GetCodePageFromLangID(LangEntry.LanguageID) = GetCodePageFromLangID(UILang)) then
-        begin
-          ResultIndex := I;
-          Result := ddMatch;
-          Exit;
-        end;
-      end;
-      Inc(I);
-    end;
-  end;
-end;
-
 function ForceDirectories(const DisableFsRedir: Boolean; Dir: String): Boolean;
 begin
   Dir := RemoveBackslashUnlessRoot(Dir);

+ 1 - 1
Projects/Src/Setup.Install.pas

@@ -29,7 +29,7 @@ implementation
 
 uses
   Windows, SysUtils, Messages, Classes, Forms, ShlObj, Shared.Struct, Setup.UninstallLog, Shared.SetupTypes,
-  SetupLdrAndSetup.InstFunc, Setup.InstFunc.Ole, Setup.SecurityFunc, SetupLdrAndSetup.Messages,
+  SetupLdrAndSetup.InstFunc, Setup.InstFunc, Setup.InstFunc.Ole, Setup.SecurityFunc, SetupLdrAndSetup.Messages,
   Setup.MainForm, Setup.LoggingFunc, Setup.FileExtractor, Shared.FileClass,
   Compression.Base, SHA1, PathFunc, Shared.CommonFunc.Vcl, Shared.CommonFunc, SetupLdrAndSetup.RedirFunc, Shared.Int64Em, Shared.SetupMessageIDs,
   Setup.WizardForm, Shared.DebugStruct, Setup.DebugClient, Shared.VerInfoFunc, Setup.ScriptRunner, Setup.RegDLL, Setup.Helper,

+ 8 - 4
Projects/Src/Setup.MainForm.pas

@@ -267,10 +267,14 @@ implementation
 
 uses
   ShellAPI, ShlObj, StrUtils,
-  SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.Install, SetupLdrAndSetup.InstFunc, Setup.InstFunc.Ole, SetupLdrAndSetup.RedirFunc, PathFunc,
-  Compression.Base, Compression.Zlib, Compression.bzlib, Compression.LZMADecompressor, Shared.ArcFour, Shared.SetupEntFunc, Setup.SelectLanguageForm,
-  Setup.WizardForm, Setup.DebugClient, Shared.VerInfoFunc, Setup.FileExtractor, Shared.FileClass, Setup.LoggingFunc, MD5, SHA1, ActiveX,
-  SimpleExpression, Setup.Helper, Setup.SpawnClient, Setup.SpawnServer, Setup.DotNetFunc, BitmapImage,
+  SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.Install, SetupLdrAndSetup.InstFunc,
+  Setup.InstFunc, Setup.InstFunc.Ole, SetupLdrAndSetup.RedirFunc, PathFunc,
+  Compression.Base, Compression.Zlib, Compression.bzlib, Compression.LZMADecompressor,
+  Shared.ArcFour, Shared.SetupEntFunc, Setup.SelectLanguageForm,
+  Setup.WizardForm, Setup.DebugClient, Shared.VerInfoFunc, Setup.FileExtractor,
+  Shared.FileClass, Setup.LoggingFunc, MD5, SHA1, ActiveX,
+  SimpleExpression, Setup.Helper, Setup.SpawnClient, Setup.SpawnServer,
+  Setup.DotNetFunc, BitmapImage,
   Shared.TaskDialogFunc, RegStr;
 
 {$R *.DFM}

+ 1 - 1
Projects/Src/Setup.RegDLL.pas

@@ -20,7 +20,7 @@ procedure RegisterServer(const AUnregister: Boolean; const AIs64Bit: Boolean;
 implementation
 
 uses
-  SysUtils, Forms, PathFunc, Shared.CommonFunc.Vcl, Shared.CommonFunc, SetupLdrAndSetup.InstFunc, SetupLdrAndSetup.Messages, Shared.SetupMessageIDs,
+  SysUtils, Forms, PathFunc, Shared.CommonFunc.Vcl, Shared.CommonFunc, Setup.InstFunc, SetupLdrAndSetup.Messages, Shared.SetupMessageIDs,
   Setup.LoggingFunc, SetupLdrAndSetup.RedirFunc, Setup.MainForm;
 
 function WaitForAndCloseProcessHandle(var AProcessHandle: THandle): DWORD;

+ 3 - 2
Projects/Src/Setup.RegSvr.pas

@@ -16,8 +16,9 @@ procedure RunRegSvr;
 implementation
 
 uses
-  Windows, SysUtils, Classes, Forms, PathFunc, Shared.CommonFunc, SetupLdrAndSetup.InstFunc, Setup.InstFunc.Ole,
-  Shared.FileClass, Shared.CommonFunc.Vcl, Shared.Struct, Setup.MainForm, SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.RegDLL, Setup.Helper;
+  Windows, SysUtils, Classes, Forms, PathFunc, Shared.CommonFunc, Setup.InstFunc, Setup.InstFunc.Ole,
+  Shared.FileClass, Shared.CommonFunc.Vcl, Shared.Struct, Setup.MainForm,
+  SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.RegDLL, Setup.Helper;
 
 procedure DeleteOldTempFiles(const Path: String);
 { Removes any old isRS-???.tmp files from Path. Not strictly necessary, but

+ 1 - 1
Projects/Src/Setup.ScriptDlg.pas

@@ -203,7 +203,7 @@ uses
   StrUtils,
   Shared.Struct, Setup.MainForm, Setup.SelectFolderForm, SetupLdrAndSetup.Messages,
   Shared.SetupMessageIDs, PathFunc, Shared.CommonFunc.Vcl, Shared.CommonFunc,
-  BrowseFunc, Setup.LoggingFunc, SetupLdrAndSetup.InstFunc;
+  BrowseFunc, Setup.LoggingFunc, Setup.InstFunc;
 
 const
   DefaultLabelHeight = 14;

+ 1 - 1
Projects/Src/Setup.ScriptFunc.pas

@@ -23,7 +23,7 @@ uses
   Forms, uPSUtils, SysUtils, Classes, Graphics, Controls, TypInfo, ActiveX,
   Shared.Struct, Setup.ScriptDlg, Setup.MainForm, PathFunc, Shared.CommonFunc.Vcl,
   Shared.CommonFunc, Shared.FileClass, SetupLdrAndSetup.RedirFunc,
-  Setup.Install, SetupLdrAndSetup.InstFunc, Setup.InstFunc.Ole, SetupLdrAndSetup.Messages,
+  Setup.Install, SetupLdrAndSetup.InstFunc, Setup.InstFunc, Setup.InstFunc.Ole, SetupLdrAndSetup.Messages,
   Shared.SetupMessageIDs, Setup.NewDiskForm, BrowseFunc, Setup.WizardForm, Shared.VerInfoFunc,
   Shared.SetupTypes, Shared.Int64Em, MD5, SHA1, Setup.LoggingFunc, Setup.SetupForm, Setup.RegDLL, Setup.Helper,
   Setup.SpawnClient, Setup.UninstallProgressForm, ASMInline, Setup.DotNetFunc,

+ 1 - 1
Projects/Src/Setup.SpawnClient.pas

@@ -15,7 +15,7 @@ unit Setup.SpawnClient;
 interface
 
 uses
-  Windows, SysUtils, Messages, SetupLdrAndSetup.InstFunc, Shared.CommonFunc;
+  Windows, SysUtils, Messages, Setup.InstFunc, Shared.CommonFunc;
 
 procedure InitializeSpawnClient(const AServerWnd: HWND);
 function InstExecEx(const RunAsOriginalUser: Boolean;

+ 1 - 1
Projects/Src/Setup.SpawnServer.pas

@@ -46,7 +46,7 @@ implementation
 {x$DEFINE SPAWNSERVER_RESPAWN_ALWAYS}
 
 uses
-  Classes, Forms, ShellApi, Shared.Int64Em, PathFunc, Shared.CommonFunc, SetupLdrAndSetup.InstFunc, Setup.SpawnCommon;
+  Classes, Forms, ShellApi, Shared.Int64Em, PathFunc, Shared.CommonFunc, Setup.InstFunc, Setup.SpawnCommon;
 
 type
   TPtrAndSize = record

+ 6 - 4
Projects/Src/Setup.Uninstall.pas

@@ -17,10 +17,12 @@ procedure HandleUninstallerEndSession;
 implementation
 
 uses
-  Windows, SysUtils, Messages, Forms, PathFunc, Shared.CommonFunc.Vcl, Shared.CommonFunc, Setup.UninstallLog, SetupLdrAndSetup.Messages,
-  Shared.SetupMessageIDs, SetupLdrAndSetup.InstFunc, Shared.Struct, Shared.SetupEntFunc, Setup.UninstallProgressForm, Setup.UninstallSharedFileForm,
-  Shared.FileClass, Setup.ScriptRunner, Setup.DebugClient, Shared.SetupTypes, Setup.LoggingFunc, Setup.MainForm,
-  Setup.SpawnServer;
+  Windows, SysUtils, Messages, Forms, PathFunc, Shared.CommonFunc.Vcl,
+  Shared.CommonFunc, Setup.UninstallLog, SetupLdrAndSetup.Messages,
+  Shared.SetupMessageIDs, SetupLdrAndSetup.InstFunc, Setup.InstFunc, Shared.Struct,
+  Shared.SetupEntFunc, Setup.UninstallProgressForm, Setup.UninstallSharedFileForm,
+  Shared.FileClass, Setup.ScriptRunner, Setup.DebugClient, Shared.SetupTypes,
+  Setup.LoggingFunc, Setup.MainForm, Setup.SpawnServer;
 
 type
   TExtUninstallLog = class(TUninstallLog)

+ 1 - 1
Projects/Src/Setup.UninstallLog.pas

@@ -155,7 +155,7 @@ implementation
 
 uses
   Messages, ShlObj, AnsiStrings,
-  PathFunc, Shared.Struct, SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, SetupLdrAndSetup.InstFunc,
+  PathFunc, Shared.Struct, SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.InstFunc,
   Setup.InstFunc.Ole, SetupLdrAndSetup.RedirFunc, Compression.Base,
   Setup.LoggingFunc, Setup.RegDLL, Setup.Helper, Setup.DotNetFunc;
 

+ 1 - 1
Projects/Src/Setup.WizardForm.pas

@@ -343,7 +343,7 @@ implementation
 
 uses
   ShellApi, ShlObj, Types, SetupLdrAndSetup.Messages, Setup.MainForm, PathFunc, Shared.CommonFunc.Vcl, Shared.CommonFunc,
-  MD5, SetupLdrAndSetup.InstFunc, Setup.SelectFolderForm, Setup.FileExtractor, Setup.LoggingFunc, RestartManager, Setup.ScriptRunner;
+  MD5, Setup.InstFunc, Setup.SelectFolderForm, Setup.FileExtractor, Setup.LoggingFunc, RestartManager, Setup.ScriptRunner;
 
 {$R *.DFM}
 

+ 337 - 0
Projects/Src/SetupLdrAndSetup.InstFunc.pas

@@ -0,0 +1,337 @@
+unit SetupLdrAndSetup.InstFunc;
+
+{
+  Inno Setup
+  Copyright (C) 1997-2024 Jordan Russell
+  Portions by Martijn Laan
+  For conditions of distribution and use, see LICENSE.TXT.
+
+  Misc. installation functions. Used only by the Setup and SetupLdr projects.
+}
+
+interface
+
+uses
+  Windows, SysUtils, Shared.Struct, Shared.CommonFunc;
+
+type
+  TDetermineDefaultLanguageResult = (ddNoMatch, ddMatch, ddMatchLangParameter);
+  TGetLanguageEntryProc = function(Index: Integer; var Entry: PSetupLanguageEntry): Boolean;
+
+function CreateSafeDirectory(const LimitCurrentUserSidAccess: Boolean; Path: String;
+  var ErrorCode: DWORD; out Protected: Boolean): Boolean; overload;
+function CreateSafeDirectory(const LimitCurrentUserSidAccess: Boolean; Path: String;
+  var ErrorCode: DWORD): Boolean; overload;
+function CreateTempDir(const LimitCurrentUserSidAccess: Boolean;
+  var Protected: Boolean): String; overload;
+function CreateTempDir(const LimitCurrentUserSidAccess: Boolean): String; overload;
+procedure DelayDeleteFile(const DisableFsRedir: Boolean; const Filename: String;
+  const MaxTries, FirstRetryDelayMS, SubsequentRetryDelayMS: Integer);
+function DetermineDefaultLanguage(const GetLanguageEntryProc: TGetLanguageEntryProc;
+  const Method: TSetupLanguageDetectionMethod; const LangParameter: String;
+  var ResultIndex: Integer): TDetermineDefaultLanguageResult;
+function IntToBase32(Number: Longint): String;
+function GenerateUniqueName(const DisableFsRedir: Boolean; Path: String;
+  const Extension: String): String;
+function RestartComputer: Boolean;
+
+implementation
+
+uses
+  PathFunc, SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, SetupLdrAndSetup.RedirFunc, Shared.SetupTypes;
+
+function ConvertStringSecurityDescriptorToSecurityDescriptorW(
+  StringSecurityDescriptor: PWideChar;
+  StringSDRevision: DWORD; var ppSecurityDescriptor: Pointer;
+  dummy: Pointer): BOOL; stdcall; external advapi32;
+
+function CreateSafeDirectory(const LimitCurrentUserSidAccess: Boolean; Path: String;
+  var ErrorCode: DWORD; out Protected: Boolean): Boolean; overload;
+{ Creates a protected directory if
+  -permissions are supported
+  -it's a subdirectory of c:\WINDOWS\TEMP, or
+  -it's on a local drive and LimitCurrentUserSidAccess is True (latter is true atm if elevated and not debugging)
+  otherwise creates a normal directory. }
+const
+  SDDL_REVISION_1 = 1;
+begin
+  Path := PathExpand(Path);
+  var Drive := PathExtractDrive(Path);
+  var FileSystemFlags: DWORD;
+
+  if GetVolumeInformation(PChar(AddBackslash(Drive)), nil, 0, nil, DWORD(nil^), FileSystemFlags, nil, 0) and
+     ((FileSystemFlags and FILE_PERSISTENT_ACLS) <> 0) then begin
+    var IsUnderWindowsTemp := Pos(PathLowercase(AddBackslash(GetSystemWinDir) + 'TEMP\'),
+      PathLowercase(Path)) = 1;
+    var IsLocalTempToProtect := LimitCurrentUserSidAccess and (Drive <> '') and
+      not PathCharIsSlash(Drive[1]) and
+      (GetDriveType(PChar(AddBackslash(Drive))) <> DRIVE_REMOTE);
+    Protected := IsUnderWindowsTemp or IsLocalTempToProtect;
+  end else
+    Protected := False;
+
+  if Protected then begin
+    var StringSecurityDescriptor :=
+      // D: adds a Discretionary ACL ("DACL", i.e. access control via SIDs)
+      // P: prevents DACL from being modified by inheritable ACEs
+      // AI: says automatic propagation of inheritable ACEs to child objects
+      //     is supported; always supposed to be set on Windows 2000+ ACLs
+      'D:PAI';
+    var CurrentUserSid := GetCurrentUserSid;
+    if CurrentUserSid = '' then
+      CurrentUserSid := 'OW'; // OW: owner rights
+    { Omit the CurrentUserSid ACE if the current user is SYSTEM, because
+      there's already a fixed Full Control ACE for SYSTEM below }
+    if not SameText(CurrentUserSid, 'S-1-5-18') then begin
+      // A: "allow"
+      // OICI: "object and container inherit",
+      //    i.e. files and directories created within the new directory
+      //    inherit these permissions
+      var AccessRights := 'FA'; // FILE_ALL_ACCESS (Full Control)
+      if LimitCurrentUserSidAccess then
+        AccessRights := 'FRFX'; // FILE_GENERIC_READ | FILE_GENERIC_EXECUTE
+      StringSecurityDescriptor := StringSecurityDescriptor +
+        '(A;OICI;' + AccessRights + ';;;' + CurrentUserSid + ')'; // current user
+    end;
+    StringSecurityDescriptor := StringSecurityDescriptor +
+      '(A;OICI;FA;;;BA)' + // BA: built-in Administrators group
+      '(A;OICI;FA;;;SY)'; // SY: local SYSTEM account
+
+    var pSecurityDescriptor: Pointer;
+    if not ConvertStringSecurityDescriptorToSecurityDescriptorW(
+      PWideChar(StringSecurityDescriptor), SDDL_REVISION_1, pSecurityDescriptor, nil
+    ) then begin
+      ErrorCode := GetLastError;
+      Result := False;
+      Exit;
+    end;
+
+    var SecurityAttr: TSecurityAttributes;
+    SecurityAttr.nLength := SizeOf(SecurityAttr);
+    SecurityAttr.bInheritHandle := False;
+    SecurityAttr.lpSecurityDescriptor := pSecurityDescriptor;
+
+    Result := CreateDirectory(PChar(Path), @SecurityAttr);
+    if not Result then
+      ErrorCode := GetLastError;
+
+    LocalFree(pSecurityDescriptor);
+  end else begin
+    Result := CreateDirectory(PChar(Path), nil);
+    if not Result then
+      ErrorCode := GetLastError;
+  end;
+end;
+
+function CreateSafeDirectory(const LimitCurrentUserSidAccess: Boolean; Path: String;
+  var ErrorCode: DWORD): Boolean; overload;
+begin
+  var Protected: Boolean;
+  Result := CreateSafeDirectory(LimitCurrentUserSidAccess, Path, ErrorCode, Protected);
+end;
+
+function IntToBase32(Number: Longint): String;
+const
+  Table: array[0..31] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUV';
+var
+  I: Integer;
+begin
+  Result := '';
+  for I := 0 to 4 do begin
+    Insert(Table[Number and 31], Result, 1);
+    Number := Number shr 5;
+  end;
+end;
+
+function GenerateUniqueName(const DisableFsRedir: Boolean; Path: String;
+  const Extension: String): String;
+var
+  Rand, RandOrig: Longint;
+  Filename: String;
+begin
+  Path := AddBackslash(Path);
+  RandOrig := Random($2000000);
+  Rand := RandOrig;
+  repeat
+    Inc(Rand);
+    if Rand > $1FFFFFF then Rand := 0;
+    if Rand = RandOrig then
+      { practically impossible to go through 33 million possibilities,
+        but check "just in case"... }
+      raise Exception.Create(FmtSetupMessage1(msgErrorTooManyFilesInDir,
+        RemoveBackslashUnlessRoot(Path)));
+    { Generate a random name }
+    Filename := Path + 'is-' + IntToBase32(Rand) + Extension;
+  until not FileOrDirExistsRedir(DisableFsRedir, Filename);
+  Result := Filename;
+end;
+
+function CreateTempDir(const LimitCurrentUserSidAccess: Boolean;
+  var Protected: Boolean): String;
+{ This is called by SetupLdr, Setup, and Uninstall. }
+var
+  Dir: String;
+  ErrorCode: DWORD;
+begin
+  while True do begin
+    Dir := GenerateUniqueName(False, GetTempDir, '.tmp');
+    if CreateSafeDirectory(LimitCurrentUserSidAccess, Dir, ErrorCode, Protected) then
+      Break;
+    if ErrorCode <> ERROR_ALREADY_EXISTS then
+      raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
+        [FmtSetupMessage1(msgErrorCreatingDir, Dir), IntToStr(ErrorCode),
+         Win32ErrorString(ErrorCode)]));
+  end;
+  Result := Dir;
+end;
+
+function CreateTempDir(const LimitCurrentUserSidAccess: Boolean): String;
+begin
+  var Protected: Boolean;
+  Result := CreateTempDir(LimitCurrentUserSidAccess, Protected);
+end;
+
+{ Work around problem in D2's declaration of the function }
+function NewAdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL;
+  const NewState: TTokenPrivileges; BufferLength: DWORD;
+  PreviousState: PTokenPrivileges; ReturnLength: PDWORD): BOOL; stdcall;
+  external advapi32 name 'AdjustTokenPrivileges';
+
+function RestartComputer: Boolean;
+{ Restarts the computer. }
+var
+  Token: THandle;
+  TokenPriv: TTokenPrivileges;
+const
+  SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';  { don't localize }
+begin
+  if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
+     Token) then begin
+    Result := False;
+    Exit;
+  end;
+
+  LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME, TokenPriv.Privileges[0].Luid);
+
+  TokenPriv.PrivilegeCount := 1;
+  TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
+
+  NewAdjustTokenPrivileges(Token, False, TokenPriv, 0, nil, nil);
+
+  { Cannot test the return value of AdjustTokenPrivileges. }
+  if GetLastError <> ERROR_SUCCESS then begin
+    Result := False;
+    Exit;
+  end;
+
+  Result := ExitWindowsEx(EWX_REBOOT, 0);
+
+  { ExitWindowsEx returns True immediately. The system then asynchronously
+    sends WM_QUERYENDSESSION messages to all processes, including the current
+    process. The current process is not killed until it has received
+    WM_QUERYENDSESSION and WM_ENDSESSION messages. }
+end;
+
+procedure DelayDeleteFile(const DisableFsRedir: Boolean; const Filename: String;
+  const MaxTries, FirstRetryDelayMS, SubsequentRetryDelayMS: Integer);
+{ Attempts to delete Filename up to MaxTries times, retrying if the file is
+  in use. It sleeps FirstRetryDelayMS msec after the first try, and
+  SubsequentRetryDelayMS msec after subsequent tries. }
+var
+  I: Integer;
+begin
+  for I := 0 to MaxTries-1 do begin
+    if I = 1 then
+      Sleep(FirstRetryDelayMS)
+    else if I > 1 then
+      Sleep(SubsequentRetryDelayMS);
+    if DeleteFileRedir(DisableFsRedir, Filename) or
+       (GetLastError = ERROR_FILE_NOT_FOUND) or
+       (GetLastError = ERROR_PATH_NOT_FOUND) then
+      Break;
+  end;
+end;
+
+function DetermineDefaultLanguage(const GetLanguageEntryProc: TGetLanguageEntryProc;
+  const Method: TSetupLanguageDetectionMethod; const LangParameter: String;
+  var ResultIndex: Integer): TDetermineDefaultLanguageResult;
+{ Finds the index of the language entry that most closely matches the user's
+  UI language / locale. If no match is found, ResultIndex is set to 0. }
+
+  function GetCodePageFromLangID(const ALangID: LANGID): Integer;
+  const
+    LOCALE_RETURN_NUMBER = $20000000;
+  var
+    CodePage: DWORD;
+  begin
+    if GetLocaleInfo(ALangID, LOCALE_IDEFAULTANSICODEPAGE or LOCALE_RETURN_NUMBER,
+       PChar(@CodePage), SizeOf(CodePage) div SizeOf(Char)) > 0 then
+      Result := Integer(CodePage)
+    else
+      Result := -1;
+  end;
+
+var
+  I: Integer;
+  LangEntry: PSetupLanguageEntry;
+  UILang: LANGID;
+begin
+  ResultIndex := 0;
+  Result := ddNoMatch;
+
+  if LangParameter <> '' then begin
+    { Use the language specified on the command line, if available }
+    I := 0;
+    while GetLanguageEntryProc(I, LangEntry) do begin
+      if CompareText(LangParameter, LangEntry.Name) = 0 then begin
+        ResultIndex := I;
+        Result := ddMatchLangParameter;
+        Exit;
+      end;
+      Inc(I);
+    end;
+  end;
+
+  case Method of
+    ldUILanguage: UILang := GetUILanguage;
+    ldLocale: UILang := GetUserDefaultLangID;
+  else
+    { ldNone }
+    UILang := 0;
+  end;
+  if UILang <> 0 then begin
+    { Look for a primary + sub language ID match }
+    I := 0;
+    while GetLanguageEntryProc(I, LangEntry) do begin
+      if LangEntry.LanguageID = UILang then begin
+        ResultIndex := I;
+        Result := ddMatch;
+        Exit;
+      end;
+      Inc(I);
+    end;
+    { Look for just a primary language ID match }
+    I := 0;
+    while GetLanguageEntryProc(I, LangEntry) do begin
+      if (LangEntry.LanguageID and $3FF) = (UILang and $3FF) then begin
+        { On Unicode, there is no LanguageCodePage filter, so we have to check
+          the language IDs to ensure we don't return Simplified Chinese on a
+          Traditional Chinese system, or vice versa.
+          If the default ANSI code pages associated with the language IDs are
+          equal, then there is no Simplified/Traditional discrepancy.
+           Simplified Chinese LANGIDs ($0804, $1004)        use CP 936
+          Traditional Chinese LANGIDs ($0404, $0C04, $1404) use CP 950 }
+        if ((UILang and $3FF) <> LANG_CHINESE) or
+           (GetCodePageFromLangID(LangEntry.LanguageID) = GetCodePageFromLangID(UILang)) then
+        begin
+          ResultIndex := I;
+          Result := ddMatch;
+          Exit;
+        end;
+      end;
+      Inc(I);
+    end;
+  end;
+end;
+
+end.

+ 1 - 1
Projects/Src/Shared.TaskDialogFunc.pas

@@ -20,7 +20,7 @@ implementation
 
 uses
   Classes, StrUtils, Math, Forms, Dialogs, SysUtils,
-  Commctrl, Shared.CommonFunc, {$IFDEF SETUPPROJ} SetupLdrAndSetup.InstFunc, {$ENDIF} PathFunc;
+  Commctrl, Shared.CommonFunc, {$IFDEF SETUPPROJ} Setup.InstFunc, {$ENDIF} PathFunc;
 
 var
   TaskDialogIndirectFunc: function(const pTaskConfig: TTaskDialogConfig;