unit Setup.Install; { Inno Setup Copyright (C) 1997-2025 Jordan Russell Portions by Martijn Laan For conditions of distribution and use, see LICENSE.TXT. Installation procedures } interface uses Classes, SHA256, Shared.FileClass, Shared.SetupTypes, Shared.Int64Em, Shared.Struct; function NoVerification: TSetupFileVerification; procedure VerificationError(const AError: TVerificationError; const ASigFilename: String = ''); procedure DoISSigVerify(const SourceF: TFile; const SourceFS: TFileStream; const SourceFilename: String; const ISSigAllowedKeys: AnsiString; out ExpectedFileHash: TSHA256Digest); procedure PerformInstall(var Succeeded: Boolean; const ChangesEnvironment, ChangesAssociations: Boolean); type TOnDownloadProgress = function(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean of object; TOnSimpleDownloadProgress = procedure(const Bytes, Param: Integer64); procedure ExtractTemporaryFile(const BaseName: String); function ExtractTemporaryFiles(const Pattern: String): Integer; function DownloadFile(const Url, CustomUserName, CustomPassword: String; const DestF: TFile; [ref] const Verification: TSetupFileVerification; const ISSigSourceFilename: String; const OnSimpleDownloadProgress: TOnSimpleDownloadProgress; const OnSimpleDownloadProgressParam: Integer64): Int64; function DownloadTemporaryFile(const Url, BaseName: String; [ref] const Verification: TSetupFileVerification; const OnDownloadProgress: TOnDownloadProgress): Int64; function DownloadTemporaryFileSize(const Url: String): Int64; function DownloadTemporaryFileDate(const Url: String): String; procedure SetDownloadTemporaryFileCredentials(const User, Pass: String); function GetISSigUrl(const Url, ISSigUrl: String): String; implementation uses Windows, SysUtils, Messages, Forms, ShlObj, Setup.UninstallLog, SetupLdrAndSetup.InstFunc, Setup.InstFunc, Setup.InstFunc.Ole, Setup.SecurityFunc, SetupLdrAndSetup.Messages, Setup.MainFunc, Setup.LoggingFunc, Setup.FileExtractor, Compression.Base, PathFunc, ISSigFunc, Shared.CommonFunc.Vcl, Compression.SevenZipDLLDecoder, Shared.CommonFunc, SetupLdrAndSetup.RedirFunc, Shared.SetupMessageIDs, Setup.WizardForm, Shared.DebugStruct, Setup.DebugClient, Shared.VerInfoFunc, Setup.ScriptRunner, Setup.RegDLL, Setup.Helper, Shared.ResUpdateFunc, Setup.DotNetFunc, TaskbarProgressFunc, NewProgressBar, RestartManager, Net.HTTPClient, Net.URLClient, NetEncoding, RegStr; type TSetupUninstallLog = class(TUninstallLog) protected procedure HandleException; override; end; var CurProgress: Integer64; ProgressShiftCount: Cardinal; { TSetupUninstallLog } procedure TSetupUninstallLog.HandleException; begin Application.HandleException(Self); end; procedure SetFilenameLabelText(const S: String; const CallUpdate: Boolean); begin WizardForm.FilenameLabel.Caption := MinimizePathName(S, WizardForm.FilenameLabel.Font, WizardForm.FileNameLabel.Width); if CallUpdate then WizardForm.FilenameLabel.Update; end; procedure SetStatusLabelText(const S: String; const ClearFilenameLabelText: Boolean = True); begin if WizardForm.StatusLabel.Caption <> S then begin WizardForm.StatusLabel.Caption := S; WizardForm.StatusLabel.Update; end; if ClearFilenameLabelText then SetFilenameLabelText('', True); end; procedure InstallMessageBoxCallback(const Flags: LongInt; const After: Boolean; const Param: LongInt); const States: array [TNewProgressBarState] of TTaskbarProgressState = (tpsNormal, tpsError, tpsPaused); var NewState: TNewProgressBarState; begin if After then NewState := npbsNormal else if (Flags and MB_ICONSTOP) <> 0 then NewState := npbsError else NewState := npbsPaused; with WizardForm.ProgressGauge do begin State := NewState; Invalidate; end; SetAppTaskbarProgressState(States[NewState]); end; procedure CalcFilesSize(var InstallFilesSize, AfterInstallFilesSize: Integer64); var N: Integer; CurFile: PSetupFileEntry; FileSize: Integer64; begin InstallFilesSize := To64(0); AfterInstallFilesSize := InstallFilesSize; for N := 0 to Entries[seFile].Count-1 do begin CurFile := PSetupFileEntry(Entries[seFile][N]); if ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin with CurFile^ do begin if LocationEntry <> -1 then { not an "external" file } FileSize := PSetupFileLocationEntry(Entries[seFileLocation][ LocationEntry])^.OriginalSize else FileSize := ExternalSize; Inc6464(InstallFilesSize, FileSize); if not (foDeleteAfterInstall in Options) then Inc6464(AfterInstallFilesSize, FileSize); end; end; end; end; procedure InitProgressGauge(const InstallFilesSize: Integer64); var NewMaxValue: Integer64; begin { Calculate the MaxValue for the progress meter } NewMaxValue := To64(1000 * Entries[seIcon].Count); if Entries[seIni].Count <> 0 then Inc(NewMaxValue.Lo, 1000); if Entries[seRegistry].Count <> 0 then Inc(NewMaxValue.Lo, 1000); Inc6464(NewMaxValue, InstallFilesSize); { To avoid progress updates that are too small to result in any visible change, divide the Max value by 2 until it's under 1500 } ProgressShiftCount := 0; while (NewMaxValue.Hi <> 0) or (NewMaxValue.Lo >= Cardinal(1500)) do begin Shr64(NewMaxValue, 1); Inc(ProgressShiftCount); end; WizardForm.ProgressGauge.Max := NewMaxValue.Lo; SetMessageBoxCallbackFunc(InstallMessageBoxCallback, 0); end; procedure UpdateProgressGauge; var NewPosition: Integer64; begin NewPosition := CurProgress; Shr64(NewPosition, ProgressShiftCount); if WizardForm.ProgressGauge.Position <> Longint(NewPosition.Lo) then begin WizardForm.ProgressGauge.Position := NewPosition.Lo; WizardForm.ProgressGauge.Update; end; SetAppTaskbarProgressValue(NewPosition.Lo, WizardForm.ProgressGauge.Max); if (CodeRunner <> nil) and CodeRunner.FunctionExists('CurInstallProgressChanged', True) then begin try CodeRunner.RunProcedures('CurInstallProgressChanged', [NewPosition.Lo, WizardForm.ProgressGauge.Max], False); except Log('CurInstallProgressChanged raised an exception.'); Application.HandleException(nil); end; end; end; procedure FinishProgressGauge(const HideGauge: Boolean); begin SetMessageBoxCallbackFunc(nil, 0); if HideGauge then WizardForm.ProgressGauge.Visible := False; SetAppTaskbarProgressState(tpsNoProgress); end; procedure SetProgress(const AProgress: Integer64); begin CurProgress := AProgress; UpdateProgressGauge; end; procedure IncProgress(const N: Cardinal); begin Inc64(CurProgress, N); UpdateProgressGauge; end; procedure IncProgress64(const N: Integer64); begin Inc6464(CurProgress, N); UpdateProgressGauge; end; procedure ProcessEvents; { Processes any waiting events. Must call this this periodically or else events like clicking the Cancel button won't be processed. Calls Abort if NeedToAbortInstall is True, which is usually the result of the user clicking Cancel and the form closing. } begin if NeedToAbortInstall then Abort; Application.ProcessMessages; if NeedToAbortInstall then Abort; end; procedure InternalProgressProc(const Bytes: Cardinal); begin IncProgress(Bytes); ProcessEvents; end; procedure ExternalProgressProc64(const Bytes, MaxProgress: Integer64); begin var NewProgress := CurProgress; Inc6464(NewProgress, Bytes); { In case the source file was larger than we thought it was, stop the progress bar at the maximum amount. Also see CopySourceFileToDestFile. } if Compare64(NewProgress, MaxProgress) > 0 then NewProgress := MaxProgress; SetProgress(NewProgress); ProcessEvents; end; procedure JustProcessEventsProc64(const Bytes, Param: Integer64); begin ProcessEvents; end; function AbortRetryIgnoreTaskDialogMsgBox(const Text: String; const RetryIgnoreAbortButtonLabels: array of String): Boolean; { Returns True if Ignore was selected, False if Retry was selected, or calls Abort if Abort was selected. } begin Result := False; case LoggedTaskDialogMsgBox('', SetupMessages[msgAbortRetryIgnoreSelectAction], Text, '', mbError, MB_ABORTRETRYIGNORE, RetryIgnoreAbortButtonLabels, 0, True, IDABORT) of IDABORT: Abort; IDRETRY: ; IDIGNORE: Result := True; else Log('LoggedTaskDialogMsgBox returned an unexpected value. Assuming Abort.'); Abort; end; end; function FileTimeToStr(const AFileTime: TFileTime): String; { Converts a TFileTime into a string for log purposes. } var FT: TFileTime; ST: TSystemTime; begin FileTimeToLocalFileTime(AFileTime, FT); if FileTimeToSystemTime(FT, ST) then Result := Format('%.4u-%.2u-%.2u %.2u:%.2u:%.2u.%.3u', [ST.wYear, ST.wMonth, ST.wDay, ST.wHour, ST.wMinute, ST.wSecond, ST.wMilliseconds]) else Result := '(invalid)'; end; function TryToGetSHA256OfFile(const DisableFsRedir: Boolean; const Filename: String; var Sum: TSHA256Digest): Boolean; { Like GetSHA256OfFile but traps exceptions locally. Returns True if successful. } begin try Sum := GetSHA256OfFile(DisableFsRedir, Filename); Result := True; except Result := False; end; end; function NoVerification: TSetupFileVerification; begin Result := Default(TSetupFileVerification); Result.Typ := fvNone; end; procedure VerificationError(const AError: TVerificationError; const ASigFilename: String); const LogMessages: array[TVerificationError] of String = ('Signature file does not exist', 'Signature is malformed', 'No matching key found', 'Signature is bad', 'File size is incorrect', 'File hash is incorrect'); SetupMessageIDs: array[TVerificationError] of TSetupMessageID = (msgVerificationSignatureDoesntExist, msgVerificationSignatureInvalid, msgVerificationKeyNotFound, msgVerificationSignatureInvalid, msgVerificationFileSizeIncorrect, msgVerificationFileHashIncorrect); begin { Also see Compiler.SetupCompiler for a similar function } Log('Verification error: ' + AddPeriod(LogMessages[AError])); raise Exception.Create(FmtSetupMessage1(msgSourceVerificationFailed, FmtSetupMessage1(SetupMessageIDs[AError], PathExtractName(ASigFilename)))); { Not all messages actually have a %1 parameter but that's OK } end; procedure DoISSigVerify(const SourceF: TFile; const SourceFS: TFileStream; const SourceFilename: String; const ISSigAllowedKeys: AnsiString; out ExpectedFileHash: TSHA256Digest); { Does not disable FS redirection. Either SourceF or SourceFS must be set, which may be opened for writing instead of reading. } begin if ((SourceF = nil) and (SourceFS = nil)) or ((SourceF <> nil) and (SourceFS <> nil)) then InternalError('DoISSigVerify: Invalid SourceF / SourceFS combination'); var ExpectedFileSize: Int64; if not ISSigVerifySignature(SourceFilename, GetISSigAllowedKeys(ISSigAvailableKeys, ISSigAllowedKeys), ExpectedFileSize, ExpectedFileHash, nil, procedure(const Filename, SigFilename: String) begin VerificationError(veSignatureMissing, SigFilename); end, procedure(const Filename, SigFilename: String; const VerifyResult: TISSigVerifySignatureResult) begin case VerifyResult of vsrMalformed: VerificationError(veSignatureMalformed, SigFilename); vsrBad: VerificationError(veSignatureBad, SigFilename); vsrKeyNotFound: VerificationError(veKeyNotFound, SigFilename); else InternalError('Unknown ISSigVerifySignature result'); end; end ) then InternalError('Unexpected ISSigVerifySignature result'); var FileSize: Int64; if SourceF <> nil then FileSize := Int64(SourceF.Size) else FileSize := SourceFS.Size; if FileSize <> ExpectedFileSize then VerificationError(veFileSizeIncorrect); { Caller must check ExpectedFileHash } end; const VerificationSuccessfulLogMessage = 'Verification successful.'; procedure CopySourceFileToDestFile(const SourceF, DestF: TFile; [ref] const Verification: TSetupFileVerification; const ISSigSourceFilename: String; const AExpectedSize: Integer64); { Copies all bytes from SourceF to DestF, incrementing process meter as it goes. Assumes file pointers of both are 0. } var BytesLeft: Integer64; BufSize: Cardinal; Buf: array[0..16383] of Byte; Context: TSHA256Context; begin var ExpectedFileHash: TSHA256Digest; if Verification.Typ <> fvNone then begin if Verification.Typ = fvHash then ExpectedFileHash := Verification.Hash else DoISSigVerify(SourceF, nil, ISSigSourceFilename, Verification.ISSigAllowedKeys, ExpectedFileHash); { ExpectedFileHash checked below after copy } SHA256Init(Context); end; var MaxProgress := CurProgress; Inc6464(MaxProgress, AExpectedSize); BytesLeft := SourceF.Size; { To avoid file system fragmentation, preallocate all of the bytes in the destination file } DestF.Seek64(BytesLeft); DestF.Truncate; DestF.Seek(0); while True do begin BufSize := SizeOf(Buf); if (BytesLeft.Hi = 0) and (BytesLeft.Lo < BufSize) then BufSize := BytesLeft.Lo; if BufSize = 0 then Break; SourceF.ReadBuffer(Buf, BufSize); DestF.WriteBuffer(Buf, BufSize); Dec64(BytesLeft, BufSize); if Verification.Typ <> fvNone then SHA256Update(Context, Buf, BufSize); ExternalProgressProc64(To64(BufSize), MaxProgress); end; if Verification.Typ <> fvNone then begin if not SHA256DigestsEqual(SHA256Final(Context), ExpectedFileHash) then VerificationError(veFileHashIncorrect); Log(VerificationSuccessfulLogMessage); end; { In case the source file was shorter than we thought it was, bump the progress bar to the maximum amount } SetProgress(MaxProgress); end; procedure AddAttributesToFile(const DisableFsRedir: Boolean; const Filename: String; Attribs: Integer); var ExistingAttr: DWORD; begin if Attribs <> 0 then begin ExistingAttr := GetFileAttributesRedir(DisableFsRedir, Filename); if ExistingAttr <> INVALID_FILE_ATTRIBUTES then SetFileAttributesRedir(DisableFsRedir, Filename, (ExistingAttr and not FILE_ATTRIBUTE_NORMAL) or DWORD(Attribs)); end; end; function ShortenOrExpandFontFilename(const Filename: String): String; { Expands Filename, except if it's in the Fonts directory, in which case it removes the path } var FontDir: String; begin Result := PathExpand(Filename); FontDir := GetShellFolder(False, sfFonts); if FontDir <> '' then if PathCompare(PathExtractDir(Result), FontDir) = 0 then Result := PathExtractName(Result); end; function LastErrorIndicatesPossiblyInUse(const LastError: DWORD; const CheckAlreadyExists: Boolean): Boolean; begin Result := (LastError = ERROR_ACCESS_DENIED) or (LastError = ERROR_SHARING_VIOLATION) or (CheckAlreadyExists and (LastError = ERROR_ALREADY_EXISTS)); end; procedure PerformInstall(var Succeeded: Boolean; const ChangesEnvironment, ChangesAssociations: Boolean); type PRegisterFilesListRec = ^TRegisterFilesListRec; TRegisterFilesListRec = record Filename: String; Is64Bit, TypeLib, NoErrorMessages: Boolean; end; var UninstLog: TSetupUninstallLog; UninstallTempExeFilename, UninstallDataFilename, UninstallMsgFilename: String; UninstallExeCreated: (ueNone, ueNew, ueReplaced); UninstallDataCreated, UninstallMsgCreated, AppendUninstallData: Boolean; RegisterFilesList: TList; ExpandedAppId: String; function GetLocalTimeAsStr: String; var SysTime: TSystemTime; begin GetLocalTime(SysTime); SetString(Result, PChar(@SysTime), SizeOf(SysTime) div SizeOf(Char)); end; procedure RecordStartInstall; var AppDir: String; begin if shCreateAppDir in SetupHeader.Options then AppDir := WizardDirValue else AppDir := ''; UninstLog.Add(utStartInstall, [GetComputerNameString, GetUserNameString, AppDir, GetLocalTimeAsStr], 0); end; procedure PackCustomMessagesIntoString(var S: String); var M: TMemoryStream; Count, I, N: Integer; begin M := TMemoryStream.Create; try Count := 0; M.WriteBuffer(Count, SizeOf(Count)); { overwritten later } for I := 0 to Entries[seCustomMessage].Count-1 do begin with PSetupCustomMessageEntry(Entries[seCustomMessage][I])^ do begin if (LangIndex = -1) or (LangIndex = ActiveLanguage) then begin N := Length(Name); M.WriteBuffer(N, SizeOf(N)); M.WriteBuffer(Name[1], N*SizeOf(Name[1])); N := Length(Value); M.WriteBuffer(N, SizeOf(N)); M.WriteBuffer(Value[1], N*SizeOf(Value[1])); Inc(Count); end; end; end; M.Seek(0, soFromBeginning); M.WriteBuffer(Count, SizeOf(Count)); SetString(S, PChar(M.Memory), M.Size div SizeOf(Char)); finally M.Free; end; end; function PackCompiledCodeTextIntoString(const CompiledCodeText: AnsiString): String; var N: Integer; begin N := Length(CompiledCodeText); if N mod 2 = 1 then Inc(N); { This will lead to 1 extra byte being moved but that's ok since it is the #0 } N := N div 2; SetString(Result, PChar(Pointer(CompiledCodeText)), N); end; procedure RecordCompiledCode; var LeadBytesStr, ExpandedApp, ExpandedGroup, CustomMessagesStr: String; begin { Only use app if Setup creates one } if shCreateAppDir in SetupHeader.Options then ExpandedApp := ExpandConst('{app}') else ExpandedApp := ''; try ExpandedGroup := ExpandConst('{group}'); except { Yep, expanding "group" might fail with an exception } ExpandedGroup := ''; end; if SetupHeader.CompiledCodeText <> '' then PackCustomMessagesIntoString(CustomMessagesStr); { Record [Code] even if empty to 'overwrite' old versions } UninstLog.Add(utCompiledCode, [PackCompiledCodeTextIntoString(SetupHeader.CompiledCodeText), LeadBytesStr, ExpandedApp, ExpandedGroup, WizardGroupValue, ExpandConst('{language}'), CustomMessagesStr], SetupBinVersion or Longint($80000000)); end; type TRegErrorFunc = (reRegSetValueEx, reRegCreateKeyEx, reRegOpenKeyEx); procedure RegError(const Func: TRegErrorFunc; const RootKey: HKEY; const KeyName: String; const ErrorCode: Longint); const ErrorMsgs: array[TRegErrorFunc] of TSetupMessageID = (msgErrorRegWriteKey, msgErrorRegCreateKey, msgErrorRegOpenKey); FuncNames: array[TRegErrorFunc] of String = ('RegSetValueEx', 'RegCreateKeyEx', 'RegOpenKeyEx'); begin raise Exception.Create(FmtSetupMessage(ErrorMsgs[Func], [GetRegRootKeyName(RootKey), KeyName]) + SNewLine2 + FmtSetupMessage(msgErrorFunctionFailedWithMessage, [FuncNames[Func], IntToStr(ErrorCode), Win32ErrorString(ErrorCode)])); end; procedure RegisterUninstallInfo(const UninstallRegKeyBaseName: String; const AfterInstallFilesSize: Integer64); { Stores uninstall information in the Registry so that the program can be uninstalled through the Control Panel Add/Remove Programs applet. } const AdminInstallModeNames: array [Boolean] of String = ('non administrative', 'administrative'); BitInstallModeNames: array [Boolean] of String = ('32-bit', '64-bit'); var RegView, OppositeRegView: TRegView; RegViewIs64Bit, OppositeRegViewIs64Bit: Boolean; RootKey, OppositeRootKey: HKEY; RootKeyIsHKLM, OppositeRootKeyIsHKLM: Boolean; SubkeyName: String; procedure SetStringValue(const K: HKEY; const ValueName: PChar; const Data: String); var ErrorCode: Longint; begin ErrorCode := RegSetValueEx(K, ValueName, 0, REG_SZ, PChar(Data), (Length(Data)+1)*SizeOf(Data[1])); if ErrorCode <> ERROR_SUCCESS then RegError(reRegSetValueEx, RootKey, SubkeyName, ErrorCode); end; procedure SetStringValueUnlessEmpty(const K: HKEY; const ValueName: PChar; const Data: String); begin if Data <> '' then SetStringValue(K, ValueName, Data); end; procedure SetDWordValue(const K: HKEY; const ValueName: PChar; const Data: DWord); var ErrorCode: Longint; begin ErrorCode := RegSetValueEx(K, ValueName, 0, REG_DWORD, @Data, SizeOf(Data)); if ErrorCode <> ERROR_SUCCESS then RegError(reRegSetValueEx, RootKey, SubkeyName, ErrorCode); end; function GetInstallDateString: String; var ST: TSystemTime; begin GetLocalTime(ST); Result := Format('%.4u%.2u%.2u', [ST.wYear, ST.wMonth, ST.wDay]); end; function ExtractMajorMinorVersion(Version: String; var Major, Minor: Integer): Boolean; var P, I: Integer; begin P := Pos('.', Version); if P <> 0 then begin Val(Copy(Version, 1, P-1), Major, I); if I = 0 then begin Delete(Version, 1, P); P := Pos('.', Version); if P <> 0 then Val(Copy(Version, 1, P-1), Minor, I) else Val(Version, Minor, I); end; end else begin Val(Version, Major, I); Minor := 0; end; Result := I = 0; end; { Also see Main.pas } function ExistingInstallationAt(const RegView: TRegView; const RootKey: HKEY): Boolean; var K: HKEY; begin if RegOpenKeyExView(RegView, RootKey, PChar(SubkeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin Result := True; RegCloseKey(K); end else Result := False; end; procedure HandleDuplicateDisplayNames(var DisplayName: String); const UninstallDisplayNameMarksUser: array [Boolean] of TSetupMessageId = (msgUninstallDisplayNameMarkCurrentUser, msgUninstallDisplayNameMarkAllUsers); UninstallDisplayNameMarksBits: array [Boolean] of TSetupMessageId = (msgUninstallDisplayNameMark32Bit, msgUninstallDisplayNameMark64Bit); var ExistingAtOppositeAdminInstallMode, ExistingAtOpposite64BitInstallMode: Boolean; begin { Check opposite administrative install mode. } ExistingAtOppositeAdminInstallMode := ExistingInstallationAt(RegView, OppositeRootKey); if RootKeyIsHKLM or not IsWin64 then begin { Opposite (HKCU) is shared for 32-bit and 64-bit so don't log bitness. Also don't log bitness on a 32-bit system. } LogFmt('Detected previous %s install? %s', [AdminInstallModeNames[OppositeRootKeyIsHKLM {always False}], SYesNo[ExistingAtOppositeAdminInstallMode]]) end else begin { Opposite (HKLM) is not shared for 32-bit and 64-bit so log bitness. } LogFmt('Detected previous %s %s install? %s', [AdminInstallModeNames[OppositeRootKeyIsHKLM {always True}], BitInstallModeNames[RegViewIs64Bit], SYesNo[ExistingAtOppositeAdminInstallMode]]); end; if IsWin64 then begin { Check opposite 32-bit or 64-bit install mode. } if RootKeyIsHKLM then begin { HKLM is not shared for 32-bit and 64-bit so check it for opposite 32-bit or 64-bit install mode. Not checking HKCU since HKCU is shared for 32-bit and 64-bit mode and we already checked HKCU above. } ExistingAtOpposite64BitInstallMode := ExistingInstallationAt(OppositeRegView, RootKey {always HKLM}); LogFmt('Detected previous %s %s install? %s', [AdminInstallModeNames[RootKeyIsHKLM {always True}], BitInstallModeNames[OppositeRegViewIs64Bit], SYesNo[ExistingAtOpposite64BitInstallMode]]); end else begin { HKCU is shared for 32-bit and 64-bit so not checking it but we do still need to check HKLM for opposite 32-bit or 64-bit install mode since we haven't already done that. } ExistingAtOpposite64BitInstallMode := ExistingInstallationAt(OppositeRegView, OppositeRootKey {always HKLM}); if ExistingAtOpposite64BitInstallMode then ExistingAtOppositeAdminInstallMode := True; LogFmt('Detected previous %s %s install? %s', [AdminInstallModeNames[OppositeRootKeyIsHKLM {always True}], BitInstallModeNames[OppositeRegViewIs64Bit], SYesNo[ExistingAtOpposite64BitInstallMode]]); end; end else ExistingAtOpposite64BitInstallMode := False; { Mark new display name if needed. Note: currently we don't attempt to mark existing display names as well. } if ExistingAtOppositeAdminInstallMode or ExistingAtOpposite64BitInstallMode then begin if ExistingAtOppositeAdminInstallMode and ExistingAtOpposite64BitInstallMode then DisplayName := FmtSetupMessage(msgUninstallDisplayNameMarks, [DisplayName, SetupMessages[UninstallDisplayNameMarksUser[RootKeyIsHKLM]], SetupMessages[UninstallDisplayNameMarksBits[RegViewIs64Bit]]]) else if ExistingAtOppositeAdminInstallMode then DisplayName := FmtSetupMessage(msgUninstallDisplayNameMark, [DisplayName, SetupMessages[UninstallDisplayNameMarksUser[RootKeyIsHKLM]]]) else DisplayName := FmtSetupMessage(msgUninstallDisplayNameMark, [DisplayName, SetupMessages[UninstallDisplayNameMarksBits[RegViewIs64Bit]]]); LogFmt('Marked uninstall display name to avoid duplicate entries. New display name: %s', [DisplayName]); end; end; var H2: HKEY; ErrorCode: Longint; Z: String; MajorVersion, MinorVersion, I: Integer; EstimatedSize: Integer64; begin RegView := InstallDefaultRegView; RegViewIs64Bit := RegView = rv64Bit; if RegViewIs64Bit then OppositeRegView := rv32Bit else OppositeRegView := rv64Bit; OppositeRegViewIs64Bit := not RegViewIs64Bit; RootKey := InstallModeRootKey; RootKeyIsHKLM := RootKey = HKEY_LOCAL_MACHINE; if RootKeyIsHKLM then OppositeRootKey := HKEY_CURRENT_USER else OppositeRootKey := HKEY_LOCAL_MACHINE; OppositeRootKeyIsHKLM := not RootKeyIsHKLM; SubkeyName := GetUninstallRegSubkeyName(UninstallRegKeyBaseName); if ExistingInstallationAt(RegView, RootKey) then begin if RootKeyIsHKLM then begin { HKLM is not shared for 32-bit and 64-bit so log bitness. } LogFmt('Deleting uninstall key left over from previous %s %s install.', [AdminInstallModeNames[RootKeyIsHKLM {always True}], BitInstallModeNames[RegViewIs64Bit]]); end else begin { HKCU is shared for 32-bit and 64-bit so don't log bitness. } LogFmt('Deleting uninstall key left over from previous %s install.', [AdminInstallModeNames[RootKeyIsHKLM {always False}]]) end; RegDeleteKeyIncludingSubkeys(RegView, RootKey, PChar(SubkeyName)); end; LogFmt('Creating new uninstall key: %s\%s', [GetRegRootKeyName(RootKey), SubkeyName]); { Create uninstall key } ErrorCode := RegCreateKeyExView(RegView, RootKey, PChar(SubkeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, H2, nil); if ErrorCode <> ERROR_SUCCESS then RegError(reRegCreateKeyEx, RootKey, SubkeyName, ErrorCode); try Log('Writing uninstall key values.'); { do not localize or change any of the following strings } SetStringValue(H2, 'Inno Setup: Setup Version', SetupVersion); if shCreateAppDir in SetupHeader.Options then Z := WizardDirValue else Z := ''; SetStringValue(H2, 'Inno Setup: App Path', Z); SetStringValueUnlessEmpty(H2, 'InstallLocation', AddBackslash(Z)); SetStringValue(H2, 'Inno Setup: Icon Group', WizardGroupValue); if WizardNoIcons then SetDWordValue(H2, 'Inno Setup: No Icons', 1); SetStringValue(H2, 'Inno Setup: User', GetUserNameString); if WizardSetupType <> nil then begin SetStringValue(H2, 'Inno Setup: Setup Type', WizardSetupType.Name); SetStringValue(H2, 'Inno Setup: Selected Components', StringsToCommaString(WizardComponents)); SetStringValue(H2, 'Inno Setup: Deselected Components', StringsToCommaString(WizardDeselectedComponents)); end; if HasTasks then begin SetStringValue(H2, 'Inno Setup: Selected Tasks', StringsToCommaString(WizardTasks)); SetStringValue(H2, 'Inno Setup: Deselected Tasks', StringsToCommaString(WizardDeselectedTasks)); end; if shUserInfoPage in SetupHeader.Options then begin SetStringValue(H2, 'Inno Setup: User Info: Name', WizardUserInfoName); SetStringValue(H2, 'Inno Setup: User Info: Organization', WizardUserInfoOrg); SetStringValue(H2, 'Inno Setup: User Info: Serial', WizardUserInfoSerial); end; SetStringValue(H2, 'Inno Setup: Language', PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name); if SetupHeader.UninstallDisplayName <> '' then Z := ExpandConst(SetupHeader.UninstallDisplayName) else Z := ExpandedAppVerName; HandleDuplicateDisplayNames(Z); { For the entry to appear in ARP, DisplayName cannot exceed 259 characters on Windows 2000 and later. } SetStringValue(H2, 'DisplayName', Copy(Z, 1, 259)); SetStringValueUnlessEmpty(H2, 'DisplayIcon', ExpandConst(SetupHeader.UninstallDisplayIcon)); var ExtraUninstallString: String; if shUninstallLogging in SetupHeader.Options then ExtraUninstallString := ' /LOG' else ExtraUninstallString := ''; SetStringValue(H2, 'UninstallString', '"' + UninstallExeFilename + '"' + ExtraUninstallString); SetStringValue(H2, 'QuietUninstallString', '"' + UninstallExeFilename + '" /SILENT' + ExtraUninstallString); SetStringValueUnlessEmpty(H2, 'DisplayVersion', ExpandConst(SetupHeader.AppVersion)); SetStringValueUnlessEmpty(H2, 'Publisher', ExpandConst(SetupHeader.AppPublisher)); SetStringValueUnlessEmpty(H2, 'URLInfoAbout', ExpandConst(SetupHeader.AppPublisherURL)); SetStringValueUnlessEmpty(H2, 'HelpTelephone', ExpandConst(SetupHeader.AppSupportPhone)); SetStringValueUnlessEmpty(H2, 'HelpLink', ExpandConst(SetupHeader.AppSupportURL)); SetStringValueUnlessEmpty(H2, 'URLUpdateInfo', ExpandConst(SetupHeader.AppUpdatesURL)); SetStringValueUnlessEmpty(H2, 'Readme', ExpandConst(SetupHeader.AppReadmeFile)); SetStringValueUnlessEmpty(H2, 'Contact', ExpandConst(SetupHeader.AppContact)); SetStringValueUnlessEmpty(H2, 'Comments', ExpandConst(SetupHeader.AppComments)); Z := ExpandConst(SetupHeader.AppModifyPath); if Z <> '' then SetStringValue(H2, 'ModifyPath', Z) else SetDWordValue(H2, 'NoModify', 1); SetDWordValue(H2, 'NoRepair', 1); SetStringValue(H2, 'InstallDate', GetInstallDateString); if ExtractMajorMinorVersion(ExpandConst(SetupHeader.AppVersion), MajorVersion, MinorVersion) then begin { Originally MSDN said to write to Major/MinorVersion, now it says to write to VersionMajor/Minor. So write to both. } SetDWordValue(H2, 'MajorVersion', MajorVersion); SetDWordValue(H2, 'MinorVersion', MinorVersion); SetDWordValue(H2, 'VersionMajor', MajorVersion); SetDWordValue(H2, 'VersionMinor', MinorVersion); end; { Note: Windows 7 (and later?) doesn't automatically calculate sizes so set EstimatedSize ourselves. } if (SetupHeader.UninstallDisplaySize.Hi = 0) and (SetupHeader.UninstallDisplaySize.Lo = 0) then begin { Estimate the size by taking the size of all files and adding any ExtraDiskSpaceRequired. } EstimatedSize := AfterInstallFilesSize; Inc6464(EstimatedSize, SetupHeader.ExtraDiskSpaceRequired); for I := 0 to Entries[seComponent].Count-1 do begin with PSetupComponentEntry(Entries[seComponent][I])^ do begin if ShouldProcessEntry(WizardComponents, nil, Name, '', Languages, '') then Inc6464(EstimatedSize, ExtraDiskSpaceRequired); end; end; end else EstimatedSize := SetupHeader.UninstallDisplaySize; { ARP on Windows 7 without SP1 only pays attention to the lower 6 bytes of EstimatedSize and throws away the rest. For example putting in $4000001 (=4GB + 1KB) displays as 1 KB. So we need to check for this. } if (Hi(NTServicePackLevel) > 0) or IsWindows8 or (EstimatedSize.Hi = 0) then begin Div64(EstimatedSize, 1024); SetDWordValue(H2, 'EstimatedSize', EstimatedSize.Lo) end; { Also see SetPreviousData in ScriptFunc.pas } if CodeRunner <> nil then begin try CodeRunner.RunProcedures('RegisterPreviousData', [Integer(H2)], False); except Log('RegisterPreviousData raised an exception.'); Application.HandleException(nil); end; end; finally RegCloseKey(H2); end; UninstLog.AddReg(utRegDeleteEntireKey, RegView, RootKey, [SubkeyName]); end; type TMakeDirFlags = set of (mdNoUninstall, mdAlwaysUninstall, mdDeleteAfterInstall, mdNotifyChange); function MakeDir(const DisableFsRedir: Boolean; Dir: String; const Flags: TMakeDirFlags): Boolean; { Returns True if a new directory was created. Note: If DisableFsRedir is True, the mdNotifyChange flag should not be specified; it won't work properly. } var ErrorCode: DWORD; UninstFlags: Longint; begin Result := False; Dir := RemoveBackslashUnlessRoot(PathExpand(Dir)); if PathExtractName(Dir) = '' then { reached root? } Exit; if DirExistsRedir(DisableFsRedir, Dir) then begin if not(mdAlwaysUninstall in Flags) then Exit; end else begin MakeDir(DisableFsRedir, PathExtractDir(Dir), Flags - [mdAlwaysUninstall]); LogFmt('Creating directory: %s', [Dir]); if not CreateDirectoryRedir(DisableFsRedir, Dir) then begin ErrorCode := GetLastError; raise Exception.Create(FmtSetupMessage(msgLastErrorMessage, [FmtSetupMessage1(msgErrorCreatingDir, Dir), IntToStr(ErrorCode), Win32ErrorString(ErrorCode)])); end; Result := True; if mdNotifyChange in Flags then begin SHChangeNotify(SHCNE_MKDIR, SHCNF_PATH, PChar(Dir), nil); SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH, PChar(PathExtractDir(Dir)), nil); end; end; if mdDeleteAfterInstall in Flags then DeleteDirsAfterInstallList.AddObject(Dir, Pointer(Ord(DisableFsRedir))) else begin if not(mdNoUninstall in Flags) then begin UninstFlags := utDeleteDirOrFiles_IsDir; if DisableFsRedir then UninstFlags := UninstFlags or utDeleteDirOrFiles_DisableFsRedir; if mdNotifyChange in Flags then UninstFlags := UninstFlags or utDeleteDirOrFiles_CallChangeNotify; UninstLog.Add(utDeleteDirOrFiles, [Dir], UninstFlags); end; end; end; procedure CreateDirs; { Creates the application's directories } procedure ApplyPermissions(const DisableFsRedir: Boolean; const Filename: String; const PermsEntry: Integer); var P: PSetupPermissionEntry; begin if PermsEntry <> -1 then begin LogFmt('Setting permissions on directory: %s', [Filename]); P := Entries[sePermission][PermsEntry]; if not GrantPermissionOnFile(DisableFsRedir, Filename, TGrantPermissionEntry(Pointer(P.Permissions)^), Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then LogFmt('Failed to set permissions on directory (%d).', [GetLastError]); end; end; procedure ApplyNTFSCompression(const DisableFsRedir: Boolean; const Filename: String; const Compress: Boolean); begin if Compress then LogFmt('Setting NTFS compression on directory: %s', [Filename]) else LogFmt('Unsetting NTFS compression on directory: %s', [Filename]); if not SetNTFSCompressionRedir(DisableFsRedir, Filename, Compress) then LogFmt('Failed to set NTFS compression state (%d).', [GetLastError]); end; var CurDirNumber: Integer; Flags: TMakeDirFlags; N: String; begin { Create main application directory } MakeDir(InstallDefaultDisableFsRedir, WizardDirValue, []); { Create the rest of the directories, if any } for CurDirNumber := 0 to Entries[seDir].Count-1 do with PSetupDirEntry(Entries[seDir][CurDirNumber])^ do begin if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin DebugNotifyEntry(seDir, CurDirNumber); NotifyBeforeInstallEntry(BeforeInstall); Flags := []; if doUninsNeverUninstall in Options then Include(Flags, mdNoUninstall); if doDeleteAfterInstall in Options then Include(Flags, mdDeleteAfterInstall); if doUninsAlwaysUninstall in Options then Include(Flags, mdAlwaysUninstall); N := RemoveBackslashUnlessRoot(PathExpand(ExpandConst(DirName))); MakeDir(InstallDefaultDisableFsRedir, N, Flags); AddAttributesToFile(InstallDefaultDisableFsRedir, N, Attribs); ApplyPermissions(InstallDefaultDisableFsRedir, N, PermissionsEntry); if (doSetNTFSCompression in Options) or (doUnsetNTFSCompression in Options) then ApplyNTFSCompression(InstallDefaultDisableFsRedir, N, doSetNTFSCompression in Options); NotifyAfterInstallEntry(AfterInstall); end; end; end; procedure WriteMsgData(const F: TFile); var MsgLangOpts: TMessagesLangOptions; LangEntry: PSetupLanguageEntry; begin FillChar(MsgLangOpts, SizeOf(MsgLangOpts), 0); MsgLangOpts.ID := MessagesLangOptionsID; StrPLCopy(MsgLangOpts.DialogFontName, LangOptions.DialogFontName, (SizeOf(MsgLangOpts.DialogFontName) div SizeOf(MsgLangOpts.DialogFontName[0])) - 1); MsgLangOpts.DialogFontSize := LangOptions.DialogFontSize; if LangOptions.RightToLeft then Include(MsgLangOpts.Flags, lfRightToLeft); LangEntry := Entries[seLanguage][ActiveLanguage]; F.WriteBuffer(LangEntry.Data[1], Length(LangEntry.Data)); F.WriteBuffer(MsgLangOpts, SizeOf(MsgLangOpts)); end; procedure MarkExeHeader(const F: TFile; const ModeID: Longint); begin F.Seek(SetupExeModeOffset); F.WriteBuffer(ModeID, SizeOf(ModeID)); end; procedure BindUninstallMsgDataToExe(const F: TFile); var UniqueValue: TSHA256Digest; UninstallerMsgTail: TUninstallerMsgTail; begin F.SeekToEnd; { First append the hash of AppId so that unins*.exe files from different applications won't have the same file hash. This is done to combat broken anti-spyware programs that catch all unins*.exe files with certain hash sums just because some piece of spyware was deployed with Inno Setup and had the unins*.exe file in its directory. } UniqueValue := GetSHA256OfUnicodeString(ExpandedAppId); F.WriteBuffer(UniqueValue, SizeOf(UniqueValue)); UninstallerMsgTail.ID := UninstallerMsgTailID; UninstallerMsgTail.Offset := F.Position.Lo; WriteMsgData(F); F.WriteBuffer(UninstallerMsgTail, SizeOf(UninstallerMsgTail)); end; type TOverwriteAll = (oaUnknown, oaOverwrite, oaKeep); procedure ProcessFileEntry(const CurFile: PSetupFileEntry; const DisableFsRedir: Boolean; AExternalSourceFile, ADestFile: String; const FileLocationFilenames: TStringList; const AExternalSize: Integer64; var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll; var WarnedPerUserFonts: Boolean; const AExternalFileDate: PFileTime); { Not external: AExternalSourceFile and ADestFile should be empty strings, FileLocationFilenames should be set, AExternalSize is unused, AExternalFileDate should not be set External : Opposite except AExternalFileDate still not set Ext. Archive: Same as external except AExternalFileDate set and AExternalSourceFile should be set to ArchiveFindHandle as a string Ext. Downl. : Same as external except AExternalSourceFile should be set to an URL } procedure InstallFont(const Filename, FontName: String; const PerUserFont, AddToFontTableNow: Boolean; var WarnedPerUserFonts: Boolean); var RootKey, K: HKEY; begin if PerUserFont and not WindowsVersionAtLeast(10, 0, 17134) then begin { Per-user fonts require Windows 10 Version 1803 (10.0.17134) or newer. } if not WarnedPerUserFonts then begin Log('Failed to set value in Fonts registry key: per-user fonts are not supported by this version of Windows.'); WarnedPerUserFonts := True; end; end else begin { 64-bit Windows note: The Fonts key is evidently exempt from registry redirection. When a 32-bit app writes to the Fonts key, it's the main 64-bit key that is modified. (There is actually a Fonts key under Wow6432Node but it appears it's never used or updated.) Also: We don't bother with any FS redirection stuff here. I'm not sure it's safe to disable FS redirection when calling AddFontResource, or if it would even work. Users should be installing their fonts to the Fonts directory instead of the System directory anyway. } if PerUserFont then RootKey := HKEY_CURRENT_USER else RootKey := HKEY_LOCAL_MACHINE; if RegOpenKeyExView(rvDefault, RootKey, 'Software\Microsoft\Windows NT\CurrentVersion\Fonts', 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin if RegSetValueEx(K, PChar(FontName), 0, REG_SZ, PChar(Filename), (Length(Filename)+1)*SizeOf(Filename[1])) <> ERROR_SUCCESS then Log('Failed to set value in Fonts registry key.'); RegCloseKey(K); end else Log('Failed to open Fonts registry key.'); end; if AddToFontTableNow then begin repeat { Note: AddFontResource doesn't set the thread's last error code } if AddFontResource(PChar(Filename)) <> 0 then begin SendNotifyMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); Break; end; until AbortRetryIgnoreTaskDialogMsgBox( AddPeriod(FmtSetupMessage1(msgErrorFunctionFailedNoCode, 'AddFontResource')), [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]); end; end; procedure SetFileLocationFilename(const LocationEntry: Integer; Filename: String); var LowercaseFilename: String; Hash: Longint; I: Integer; begin Filename := PathExpand(Filename); LowercaseFilename := PathLowercase(Filename); Hash := GetCRC32(LowercaseFilename[1], Length(LowercaseFilename)*SizeOf(LowercaseFilename[1])); { If Filename was already associated with another LocationEntry, disassociate it. If we *don't* do this, then this script won't produce the expected result: [Files] Source: "fileA"; DestName: "file2" Source: "fileB"; DestName: "file2" Source: "fileA"; DestName: "file1" 1. It extracts fileA under the name "file2" 2. It extracts fileB under the name "file2" 3. It copies file2 to file1, thinking a copy of fileA was still stored in file2. } for I := 0 to FileLocationFilenames.Count-1 do if (Longint(FileLocationFilenames.Objects[I]) = Hash) and (PathLowercase(FileLocationFilenames[I]) = LowercaseFilename) then begin FileLocationFilenames[I] := ''; FileLocationFilenames.Objects[I] := nil; Break; end; FileLocationFilenames[LocationEntry] := Filename; FileLocationFilenames.Objects[LocationEntry] := Pointer(Hash); end; procedure ApplyPermissions(const DisableFsRedir: Boolean; const Filename: String; const PermsEntry: Integer); var Attr: DWORD; P: PSetupPermissionEntry; begin if PermsEntry <> -1 then begin Attr := GetFileAttributesRedir(DisableFsRedir, Filename); if (Attr <> INVALID_FILE_ATTRIBUTES) and (Attr and FILE_ATTRIBUTE_DIRECTORY = 0) then begin LogFmt('Setting permissions on file: %s', [Filename]); P := Entries[sePermission][PermsEntry]; if not GrantPermissionOnFile(DisableFsRedir, Filename, TGrantPermissionEntry(Pointer(P.Permissions)^), Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then LogFmt('Failed to set permissions on file (%d).', [GetLastError]); end; end; end; procedure ApplyNTFSCompression(const DisableFsRedir: Boolean; const Filename: String; const Compress: Boolean); begin if Compress then LogFmt('Setting NTFS compression on file: %s', [Filename]) else LogFmt('Unsetting NTFS compression on file: %s', [Filename]); if not SetNTFSCompressionRedir(DisableFsRedir, Filename, Compress) then LogFmt('Failed to set NTFS compression state (%d).', [GetLastError]); end; procedure DoHandleFailedDeleteOrMoveFileTry(const Func, TempFile, DestFile: String; const LastError: DWORD; var RetriesLeft: Integer; var LastOperation: String; var NeedsRestart, ReplaceOnRestart, DoBreak, DoContinue: Boolean); begin { Automatically retry. Wait with replace on restart until no retries left, unless we already know we're going to restart. } if ((RetriesLeft = 0) or NeedsRestart) and (foRestartReplace in CurFile^.Options) and IsAdmin then begin LogFmt('%s: The existing file appears to be in use (%d). ' + 'Will replace on restart.', [Func, LastError]); LastOperation := SetupMessages[msgErrorRestartReplace]; NeedsRestart := True; RestartReplace(DisableFsRedir, TempFile, DestFile); ReplaceOnRestart := True; DoBreak := True; DoContinue := False; end else if RetriesLeft > 0 then begin LogFmt('%s: The existing file appears to be in use (%d). ' + 'Retrying.', [Func, LastError]); Dec(RetriesLeft); Sleep(1000); ProcessEvents; DoBreak := False; DoContinue := True; end else begin DoBreak := False; DoContinue := False; end; end; function AskOverwrite(const DestFile, Instruction, Caption: string; const ButtonLabels: array of String; const VerificationText: String; const Typ: TMsgBoxType; const Default, Overwrite: Integer; var OverwriteAll: TOverwriteAll): Boolean; var VerificationFlagChecked: BOOL; begin if OverwriteAll = oaKeep then Result := False { The user already said to keep (=not overwrite) all } else begin Result := LoggedTaskDialogMsgBox('', Instruction, DestFile + SNewLine2 + Caption, '', Typ, MB_YESNO, ButtonLabels, 0, True, Default, VerificationText, @VerificationFlagChecked) = Overwrite; if VerificationFlagChecked then begin if Result then OverwriteAll := oaOverwrite else OverwriteAll := oaKeep; end; end; end; var ProgressUpdated: Boolean; PreviousProgress: Integer64; LastOperation: String; CurFileLocation: PSetupFileLocationEntry; SourceFile, DestFile, TempFile, FontFilename: String; DestFileExists, DestFileExistedBefore, CheckedDestFileExistedBefore, TempFileLeftOver, AllowFileToBeDuplicated, ReplaceOnRestart, DoBreak, DoContinue: Boolean; Failed: String; CurFileVersionInfoValid: Boolean; CurFileVersionInfo, ExistingVersionInfo: TFileVersionNumbers; CurFileDateValid, ExistingFileDateValid: Boolean; IsProtectedFile, AllowTimeStampComparison: Boolean; DeleteFlags: Longint; CurFileDate, ExistingFileDate: TFileTime; RegisterRec: PRegisterFilesListRec; RetriesLeft: Integer; LastError: DWORD; DestF, SourceF: TFile; Flags: TMakeDirFlags; Overwrite, PerUserFont: Boolean; label Retry, Skip; begin Log('-- File entry --'); CheckedDestFileExistedBefore := False; DestFileExistedBefore := False; { prevent warning } if CurFile^.LocationEntry <> -1 then CurFileLocation := PSetupFileLocationEntry(Entries[seFileLocation][CurFile^.LocationEntry]) else CurFileLocation := nil; Retry: DestFile := ''; TempFile := ''; TempFileLeftOver := False; ProgressUpdated := False; PreviousProgress := CurProgress; LastOperation := ''; Failed := ''; try try ReplaceOnRestart := False; DeleteFlags := 0; if DisableFsRedir then DeleteFlags := DeleteFlags or utDeleteFile_DisableFsRedir; if foRegisterServer in CurFile^.Options then DeleteFlags := DeleteFlags or utDeleteFile_RegisteredServer; if foRegisterTypeLib in CurFile^.Options then DeleteFlags := DeleteFlags or utDeleteFile_RegisteredTypeLib; if foUninsRestartDelete in CurFile^.Options then DeleteFlags := DeleteFlags or utDeleteFile_RestartDelete; if foUninsRemoveReadOnly in CurFile^.Options then DeleteFlags := DeleteFlags or utDeleteFile_RemoveReadOnly; if foGacInstall in CurFile^.Options then DeleteFlags := DeleteFlags or utDeleteFile_GacInstalled; FontFilename := ''; { Determine the destination filename } try case CurFile^.FileType of ftUninstExe: DestFile := UninstallExeFilename; else if ADestFile = '' then DestFile := ExpandConst(CurFile^.DestName) else DestFile := ADestFile; end; DestFile := PathExpand(DestFile); except { If an exception occurred, reset DestFile back to an empty string so the error message doesn't show an unexpanded name } DestFile := ''; raise; end; { Update the status and filename labels } if foDownload in CurFile^.Options then SetStatusLabelText(SetupMessages[msgStatusDownloadFiles], False) else SetStatusLabelText(SetupMessages[msgStatusExtractFiles], False); SetFilenameLabelText(DestFile, True); LogFmt('Dest filename: %s', [DestFile]); if DisableFsRedir <> InstallDefaultDisableFsRedir then begin if DisableFsRedir then Log('Non-default bitness: 64-bit') else Log('Non-default bitness: 32-bit'); end; { See if it's a protected system file. } if IsProtectedSystemFile(DisableFsRedir, DestFile) then begin Log('Dest file is protected by Windows File Protection.'); IsProtectedFile := (CurFile^.FileType = ftUserFile); end else IsProtectedFile := False; DestFileExists := NewFileExistsRedir(DisableFsRedir, DestFile); if not CheckedDestFileExistedBefore then begin DestFileExistedBefore := DestFileExists; CheckedDestFileExistedBefore := True; end; if DestFileExistedBefore then DeleteFlags := DeleteFlags or utDeleteFile_ExistedBeforeInstall; var CurFileDateDidRead := True; { Set to False later if needed } if Assigned(CurFileLocation) then begin if floTimeStampInUTC in CurFileLocation^.Flags then CurFileDate := CurFileLocation^.SourceTimeStamp else LocalFileTimeToFileTime(CurFileLocation^.SourceTimeStamp, CurFileDate); CurFileDateValid := True; end else if Assigned(AExternalFileDate) then begin CurFileDate := AExternalFileDate^; CurFileDateValid := CurFileDate.HasTime; end else if not(foDownload in CurFile^.Options) then CurFileDateValid := GetFileDateTime(DisableFsRedir, AExternalSourceFile, CurFileDate) else begin CurFileDateValid := False; CurFileDateDidRead := False; end; if CurFileDateValid then LogFmt('Time stamp of our file: %s', [FileTimeToStr(CurFileDate)]) else if CurFileDateDidRead then Log('Time stamp of our file: (failed to read)'); if DestFileExists then begin Log('Dest file exists.'); if foOnlyIfDoesntExist in CurFile^.Options then begin Log('Skipping due to "onlyifdoesntexist" flag.'); goto Skip; end; LastOperation := SetupMessages[msgErrorReadingExistingDest]; ExistingFileDateValid := GetFileDateTime(DisableFsRedir, DestFile, ExistingFileDate); if ExistingFileDateValid then LogFmt('Time stamp of existing file: %s', [FileTimeToStr(ExistingFileDate)]) else Log('Time stamp of existing file: (failed to read)'); { Compare version info } if not(foIgnoreVersion in CurFile^.Options) then begin AllowTimeStampComparison := False; { Read version info of file being installed } if foDownload in CurFile^.Options then InternalError('Unexpected Download flag'); if foExtractArchive in CurFile^.Options then InternalError('Unexpected ExtractArchive flag'); if Assigned(CurFileLocation) then begin CurFileVersionInfoValid := floVersionInfoValid in CurFileLocation^.Flags; CurFileVersionInfo.MS := CurFileLocation^.FileVersionMS; CurFileVersionInfo.LS := CurFileLocation^.FileVersionLS; end else CurFileVersionInfoValid := GetVersionNumbersRedir(DisableFsRedir, PathExpand(AExternalSourceFile), CurFileVersionInfo); if CurFileVersionInfoValid then LogFmt('Version of our file: %u.%u.%u.%u', [LongRec(CurFileVersionInfo.MS).Hi, LongRec(CurFileVersionInfo.MS).Lo, LongRec(CurFileVersionInfo.LS).Hi, LongRec(CurFileVersionInfo.LS).Lo]) else Log('Version of our file: (none)'); { Does the existing file have version info? } if GetVersionNumbersRedir(DisableFsRedir, PathExpand(DestFile), ExistingVersionInfo) then begin { If the file being installed has no version info, or the existing file is a newer version... } LogFmt('Version of existing file: %u.%u.%u.%u', [LongRec(ExistingVersionInfo.MS).Hi, LongRec(ExistingVersionInfo.MS).Lo, LongRec(ExistingVersionInfo.LS).Hi, LongRec(ExistingVersionInfo.LS).Lo]); if not CurFileVersionInfoValid or ((ExistingVersionInfo.MS > CurFileVersionInfo.MS) or ((ExistingVersionInfo.MS = CurFileVersionInfo.MS) and (ExistingVersionInfo.LS > CurFileVersionInfo.LS))) then begin { No version info, or existing file is newer, ask user what to do unless we shouldn't } if (foPromptIfOlder in CurFile^.Options) and not IsProtectedFile then begin if PromptIfOlderOverwriteAll <> oaOverwrite then begin Overwrite := AskOverwrite(DestFile, SetupMessages[msgExistingFileNewerSelectAction], SetupMessages[msgExistingFileNewer2], [SetupMessages[msgExistingFileNewerKeepExisting], SetupMessages[msgExistingFileNewerOverwriteExisting]], SetupMessages[msgExistingFileNewerOverwriteOrKeepAll], mbError, IDYES, IDNO, PromptIfOlderOverwriteAll); if not Overwrite then begin Log('User opted not to overwrite the existing file. Skipping.'); goto Skip; end; end; end else begin Log('Existing file is a newer version. Skipping.'); goto Skip; end; end else begin { If the existing file and the file being installed are the same version... } if (ExistingVersionInfo.MS = CurFileVersionInfo.MS) and (ExistingVersionInfo.LS = CurFileVersionInfo.LS) and not(foOverwriteSameVersion in CurFile^.Options) then begin if foReplaceSameVersionIfContentsDiffer in CurFile^.Options then begin { Get the two files' SHA-256 hashes and compare them } var ExistingFileHash: TSHA256Digest; if TryToGetSHA256OfFile(DisableFsRedir, DestFile, ExistingFileHash) then begin var CurFileHash: TSHA256Digest; if Assigned(CurFileLocation) then CurFileHash := CurFileLocation^.SHA256Sum else begin LastOperation := SetupMessages[msgErrorReadingSource]; { This GetSHA256OfFile call could raise an exception, but it's very unlikely since we were already able to successfully read the file's version info. } CurFileHash := GetSHA256OfFile(DisableFsRedir, AExternalSourceFile); LastOperation := SetupMessages[msgErrorReadingExistingDest]; end; { If the two files' SHA-256 hashes are equal, skip the file } if SHA256DigestsEqual(ExistingFileHash, CurFileHash) then begin Log('Existing file''s SHA-256 hash matches our file. Skipping.'); goto Skip; end; Log('Existing file''s SHA-256 hash is different from our file. Proceeding.'); end else Log('Failed to read existing file''s SHA-256 hash. Proceeding.'); end else begin { Skip the file or fall back to time stamp comparison } if not(foCompareTimeStamp in CurFile^.Options) then begin Log('Same version. Skipping.'); goto Skip; end; AllowTimeStampComparison := True; end; end; end; end else begin Log('Version of existing file: (none)'); { If neither the existing file nor our file have version info, allow time stamp comparison } if not CurFileVersionInfoValid then AllowTimeStampComparison := True; end; end else begin { When foIgnoreVersion is in Options, always allow time stamp comparison } AllowTimeStampComparison := True; end; { Fall back to comparing time stamps if needed } if AllowTimeStampComparison and (foCompareTimeStamp in CurFile^.Options) then begin if foDownload in CurFile^.Options then InternalError('Unexpected Download flag'); if not CurFileDateValid or not ExistingFileDateValid then begin { If we failed to read one of the time stamps, do the safe thing and just skip the file } Log('Couldn''t read time stamp. Skipping.'); goto Skip; end; if CompareFileTime(ExistingFileDate, CurFileDate) = 0 then begin { Same time stamp } Log('Same time stamp. Skipping.'); goto Skip; end; if CompareFileTime(ExistingFileDate, CurFileDate) > 0 then begin { Existing file has a later time stamp, ask user what to do unless we shouldn't } if (foPromptIfOlder in CurFile^.Options) and not IsProtectedFile then begin if PromptIfOlderOverwriteAll <> oaOverwrite then begin Overwrite := AskOverwrite(DestFile, SetupMessages[msgExistingFileNewerSelectAction], SetupMessages[msgExistingFileNewer2], [SetupMessages[msgExistingFileNewerKeepExisting], SetupMessages[msgExistingFileNewerOverwriteExisting]], SetupMessages[msgExistingFileNewerOverwriteOrKeepAll], mbError, IDYES, IDNO, PromptIfOlderOverwriteAll); if not Overwrite then begin Log('User opted not to overwrite the existing file. Skipping.'); goto Skip; end; end; end else begin Log('Existing file has a later time stamp. Skipping.'); goto Skip; end; end; end; LastOperation := ''; { Don't attempt to replace an existing protected system file. (Do this *after* the version numbers of the new & existing files have been logged.) } if IsProtectedFile then begin Log('Existing file is protected by Windows File Protection. Skipping.'); goto Skip; end; { If file already exists and foConfirmOverwrite is in Options, ask the user what to do } if foConfirmOverwrite in CurFile^.Options then begin if ConfirmOverwriteOverwriteAll <> oaOverwrite then begin Overwrite := AskOverwrite(DestFile, SetupMessages[msgFileExistsSelectAction], SetupMessages[msgFileExists2], [SetupMessages[msgFileExistsOverwriteExisting], SetupMessages[msgFileExistsKeepExisting]], SetupMessages[msgFileExistsOverwriteOrKeepAll], mbConfirmation, IDNO, IDYES, ConfirmOverwriteOverwriteAll); if not Overwrite then begin Log('User opted not to overwrite the existing file. Skipping.'); goto Skip; end; end; end; { Check if existing file is read-only } while True do begin var ExistingFileAttr := GetFileAttributesRedir(DisableFsRedir, DestFile); if (ExistingFileAttr <> INVALID_FILE_ATTRIBUTES) and (ExistingFileAttr and FILE_ATTRIBUTE_READONLY <> 0) then begin if not(foOverwriteReadOnly in CurFile^.Options) and AbortRetryIgnoreTaskDialogMsgBox( DestFile + SNewLine2 + SetupMessages[msgExistingFileReadOnly2], [SetupMessages[msgExistingFileReadOnlyRetry], SetupMessages[msgExistingFileReadOnlyKeepExisting], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin Log('User opted not to strip the existing file''s read-only attribute. Skipping.'); goto Skip; end; LastOperation := SetupMessages[msgErrorChangingAttr]; if SetFileAttributesRedir(DisableFsRedir, DestFile, ExistingFileAttr and not FILE_ATTRIBUTE_READONLY) then Log('Stripped read-only attribute.') else Log('Failed to strip read-only attribute.'); if foOverwriteReadOnly in CurFile^.Options then Break; { don't retry } end else Break; end; end else begin if (foOnlyIfDestFileExists in CurFile^.Options) and not DestFileExistedBefore then begin Log('Skipping due to "onlyifdestfileexists" flag.'); goto Skip; end; end; Log('Installing the file.'); { Locate source file } SourceFile := AExternalSourceFile; { Empty string if not external } if DisableFsRedir = InstallDefaultDisableFsRedir then begin { If the file is compressed in the setup package, has the same file already been copied somewhere else? If so, just make a duplicate of that file instead of extracting it over again. } if (SourceFile = '') and (FileLocationFilenames <> nil) and (FileLocationFilenames[CurFile^.LocationEntry] <> '') and NewFileExistsRedir(DisableFsRedir, FileLocationFilenames[CurFile^.LocationEntry]) then SourceFile := FileLocationFilenames[CurFile^.LocationEntry]; AllowFileToBeDuplicated := (SourceFile = ''); end else begin { This file uses a non-default FS redirection setting. Files in FileLocationFilenames are assumed to have been installed with the default FS redirection setting, so we can't use a file in FileLocationFilenames as the source, or put this file there. } AllowFileToBeDuplicated := False; end; { Download or extract or copy the file to a temporary file. Create the destination file's directory if it didn't already exist. } LastOperation := SetupMessages[msgErrorCreatingTemp]; TempFile := GenerateUniqueName(DisableFsRedir, PathExtractPath(DestFile), '.tmp'); Flags := []; if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall); if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall); MakeDir(DisableFsRedir, PathExtractDir(TempFile), Flags); DestF := TFileRedir.Create(DisableFsRedir, TempFile, fdCreateAlways, faReadWrite, fsNone); try TempFileLeftOver := True; try ProgressUpdated := True; LastOperation := SetupMessages[msgErrorReadingSource]; if SourceFile = '' then begin { Decompress a file } FileExtractor.SeekTo(CurFileLocation^, InternalProgressProc); LastOperation := SetupMessages[msgErrorCopying]; FileExtractor.DecompressFile(CurFileLocation^, DestF, InternalProgressProc, not (foDontVerifyChecksum in CurFile^.Options)); end else if foExtractArchive in CurFile^.Options then begin { Extract a file from archive. Note: ISSigVerify for archive has already been handled by RecurseExternalArchiveCopyFiles. } LastOperation := SetupMessages[msgErrorExtracting]; var MaxProgress := CurProgress; Inc6464(MaxProgress, AExternalSize); ArchiveFindExtract(StrToInt(SourceFile), DestF, ExternalProgressProc64, MaxProgress); end else if foDownload in CurFile^.Options then begin { Download a file with or without ISSigVerify. Note: estimate of extra .issig size has already been added to CurFile's ExternalSize. } LastOperation := SetupMessages[msgErrorDownloading]; const DownloadUserName = ExpandConst(CurFile^.DownloadUserName); const DownloadPassword = ExpandConst(CurFile^.DownloadPassword); var MaxProgress := CurProgress; Inc6464(MaxProgress, AExternalSize); if CurFile^.Verification.Typ = fvISSig then begin const ISSigTempFile = TempFile + ISSigExt; const ISSigDestF = TFileRedir.Create(DisableFsRedir, ISSigTempFile, fdCreateAlways, faReadWrite, fsNone); try { Download the .issig file } const ISSigUrl = GetISSigUrl(SourceFile, ExpandConst(CurFile^.DownloadISSigSource)); DownloadFile(ISSigUrl, DownloadUserName, DownloadPassword, ISSigDestF, NoVerification, '', JustProcessEventsProc64, To64(0)); FreeAndNil(ISSigDestF); { Download and verify the actual file } DownloadFile(SourceFile, DownloadUserName, DownloadPassword, DestF, CurFile^.Verification, TempFile, ExternalProgressProc64, MaxProgress); finally ISSigDestF.Free; { Delete the .issig file } DeleteFileRedir(DisableFsRedir, ISSigTempFile); end; end else DownloadFile(SourceFile, DownloadUserName, DownloadPassword, DestF, CurFile^.Verification, '', ExternalProgressProc64, MaxProgress); end else begin { Copy a duplicated non-external file, or an external file } SourceF := TFileRedir.Create(DisableFsRedir, SourceFile, fdOpenExisting, faRead, fsRead); try LastOperation := SetupMessages[msgErrorCopying]; if Assigned(CurFileLocation) then CopySourceFileToDestFile(SourceF, DestF, NoVerification, '', CurFileLocation^.OriginalSize) else CopySourceFileToDestFile(SourceF, DestF, CurFile^.Verification, SourceFile, AExternalSize); finally SourceF.Free; end; end; except { If an exception occurred, put progress meter back to where it was } ProgressUpdated := False; SetProgress(PreviousProgress); raise; end; { Set time/date stamp } if CurFileDateValid then SetFileTime(DestF.Handle, nil, nil, @CurFileDate); { If it's the uninstall program, bind the messages } if CurFile^.FileType = ftUninstExe then begin AllowFileToBeDuplicated := False; MarkExeHeader(DestF, SetupExeModeUninstaller); if not(shSignedUninstaller in SetupHeader.Options) and not DetachedUninstMsgFile then BindUninstallMsgDataToExe(DestF); end; finally DestF.Free; end; { If it's a font, unregister the existing one to ensure that Windows 'notices' the file is being replaced, and to increase the chances of the file being unlocked/closed before we replace it. } if CurFile^.InstallFontName <> '' then begin LastOperation := ''; FontFilename := ShortenOrExpandFontFilename(DestFile); if DestFileExistedBefore then RemoveFontResource(PChar(FontFilename)); end; { Delete existing version of file, if any. If it can't be deleted because it's in use and the "restartreplace" flag was specified on the entry, register it to be replaced when the system is restarted. Do retry deletion before doing this. } if DestFileExists and (CurFile^.FileType <> ftUninstExe) then begin LastOperation := SetupMessages[msgErrorReplacingExistingFile]; RetriesLeft := 4; while not DeleteFileRedir(DisableFsRedir, DestFile) do begin { Couldn't delete the existing file... } LastError := GetLastError; { If the file inexplicably vanished, it's not a problem } if LastError = ERROR_FILE_NOT_FOUND then Break; { Does the error code indicate that it is possibly in use? } if LastErrorIndicatesPossiblyInUse(LastError, False) then begin DoHandleFailedDeleteOrMoveFileTry('DeleteFile', TempFile, DestFile, LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart, DoBreak, DoContinue); if DoBreak then Break else if DoContinue then Continue; end; { Some other error occurred, or we ran out of tries } SetLastError(LastError); Win32ErrorMsg('DeleteFile'); end; end; { Rename the temporary file to the new name now, unless the file is to be replaced when the system is restarted, or if the file is the uninstall program and an existing uninstall program already exists. If it can't be renamed and the "restartreplace" flag was specified on the entry, register it to be replaced when the system is restarted. Do retry renaming before doing this. } if not (ReplaceOnRestart or ((CurFile^.FileType = ftUninstExe) and DestFileExistedBefore)) then begin LastOperation := SetupMessages[msgErrorRenamingTemp]; { Since the DeleteFile above succeeded you would expect the rename to also always succeed, but if it doesn't retry anyway. } RetriesLeft := 4; while not MoveFileRedir(DisableFsRedir, TempFile, DestFile) do begin { Couldn't rename the temporary file... } LastError := GetLastError; { Does the error code indicate that it is possibly in use? } if LastErrorIndicatesPossiblyInUse(LastError, True) then begin DoHandleFailedDeleteOrMoveFileTry('MoveFile', TempFile, DestFile, LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart, DoBreak, DoContinue); if DoBreak then Break else if DoContinue then Continue; end; { Some other error occurred, or we ran out of tries } SetLastError(LastError); Win32ErrorMsg('MoveFile'); { Throws an exception } end; { If ReplaceOnRestart is still False the rename succeeded so handle this. Then set any file attributes. } if not ReplaceOnRestart then begin TempFileLeftOver := False; TempFile := ''; LastOperation := ''; Log('Successfully installed the file.'); if AllowFileToBeDuplicated then SetFileLocationFilename(CurFile^.LocationEntry, DestFile); if foDeleteAfterInstall in CurFile^.Options then DeleteFilesAfterInstallList.AddObject(DestFile, Pointer(Ord(DisableFsRedir))); { Set file attributes *after* renaming the file since Novell reportedly can't rename read-only files. } AddAttributesToFile(DisableFsRedir, DestFile, CurFile^.Attribs); end; end; { Leave the temporary file in place for now if the file is to be replaced when the system is restarted, or if the file is the uninstall program and an existing uninstall program already exists. } if ReplaceOnRestart or ((CurFile^.FileType = ftUninstExe) and DestFileExistedBefore) then begin if CurFile^.FileType = ftUninstExe then UninstallTempExeFilename := TempFile; TempFileLeftOver := False; LastOperation := ''; Log('Leaving temporary file in place for now.'); if AllowFileToBeDuplicated then SetFileLocationFilename(CurFile^.LocationEntry, TempFile); AddAttributesToFile(DisableFsRedir, TempFile, CurFile^.Attribs); end; { If it's a font, register it } if CurFile^.InstallFontName <> '' then begin LastOperation := ''; LogFmt('Registering file as a font ("%s")', [CurFile^.InstallFontName]); PerUserFont := not IsAdminInstallMode; InstallFont(FontFilename, CurFile^.InstallFontName, PerUserFont, not ReplaceOnRestart, WarnedPerUserFonts); DeleteFlags := DeleteFlags or utDeleteFile_IsFont; if PerUserFont then DeleteFlags := DeleteFlags or utDeleteFile_PerUserFont; end; { There were no errors so add the uninstall log entry, unless the file is the uninstall program, or if it has the foSharedFile flag; shared files are handled below. } LastOperation := ''; if CurFile^.FileType <> ftUninstExe then begin if not(foUninsNeverUninstall in CurFile^.Options) and not(foSharedFile in CurFile^.Options) then begin UninstLog.Add(utDeleteFile, [DestFile, TempFile, CurFile^.InstallFontName, FontFilename, CurFile^.StrongAssemblyName], DeleteFlags); end; end else begin if UninstallTempExeFilename = '' then UninstallExeCreated := ueNew else UninstallExeCreated := ueReplaced; end; Skip: { If foRegisterServer or foRegisterTypeLib is in Options, add the file to RegisterFilesList for registering later. Don't attempt to register if the file doesn't exist (which can happen if the foOnlyIfDestFileExists flag is used). } if ((foRegisterServer in CurFile^.Options) or (foRegisterTypeLib in CurFile^.Options)) and NewFileExistsRedir(DisableFsRedir, DestFile) then begin LastOperation := ''; if foRegisterTypeLib in CurFile^.Options then Log('Will register the file (a type library) later.') else Log('Will register the file (a DLL/OCX) later.'); New(RegisterRec); RegisterRec^.Filename := DestFile; RegisterRec^.Is64Bit := DisableFsRedir; RegisterRec^.TypeLib := foRegisterTypeLib in CurFile^.Options; RegisterRec^.NoErrorMessages := foNoRegError in CurFile^.Options; RegisterFilesList.Add(RegisterRec); end; { If foSharedFile is in Options, increment the reference count in the registry for the file, then add the uninstall log entry (which, unlike non-shared files, must be done on skipped files as well; that's why there are two places where utDeleteFile entries are added). } if foSharedFile in CurFile^.Options then begin LastOperation := ''; if DisableFsRedir then begin Log('Incrementing shared file count (64-bit).'); IncrementSharedCount(rv64Bit, DestFile, DestFileExistedBefore); end else begin Log('Incrementing shared file count (32-bit).'); IncrementSharedCount(rv32Bit, DestFile, DestFileExistedBefore); end; if not(foUninsNeverUninstall in CurFile^.Options) then begin DeleteFlags := DeleteFlags or utDeleteFile_SharedFile; if DisableFsRedir then DeleteFlags := DeleteFlags or utDeleteFile_SharedFileIn64BitKey; if foUninsNoSharedFilePrompt in CurFile^.Options then DeleteFlags := DeleteFlags or utDeleteFile_NoSharedFilePrompt; UninstLog.Add(utDeleteFile, [DestFile, TempFile, CurFile^.InstallFontName, FontFilename, CurFile^.StrongAssemblyName], DeleteFlags); end else begin if DisableFsRedir then UninstLog.Add(utDecrementSharedCount, [DestFile], utDecrementSharedCount_64BitKey) else UninstLog.Add(utDecrementSharedCount, [DestFile], 0); end; end; { Apply permissions (even if the file wasn't replaced) } LastOperation := ''; if TempFile <> '' then ApplyPermissions(DisableFsRedir, TempFile, CurFile^.PermissionsEntry) else ApplyPermissions(DisableFsRedir, DestFile, CurFile^.PermissionsEntry); { Set NTFS compression (even if the file wasn't replaced) } if (foSetNTFSCompression in CurFile^.Options) or (foUnsetNTFSCompression in CurFile^.Options) then begin LastOperation := ''; if TempFile <> '' then ApplyNTFSCompression(DisableFsRedir, TempFile, foSetNTFSCompression in CurFile^.Options) else ApplyNTFSCompression(DisableFsRedir, DestFile, foSetNTFSCompression in CurFile^.Options); end; { Install into GAC (even if the file wasn't replaced) } if foGacInstall in CurFile^.Options then begin Log('Installing into GAC'); with TAssemblyCacheInfo.Create(rvDefault) do try if TempFile <> '' then InstallAssembly(TempFile) else InstallAssembly(DestFile); finally Free; end; end; except if ExceptObject is EAbort then raise; Failed := GetExceptMessage; end; finally { If an exception occurred before TempFile was cleaned up, delete it now } if TempFileLeftOver then DeleteFileRedir(DisableFsRedir, TempFile); end; { Was there an exception? Display error message and offer to retry } if Failed <> '' then begin if (CurFile^.FileType = ftUninstExe) and (UninstallTempExeFilename <> '') then begin DeleteFile(UninstallTempExeFilename); UninstallTempExeFilename := ''; UninstallExeCreated := ueNone; end; if LastOperation <> '' then LastOperation := LastOperation + SNewLine; if not AbortRetryIgnoreTaskDialogMsgBox( DestFile + SNewLine2 + LastOperation + Failed, [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin if ProgressUpdated then SetProgress(PreviousProgress); goto Retry; end; end; { Increment progress meter, if not already done so } if not ProgressUpdated then begin if Assigned(CurFileLocation) then { not an "external" file } IncProgress64(CurFileLocation^.OriginalSize) else IncProgress64(AExternalSize); end; { Process any events between copying files } ProcessEvents; { Clear previous filename label in case an exception or debugger break occurs between now and when the label for the next entry is set } SetFilenameLabelText('', False); end; procedure CopyFiles(const Uninstallable: Boolean); { Copies all the application's files } function RecurseExternalCopyFiles(const DisableFsRedir: Boolean; const SearchBaseDir, SearchSubDir, SearchWildcard: String; const SourceIsWildcard: Boolean; const Excludes: TStrings; const CurFile: PSetupFileEntry; var ExpectedBytesLeft: Integer64; var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll; var WarnedPerUserFonts: Boolean): Boolean; begin { Also see RecurseExternalFiles and RecurseExternalGetSizeOfFiles in Setup.MainFunc Also see RecurseExternalArchiveCopyFiles directly below } Result := False; 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 var FileName: String; if SourceIsWildcard then begin if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then Continue; FileName := FindData.cFileName; end else FileName := SearchWildcard; { use the case specified in the script } if IsExcluded(SearchSubDir + FileName, Excludes) then Continue; Result := True; var SourceFile := SearchBaseDir + SearchSubDir + FileName; { 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 + FileName else if SearchSubDir <> '' then DestFile := PathExtractPath(DestFile) + SearchSubDir + PathExtractName(DestFile); var Size: Integer64; Size.Hi := FindData.nFileSizeHigh; Size.Lo := FindData.nFileSizeLow; if Compare64(Size, ExpectedBytesLeft) > 0 then begin { Don't allow the progress bar to overflow if the size of the files is greater than when we last checked } Size := ExpectedBytesLeft; end; ProcessFileEntry(CurFile, DisableFsRedir, SourceFile, DestFile, nil, Size, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll, WarnedPerUserFonts, nil); Dec6464(ExpectedBytesLeft, Size); 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 Result := RecurseExternalCopyFiles(DisableFsRedir, SearchBaseDir, SearchSubDir + FindData.cFileName + '\', SearchWildcard, SourceIsWildcard, Excludes, CurFile, ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll, WarnedPerUserFonts) or Result; until not FindNextFile(H, FindData); finally Windows.FindClose(H); end; end; end; if SearchSubDir <> '' then begin { If Result is False this subdir won't be created, so create it now if CreateAllSubDirs was set } if not Result and (foCreateAllSubDirs in CurFile.Options) then begin var DestName := ExpandConst(CurFile^.DestName); { See above } if not(foCustomDestName in CurFile^.Options) then DestName := DestName + SearchSubDir else DestName := PathExtractPath(DestName) + SearchSubDir; var Flags: TMakeDirFlags := []; if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall); if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall); MakeDir(DisableFsRedir, DestName, Flags); Result := True; end; end; { When recursively searching but not picking up every file, we could be frozen for a long time when installing from a network. Calling ProcessEvents after every directory helps. } ProcessEvents; end; function RecurseExternalArchiveCopyFiles(const DisableFsRedir: Boolean; const ArchiveFilename: String; const Excludes: TStrings; const CurFile: PSetupFileEntry; var ExpectedBytesLeft: Integer64; var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll; var WarnedPerUserFonts: Boolean): Boolean; begin { See above } { If the archive doesn't exist then the caller should handle this with a msgSourceDoesntExist message. All other errors we handle ourselves with a msgErrorExtracting message, without informing the caller, unless you count EAbort. } Result := NewFileExistsRedir(DisableFsRedir, ArchiveFilename); if not Result then Exit; if foCustomDestName in CurFile^.Options then InternalError('Unexpected custom DestName'); const DestDir = ExpandConst(CurFile^.DestName); Log('-- Archive entry --'); var VerifySourceF: TFile := nil; try var FindData: TWin32FindData; var H: TArchiveFindHandle := INVALID_HANDLE_VALUE; var Failed: String; repeat try if CurFile^.Verification.Typ <> fvNone then begin if VerifySourceF = nil then VerifySourceF := TFileRedir.Create(DisableFsRedir, ArchiveFilename, fdOpenExisting, faRead, fsRead); var ExpectedFileHash: TSHA256Digest; if CurFile^.Verification.Typ = fvHash then ExpectedFileHash := CurFile^.Verification.Hash else begin DoISSigVerify(VerifySourceF, nil, ArchiveFilename, CurFile^.Verification.ISSigAllowedKeys, ExpectedFileHash); end; { Can't get the SHA-256 while extracting so need to get and check it now } const ActualFileHash = GetSHA256OfFile(VerifySourceF); if not SHA256DigestsEqual(ActualFileHash, ExpectedFileHash) then VerificationError(veFileHashIncorrect); Log(VerificationSuccessfulLogMessage); { Keep VerifySourceF open until extraction has completed to prevent TOCTOU problem } end; H := ArchiveFindFirstFileRedir(DisableFsRedir, ArchiveFilename, DestDir, ExpandConst(CurFile^.ExtractArchivePassword), foRecurseSubDirsExternal in CurFile^.Options, True, FindData); Failed := ''; except if ExceptObject is EAbort then raise; Failed := GetExceptMessage; end; until (Failed = '') or AbortRetryIgnoreTaskDialogMsgBox( ArchiveFilename + SNewLine2 + SetupMessages[msgErrorExtracting] + SNewLine + Failed, [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]); 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 SourceFile := IntToStr(H); const DestFile = DestDir + FindData.cFileName; var Size: Integer64; Size.Hi := FindData.nFileSizeHigh; Size.Lo := FindData.nFileSizeLow; if Compare64(Size, ExpectedBytesLeft) > 0 then begin { Don't allow the progress bar to overflow if the size of the files is greater than when we last checked } Size := ExpectedBytesLeft; end; ProcessFileEntry(CurFile, DisableFsRedir, SourceFile, DestFile, nil, Size, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll, WarnedPerUserFonts, @FindData.ftLastWriteTime); Dec6464(ExpectedBytesLeft, Size); end else if foCreateAllSubDirs in CurFile.Options then begin var Flags: TMakeDirFlags := []; if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall); if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall); MakeDir(DisableFsRedir, DestDir + FindData.cFileName, Flags); Result := True; end; until not ArchiveFindNextFile(H, FindData); finally ArchiveFindClose(H); end; Log('Successfully extracted the archive.'); end; finally VerifySourceF.Free; end; end; var I: Integer; CurFileNumber: Integer; CurFile: PSetupFileEntry; SourceWildcard: String; ProgressBefore, ExpectedBytesLeft: Integer64; DisableFsRedir, FoundFiles: Boolean; ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll; WarnedPerUserFonts: Boolean; begin ConfirmOverwriteOverwriteAll := oaUnknown; PromptIfOlderOverwriteAll := oaUnknown; WarnedPerUserFonts := False; var FileLocationFilenames: TStringList := nil; var Excludes: TStringList := nil; try FileLocationFilenames := TStringList.Create; for I := 0 to Entries[seFileLocation].Count-1 do FileLocationFilenames.Add(''); Excludes := TStringList.Create; Excludes.StrictDelimiter := True; Excludes.Delimiter := ','; for CurFileNumber := 0 to Entries[seFile].Count-1 do begin CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]); if ((CurFile^.FileType <> ftUninstExe) or Uninstallable) and ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin DebugNotifyEntry(seFile, CurFileNumber); NotifyBeforeInstallFileEntry(CurFile); DisableFsRedir := InstallDefaultDisableFsRedir; if fo32Bit in CurFile^.Options then DisableFsRedir := False; if fo64Bit in CurFile^.Options then begin if not IsWin64 then InternalError('Cannot install files to 64-bit locations on this version of Windows'); DisableFsRedir := True; end; if CurFile^.LocationEntry <> -1 then begin ProcessFileEntry(CurFile, DisableFsRedir, '', '', FileLocationFilenames, To64(0), ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll, WarnedPerUserFonts, nil); end else begin { File is an 'external' file } if CurFile^.FileType = ftUninstExe then begin { This is the file entry for the uninstaller program } SourceWildcard := NewParamStr(0); DisableFsRedir := False; end else SourceWildcard := ExpandConst(CurFile^.SourceFilename); Excludes.DelimitedText := CurFile^.Excludes; ProgressBefore := CurProgress; repeat SetProgress(ProgressBefore); ExpectedBytesLeft := CurFile^.ExternalSize; 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 foSkipIfSourceDoesntExist in CurFile^.Options then InternalError('Unexpected SkipIfSourceDoesntExist flag'); if not(foCustomDestName in CurFile^.Options) then InternalError('Expected CustomDestName flag'); { CurFile^.DestName now includes a filename, see TSetupCompiler.EnumFilesProc.ProcessFileList } ProcessFileEntry(CurFile, DisableFsRedir, SourceWildcard, ExpandConst(CurFile^.DestName), nil, ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll, WarnedPerUserFonts, nil); FoundFiles := True; end else if foExtractArchive in CurFile^.Options then FoundFiles := RecurseExternalArchiveCopyFiles(DisableFsRedir, SourceWildcard, Excludes, CurFile, ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll, WarnedPerUserFonts) else FoundFiles := RecurseExternalCopyFiles(DisableFsRedir, PathExtractPath(SourceWildcard), '', PathExtractName(SourceWildcard), IsWildcard(SourceWildcard), Excludes, CurFile, ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll, WarnedPerUserFonts); until FoundFiles or (foSkipIfSourceDoesntExist in CurFile^.Options) or AbortRetryIgnoreTaskDialogMsgBox( SetupMessages[msgErrorReadingSource] + SNewLine + AddPeriod(FmtSetupMessage(msgSourceDoesntExist, [SourceWildcard])), [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]); { In case we didn't end up copying all the expected bytes, bump the progress bar up to the expected amount } Inc6464(ProgressBefore, CurFile^.ExternalSize); SetProgress(ProgressBefore); end; NotifyAfterInstallFileEntry(CurFile); end; end; finally Excludes.Free; FileLocationFilenames.Free; end; end; procedure CreateIcons; function IsPathURL(const S: String): Boolean; { Returns True if S begins with a scheme name and colon. Should be compliant with RFC 2396 section 3.1. } const SchemeAlphaChars = ['A'..'Z', 'a'..'z']; SchemeAllChars = SchemeAlphaChars + ['0'..'9', '+', '-', '.']; var P, I: Integer; begin Result := False; P := PathPos(':', S); if (P > 2) and CharInSet(S[1], SchemeAlphaChars) then begin for I := 2 to P-1 do if not CharInSet(S[I], SchemeAllChars) then Exit; Result := True; end; end; procedure CreateURLFile(const Filename, URL, IconFilename: String; const IconIndex: Integer); var S: String; F: TTextFileWriter; begin S := '[InternetShortcut]' + SNewLine + 'URL=' + URL + SNewLine; if IconFilename <> '' then S := S + 'IconFile=' + IconFilename + SNewLine + 'IconIndex=' + IntToStr(IconIndex) + SNewLine; F := TTextFileWriter.Create(Filename, fdCreateAlways, faWrite, fsNone); try if SameText(S, String(AnsiString(S))) then F.WriteAnsi(AnsiString(S)) else F.Write(S); finally F.Free; end; end; procedure DeleteFolderShortcut(const Dir: String); var Attr: DWORD; DesktopIniFilename, S: String; begin Attr := GetFileAttributes(PChar(Dir)); if (Attr <> INVALID_FILE_ATTRIBUTES) and (Attr and FILE_ATTRIBUTE_DIRECTORY <> 0) then begin { To be sure this is really a folder shortcut and not a regular folder, look for a desktop.ini file specifying CLSID_FolderShortcut } DesktopIniFilename := PathCombine(Dir, 'desktop.ini'); S := GetIniString('.ShellClassInfo', 'CLSID2', '', DesktopIniFilename); if CompareText(S, '{0AFACED1-E828-11D1-9187-B532F1E9575D}') = 0 then begin DeleteFile(DesktopIniFilename); DeleteFile(PathCombine(Dir, 'target.lnk')); SetFileAttributes(PChar(Dir), Attr and not FILE_ATTRIBUTE_READONLY); RemoveDirectory(PChar(Dir)); end; end; end; procedure CreateAnIcon(Name: String; const Description, Path, Parameters, WorkingDir, IconFilename: String; const IconIndex, ShowCmd: Integer; const NeverUninstall: Boolean; const CloseOnExit: TSetupIconCloseOnExit; const HotKey: Word; const AppUserModelID: String; const AppUserModelToastActivatorCLSID: PGUID; const ExcludeFromShowInNewInstall, PreventPinning: Boolean); var BeginsWithGroup: Boolean; LinkFilename, PifFilename, UrlFilename, DirFilename, ProbableFilename, ResultingFilename: String; Flags: TMakeDirFlags; URLShortcut: Boolean; begin BeginsWithGroup := Copy(Name, 1, 8) = '{group}\'; { Note: PathExpand removes trailing spaces, so it can't be called on Name before the extensions are appended } Name := ExpandConst(Name); LinkFilename := PathExpand(Name + '.lnk'); PifFilename := PathExpand(Name + '.pif'); UrlFilename := PathExpand(Name + '.url'); DirFilename := PathExpand(Name); Flags := [mdNotifyChange]; if NeverUninstall then Include(Flags, mdNoUninstall) else if BeginsWithGroup then Include(Flags, mdAlwaysUninstall); URLShortcut := IsPathURL(Path); if URLShortcut then ProbableFilename := UrlFilename else ProbableFilename := LinkFilename; LogFmt('Dest filename: %s', [ProbableFilename]); SetFilenameLabelText(ProbableFilename, True); MakeDir(False, PathExtractDir(ProbableFilename), Flags); { Delete any old files first } DeleteFile(LinkFilename); DeleteFile(PifFilename); if NewFileExists(UrlFilename) then begin { Flush out any pending writes by other apps before deleting } WritePrivateProfileString(nil, nil, nil, PChar(UrlFilename)); end; DeleteFile(UrlFilename); DeleteFolderShortcut(DirFilename); Log('Creating the icon.'); if not URLShortcut then begin { Create the shortcut. Note: Don't call PathExpand on any of the paths since they may contain environment-variable strings (e.g. %SystemRoot%\...) } ResultingFilename := CreateShellLink(LinkFilename, Description, Path, Parameters, WorkingDir, IconFilename, IconIndex, ShowCmd, HotKey, AppUserModelID, AppUserModelToastActivatorCLSID, ExcludeFromShowInNewInstall, PreventPinning); { If a .pif file was created, apply the "Close on exit" setting } if (CloseOnExit <> icNoSetting) and SameText(PathExtractExt(ResultingFilename), '.pif') then begin try ModifyPifFile(ResultingFilename, CloseOnExit = icYes); except { Failure isn't important here. Ignore exceptions } end; end; end else begin { Create an Internet Shortcut (.url) file } CreateURLFile(UrlFilename, Path, IconFilename, IconIndex); ResultingFilename := UrlFilename; end; Log('Successfully created the icon.'); { Set the global flag that is checked by the Finished wizard page } CreatedIcon := True; { Notify shell of the change } SHChangeNotify(SHCNE_CREATE, SHCNF_PATH, PChar(ResultingFilename), nil); SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH, PChar(PathExtractDir(ResultingFilename)), nil); { Add uninstall log entries } if not NeverUninstall then begin if URLShortcut then UninstLog.Add(utDeleteFile, [ResultingFilename], utDeleteFile_CallChangeNotify) else begin { Even though we only created one file, go ahead and try deleting both a .lnk and .pif file at uninstall time, in case the user alters the shortcut after installation } UninstLog.Add(utDeleteFile, [LinkFilename], utDeleteFile_CallChangeNotify); UninstLog.Add(utDeleteFile, [PifFilename], utDeleteFile_CallChangeNotify); end; end; end; function ExpandAppPath(const Filename: String): String; var K: HKEY; Found: Boolean; begin if RegOpenKeyExView(InstallDefaultRegView, HKEY_LOCAL_MACHINE, PChar(REGSTR_PATH_APPPATHS + '\' + Filename), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin Found := RegQueryStringValue(K, '', Result); RegCloseKey(K); if Found then Exit; end; Result := Filename; end; var CurIconNumber: Integer; CurIcon: PSetupIconEntry; FN: String; TACLSID: PGUID; begin for CurIconNumber := 0 to Entries[seIcon].Count-1 do begin try CurIcon := PSetupIconEntry(Entries[seIcon][CurIconNumber]); with CurIcon^ do begin if ShouldProcessIconEntry(WizardComponents, WizardTasks, WizardNoIcons, CurIcon) then begin DebugNotifyEntry(seIcon, CurIconNumber); NotifyBeforeInstallEntry(BeforeInstall); Log('-- Icon entry --'); FN := ExpandConst(Filename); if ioUseAppPaths in Options then FN := ExpandAppPath(FN); if not(ioCreateOnlyIfFileExists in Options) or NewFileExistsRedir(IsWin64, FN) then begin if ioHasAppUserModelToastActivatorCLSID in Options then TACLSID := @AppUserModelToastActivatorCLSID else TACLSID := nil; CreateAnIcon(IconName, ExpandConst(Comment), FN, ExpandConst(Parameters), ExpandConst(WorkingDir), ExpandConst(IconFilename), IconIndex, ShowCmd, ioUninsNeverUninstall in Options, CloseOnExit, HotKey, ExpandConst(AppUserModelID), TACLSID, ioExcludeFromShowInNewInstall in Options, ioPreventPinning in Options) end else Log('Skipping due to "createonlyiffileexists" flag.'); { Increment progress meter } IncProgress(1000); NotifyAfterInstallEntry(AfterInstall); end; end; except if not(ExceptObject is EAbort) then Application.HandleException(nil) else raise; end; ProcessEvents; { Clear previous filename label in case an exception or debugger break occurs between now and when the label for the next entry is set } SetFilenameLabelText('', False); end; end; procedure CreateIniEntries; var CurIniNumber: Integer; CurIni: PSetupIniEntry; IniSection, IniEntry, IniValue, IniFilename, IniDir: String; Skip: Boolean; begin for CurIniNumber := 0 to Entries[seIni].Count-1 do begin CurIni := PSetupIniEntry(Entries[seIni][CurIniNumber]); with CurIni^ do begin if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin DebugNotifyEntry(seIni, CurIniNumber); NotifyBeforeInstallEntry(BeforeInstall); Log('-- INI entry --'); IniSection := ExpandConst(Section); IniEntry := ExpandConst(Entry); IniValue := ExpandConst(Value); IniFilename := ExpandConst(Filename); LogFmt('Dest filename: %s', [IniFilename]); LogFmt('Section: %s', [IniSection]); if IniEntry <> '' then LogFmt('Entry: %s', [IniEntry]); if ioHasValue in Options then LogFmt('Value: %s', [IniValue]); if (IniEntry <> '') and (ioHasValue in Options) and (not(ioCreateKeyIfDoesntExist in Options) or not IniKeyExists(IniSection, IniEntry, IniFilename)) then begin Skip := False; IniDir := PathExtractDir(IniFilename); if IniDir <> '' then begin while True do begin try MakeDir(False, IniDir, []); Break; except if AbortRetryIgnoreTaskDialogMsgBox( GetExceptMessage, [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin Skip := True; Break; end; end; end; end; if not Skip then Log('Updating the .INI file.'); repeat if SetIniString(IniSection, IniEntry, IniValue, IniFilename) then begin Log('Successfully updated the .INI file.'); Break; end; until AbortRetryIgnoreTaskDialogMsgBox( FmtSetupMessage1(msgErrorIniEntry, IniFilename), [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]); end else Log('Skipping updating the .INI file, only updating uninstall log.'); if ioUninsDeleteEntireSection in Options then UninstLog.Add(utIniDeleteSection, [IniFilename, IniSection], 0); if ioUninsDeleteSectionIfEmpty in Options then UninstLog.Add(utIniDeleteSection, [IniFilename, IniSection], utIniDeleteSection_OnlyIfEmpty); if (ioUninsDeleteEntry in Options) and (IniEntry <> '') then UninstLog.Add(utIniDeleteEntry, [IniFilename, IniSection, IniEntry], 0); { ^ add utIniDeleteEntry last since we want it done first by the uninstaller (in case the entry's also got the "uninsdeletesectionifempty" flag) } NotifyAfterInstallEntry(AfterInstall); end; end; end; { Increment progress meter } IncProgress(1000); end; procedure CreateRegistryEntries; function IsDeletableSubkey(const S: String): Boolean; { A sanity check to prevent people from shooting themselves in the foot by using Root: HKLM; Subkey: ""; Flags: [unins]deletekey or a 'code' constant in Subkey that returns a blank string or only backslashes. } var P: PChar; begin Result := False; P := PChar(S); while P^ <> #0 do begin if P^ <> '\' then begin Result := True; Break; end; Inc(P); end; end; procedure ApplyPermissions(const RegView: TRegView; const RootKey: HKEY; const Subkey: String; const PermsEntry: Integer); var P: PSetupPermissionEntry; begin LogFmt('Setting permissions on key: %s\%s', [GetRegRootKeyName(RootKey), Subkey]); P := Entries[sePermission][PermsEntry]; if not GrantPermissionOnKey(RegView, RootKey, Subkey, TGrantPermissionEntry(Pointer(P.Permissions)^), Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then begin if GetLastError = ERROR_FILE_NOT_FOUND then Log('Could not set permissions on the key because it currently does not exist.') else LogFmt('Failed to set permissions on the key (%d).', [GetLastError]); end; end; const REG_QWORD = 11; var RK, K: HKEY; Disp: DWORD; N, V, ExistingData: String; ExistingType, NewType, DV: DWORD; S: String; RV: TRegView; CurRegNumber: Integer; NeedToRetry, DidDeleteKey: Boolean; ErrorCode: Longint; QV: Integer64; I: Integer; AnsiS: AnsiString; begin for CurRegNumber := 0 to Entries[seRegistry].Count-1 do begin with PSetupRegistryEntry(Entries[seRegistry][CurRegNumber])^ do begin if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin DebugNotifyEntry(seRegistry, CurRegNumber); NotifyBeforeInstallEntry(BeforeInstall); Log('-- Registry entry --'); RK := RootKey; if RK = HKEY_AUTO then RK := InstallModeRootKey; S := ExpandConst(Subkey); LogFmt('Key: %s\%s', [GetRegRootKeyName(RK), Subkey]); N := ExpandConst(ValueName); if N <> '' then LogFmt('Value name: %s', [N]); RV := InstallDefaultRegView; if (ro32Bit in Options) and (RV <> rv32Bit) then begin Log('Non-default bitness: 32-bit'); RV := rv32Bit; end; if ro64Bit in Options then begin if not IsWin64 then InternalError('Cannot access 64-bit registry keys on this version of Windows'); if RV <> rv64Bit then begin Log('Non-default bitness: 64-bit'); RV := rv64Bit; end; end; repeat NeedToRetry := False; try DidDeleteKey := False; if roDeleteKey in Options then begin if IsDeletableSubkey(S) then begin Log('Deleting the key.'); RegDeleteKeyIncludingSubkeys(RV, RK, PChar(S)); DidDeleteKey := True; end else Log('Key to delete is not deletable.'); end; if (roDeleteKey in Options) and (Typ = rtNone) then begin { We've deleted the key, and no value is to be created. Our work is done. } if DidDeleteKey then Log('Successfully deleted the key.'); end else if (roDeleteValue in Options) and (Typ = rtNone) then begin { We're going to delete a value with no intention of creating another, so don't create the key if it didn't exist. } if RegOpenKeyExView(RV, RK, PChar(S), 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin Log('Deleting the value.'); RegDeleteValue(K, PChar(N)); RegCloseKey(K); Log('Successfully deleted the value.'); { Our work is done. } end else Log('Key of value to delete does not exist.'); end else begin { Apply any permissions *before* calling RegCreateKeyExView or RegOpenKeyExView, since we may (in a rather unlikely scenario) need those permissions in order for those calls to succeed } if PermissionsEntry <> -1 then ApplyPermissions(RV, RK, S, PermissionsEntry); { Create or open the key } if not(roDontCreateKey in Options) then begin Log('Creating or opening the key.'); ErrorCode := RegCreateKeyExView(RV, RK, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_SET_VALUE, nil, K, @Disp); if ErrorCode = ERROR_SUCCESS then begin { Apply permissions again if a new key was created } if (Disp = REG_CREATED_NEW_KEY) and (PermissionsEntry <> -1) then begin Log('New key created, need to set permissions again.'); ApplyPermissions(RV, RK, S, PermissionsEntry); end; end else begin if not(roNoError in Options) then RegError(reRegCreateKeyEx, RK, S, ErrorCode); end; end else begin if Typ <> rtNone then begin Log('Opening the key.'); ErrorCode := RegOpenKeyExView(RV, RK, PChar(S), 0, KEY_QUERY_VALUE or KEY_SET_VALUE, K); if (ErrorCode <> ERROR_SUCCESS) and (ErrorCode <> ERROR_FILE_NOT_FOUND) then if not(roNoError in Options) then RegError(reRegOpenKeyEx, RK, S, ErrorCode); end else begin { We're not creating a value, and we're not just deleting a value (that was checked above), so there is no reason to even open the key } Log('Not creating the key or a value, skipping the key and only updating uninstall log.'); ErrorCode := ERROR_FILE_NOT_FOUND; end; end; { If there was no error opening the key, proceed with deleting and/or creating the value } if ErrorCode = ERROR_SUCCESS then try if roDeleteValue in Options then begin Log('Deleting the value.'); RegDeleteValue(K, PChar(N)); end; if (Typ <> rtNone) and (not(roCreateValueIfDoesntExist in Options) or not RegValueExists(K, PChar(N))) then begin Log('Creating or setting the value.'); case Typ of rtString, rtExpandString, rtMultiString: begin NewType := REG_SZ; case Typ of rtExpandString: NewType := REG_EXPAND_SZ; rtMultiString: NewType := REG_MULTI_SZ; end; if Typ <> rtMultiString then begin if (Pos('{olddata}', ValueData) <> 0) and RegQueryStringValue(K, PChar(N), ExistingData) then { successful } else ExistingData := ''; if roPreserveStringType in Options then begin if (RegQueryValueEx(K, PChar(N), nil, @ExistingType, nil, nil) = ERROR_SUCCESS) and ((ExistingType = REG_SZ) or (ExistingType = REG_EXPAND_SZ)) then NewType := ExistingType; end; V := ExpandConstEx(ValueData, ['olddata', ExistingData]) end else begin if (Pos('{olddata}', ValueData) <> 0) and RegQueryMultiStringValue(K, PChar(N), ExistingData) then { successful } else ExistingData := ''; V := ExpandConstEx(ValueData, ['olddata', ExistingData, 'break', #0]); { Multi-string data requires two null terminators: one after the last string, and one to mark the end. Delphi's String type is implicitly null-terminated, so only one null needs to be added to the end. } if (V <> '') and (V[Length(V)] <> #0) then V := V + #0; end; ErrorCode := RegSetValueEx(K, PChar(N), 0, NewType, PChar(V), (Length(V)+1)*SizeOf(V[1])); if (ErrorCode <> ERROR_SUCCESS) and not(roNoError in Options) then RegError(reRegSetValueEx, RK, S, ErrorCode); end; rtDWord: begin DV := StrToInt(ExpandConst(ValueData)); ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_DWORD, @DV, SizeOf(DV)); if (ErrorCode <> ERROR_SUCCESS) and not(roNoError in Options) then RegError(reRegSetValueEx, RK, S, ErrorCode); end; rtQWord: begin if not StrToInteger64(ExpandConst(ValueData), QV) then InternalError('Failed to parse "qword" value'); ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_QWORD, @TLargeInteger(QV), SizeOf(TLargeInteger(QV))); if (ErrorCode <> ERROR_SUCCESS) and not(roNoError in Options) then RegError(reRegSetValueEx, RK, S, ErrorCode); end; rtBinary: begin AnsiS := ''; for I := 1 to Length(ValueData) do AnsiS := AnsiS + AnsiChar(Ord(ValueData[I])); ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_BINARY, PAnsiChar(AnsiS), Length(AnsiS)); if (ErrorCode <> ERROR_SUCCESS) and not(roNoError in Options) then RegError(reRegSetValueEx, RK, S, ErrorCode); end; end; Log('Successfully created or set the value.'); end else if roDeleteValue in Options then Log('Successfully deleted the value.') else Log('Successfully created the key.') { Our work is done. } finally RegCloseKey(K); end; end; except if not AbortRetryIgnoreTaskDialogMsgBox( GetExceptMessage, [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin Log('Retrying.'); NeedToRetry := True; end; end; until not NeedToRetry; if roUninsDeleteEntireKey in Options then if IsDeletableSubkey(S) then UninstLog.AddReg(utRegDeleteEntireKey, RV, RK, [S]); if roUninsDeleteEntireKeyIfEmpty in Options then if IsDeletableSubkey(S) then UninstLog.AddReg(utRegDeleteKeyIfEmpty, RV, RK, [S]); if roUninsDeleteValue in Options then UninstLog.AddReg(utRegDeleteValue, RV, RK, [S, N]); { ^ must add roUninsDeleteValue after roUninstDeleteEntireKey* since the entry may have both the roUninsDeleteValue and roUninsDeleteEntireKeyIfEmpty options } if roUninsClearValue in Options then UninstLog.AddReg(utRegClearValue, RV, RK, [S, N]); NotifyAfterInstallEntry(AfterInstall); end; end; end; { Increment progress meter } IncProgress(1000); end; procedure RegisterFiles; procedure RegisterServersOnRestart; function CreateRegSvrExe(const Dir: String): String; var ExeFilename: String; SourceF, DestF: TFile; NumRead: Cardinal; Buf: array[0..16383] of Byte; begin ExeFilename := GenerateUniqueName(False, Dir, '.exe'); DestF := nil; SourceF := TFile.Create(NewParamStr(0), fdOpenExisting, faRead, fsRead); try DestF := TFile.Create(ExeFilename, fdCreateAlways, faWrite, fsNone); try DestF.Seek64(SourceF.Size); DestF.Truncate; DestF.Seek(0); while True do begin NumRead := SourceF.Read(Buf, SizeOf(Buf)); if NumRead = 0 then Break; DestF.WriteBuffer(Buf, NumRead); end; if not(shSignedUninstaller in SetupHeader.Options) then MarkExeHeader(DestF, SetupExeModeRegSvr); except FreeAndNil(DestF); DeleteFile(ExeFilename); raise; end; finally DestF.Free; SourceF.Free; end; Result := ExeFilename; end; procedure CreateRegSvrMsg(const Filename: String); var F: TFile; begin F := TFile.Create(Filename, fdCreateAlways, faWrite, fsNone); try WriteMsgData(F); finally F.Free; end; end; const Chars: array[Boolean, Boolean] of Char = (('s', 't'), ('S', 'T')); var RegSvrExeFilename: String; F: TTextFileWriter; Rec: PRegisterFilesListRec; RootKey, H: HKEY; I, J: Integer; Disp: DWORD; ValueName, Data: String; ErrorCode: Longint; begin { Create RegSvr program used to register OLE servers & type libraries on the next reboot } if IsAdmin then begin try RegSvrExeFilename := CreateRegSvrExe(WinDir); except { In case Windows directory is write protected, try the Temp directory. Windows directory is our first choice since some people (ignorantly) put things like "DELTREE C:\WINDOWS\TEMP\*.*" in their AUTOEXEC.BAT. Also, each user has his own personal Temp directory which may not be accessible by other users. } RegSvrExeFilename := CreateRegSvrExe(GetTempDir); end; end else begin { Always use Temp directory when user doesn't have admin privileges } RegSvrExeFilename := CreateRegSvrExe(GetTempDir); end; LogFmt('Registration executable created: %s', [RegSvrExeFilename]); try CreateRegSvrMsg(PathChangeExt(RegSvrExeFilename, '.msg')); F := TTextFileWriter.Create(PathChangeExt(RegSvrExeFilename, '.lst'), fdCreateAlways, faWrite, fsNone); try F.WriteLine('; This file was created by the installer for:'); F.WriteLine('; ' + ExpandedAppVerName); F.WriteLine('; Location: ' + SetupLdrOriginalFilename); F.WriteLine(''); F.WriteLine('; List of files to be registered on the next reboot. DO NOT EDIT!'); F.WriteLine(''); for I := 0 to RegisterFilesList.Count-1 do begin Rec := RegisterFilesList[I]; Data := '[..]' + Rec.Filename; Data[2] := Chars[Rec.Is64Bit, Rec.TypeLib]; if Rec.NoErrorMessages then Data[3] := 'q'; F.WriteLine(Data); end; finally F.Free; end; if IsAdmin then RootKey := HKEY_LOCAL_MACHINE else RootKey := HKEY_CURRENT_USER; ErrorCode := RegCreateKeyExView(rvDefault, RootKey, REGSTR_PATH_RUNONCE, 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE or KEY_QUERY_VALUE, nil, H, @Disp); if ErrorCode <> ERROR_SUCCESS then RegError(reRegCreateKeyEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode); try J := 0; while True do begin Inc(J); ValueName := Format('InnoSetupRegFile.%.10d', [J]); { don't localize } { ^ Note: Names of values written to the "RunOnce" key cannot exceed 31 characters! Otherwise the original Windows Explorer 4.0 will not process them. } if not RegValueExists(H, PChar(ValueName)) then begin Data := '"' + RegSvrExeFilename + '" /REG'; if not IsAdmin then Data := Data + 'U'; { /REG -> /REGU when not running as admin } { Note: RegSvr expects /REG(U) to be the first parameter } Data := Data + ' /REGSVRMODE'; ErrorCode := RegSetValueEx(H, PChar(ValueName), 0, REG_SZ, PChar(Data), (Length(Data)+1)*SizeOf(Data[1])); if ErrorCode <> ERROR_SUCCESS then RegError(reRegSetValueEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode); Break; end; end; finally RegCloseKey(H); end; except DeleteFile(PathChangeExt(RegSvrExeFilename, '.lst')); DeleteFile(PathChangeExt(RegSvrExeFilename, '.msg')); DeleteFile(RegSvrExeFilename); raise; end; end; procedure RegisterSvr(const Is64Bit: Boolean; const Filename: String; const NoErrorMessages: Boolean); var NeedToRetry: Boolean; begin repeat if Is64Bit then LogFmt('Registering 64-bit DLL/OCX: %s', [Filename]) else LogFmt('Registering 32-bit DLL/OCX: %s', [Filename]); NeedToRetry := False; try RegisterServer(False, Is64Bit, Filename, NoErrorMessages); Log('Registration successful.'); except Log('Registration failed:' + SNewLine + GetExceptMessage); if not NoErrorMessages then if not AbortRetryIgnoreTaskDialogMsgBox( Filename + SNewLine2 + FmtSetupMessage1(msgErrorRegisterServer, GetExceptMessage), [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreIgnoreNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then NeedToRetry := True; end; until not NeedToRetry; end; procedure RegisterTLib(const Is64Bit: Boolean; const Filename: String; const NoErrorMessages: Boolean); var NeedToRetry: Boolean; begin repeat if Is64Bit then LogFmt('Registering 64-bit type library: %s', [Filename]) else LogFmt('Registering 32-bit type library: %s', [Filename]); NeedToRetry := False; try if Is64Bit then HelperRegisterTypeLibrary(False, Filename) else RegisterTypeLibrary(Filename); Log('Registration successful.'); except Log('Registration failed:' + SNewLine + GetExceptMessage); if not NoErrorMessages then if not AbortRetryIgnoreTaskDialogMsgBox( Filename + SNewLine2 + FmtSetupMessage1(msgErrorRegisterTypeLib, GetExceptMessage), [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreIgnoreNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then NeedToRetry := True; end; until not NeedToRetry; end; var I: Integer; begin if not NeedsRestart then for I := 0 to RegisterFilesList.Count-1 do begin with PRegisterFilesListRec(RegisterFilesList[I])^ do if not TypeLib then RegisterSvr(Is64Bit, Filename, NoErrorMessages) else RegisterTLib(Is64Bit, Filename, NoErrorMessages); end else begin { When a restart is needed, all "regserver" & "regtypelib" files will get registered on the next logon } Log('Delaying registration of all files until the next logon since a restart is needed.'); try RegisterServersOnRestart; except Application.HandleException(nil); end; end; end; procedure ProcessInstallDeleteEntries; var I: Integer; begin 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 DebugNotifyEntry(seInstallDelete, I); NotifyBeforeInstallEntry(BeforeInstall); case DeleteType of dfFiles, dfFilesAndOrSubdirs: DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), False, True, DeleteType = dfFilesAndOrSubdirs, False, nil, nil, nil); dfDirIfEmpty: DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), True, False, False, False, nil, nil, nil); end; NotifyAfterInstallEntry(AfterInstall); end; end; procedure RecordUninstallDeleteEntries; const DefFlags: array[TSetupDeleteType] of Longint = ( utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_DeleteFiles, utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_DeleteFiles or utDeleteDirOrFiles_DeleteSubdirsAlso, utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_IsDir); var I: Integer; Flags: Longint; begin for I := Entries[seUninstallDelete].Count-1 downto 0 do { ^ process backwards so the uninstaller will process them in the order they appear in the script } with PSetupDeleteEntry(Entries[seUninstallDelete][I])^ do if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin DebugNotifyEntry(seUninstallDelete, I); NotifyBeforeInstallEntry(BeforeInstall); Flags := DefFlags[DeleteType]; if InstallDefaultDisableFsRedir then Flags := Flags or utDeleteDirOrFiles_DisableFsRedir; UninstLog.Add(utDeleteDirOrFiles, [ExpandConst(Name)], Flags); NotifyAfterInstallEntry(AfterInstall); end; end; procedure RecordUninstallRunEntries; var I: Integer; RunEntry: PSetupRunEntry; Flags: Longint; begin for I := Entries[seUninstallRun].Count-1 downto 0 do begin { ^ process backwards so the uninstaller will process them in the order they appear in the script } RunEntry := PSetupRunEntry(Entries[seUninstallRun][I]); if ShouldProcessEntry(WizardComponents, WizardTasks, RunEntry.Components, RunEntry.Tasks, RunEntry.Languages, RunEntry.Check) then begin DebugNotifyEntry(seUninstallRun, I); NotifyBeforeInstallEntry(RunEntry.BeforeInstall); Flags := 0; case RunEntry.Wait of rwNoWait: Flags := Flags or utRun_NoWait; rwWaitUntilIdle: Flags := Flags or utRun_WaitUntilIdle; end; if roShellExec in RunEntry.Options then Flags := Flags or (utRun_ShellExec or utRun_ShellExecRespectWaitFlags) else begin if ShouldDisableFsRedirForRunEntry(RunEntry) then Flags := Flags or utRun_DisableFsRedir; end; if roSkipIfDoesntExist in RunEntry.Options then Flags := Flags or utRun_SkipIfDoesntExist; case RunEntry.ShowCmd of SW_SHOWMINNOACTIVE: Flags := Flags or utRun_RunMinimized; SW_SHOWMAXIMIZED: Flags := Flags or utRun_RunMaximized; SW_HIDE: Flags := Flags or utRun_RunHidden; end; if roDontLogParameters in RunEntry.Options then Flags := Flags or utRun_DontLogParameters; if roLogOutput in RunEntry.Options then Flags := Flags or utRun_LogOutput; UninstLog.Add(utRun, [ExpandConst(RunEntry.Name), ExpandConst(RunEntry.Parameters), ExpandConst(RunEntry.WorkingDir), ExpandConst(RunEntry.RunOnceId), ExpandConst(RunEntry.Verb)], Flags); NotifyAfterInstallEntry(RunEntry.AfterInstall); end; end; end; procedure GenerateUninstallInfoFilename; var ExistingFiles: array[0..999] of Boolean; BaseDir: String; procedure FindFiles; var H: THandle; FindData: TWin32FindData; S: String; begin H := FindFirstFile(PChar(AddBackslash(BaseDir) + 'unins???.*'), FindData); if H <> INVALID_HANDLE_VALUE then begin repeat S := FindData.cFilename; if (Length(S) >= 9) and (CompareText(Copy(S, 1, 5), 'unins') = 0) and CharInSet(S[6], ['0'..'9']) and CharInSet(S[7], ['0'..'9']) and CharInSet(S[8], ['0'..'9']) and (S[9] = '.') then ExistingFiles[StrToInt(Copy(S, 6, 3))] := True; until not FindNextFile(H, FindData); Windows.FindClose(H); end; end; procedure GenerateFilenames(const I: Integer); var BaseFilename: String; begin BaseFilename := AddBackslash(BaseDir) + Format('unins%.3d', [I]); UninstallExeFilename := BaseFilename + '.exe'; UninstallDataFilename := BaseFilename + '.dat'; UninstallMsgFilename := BaseFilename + '.msg'; end; procedure ReserveDataFile; var H: THandle; begin { Create an empty .dat file to reserve the filename. } H := CreateFile(PChar(UninstallDataFilename), GENERIC_READ or GENERIC_WRITE, 0, nil, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0); if H = INVALID_HANDLE_VALUE then Win32ErrorMsg('CreateFile'); CloseHandle(H); UninstallDataCreated := True; end; var I: Integer; ExistingFlags: TUninstallLogFlags; begin { Note: We never disable FS redirection when writing to UninstallFilesDir. If someone sets UninstallFilesDir to "sys", we can't place a 32-bit uninstaller in the 64-bit system directory, because it wouldn't see its .dat file -- it would try to open 'windows\system32\unins???.dat' but fail because system32 maps to syswow64 by default. Not to mention, 32-bit EXEs really have no business being in the 64-bit system directory, and vice versa. Might result in undefined behavior? } { Because we don't disable FS redirection, we have to change any system32 to syswow64, otherwise Add/Remove Programs would look for the UninstallString executable in the 64-bit system directory (at least when using a 64-bit Uninstall key) } BaseDir := ReplaceSystemDirWithSysWow64(PathExpand(ExpandConst(SetupHeader.UninstallFilesDir))); LogFmt('Directory for uninstall files: %s', [BaseDir]); MakeDir(False, BaseDir, []); FillChar(ExistingFiles, SizeOf(ExistingFiles), 0); { set all to False } FindFiles; { Look for an existing .dat file to append to or overwrite } if SetupHeader.UninstallLogMode <> lmNew then for I := 0 to 999 do if ExistingFiles[I] then begin GenerateFilenames(I); if NewFileExists(UninstallDataFilename) and UninstLog.CanAppend(UninstallDataFilename, ExistingFlags) then begin if SetupHeader.UninstallLogMode = lmAppend then begin LogFmt('Will append to existing uninstall log: %s', [UninstallDataFilename]); AppendUninstallData := True; end else LogFmt('Will overwrite existing uninstall log: %s', [UninstallDataFilename]); Exit; end; end; { None found; use a new .dat file } for I := 0 to 999 do if not ExistingFiles[I] then begin GenerateFilenames(I); LogFmt('Creating new uninstall log: %s', [UninstallDataFilename]); ReserveDataFile; Exit; end; raise Exception.Create(FmtSetupMessage1(msgErrorTooManyFilesInDir, BaseDir)); end; procedure RenameUninstallExe; begin { If the uninstall EXE wasn't extracted to a .tmp file because it isn't replacing an existing uninstall EXE, exit. } if UninstallTempExeFilename = '' then Exit; Log('Renaming uninstaller.'); var Timer: TOneShotTimer; var RetriesLeft := 4; while True do begin Timer.Start(1000); if MoveFileReplace(UninstallTempExeFilename, UninstallExeFilename) then Break; var LastError := GetLastError; { Does the error code indicate that the file is possibly in use? } if LastErrorIndicatesPossiblyInUse(LastError, False) then begin if RetriesLeft > 0 then begin LogFmt('The existing file appears to be in use (%d). ' + 'Retrying.', [LastError]); Dec(RetriesLeft); Timer.SleepUntilExpired; ProcessEvents; Continue; end; end; case LoggedMsgBox(UninstallExeFilename + SNewLine2 + SetupMessages[msgErrorReplacingExistingFile] + SNewLine2 + AddPeriod(FmtSetupMessage(msgErrorFunctionFailedWithMessage, ['MoveFileEx', IntToStr(LastError), Win32ErrorString(LastError)])), '', mbError, MB_RETRYCANCEL, True, IDCANCEL) of IDRETRY: ; IDCANCEL: Abort; else Log('LoggedMsgBox returned an unexpected value. Assuming Cancel.'); Abort; end; end; UninstallTempExeFilename := ''; end; procedure CreateUninstallMsgFile; { If the uninstaller EXE has a digital signature, or if Setup was started with /DETACHEDMSG, create the unins???.msg file } var F: TFile; begin { If this installation didn't create or replace an unins???.exe file, do nothing } if (UninstallExeCreated <> ueNone) and ((shSignedUninstaller in SetupHeader.Options) or DetachedUninstMsgFile) then begin LogFmt('Writing uninstaller messages: %s', [UninstallMsgFilename]); F := TFile.Create(UninstallMsgFilename, fdCreateAlways, faWrite, fsNone); try if UninstallExeCreated = ueNew then UninstallMsgCreated := True; WriteMsgData(F); finally F.Free; end; end; end; procedure ProcessNeedRestartEvent; begin if (CodeRunner <> nil) and CodeRunner.FunctionExists('NeedRestart', True) then begin if not NeedsRestart then begin try if CodeRunner.RunBooleanFunctions('NeedRestart', [''], bcTrue, False, False) then begin NeedsRestart := True; Log('Will restart because NeedRestart returned True.'); end; except Log('NeedRestart raised an exception.'); Application.HandleException(nil); end; end else Log('Not calling NeedRestart because a restart has already been deemed necessary.'); end; end; procedure ProcessComponentEntries; var I: Integer; begin for I := 0 to Entries[seComponent].Count-1 do begin with PSetupComponentEntry(Entries[seComponent][I])^ do begin if ShouldProcessEntry(WizardComponents, nil, Name, '', Languages, '') and (coRestart in Options) then begin NeedsRestart := True; Break; end; end; end; end; procedure ProcessTasksEntries; var I: Integer; begin for I := 0 to Entries[seTask].Count-1 do begin with PSetupTaskEntry(Entries[seTask][I])^ do begin if ShouldProcessEntry(nil, WizardTasks, '', Name, Languages, '') and (toRestart in Options) then begin NeedsRestart := True; Break; end; end; end; end; procedure ShutdownApplications; const ERROR_FAIL_SHUTDOWN = 351; ForcedStrings: array [Boolean] of String = ('', ' (forced)'); ForcedActionFlag: array [Boolean] of ULONG = (0, RmForceShutdown); var Forced: Boolean; Error: DWORD; begin Forced := InitForceCloseApplications or ((shForceCloseApplications in SetupHeader.Options) and not InitNoForceCloseApplications); Log('Shutting down applications using our files.' + ForcedStrings[Forced]); RmDoRestart := True; Error := RmShutdown(RmSessionHandle, ForcedActionFlag[Forced], nil); while Error = ERROR_FAIL_SHUTDOWN do begin Log('Some applications could not be shut down.'); if AbortRetryIgnoreTaskDialogMsgBox( SetupMessages[msgErrorCloseApplications], [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then Break; Log('Retrying to shut down applications using our files.' + ForcedStrings[Forced]); Error := RmShutdown(RmSessionHandle, ForcedActionFlag[Forced], nil); end; { Close session on all errors except for ERROR_FAIL_SHUTDOWN, should still call RmRestart in that case. } if (Error <> ERROR_SUCCESS) and (Error <> ERROR_FAIL_SHUTDOWN) then begin RmEndSession(RmSessionHandle); LogFmt('RmShutdown returned an error: %d', [Error]); RmDoRestart := False; end; end; var Uninstallable, UninstLogCleared: Boolean; I: Integer; UninstallRegKeyBaseName: String; InstallFilesSize, AfterInstallFilesSize: Integer64; begin Succeeded := False; Log('Starting the installation process.'); SetCurrentDir(WinSystemDir); CalcFilesSize(InstallFilesSize, AfterInstallFilesSize); InitProgressGauge(InstallFilesSize); UninstallExeCreated := ueNone; UninstallDataCreated := False; UninstallMsgCreated := False; AppendUninstallData := False; UninstLogCleared := False; RegisterFilesList := nil; UninstLog := TSetupUninstallLog.Create; try try { Get AppId, UninstallRegKeyBaseName, and Uninstallable now so the user can't change them while we're installing } ExpandedAppId := ExpandConst(SetupHeader.AppId); if ExpandedAppId = '' then InternalError('Failed to get a non empty installation "AppId"'); if TUninstallLog.WriteSafeHeaderString(nil, ExpandedAppId, 0) > 128 then InternalError('"AppId" cannot exceed 128 bytes (encoded)'); UninstallRegKeyBaseName := GetUninstallRegKeyBaseName(ExpandedAppId); Uninstallable := EvalDirectiveCheck(SetupHeader.Uninstallable); { Init } UninstLog.InstallMode64Bit := Is64BitInstallMode; UninstLog.AppName := ExpandedAppName; UninstLog.AppId := ExpandedAppId; if IsAdminInstallMode then Include(UninstLog.Flags, ufAdminInstallMode); if IsWin64 then Include(UninstLog.Flags, ufWin64); if IsAdmin then { Setup or [Code] might have done administrative actions, even if IsAdminInstallMode is False } Include(UninstLog.Flags, ufAdminInstalled) else if IsPowerUserOrAdmin then { Note: This flag is only set in 5.1.9 and later } Include(UninstLog.Flags, ufPowerUserInstalled); if SetupHeader.WizardStyle = wsModern then Include(UninstLog.Flags, ufModernStyle); if shUninstallRestartComputer in SetupHeader.Options then Include(UninstLog.Flags, ufAlwaysRestart); if ChangesEnvironment then Include(UninstLog.Flags, ufChangesEnvironment); RecordStartInstall; RecordCompiledCode; RegisterFilesList := TList.Create; { Process Component entries, if any } ProcessComponentEntries; ProcessEvents; { Process Tasks entries, if any } ProcessTasksEntries; ProcessEvents; { Shutdown applications, if any } if RmSessionStarted and RmFoundApplications then begin if WizardPreparingYesRadio then begin SetStatusLabelText(SetupMessages[msgStatusClosingApplications]); ShutdownApplications; ProcessEvents; end else Log('User chose not to shutdown applications using our files.'); end; { Process InstallDelete entries, if any } ProcessInstallDeleteEntries; ProcessEvents; if ExpandedAppMutex <> '' then UninstLog.Add(utMutexCheck, [ExpandedAppMutex], 0); if ChangesAssociations then UninstLog.Add(utRefreshFileAssoc, [''], 0); { Record UninstallDelete entries, if any } RecordUninstallDeleteEntries; ProcessEvents; { Create the application directory and extra dirs } SetStatusLabelText(SetupMessages[msgStatusCreateDirs]); CreateDirs; ProcessEvents; if Uninstallable then begin { Generate the filenames for the uninstall info in the application directory } SetStatusLabelText(SetupMessages[msgStatusSavingUninstall]); GenerateUninstallInfoFilename; end; { Copy the files } SetStatusLabelText(SetupMessages[msgStatusExtractFiles]); CopyFiles(Uninstallable); ProcessEvents; { Create program icons, if any } if HasIcons then begin SetStatusLabelText(SetupMessages[msgStatusCreateIcons]); CreateIcons; ProcessEvents; end; { Create INI entries, if any } if Entries[seIni].Count <> 0 then begin SetStatusLabelText(SetupMessages[msgStatusCreateIniEntries]); CreateIniEntries; ProcessEvents; end; { Create registry entries, if any } if Entries[seRegistry].Count <> 0 then begin SetStatusLabelText(SetupMessages[msgStatusCreateRegistryEntries]); CreateRegistryEntries; ProcessEvents; end; { Call the NeedRestart event function now. Note: This can't be done after RegisterFiles, since RegisterFiles relies on the setting of the NeedsRestart variable. } SetStatusLabelText(''); ProcessNeedRestartEvent; ProcessEvents; { Register files, if any } if RegisterFilesList.Count <> 0 then begin SetStatusLabelText(SetupMessages[msgStatusRegisterFiles]); RegisterFiles; ProcessEvents; end; { Save uninstall information. After uninstall info is saved, you cannot make any more modifications to the user's system. Any additional modifications you want to add must be done before this is called. } if Uninstallable then begin SetStatusLabelText(SetupMessages[msgStatusSavingUninstall]); Log('Saving uninstall information.'); RenameUninstallExe; CreateUninstallMsgFile; { Register uninstall information so the program can be uninstalled through the Add/Remove Programs Control Panel applet. This is done on NT 3.51 too, so that the uninstall entry for the app will appear if the user later upgrades to NT 4.0+. } if EvalDirectiveCheck(SetupHeader.CreateUninstallRegKey) then RegisterUninstallInfo(UninstallRegKeyBaseName, AfterInstallFilesSize); RecordUninstallRunEntries; UninstLog.Add(utEndInstall, [GetLocalTimeAsStr], 0); UninstLog.Save(UninstallDataFilename, AppendUninstallData, shUpdateUninstallLogAppName in SetupHeader.Options); if Debugging then DebugNotifyUninstExe(UninstallExeFileName); end; SetStatusLabelText(''); UninstLogCleared := True; UninstLog.Clear; except try { Show error message, if any, and set the exit code we'll be returning } if not(ExceptObject is EAbort) then begin Log(Format('Fatal exception during installation process (%s):' + SNewLine, [ExceptObject.ClassName]) + GetExceptMessage); SetupExitCode := ecInstallationError; Application.HandleException(nil); LoggedMsgBox(SetupMessages[msgSetupAborted], '', mbCriticalError, MB_OK, True, IDOK); end else begin Log('User canceled the installation process.'); SetupExitCode := ecInstallationCancelled; end; { Undo any changes it's made so far } if not UninstLogCleared then begin Log('Rolling back changes.'); try SetStatusLabelText(SetupMessages[msgStatusRollback]); WizardForm.ProgressGauge.Visible := False; FinishProgressGauge(True); WizardForm.CancelButton.Enabled := False; WizardForm.Update; except { ignore any exceptions, just in case... } end; if UninstallTempExeFilename <> '' then DeleteFile(UninstallTempExeFilename); if UninstallExeCreated = ueNew then DeleteFile(UninstallExeFilename); if UninstallDataCreated then DeleteFile(UninstallDataFilename); if UninstallMsgCreated then DeleteFile(UninstallMsgFilename); UninstLog.PerformUninstall(False, nil); { Sleep for a bit so that the user has time to read the "Rolling back changes" message } if WizardForm.Visible then Sleep(1500); end; except { No exception should be generated by the above code, but just in case, handle any exception now so that Application.Terminate is always called below. Note that we can't just put Application.Terminate in a finally section, because it would prevent the display of an exception message box later (MessageBox() dislikes WM_QUIT). } Application.HandleException(nil); end; Exit; end; finally if Assigned(RegisterFilesList) then begin for I := RegisterFilesList.Count-1 downto 0 do Dispose(PRegisterFilesListRec(RegisterFilesList[I])); RegisterFilesList.Free; end; UninstLog.Free; FinishProgressGauge(False); end; Log('Installation process succeeded.'); Succeeded := True; end; procedure InternalExtractTemporaryFile(const DestName: String; const CurFile: PSetupFileEntry; const CurFileLocation: PSetupFileLocationEntry; const CreateDirs: Boolean); var DestFile: String; DestF: TFile; CurFileDate: TFileTime; begin DestFile := AddBackslash(TempInstallDir) + DestName; Log('Extracting temporary file: ' + DestFile); { Does not disable FS redirection, like everything else working on the temp dir } if CreateDirs then ForceDirectories(False, PathExtractPath(DestFile)); DestF := TFile.Create(DestFile, fdCreateAlways, faWrite, fsNone); try try FileExtractor.SeekTo(CurFileLocation^, nil); FileExtractor.DecompressFile(CurFileLocation^, DestF, nil, not (foDontVerifyChecksum in CurFile^.Options)); if floTimeStampInUTC in CurFileLocation^.Flags then CurFileDate := CurFileLocation^.SourceTimeStamp else LocalFileTimeToFileTime(CurFileLocation^.SourceTimeStamp, CurFileDate); SetFileTime(DestF.Handle, nil, nil, @CurFileDate); finally DestF.Free; end; except DeleteFile(DestFile); raise; end; AddAttributesToFile(False, DestFile, CurFile^.Attribs); end; procedure ExtractTemporaryFile(const BaseName: String); function EscapeBraces(const S: String): String; { Changes all '{' to '{{'. Uses ConstLeadBytes^ for the lead byte table. } var I: Integer; begin Result := S; I := 1; while I <= Length(Result) do begin if Result[I] = '{' then begin Insert('{', Result, I); Inc(I); end; Inc(I); end; end; var EscapedBaseName: String; CurFileNumber: Integer; CurFile: PSetupFileEntry; begin { We compare BaseName to the filename portion of TSetupFileEntry.DestName which has braces escaped, but BaseName does not; escape it to match } EscapedBaseName := EscapeBraces(BaseName); for CurFileNumber := 0 to Entries[seFile].Count-1 do begin CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]); if (CurFile^.LocationEntry <> -1) and (CompareText(PathExtractName(CurFile^.DestName), EscapedBaseName) = 0) then begin InternalExtractTemporaryFile(BaseName, CurFile, Entries[seFileLocation][CurFile^.LocationEntry], False); Exit; end; end; InternalErrorFmt('ExtractTemporaryFile: The file "%s" was not found', [BaseName]); end; function ExtractTemporaryFiles(const Pattern: String): Integer; var LowerPattern, DestName: String; CurFileNumber: Integer; CurFile: PSetupFileEntry; begin if Length(Pattern) >= MAX_PATH then InternalError('ExtractTemporaryFiles: Pattern too long'); LowerPattern := PathLowercase(Pattern); Result := 0; for CurFileNumber := 0 to Entries[seFile].Count-1 do begin CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]); if CurFile^.LocationEntry <> -1 then begin { Use ExpandConstEx2 to unescape any braces not in an embedded constant, while leaving constants unexpanded } DestName := ExpandConstEx2(CurFile^.DestName, [''], False); if WildcardMatch(PChar(PathLowercase(DestName)), PChar(LowerPattern)) then begin Delete(DestName, 1, PathDrivePartLengthEx(DestName, True)); { Remove any drive part } if Pos('{tmp}\', DestName) = 1 then Delete(DestName, 1, Length('{tmp}\')); if Pos(':', DestName) <> 0 then InternalError('ExtractTemporaryFiles: Invalid character in matched file name'); InternalExtractTemporaryFile(DestName, CurFile, Entries[seFileLocation][CurFile^.LocationEntry], True); Inc(Result); end; end; end; if Result = 0 then InternalErrorFmt('ExtractTemporaryFiles: No files matching "%s" found', [Pattern]); end; type THTTPDataReceiver = class private FBaseName, FUrl: String; FOnDownloadProgress: TOnDownloadProgress; FOnSimpleDownloadProgress: TOnSimpleDownloadProgress; FOnSimpleDownloadProgressParam: Integer64; FAborted: Boolean; FProgress, FProgressMax: Int64; FLastReportedProgress, FLastReportedProgressMax: Int64; public property BaseName: String write FBaseName; property Url: String write FUrl; property OnDownloadProgress: TOnDownloadProgress write FOnDownloadProgress; property OnSimpleDownloadProgress: TOnSimpleDownloadProgress write FOnSimpleDownloadProgress; property OnSimpleDownloadProgressParam: Integer64 write FOnSimpleDownloadProgressParam; property Aborted: Boolean read FAborted; property Progress: Int64 read FProgress; property ProgressMax: Int64 read FProgressMax; procedure OnReceiveData(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean); end; procedure THTTPDataReceiver.OnReceiveData(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean); begin FProgress := AReadCount; FProgressMax := AContentLength; if Assigned(FOnDownloadProgress) then begin { Make sure script isn't called crazy often because that would slow the download significantly. Only report: -At start or finish -Or if somehow Progress decreased or Max changed -Or if at least 512 KB progress was made since last report } if (FProgress = 0) or (FProgress = FProgressMax) or (FProgress < FLastReportedProgress) or (FProgressMax <> FLastReportedProgressMax) or ((FProgress - FLastReportedProgress) > 524288) then begin try if not FOnDownloadProgress(FUrl, FBaseName, FProgress, FProgressMax) then Abort := True; finally FLastReportedProgress := FProgress; FLastReportedProgressMax := FProgressMax; end; end; if not Abort and DownloadTemporaryFileOrExtractArchiveProcessMessages then Application.ProcessMessages; if Abort then FAborted := True end else if Assigned(FOnSimpleDownloadProgress) then begin try FOnSimpleDownloadProgress(Integer64(Progress-FLastReportedProgress), FOnSimpleDownloadProgressParam); except if ExceptObject is EAbort then begin Abort := True; FAborted := True; end else raise; end; FLastReportedProgress := Progress; end; end; procedure SetUserAgentAndSecureProtocols(const AHTTPClient: THTTPClient); begin AHTTPClient.UserAgent := SetupTitle + ' ' + SetupVersion; { TLS 1.2 isn't enabled by default on older versions of Windows } AHTTPClient.SecureProtocols := [THTTPSecureProtocol.TLS1, THTTPSecureProtocol.TLS11, THTTPSecureProtocol.TLS12]; end; function MaskPasswordInUrl(const Url: String): String; var Uri: TUri; begin Uri := TUri.Create(Url); if Uri.Password <> '' then begin Uri.Password := '***'; Result := Uri.ToString; end else Result := URL; end; var DownloadTemporaryFileUser, DownloadTemporaryFilePass: String; procedure SetDownloadTemporaryFileCredentials(const User, Pass: String); begin DownloadTemporaryFileUser := User; DownloadTemporaryFilePass := Pass; end; function GetCredentialsAndCleanUrl(const Url, CustomUser, CustomPass: String; var User, Pass, CleanUrl: String) : Boolean; begin const Uri = TUri.Create(Url); { This is a record so no need to free } if CustomUser = '' then User := TNetEncoding.URL.Decode(Uri.Username) else User := CustomUser; if CustomPass = '' then Pass := TNetEncoding.URL.Decode(Uri.Password, [TURLEncoding.TDecodeOption.PlusAsSpaces]) else Pass := CustomPass; Uri.Username := ''; Uri.Password := ''; CleanUrl := Uri.ToString; Result := (User <> '') or (Pass <> ''); if Result then LogFmt('Download is using basic authentication: %s, ***', [User]) else Log('Download is not using basic authentication'); end; function GetISSigUrl(const Url, ISSigUrl: String): String; begin if ISSigUrl <> '' then Result := ISSigUrl else begin const Uri = TUri.Create(Url); { This is a record so no need to free } Uri.Path := Uri.Path + ISSigExt; Result := Uri.ToString; end; end; function DownloadFile(const Url, CustomUserName, CustomPassword: String; const DestF: TFile; [ref] const Verification: TSetupFileVerification; const ISSigSourceFilename: String; const OnSimpleDownloadProgress: TOnSimpleDownloadProgress; const OnSimpleDownloadProgressParam: Integer64): Int64; var HandleStream: THandleStream; HTTPDataReceiver: THTTPDataReceiver; HTTPClient: THTTPClient; HTTPResponse: IHTTPResponse; User, Pass, CleanUrl: String; HasCredentials : Boolean; begin if Url = '' then InternalError('DownloadFile: Invalid Url value'); LogFmt('Downloading file from %s', [MaskPasswordInURL(Url)]); HTTPDataReceiver := nil; HTTPClient := nil; HandleStream := nil; try HasCredentials := GetCredentialsAndCleanUrl(URL, CustomUserName, CustomPassword, User, Pass, CleanUrl); { Setup downloader } HTTPDataReceiver := THTTPDataReceiver.Create; HTTPDataReceiver.Url := CleanUrl; HTTPDataReceiver.OnSimpleDownloadProgress := OnSimpleDownloadProgress; HTTPDataReceiver.OnSimpleDownloadProgressParam := OnSimpleDownloadProgressParam; HTTPClient := THTTPClient.Create; { http://docwiki.embarcadero.com/RADStudio/Rio/en/Using_an_HTTP_Client } SetUserAgentAndSecureProtocols(HTTPClient); HTTPClient.OnReceiveData := HTTPDataReceiver.OnReceiveData; { Download to specified handle } HandleStream := THandleStream.Create(DestF.Handle); if HasCredentials then begin const Base64 = TBase64Encoding.Create(0); try HTTPClient.CustomHeaders['Authorization'] := 'Basic ' + Base64.Encode(User + ':' + Pass); finally Base64.Free; end; end; HTTPResponse := HTTPClient.Get(CleanUrl, HandleStream); Result := 0; { silence compiler } if HTTPDataReceiver.Aborted then Abort else if (HTTPResponse.StatusCode < 200) or (HTTPResponse.StatusCode > 299) then raise Exception.Create(Format('%d %s', [HTTPResponse.StatusCode, HTTPResponse.StatusText])) else begin { Download completed, get size and close it } Result := HandleStream.Size; FreeAndNil(HandleStream); { Check verification if specified, otherwise check everything else we can check } if Verification.Typ <> fvNone then begin var ExpectedFileHash: TSHA256Digest; if Verification.Typ = fvHash then ExpectedFileHash := Verification.Hash else DoISSigVerify(DestF, nil, ISSigSourceFilename, Verification.ISSigAllowedKeys, ExpectedFileHash); const FileHash = GetSHA256OfFile(DestF); if not SHA256DigestsEqual(FileHash, ExpectedFileHash) then VerificationError(veFileHashIncorrect); Log(VerificationSuccessfulLogMessage); end else begin if HTTPDataReceiver.ProgressMax > 0 then begin if HTTPDataReceiver.Progress <> HTTPDataReceiver.ProgressMax then raise Exception.Create(FmtSetupMessage(msgErrorProgress, [IntToStr(HTTPDataReceiver.Progress), IntToStr(HTTPDataReceiver.ProgressMax)])) else if HTTPDataReceiver.ProgressMax <> Result then raise Exception.Create(FmtSetupMessage(msgErrorFileSize, [IntToStr(HTTPDataReceiver.ProgressMax), IntToStr(Result)])); end; end; end; finally HandleStream.Free; HTTPClient.Free; HTTPDataReceiver.Free; end; end; function DownloadTemporaryFile(const Url, BaseName: String; [ref] const Verification: TSetupFileVerification; const OnDownloadProgress: TOnDownloadProgress): Int64; var DestFile, TempFile: String; TempF: TFile; HandleStream: THandleStream; TempFileLeftOver: Boolean; HTTPDataReceiver: THTTPDataReceiver; HTTPClient: THTTPClient; HTTPResponse: IHTTPResponse; RetriesLeft: Integer; LastError: DWORD; User, Pass, CleanUrl: String; HasCredentials : Boolean; begin if Url = '' then InternalError('DownloadTemporaryFile: Invalid Url value'); if BaseName = '' then InternalError('DownloadTemporaryFile: Invalid BaseName value'); DestFile := AddBackslash(TempInstallDir) + BaseName; LogFmt('Downloading temporary file from %s: %s', [MaskPasswordInURL(Url), DestFile]); { Does not disable FS redirection, like everything else working on the temp dir } { Prepare directory } if NewFileExists(DestFile) then begin if Verification.Typ = fvHash then begin if SHA256DigestsEqual(GetSHA256OfFile(False, DestFile), Verification.Hash) then begin Log(' File already downloaded.'); Result := 0; Exit; end; end else if Verification.Typ = fvISSig then begin var ExistingFileSize: Int64; var ExistingFileHash: TSHA256Digest; if ISSigVerifySignature(DestFile, GetISSigAllowedKeys(ISSigAvailableKeys, Verification.ISSigAllowedKeys), ExistingFileSize, ExistingFileHash, nil, nil, nil) then begin const DestF = TFile.Create(DestFile, fdOpenExisting, faRead, fsReadWrite); try if (Int64(DestF.Size) = ExistingFileSize) and (SHA256DigestsEqual(GetSHA256OfFile(DestF), ExistingFileHash)) then begin Log(' File already downloaded.'); Result := 0; Exit; end; finally DestF.Free; end; end; end; SetFileAttributes(PChar(DestFile), GetFileAttributes(PChar(DestFile)) and not FILE_ATTRIBUTE_READONLY); DelayDeleteFile(False, DestFile, 13, 50, 250); end else ForceDirectories(False, PathExtractPath(DestFile)); HTTPDataReceiver := nil; HTTPClient := nil; TempF := nil; TempFileLeftOver := False; HandleStream := nil; try HasCredentials := GetCredentialsAndCleanUrl(URL, DownloadTemporaryFileUser, DownloadTemporaryFilePass, User, Pass, CleanUrl); { Setup downloader } HTTPDataReceiver := THTTPDataReceiver.Create; HTTPDataReceiver.BaseName := BaseName; HTTPDataReceiver.Url := CleanUrl; HTTPDataReceiver.OnDownloadProgress := OnDownloadProgress; HTTPClient := THTTPClient.Create; { http://docwiki.embarcadero.com/RADStudio/Rio/en/Using_an_HTTP_Client } SetUserAgentAndSecureProtocols(HTTPClient); HTTPClient.OnReceiveData := HTTPDataReceiver.OnReceiveData; { Create temporary file } TempFile := GenerateUniqueName(False, PathExtractPath(DestFile), '.tmp'); TempF := TFile.Create(TempFile, fdCreateAlways, faWrite, fsNone); TempFileLeftOver := True; { To test redirects: https://jrsoftware.org/download.php/is.exe To test expired certificates: https://expired.badssl.com/ To test self-signed certificates: https://self-signed.badssl.com/ To test basic authentication: https://guest:guest@jigsaw.w3.org/HTTP/Basic/ To test 100 MB file: https://speed.hetzner.de/100MB.bin To test 1 GB file: https://speed.hetzner.de/1GB.bin To test file without a content length: https://github.com/jrsoftware/issrc/archive/main.zip } { Download to temporary file} HandleStream := THandleStream.Create(TempF.Handle); if HasCredentials then begin const Base64 = TBase64Encoding.Create(0); try HTTPClient.CustomHeaders['Authorization'] := 'Basic ' + Base64.Encode(User + ':' + Pass); finally Base64.Free; end; end; HTTPResponse := HTTPClient.Get(CleanUrl, HandleStream); if HTTPDataReceiver.Aborted then raise Exception.Create(SetupMessages[msgErrorDownloadAborted]) else if (HTTPResponse.StatusCode < 200) or (HTTPResponse.StatusCode > 299) then raise Exception.Create(FmtSetupMessage(msgErrorDownloadFailed, [IntToStr(HTTPResponse.StatusCode), HTTPResponse.StatusText])) else begin { Download completed, get size and close it } Result := HandleStream.Size; FreeAndNil(HandleStream); { Check verification if specified, otherwise check everything else we can check } if Verification.Typ <> fvNone then begin var ExpectedFileHash: TSHA256Digest; if Verification.Typ = fvHash then ExpectedFileHash := Verification.Hash else DoISSigVerify(TempF, nil, DestFile, Verification.ISSigAllowedKeys, ExpectedFileHash); FreeAndNil(TempF); const FileHash = GetSHA256OfFile(False, TempFile); if not SHA256DigestsEqual(FileHash, ExpectedFileHash) then VerificationError(veFileHashIncorrect); Log(VerificationSuccessfulLogMessage); end else begin FreeAndNil(TempF); if HTTPDataReceiver.ProgressMax > 0 then begin if HTTPDataReceiver.Progress <> HTTPDataReceiver.ProgressMax then raise Exception.Create(FmtSetupMessage(msgErrorProgress, [IntToStr(HTTPDataReceiver.Progress), IntToStr(HTTPDataReceiver.ProgressMax)])) else if HTTPDataReceiver.ProgressMax <> Result then raise Exception.Create(FmtSetupMessage(msgErrorFileSize, [IntToStr(HTTPDataReceiver.ProgressMax), IntToStr(Result)])); end; end; { Rename the temporary file to the new name now, with retries if needed } RetriesLeft := 4; while not MoveFile(PChar(TempFile), PChar(DestFile)) do begin { Couldn't rename the temporary file... } LastError := GetLastError; { Does the error code indicate that it is possibly in use? } if LastErrorIndicatesPossiblyInUse(LastError, True) then begin LogFmt(' The existing file appears to be in use (%d). ' + 'Retrying.', [LastError]); Dec(RetriesLeft); Sleep(1000); if RetriesLeft > 0 then Continue; end; { Some other error occurred, or we ran out of tries } SetLastError(LastError); Win32ErrorMsg('MoveFile'); { Throws an exception } end; TempFileLeftOver := False; end; finally HandleStream.Free; TempF.Free; HTTPClient.Free; HTTPDataReceiver.Free; if TempFileLeftOver then DeleteFile(TempFile); end; end; procedure DownloadTemporaryFileSizeAndDate(const Url: String; var FileSize: Int64; var FileDate: String); var HTTPClient: THTTPClient; HTTPResponse: IHTTPResponse; User, Pass, CleanUrl: string; HasCredentials : Boolean; Base64: TBase64Encoding; begin HTTPClient := THTTPClient.Create; Base64 := nil; try HasCredentials := GetCredentialsAndCleanUrl(Url, DownloadTemporaryFileUser, DownloadTemporaryFilePass, User, Pass, CleanUrl); if HasCredentials then begin Base64 := TBase64Encoding.Create(0); HTTPClient.CustomHeaders['Authorization'] := 'Basic ' + Base64.Encode(User + ':' + Pass); end; SetUserAgentAndSecureProtocols(HTTPClient); HTTPResponse := HTTPClient.Head(CleanUrl); if (HTTPResponse.StatusCode < 200) or (HTTPResponse.StatusCode > 299) then raise Exception.Create(FmtSetupMessage(msgErrorDownloadSizeFailed, [IntToStr(HTTPResponse.StatusCode), HTTPResponse.StatusText])) else begin FileSize := HTTPResponse.ContentLength; FileDate := HTTPResponse.LastModified; end; finally Base64.Free; HTTPClient.Free; end; end; function DownloadTemporaryFileSize(const Url: String): Int64; var FileSize: Int64; FileDate: String; begin if Url = '' then InternalError('DownloadTemporaryFileSize: Invalid Url value'); LogFmt('Getting size of %s.', [MaskPasswordInUrl(Url)]); DownloadTemporaryFileSizeAndDate(Url, FileSize, FileDate); Result := FileSize; end; function DownloadTemporaryFileDate(const Url: String): String; var FileSize: Int64; FileDate: String; begin if Url = '' then InternalError('DownloadTemporaryFileDate: Invalid Url value'); LogFmt('Getting last modified date of %s.', [MaskPasswordInUrl(Url)]); DownloadTemporaryFileSizeAndDate(Url, FileSize, FileDate); Result := FileDate; end; end.