4008 lines
153 KiB
ObjectPascal
4008 lines
153 KiB
ObjectPascal
unit Setup.MainFunc;
|
|
|
|
{
|
|
Inno Setup
|
|
Copyright (C) 1997-2025 Jordan Russell
|
|
Portions by Martijn Laan
|
|
For conditions of distribution and use, see LICENSE.TXT.
|
|
|
|
Setup main functions and global variables
|
|
}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs,
|
|
StdCtrls, Shared.Struct, Shared.DebugStruct, Shared.Int64Em, Shared.CommonFunc.Vcl, Shared.CommonFunc,
|
|
Shared.SetupTypes, Setup.ScriptRunner, RestartManager;
|
|
|
|
type
|
|
TEntryType = (seLanguage, seCustomMessage, sePermission, seType, seComponent,
|
|
seTask, seDir, seISSigKey, seFile, seFileLocation, seIcon, seIni, seRegistry,
|
|
seInstallDelete, seUninstallDelete, seRun, seUninstallRun);
|
|
|
|
TShellFolderID = (sfDesktop, sfStartMenu, sfPrograms, sfStartup, sfSendTo, //these have common and user versions
|
|
sfFonts, sfAppData, sfDocs, sfTemplates, //
|
|
sfFavorites, sfLocalAppData, sfUserProgramFiles, sfUserCommonFiles, sfUserSavedGames); //these only have user versions
|
|
|
|
const
|
|
EntryStrings: array[TEntryType] of Integer = (SetupLanguageEntryStrings,
|
|
SetupCustomMessageEntryStrings, SetupPermissionEntryStrings,
|
|
SetupTypeEntryStrings, SetupComponentEntryStrings, SetupTaskEntryStrings,
|
|
SetupDirEntryStrings, SetupISSigKeyEntryStrings, SetupFileEntryStrings,
|
|
SetupFileLocationEntryStrings, SetupIconEntryStrings, SetupIniEntryStrings,
|
|
SetupRegistryEntryStrings, SetupDeleteEntryStrings, SetupDeleteEntryStrings,
|
|
SetupRunEntryStrings, SetupRunEntryStrings);
|
|
|
|
EntryAnsiStrings: array[TEntryType] of Integer = (SetupLanguageEntryAnsiStrings,
|
|
SetupCustomMessageEntryAnsiStrings, SetupPermissionEntryAnsiStrings,
|
|
SetupTypeEntryAnsiStrings, SetupComponentEntryAnsiStrings, SetupTaskEntryAnsiStrings,
|
|
SetupDirEntryAnsiStrings, SetupISSigKeyEntryAnsiStrings, SetupFileEntryAnsiStrings,
|
|
SetupFileLocationEntryAnsiStrings, SetupIconEntryAnsiStrings, SetupIniEntryAnsiStrings,
|
|
SetupRegistryEntryAnsiStrings, SetupDeleteEntryAnsiStrings, SetupDeleteEntryAnsiStrings,
|
|
SetupRunEntryAnsiStrings, SetupRunEntryAnsiStrings);
|
|
|
|
{ Exit codes that are assigned to the SetupExitCode variable.
|
|
Note: SetupLdr also returns exit codes with the same numbers. }
|
|
ecInitializationError = 1; { Setup failed to initialize. }
|
|
ecCancelledBeforeInstall = 2; { User clicked Cancel before the actual
|
|
installation started. }
|
|
ecNextStepError = 3; { A fatal exception occurred while moving to
|
|
the next step. }
|
|
ecInstallationError = 4; { A fatal exception occurred during
|
|
installation. }
|
|
ecInstallationCancelled = 5; { User clicked Cancel during installation,
|
|
or clicked Abort at an Abort-Retry-Ignore
|
|
dialog. }
|
|
ecKilledByDebugger = 6; { User killed the Setup process from within
|
|
the debugger. }
|
|
ecPrepareToInstallFailed = 7; { Stopped on Preparing to Install page;
|
|
restart not needed. }
|
|
ecPrepareToInstallFailedRestartNeeded = 8;
|
|
{ Stopped on Preparing to Install page;
|
|
restart needed. }
|
|
|
|
CodeRunnerNamingAttribute = 'Event';
|
|
|
|
var
|
|
{ Variables for command line parameters }
|
|
SetupLdrMode: Boolean;
|
|
SetupLdrOriginalFilename: String;
|
|
SetupLdrOffset0, SetupLdrOffset1: Longint;
|
|
SetupNotifyWndPresent: Boolean;
|
|
SetupNotifyWnd: HWND;
|
|
InitLang: String;
|
|
InitDir, InitProgramGroup: String;
|
|
InitLoadInf, InitSaveInf: String;
|
|
InitNoIcons, InitSilent, InitVerySilent, InitNoRestart, InitCloseApplications,
|
|
InitNoCloseApplications, InitForceCloseApplications, InitNoForceCloseApplications,
|
|
InitLogCloseApplications, InitRestartApplications, InitNoRestartApplications,
|
|
InitNoCancel: Boolean;
|
|
InitSetupType: String;
|
|
InitComponents, InitTasks: TStringList;
|
|
InitComponentsSpecified: Boolean;
|
|
InitDeselectAllTasks: Boolean;
|
|
InitPassword: String;
|
|
InitRestartExitCode: Integer;
|
|
InitPrivilegesRequired: TSetupPrivilegesRequired;
|
|
HasInitPrivilegesRequired: Boolean;
|
|
InitSuppressMsgBoxes: Boolean;
|
|
DetachedUninstMsgFile: Boolean;
|
|
NewParamsForCode: TStringList;
|
|
|
|
{ Debugger }
|
|
OriginalEntryIndexes: array[TEntryType] of TList;
|
|
|
|
{ 'Constants' }
|
|
SourceDir, TempInstallDir, WinDir, WinSystemDir, WinSysWow64Dir, WinSysNativeDir, SystemDrive,
|
|
ProgramFiles32Dir, CommonFiles32Dir, ProgramFiles64Dir, CommonFiles64Dir,
|
|
CmdFilename, SysUserInfoName,
|
|
SysUserInfoOrg, UninstallExeFilename: String;
|
|
|
|
{ Uninstall 'constants' }
|
|
UninstallExpandedAppId, UninstallExpandedApp, UninstallExpandedGroup,
|
|
UninstallExpandedGroupName, UninstallExpandedLanguage: String;
|
|
UninstallSilent: Boolean;
|
|
|
|
{ Variables read in from the SETUP.0 file }
|
|
SetupHeader: TSetupHeader;
|
|
LangOptions: TSetupLanguageEntry;
|
|
Entries: array[TEntryType] of TList;
|
|
WizardImages: TList;
|
|
WizardSmallImages: TList;
|
|
CloseApplicationsFilterList, CloseApplicationsFilterExcludesList: TStringList;
|
|
ISSigAvailableKeys: TArrayOfECDSAKey;
|
|
|
|
{ User options }
|
|
ActiveLanguage: Integer = -1;
|
|
ActiveLicenseText, ActiveInfoBeforeText, ActiveInfoAfterText: AnsiString;
|
|
WizardUserInfoName, WizardUserInfoOrg, WizardUserInfoSerial, WizardDirValue, WizardGroupValue: String;
|
|
WizardNoIcons, WizardPreparingYesRadio: Boolean;
|
|
WizardSetupType: PSetupTypeEntry;
|
|
WizardComponents, WizardDeselectedComponents, WizardTasks, WizardDeselectedTasks: TStringList;
|
|
NeedToAbortInstall: Boolean;
|
|
|
|
{ Check/BeforeInstall/AfterInstall 'constants' }
|
|
CheckOrInstallCurrentFilename, CheckOrInstallCurrentSourceFilename: String;
|
|
|
|
{ RestartManager API state.
|
|
Note: the handle and key might change while running, see TWizardForm.QueryRestartManager. }
|
|
RmSessionStarted, RmFoundApplications, RmDoRestart: Boolean;
|
|
RmSessionHandle: DWORD;
|
|
RmSessionKey: array[0..CCH_RM_SESSION_KEY] of WideChar;
|
|
RmRegisteredFilesCount: Integer;
|
|
|
|
{ Other }
|
|
ShowLanguageDialog, MatchedLangParameter: Boolean;
|
|
InstallMode: (imNormal, imSilent, imVerySilent);
|
|
HasIcons, IsWin64, Is64BitInstallMode, IsAdmin, IsPowerUserOrAdmin, IsAdminInstallMode,
|
|
NeedPassword, NeedSerial, NeedsRestart, RestartSystem,
|
|
IsUninstaller, AllowUninstallerShutdown, AcceptedQueryEndSessionInProgress: Boolean;
|
|
InstallDefaultDisableFsRedir, ScriptFuncDisableFsRedir: Boolean;
|
|
InstallDefaultRegView: TRegView = rvDefault;
|
|
HasCustomType, HasComponents, HasTasks: Boolean;
|
|
ProcessorArchitecture: TSetupProcessorArchitecture = paUnknown;
|
|
MachineTypesSupportedBySystem: TSetupProcessorArchitectures;
|
|
WindowsVersion: Cardinal;
|
|
NTServicePackLevel: Word;
|
|
WindowsProductType: Byte;
|
|
WindowsSuiteMask: Word;
|
|
MinimumSpace: Integer64;
|
|
DeleteFilesAfterInstallList, DeleteDirsAfterInstallList: TStringList;
|
|
ExpandedAppName, ExpandedAppVerName, ExpandedAppCopyright, ExpandedAppMutex: String;
|
|
DisableCodeConsts: Integer;
|
|
SetupExitCode: Integer;
|
|
CreatedIcon: Boolean;
|
|
RestartInitiatedByThisProcess, DownloadTemporaryFileOrExtractArchiveProcessMessages: Boolean;
|
|
InstallModeRootKey: HKEY;
|
|
|
|
CodeRunner: TScriptRunner;
|
|
|
|
procedure CodeRunnerOnLog(const S: String);
|
|
procedure CodeRunnerOnLogFmt(const S: String; const Args: array of const);
|
|
function CodeRunnerOnDebug(const Position: LongInt;
|
|
var ContinueStepOver: Boolean): Boolean;
|
|
function CodeRunnerOnDebugIntermediate(const Position: LongInt;
|
|
var ContinueStepOver: Boolean): Boolean;
|
|
procedure CodeRunnerOnDllImport(var DllName: String; var ForceDelayLoad: Boolean);
|
|
procedure CodeRunnerOnException(const Exception: AnsiString; const Position: LongInt);
|
|
procedure CreateTempInstallDirAndExtract64BitHelper;
|
|
procedure DebugNotifyEntry(EntryType: TEntryType; Number: Integer);
|
|
procedure DeinitSetup(const AllowCustomSetupExitCode: Boolean);
|
|
function ExitSetupMsgBox: Boolean;
|
|
function ExpandConst(const S: String): String;
|
|
function ExpandConstEx(const S: String; const CustomConsts: array of String): String;
|
|
function ExpandConstEx2(const S: String; const CustomConsts: array of String;
|
|
const DoExpandIndividualConst: Boolean): String;
|
|
function ExpandConstIfPrefixed(const S: String): String;
|
|
function GetCustomMessageValue(const AName: String; var AValue: String): Boolean;
|
|
function GetShellFolder(const Common: Boolean; const ID: TShellFolderID): String;
|
|
function GetShellFolderByCSIDL(Folder: Integer; const Create: Boolean): String;
|
|
function GetUninstallRegKeyBaseName(const ExpandedAppId: String): String;
|
|
function GetUninstallRegSubkeyName(const UninstallRegKeyBaseName: String): String;
|
|
function GetPreviousData(const ExpandedAppID, ValueName, DefaultValueData: String): String;
|
|
function GetPreviousLanguage(const ExpandedAppID: String): Integer;
|
|
procedure InitializeAdminInstallMode(const AAdminInstallMode: Boolean);
|
|
procedure Initialize64BitInstallMode(const A64BitInstallMode: Boolean);
|
|
procedure Log64BitInstallMode;
|
|
procedure LogArchiveExtractionModeOnce;
|
|
procedure InitializeCommonVars;
|
|
procedure InitializeSetup;
|
|
procedure InitializeWizard;
|
|
procedure InitMainNonSHFolderConsts;
|
|
function InstallOnThisVersion(const MinVersion: TSetupVersionData;
|
|
const OnlyBelowVersion: TSetupVersionData): TInstallOnThisVersionResult;
|
|
function IsRecurseableDirectory(const FindData: TWin32FindData): Boolean;
|
|
procedure LoadSHFolderDLL;
|
|
function LoggedAppMessageBox(const Text, Caption: PChar; const Flags: Longint;
|
|
const Suppressible: Boolean; const Default: Integer): Integer;
|
|
function LoggedMsgBox(const Text, Caption: String; const Typ: TMsgBoxType;
|
|
const Buttons: Cardinal; const Suppressible: Boolean; const Default: Integer): Integer;
|
|
function LoggedTaskDialogMsgBox(const Icon, Instruction, Text, Caption: String;
|
|
const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: array of String;
|
|
const ShieldButton: Integer; const Suppressible: Boolean; const Default: Integer;
|
|
const VerificationText: String = ''; const pfVerificationFlagChecked: PBOOL = nil): Integer;
|
|
procedure LogWindowsVersion;
|
|
procedure NotifyAfterInstallEntry(const AfterInstall: String);
|
|
procedure NotifyAfterInstallFileEntry(const FileEntry: PSetupFileEntry);
|
|
procedure NotifyBeforeInstallEntry(const BeforeInstall: String);
|
|
procedure NotifyBeforeInstallFileEntry(const FileEntry: PSetupFileEntry);
|
|
function PreviousInstallCompleted(const WizardComponents, WizardTasks: TStringList): Boolean;
|
|
function CodeRegisterExtraCloseApplicationsResource(const DisableFsRedir: Boolean; const AFilename: String): Boolean;
|
|
procedure RegisterResourcesWithRestartManager(const WizardComponents, WizardTasks: TStringList);
|
|
procedure RemoveTempInstallDir;
|
|
procedure SaveInf(const FileName: String);
|
|
procedure SaveResourceToTempFile(const ResName, Filename: String);
|
|
procedure SetActiveLanguage(const I: Integer);
|
|
procedure ShellExecuteAsOriginalUser(hWnd: HWND; Operation, FileName, Parameters, Directory: LPWSTR; ShowCmd: Integer); stdcall;
|
|
function ShouldDisableFsRedirForFileEntry(const FileEntry: PSetupFileEntry): Boolean;
|
|
function ShouldDisableFsRedirForRunEntry(const RunEntry: PSetupRunEntry): Boolean;
|
|
procedure ProcessRunEntry(const RunEntry: PSetupRunEntry);
|
|
function EvalArchitectureIdentifier(const Name: String): Boolean;
|
|
function EvalDirectiveCheck(const Expression: String): Boolean;
|
|
function ShouldProcessEntry(const WizardComponents, WizardTasks: TStringList;
|
|
const Components, Tasks, Languages, Check: String): Boolean;
|
|
function ShouldProcessFileEntry(const WizardComponents, WizardTasks: TStringList;
|
|
const FileEntry: PSetupFileEntry; const IgnoreCheck: Boolean): Boolean;
|
|
function ShouldProcessIconEntry(const WizardComponents, WizardTasks: TStringList;
|
|
const WizardNoIcons: Boolean; const IconEntry: PSetupIconEntry): Boolean;
|
|
function ShouldProcessRunEntry(const WizardComponents, WizardTasks: TStringList;
|
|
const RunEntry: PSetupRunEntry): Boolean;
|
|
function TestPassword(const EncryptionKey: TSetupEncryptionKey): Boolean;
|
|
procedure UnloadSHFolderDLL;
|
|
function WindowsVersionAtLeast(const AMajor, AMinor: Byte; const ABuild: Word = 0): Boolean;
|
|
function IsWindows8: Boolean;
|
|
function IsWindows10: Boolean;
|
|
function IsWindows11: Boolean;
|
|
|
|
implementation
|
|
|
|
uses
|
|
ShellAPI, ShlObj, StrUtils, ActiveX, RegStr, ChaCha20, ECDSA, ISSigFunc,
|
|
SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.Install, SetupLdrAndSetup.InstFunc,
|
|
Setup.InstFunc, SetupLdrAndSetup.RedirFunc, PathFunc,
|
|
Compression.Base, Compression.Zlib, Compression.bzlib, Compression.LZMADecompressor,
|
|
Shared.SetupEntFunc, Setup.SelectLanguageForm,
|
|
Setup.WizardForm, Setup.DebugClient, Shared.VerInfoFunc, Setup.FileExtractor,
|
|
Shared.FileClass, Setup.LoggingFunc,
|
|
SimpleExpression, Setup.Helper, Setup.SpawnClient, Setup.SpawnServer,
|
|
Setup.DotNetFunc, Shared.TaskDialogFunc, Setup.MainForm, Compression.SevenZipDecoder,
|
|
Compression.SevenZipDLLDecoder;
|
|
|
|
var
|
|
ShellFolders: array[Boolean, TShellFolderID] of String;
|
|
ShellFoldersRead: array[Boolean, TShellFolderID] of Boolean;
|
|
SHFolderDLLHandle: HMODULE;
|
|
SHGetFolderPathFunc: function(hwndOwner: HWND; nFolder: Integer;
|
|
hToken: THandle; dwFlags: DWORD; pszPath: PChar): HRESULT; stdcall;
|
|
SHGetKnownFolderPathFunc: function(const rfid: TGUID; dwFlags: DWORD; hToken: THandle;
|
|
var ppszPath: PWideChar): HRESULT; stdcall;
|
|
|
|
DecompressorDLLHandle, SevenZipDLLHandle: HMODULE;
|
|
|
|
type
|
|
TDummyClass = class
|
|
public
|
|
class function ExpandCheckOrInstallConstant(Sender: TSimpleExpression;
|
|
const Constant: String): String;
|
|
class function EvalInstallIdentifier(Sender: TSimpleExpression;
|
|
const Name: String; const Parameters: array of const): Boolean;
|
|
class function EvalArchitectureIdentifier(Sender: TSimpleExpression;
|
|
const Name: String; const Parameters: array of const): Boolean;
|
|
class function EvalComponentOrTaskIdentifier(Sender: TSimpleExpression;
|
|
const Name: String; const Parameters: array of const): Boolean;
|
|
class function EvalLanguageIdentifier(Sender: TSimpleExpression;
|
|
const Name: String; const Parameters: array of const): Boolean;
|
|
class function EvalCheckIdentifier(Sender: TSimpleExpression;
|
|
const Name: String; const Parameters: array of const): Boolean;
|
|
end;
|
|
|
|
{ Misc. functions }
|
|
|
|
function WindowsVersionAtLeast(const AMajor, AMinor: Byte; const ABuild: Word): Boolean;
|
|
begin
|
|
Result := WindowsVersion >= Cardinal((AMajor shl 24) or (AMinor shl 16) or ABuild);
|
|
end;
|
|
|
|
function IsWindows8: Boolean;
|
|
begin
|
|
Result := WindowsVersionAtLeast(6, 2);
|
|
end;
|
|
|
|
function IsWindows10: Boolean;
|
|
begin
|
|
Result := WindowsVersionAtLeast(10, 0);
|
|
end;
|
|
|
|
function IsWindows11: Boolean;
|
|
begin
|
|
Result := WindowsVersionAtLeast(10, 0, 22000);
|
|
end;
|
|
|
|
function GetUninstallRegKeyBaseName(const ExpandedAppId: String): String;
|
|
var
|
|
UseAnsiCRC32: Boolean;
|
|
S: AnsiString;
|
|
I: Integer;
|
|
begin
|
|
{ Set uninstall registry key base name }
|
|
Result := ExpandedAppId;
|
|
{ Uninstall registry keys can only be up to 63 characters, otherwise Win95
|
|
ignores them. Limit to 57 since Setup will add _isXXX to the end later. }
|
|
if Length(Result) > 57 then begin
|
|
{ Only keep the first 48 characters, then add an tilde and the CRC
|
|
of the original string (to make the trimmed string unique). The
|
|
resulting string is 57 characters long. On Unicode, only do this if we
|
|
can get a CRC32 compatible with ANSI versions, else there's no point
|
|
in shortening since Unicode doesn't run on Win95. }
|
|
UseAnsiCRC32 := True;
|
|
for I := 1 to Length(Result) do begin
|
|
if Ord(Result[I]) > 126 then begin
|
|
UseAnsiCRC32 := False;
|
|
Break;
|
|
end;
|
|
end;
|
|
if UseAnsiCRC32 then begin
|
|
S := AnsiString(Result);
|
|
FmtStr(Result, '%.48s~%.8x', [Result, GetCRC32(S[1], Length(S)*SizeOf(S[1]))]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetUninstallRegSubkeyName(const UninstallRegKeyBaseName: String): String;
|
|
begin
|
|
Result := Format('%s\%s_is1', [REGSTR_PATH_UNINSTALL, UninstallRegKeyBaseName]);
|
|
end;
|
|
|
|
{ Based on FindPreviousData in Wizard.pas }
|
|
function GetPreviousData(const ExpandedAppID, ValueName, DefaultValueData: String): String;
|
|
var
|
|
H: HKEY;
|
|
begin
|
|
Result := DefaultValueData;
|
|
if ExpandedAppId <> '' then begin
|
|
if RegOpenKeyExView(InstallDefaultRegView, InstallModeRootKey,
|
|
PChar(GetUninstallRegSubkeyName(GetUninstallRegKeyBaseName(ExpandedAppId))),
|
|
0, KEY_QUERY_VALUE, H) = ERROR_SUCCESS then begin
|
|
try
|
|
RegQueryStringValue (H, PChar(ValueName), Result);
|
|
finally
|
|
RegCloseKey (H);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetPreviousLanguage(const ExpandedAppID: String): Integer;
|
|
var
|
|
PrevLang: String;
|
|
I: Integer;
|
|
begin
|
|
{ do not localize or change the following string }
|
|
PrevLang := GetPreviousData(ExpandConst(SetupHeader.AppId), 'Inno Setup: Language', '');
|
|
|
|
if PrevLang <> '' then begin
|
|
for I := 0 to Entries[seLanguage].Count-1 do begin
|
|
if CompareText(PrevLang, PSetupLanguageEntry(Entries[seLanguage][I]).Name) = 0 then begin
|
|
Result := I;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Result := -1;
|
|
end;
|
|
|
|
{ This function assumes EncryptionKey is based on the password }
|
|
function TestPassword(const EncryptionKey: TSetupEncryptionKey): Boolean;
|
|
begin
|
|
{ Do same as compiler did in GeneratePasswordTest and compare results }
|
|
var Nonce := SetupHeader.EncryptionBaseNonce;
|
|
Nonce.RandomXorFirstSlice := Nonce.RandomXorFirstSlice xor -1;
|
|
|
|
var Context: TChaCha20Context;
|
|
XChaCha20Init(Context, EncryptionKey[0], Length(EncryptionKey), Nonce, SizeOf(Nonce), 0);
|
|
var PasswordTest := 0;
|
|
XChaCha20Crypt(Context, PasswordTest, PasswordTest, SizeOf(PasswordTest));
|
|
|
|
Result := PasswordTest = SetupHeader.PasswordTest;
|
|
end;
|
|
|
|
class function TDummyClass.ExpandCheckOrInstallConstant(Sender: TSimpleExpression;
|
|
const Constant: String): String;
|
|
begin
|
|
Result := ExpandConst(Constant);
|
|
end;
|
|
|
|
class function TDummyClass.EvalInstallIdentifier(Sender: TSimpleExpression;
|
|
const Name: String; const Parameters: array of const): Boolean;
|
|
begin
|
|
CodeRunner.RunProcedure(AnsiString(Name), Parameters, True);
|
|
Result := True; { Result doesn't matter }
|
|
end;
|
|
|
|
procedure NotifyInstallEntry(const Install: String);
|
|
|
|
procedure EvalInstall(const Expression: String);
|
|
var
|
|
SimpleExpression: TSimpleExpression;
|
|
begin
|
|
try
|
|
SimpleExpression := TSimpleExpression.Create;
|
|
try
|
|
SimpleExpression.Expression := Expression;
|
|
SimpleExpression.OnEvalIdentifier := TDummyClass.EvalInstallIdentifier;
|
|
SimpleExpression.OnExpandConstant := TDummyClass.ExpandCheckOrInstallConstant;
|
|
SimpleExpression.ParametersAllowed := True;
|
|
SimpleExpression.SingleIdentifierMode := True;
|
|
SimpleExpression.Eval;
|
|
finally
|
|
SimpleExpression.Free;
|
|
end;
|
|
except
|
|
InternalError(Format('Expression error ''%s''', [GetExceptMessage]));
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if Install <> '' then begin
|
|
try
|
|
if CodeRunner = nil then
|
|
InternalError('"BeforeInstall" or "AfterInstall" parameter with no CodeRunner');
|
|
EvalInstall(Install);
|
|
except
|
|
{ Don't allow exceptions raised by Before/AfterInstall functions to be propagated out }
|
|
Application.HandleException(nil);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure NotifyBeforeInstallEntry(const BeforeInstall: String);
|
|
begin
|
|
NotifyInstallEntry(BeforeInstall);
|
|
end;
|
|
|
|
procedure NotifyBeforeInstallFileEntry(const FileEntry: PSetupFileEntry);
|
|
begin
|
|
CheckOrInstallCurrentFilename := FileEntry.DestName;
|
|
CheckOrInstallCurrentSourceFilename := FileEntry.SourceFilename;
|
|
NotifyInstallEntry(FileEntry.BeforeInstall);
|
|
CheckOrInstallCurrentFilename := '';
|
|
CheckOrInstallCurrentSourceFilename := '';
|
|
end;
|
|
|
|
procedure NotifyAfterInstallEntry(const AfterInstall: String);
|
|
begin
|
|
NotifyInstallEntry(AfterInstall);
|
|
end;
|
|
|
|
procedure NotifyAfterInstallFileEntry(const FileEntry: PSetupFileEntry);
|
|
begin
|
|
CheckOrInstallCurrentFilename := FileEntry.DestName;
|
|
CheckOrInstallCurrentSourceFilename := FileEntry.SourceFilename;
|
|
NotifyInstallEntry(FileEntry.AfterInstall);
|
|
CheckOrInstallCurrentFilename := '';
|
|
CheckOrInstallCurrentSourceFilename := '';
|
|
end;
|
|
|
|
function EvalArchitectureIdentifier(const Name: String): Boolean;
|
|
type
|
|
TArchIdentifierRec = record
|
|
Name: String;
|
|
Arch: TSetupProcessorArchitecture;
|
|
Compatible: Boolean;
|
|
end;
|
|
const
|
|
{ Valid identifier 'win64' is not in this list but treated specially below }
|
|
ArchIdentifiers: array[0..7] of TArchIdentifierRec = (
|
|
(Name: 'arm32compatible'; Arch: paArm32; Compatible: True),
|
|
(Name: 'arm64'; Arch: paArm64; Compatible: False),
|
|
(Name: 'x64'; Arch: paX64; Compatible: False),
|
|
(Name: 'x64os'; Arch: paX64; Compatible: False),
|
|
(Name: 'x64compatible'; Arch: paX64; Compatible: True),
|
|
(Name: 'x86'; Arch: paX86; Compatible: False),
|
|
(Name: 'x86os'; Arch: paX86; Compatible: False),
|
|
(Name: 'x86compatible'; Arch: paX86; Compatible: True));
|
|
begin
|
|
if Name = 'win64' then
|
|
Exit(IsWin64);
|
|
|
|
for var ArchIdentifier in ArchIdentifiers do
|
|
if ArchIdentifier.Name = Name then begin
|
|
if ArchIdentifier.Compatible then
|
|
Exit(ArchIdentifier.Arch in MachineTypesSupportedBySystem)
|
|
else { An exact match is requested instead of anything compatible, perhaps
|
|
for a driver install or something similar }
|
|
Exit(ProcessorArchitecture = ArchIdentifier.Arch);
|
|
end;
|
|
|
|
raise Exception.CreateFmt('Unknown architecture ''%s''', [Name]);
|
|
end;
|
|
|
|
class function TDummyClass.EvalArchitectureIdentifier(Sender: TSimpleExpression;
|
|
const Name: String; const Parameters: array of const): Boolean;
|
|
begin
|
|
Result := Setup.MainFunc.EvalArchitectureIdentifier(Name);
|
|
end;
|
|
|
|
class function TDummyClass.EvalComponentOrTaskIdentifier(Sender: TSimpleExpression;
|
|
const Name: String; const Parameters: array of const): Boolean;
|
|
var
|
|
WizardItems: TStringList;
|
|
begin
|
|
WizardItems := TStringList(Sender.Tag);
|
|
Result := ListContains(WizardItems, Name);
|
|
end;
|
|
|
|
class function TDummyClass.EvalLanguageIdentifier(Sender: TSimpleExpression;
|
|
const Name: String; const Parameters: array of const): Boolean;
|
|
begin
|
|
Result := CompareText(PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name, Name) = 0;
|
|
end;
|
|
|
|
class function TDummyClass.EvalCheckIdentifier(Sender: TSimpleExpression;
|
|
const Name: String; const Parameters: array of const): Boolean;
|
|
begin
|
|
Result := CodeRunner.RunBooleanFunction(AnsiString(Name), Parameters, True, False);
|
|
end;
|
|
|
|
function EvalCheck(const Expression: String): Boolean;
|
|
var
|
|
SimpleExpression: TSimpleExpression;
|
|
begin
|
|
try
|
|
SimpleExpression := TSimpleExpression.Create;
|
|
try
|
|
SimpleExpression.Lazy := True;
|
|
SimpleExpression.Expression := Expression;
|
|
SimpleExpression.OnEvalIdentifier := TDummyClass.EvalCheckIdentifier;
|
|
SimpleExpression.OnExpandConstant := TDummyClass.ExpandCheckOrInstallConstant;
|
|
SimpleExpression.ParametersAllowed := True;
|
|
SimpleExpression.SilentOrAllowed := False;
|
|
SimpleExpression.SingleIdentifierMode := False;
|
|
Result := SimpleExpression.Eval;
|
|
finally
|
|
SimpleExpression.Free;
|
|
end;
|
|
except
|
|
InternalError(Format('Expression error ''%s''', [GetExceptMessage]));
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function EvalDirectiveCheck(const Expression: String): Boolean;
|
|
begin
|
|
if not TryStrToBoolean(Expression, Result) then
|
|
Result := EvalCheck(Expression);
|
|
end;
|
|
|
|
function EvalExpression(const Expression: String;
|
|
OnEvalIdentifier: TSimpleExpressionOnEvalIdentifier; Tag: LongInt = 0): Boolean;
|
|
var
|
|
SimpleExpression: TSimpleExpression;
|
|
begin
|
|
try
|
|
SimpleExpression := TSimpleExpression.Create;
|
|
try
|
|
SimpleExpression.Lazy := True;
|
|
SimpleExpression.Expression := Expression;
|
|
SimpleExpression.OnEvalIdentifier := OnEvalIdentifier;
|
|
SimpleExpression.ParametersAllowed := False;
|
|
SimpleExpression.SilentOrAllowed := True;
|
|
SimpleExpression.SingleIdentifierMode := False;
|
|
SimpleExpression.Tag := Tag;
|
|
Result := SimpleExpression.Eval;
|
|
finally
|
|
SimpleExpression.Free;
|
|
end;
|
|
except
|
|
InternalError(Format('Expression error ''%s''', [GetExceptMessage]));
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function ShouldProcessEntry(const WizardComponents, WizardTasks: TStringList;
|
|
const Components, Tasks, Languages, Check: String): Boolean;
|
|
var
|
|
ProcessComponent, ProcessTask, ProcessLanguage: Boolean;
|
|
begin
|
|
if (Components <> '') or (Tasks <> '') or (Languages <> '') or (Check <> '') then begin
|
|
if (Components <> '') and (WizardComponents <> nil) then
|
|
ProcessComponent := EvalExpression(Components, TDummyClass.EvalComponentOrTaskIdentifier, LongInt(WizardComponents))
|
|
else
|
|
ProcessComponent := True;
|
|
|
|
if (Tasks <> '') and (WizardTasks <> nil) then
|
|
ProcessTask := EvalExpression(Tasks, TDummyClass.EvalComponentOrTaskIdentifier, LongInt(WizardTasks))
|
|
else
|
|
ProcessTask := True;
|
|
|
|
if Languages <> '' then
|
|
ProcessLanguage := EvalExpression(Languages, TDummyClass.EvalLanguageIdentifier)
|
|
else
|
|
ProcessLanguage := True;
|
|
|
|
Result := ProcessComponent and ProcessTask and ProcessLanguage;
|
|
if Result and (Check <> '') then begin
|
|
try
|
|
if CodeRunner = nil then
|
|
InternalError('"Check" parameter with no CodeRunner');
|
|
Result := EvalCheck(Check);
|
|
except
|
|
{ Don't allow exceptions raised by Check functions to be propagated out }
|
|
Application.HandleException(nil);
|
|
Result := False;
|
|
end;
|
|
end;
|
|
end else
|
|
Result := True;
|
|
end;
|
|
|
|
function ShouldProcessFileEntry(const WizardComponents, WizardTasks: TStringList;
|
|
const FileEntry: PSetupFileEntry; const IgnoreCheck: Boolean): Boolean;
|
|
begin
|
|
if foDontCopy in FileEntry.Options then begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
CheckOrInstallCurrentFilename := FileEntry.DestName;
|
|
CheckOrInstallCurrentSourceFilename := FileEntry.SourceFilename;
|
|
if IgnoreCheck then
|
|
Result := ShouldProcessEntry(WizardComponents, WizardTasks, FileEntry.Components, FileEntry.Tasks, FileEntry.Languages, '')
|
|
else
|
|
Result := ShouldProcessEntry(WizardComponents, WizardTasks, FileEntry.Components, FileEntry.Tasks, FileEntry.Languages, FileEntry.Check);
|
|
CheckOrInstallCurrentFilename := '';
|
|
CheckOrInstallCurrentSourceFilename := '';
|
|
end;
|
|
|
|
function ShouldProcessRunEntry(const WizardComponents, WizardTasks: TStringList;
|
|
const RunEntry: PSetupRunEntry): Boolean;
|
|
begin
|
|
if (InstallMode <> imNormal) and (roSkipIfSilent in RunEntry.Options) then
|
|
Result := False
|
|
else if (InstallMode = imNormal) and (roSkipIfNotSilent in RunEntry.Options) then
|
|
Result := False
|
|
else
|
|
Result := ShouldProcessEntry(WizardComponents, WizardTasks, RunEntry.Components, RunEntry.Tasks, RunEntry.Languages, RunEntry.Check);
|
|
end;
|
|
|
|
function ShouldProcessIconEntry(const WizardComponents, WizardTasks: TStringList;
|
|
const WizardNoIcons: Boolean; const IconEntry: PSetupIconEntry): Boolean;
|
|
begin
|
|
if WizardNoIcons and (IconEntry.Tasks = '') and
|
|
(Copy(IconEntry.IconName, 1, 8) = '{group}\') then
|
|
Result := False
|
|
else
|
|
Result := ShouldProcessEntry(WizardComponents, WizardTasks, IconEntry.Components, IconEntry.Tasks, IconEntry.Languages, IconEntry.Check);
|
|
end;
|
|
|
|
function ShouldDisableFsRedirForFileEntry(const FileEntry: PSetupFileEntry): Boolean;
|
|
begin
|
|
Result := InstallDefaultDisableFsRedir;
|
|
if fo32Bit in FileEntry.Options then
|
|
Result := False;
|
|
if fo64Bit in FileEntry.Options then begin
|
|
if not IsWin64 then
|
|
InternalError('Cannot install files to 64-bit locations on this version of Windows');
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
function SlashesToBackslashes(const S: String): String;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := S;
|
|
for I := 1 to Length(Result) do
|
|
if Result[I] = '/' then
|
|
Result[I] := '\';
|
|
end;
|
|
|
|
procedure LoadInf(const FileName: String; var WantToSuppressMsgBoxes: Boolean);
|
|
const
|
|
Section = 'Setup';
|
|
var
|
|
S: String;
|
|
begin
|
|
//saved infs
|
|
InitLang := GetIniString(Section, 'Lang', InitLang, FileName);
|
|
InitDir := GetIniString(Section, 'Dir', InitDir, FileName);
|
|
InitProgramGroup := GetIniString(Section, 'Group', InitProgramGroup, FileName);
|
|
InitNoIcons := GetIniBool(Section, 'NoIcons', InitNoIcons, FileName);
|
|
InitSetupType := GetIniString(Section, 'SetupType', InitSetupType, FileName);
|
|
S := GetIniString(Section, 'Components', '$', FileName);
|
|
if S <> '$' then begin
|
|
InitComponentsSpecified := True;
|
|
SetStringsFromCommaString(InitComponents, SlashesToBackslashes(S));
|
|
end;
|
|
S := GetIniString(Section, 'Tasks', '$', FileName);
|
|
if S <> '$' then begin
|
|
InitDeselectAllTasks := True;
|
|
SetStringsFromCommaString(InitTasks, SlashesToBackslashes(S));
|
|
end;
|
|
//non saved infs (=non user settable)
|
|
InitSilent := GetIniBool(Section, 'Silent', InitSilent, FileName);
|
|
InitVerySilent := GetIniBool(Section, 'VerySilent', InitVerySilent, FileName);
|
|
InitNoRestart := GetIniBool(Section, 'NoRestart', InitNoRestart, FileName);
|
|
InitCloseApplications := GetIniBool(Section, 'CloseApplications', InitCloseApplications, FileName);
|
|
InitNoCloseApplications := GetIniBool(Section, 'NoCloseApplications', InitNoCloseApplications, FileName);
|
|
InitForceCloseApplications := GetIniBool(Section, 'ForceCloseApplications', InitForceCloseApplications, FileName);
|
|
InitNoForceCloseApplications := GetIniBool(Section, 'NoForceCloseApplications', InitNoForceCloseApplications, FileName);
|
|
InitLogCloseApplications := GetIniBool(Section, 'LogCloseApplications', InitLogCloseApplications, FileName);
|
|
InitRestartApplications := GetIniBool(Section, 'RestartApplications', InitRestartApplications, FileName);
|
|
InitNoRestartApplications := GetIniBool(Section, 'NoRestartApplications', InitNoRestartApplications, FileName);
|
|
InitNoCancel := GetIniBool(Section, 'NoCancel', InitNoCancel, FileName);
|
|
InitPassword := GetIniString(Section, 'Password', InitPassword, FileName);
|
|
InitRestartExitCode := GetIniInt(Section, 'RestartExitCode', InitRestartExitCode, 0, 0, FileName);
|
|
WantToSuppressMsgBoxes := GetIniBool(Section, 'SuppressMsgBoxes', WantToSuppressMsgBoxes, FileName);
|
|
InitSaveInf := GetIniString(Section, 'SaveInf', InitSaveInf, FileName);
|
|
end;
|
|
|
|
procedure SaveInf(const FileName: String);
|
|
const
|
|
Section = 'Setup';
|
|
begin
|
|
SetIniString(Section, 'Lang',
|
|
PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name, FileName);
|
|
SetIniString(Section, 'Dir', WizardDirValue, FileName);
|
|
SetIniString(Section, 'Group', WizardGroupValue, FileName);
|
|
SetIniBool(Section, 'NoIcons', WizardNoIcons, FileName);
|
|
if WizardSetupType <> nil then begin
|
|
SetIniString(Section, 'SetupType', WizardSetupType.Name, FileName);
|
|
SetIniString(Section, 'Components', StringsToCommaString(WizardComponents), FileName);
|
|
end
|
|
else begin
|
|
DeleteIniEntry(Section, 'SetupType', FileName);
|
|
DeleteIniEntry(Section, 'Components', FileName);
|
|
end;
|
|
SetIniString(Section, 'Tasks', StringsToCommaString(WizardTasks), FileName);
|
|
end;
|
|
|
|
function GetCustomMessageValue(const AName: String; var AValue: String): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := False;
|
|
for I := 0 to Entries[seCustomMessage].Count-1 do begin
|
|
with PSetupCustomMessageEntry(Entries[seCustomMessage][I])^ do begin
|
|
if (CompareText(Name, AName) = 0) and
|
|
((LangIndex = -1) or (LangIndex = ActiveLanguage)) then begin
|
|
Result := True;
|
|
AValue := Value;
|
|
{ don't stop looping, last item counts }
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ExpandIndividualConst(Cnst: String;
|
|
const CustomConsts: array of String): String;
|
|
{ Cnst must be the name of a single constant, without the braces.
|
|
For example: app
|
|
IsPath is set to True if the result is a path which needs special trailing-
|
|
backslash handling. }
|
|
|
|
procedure HandleAutoConstants(var Cnst: String);
|
|
const
|
|
Actual: array [Boolean] of String = ('user', 'common');
|
|
begin
|
|
if Copy(Cnst, 1, 4) = 'auto' then begin
|
|
StringChange(Cnst, 'auto', Actual[IsAdminInstallMode]);
|
|
if (Cnst = 'userpf32') or (Cnst = 'userpf64') or
|
|
(Cnst = 'usercf32') or (Cnst = 'usercf64') then
|
|
Delete(Cnst, Length(Cnst)-1, 2);
|
|
end;
|
|
end;
|
|
|
|
procedure NoUninstallConstError(const C: String);
|
|
begin
|
|
InternalError(Format('Cannot evaluate "%s" constant during Uninstall', [C]));
|
|
end;
|
|
|
|
function ExpandEnvConst(C: String): String;
|
|
var
|
|
I: Integer;
|
|
VarName, Default: String;
|
|
begin
|
|
Delete(C, 1, 1);
|
|
I := ConstPos('|', C); { check for 'default' value }
|
|
if I = 0 then
|
|
I := Length(C)+1;
|
|
VarName := Copy(C, 1, I-1);
|
|
Default := Copy(C, I+1, Maxint);
|
|
Result := '';
|
|
if ConvertConstPercentStr(VarName) and ConvertConstPercentStr(Default) then begin
|
|
Result := GetEnv(ExpandConstEx(VarName, CustomConsts));
|
|
if Result = '' then
|
|
Result := ExpandConstEx(Default, CustomConsts);
|
|
end;
|
|
end;
|
|
|
|
function ExpandRegConst(C: String): String;
|
|
{ Expands a registry-value constant in the form:
|
|
reg:HKxx\SubkeyName,ValueName|DefaultValue }
|
|
type
|
|
TKeyNameConst = packed record
|
|
KeyName: String;
|
|
KeyConst: HKEY;
|
|
end;
|
|
const
|
|
KeyNameConsts: array[0..5] of TKeyNameConst = (
|
|
(KeyName: 'HKA'; KeyConst: HKEY_AUTO),
|
|
(KeyName: 'HKCR'; KeyConst: HKEY_CLASSES_ROOT),
|
|
(KeyName: 'HKCU'; KeyConst: HKEY_CURRENT_USER),
|
|
(KeyName: 'HKLM'; KeyConst: HKEY_LOCAL_MACHINE),
|
|
(KeyName: 'HKU'; KeyConst: HKEY_USERS),
|
|
(KeyName: 'HKCC'; KeyConst: HKEY_CURRENT_CONFIG));
|
|
var
|
|
Z, Subkey, Value, Default: String;
|
|
I, J, L: Integer;
|
|
RegView: TRegView;
|
|
RootKey: HKEY;
|
|
K: HKEY;
|
|
begin
|
|
Delete(C, 1, 4); { skip past 'reg:' }
|
|
I := ConstPos('\', C);
|
|
if I <> 0 then begin
|
|
Z := Copy(C, 1, I-1);
|
|
if Z <> '' then begin
|
|
RegView := InstallDefaultRegView;
|
|
L := Length(Z);
|
|
if L >= 2 then begin
|
|
{ Check for '32' or '64' suffix }
|
|
if (Z[L-1] = '3') and (Z[L] = '2') then begin
|
|
RegView := rv32Bit;
|
|
SetLength(Z, L-2);
|
|
end
|
|
else if (Z[L-1] = '6') and (Z[L] = '4') then begin
|
|
if not IsWin64 then
|
|
InternalError('Cannot access a 64-bit key in a "reg" constant on this version of Windows');
|
|
RegView := rv64Bit;
|
|
SetLength(Z, L-2);
|
|
end;
|
|
end;
|
|
RootKey := 0;
|
|
for J := Low(KeyNameConsts) to High(KeyNameConsts) do
|
|
if CompareText(KeyNameConsts[J].KeyName, Z) = 0 then begin
|
|
RootKey := KeyNameConsts[J].KeyConst;
|
|
if RootKey = HKEY_AUTO then
|
|
RootKey := InstallModeRootKey;
|
|
Break;
|
|
end;
|
|
if RootKey <> 0 then begin
|
|
Z := Copy(C, I+1, Maxint);
|
|
I := ConstPos('|', Z); { check for a 'default' data }
|
|
if I = 0 then
|
|
I := Length(Z)+1;
|
|
Default := Copy(Z, I+1, Maxint);
|
|
SetLength(Z, I-1);
|
|
I := ConstPos(',', Z); { comma separates subkey and value }
|
|
if I <> 0 then begin
|
|
Subkey := Copy(Z, 1, I-1);
|
|
Value := Copy(Z, I+1, Maxint);
|
|
if ConvertConstPercentStr(Subkey) and ConvertConstPercentStr(Value) and
|
|
ConvertConstPercentStr(Default) then begin
|
|
Result := ExpandConstEx(Default, CustomConsts);
|
|
if RegOpenKeyExView(RegView, RootKey,
|
|
PChar(ExpandConstEx(Subkey, CustomConsts)),
|
|
0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
|
|
RegQueryStringValue(K, PChar(ExpandConstEx(Value, CustomConsts)),
|
|
Result, True); { also allows REG_DWORD }
|
|
RegCloseKey(K);
|
|
end;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{ it will only reach here if there was a parsing error }
|
|
InternalError('Failed to parse "reg" constant');
|
|
end;
|
|
|
|
function ExpandIniConst(C: String): String;
|
|
{ Expands an INI-value constant in the form:
|
|
filename,section,key|defaultvalue }
|
|
var
|
|
Z, Filename, Section, Key, Default: String;
|
|
I: Integer;
|
|
begin
|
|
Delete(C, 1, 4); { skip past 'ini:' }
|
|
I := ConstPos(',', C);
|
|
if I <> 0 then begin
|
|
Z := Copy(C, 1, I-1);
|
|
if Z <> '' then begin
|
|
Filename := Z;
|
|
Z := Copy(C, I+1, Maxint);
|
|
I := ConstPos('|', Z); { check for a 'default' data }
|
|
if I = 0 then
|
|
I := Length(Z)+1;
|
|
Default := Copy(Z, I+1, Maxint);
|
|
SetLength(Z, I-1);
|
|
I := ConstPos(',', Z); { comma separates section and key }
|
|
if I <> 0 then begin
|
|
Section := Copy(Z, 1, I-1);
|
|
Key := Copy(Z, I+1, Maxint);
|
|
if ConvertConstPercentStr(Filename) and ConvertConstPercentStr(Section) and ConvertConstPercentStr(Key) and
|
|
ConvertConstPercentStr(Default) then begin
|
|
Filename := ExpandConstEx(Filename, CustomConsts);
|
|
Section := ExpandConstEx(Section, CustomConsts);
|
|
Key := ExpandConstEx(Key, CustomConsts);
|
|
Default := ExpandConstEx(Default, CustomConsts);
|
|
Result := GetIniString(Section, Key, Default, Filename);
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{ it will only reach here if there was a parsing error }
|
|
InternalError('Failed to parse "ini" constant');
|
|
end;
|
|
|
|
function ExpandParamConst(C: String): String;
|
|
{ Expands an commandline-parameter-value constant in the form:
|
|
parametername|defaultvalue }
|
|
|
|
function GetParamString(const Param, Default: String): String;
|
|
var
|
|
I, PCount: Integer;
|
|
Z: String;
|
|
begin
|
|
PCount := NewParamCount();
|
|
for I := 1 to PCount do begin
|
|
Z := NewParamStr(I);
|
|
if StrLIComp(PChar(Z), PChar('/'+Param+'='), Length(Param)+2) = 0 then begin
|
|
Delete(Z, 1, Length(Param)+2);
|
|
Result := Z;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
Result := Default;
|
|
end;
|
|
|
|
var
|
|
Z, Param, Default: String;
|
|
I: Integer;
|
|
begin
|
|
Delete(C, 1, 6); { skip past 'param:' }
|
|
Z := C;
|
|
I := ConstPos('|', Z); { check for a 'default' data }
|
|
if I = 0 then
|
|
I := Length(Z)+1;
|
|
Default := Copy(Z, I+1, Maxint);
|
|
SetLength(Z, I-1);
|
|
Param := Z;
|
|
if ConvertConstPercentStr(Param) and ConvertConstPercentStr(Default) then begin
|
|
Param := ExpandConstEx(Param, CustomConsts);
|
|
Default := ExpandConstEx(Default, CustomConsts);
|
|
Result := GetParamString(Param, Default);
|
|
Exit;
|
|
end;
|
|
{ it will only reach here if there was a parsing error }
|
|
InternalError('Failed to parse "param" constant');
|
|
end;
|
|
|
|
function ExpandCodeConst(C: String): String;
|
|
{ Expands an Pascal-script-value constant in the form:
|
|
parametername|defaultvalue }
|
|
|
|
function GetCodeString(const ScriptFunc, Default: String): String;
|
|
begin
|
|
if (CodeRunner <> nil) then
|
|
Result := CodeRunner.RunStringFunction(AnsiString(ScriptFunc), [Default], True, Default)
|
|
else begin
|
|
InternalError('"code" constant with no CodeRunner');
|
|
Result := '';
|
|
end;
|
|
end;
|
|
|
|
var
|
|
Z, ScriptFunc, Default: String;
|
|
I: Integer;
|
|
begin
|
|
if DisableCodeConsts <> 0 then
|
|
raise Exception.Create('Cannot evaluate "code" constant because of possible side effects');
|
|
|
|
Delete(C, 1, 5); { skip past 'code:' }
|
|
Z := C;
|
|
I := ConstPos('|', Z); { check for a 'default' data }
|
|
if I = 0 then
|
|
I := Length(Z)+1;
|
|
Default := Copy(Z, I+1, Maxint);
|
|
SetLength(Z, I-1);
|
|
ScriptFunc := Z;
|
|
if ConvertConstPercentStr(ScriptFunc) and ConvertConstPercentStr(Default) then begin
|
|
Default := ExpandConstEx(Default, CustomConsts);
|
|
Result := GetCodeString(ScriptFunc, Default);
|
|
Exit;
|
|
end;
|
|
{ it will only reach here if there was a parsing error }
|
|
InternalError('Failed to parse "code" constant');
|
|
end;
|
|
|
|
function ExpandDriveConst(C: String): String;
|
|
begin
|
|
Delete(C, 1, 6); { skip past 'drive:' }
|
|
if ConvertConstPercentStr(C) then begin
|
|
Result := PathExtractDrive(ExpandConstEx(C, CustomConsts));
|
|
Exit;
|
|
end;
|
|
{ it will only reach here if there was a parsing error }
|
|
InternalError('Failed to parse "drive" constant');
|
|
end;
|
|
|
|
function ExpandCustomMessageConst(C: String): String;
|
|
var
|
|
I, ArgCount: Integer;
|
|
MsgName: String;
|
|
ArgValues: array[0..8] of String; { %1 through %9 }
|
|
begin
|
|
Delete(C, 1, 3); { skip past 'cm:' }
|
|
I := ConstPos(',', C);
|
|
if I = 0 then
|
|
MsgName := C
|
|
else
|
|
MsgName := Copy(C, 1, I-1);
|
|
|
|
{ Prepare arguments. Excess arguments are ignored. }
|
|
ArgCount := 0;
|
|
while (I > 0) and (ArgCount <= High(ArgValues)) do begin
|
|
Delete(C, 1, I);
|
|
I := ConstPos(',', C);
|
|
if I = 0 then
|
|
ArgValues[ArgCount] := C
|
|
else
|
|
ArgValues[ArgCount] := Copy(C, 1, I-1);
|
|
if not ConvertConstPercentStr(ArgValues[ArgCount]) then
|
|
InternalError('Failed to parse "cm" constant');
|
|
ArgValues[ArgCount] := ExpandConstEx(ArgValues[ArgCount], CustomConsts);
|
|
Inc(ArgCount);
|
|
end;
|
|
|
|
{ Look up the message value }
|
|
if not GetCustomMessageValue(MsgName, Result) then
|
|
InternalError(Format('Unknown custom message name "%s" in "cm" constant', [MsgName]));
|
|
|
|
{ Expand the message }
|
|
Result := FmtMessage(PChar(Result), Slice(ArgValues, ArgCount));
|
|
end;
|
|
|
|
const
|
|
FolderConsts: array[Boolean, TShellFolderID] of String = (
|
|
{ Also see FolderIDs }
|
|
{ User }
|
|
('userdesktop', 'userstartmenu', 'userprograms', 'userstartup',
|
|
'usersendto', 'commonfonts', 'userappdata', 'userdocs', 'usertemplates',
|
|
'userfavorites', 'localappdata', 'userpf', 'usercf', 'usersavedgames'),
|
|
{ Common }
|
|
('commondesktop', 'commonstartmenu', 'commonprograms', 'commonstartup',
|
|
'usersendto', 'commonfonts', 'commonappdata', 'commondocs', 'commontemplates',
|
|
'commonfavorites' { not accepted anymore by the compiler }, '', '', '', ''));
|
|
NoUninstallConsts: array[0..6] of String =
|
|
('src', 'srcexe', 'userinfoname', 'userinfoorg', 'userinfoserial', 'hwnd',
|
|
'wizardhwnd');
|
|
var
|
|
OriginalCnst, ShellFolder: String;
|
|
Common: Boolean;
|
|
ShellFolderID: TShellFolderID;
|
|
I: Integer;
|
|
begin
|
|
OriginalCnst := Cnst;
|
|
HandleRenamedConstants(Cnst, nil);
|
|
HandleAutoConstants(Cnst);
|
|
|
|
if IsUninstaller then
|
|
for I := Low(NoUninstallConsts) to High(NoUninstallConsts) do
|
|
if NoUninstallConsts[I] = Cnst then
|
|
NoUninstallConstError(NoUninstallConsts[I]);
|
|
|
|
if Cnst = '\' then Result := '\'
|
|
else if Cnst = 'app' then begin
|
|
if IsUninstaller then begin
|
|
if UninstallExpandedApp = '' then
|
|
InternalError('An attempt was made to expand the "' + OriginalCnst + '" constant but Setup didn''t create the "app" dir');
|
|
Result := UninstallExpandedApp;
|
|
end else begin
|
|
if WizardDirValue = '' then
|
|
InternalError('An attempt was made to expand the "' + OriginalCnst + '" constant before it was initialized');
|
|
Result := WizardDirValue;
|
|
end;
|
|
end
|
|
else if Cnst = 'win' then Result := WinDir
|
|
else if Cnst = 'sys' then Result := WinSystemDir
|
|
else if Cnst = 'syswow64' then begin
|
|
if WinSysWow64Dir <> '' then
|
|
Result := WinSysWow64Dir
|
|
else begin
|
|
if IsWin64 then { sanity check }
|
|
InternalError('Cannot expand "' + OriginalCnst + '" constant because there is no SysWOW64 directory');
|
|
Result := WinSystemDir;
|
|
end;
|
|
end
|
|
else if Cnst = 'sysnative' then begin
|
|
if WinSysNativeDir <> '' then
|
|
Result := WinSysNativeDir
|
|
else
|
|
Result := WinSystemDir;
|
|
end
|
|
else if Cnst = 'src' then Result := SourceDir
|
|
else if Cnst = 'srcexe' then Result := SetupLdrOriginalFilename
|
|
else if Cnst = 'tmp' then Result := TempInstallDir
|
|
else if Cnst = 'sd' then Result := SystemDrive
|
|
else if Cnst = 'commonpf' then begin
|
|
if Is64BitInstallMode then
|
|
Result := ProgramFiles64Dir
|
|
else
|
|
Result := ProgramFiles32Dir;
|
|
end
|
|
else if Cnst = 'commoncf' then begin
|
|
if Is64BitInstallMode then
|
|
Result := CommonFiles64Dir
|
|
else
|
|
Result := CommonFiles32Dir;
|
|
end
|
|
else if Cnst = 'commonpf32' then Result := ProgramFiles32Dir
|
|
else if Cnst = 'commoncf32' then Result := CommonFiles32Dir
|
|
else if Cnst = 'commonpf64' then begin
|
|
if IsWin64 then
|
|
Result := ProgramFiles64Dir
|
|
else
|
|
InternalError('Cannot expand "' + OriginalCnst + '" constant on this version of Windows');
|
|
end
|
|
else if Cnst = 'commoncf64' then begin
|
|
if IsWin64 then
|
|
Result := CommonFiles64Dir
|
|
else
|
|
InternalError('Cannot expand "' + OriginalCnst + '" constant on this version of Windows');
|
|
end
|
|
else if Cnst = 'userfonts' then Result := ExpandConst('{localappdata}\Microsoft\Windows\Fonts') { supported by Windows 10 Version 1803 and newer. doesn't have a KNOWNFOLDERID. }
|
|
else if Cnst = 'dao' then Result := ExpandConst('{cf}\Microsoft Shared\DAO')
|
|
else if Cnst = 'cmd' then Result := CmdFilename
|
|
else if Cnst = 'computername' then Result := GetComputerNameString
|
|
else if Cnst = 'username' then Result := GetUserNameString
|
|
else if Cnst = 'groupname' then begin
|
|
if IsUninstaller then begin
|
|
if UninstallExpandedGroupName = '' then
|
|
InternalError('Cannot expand "' + OriginalCnst + '" constant because it was not available at install time');
|
|
Result := UninstallExpandedGroupName;
|
|
end
|
|
else begin
|
|
if WizardGroupValue = '' then
|
|
InternalError('An attempt was made to expand the "' + OriginalCnst + '" constant before it was initialized');
|
|
Result := WizardGroupValue;
|
|
end;
|
|
end
|
|
else if Cnst = 'sysuserinfoname' then Result := SysUserInfoName
|
|
else if Cnst = 'sysuserinfoorg' then Result := SysUserInfoOrg
|
|
else if Cnst = 'userinfoname' then Result := WizardUserInfoName
|
|
else if Cnst = 'userinfoorg' then Result := WizardUserInfoOrg
|
|
else if Cnst = 'userinfoserial' then Result := WizardUserInfoSerial
|
|
else if Cnst = 'uninstallexe' then Result := UninstallExeFilename
|
|
else if Cnst = 'group' then begin
|
|
if IsUninstaller then begin
|
|
if UninstallExpandedGroup = '' then
|
|
InternalError('Cannot expand "' + OriginalCnst + '" constant because it was not available at install time');
|
|
Result := UninstallExpandedGroup;
|
|
end
|
|
else begin
|
|
if WizardGroupValue = '' then
|
|
InternalError('An attempt was made to expand the "' + OriginalCnst + '" constant before it was initialized');
|
|
ShellFolder := GetShellFolder(not(shAlwaysUsePersonalGroup in SetupHeader.Options) and IsAdminInstallMode,
|
|
sfPrograms);
|
|
if ShellFolder = '' then
|
|
InternalError('Failed to expand "' + OriginalCnst + '" constant');
|
|
Result := AddBackslash(ShellFolder) + WizardGroupValue;
|
|
end;
|
|
end
|
|
else if Cnst = 'language' then begin
|
|
if IsUninstaller then
|
|
Result := UninstallExpandedLanguage
|
|
else
|
|
Result := PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name
|
|
end
|
|
else if Cnst = 'wizardhwnd' then begin
|
|
if Assigned(WizardForm) then
|
|
Result := IntToStr(WizardForm.Handle)
|
|
else
|
|
Result := '0';
|
|
end
|
|
else if Cnst = 'log' then Result := GetLogFileName
|
|
else if Cnst = 'dotnet11' then Result := GetDotNetVersionInstallRoot(rv32Bit, netbase11)
|
|
else if Cnst = 'dotnet20' then Result := GetDotNetVersionInstallRoot(InstallDefaultRegView, netbase20)
|
|
else if Cnst = 'dotnet2032' then Result := GetDotNetVersionInstallRoot(rv32Bit, netbase20)
|
|
else if Cnst = 'dotnet2064' then begin
|
|
if IsWin64 then
|
|
Result := GetDotNetVersionInstallRoot(rv64Bit, netbase20)
|
|
else
|
|
InternalError('Cannot expand "' + OriginalCnst + '" constant on this version of Windows');
|
|
end
|
|
else if Cnst = 'dotnet40' then Result := GetDotNetVersionInstallRoot(InstallDefaultRegView, netbase40)
|
|
else if Cnst = 'dotnet4032' then Result := GetDotNetVersionInstallRoot(rv32Bit, netbase40)
|
|
else if Cnst = 'dotnet4064' then begin
|
|
if IsWin64 then
|
|
Result := GetDotNetVersionInstallRoot(rv64Bit, netbase40)
|
|
else
|
|
InternalError('Cannot expand "' + OriginalCnst + '" constant on this version of Windows');
|
|
end
|
|
else if (Cnst <> '') and (Cnst[1] = '%') then Result := ExpandEnvConst(Cnst)
|
|
else if StrLComp(PChar(Cnst), 'reg:', 4) = 0 then Result := ExpandRegConst(Cnst)
|
|
else if StrLComp(PChar(Cnst), 'ini:', 4) = 0 then Result := ExpandIniConst(Cnst)
|
|
else if StrLComp(PChar(Cnst), 'param:', 6) = 0 then Result := ExpandParamConst(Cnst)
|
|
else if StrLComp(PChar(Cnst), 'code:', 5) = 0 then Result := ExpandCodeConst(Cnst)
|
|
else if StrLComp(PChar(Cnst), 'drive:', 6) = 0 then Result := ExpandDriveConst(Cnst)
|
|
else if StrLComp(PChar(Cnst), 'cm:', 3) = 0 then Result := ExpandCustomMessageConst(Cnst)
|
|
else begin
|
|
{ Shell folder constants }
|
|
if Cnst <> '' then
|
|
for Common := False to True do
|
|
for ShellFolderID := Low(ShellFolderID) to High(ShellFolderID) do
|
|
if Cnst = FolderConsts[Common, ShellFolderID] then begin
|
|
ShellFolder := GetShellFolder(Common, ShellFolderID);
|
|
if ShellFolder = '' then
|
|
InternalError(Format('Failed to expand shell folder constant "%s"', [OriginalCnst]));
|
|
Result := ShellFolder;
|
|
Exit;
|
|
end;
|
|
{ Custom constants }
|
|
if Cnst <> '' then begin
|
|
I := 0;
|
|
while I < High(CustomConsts) do begin
|
|
if Cnst = CustomConsts[I] then begin
|
|
Result := CustomConsts[I+1];
|
|
Exit;
|
|
end;
|
|
Inc(I, 2);
|
|
end;
|
|
end;
|
|
{ Unknown constant }
|
|
InternalError(Format('Unknown constant "%s"', [OriginalCnst]));
|
|
end;
|
|
end;
|
|
|
|
function ExpandConst(const S: String): String;
|
|
begin
|
|
Result := ExpandConstEx2(S, [''], True);
|
|
end;
|
|
|
|
function ExpandConstEx(const S: String; const CustomConsts: array of String): String;
|
|
begin
|
|
Result := ExpandConstEx2(S, CustomConsts, True);
|
|
end;
|
|
|
|
function ExpandConstEx2(const S: String; const CustomConsts: array of String;
|
|
const DoExpandIndividualConst: Boolean): String;
|
|
var
|
|
I, Start: Integer;
|
|
Cnst, ReplaceWith: String;
|
|
begin
|
|
Result := S;
|
|
I := 1;
|
|
while I <= Length(Result) do begin
|
|
if Result[I] = '{' then begin
|
|
if (I < Length(Result)) and (Result[I+1] = '{') then begin
|
|
{ Change '{{' to '{' if not in an embedded constant }
|
|
Inc(I);
|
|
Delete(Result, I, 1);
|
|
end
|
|
else begin
|
|
Start := I;
|
|
{ Find the closing brace, skipping over any embedded constants }
|
|
I := SkipPastConst(Result, I);
|
|
if I = 0 then { unclosed constant? }
|
|
InternalError('Unclosed constant');
|
|
Dec(I); { 'I' now points to the closing brace }
|
|
|
|
if DoExpandIndividualConst then begin
|
|
{ Now translate the constant }
|
|
Cnst := Copy(Result, Start+1, I-(Start+1));
|
|
ReplaceWith := ExpandIndividualConst(Cnst, CustomConsts);
|
|
Delete(Result, Start, (I+1)-Start);
|
|
Insert(ReplaceWith, Result, Start);
|
|
I := Start + Length(ReplaceWith);
|
|
if (ReplaceWith <> '') and (PathLastChar(ReplaceWith)^ = '\') and
|
|
(I <= Length(Result)) and (Result[I] = '\') then
|
|
Delete(Result, I, 1);
|
|
end else
|
|
Inc(I); { Skip closing brace }
|
|
end;
|
|
end
|
|
else
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
function ExpandConstIfPrefixed(const S: String): String;
|
|
const
|
|
ExpandPrefix = 'expand:';
|
|
begin
|
|
if Pos(ExpandPrefix, S) = 1 then begin
|
|
Inc(DisableCodeConsts);
|
|
try
|
|
Result := ExpandConst(Copy(S, Length(ExpandPrefix)+1, Maxint));
|
|
finally
|
|
Dec(DisableCodeConsts);
|
|
end;
|
|
end
|
|
else
|
|
Result := S;
|
|
end;
|
|
|
|
procedure InitMainNonSHFolderConsts;
|
|
|
|
function GetPath(const RegView: TRegView; const Name: PChar): String;
|
|
var
|
|
H: HKEY;
|
|
begin
|
|
if RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, REGSTR_PATH_SETUP, 0,
|
|
KEY_QUERY_VALUE, H) = ERROR_SUCCESS then begin
|
|
if not RegQueryStringValue(H, Name, Result) then
|
|
Result := '';
|
|
RegCloseKey(H);
|
|
end
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
procedure ReadSysUserInfo;
|
|
var
|
|
RegView: TRegView;
|
|
K: HKEY;
|
|
begin
|
|
{ Windows 7 x64 (and later?) is bugged: the owner and organization
|
|
are set to "Microsoft" on the 32-bit key. So on 64-bit Windows, read
|
|
from the 64-bit key. (The bug doesn't exist on 64-bit XP or Server 2003,
|
|
but it's safe to read the 64-bit key on those versions too.) }
|
|
if IsWin64 then
|
|
RegView := rv64Bit
|
|
else
|
|
RegView := rvDefault;
|
|
if RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion',
|
|
0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
|
|
RegQueryStringValue(K, 'RegisteredOwner', SysUserInfoName);
|
|
RegQueryStringValue(K, 'RegisteredOrganization', SysUserInfoOrg);
|
|
RegCloseKey(K);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
{ Read Windows and Windows System dirs }
|
|
WinDir := GetWinDir;
|
|
WinSystemDir := GetSystemDir;
|
|
WinSysWow64Dir := GetSysWow64Dir;
|
|
WinSysNativeDir := GetSysNativeDir(IsWin64);
|
|
|
|
{ Get system drive }
|
|
SystemDrive := GetEnv('SystemDrive'); {don't localize}
|
|
if SystemDrive = '' then begin
|
|
SystemDrive := PathExtractDrive(WinDir);
|
|
if SystemDrive = '' then
|
|
{ In some rare case that PathExtractDrive failed, just default to C }
|
|
SystemDrive := 'C:';
|
|
end;
|
|
|
|
{ Get 32-bit Program Files and Common Files dirs }
|
|
ProgramFiles32Dir := GetPath(rv32Bit, 'ProgramFilesDir');
|
|
if ProgramFiles32Dir = '' then
|
|
ProgramFiles32Dir := SystemDrive + '\Program Files'; {don't localize}
|
|
CommonFiles32Dir := GetPath(rv32Bit, 'CommonFilesDir');
|
|
if CommonFiles32Dir = '' then
|
|
CommonFiles32Dir := AddBackslash(ProgramFiles32Dir) + 'Common Files'; {don't localize}
|
|
|
|
{ Get 64-bit Program Files and Common Files dirs }
|
|
if IsWin64 then begin
|
|
ProgramFiles64Dir := GetPath(rv64Bit, 'ProgramFilesDir');
|
|
if ProgramFiles64Dir = '' then
|
|
InternalError('Failed to get path of 64-bit Program Files directory');
|
|
CommonFiles64Dir := GetPath(rv64Bit, 'CommonFilesDir');
|
|
if CommonFiles64Dir = '' then
|
|
InternalError('Failed to get path of 64-bit Common Files directory');
|
|
end;
|
|
|
|
{ Get path of command interpreter }
|
|
CmdFilename := AddBackslash(WinSystemDir) + 'cmd.exe';
|
|
|
|
{ Get user info from system }
|
|
ReadSysUserInfo;
|
|
end;
|
|
|
|
procedure SaveStreamToTempFile(const Strm: TCustomMemoryStream;
|
|
const Filename: String);
|
|
var
|
|
ErrorCode: DWORD;
|
|
begin
|
|
try
|
|
Strm.SaveToFile(Filename);
|
|
except
|
|
{ Display more useful error message than 'Stream write error' etc. }
|
|
on EStreamError do begin
|
|
ErrorCode := GetLastError;
|
|
raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
|
|
[SetupMessages[msgLdrCannotCreateTemp], IntToStr(ErrorCode),
|
|
Win32ErrorString(ErrorCode)]));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SaveResourceToTempFile(const ResName, Filename: String);
|
|
var
|
|
ResStrm: TResourceStream;
|
|
begin
|
|
ResStrm := TResourceStream.Create(HInstance, ResName, RT_RCDATA);
|
|
try
|
|
SaveStreamToTempFile(ResStrm, Filename);
|
|
finally
|
|
ResStrm.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure CreateTempInstallDirAndExtract64BitHelper;
|
|
{ Initializes TempInstallDir and extracts the 64-bit helper into it if needed.
|
|
This is called by Setup, Uninstall, and RegSvr. }
|
|
begin
|
|
var Protected: Boolean;
|
|
TempInstallDir := CreateTempDir(IsAdmin and not Debugging, Protected);
|
|
LogFmt('Created %stemporary directory: %s', [IfThen(Protected, 'protected ', ''), TempInstallDir]);
|
|
if Debugging then
|
|
DebugNotifyTempDir(TempInstallDir);
|
|
|
|
{ Create _isetup subdirectory to hold our internally-used files to ensure
|
|
they won't use any DLLs the install creator might've dumped into
|
|
TempInstallDir }
|
|
var Subdir := AddBackslash(TempInstallDir) + '_isetup';
|
|
if not CreateDirectory(PChar(Subdir), nil) then begin
|
|
var ErrorCode := GetLastError;
|
|
raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
|
|
[FmtSetupMessage1(msgErrorCreatingDir, Subdir), IntToStr(ErrorCode),
|
|
Win32ErrorString(ErrorCode)]));
|
|
end;
|
|
|
|
{ Extract 64-bit helper EXE, if one is available for the current processor
|
|
architecture }
|
|
var ResName := GetHelperResourceName;
|
|
if ResName <> '' then begin
|
|
var Filename := Subdir + '\_setup64.tmp';
|
|
SaveResourceToTempFile(ResName, Filename);
|
|
SetHelperExeFilename(Filename);
|
|
end;
|
|
end;
|
|
|
|
function TempDeleteFileProc(const DisableFsRedir: Boolean;
|
|
const FileName: String; const Param: Pointer): Boolean;
|
|
var
|
|
Elapsed: DWORD;
|
|
label Retry;
|
|
begin
|
|
Retry:
|
|
Result := DeleteFileRedir(DisableFsRedir, FileName);
|
|
if not Result and
|
|
(GetLastError <> ERROR_FILE_NOT_FOUND) and
|
|
(GetLastError <> ERROR_PATH_NOT_FOUND) then begin
|
|
{ If we get here, the file is probably still in use. On an SMP machine,
|
|
it's possible for an EXE to remain locked by Windows for a short time
|
|
after it terminates, causing DeleteFile to fail with ERROR_ACCESS_DENIED.
|
|
(I'm not sure this issue can really be seen here in practice; I could
|
|
only reproduce it consistently by calling DeleteFile() *immediately*
|
|
after waiting on the process handle.)
|
|
Retry if fewer than 2 seconds have passed since DelTree started,
|
|
otherwise assume the error must be permanent and give up. 2 seconds
|
|
ought to be more than enough for the SMP case. }
|
|
Elapsed := GetTickCount - DWORD(Param);
|
|
if Cardinal(Elapsed) < Cardinal(2000) then begin
|
|
Sleep(50);
|
|
goto Retry;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure RemoveTempInstallDir;
|
|
{ Removes TempInstallDir and all its contents. Stops the 64-bit helper first
|
|
if necessary. }
|
|
begin
|
|
{ Stop 64-bit helper if it's running }
|
|
StopHelper(False);
|
|
SetHelperExeFilename('');
|
|
|
|
if TempInstallDir <> '' then begin
|
|
if Debugging then
|
|
DebugNotifyTempDir('');
|
|
if not DelTree(False, TempInstallDir, True, True, True, False, nil,
|
|
TempDeleteFileProc, Pointer(GetTickCount())) then
|
|
Log('Failed to remove temporary directory: ' + TempInstallDir);
|
|
end;
|
|
end;
|
|
|
|
procedure LoadSHFolderDLL;
|
|
var
|
|
Filename: String;
|
|
const
|
|
shfolder = 'shfolder.dll';
|
|
begin
|
|
Filename := AddBackslash(GetSystemDir) + shfolder;
|
|
{ Ensure shell32.dll is pre-loaded so it isn't loaded/freed for each
|
|
individual SHGetFolderPath call }
|
|
SafeLoadLibrary(AddBackslash(GetSystemDir) + shell32, SEM_NOOPENFILEERRORBOX);
|
|
SHFolderDLLHandle := SafeLoadLibrary(Filename, SEM_NOOPENFILEERRORBOX);
|
|
if SHFolderDLLHandle = 0 then
|
|
InternalError(Format('Failed to load DLL "%s"', [Filename]));
|
|
@SHGetFolderPathFunc := GetProcAddress(SHFolderDLLHandle, 'SHGetFolderPathW');
|
|
if @SHGetFolderPathFunc = nil then
|
|
InternalError('Failed to get address of SHGetFolderPath function');
|
|
end;
|
|
|
|
procedure UnloadSHFolderDLL;
|
|
begin
|
|
@SHGetFolderPathFunc := nil;
|
|
if SHFolderDLLHandle <> 0 then begin
|
|
FreeLibrary(SHFolderDLLHandle);
|
|
SHFolderDLLHandle := 0;
|
|
end;
|
|
end;
|
|
|
|
function GetShellFolderByCSIDL(Folder: Integer; const Create: Boolean): String;
|
|
const
|
|
CSIDL_FLAG_CREATE = $8000;
|
|
SHGFP_TYPE_CURRENT = 0;
|
|
var
|
|
Res: HRESULT;
|
|
Buf: array[0..MAX_PATH-1] of Char;
|
|
begin
|
|
{ Note: Must pass Create=True or else SHGetFolderPath fails if the
|
|
specified CSIDL is valid but doesn't currently exist. }
|
|
if Create then
|
|
Folder := Folder or CSIDL_FLAG_CREATE;
|
|
|
|
{ Work around a nasty bug in Windows Vista and Windows Server 2008 and maybe
|
|
later versions also: When a folder ID resolves to the root directory of a
|
|
drive ('X:\') and the CSIDL_FLAG_CREATE flag is passed, SHGetFolderPath
|
|
fails with code 0x80070005.
|
|
So, first try calling the function without CSIDL_FLAG_CREATE.
|
|
If and only if that fails, call it again with the flag.
|
|
Note: The calls *must* be issued in this order; if it's called with the
|
|
flag first, it seems to permanently cache the failure code, causing future
|
|
calls that don't include the flag to fail as well. }
|
|
if Folder and CSIDL_FLAG_CREATE <> 0 then
|
|
Res := SHGetFolderPathFunc(0, Folder and not CSIDL_FLAG_CREATE, 0,
|
|
SHGFP_TYPE_CURRENT, Buf)
|
|
else
|
|
Res := E_FAIL; { always issue the call below }
|
|
|
|
if Res <> S_OK then
|
|
Res := SHGetFolderPathFunc(0, Folder, 0, SHGFP_TYPE_CURRENT, Buf);
|
|
if Res = S_OK then
|
|
Result := RemoveBackslashUnlessRoot(PathExpand(Buf))
|
|
else begin
|
|
Result := '';
|
|
LogFmt('Warning: SHGetFolderPath failed with code 0x%.8x on folder 0x%.4x',
|
|
[Res, Folder]);
|
|
end;
|
|
end;
|
|
|
|
function GetShellFolderByGUID(Folder: TGUID; const Create: Boolean): String;
|
|
begin
|
|
if Assigned(SHGetKnownFolderPathFunc) then begin
|
|
var dwFlags: DWORD := 0;
|
|
if Create then
|
|
dwFlags := dwFlags or KF_FLAG_CREATE;
|
|
var Path: PWideChar;
|
|
{ Note: Must pass Create=True or else SHGetKnownFolderPath fails if the
|
|
specified GUID is valid but doesn't currently exist. }
|
|
var Res := SHGetKnownFolderPathFunc(Folder, dwFlags, 0, Path);
|
|
if Res = S_OK then begin
|
|
Result := WideCharToString(Path);
|
|
CoTaskMemFree(Path);
|
|
end else begin
|
|
Result := '';
|
|
LogFmt('Warning: SHGetKnownFolderPath failed with code 0x%.8x', [Res]);
|
|
end;
|
|
end else
|
|
Result := '';
|
|
end;
|
|
|
|
function GetShellFolder(const Common: Boolean; const ID: TShellFolderID): String;
|
|
const
|
|
CSIDL_COMMON_STARTMENU = $0016;
|
|
CSIDL_COMMON_PROGRAMS = $0017;
|
|
CSIDL_COMMON_STARTUP = $0018;
|
|
CSIDL_COMMON_DESKTOPDIRECTORY = $0019;
|
|
CSIDL_APPDATA = $001A;
|
|
CSIDL_LOCAL_APPDATA = $001C;
|
|
CSIDL_COMMON_FAVORITES = $001F;
|
|
CSIDL_COMMON_APPDATA = $0023;
|
|
CSIDL_COMMON_TEMPLATES = $002D;
|
|
CSIDL_COMMON_DOCUMENTS = $002E;
|
|
FolderIDs: array[Boolean, TShellFolderID] of Integer = (
|
|
{ Values must match FolderConsts }
|
|
{ User }
|
|
(CSIDL_DESKTOPDIRECTORY, CSIDL_STARTMENU, CSIDL_PROGRAMS, CSIDL_STARTUP,
|
|
CSIDL_SENDTO, CSIDL_FONTS, CSIDL_APPDATA, CSIDL_PERSONAL,
|
|
CSIDL_TEMPLATES, CSIDL_FAVORITES, CSIDL_LOCAL_APPDATA, 0, 0, 0),
|
|
{ Common }
|
|
(CSIDL_COMMON_DESKTOPDIRECTORY, CSIDL_COMMON_STARTMENU, CSIDL_COMMON_PROGRAMS, CSIDL_COMMON_STARTUP,
|
|
CSIDL_SENDTO, CSIDL_FONTS, CSIDL_COMMON_APPDATA, CSIDL_COMMON_DOCUMENTS,
|
|
CSIDL_COMMON_TEMPLATES, CSIDL_COMMON_FAVORITES, 0, 0, 0, 0));
|
|
FOLDERID_UserProgramFiles: TGUID = (D1:$5CD7AEE2; D2:$2219; D3:$4A67; D4:($B8,$5D,$6C,$9C,$E1,$56,$60,$CB));
|
|
FOLDERID_UserProgramFilesCommon: TGUID = (D1:$BCBD3057; D2:$CA5C; D3:$4622; D4:($B4,$2D,$BC,$56,$DB,$0A,$E5,$16));
|
|
FOLDERID_SavedGames: TGUID = (D1:$4C5C32FF; D2:$BB9D; D3:$43B0; D4:($B5,$B4,$2D,$72,$E5,$4E,$AA,$A4));
|
|
var
|
|
ShellFolder: String;
|
|
begin
|
|
if not ShellFoldersRead[Common, ID] then begin
|
|
if ID = sfUserProgramFiles then
|
|
ShellFolder := GetShellFolderByGUID(FOLDERID_UserProgramFiles, True)
|
|
else if ID = sfUserCommonFiles then
|
|
ShellFolder := GetShellFolderByGUID(FOLDERID_UserProgramFilesCommon, True)
|
|
else if ID = sfUserSavedGames then
|
|
ShellFolder := GetShellFolderByGUID(FOLDERID_SavedGames, True)
|
|
else
|
|
ShellFolder := GetShellFolderByCSIDL(FolderIDs[Common, ID], True);
|
|
ShellFolders[Common, ID] := ShellFolder;
|
|
ShellFoldersRead[Common, ID] := True;
|
|
end;
|
|
Result := ShellFolders[Common, ID];
|
|
end;
|
|
|
|
function InstallOnThisVersion(const MinVersion: TSetupVersionData;
|
|
const OnlyBelowVersion: TSetupVersionData): TInstallOnThisVersionResult;
|
|
var
|
|
Ver, Ver2, MinVer, OnlyBelowVer: Cardinal;
|
|
begin
|
|
Ver := WindowsVersion;
|
|
MinVer := MinVersion.NTVersion;
|
|
OnlyBelowVer := OnlyBelowVersion.NTVersion;
|
|
Result := irInstall;
|
|
if MinVer = 0 then
|
|
Result := irNotOnThisPlatform
|
|
else begin
|
|
if Ver < MinVer then
|
|
Result := irVersionTooLow
|
|
else if (LongRec(Ver).Hi = LongRec(MinVer).Hi) and
|
|
(NTServicePackLevel < MinVersion.NTServicePack) then
|
|
Result := irServicePackTooLow
|
|
else begin
|
|
if OnlyBelowVer <> 0 then begin
|
|
Ver2 := Ver;
|
|
{ A build number of 0 on OnlyBelowVersion means 'match any build' }
|
|
if LongRec(OnlyBelowVer).Lo = 0 then
|
|
Ver2 := Ver2 and $FFFF0000; { set build number to zero on Ver2 also }
|
|
{ Note: When OnlyBelowVersion includes a service pack level, the
|
|
version number test changes from a "<" to "<=" operation. Thus,
|
|
on Windows 2000 SP4, 5.0 and 5.0.2195 will fail, but 5.0sp5 and
|
|
5.0.2195sp5 will pass. }
|
|
if (Ver2 > OnlyBelowVer) or
|
|
((Ver2 = OnlyBelowVer) and
|
|
(OnlyBelowVersion.NTServicePack = 0)) or
|
|
((LongRec(Ver).Hi = LongRec(OnlyBelowVer).Hi) and
|
|
(OnlyBelowVersion.NTServicePack <> 0) and
|
|
(NTServicePackLevel >= OnlyBelowVersion.NTServicePack)) then
|
|
Result := irVerTooHigh;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetSizeOfComponent(const ComponentName: String; const ExtraDiskSpaceRequired: Integer64): Integer64;
|
|
var
|
|
ComponentNameAsList: TStringList;
|
|
FileEntry: PSetupFileEntry;
|
|
I: Integer;
|
|
begin
|
|
Result := ExtraDiskSpaceRequired;
|
|
|
|
ComponentNameAsList := TStringList.Create();
|
|
try
|
|
ComponentNameAsList.Add(ComponentName);
|
|
for I := 0 to Entries[seFile].Count-1 do begin
|
|
FileEntry := PSetupFileEntry(Entries[seFile][I]);
|
|
with FileEntry^ do begin
|
|
if (Components <> '') and
|
|
((Tasks = '') and (Check = '')) then begin {don't count tasks or scripted entries}
|
|
if ShouldProcessFileEntry(ComponentNameAsList, nil, FileEntry, True) then begin
|
|
if LocationEntry <> -1 then
|
|
Inc6464(Result, PSetupFileLocationEntry(Entries[seFileLocation][LocationEntry])^.OriginalSize)
|
|
else
|
|
Inc6464(Result, ExternalSize);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
ComponentNameAsList.Free();
|
|
end;
|
|
end;
|
|
|
|
function GetSizeOfType(const TypeName: String; const IsCustom: Boolean): Integer64;
|
|
var
|
|
ComponentTypes: TStringList;
|
|
I: Integer;
|
|
begin
|
|
Result := To64(0);
|
|
ComponentTypes := TStringList.Create();
|
|
|
|
for I := 0 to Entries[seComponent].Count-1 do begin
|
|
with PSetupComponentEntry(Entries[seComponent][I])^ do begin
|
|
SetStringsFromCommaString(ComponentTypes, Types);
|
|
{ For custom types, only count fixed components. Otherwise count all. }
|
|
if IsCustom then begin
|
|
if (coFixed in Options) and ListContains(ComponentTypes, TypeName) then
|
|
Inc6464(Result, Size);
|
|
end else begin
|
|
if ListContains(ComponentTypes, TypeName) then
|
|
Inc6464(Result, Size);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
ComponentTypes.Free();
|
|
end;
|
|
|
|
function IsRecurseableDirectory(const FindData: TWin32FindData): Boolean;
|
|
{ Returns True if FindData is a directory that may be recursed into.
|
|
Intended only for use when processing external+recursesubdirs file entries. }
|
|
begin
|
|
Result :=
|
|
(FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0) and
|
|
(FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN = 0) and
|
|
(StrComp(FindData.cFileName, '.') <> 0) and
|
|
(StrComp(FindData.cFileName, '..') <> 0);
|
|
end;
|
|
|
|
type
|
|
TEnumFilesProc = function(const DisableFsRedir: Boolean; const Filename: String;
|
|
const Param: Pointer): Boolean;
|
|
|
|
function DummyDeleteDirProc(const DisableFsRedir: Boolean; const Filename: String;
|
|
const Param: Pointer): Boolean;
|
|
begin
|
|
{ We don't actually want to delete the dir, so just return success. }
|
|
Result := True;
|
|
end;
|
|
|
|
{ Enumerates the files we're going to install and delete. Returns True on success.
|
|
Likewise EnumFilesProc should return True on success and return False
|
|
to break the enum and to cause EnumFiles to return False instead of True. }
|
|
function EnumFiles(const EnumFilesProc: TEnumFilesProc;
|
|
const WizardComponents, WizardTasks: TStringList; const Param: Pointer): Boolean;
|
|
|
|
function RecurseExternalFiles(const DisableFsRedir: Boolean;
|
|
const SearchBaseDir, SearchSubDir, SearchWildcard: String;
|
|
const SourceIsWildcard: Boolean; const Excludes: TStrings; const CurFile: PSetupFileEntry): Boolean;
|
|
begin
|
|
{ Also see RecurseExternalGetSizeOfFiles below and RecurseExternalCopyFiles in Setup.Install
|
|
Also see RecurseExternalArchiveFiles directly below }
|
|
Result := True;
|
|
|
|
var FindData: TWin32FindData;
|
|
var H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + SearchWildcard, FindData);
|
|
if H <> INVALID_HANDLE_VALUE then begin
|
|
try
|
|
repeat
|
|
if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
|
|
|
|
if SourceIsWildcard then
|
|
if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
|
|
Continue;
|
|
|
|
if IsExcluded(SearchSubDir + FindData.cFileName, Excludes) then
|
|
Continue;
|
|
|
|
{ Note: CurFile^.DestName only includes a a filename if foCustomDestName is set,
|
|
see TSetupCompiler.EnumFilesProc.ProcessFileList }
|
|
var DestFile := ExpandConst(CurFile^.DestName);
|
|
if not(foCustomDestName in CurFile^.Options) then
|
|
DestFile := DestFile + SearchSubDir + FindData.cFileName
|
|
else if SearchSubDir <> '' then
|
|
DestFile := PathExtractPath(DestFile) + SearchSubDir + PathExtractName(DestFile);
|
|
if not EnumFilesProc(DisableFsRedir, DestFile, Param) then begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
until not FindNextFile(H, FindData);
|
|
finally
|
|
Windows.FindClose(H);
|
|
end;
|
|
end;
|
|
|
|
if foRecurseSubDirsExternal in CurFile^.Options then begin
|
|
H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + '*', FindData);
|
|
if H <> INVALID_HANDLE_VALUE then begin
|
|
try
|
|
repeat
|
|
if IsRecurseableDirectory(FindData) then
|
|
if not RecurseExternalFiles(DisableFsRedir, SearchBaseDir,
|
|
SearchSubDir + FindData.cFileName + '\', SearchWildcard,
|
|
SourceIsWildcard, Excludes, CurFile) then
|
|
Exit(False);
|
|
until not FindNextFile(H, FindData);
|
|
finally
|
|
Windows.FindClose(H);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function RecurseExternalArchiveFiles(const DisableFsRedir: Boolean;
|
|
const ArchiveFilename: String; const Excludes: TStrings;
|
|
const CurFile: PSetupFileEntry): Boolean;
|
|
begin
|
|
{ See above }
|
|
Result := True;
|
|
|
|
if not NewFileExistsRedir(DisableFsRedir, ArchiveFilename) then
|
|
Exit;
|
|
|
|
if foCustomDestName in CurFile^.Options then
|
|
InternalError('Unexpected CustomDestName flag');
|
|
const DestDir = ExpandConst(CurFile^.DestName);
|
|
|
|
var FindData: TWin32FindData;
|
|
var H := ArchiveFindFirstFileRedir(DisableFsRedir, ArchiveFilename, DestDir,
|
|
ExpandConst(CurFile^.ExtractArchivePassword), foRecurseSubDirsExternal in CurFile^.Options,
|
|
False, FindData);
|
|
if H <> INVALID_HANDLE_VALUE then begin
|
|
try
|
|
repeat
|
|
if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
|
|
|
|
if IsExcluded(FindData.cFileName, Excludes) then
|
|
Continue;
|
|
|
|
const DestFile = DestDir + FindData.cFileName;
|
|
if not EnumFilesProc(DisableFsRedir, DestFile, Param) then
|
|
Exit(False);
|
|
end;
|
|
until not ArchiveFindNextFile(H, FindData);
|
|
finally
|
|
ArchiveFindClose(H);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
I: Integer;
|
|
CurFile: PSetupFileEntry;
|
|
DisableFsRedir: Boolean;
|
|
SourceWildcard: String;
|
|
begin
|
|
Result := True;
|
|
|
|
{ [Files] }
|
|
const Excludes = TStringList.Create;
|
|
try
|
|
Excludes.StrictDelimiter := True;
|
|
Excludes.Delimiter := ',';
|
|
|
|
for I := 0 to Entries[seFile].Count-1 do begin
|
|
CurFile := PSetupFileEntry(Entries[seFile][I]);
|
|
if (CurFile^.FileType = ftUserFile) and
|
|
ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin
|
|
DisableFsRedir := ShouldDisableFsRedirForFileEntry(CurFile);
|
|
if CurFile^.LocationEntry <> -1 then begin
|
|
{ Non-external file }
|
|
if not EnumFilesProc(DisableFsRedir, ExpandConst(CurFile^.DestName), Param) then begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
end
|
|
else begin
|
|
{ External file }
|
|
if foDownload in CurFile^.Options then begin
|
|
{ Archive download should have been done already by Setup.WizardForm's DownloadArchivesToExtract }
|
|
if foExtractArchive in CurFile^.Options then
|
|
InternalError('Unexpected Download flag');
|
|
if not(foCustomDestName in CurFile^.Options) then
|
|
InternalError('Expected CustomDestName flag');
|
|
{ CurFile^.DestName now includes a filename, see TSetupCompiler.EnumFilesProc.ProcessFileList }
|
|
if not EnumFilesProc(DisableFsRedir, ExpandConst(CurFile^.DestName), Param) then
|
|
Exit(False);
|
|
end else begin
|
|
SourceWildcard := ExpandConst(CurFile^.SourceFilename);
|
|
Excludes.DelimitedText := CurFile^.Excludes;
|
|
if foExtractArchive in CurFile^.Options then begin
|
|
try
|
|
if not RecurseExternalArchiveFiles(DisableFsRedir, SourceWildcard,
|
|
Excludes, CurFile) then
|
|
Exit(False);
|
|
except on E: ESevenZipError do
|
|
{ Ignore archive errors for now, will show up with proper UI during
|
|
installation }
|
|
end;
|
|
end else begin
|
|
if not RecurseExternalFiles(DisableFsRedir, PathExtractPath(SourceWildcard), '',
|
|
PathExtractName(SourceWildcard), IsWildcard(SourceWildcard), Excludes, CurFile) then
|
|
Exit(False);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Excludes.Free;
|
|
end;
|
|
|
|
{ [InstallDelete] }
|
|
for I := 0 to Entries[seInstallDelete].Count-1 do
|
|
with PSetupDeleteEntry(Entries[seInstallDelete][I])^ do
|
|
if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
|
|
case DeleteType of
|
|
dfFiles, dfFilesAndOrSubdirs:
|
|
if not DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), False, True, DeleteType = dfFilesAndOrSubdirs, True,
|
|
DummyDeleteDirProc, EnumFilesProc, Param) then begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
dfDirIfEmpty:
|
|
if not DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), True, False, False, True,
|
|
DummyDeleteDirProc, EnumFilesProc, Param) then begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure EnumProc(const Filename: String; Param: Pointer);
|
|
begin
|
|
TStringList(Param).Add(PathLowercase(Filename));
|
|
end;
|
|
|
|
var
|
|
CheckForFileSL: TStringList;
|
|
|
|
function CheckForFile(const DisableFsRedir: Boolean; const AFilename: String;
|
|
const Param: Pointer): Boolean;
|
|
var
|
|
Filename: String;
|
|
J: Integer;
|
|
begin
|
|
Filename := AFilename;
|
|
if not DisableFsRedir then
|
|
Filename := ReplaceSystemDirWithSysWow64(Filename);
|
|
Filename := PathLowercase(Filename);
|
|
for J := 0 to CheckForFileSL.Count-1 do begin
|
|
if CheckForFileSL[J] = Filename then begin
|
|
LogFmt('Found pending rename or delete that matches one of our files: %s', [Filename]);
|
|
Result := False; { Break the enum, just need to know if any matches }
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := True; { Success! }
|
|
end;
|
|
|
|
{ Checks if no file we're going to install or delete has a pending rename or delete. }
|
|
function PreviousInstallCompleted(const WizardComponents, WizardTasks: TStringList): Boolean;
|
|
begin
|
|
Result := True;
|
|
if Entries[seFile].Count = 0 then
|
|
Exit;
|
|
CheckForFileSL := TStringList.Create;
|
|
try
|
|
EnumFileReplaceOperationsFilenames(EnumProc, CheckForFileSL);
|
|
if CheckForFileSL.Count = 0 then
|
|
Exit;
|
|
Result := EnumFiles(CheckForFile, WizardComponents, WizardTasks, nil);
|
|
finally
|
|
CheckForFileSL.Free;
|
|
end;
|
|
end;
|
|
|
|
type
|
|
TArrayOfPWideChar = array[0..(MaxInt div SizeOf(PWideChar))-1] of PWideChar;
|
|
PArrayOfPWideChar = ^TArrayOfPWideChar;
|
|
|
|
var
|
|
RegisterFileBatchFilenames: PArrayOfPWideChar;
|
|
RegisterFileFilenamesBatchMax, RegisterFileFilenamesBatchCount: Integer;
|
|
|
|
function RegisterFile(const DisableFsRedir: Boolean; const AFilename: String;
|
|
const Param: Pointer): Boolean;
|
|
var
|
|
Filename, Text: String;
|
|
I, Len: Integer;
|
|
CheckFilter, Match: Boolean;
|
|
begin
|
|
Filename := AFilename;
|
|
|
|
{ First: check filters and self. }
|
|
if Filename <> '' then begin
|
|
CheckFilter := Boolean(Param);
|
|
if CheckFilter then begin
|
|
Match := False;
|
|
Text := PathLowercase(PathExtractName(Filename));
|
|
for I := 0 to CloseApplicationsFilterList.Count-1 do begin
|
|
if WildcardMatch(PChar(Text), PChar(CloseApplicationsFilterList[I])) then begin
|
|
Match := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
if Match then begin
|
|
for I := 0 to CloseApplicationsFilterExcludesList.Count-1 do begin
|
|
if WildcardMatch(PChar(Text), PChar(CloseApplicationsFilterExcludesList[I])) then begin
|
|
Match := False;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if not Match then begin
|
|
{ No match with filter so exit but don't return an error. }
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
if PathCompare(Filename, SetupLdrOriginalFilename) = 0 then begin
|
|
{ Don't allow self to be registered but don't return an error. }
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
{ Secondly: check if we need to register this batch, either because the batch is full
|
|
or because we're done scanning and have leftovers. }
|
|
if ((Filename <> '') and (RegisterFileFilenamesBatchCount = RegisterFileFilenamesBatchMax)) or
|
|
((Filename = '') and (RegisterFileFilenamesBatchCount > 0)) then begin
|
|
if RmRegisterResources(RmSessionHandle, RegisterFileFilenamesBatchCount, RegisterFileBatchFilenames, 0, nil, 0, nil) = ERROR_SUCCESS then begin
|
|
for I := 0 to RegisterFileFilenamesBatchCount-1 do
|
|
FreeMem(RegisterFileBatchFilenames[I]);
|
|
RegisterFileFilenamesBatchCount := 0;
|
|
end else begin
|
|
RmEndSession(RmSessionHandle);
|
|
RmSessionStarted := False;
|
|
end;
|
|
end;
|
|
|
|
{ Finally: add this file to the batch. }
|
|
if RmSessionStarted and (FileName <> '') then begin
|
|
{ From MSDN: "Installers should not disable file system redirection before calling
|
|
the Restart Manager API. This means that a 32-bit installer run on 64-bit Windows
|
|
is unable register a file in the %windir%\system32 directory." This is incorrect,
|
|
we can register such files by using the Sysnative alias. }
|
|
if DisableFsRedir then
|
|
Filename := ReplaceSystemDirWithSysNative(Filename, IsWin64);
|
|
|
|
if InitLogCloseApplications then
|
|
LogFmt('Found a file to register with RestartManager: %s', [Filename]);
|
|
|
|
Len := Length(Filename);
|
|
GetMem(RegisterFileBatchFilenames[RegisterFileFilenamesBatchCount], (Len + 1) * SizeOf(RegisterFileBatchFilenames[RegisterFileFilenamesBatchCount][0]));
|
|
StrPCopy(RegisterFileBatchFilenames[RegisterFileFilenamesBatchCount], Filename);
|
|
Inc(RegisterFileFilenamesBatchCount);
|
|
|
|
Inc(RmRegisteredFilesCount);
|
|
end;
|
|
|
|
Result := RmSessionStarted; { Break the enum if there was an error, else continue. }
|
|
end;
|
|
|
|
{ Helper function for [Code] to register extra files. }
|
|
var
|
|
AllowCodeRegisterExtraCloseApplicationsResource: Boolean;
|
|
|
|
function CodeRegisterExtraCloseApplicationsResource(const DisableFsRedir: Boolean; const AFilename: String): Boolean;
|
|
begin
|
|
if AllowCodeRegisterExtraCloseApplicationsResource then
|
|
Result := RegisterFile(DisableFsRedir, AFilename, Pointer(False))
|
|
else begin
|
|
InternalError('Cannot call "RegisterExtraCloseApplicationsResource" function at this time');
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
{ Register all files we're going to install or delete. Ends RmSession on errors. }
|
|
procedure RegisterResourcesWithRestartManager(const WizardComponents, WizardTasks: TStringList);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
{ Note: MSDN says we shouldn't call RmRegisterResources for each file because of speed, but calling
|
|
it once for all files adds extra memory usage, so calling it in batches. }
|
|
RegisterFileFilenamesBatchMax := 1000;
|
|
GetMem(RegisterFileBatchFilenames, RegisterFileFilenamesBatchMax * SizeOf(RegisterFileBatchFilenames[0]));
|
|
try
|
|
{ Register our files. }
|
|
RmRegisteredFilesCount := 0;
|
|
try
|
|
EnumFiles(RegisterFile, WizardComponents, WizardTasks, Pointer(True));
|
|
except
|
|
Log('EnumFiles(RegisterFile) raised an exception.');
|
|
Application.HandleException(nil);
|
|
end;
|
|
{ Ask [Code] for more files. }
|
|
if CodeRunner <> nil then begin
|
|
AllowCodeRegisterExtraCloseApplicationsResource := True;
|
|
try
|
|
try
|
|
CodeRunner.RunProcedures('RegisterExtraCloseApplicationsResources', [''], False);
|
|
except
|
|
Log('RegisterExtraCloseApplicationsResources raised an exception.');
|
|
Application.HandleException(nil);
|
|
end;
|
|
finally
|
|
AllowCodeRegisterExtraCloseApplicationsResource := False;
|
|
end;
|
|
end;
|
|
{ Don't forget to register leftovers. }
|
|
if RmSessionStarted then
|
|
RegisterFile(False, '', nil);
|
|
finally
|
|
for I := 0 to RegisterFileFilenamesBatchCount-1 do
|
|
FreeMem(RegisterFileBatchFilenames[I]);
|
|
FreeMem(RegisterFileBatchFilenames);
|
|
end;
|
|
end;
|
|
|
|
procedure DebugNotifyEntry(EntryType: TEntryType; Number: Integer);
|
|
var
|
|
Kind: TDebugEntryKind;
|
|
B: Boolean;
|
|
begin
|
|
if not Debugging then Exit;
|
|
case EntryType of
|
|
seDir: Kind := deDir;
|
|
seFile: Kind := deFile;
|
|
seIcon: Kind := deIcon;
|
|
seIni: Kind := deIni;
|
|
seRegistry: Kind := deRegistry;
|
|
seInstallDelete: Kind := deInstallDelete;
|
|
seUninstallDelete: Kind := deUninstallDelete;
|
|
seRun: Kind := deRun;
|
|
seUninstallRun: Kind := deUninstallRun;
|
|
else
|
|
Exit;
|
|
end;
|
|
DebugNotify(Kind, Integer(OriginalEntryIndexes[EntryType][Number]), B);
|
|
end;
|
|
|
|
procedure CodeRunnerOnLog(const S: String);
|
|
begin
|
|
Log(S);
|
|
end;
|
|
|
|
procedure CodeRunnerOnLogFmt(const S: String; const Args: array of const);
|
|
begin
|
|
LogFmt(S, Args);
|
|
end;
|
|
|
|
procedure CodeRunnerOnDllImport(var DllName: String; var ForceDelayLoad: Boolean);
|
|
var
|
|
S, BaseName, FullName: String;
|
|
FirstFile: Boolean;
|
|
P: Integer;
|
|
begin
|
|
while True do begin
|
|
if Pos('setup:', DllName) = 1 then begin
|
|
if IsUninstaller then begin
|
|
DllName := '';
|
|
ForceDelayLoad := True;
|
|
Exit;
|
|
end;
|
|
Delete(DllName, 1, Length('setup:'));
|
|
end
|
|
else if Pos('uninstall:', DllName) = 1 then begin
|
|
if not IsUninstaller then begin
|
|
DllName := '';
|
|
ForceDelayLoad := True;
|
|
Exit;
|
|
end;
|
|
Delete(DllName, 1, Length('uninstall:'));
|
|
end
|
|
else
|
|
Break;
|
|
end;
|
|
|
|
if Pos('files:', DllName) = 1 then begin
|
|
if IsUninstaller then begin
|
|
{ Uninstall doesn't do 'files:' }
|
|
DllName := '';
|
|
ForceDelayLoad := True;
|
|
end
|
|
else begin
|
|
S := Copy(DllName, Length('files:')+1, Maxint);
|
|
FirstFile := True;
|
|
repeat
|
|
P := ConstPos(',', S);
|
|
if P = 0 then
|
|
BaseName := S
|
|
else begin
|
|
BaseName := Copy(S, 1, P-1);
|
|
Delete(S, 1, P);
|
|
end;
|
|
BaseName := ExpandConst((BaseName));
|
|
FullName := AddBackslash(TempInstallDir) + BaseName;
|
|
if not NewFileExists(FullName) then
|
|
ExtractTemporaryFile(BaseName);
|
|
if FirstFile then begin
|
|
DllName := FullName;
|
|
FirstFile := False;
|
|
end;
|
|
until P = 0;
|
|
end;
|
|
end
|
|
else
|
|
DllName := ExpandConst(DllName);
|
|
end;
|
|
|
|
function CodeRunnerOnDebug(const Position: LongInt;
|
|
var ContinueStepOver: Boolean): Boolean;
|
|
begin
|
|
Result := DebugNotify(deCodeLine, Position, ContinueStepOver, CodeRunner.GetCallStack);
|
|
end;
|
|
|
|
function CodeRunnerOnDebugIntermediate(const Position: LongInt;
|
|
var ContinueStepOver: Boolean): Boolean;
|
|
begin
|
|
Result := DebugNotifyIntermediate(deCodeLine, Position, ContinueStepOver);
|
|
end;
|
|
|
|
procedure CodeRunnerOnException(const Exception: AnsiString; const Position: LongInt);
|
|
begin
|
|
if Debugging then
|
|
DebugNotifyException(String(Exception), deCodeLine, Position);
|
|
end;
|
|
|
|
procedure SetActiveLanguage(const I: Integer);
|
|
{ Activates the specified language }
|
|
var
|
|
LangEntry: PSetupLanguageEntry;
|
|
J: Integer;
|
|
begin
|
|
if ActiveLanguage = I then
|
|
Exit;
|
|
|
|
LangEntry := Entries[seLanguage][I];
|
|
|
|
AssignSetupMessages(LangEntry.Data[1], Length(LangEntry.Data));
|
|
|
|
{ Remove outdated < and > markers from the Back and Next buttons. Done here for now to avoid a Default.isl change. }
|
|
StringChange(SetupMessages[msgButtonBack], '< ', '');
|
|
StringChange(SetupMessages[msgButtonNext], ' >', '');
|
|
|
|
ActiveLanguage := I;
|
|
Finalize(LangOptions); { prevent leak on D2 }
|
|
LangOptions := LangEntry^;
|
|
|
|
if LangEntry.LicenseText <> '' then
|
|
ActiveLicenseText := LangEntry.LicenseText
|
|
else
|
|
ActiveLicenseText := SetupHeader.LicenseText;
|
|
|
|
if LangEntry.InfoBeforeText <> '' then
|
|
ActiveInfoBeforeText := LangEntry.InfoBeforeText
|
|
else
|
|
ActiveInfoBeforeText := SetupHeader.InfoBeforeText;
|
|
|
|
if LangEntry.InfoAfterText <> '' then
|
|
ActiveInfoAfterText := LangEntry.InfoAfterText
|
|
else
|
|
ActiveInfoAfterText := SetupHeader.InfoAfterText;
|
|
|
|
SetMessageBoxRightToLeft(LangOptions.RightToLeft);
|
|
SetMessageBoxCaption(mbInformation, PChar(SetupMessages[msgInformationTitle]));
|
|
SetMessageBoxCaption(mbConfirmation, PChar(SetupMessages[msgConfirmTitle]));
|
|
SetMessageBoxCaption(mbError, PChar(SetupMessages[msgErrorTitle]));
|
|
SetMessageBoxCaption(mbCriticalError, PChar(SetupMessages[msgErrorTitle]));
|
|
Application.Title := SetupMessages[msgSetupAppTitle];
|
|
|
|
for J := 0 to Entries[seType].Count-1 do begin
|
|
with PSetupTypeEntry(Entries[seType][J])^ do begin
|
|
case Typ of
|
|
ttDefaultFull: Description := SetupMessages[msgFullInstallation];
|
|
ttDefaultCompact: Description := SetupMessages[msgCompactInstallation];
|
|
ttDefaultCustom: Description := SetupMessages[msgCustomInstallation];
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ Tell the first instance to change its language too. (It's possible for
|
|
the first instance to display messages after Setup terminates, e.g. if it
|
|
fails to restart the computer.) }
|
|
if SetupNotifyWndPresent then
|
|
SendNotifyMessage(SetupNotifyWnd, WM_USER + 150, 10001, I);
|
|
end;
|
|
|
|
function GetLanguageEntryProc(Index: Integer; var Entry: PSetupLanguageEntry): Boolean;
|
|
begin
|
|
Result := False;
|
|
if Index < Entries[seLanguage].Count then begin
|
|
Entry := Entries[seLanguage][Index];
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
procedure ActivateDefaultLanguage;
|
|
{ Auto-detects the most appropriate language and activates it.
|
|
Also initializes the ShowLanguageDialog and MatchedLangParameter variables.
|
|
Note: A like-named version of this function is also present in SetupLdr.dpr. }
|
|
var
|
|
I: Integer;
|
|
begin
|
|
MatchedLangParameter := False;
|
|
case DetermineDefaultLanguage(GetLanguageEntryProc,
|
|
SetupHeader.LanguageDetectionMethod, InitLang, I) of
|
|
ddNoMatch: ShowLanguageDialog := (SetupHeader.ShowLanguageDialog <> slNo);
|
|
ddMatch: ShowLanguageDialog := (SetupHeader.ShowLanguageDialog = slYes);
|
|
else
|
|
begin
|
|
{ ddMatchLangParameter }
|
|
ShowLanguageDialog := False;
|
|
MatchedLangParameter := True;
|
|
end;
|
|
end;
|
|
SetActiveLanguage(I);
|
|
end;
|
|
|
|
procedure LogCompatibilityMode;
|
|
var
|
|
S: String;
|
|
begin
|
|
S := GetEnv('__COMPAT_LAYER');
|
|
if S <> '' then
|
|
LogFmt('Compatibility mode: %s (%s)', [SYesNo[True], S]);
|
|
end;
|
|
|
|
procedure LogWindowsVersion;
|
|
|
|
function ArchitecturesToStr(const Architectures: TSetupProcessorArchitectures;
|
|
const Separator: String): String;
|
|
|
|
procedure AppendArchitecture(var S: String; const Separator, L: String);
|
|
begin
|
|
if S <> '' then
|
|
S := S + Separator + L
|
|
else
|
|
S := L;
|
|
end;
|
|
|
|
var
|
|
I: TSetupProcessorArchitecture;
|
|
begin
|
|
Result := '';
|
|
for I := Low(I) to High(I) do
|
|
if I in Architectures then
|
|
AppendArchitecture(Result, Separator, SetupProcessorArchitectureNames[I]);
|
|
end;
|
|
|
|
var
|
|
SP: String;
|
|
begin
|
|
if NTServicePackLevel <> 0 then begin
|
|
SP := ' SP' + IntToStr(Hi(NTServicePackLevel));
|
|
if Lo(NTServicePackLevel) <> 0 then
|
|
SP := SP + '.' + IntToStr(Lo(NTServicePackLevel));
|
|
end;
|
|
LogFmt('Windows version: %u.%u.%u%s', [WindowsVersion shr 24,
|
|
(WindowsVersion shr 16) and $FF, WindowsVersion and $FFFF, SP]);
|
|
|
|
var Bits := 32;
|
|
if IsWin64 then
|
|
Bits := 64;
|
|
LogFmt('Windows architecture: %s (%d-bit)', [SetupProcessorArchitectureNames[ProcessorArchitecture], Bits]);
|
|
LogFmt('Machine types supported by system: %s', [ArchitecturesToStr(MachineTypesSupportedBySystem, ' ')]);
|
|
|
|
if IsAdmin then
|
|
Log('User privileges: Administrative')
|
|
else if IsPowerUserOrAdmin then
|
|
Log('User privileges: Power User')
|
|
else
|
|
Log('User privileges: None');
|
|
end;
|
|
|
|
function GetMessageBoxResultText(const AResult: Integer): String;
|
|
begin
|
|
case AResult of
|
|
IDOK: Result := 'OK';
|
|
IDCANCEL: Result := 'Cancel';
|
|
IDABORT: Result := 'Abort';
|
|
IDRETRY: Result := 'Retry';
|
|
IDIGNORE: Result := 'Ignore';
|
|
IDYES: Result := 'Yes';
|
|
IDNO: Result := 'No';
|
|
IDTRYAGAIN: Result := 'Try Again';
|
|
IDCONTINUE: Result := 'Continue';
|
|
else
|
|
Result := IntToStr(AResult);
|
|
end;
|
|
end;
|
|
|
|
function GetButtonsText(const Buttons: Cardinal): String;
|
|
const
|
|
{ We don't use this type, but end users are liable to in [Code] }
|
|
MB_CANCELTRYCONTINUE = $00000006;
|
|
begin
|
|
case Buttons and MB_TYPEMASK of
|
|
MB_OK: Result := 'OK';
|
|
MB_OKCANCEL: Result := 'OK/Cancel';
|
|
MB_ABORTRETRYIGNORE: Result := 'Abort/Retry/Ignore';
|
|
MB_YESNOCANCEL: Result := 'Yes/No/Cancel';
|
|
MB_YESNO: Result := 'Yes/No';
|
|
MB_RETRYCANCEL: Result := 'Retry/Cancel';
|
|
MB_CANCELTRYCONTINUE: Result := 'Cancel/Try Again/Continue';
|
|
else
|
|
Result := IntToStr(Buttons and MB_TYPEMASK);
|
|
end;
|
|
end;
|
|
|
|
procedure LogSuppressedMessageBox(const Text: PChar; const Buttons: Cardinal;
|
|
const Default: Integer);
|
|
begin
|
|
Log(Format('Defaulting to %s for suppressed message box (%s):' + SNewLine,
|
|
[GetMessageBoxResultText(Default), GetButtonsText(Buttons)]) + Text);
|
|
end;
|
|
|
|
procedure LogMessageBox(const Text: PChar; const Buttons: Cardinal);
|
|
begin
|
|
Log(Format('Message box (%s):' + SNewLine,
|
|
[GetButtonsText(Buttons)]) + Text);
|
|
end;
|
|
|
|
function LoggedAppMessageBox(const Text, Caption: PChar; const Flags: Longint;
|
|
const Suppressible: Boolean; const Default: Integer): Integer;
|
|
begin
|
|
if InitSuppressMsgBoxes and Suppressible then begin
|
|
LogSuppressedMessageBox(Text, Flags, Default);
|
|
Result := Default;
|
|
end else begin
|
|
LogMessageBox(Text, Flags);
|
|
Result := AppMessageBox(Text, Caption, Flags);
|
|
if Result <> 0 then
|
|
LogFmt('User chose %s.', [GetMessageBoxResultText(Result)])
|
|
else
|
|
Log('AppMessageBox failed.');
|
|
end;
|
|
end;
|
|
|
|
function LoggedMsgBox(const Text, Caption: String; const Typ: TMsgBoxType;
|
|
const Buttons: Cardinal; const Suppressible: Boolean; const Default: Integer): Integer;
|
|
begin
|
|
if InitSuppressMsgBoxes and Suppressible then begin
|
|
LogSuppressedMessageBox(PChar(Text), Buttons, Default);
|
|
Result := Default;
|
|
end else begin
|
|
LogMessageBox(PChar(Text), Buttons);
|
|
Result := MsgBox(Text, Caption, Typ, Buttons);
|
|
if Result <> 0 then
|
|
LogFmt('User chose %s.', [GetMessageBoxResultText(Result)])
|
|
else
|
|
Log('MsgBox failed.');
|
|
end;
|
|
end;
|
|
|
|
function LoggedTaskDialogMsgBox(const Icon, Instruction, Text, Caption: String;
|
|
const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: array of String;
|
|
const ShieldButton: Integer; const Suppressible: Boolean; const Default: Integer;
|
|
const VerificationText: String = ''; const pfVerificationFlagChecked: PBOOL = nil): Integer;
|
|
begin
|
|
if InitSuppressMsgBoxes and Suppressible then begin
|
|
LogSuppressedMessageBox(PChar(Text), Buttons, Default);
|
|
Result := Default;
|
|
end else begin
|
|
LogMessageBox(PChar(Text), Buttons);
|
|
Result := TaskDialogMsgBox(Icon, Instruction, Text,
|
|
Caption, Typ, Buttons, ButtonLabels, ShieldButton, VerificationText, pfVerificationFlagChecked);
|
|
if Result <> 0 then begin
|
|
LogFmt('User chose %s.', [GetMessageBoxResultText(Result)]);
|
|
if pfVerificationFlagChecked <> nil then
|
|
LogFmt('User chose %s for the verification.', [SYesNo[pfVerificationFlagChecked^]]);
|
|
end else
|
|
Log('TaskDialogMsgBox failed.');
|
|
end;
|
|
end;
|
|
|
|
procedure RestartComputerFromThisProcess;
|
|
begin
|
|
RestartInitiatedByThisProcess := True;
|
|
{ Note: Depending on the OS, RestartComputer may not return if successful }
|
|
if not RestartComputer then begin
|
|
LoggedMsgBox(SetupMessages[msgErrorRestartingComputer], '', mbError,
|
|
MB_OK, True, IDOK);
|
|
end;
|
|
end;
|
|
|
|
procedure RespawnSetupElevated(const AParams: String);
|
|
{ Starts a new, elevated Setup(Ldr) process and waits until it terminates.
|
|
Does not return; either calls Halt or raises an exception. }
|
|
var
|
|
Cancelled: Boolean;
|
|
Server: TSpawnServer;
|
|
ParamNotifyWnd: HWND;
|
|
RespawnResults: record
|
|
ExitCode: DWORD;
|
|
NotifyRestartRequested: Boolean;
|
|
NotifyNewLanguage: Integer;
|
|
end;
|
|
begin
|
|
Cancelled := False;
|
|
try
|
|
Server := TSpawnServer.Create;
|
|
try
|
|
if SetupNotifyWndPresent then
|
|
ParamNotifyWnd := SetupNotifyWnd
|
|
else
|
|
ParamNotifyWnd := Server.Wnd;
|
|
RespawnSelfElevated(SetupLdrOriginalFilename,
|
|
Format('/SPAWNWND=$%x /NOTIFYWND=$%x ', [Server.Wnd, ParamNotifyWnd]) +
|
|
AParams, RespawnResults.ExitCode);
|
|
RespawnResults.NotifyRestartRequested := Server.NotifyRestartRequested;
|
|
RespawnResults.NotifyNewLanguage := Server.NotifyNewLanguage;
|
|
finally
|
|
Server.Free;
|
|
end;
|
|
except
|
|
{ If the user clicked Cancel on the dialog, halt with special exit code }
|
|
if ExceptObject is EAbort then
|
|
Cancelled := True
|
|
else
|
|
raise;
|
|
end;
|
|
if Cancelled then
|
|
Halt(ecCancelledBeforeInstall);
|
|
|
|
if not SetupNotifyWndPresent then begin
|
|
{ In the UseSetupLdr=no case, there is no notify window handle to pass to
|
|
RespawnSelfElevated, so it hosts one itself. Process the results. }
|
|
try
|
|
if (RespawnResults.NotifyNewLanguage >= 0) and
|
|
(RespawnResults.NotifyNewLanguage < Entries[seLanguage].Count) then
|
|
SetActiveLanguage(RespawnResults.NotifyNewLanguage);
|
|
if RespawnResults.NotifyRestartRequested then begin
|
|
{ Note: Depending on the OS, this may not return if successful }
|
|
RestartComputerFromThisProcess;
|
|
end;
|
|
except
|
|
{ In the unlikely event that something above raises an exception, handle
|
|
it here so the right exit code will still be returned below }
|
|
Application.HandleException(nil);
|
|
end;
|
|
end;
|
|
|
|
Halt(RespawnResults.ExitCode);
|
|
end;
|
|
|
|
procedure InitializeCommonVars;
|
|
{ Initializes variables shared between Setup and Uninstall }
|
|
begin
|
|
IsAdmin := IsAdminLoggedOn;
|
|
IsPowerUserOrAdmin := IsAdmin or IsPowerUserLoggedOn;
|
|
Randomize;
|
|
end;
|
|
|
|
procedure InitializeAdminInstallMode(const AAdminInstallMode: Boolean);
|
|
{ Initializes IsAdminInstallMode and other global variables that depend on it }
|
|
const
|
|
RootKeys: array[Boolean] of HKEY = (HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE);
|
|
begin
|
|
LogFmt('Administrative install mode: %s', [SYesNo[AAdminInstallMode]]);
|
|
IsAdminInstallMode := AAdminInstallMode;
|
|
InstallModeRootKey := RootKeys[AAdminInstallMode];
|
|
LogFmt('Install mode root key: %s', [GetRegRootKeyName(InstallModeRootKey)]);
|
|
end;
|
|
|
|
procedure Initialize64BitInstallMode(const A64BitInstallMode: Boolean);
|
|
{ Initializes Is64BitInstallMode and other global variables that depend on it }
|
|
begin
|
|
Is64BitInstallMode := A64BitInstallMode;
|
|
InstallDefaultDisableFsRedir := A64BitInstallMode;
|
|
ScriptFuncDisableFsRedir := A64BitInstallMode;
|
|
if A64BitInstallMode then
|
|
InstallDefaultRegView := rv64Bit
|
|
else
|
|
InstallDefaultRegView := rv32Bit;
|
|
end;
|
|
|
|
procedure Log64BitInstallMode;
|
|
begin
|
|
LogFmt('64-bit install mode: %s', [SYesNo[Is64BitInstallMode]]);
|
|
end;
|
|
|
|
var
|
|
LoggedArchiveExtractionMode: Boolean;
|
|
|
|
procedure LogArchiveExtractionModeOnce;
|
|
begin
|
|
if not LoggedArchiveExtractionMode then begin
|
|
LogFmt('Archive extraction mode: %s',
|
|
[IfThen(SetupHeader.SevenZipLibraryName <> '', Format('Using %s', [SetupHeader.SevenZipLibraryName]), 'Basic')]);
|
|
LoggedArchiveExtractionMode := True;
|
|
end;
|
|
end;
|
|
|
|
procedure InitializeSetup;
|
|
{ Initializes various vars used by the setup. This is called in the project
|
|
source. }
|
|
var
|
|
DecompressorDLL, SevenZipDLL: TMemoryStream;
|
|
|
|
function ExtractLongWord(var S: String): LongWord;
|
|
var
|
|
P: Integer;
|
|
begin
|
|
P := PathPos(',', S);
|
|
if P = 0 then
|
|
raise Exception.Create('ExtractLongWord: Missing comma');
|
|
Result := LongWord(StrToInt(Copy(S, 1, P-1)));
|
|
Delete(S, 1, P);
|
|
end;
|
|
|
|
procedure AbortInit(const Msg: TSetupMessageID);
|
|
begin
|
|
LoggedMsgBox(SetupMessages[Msg], '', mbCriticalError, MB_OK, True, IDOK);
|
|
Abort;
|
|
end;
|
|
|
|
procedure AbortInitFmt1(const Msg: TSetupMessageID; const Arg1: String);
|
|
begin
|
|
LoggedMsgBox(FmtSetupMessage(Msg, [Arg1]), '', mbCriticalError, MB_OK, True, IDOK);
|
|
Abort;
|
|
end;
|
|
|
|
procedure AbortInitServicePackRequired(const ServicePack: Word);
|
|
begin
|
|
LoggedMsgBox(FmtSetupMessage(msgWindowsServicePackRequired, ['Windows',
|
|
IntToStr(Hi(ServicePack))]), '', mbCriticalError, MB_OK, True, IDOK);
|
|
Abort;
|
|
end;
|
|
|
|
procedure ReadFileIntoStream(const Stream: TStream;
|
|
const R: TCompressedBlockReader);
|
|
type
|
|
PBuffer = ^TBuffer;
|
|
TBuffer = array[0..8191] of Byte;
|
|
var
|
|
Buf: PBuffer;
|
|
BytesLeft, Bytes: Longint;
|
|
begin
|
|
New(Buf);
|
|
try
|
|
R.Read(BytesLeft, SizeOf(BytesLeft));
|
|
while BytesLeft > 0 do begin
|
|
Bytes := BytesLeft;
|
|
if Bytes > SizeOf(Buf^) then Bytes := SizeOf(Buf^);
|
|
R.Read(Buf^, Bytes);
|
|
Stream.WriteBuffer(Buf^, Bytes);
|
|
Dec(BytesLeft, Bytes);
|
|
end;
|
|
finally
|
|
Dispose(Buf);
|
|
end;
|
|
end;
|
|
|
|
function ReadWizardImage(const R: TCompressedBlockReader): TBitmap;
|
|
var
|
|
MemStream: TMemoryStream;
|
|
begin
|
|
MemStream := TMemoryStream.Create;
|
|
try
|
|
ReadFileIntoStream(MemStream, R);
|
|
MemStream.Seek(0, soFromBeginning);
|
|
Result := TBitmap.Create;
|
|
Result.AlphaFormat := TAlphaFormat(SetupHeader.WizardImageAlphaFormat);
|
|
Result.LoadFromStream(MemStream);
|
|
finally
|
|
MemStream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure LoadDecompressorDLL;
|
|
var
|
|
Filename: String;
|
|
begin
|
|
Filename := AddBackslash(TempInstallDir) + '_isetup\_isdecmp.dll';
|
|
SaveStreamToTempFile(DecompressorDLL, Filename);
|
|
FreeAndNil(DecompressorDLL);
|
|
DecompressorDLLHandle := SafeLoadLibrary(Filename, SEM_NOOPENFILEERRORBOX);
|
|
if DecompressorDLLHandle = 0 then
|
|
InternalError(Format('Failed to load DLL "%s"', [Filename]));
|
|
case SetupHeader.CompressMethod of
|
|
cmZip:
|
|
if not ZlibInitDecompressFunctions(DecompressorDLLHandle) then
|
|
InternalError('ZlibInitDecompressFunctions failed');
|
|
cmBzip:
|
|
if not BZInitDecompressFunctions(DecompressorDLLHandle) then
|
|
InternalError('BZInitDecompressFunctions failed');
|
|
end;
|
|
end;
|
|
|
|
procedure LoadSevenZipDLL;
|
|
var
|
|
Filename: String;
|
|
begin
|
|
Filename := AddBackslash(TempInstallDir) + '_isetup\_is7z.dll';
|
|
SaveStreamToTempFile(SevenZipDLL, Filename);
|
|
FreeAndNil(SevenZipDLL);
|
|
SevenZipDLLHandle := SafeLoadLibrary(Filename, SEM_NOOPENFILEERRORBOX);
|
|
if SevenZipDLLHandle = 0 then
|
|
InternalError(Format('Failed to load DLL "%s"', [Filename]))
|
|
else begin
|
|
var VersionNumbers: TFileVersionNumbers;
|
|
if not GetVersionNumbers(Filename, VersionNumbers) then
|
|
FillChar(VersionNumbers, SizeOf(VersionNumbers), 0);
|
|
if not SevenZipDLLInit(SevenZipDLLHandle, VersionNumbers) then
|
|
InternalError('SevenZipDLLInit failed');
|
|
end;
|
|
end;
|
|
|
|
var
|
|
Reader: TCompressedBlockReader;
|
|
|
|
procedure ReadEntriesWithoutVersion(const EntryType: TEntryType;
|
|
const Count: Integer; const Size: Integer);
|
|
var
|
|
I: Integer;
|
|
P: Pointer;
|
|
begin
|
|
Entries[EntryType].Capacity := Count;
|
|
for I := 0 to Count-1 do begin
|
|
P := AllocMem(Size);
|
|
SECompressedBlockRead(Reader, P^, Size, EntryStrings[EntryType],
|
|
EntryAnsiStrings[EntryType]);
|
|
Entries[EntryType].Add(P);
|
|
end;
|
|
end;
|
|
|
|
procedure ReadEntries(const EntryType: TEntryType; const Count: Integer;
|
|
const Size: Integer; const MinVersionOfs, OnlyBelowVersionOfs: Integer);
|
|
var
|
|
I: Integer;
|
|
P: Pointer;
|
|
begin
|
|
if Debugging then begin
|
|
OriginalEntryIndexes[EntryType] := TList.Create;
|
|
OriginalEntryIndexes[EntryType].Capacity := Count;
|
|
end;
|
|
Entries[EntryType].Capacity := Count;
|
|
for I := 0 to Count-1 do begin
|
|
P := AllocMem(Size);
|
|
SECompressedBlockRead(Reader, P^, Size, EntryStrings[EntryType],
|
|
EntryAnsiStrings[Entrytype]);
|
|
if (MinVersionOfs = -1) or
|
|
(InstallOnThisVersion(TSetupVersionData((@PByteArray(P)[MinVersionOfs])^),
|
|
TSetupVersionData((@PByteArray(P)[OnlyBelowVersionOfs])^)) = irInstall) then begin
|
|
Entries[EntryType].Add(P);
|
|
if Debugging then
|
|
OriginalEntryIndexes[EntryType].Add(Pointer(I));
|
|
end
|
|
else
|
|
SEFreeRec(P, EntryStrings[EntryType], EntryAnsiStrings[EntryType]);
|
|
end;
|
|
end;
|
|
|
|
function HandleInitPassword(const NeedPassword: Boolean): Boolean;
|
|
{ Handles InitPassword and returns the updated value of NeedPassword }
|
|
{ Also see WizardForm.CheckPassword }
|
|
begin
|
|
Result := NeedPassword;
|
|
|
|
if NeedPassword and (InitPassword <> '') then begin
|
|
var PasswordOk := False;
|
|
var S := InitPassword;
|
|
var CryptKey: TSetupEncryptionKey;
|
|
GenerateEncryptionKey(S, SetupHeader.EncryptionKDFSalt, SetupHeader.EncryptionKDFIterations, CryptKey);
|
|
if shPassword in SetupHeader.Options then
|
|
PasswordOk := TestPassword(CryptKey);
|
|
if not PasswordOk and (CodeRunner <> nil) then
|
|
PasswordOk := CodeRunner.RunBooleanFunctions('CheckPassword', [S], bcTrue, False, PasswordOk);
|
|
|
|
if PasswordOk then begin
|
|
Result := False;
|
|
if shEncryptionUsed in SetupHeader.Options then
|
|
FileExtractor.CryptKey := CryptKey;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SetupInstallMode;
|
|
begin
|
|
if InitVerySilent then
|
|
InstallMode := imVerySilent
|
|
else if InitSilent then
|
|
InstallMode := imSilent;
|
|
end;
|
|
|
|
function RecurseExternalGetSizeOfFiles(const DisableFsRedir: Boolean;
|
|
const SearchBaseDir, SearchSubDir, SearchWildcard: String;
|
|
const SourceIsWildcard: Boolean; const Excludes: TStrings;
|
|
const RecurseSubDirs: Boolean): Integer64;
|
|
begin
|
|
{ Also see RecurseExternalFiles above and RecurseExternalCopyFiles in Setup.Install
|
|
Also see RecurseExternalArchiveGetSizeOfFiles directly below }
|
|
Result := To64(0);
|
|
|
|
var FindData: TWin32FindData;
|
|
var H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + SearchWildcard, FindData);
|
|
if H <> INVALID_HANDLE_VALUE then begin
|
|
repeat
|
|
if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
|
|
|
|
if SourceIsWildcard then
|
|
if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
|
|
Continue;
|
|
|
|
if IsExcluded(SearchSubDir + FindData.cFileName, Excludes) then
|
|
Continue;
|
|
|
|
var I: Integer64;
|
|
I.Hi := FindData.nFileSizeHigh;
|
|
I.Lo := FindData.nFileSizeLow;
|
|
Inc6464(Result, I);
|
|
end;
|
|
until not FindNextFile(H, FindData);
|
|
Windows.FindClose(H);
|
|
end;
|
|
|
|
if RecurseSubDirs then begin
|
|
H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + '*', FindData);
|
|
if H <> INVALID_HANDLE_VALUE then begin
|
|
try
|
|
repeat
|
|
if IsRecurseableDirectory(FindData) then begin
|
|
var I := RecurseExternalGetSizeOfFiles(DisableFsRedir, SearchBaseDir,
|
|
SearchSubDir + FindData.cFileName + '\', SearchWildcard,
|
|
SourceIsWildcard, Excludes, RecurseSubDirs);
|
|
Inc6464(Result, I);
|
|
end;
|
|
until not FindNextFile(H, FindData);
|
|
finally
|
|
Windows.FindClose(H);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function RecurseExternalArchiveGetSizeOfFiles(const DisableFsRedir: Boolean;
|
|
const ArchiveFilename, Password: String; const Excludes: TStrings;
|
|
const RecurseSubDirs: Boolean): Integer64;
|
|
begin
|
|
{ See above }
|
|
Result := To64(0);
|
|
|
|
if not NewFileExistsRedir(DisableFsRedir, ArchiveFilename) then
|
|
Exit;
|
|
|
|
var FindData: TWin32FindData;
|
|
var H := ArchiveFindFirstFileRedir(DisableFsRedir, ArchiveFilename,
|
|
AddBackslash(TempInstallDir), { DestDir isn't known yet, pass a placeholder }
|
|
Password, RecurseSubDirs, False, FindData);
|
|
if H <> INVALID_HANDLE_VALUE then begin
|
|
try
|
|
repeat
|
|
if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
|
|
|
|
if IsExcluded(FindData.cFileName, Excludes) then
|
|
Continue;
|
|
|
|
var I: Integer64;
|
|
I.Hi := FindData.nFileSizeHigh;
|
|
I.Lo := FindData.nFileSizeLow;
|
|
Inc6464(Result, I);
|
|
end;
|
|
until not ArchiveFindNextFile(H, FindData);
|
|
finally
|
|
ArchiveFindClose(H);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ Also see Install.pas }
|
|
function ExistingInstallationAt(const RootKey: HKEY; const SubkeyName: String): Boolean;
|
|
var
|
|
K: HKEY;
|
|
begin
|
|
if RegOpenKeyExView(InstallDefaultRegView, RootKey, PChar(SubkeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
|
|
Result := True;
|
|
RegCloseKey(K);
|
|
end else
|
|
Result := False;
|
|
end;
|
|
|
|
procedure HandlePrivilegesRequiredOverrides(var ExtraRespawnParam: String);
|
|
var
|
|
ExistingAtAdminInstallMode, ExistingAtNonAdminInstallMode, DesireAnInstallMode, DesireAdminInstallMode: Boolean;
|
|
SubkeyName, AppName: String;
|
|
begin
|
|
if HasInitPrivilegesRequired and (proCommandLine in SetupHeader.PrivilegesRequiredOverridesAllowed) then begin
|
|
SetupHeader.PrivilegesRequired := InitPrivilegesRequired;
|
|
{ We don't need to set ExtraRespawnParam since the existing command line
|
|
already contains the needed parameters and it will automatically be
|
|
passed on to any respawned Setup(Ldr). }
|
|
end else if proDialog in SetupHeader.PrivilegesRequiredOverridesAllowed then begin
|
|
if shUsePreviousPrivileges in SetupHeader.Options then begin
|
|
{ Note: if proDialog is used and UsePreviousPrivileges is set to "yes"
|
|
then the compiler does not allow AppId to include constants but we
|
|
should still call ExpandConst to handle any '{{'. }
|
|
SubkeyName := GetUninstallRegSubkeyName(GetUninstallRegKeyBaseName(ExpandConst(SetupHeader.AppID)));
|
|
ExistingAtAdminInstallMode := ExistingInstallationAt(HKEY_LOCAL_MACHINE, SubkeyName);
|
|
ExistingAtNonAdminInstallMode := ExistingInstallationAt(HKEY_CURRENT_USER, SubkeyName);
|
|
end else begin
|
|
ExistingAtAdminInstallMode := False;
|
|
ExistingAtNonAdminInstallMode := False;
|
|
end;
|
|
|
|
DesireAnInstallMode := True;
|
|
DesireAdminInstallMode := False; { Silence compiler }
|
|
|
|
if ExistingAtAdminInstallMode and not ExistingAtNonAdminInstallMode then
|
|
DesireAdminInstallMode := True
|
|
else if not ExistingAtAdminInstallMode and ExistingAtNonAdminInstallMode then
|
|
DesireAdminInstallMode := False
|
|
else if not InitSuppressMsgBoxes then begin
|
|
{ Ask user. Doesn't log since logging hasn't started yet. Also doesn't
|
|
use ExpandedAppName since it isn't set yet. Afterwards we need to tell
|
|
any respawned Setup(Ldr) about the user choice (and avoid asking again).
|
|
Will use the command line parameter for this. Allowing proDialog forces
|
|
allowing proCommandLine, so we can count on the parameter to work. }
|
|
if shAppNameHasConsts in SetupHeader.Options then
|
|
AppName := PathChangeExt(PathExtractName(SetupLdrOriginalFilename), '')
|
|
else
|
|
AppName := SetupHeader.AppName;
|
|
if SetupHeader.PrivilegesRequired = prLowest then begin
|
|
case TaskDialogMsgBox('MAINICON', SetupMessages[msgPrivilegesRequiredOverrideInstruction],
|
|
FmtSetupMessage(msgPrivilegesRequiredOverrideText2, [AppName]),
|
|
SetupMessages[msgPrivilegesRequiredOverrideTitle], mbInformation, MB_YESNOCANCEL,
|
|
[SetupMessages[msgPrivilegesRequiredOverrideCurrentUserRecommended], SetupMessages[msgPrivilegesRequiredOverrideAllUsers]], IDNO) of
|
|
IDYES: DesireAdminInstallMode := False;
|
|
IDNO: DesireAdminInstallMode := True;
|
|
IDCANCEL: Abort;
|
|
end;
|
|
end else begin
|
|
case TaskDialogMsgBox('MAINICON', SetupMessages[msgPrivilegesRequiredOverrideInstruction],
|
|
FmtSetupMessage(msgPrivilegesRequiredOverrideText1, [AppName]),
|
|
SetupMessages[msgPrivilegesRequiredOverrideTitle], mbInformation, MB_YESNOCANCEL,
|
|
[SetupMessages[msgPrivilegesRequiredOverrideAllUsersRecommended], SetupMessages[msgPrivilegesRequiredOverrideCurrentUser]], IDYES) of
|
|
IDYES: DesireAdminInstallMode := True;
|
|
IDNO: DesireAdminInstallMode := False;
|
|
IDCANCEL: Abort;
|
|
end;
|
|
end;
|
|
end else
|
|
DesireAnInstallMode := False; { No previous found and msgboxes are suppressed, just keep things as they are. }
|
|
|
|
if DesireAnInstallMode then begin
|
|
if DesireAdminInstallMode then begin
|
|
SetupHeader.PrivilegesRequired := prAdmin;
|
|
ExtraRespawnParam := '/ALLUSERS';
|
|
end else begin
|
|
SetupHeader.PrivilegesRequired := prLowest;
|
|
ExtraRespawnParam := '/CURRENTUSER';
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
ParamName, ParamValue: String;
|
|
ParamIsAutomaticInternal: Boolean;
|
|
StartParam: Integer;
|
|
I, N: Integer;
|
|
IsRespawnedProcess, EnableLogging, WantToSuppressMsgBoxes, Res: Boolean;
|
|
DebugServerWnd: HWND;
|
|
LogFilename: String;
|
|
SetupFilename: String;
|
|
SetupFile: TFile;
|
|
TestID: TSetupID;
|
|
NameAndVersionMsg: String;
|
|
NextAllowedLevel: Integer;
|
|
LastShownComponentEntry, ComponentEntry: PSetupComponentEntry;
|
|
MinimumTypeSpace: Integer64;
|
|
SourceWildcard: String;
|
|
ExpandedSetupMutex, ExtraRespawnParam, RespawnParams: String;
|
|
begin
|
|
InitializeCommonVars;
|
|
|
|
{ NewParamsForCode will hold all params except automatic internal ones like /SL5= and /DEBUGWND=
|
|
Also see Uninstall.ProcessCommandLine }
|
|
NewParamsForCode.Add(NewParamStr(0));
|
|
|
|
{ Based on SetupLdr or not?
|
|
Parameters for launching SetupLdr-based installation are:
|
|
/SL5="<handle to SetupLdr's notify window>,<setup 0 data offset>,
|
|
<setup 1 data offset>,<original exe filename>"
|
|
}
|
|
SplitNewParamStr(1, ParamName, ParamValue);
|
|
if CompareText(ParamName, '/SL5=') = 0 then begin
|
|
StartParam := 2;
|
|
SetupLdrMode := True;
|
|
SetupNotifyWnd := ExtractLongWord(ParamValue);
|
|
SetupNotifyWndPresent := True;
|
|
SetupLdrOffset0 := ExtractLongWord(ParamValue);
|
|
SetupLdrOffset1 := ExtractLongWord(ParamValue);
|
|
SetupLdrOriginalFilename := ParamValue;
|
|
end
|
|
else begin
|
|
StartParam := 1;
|
|
SetupLdrOriginalFilename := NewParamStr(0);
|
|
end;
|
|
SourceDir := PathExtractDir(SetupLdrOriginalFilename);
|
|
|
|
IsRespawnedProcess := False;
|
|
EnableLogging := False;
|
|
WantToSuppressMsgBoxes := False;
|
|
DebugServerWnd := 0;
|
|
for I := StartParam to NewParamCount do begin
|
|
SplitNewParamStr(I, ParamName, ParamValue);
|
|
ParamIsAutomaticInternal := False;
|
|
if CompareText(ParamName, '/Log') = 0 then begin
|
|
EnableLogging := True;
|
|
LogFilename := '';
|
|
end else if CompareText(ParamName, '/Log=') = 0 then begin
|
|
EnableLogging := True;
|
|
LogFilename := ParamValue;
|
|
end else if CompareText(ParamName, '/Silent') = 0 then
|
|
InitSilent := True
|
|
else if CompareText(ParamName, '/VerySilent') = 0 then
|
|
InitVerySilent := True
|
|
else if CompareText(ParamName, '/NoRestart') = 0 then
|
|
InitNoRestart := True
|
|
else if CompareText(ParamName, '/CloseApplications') = 0 then
|
|
InitCloseApplications := True
|
|
else if CompareText(ParamName, '/NoCloseApplications') = 0 then
|
|
InitNoCloseApplications := True
|
|
else if CompareText(ParamName, '/ForceCloseApplications') = 0 then
|
|
InitForceCloseApplications := True
|
|
else if CompareText(ParamName, '/NoForceCloseApplications') = 0 then
|
|
InitNoForceCloseApplications := True
|
|
else if CompareText(ParamName, '/LogCloseApplications') = 0 then
|
|
InitLogCloseApplications := True
|
|
else if CompareText(ParamName, '/RestartApplications') = 0 then
|
|
InitRestartApplications := True
|
|
else if CompareText(ParamName, '/NoRestartApplications') = 0 then
|
|
InitNoRestartApplications := True
|
|
else if CompareText(ParamName, '/NoIcons') = 0 then
|
|
InitNoIcons := True
|
|
else if CompareText(ParamName, '/NoCancel') = 0 then
|
|
InitNoCancel := True
|
|
else if CompareText(ParamName, '/Lang=') = 0 then
|
|
InitLang := ParamValue
|
|
else if CompareText(ParamName, '/Type=') = 0 then
|
|
InitSetupType := ParamValue
|
|
else if CompareText(ParamName, '/Components=') = 0 then begin
|
|
InitComponentsSpecified := True;
|
|
SetStringsFromCommaString(InitComponents, SlashesToBackslashes(ParamValue));
|
|
end else if CompareText(ParamName, '/Tasks=') = 0 then begin
|
|
InitDeselectAllTasks := True;
|
|
SetStringsFromCommaString(InitTasks, SlashesToBackslashes(ParamValue));
|
|
end else if CompareText(ParamName, '/MergeTasks=') = 0 then begin
|
|
InitDeselectAllTasks := False;
|
|
SetStringsFromCommaString(InitTasks, SlashesToBackslashes(ParamValue));
|
|
end else if CompareText(ParamName, '/LoadInf=') = 0 then
|
|
InitLoadInf := PathExpand(ParamValue)
|
|
else if CompareText(ParamName, '/SaveInf=') = 0 then
|
|
InitSaveInf := PathExpand(ParamValue)
|
|
else if CompareText(ParamName, '/DIR=') = 0 then
|
|
InitDir := ParamValue
|
|
else if CompareText(ParamName, '/GROUP=') = 0 then
|
|
InitProgramGroup := ParamValue
|
|
else if CompareText(ParamName, '/Password=') = 0 then
|
|
InitPassword := ParamValue
|
|
else if CompareText(ParamName, '/RestartExitCode=') = 0 then
|
|
InitRestartExitCode := StrToIntDef(ParamValue, 0)
|
|
else if CompareText(ParamName, '/SuppressMsgBoxes') = 0 then
|
|
WantToSuppressMsgBoxes := True
|
|
else if CompareText(ParamName, '/DETACHEDMSG') = 0 then { for debugging }
|
|
DetachedUninstMsgFile := True
|
|
else if CompareText(ParamName, '/SPAWNWND=') = 0 then begin
|
|
ParamIsAutomaticInternal := True; { sent by RespawnSetupElevated }
|
|
IsRespawnedProcess := True;
|
|
InitializeSpawnClient(StrToInt(ParamValue));
|
|
end else if CompareText(ParamName, '/NOTIFYWND=') = 0 then begin
|
|
ParamIsAutomaticInternal := True; { sent by RespawnSetupElevated }
|
|
{ /NOTIFYWND= takes precedence over any previously set SetupNotifyWnd }
|
|
SetupNotifyWnd := StrToInt(ParamValue);
|
|
SetupNotifyWndPresent := True;
|
|
end else if CompareText(ParamName, '/DebugSpawnServer') = 0 then { for debugging }
|
|
EnterSpawnServerDebugMode { does not return }
|
|
else if CompareText(ParamName, '/DEBUGWND=') = 0 then begin
|
|
ParamIsAutomaticInternal := True; { sent by IDE.MainForm's StartProcess }
|
|
DebugServerWnd := StrToInt(ParamValue);
|
|
end else if CompareText(ParamName, '/ALLUSERS') = 0 then begin
|
|
InitPrivilegesRequired := prAdmin;
|
|
HasInitPrivilegesRequired := True;
|
|
end else if CompareText(ParamName, '/CURRENTUSER') = 0 then begin
|
|
InitPrivilegesRequired := prLowest;
|
|
HasInitPrivilegesRequired := True;
|
|
end;
|
|
if not ParamIsAutomaticInternal then
|
|
NewParamsForCode.Add(NewParamStr(I));
|
|
end;
|
|
|
|
if InitLoadInf <> '' then
|
|
LoadInf(InitLoadInf, WantToSuppressMsgBoxes);
|
|
|
|
if WantToSuppressMsgBoxes and (InitSilent or InitVerySilent) then
|
|
InitSuppressMsgBoxes := True;
|
|
|
|
{ Assign some default messages that may be used before the messages are read }
|
|
SetupMessages[msgSetupFileMissing] := SSetupFileMissing;
|
|
SetupMessages[msgSetupFileCorrupt] := SSetupFileCorrupt;
|
|
SetupMessages[msgSetupFileCorruptOrWrongVer] := SSetupFileCorruptOrWrongVer;
|
|
|
|
{ Read setup-0.bin, or from EXE }
|
|
if not SetupLdrMode then begin
|
|
SetupFilename := PathChangeExt(SetupLdrOriginalFilename, '') + '-0.bin';
|
|
if not NewFileExists(SetupFilename) then
|
|
AbortInitFmt1(msgSetupFileMissing, PathExtractName(SetupFilename));
|
|
end
|
|
else
|
|
SetupFilename := SetupLdrOriginalFilename;
|
|
SetupFile := TFile.Create(SetupFilename, fdOpenExisting, faRead, fsRead);
|
|
try
|
|
SetupFile.Seek(SetupLdrOffset0);
|
|
if SetupFile.Read(TestID, SizeOf(TestID)) <> SizeOf(TestID) then
|
|
AbortInit(msgSetupFileCorruptOrWrongVer);
|
|
if TestID <> SetupID then
|
|
AbortInit(msgSetupFileCorruptOrWrongVer);
|
|
try
|
|
Reader := TCompressedBlockReader.Create(SetupFile, TLZMA1Decompressor);
|
|
try
|
|
{ Header }
|
|
SECompressedBlockRead(Reader, SetupHeader, SizeOf(SetupHeader),
|
|
SetupHeaderStrings, SetupHeaderAnsiStrings);
|
|
{ Language entries }
|
|
ReadEntriesWithoutVersion(seLanguage, SetupHeader.NumLanguageEntries,
|
|
SizeOf(TSetupLanguageEntry));
|
|
{ CustomMessage entries }
|
|
ReadEntriesWithoutVersion(seCustomMessage, SetupHeader.NumCustomMessageEntries,
|
|
SizeOf(TSetupCustomMessageEntry));
|
|
{ Permission entries }
|
|
ReadEntriesWithoutVersion(sePermission, SetupHeader.NumPermissionEntries,
|
|
SizeOf(TSetupPermissionEntry));
|
|
{ Type entries }
|
|
ReadEntries(seType, SetupHeader.NumTypeEntries, SizeOf(TSetupTypeEntry),
|
|
Integer(@PSetupTypeEntry(nil).MinVersion),
|
|
Integer(@PSetupTypeEntry(nil).OnlyBelowVersion));
|
|
|
|
ActivateDefaultLanguage;
|
|
|
|
{ Set Is64BitInstallMode if we're on Win64 and the processor architecture is
|
|
one on which a "64-bit mode" install should be performed. Doing this early
|
|
so that UsePreviousPrivileges knows where to look. Will log later. }
|
|
if (SetupHeader.ArchitecturesInstallIn64BitMode <> '') and
|
|
EvalExpression(SetupHeader.ArchitecturesInstallIn64BitMode, TDummyClass.EvalArchitectureIdentifier) then begin
|
|
if not IsWin64 then begin
|
|
{ The script writer made a mistake: their expression matched a
|
|
32-bit system. Obviously that can't be allowed.
|
|
With "not" there are lots of ways that could happen without
|
|
explicitly specifying a 32-bit architecture in the expression.
|
|
One example: "not win64" }
|
|
InternalError('ArchitecturesInstallIn64BitMode expression matched 32-bit system');
|
|
end;
|
|
Initialize64BitInstallMode(True);
|
|
end
|
|
else
|
|
Initialize64BitInstallMode(False);
|
|
|
|
HandlePrivilegesRequiredOverrides(ExtraRespawnParam);
|
|
|
|
{ Start a new, elevated Setup(Ldr) process if needed }
|
|
if not IsRespawnedProcess and
|
|
NeedToRespawnSelfElevated(not (SetupHeader.PrivilegesRequired in [prNone, prLowest]),
|
|
SetupHeader.PrivilegesRequired <> prLowest) then begin
|
|
FreeAndNil(Reader);
|
|
FreeAndNil(SetupFile);
|
|
RespawnParams := GetCmdTailEx(StartParam);
|
|
if ExtraRespawnParam <> '' then
|
|
RespawnParams := RespawnParams + ' ' + ExtraRespawnParam;
|
|
RespawnSetupElevated(RespawnParams);
|
|
{ Note: RespawnSetupElevated does not return; it either calls Halt
|
|
or raises an exception. }
|
|
end;
|
|
|
|
{ Application.Handle is now known to be the main window. Set the shutdown block reason. }
|
|
ShutdownBlockReasonCreate(Application.Handle, SetupMessages[msgWizardInstalling]);
|
|
|
|
{ Initialize debug client (client=Setup, server=debugger/IDE) }
|
|
if DebugServerWnd <> 0 then
|
|
SetDebugServerWnd(DebugServerWnd, False);
|
|
|
|
{ Initialize logging }
|
|
if EnableLogging or (shSetupLogging in SetupHeader.Options) then begin
|
|
try
|
|
if LogFilename = '' then
|
|
StartLogging('Setup')
|
|
else
|
|
StartLoggingWithFixedFilename(LogFilename);
|
|
except
|
|
on E: Exception do begin
|
|
E.Message := 'Error creating log file:' + SNewLine2 + E.Message;
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
Log('Setup version: ' + SetupTitle + ' version ' + SetupVersion);
|
|
Log('Original Setup EXE: ' + SetupLdrOriginalFilename);
|
|
Log('Setup command line: ' + GetCmdTail);
|
|
LogCompatibilityMode;
|
|
LogWindowsVersion;
|
|
|
|
NeedPassword := shPassword in SetupHeader.Options;
|
|
NeedSerial := False;
|
|
NeedsRestart := shAlwaysRestart in SetupHeader.Options;
|
|
|
|
{ Component entries }
|
|
ReadEntries(seComponent, SetupHeader.NumComponentEntries, SizeOf(TSetupComponentEntry),
|
|
-1, -1);
|
|
{ Task entries }
|
|
ReadEntries(seTask, SetupHeader.NumTaskEntries, SizeOf(TSetupTaskEntry),
|
|
-1, -1);
|
|
{ Dir entries }
|
|
ReadEntries(seDir, SetupHeader.NumDirEntries, SizeOf(TSetupDirEntry),
|
|
Integer(@PSetupDirEntry(nil).MinVersion),
|
|
Integer(@PSetupDirEntry(nil).OnlyBelowVersion));
|
|
{ ISSigKey entries }
|
|
ReadEntriesWithoutVersion(seISSigKey, SetupHeader.NumISSigKeyEntries, SizeOf(TSetupISSigKeyEntry));
|
|
{ File entries }
|
|
ReadEntries(seFile, SetupHeader.NumFileEntries, SizeOf(TSetupFileEntry),
|
|
Integer(@PSetupFileEntry(nil).MinVersion),
|
|
Integer(@PSetupFileEntry(nil).OnlyBelowVersion));
|
|
{ Icon entries }
|
|
ReadEntries(seIcon, SetupHeader.NumIconEntries, SizeOf(TSetupIconEntry),
|
|
Integer(@PSetupIconEntry(nil).MinVersion),
|
|
Integer(@PSetupIconEntry(nil).OnlyBelowVersion));
|
|
{ INI entries }
|
|
ReadEntries(seIni, SetupHeader.NumIniEntries, SizeOf(TSetupIniEntry),
|
|
Integer(@PSetupIniEntry(nil).MinVersion),
|
|
Integer(@PSetupIniEntry(nil).OnlyBelowVersion));
|
|
{ Registry entries }
|
|
ReadEntries(seRegistry, SetupHeader.NumRegistryEntries, SizeOf(TSetupRegistryEntry),
|
|
Integer(@PSetupRegistryEntry(nil).MinVersion),
|
|
Integer(@PSetupRegistryEntry(nil).OnlyBelowVersion));
|
|
{ InstallDelete entries }
|
|
ReadEntries(seInstallDelete, SetupHeader.NumInstallDeleteEntries, SizeOf(TSetupDeleteEntry),
|
|
Integer(@PSetupDeleteEntry(nil).MinVersion),
|
|
Integer(@PSetupDeleteEntry(nil).OnlyBelowVersion));
|
|
{ UninstallDelete entries }
|
|
ReadEntries(seUninstallDelete, SetupHeader.NumUninstallDeleteEntries, SizeOf(TSetupDeleteEntry),
|
|
Integer(@PSetupDeleteEntry(nil).MinVersion),
|
|
Integer(@PSetupDeleteEntry(nil).OnlyBelowVersion));
|
|
{ Run entries }
|
|
ReadEntries(seRun, SetupHeader.NumRunEntries, SizeOf(TSetupRunEntry),
|
|
Integer(@PSetupRunEntry(nil).MinVersion),
|
|
Integer(@PSetupRunEntry(nil).OnlyBelowVersion));
|
|
{ UninstallRun entries }
|
|
ReadEntries(seUninstallRun, SetupHeader.NumUninstallRunEntries, SizeOf(TSetupRunEntry),
|
|
Integer(@PSetupRunEntry(nil).MinVersion),
|
|
Integer(@PSetupRunEntry(nil).OnlyBelowVersion));
|
|
{ Wizard images }
|
|
Reader.Read(N, SizeOf(LongInt));
|
|
for I := 0 to N-1 do
|
|
WizardImages.Add(ReadWizardImage(Reader));
|
|
Reader.Read(N, SizeOf(LongInt));
|
|
for I := 0 to N-1 do
|
|
WizardSmallImages.Add(ReadWizardImage(Reader));
|
|
{ Decompressor DLL }
|
|
DecompressorDLL := nil;
|
|
if SetupHeader.CompressMethod in [cmZip, cmBzip] then begin
|
|
DecompressorDLL := TMemoryStream.Create;
|
|
ReadFileIntoStream(DecompressorDLL, Reader);
|
|
end;
|
|
{ SevenZip DLL }
|
|
SevenZipDLL := nil;
|
|
if SetupHeader.SevenZipLibraryName <> '' then begin
|
|
SevenZipDLL := TMemoryStream.Create;
|
|
ReadFileIntoStream(SevenZipDLL, Reader);
|
|
end;
|
|
finally
|
|
Reader.Free;
|
|
end;
|
|
Reader := TCompressedBlockReader.Create(SetupFile, TLZMA1Decompressor);
|
|
try
|
|
{ File location entries }
|
|
ReadEntriesWithoutVersion(seFileLocation, SetupHeader.NumFileLocationEntries,
|
|
SizeOf(TSetupFileLocationEntry));
|
|
finally
|
|
Reader.Free;
|
|
end;
|
|
except
|
|
on ECompressDataError do
|
|
AbortInit(msgSetupFileCorrupt);
|
|
end;
|
|
finally
|
|
SetupFile.Free;
|
|
end;
|
|
|
|
InitializeAdminInstallMode(IsAdmin and (SetupHeader.PrivilegesRequired <> prLowest));
|
|
|
|
Log64BitInstallMode;
|
|
|
|
{ Show "Select Language" dialog if necessary - requires "64-bit mode" to be
|
|
initialized else it might query the previous language from the wrong registry
|
|
view }
|
|
if Entries[seLanguage].Count > 1 then begin
|
|
if ShowLanguageDialog and not InitSilent and not InitVerySilent then begin
|
|
if not AskForLanguage then
|
|
Abort;
|
|
end else if not MatchedLangParameter and (shUsePreviousLanguage in SetupHeader.Options) then begin
|
|
{ Replicate the dialog's UsePreviousLanguage functionality. }
|
|
{ Note: if UsePreviousLanguage is set to "yes" then the compiler does not
|
|
allow AppId to include constants but we should still call ExpandConst
|
|
to handle any '{{'. }
|
|
I := GetPreviousLanguage(ExpandConst(SetupHeader.AppId));
|
|
if I <> -1 then
|
|
SetActiveLanguage(I);
|
|
end;
|
|
end;
|
|
|
|
{ Check unsupported Itanium - must be on Windows Server 2008 R2 so remove once
|
|
this becomes unsupported as well and Windows 8 (6.2+) becomes the new minimum }
|
|
var SysInfo: TSystemInfo;
|
|
GetNativeSystemInfo(SysInfo);
|
|
if SysInfo.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_IA64 then
|
|
AbortInit(msgWindowsVersionNotSupported);
|
|
|
|
{ Check allowed processor architectures }
|
|
if (SetupHeader.ArchitecturesAllowed <> '') and
|
|
not EvalExpression(SetupHeader.ArchitecturesAllowed, TDummyClass.EvalArchitectureIdentifier) then
|
|
AbortInit(msgWindowsVersionNotSupported);
|
|
|
|
{ Check Windows version }
|
|
case InstallOnThisVersion(SetupHeader.MinVersion, SetupHeader.OnlyBelowVersion) of
|
|
irInstall: ;
|
|
irServicePackTooLow:
|
|
AbortInitServicePackRequired(SetupHeader.MinVersion.NTServicePack);
|
|
else
|
|
AbortInit(msgWindowsVersionNotSupported);
|
|
end;
|
|
|
|
{ Check if the user lacks the required privileges }
|
|
case SetupHeader.PrivilegesRequired of
|
|
prPowerUser:
|
|
if not IsPowerUserOrAdmin then AbortInit(msgPowerUserPrivilegesRequired);
|
|
prAdmin:
|
|
if not IsAdmin then AbortInit(msgAdminPrivilegesRequired);
|
|
end;
|
|
|
|
{ Init main constants, not depending on shfolder.dll/_shfoldr.dll }
|
|
InitMainNonSHFolderConsts;
|
|
|
|
{ Create temporary directory and extract 64-bit helper EXE if necessary }
|
|
CreateTempInstallDirAndExtract64BitHelper;
|
|
|
|
{ Load system's "shfolder.dll", and load it }
|
|
LoadSHFolderDLL;
|
|
|
|
{ Extract "_isdecmp.dll" to TempInstallDir, and load it }
|
|
if SetupHeader.CompressMethod in [cmZip, cmBzip] then
|
|
LoadDecompressorDLL;
|
|
|
|
{ Extract "_is7z.dll" to TempInstallDir, and load it }
|
|
if SetupHeader.SevenZipLibraryName <> '' then
|
|
LoadSevenZipDLL;
|
|
|
|
{ Start RestartManager session }
|
|
if InitCloseApplications or
|
|
((shCloseApplications in SetupHeader.Options) and not InitNoCloseApplications) then begin
|
|
InitRestartManagerLibrary;
|
|
{ Note from Old New Thing: "The RmStartSession function doesn't properly
|
|
null-terminate the session key <...>. To work around this bug, we pre-fill
|
|
the buffer with null characters <...>." Our key is pre-filled too since
|
|
it's global. }
|
|
if UseRestartManager and (RmStartSession(@RmSessionHandle, 0, RmSessionKey) = ERROR_SUCCESS) then begin
|
|
RmSessionStarted := True;
|
|
SetStringsFromCommaString(CloseApplicationsFilterList, SetupHeader.CloseApplicationsFilter);
|
|
SetStringsFromCommaString(CloseApplicationsFilterExcludesList, SetupHeader.CloseApplicationsFilterExcludes);
|
|
end;
|
|
end;
|
|
|
|
{ Set install mode }
|
|
SetupInstallMode;
|
|
|
|
{ Init ISSigAvailableKeys }
|
|
SetLength(ISSigAvailableKeys, Entries[seISSigKey].Count);
|
|
for I := 0 to Entries[seISSigKey].Count-1 do begin
|
|
var ISSigKeyEntry := PSetupISSigKeyEntry(Entries[seISSigKey][I]);
|
|
ISSigAvailableKeys[I] := TECDSAKey.Create;
|
|
if ISSigImportPublicKey(ISSigAvailableKeys[I], '', ISSigKeyEntry.PublicX, ISSigKeyEntry.PublicY) <> ikrSuccess then
|
|
InternalError('ISSigImportPublicKey failed')
|
|
end;
|
|
|
|
{ Load and initialize code }
|
|
if SetupHeader.CompiledCodeText <> '' then begin
|
|
CodeRunner := TScriptRunner.Create();
|
|
try
|
|
CodeRunner.NamingAttribute := CodeRunnerNamingAttribute;
|
|
CodeRunner.OnLog := CodeRunnerOnLog;
|
|
CodeRunner.OnLogFmt := CodeRunnerOnLogFmt;
|
|
CodeRunner.OnDllImport := CodeRunnerOnDllImport;
|
|
CodeRunner.OnDebug := CodeRunnerOnDebug;
|
|
CodeRunner.OnDebugIntermediate := CodeRunnerOnDebugIntermediate;
|
|
CodeRunner.OnException := CodeRunnerOnException;
|
|
CodeRunner.LoadScript(SetupHeader.CompiledCodeText, DebugClientCompiledCodeDebugInfo);
|
|
if not NeedPassword then
|
|
NeedPassword := CodeRunner.FunctionExists('CheckPassword', True);
|
|
NeedPassword := HandleInitPassword(NeedPassword);
|
|
if not NeedSerial then
|
|
NeedSerial := CodeRunner.FunctionExists('CheckSerial', True);
|
|
except
|
|
{ Don't let DeinitSetup see a partially-initialized CodeRunner }
|
|
FreeAndNil(CodeRunner);
|
|
raise;
|
|
end;
|
|
try
|
|
Res := CodeRunner.RunBooleanFunctions('InitializeSetup', [''], bcFalse, False, True);
|
|
except
|
|
Log('InitializeSetup raised an exception (fatal).');
|
|
raise;
|
|
end;
|
|
if not Res then begin
|
|
Log('InitializeSetup returned False; aborting.');
|
|
Abort;
|
|
end;
|
|
end
|
|
else
|
|
NeedPassword := HandleInitPassword(NeedPassword);
|
|
|
|
{ Expand AppName, AppVerName, and AppCopyright now since they're used often,
|
|
especially by the background window painting. }
|
|
ExpandedAppName := ExpandConst(SetupHeader.AppName);
|
|
if SetupHeader.AppVerName <> '' then
|
|
ExpandedAppVerName := ExpandConst(SetupHeader.AppVerName)
|
|
else begin
|
|
if not GetCustomMessageValue('NameAndVersion', NameAndVersionMsg) then
|
|
NameAndVersionMsg := '%1 %2'; { just in case }
|
|
ExpandedAppVerName := FmtMessage(PChar(NameAndVersionMsg),
|
|
[ExpandedAppName, ExpandConst(SetupHeader.AppVersion)]);
|
|
end;
|
|
ExpandedAppCopyright := ExpandConst(SetupHeader.AppCopyright);
|
|
ExpandedAppMutex := ExpandConst(SetupHeader.AppMutex);
|
|
ExpandedSetupMutex := ExpandConst(SetupHeader.SetupMutex);
|
|
|
|
{ Update the shutdown block reason now that we have ExpandedAppName. }
|
|
ShutdownBlockReasonCreate(Application.Handle,
|
|
FmtSetupMessage1(msgShutdownBlockReasonInstallingApp, ExpandedAppName));
|
|
|
|
{ Check if app is running }
|
|
while CheckForMutexes(ExpandedAppMutex) do
|
|
if LoggedMsgBox(FmtSetupMessage1(msgSetupAppRunningError, ExpandedAppName),
|
|
SetupMessages[msgSetupAppTitle], mbError, MB_OKCANCEL, True, IDCANCEL) <> IDOK then
|
|
Abort;
|
|
|
|
{ Check if Setup is running and if not create mutexes }
|
|
while CheckForMutexes(ExpandedSetupMutex) do
|
|
if LoggedMsgBox(FmtSetupMessage1(msgSetupAppRunningError, SetupMessages[msgSetupAppTitle]),
|
|
SetupMessages[msgSetupAppTitle], mbError, MB_OKCANCEL, True, IDCANCEL) <> IDOK then
|
|
Abort;
|
|
CreateMutexes(ExpandedSetupMutex);
|
|
|
|
{ Remove types that fail their 'languages' or 'check'. Can't do this earlier
|
|
because the InitializeSetup call above can't be done earlier. }
|
|
for I := 0 to Entries[seType].Count-1 do begin
|
|
if not ShouldProcessEntry(nil, nil, '', '', PSetupTypeEntry(Entries[seType][I]).Languages, PSetupTypeEntry(Entries[seType][I]).CheckOnce) then begin
|
|
SEFreeRec(Entries[seType][I], EntryStrings[seType], EntryAnsiStrings[seType]);
|
|
{ Don't delete it yet so that the entries can be processed sequentially }
|
|
Entries[seType][I] := nil;
|
|
end;
|
|
end;
|
|
{ Delete the nil-ed items now }
|
|
Entries[seType].Pack();
|
|
|
|
{ Remove components }
|
|
NextAllowedLevel := 0;
|
|
LastShownComponentEntry := nil;
|
|
for I := 0 to Entries[seComponent].Count-1 do begin
|
|
ComponentEntry := PSetupComponentEntry(Entries[seComponent][I]);
|
|
if (ComponentEntry.Level <= NextAllowedLevel) and
|
|
(InstallOnThisVersion(ComponentEntry.MinVersion, ComponentEntry.OnlyBelowVersion) = irInstall) and
|
|
ShouldProcessEntry(nil, nil, '', '', ComponentEntry.Languages, ComponentEntry.CheckOnce) then begin
|
|
NextAllowedLevel := ComponentEntry.Level + 1;
|
|
LastShownComponentEntry := ComponentEntry;
|
|
end
|
|
else begin
|
|
{ Not showing }
|
|
if Assigned(LastShownComponentEntry) and
|
|
(ComponentEntry.Level = LastShownComponentEntry.Level) and
|
|
(CompareText(ComponentEntry.Name, LastShownComponentEntry.Name) = 0) then begin
|
|
{ It's a duplicate of the last shown item. Leave NextAllowedLevel
|
|
alone, so that any child items that follow can attach to the last
|
|
shown item. }
|
|
end
|
|
else begin
|
|
{ Not a duplicate of the last shown item, so the next item must be
|
|
at the same level or less }
|
|
if NextAllowedLevel > ComponentEntry.Level then
|
|
NextAllowedLevel := ComponentEntry.Level;
|
|
{ Clear LastShownComponentEntry so that no subsequent item can be
|
|
considered a duplicate of it. Needed in this case:
|
|
foo (shown)
|
|
foo\childA (not shown)
|
|
foo (not shown)
|
|
foo\childB
|
|
"foo\childB" should be hidden, not made a child of "foo" #1. }
|
|
LastShownComponentEntry := nil;
|
|
end;
|
|
Entries[seComponent][I] := nil;
|
|
SEFreeRec(ComponentEntry, EntryStrings[seComponent], EntryAnsiStrings[seComponent]);
|
|
end;
|
|
end;
|
|
Entries[seComponent].Pack();
|
|
|
|
{ Set misc. variables }
|
|
HasCustomType := False;
|
|
for I := 0 to Entries[seType].Count-1 do begin
|
|
if toIsCustom in PSetupTypeEntry(Entries[seType][I]).Options then begin
|
|
HasCustomType := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
HasComponents := Entries[seComponent].Count <> 0;
|
|
|
|
HasIcons := Entries[seIcon].Count <> 0;
|
|
|
|
HasTasks := Entries[seTask].Count <> 0;
|
|
|
|
{ Calculate minimum disk space. If there are setup types, find the smallest
|
|
type and add the size of all files that don't belong to any component. Otherwise
|
|
calculate minimum disk space by adding all of the file's sizes. Also for each
|
|
"external" file, check the file size now, and store it the ExternalSize field
|
|
of the TSetupFileEntry record, except if an ExternalSize was specified by the
|
|
script. }
|
|
|
|
MinimumSpace := SetupHeader.ExtraDiskSpaceRequired;
|
|
|
|
const LExcludes = TStringList.Create;
|
|
try
|
|
LExcludes.StrictDelimiter := True;
|
|
LExcludes.Delimiter := ',';
|
|
|
|
for I := 0 to Entries[seFile].Count-1 do begin
|
|
with PSetupFileEntry(Entries[seFile][I])^ do begin
|
|
if LocationEntry <> -1 then begin { not an "external" file }
|
|
if Components = '' then { no types or a file that doesn't belong to any component }
|
|
if (Tasks = '') and (Check = '') then {don't count tasks and scripted entries}
|
|
Inc6464(MinimumSpace, PSetupFileLocationEntry(Entries[seFileLocation][LocationEntry])^.OriginalSize)
|
|
end else begin
|
|
if not(foExternalSizePreset in Options) then begin
|
|
if foDownload in Options then
|
|
InternalError('Unexpected download flag');
|
|
try
|
|
LExcludes.DelimitedText := Excludes;
|
|
if foExtractArchive in Options then begin
|
|
ExternalSize := RecurseExternalArchiveGetSizeOfFiles(
|
|
ShouldDisableFsRedirForFileEntry(PSetupFileEntry(Entries[seFile][I])),
|
|
ExpandConst(SourceFilename), ExpandConst(ExtractArchivePassword), LExcludes,
|
|
foRecurseSubDirsExternal in Options);
|
|
end else begin
|
|
if FileType <> ftUserFile then
|
|
SourceWildcard := NewParamStr(0)
|
|
else
|
|
SourceWildcard := ExpandConst(SourceFilename);
|
|
ExternalSize := RecurseExternalGetSizeOfFiles(
|
|
ShouldDisableFsRedirForFileEntry(PSetupFileEntry(Entries[seFile][I])),
|
|
PathExtractPath(SourceWildcard),
|
|
'', PathExtractName(SourceWildcard), IsWildcard(SourceWildcard),
|
|
LExcludes, foRecurseSubDirsExternal in Options);
|
|
end;
|
|
except
|
|
{ Ignore exceptions. Two notable exceptions we want to ignore are
|
|
the one about "app" not being initialized and also archive errors
|
|
(ESevenZipError). Also see EnumFiles. }
|
|
end;
|
|
end;
|
|
if Components = '' then { no types or a file that doesn't belong to any component }
|
|
if (Tasks = '') and (Check = '') then {don't count tasks or scripted entries}
|
|
Inc6464(MinimumSpace, ExternalSize);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
LExcludes.Free;
|
|
end;
|
|
|
|
for I := 0 to Entries[seComponent].Count-1 do
|
|
with PSetupComponentEntry(Entries[seComponent][I])^ do
|
|
Size := GetSizeOfComponent(Name, ExtraDiskSpaceRequired);
|
|
|
|
if Entries[seType].Count > 0 then begin
|
|
for I := 0 to Entries[seType].Count-1 do begin
|
|
with PSetupTypeEntry(Entries[seType][I])^ do begin
|
|
Size := GetSizeOfType(Name, toIsCustom in Options);
|
|
if (I = 0) or (Compare64(Size, MinimumTypeSpace) < 0) then
|
|
MinimumTypeSpace := Size;
|
|
end;
|
|
end;
|
|
Inc6464(MinimumSpace, MinimumTypeSpace);
|
|
end;
|
|
end;
|
|
|
|
procedure InitializeWizard;
|
|
begin
|
|
WizardForm := AppCreateForm(TWizardForm) as TWizardForm;
|
|
if CodeRunner <> nil then begin
|
|
try
|
|
CodeRunner.RunProcedures('InitializeWizard', [''], False);
|
|
except
|
|
Log('InitializeWizard raised an exception (fatal).');
|
|
raise;
|
|
end;
|
|
end;
|
|
WizardForm.FlipSizeAndCenterIfNeeded(False, nil, False);
|
|
WizardForm.SetCurPage(wpWelcome);
|
|
if InstallMode = imNormal then begin
|
|
WizardForm.ClickToStartPage; { this won't go past wpReady }
|
|
WizardForm.Visible := True;
|
|
end
|
|
else
|
|
WizardForm.ClickThroughPages;
|
|
end;
|
|
|
|
procedure DeinitSetup(const AllowCustomSetupExitCode: Boolean);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Log('Deinitializing Setup.');
|
|
|
|
if Assigned(CodeRunner) then begin
|
|
if AllowCustomSetupExitCode then begin
|
|
try
|
|
SetupExitCode := CodeRunner.RunIntegerFunctions('GetCustomSetupExitCode',
|
|
[''], bcNonZero, False, SetupExitCode);
|
|
except
|
|
Log('GetCustomSetupExitCode raised an exception.');
|
|
Application.HandleException(nil);
|
|
end;
|
|
end;
|
|
try
|
|
CodeRunner.RunProcedures('DeinitializeSetup', [''], False);
|
|
except
|
|
Log('DeinitializeSetup raised an exception.');
|
|
Application.HandleException(nil);
|
|
end;
|
|
FreeAndNil(CodeRunner);
|
|
end;
|
|
|
|
for I := 0 to DeleteFilesAfterInstallList.Count-1 do
|
|
DeleteFileRedir(DeleteFilesAfterInstallList.Objects[I] <> nil,
|
|
DeleteFilesAfterInstallList[I]);
|
|
DeleteFilesAfterInstallList.Clear;
|
|
for I := DeleteDirsAfterInstallList.Count-1 downto 0 do
|
|
RemoveDirectoryRedir(DeleteDirsAfterInstallList.Objects[I] <> nil,
|
|
DeleteDirsAfterInstallList[I]);
|
|
DeleteDirsAfterInstallList.Clear;
|
|
|
|
for I := 0 to Length(ISSigAvailableKeys)-1 do
|
|
ISSigAvailableKeys[I].Free;
|
|
|
|
FreeFileExtractor;
|
|
|
|
{ End RestartManager session }
|
|
if RmSessionStarted then
|
|
RmEndSession(RmSessionHandle);
|
|
|
|
{ Free the _isdecmp.dll and _is7z.dll handles }
|
|
if DecompressorDLLHandle <> 0 then
|
|
FreeLibrary(DecompressorDLLHandle);
|
|
if SevenZipDLLHandle <> 0 then begin
|
|
SevenZipDLLDeInit;
|
|
FreeLibrary(SevenZipDLLHandle);
|
|
end;
|
|
|
|
{ Free the shfolder.dll handle }
|
|
UnloadSHFolderDLL;
|
|
|
|
{ Remove TempInstallDir, stopping the 64-bit helper first if necessary }
|
|
RemoveTempInstallDir;
|
|
|
|
{ An attempt to restart while debugging is most likely an accident;
|
|
don't allow it }
|
|
if RestartSystem and Debugging then begin
|
|
Log('Not restarting Windows because Setup is being run from the debugger.');
|
|
RestartSystem := False;
|
|
end;
|
|
|
|
EndDebug;
|
|
|
|
ShutdownBlockReasonDestroy(Application.Handle);
|
|
|
|
if RestartSystem then begin
|
|
Log('Restarting Windows.');
|
|
if SetupNotifyWndPresent then begin
|
|
{ Send a special message back to the first instance telling it to
|
|
restart the system after Setup returns }
|
|
SendNotifyMessage(SetupNotifyWnd, WM_USER + 150, 10000, 0);
|
|
end
|
|
else begin
|
|
{ There is no other instance, so initiate the restart ourself.
|
|
Note: Depending on the OS, this may not return if successful. }
|
|
RestartComputerFromThisProcess;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ExitSetupMsgBox: Boolean;
|
|
begin
|
|
Result := LoggedMsgBox(SetupMessages[msgExitSetupMessage], SetupMessages[msgExitSetupTitle],
|
|
mbConfirmation, MB_YESNO or MB_DEFBUTTON2, False, 0) = IDYES;
|
|
end;
|
|
|
|
procedure ProcessMessagesProc; far;
|
|
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;
|
|
|
|
function ShouldDisableFsRedirForRunEntry(const RunEntry: PSetupRunEntry): Boolean;
|
|
begin
|
|
Result := InstallDefaultDisableFsRedir;
|
|
if roRun32Bit in RunEntry.Options then
|
|
Result := False;
|
|
if roRun64Bit in RunEntry.Options then begin
|
|
if not IsWin64 then
|
|
InternalError('Cannot run files in 64-bit locations on this version of Windows');
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
procedure ProcessRunEntry(const RunEntry: PSetupRunEntry);
|
|
var
|
|
RunAsOriginalUser: Boolean;
|
|
ExpandedFilename, ExpandedParameters: String;
|
|
Wait: TExecWait;
|
|
DisableFsRedir: Boolean;
|
|
ErrorCode: Integer;
|
|
begin
|
|
try
|
|
Log('-- Run entry --');
|
|
RunAsOriginalUser := (roRunAsOriginalUser in RunEntry.Options);
|
|
if RunAsOriginalUser then
|
|
Log('Run as: Original user')
|
|
else
|
|
Log('Run as: Current user');
|
|
if not(roShellExec in RunEntry.Options) then
|
|
Log('Type: Exec')
|
|
else
|
|
Log('Type: ShellExec');
|
|
ExpandedFilename := ExpandConst(RunEntry.Name);
|
|
Log('Filename: ' + ExpandedFilename);
|
|
ExpandedParameters := ExpandConst(RunEntry.Parameters);
|
|
if not(roDontLogParameters in RunEntry.Options) and (ExpandedParameters <> '') then
|
|
Log('Parameters: ' + ExpandedParameters);
|
|
|
|
Wait := ewWaitUntilTerminated;
|
|
case RunEntry.Wait of
|
|
rwNoWait: Wait := ewNoWait;
|
|
rwWaitUntilIdle: Wait := ewWaitUntilIdle;
|
|
end;
|
|
|
|
if not(roShellExec in RunEntry.Options) then begin
|
|
DisableFsRedir := ShouldDisableFsRedirForRunEntry(RunEntry);
|
|
if not(roSkipIfDoesntExist in RunEntry.Options) or
|
|
NewFileExistsRedir(DisableFsRedir, ExpandedFilename) then begin
|
|
var OutputReader: TCreateProcessOutputReader := nil;
|
|
try
|
|
if GetLogActive and (roLogOutput in RunEntry.Options) then
|
|
OutputReader := TCreateProcessOutputReader.Create(RunExecLog, 0);
|
|
if not InstExecEx(RunAsOriginalUser, DisableFsRedir, ExpandedFilename,
|
|
ExpandedParameters, ExpandConst(RunEntry.WorkingDir),
|
|
Wait, RunEntry.ShowCmd, ProcessMessagesProc, OutputReader, ErrorCode) then
|
|
raise Exception.Create(FmtSetupMessage1(msgErrorExecutingProgram, ExpandedFilename) +
|
|
SNewLine2 + FmtSetupMessage(msgErrorFunctionFailedWithMessage,
|
|
['CreateProcess', IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));
|
|
if Wait = ewWaitUntilTerminated then
|
|
Log(Format('Process exit code: %u', [ErrorCode]));
|
|
finally
|
|
OutputReader.Free;
|
|
end;
|
|
end
|
|
else
|
|
Log('File doesn''t exist. Skipping.');
|
|
end
|
|
else begin
|
|
if not(roSkipIfDoesntExist in RunEntry.Options) or FileOrDirExists(ExpandedFilename) then begin
|
|
if not InstShellExecEx(RunAsOriginalUser, ExpandConst(RunEntry.Verb),
|
|
ExpandedFilename, ExpandedParameters, ExpandConst(RunEntry.WorkingDir),
|
|
Wait, RunEntry.ShowCmd, ProcessMessagesProc, ErrorCode) then
|
|
raise Exception.Create(FmtSetupMessage1(msgErrorExecutingProgram, ExpandedFilename) +
|
|
SNewLine2 + FmtSetupMessage(msgErrorFunctionFailedWithMessage,
|
|
['ShellExecuteEx', IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));
|
|
end
|
|
else
|
|
Log('File/directory doesn''t exist. Skipping.');
|
|
end;
|
|
except
|
|
Application.HandleException(nil);
|
|
end;
|
|
end;
|
|
|
|
procedure ShellExecuteAsOriginalUser(hWnd: HWND; Operation, FileName, Parameters, Directory: LPWSTR; ShowCmd: Integer); stdcall;
|
|
var
|
|
ErrorCode: Integer;
|
|
begin
|
|
InstShellExecEx(True, Operation, Filename, Parameters, Directory, ewNoWait, ShowCmd, ProcessMessagesProc, ErrorCode);
|
|
end;
|
|
|
|
procedure InitIsWin64AndProcessorArchitectureAndMachineTypesSupportedBySystem;
|
|
const
|
|
PROCESSOR_ARCHITECTURE_ARM64 = 12;
|
|
IMAGE_FILE_MACHINE_ARM64 = $AA64;
|
|
IMAGE_FILE_MACHINE_ARMNT = $01C4;
|
|
UserEnabled = $1;
|
|
var
|
|
KernelModule: HMODULE;
|
|
IsWow64ProcessFunc: function(hProcess: THandle; var Wow64Process: BOOL): BOOL; stdcall;
|
|
IsWow64Process2Func: function(hProcess: THandle; var pProcessMachine, pNativeMachine: USHORT): BOOL; stdcall;
|
|
GetMachineTypeAttributesFunc: function(Machine: USHORT; var MachineTypeAttributes: Integer): HRESULT; stdcall;
|
|
IsWow64GuestMachineSupportedFunc: function(WowGuestMachine: USHORT; var MachineIsSupported: BOOL): HRESULT; stdcall;
|
|
ProcessMachine, NativeMachine: USHORT;
|
|
Wow64Process: BOOL;
|
|
SysInfo: TSystemInfo;
|
|
begin
|
|
KernelModule := GetModuleHandle(kernel32);
|
|
|
|
{ The system is considered a "Win64" system if all of the following
|
|
conditions are true:
|
|
1. One of the following two is true:
|
|
a. IsWow64Process2 is available, and returns True for the current process.
|
|
b. IsWow64Process is available, and returns True for the current process.
|
|
2. Wow64DisableWow64FsRedirection is available.
|
|
3. Wow64RevertWow64FsRedirection is available.
|
|
4. GetSystemWow64DirectoryA is available.
|
|
5. RegDeleteKeyExA is available.
|
|
The system does not have to be one of the known 64-bit architectures
|
|
to be considered a "Win64" system. }
|
|
|
|
IsWin64 := False;
|
|
|
|
IsWow64Process2Func := GetProcAddress(KernelModule, 'IsWow64Process2');
|
|
if Assigned(IsWow64Process2Func) and
|
|
IsWow64Process2Func(GetCurrentProcess, ProcessMachine, NativeMachine) and
|
|
(ProcessMachine <> IMAGE_FILE_MACHINE_UNKNOWN) then begin
|
|
IsWin64 := True;
|
|
case NativeMachine of
|
|
IMAGE_FILE_MACHINE_I386: ProcessorArchitecture := paX86;
|
|
IMAGE_FILE_MACHINE_AMD64: ProcessorArchitecture := paX64;
|
|
IMAGE_FILE_MACHINE_ARM64: ProcessorArchitecture := paArm64;
|
|
else
|
|
ProcessorArchitecture := paUnknown;
|
|
end;
|
|
end else begin
|
|
IsWow64ProcessFunc := GetProcAddress(KernelModule, 'IsWow64Process');
|
|
if Assigned(IsWow64ProcessFunc) and
|
|
IsWow64ProcessFunc(GetCurrentProcess, Wow64Process) and
|
|
Wow64Process then
|
|
IsWin64 := True;
|
|
|
|
GetNativeSystemInfo(SysInfo);
|
|
case SysInfo.wProcessorArchitecture of
|
|
PROCESSOR_ARCHITECTURE_INTEL: ProcessorArchitecture := paX86;
|
|
PROCESSOR_ARCHITECTURE_AMD64: ProcessorArchitecture := paX64;
|
|
PROCESSOR_ARCHITECTURE_ARM64: ProcessorArchitecture := paArm64;
|
|
else
|
|
ProcessorArchitecture := paUnknown;
|
|
end;
|
|
end;
|
|
|
|
if IsWin64 and
|
|
not (AreFsRedirectionFunctionsAvailable and
|
|
(GetProcAddress(KernelModule, 'GetSystemWow64DirectoryA') <> nil) and
|
|
(GetProcAddress(GetModuleHandle(advapi32), 'RegDeleteKeyExA') <> nil)) then
|
|
IsWin64 := False;
|
|
|
|
{ Setup MachineTypesSupportedBySystem. The result should end up being:
|
|
- 32-bit x86: [paX86]
|
|
- x64: [paX86, paX64]
|
|
(but not paX86 in a future x64 build of Inno Setup if Windows was installed
|
|
without support for x86 binaries (which is possible with Windows Server))
|
|
- Arm64 Windows 10: [paX86, paArm64, paArm32]
|
|
(Arm32 support detected, not just assumed)
|
|
- Arm64 Windows 11: [paX86, paX64, paArm64, paArm32]
|
|
(X64 and Arm32 support detected, not just assumed) }
|
|
|
|
{$IFDEF CPUX86}
|
|
MachineTypesSupportedBySystem := [paX86];
|
|
{$ELSE}
|
|
{$MESSAGE ERROR 'This needs updating for non-x86 builds'}
|
|
{$ENDIF}
|
|
|
|
if ProcessorArchitecture <> paUnknown then
|
|
Include(MachineTypesSupportedBySystem, ProcessorArchitecture);
|
|
|
|
{ On Windows 11 we can use GetMachineTypeAttributes to check what is supported extra }
|
|
GetMachineTypeAttributesFunc := GetProcAddress(KernelModule, 'GetMachineTypeAttributes');
|
|
if Assigned(GetMachineTypeAttributesFunc) then begin
|
|
var MachineTypeAttributes: Integer;
|
|
if (GetMachineTypeAttributesFunc(IMAGE_FILE_MACHINE_ARMNT, MachineTypeAttributes) = S_OK) and
|
|
((MachineTypeAttributes and UserEnabled) <> 0) then
|
|
Include(MachineTypesSupportedBySystem, paArm32);
|
|
if not (paX64 in MachineTypesSupportedBySystem) and
|
|
(GetMachineTypeAttributesFunc(IMAGE_FILE_MACHINE_AMD64, MachineTypeAttributes) = S_OK) and
|
|
((MachineTypeAttributes and UserEnabled) <> 0) then
|
|
Include(MachineTypesSupportedBySystem, paX64);
|
|
end else begin
|
|
{ Without GetMachineTypeAttributes we can only check if Arm32 is supported extra
|
|
using IsWow64GuestMachineSupported }
|
|
IsWow64GuestMachineSupportedFunc := GetProcAddress(KernelModule, 'IsWow64GuestMachineSupported');
|
|
if Assigned(IsWow64GuestMachineSupportedFunc) then begin
|
|
var MachineIsSupported: BOOL;
|
|
if (IsWow64GuestMachineSupportedFunc(IMAGE_FILE_MACHINE_ARMNT, MachineIsSupported) = S_OK) and
|
|
MachineIsSupported then
|
|
Include(MachineTypesSupportedBySystem, paArm32);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure InitWindowsVersion;
|
|
var
|
|
OSVersionInfo: TOSVersionInfo;
|
|
OSVersionInfoEx: TOSVersionInfoEx;
|
|
begin
|
|
OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
|
|
if GetVersionEx(OSVersionInfo) then begin
|
|
WindowsVersion := (Byte(OSVersionInfo.dwMajorVersion) shl 24) or
|
|
(Byte(OSVersionInfo.dwMinorVersion) shl 16) or
|
|
Word(OSVersionInfo.dwBuildNumber);
|
|
{ ^ Note: We MUST clip dwBuildNumber to 16 bits for Win9x compatibility }
|
|
OSVersionInfoEx.dwOSVersionInfoSize := SizeOf(OSVersionInfoEx);
|
|
if GetVersionEx(POSVersionInfo(@OSVersionInfoEx)^) then begin
|
|
NTServicePackLevel := (Byte(OSVersionInfoEx.wServicePackMajor) shl 8) or
|
|
Byte(OSVersionInfoEx.wServicePackMinor);
|
|
WindowsProductType := OSVersionInfoEx.wProductType;
|
|
WindowsSuiteMask := OSVersionInfoEx.wSuiteMask;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure CreateEntryLists;
|
|
var
|
|
I: TEntryType;
|
|
begin
|
|
for I := Low(I) to High(I) do
|
|
Entries[I] := TList.Create;
|
|
end;
|
|
|
|
procedure FreeEntryLists;
|
|
var
|
|
I: TEntryType;
|
|
List: TList;
|
|
J: Integer;
|
|
P: Pointer;
|
|
begin
|
|
for I := High(I) downto Low(I) do begin
|
|
List := Entries[I];
|
|
if Assigned(List) then begin
|
|
Entries[I] := nil;
|
|
for J := List.Count-1 downto 0 do begin
|
|
P := List[J];
|
|
if EntryStrings[I] <> 0 then
|
|
SEFreeRec(P, EntryStrings[I], EntryAnsiStrings[I])
|
|
else
|
|
FreeMem(P);
|
|
end;
|
|
List.Free;
|
|
end;
|
|
FreeAndNil(OriginalEntryIndexes[I]);
|
|
end;
|
|
end;
|
|
|
|
procedure FreeWizardImages;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := WizardImages.Count-1 downto 0 do
|
|
TBitmap(WizardImages[I]).Free;
|
|
FreeAndNil(WizardImages);
|
|
for I := WizardSmallImages.Count-1 downto 0 do
|
|
TBitmap(WizardSmallImages[I]).Free;
|
|
FreeAndNil(WizardSmallImages);
|
|
end;
|
|
|
|
initialization
|
|
InitIsWin64AndProcessorArchitectureAndMachineTypesSupportedBySystem;
|
|
InitWindowsVersion;
|
|
InitComponents := TStringList.Create();
|
|
InitTasks := TStringList.Create();
|
|
NewParamsForCode := TStringList.Create();
|
|
WizardComponents := TStringList.Create();
|
|
WizardDeselectedComponents := TStringList.Create();
|
|
WizardTasks := TStringList.Create();
|
|
WizardDeselectedTasks := TStringList.Create();
|
|
CreateEntryLists;
|
|
DeleteFilesAfterInstallList := TStringList.Create;
|
|
DeleteDirsAfterInstallList := TStringList.Create;
|
|
CloseApplicationsFilterList := TStringList.Create;
|
|
CloseApplicationsFilterExcludesList := TStringList.Create;
|
|
WizardImages := TList.Create;
|
|
WizardSmallImages := TList.Create;
|
|
SHGetKnownFolderPathFunc := GetProcAddress(SafeLoadLibrary(AddBackslash(GetSystemDir) + shell32,
|
|
SEM_NOOPENFILEERRORBOX), 'SHGetKnownFolderPath');
|
|
|
|
finalization
|
|
FreeWizardImages;
|
|
FreeAndNil(CloseApplicationsFilterExcludesList);
|
|
FreeAndNil(CloseApplicationsFilterList);
|
|
FreeAndNil(DeleteDirsAfterInstallList);
|
|
FreeAndNil(DeleteFilesAfterInstallList);
|
|
FreeEntryLists;
|
|
FreeAndNil(WizardDeselectedTasks);
|
|
FreeAndNil(WizardTasks);
|
|
FreeAndNil(WizardDeselectedComponents);
|
|
FreeAndNil(WizardComponents);
|
|
FreeAndNil(NewParamsForCode);
|
|
FreeAndNil(InitTasks);
|
|
FreeAndNil(InitComponents);
|
|
end.
|