From 8c1fe5cfc880f1dce8a134752d7e3e1ece0590f5 Mon Sep 17 00:00:00 2001 From: Martijn Laan <1092369+martijnlaan@users.noreply.github.com> Date: Sun, 17 Nov 2024 19:29:17 +0100 Subject: [PATCH 1/8] Modernize the mapping of function name to function code by using a dictionary. Function names are still listed the same amount of times (so only once unless code is shared) but it no longer requires a ton of else ifs (nor a ton of ROPS procs) and should also be a lot faster. Kept the categories even though they don't have an impact anymore except to keep things organized a bit more. --- Projects/Src/Setup.ScriptFunc.pas | 4018 ++++++++++++++++------------- 1 file changed, 2212 insertions(+), 1806 deletions(-) diff --git a/Projects/Src/Setup.ScriptFunc.pas b/Projects/Src/Setup.ScriptFunc.pas index 4b194c7dd..7c3902775 100644 --- a/Projects/Src/Setup.ScriptFunc.pas +++ b/Projects/Src/Setup.ScriptFunc.pas @@ -116,6 +116,99 @@ function IsProtectedSrcExe(const Filename: String): Boolean; {---} +type + { *Must* keep this in synch with ScriptFunc_C } + TFindRec = record + Name: String; + Attributes: LongWord; + SizeHigh: LongWord; + SizeLow: LongWord; + CreationTime: TFileTime; + LastAccessTime: TFileTime; + LastWriteTime: TFileTime; + AlternateName: String; + FindHandle: THandle; + end; + +procedure FindDataToFindRec(const FindData: TWin32FindData; + var FindRec: TFindRec); +begin + FindRec.Name := FindData.cFileName; + FindRec.Attributes := FindData.dwFileAttributes; + FindRec.SizeHigh := FindData.nFileSizeHigh; + FindRec.SizeLow := FindData.nFileSizeLow; + FindRec.CreationTime := FindData.ftCreationTime; + FindRec.LastAccessTime := FindData.ftLastAccessTime; + FindRec.LastWriteTime := FindData.ftLastWriteTime; + FindRec.AlternateName := FindData.cAlternateFileName; +end; + +function _FindFirst(const FileName: String; var FindRec: TFindRec): Boolean; +var + FindHandle: THandle; + FindData: TWin32FindData; +begin + FindHandle := FindFirstFileRedir(ScriptFuncDisableFsRedir, FileName, FindData); + if FindHandle <> INVALID_HANDLE_VALUE then begin + FindRec.FindHandle := FindHandle; + FindDataToFindRec(FindData, FindRec); + Result := True; + end + else begin + FindRec.FindHandle := 0; + Result := False; + end; +end; + +function _FindNext(var FindRec: TFindRec): Boolean; +var + FindData: TWin32FindData; +begin + Result := (FindRec.FindHandle <> 0) and FindNextFile(FindRec.FindHandle, FindData); + if Result then + FindDataToFindRec(FindData, FindRec); +end; + +procedure _FindClose(var FindRec: TFindRec); +begin + if FindRec.FindHandle <> 0 then begin + Windows.FindClose(FindRec.FindHandle); + FindRec.FindHandle := 0; + end; +end; + +function _FmtMessage(const S: String; const Args: array of String): String; +begin + Result := FmtMessage(PChar(S), Args); +end; + +type + { *Must* keep this in synch with ScriptFunc_C } + TWindowsVersion = packed record + Major: Cardinal; + Minor: Cardinal; + Build: Cardinal; + ServicePackMajor: Cardinal; + ServicePackMinor: Cardinal; + NTPlatform: Boolean; + ProductType: Byte; + SuiteMask: Word; + end; + +procedure _GetWindowsVersionEx(var Version: TWindowsVersion); +begin + Version.Major := WindowsVersion shr 24; + Version.Minor := (WindowsVersion shr 16) and $FF; + Version.Build := WindowsVersion and $FFFF; + Version.ServicePackMajor := Hi(NTServicePackLevel); + Version.ServicePackMinor := Lo(NTServicePackLevel); + Version.NTPlatform := True; + Version.ProductType := WindowsProductType; + Version.SuiteMask := WindowsSuiteMask; +end; + +{---} + type TPSStackHelper = class helper for TPSStack private @@ -250,667 +343,144 @@ procedure TPSStackHelper.SetInt(const ItemNo: Longint; const Data: Integer; {---} -function ScriptDlgProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; -var - PStart: Cardinal; +procedure CrackCodeRootKey(CodeRootKey: HKEY; var RegView: TRegView; + var RootKey: HKEY); begin - PStart := Stack.Count-1; - Result := True; + if (CodeRootKey and not CodeRootKeyValidFlags) = HKEY_AUTO then begin + { Change HKA to HKLM or HKCU, keeping our special flag bits. } + CodeRootKey := (CodeRootKey and CodeRootKeyValidFlags) or InstallModeRootKey; + end else begin + { Allow only predefined key handles (8xxxxxxx). Can't accept handles to + open keys because they might have our special flag bits set. + Also reject unknown flags which may have a meaning in the future. } + if (CodeRootKey shr 31 <> 1) or + ((CodeRootKey and CodeRootKeyFlagMask) and not CodeRootKeyValidFlags <> 0) then + InternalError('Invalid RootKey value'); + end; - if Proc.Name = 'PAGEFROMID' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - Stack.SetClass(PStart, GetWizardForm.PageFromID(Stack.GetInt(PStart-1))); - end else if Proc.Name = 'PAGEINDEXFROMID' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - Stack.SetInt(PStart, GetWizardForm.PageIndexFromID(Stack.GetInt(PStart-1))); - end else if Proc.Name = 'CREATECUSTOMPAGE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - var NewPage := TWizardPage.Create(GetWizardForm); - try - NewPage.Caption := Stack.GetString(PStart-2); - NewPage.Description := Stack.GetString(PStart-3); - GetWizardForm.AddPage(NewPage, Stack.GetInt(PStart-1)); - except - NewPage.Free; - raise; - end; - Stack.SetClass(PStart, NewPage); - end else if Proc.Name = 'CREATEINPUTQUERYPAGE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - var NewInputQueryPage := TInputQueryWizardPage.Create(GetWizardForm); - try - NewInputQueryPage.Caption := Stack.GetString(PStart-2); - NewInputQueryPage.Description := Stack.GetString(PStart-3); - GetWizardForm.AddPage(NewInputQueryPage, Stack.GetInt(PStart-1)); - NewInputQueryPage.Initialize(Stack.GetString(PStart-4)); - except - NewInputQueryPage.Free; - raise; - end; - Stack.SetClass(PStart, NewInputQueryPage); - end else if Proc.Name = 'CREATEINPUTOPTIONPAGE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - var NewInputOptionPage := TInputOptionWizardPage.Create(GetWizardForm); - try - NewInputOptionPage.Caption := Stack.GetString(PStart-2); - NewInputOptionPage.Description := Stack.GetString(PStart-3); - GetWizardForm.AddPage(NewInputOptionPage, Stack.GetInt(PStart-1)); - NewInputOptionPage.Initialize(Stack.GetString(PStart-4), - Stack.GetBool(PStart-5), Stack.GetBool(PStart-6)); - except - NewInputOptionPage.Free; - raise; - end; - Stack.SetClass(PStart, NewInputOptionPage); - end else if Proc.Name = 'CREATEINPUTDIRPAGE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - var NewInputDirPage := TInputDirWizardPage.Create(GetWizardForm); - try - NewInputDirPage.Caption := Stack.GetString(PStart-2); - NewInputDirPage.Description := Stack.GetString(PStart-3); - GetWizardForm.AddPage(NewInputDirPage, Stack.GetInt(PStart-1)); - NewInputDirPage.Initialize(Stack.GetString(PStart-4), Stack.GetBool(PStart-5), - Stack.GetString(PStart-6)); - except - NewInputDirPage.Free; - raise; - end; - Stack.SetClass(PStart, NewInputDirPage); - end else if Proc.Name = 'CREATEINPUTFILEPAGE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - var NewInputFilePage := TInputFileWizardPage.Create(GetWizardForm); - try - NewInputFilePage.Caption := Stack.GetString(PStart-2); - NewInputFilePage.Description := Stack.GetString(PStart-3); - GetWizardForm.AddPage(NewInputFilePage, Stack.GetInt(PStart-1)); - NewInputFilePage.Initialize(Stack.GetString(PStart-4)); - except - NewInputFilePage.Free; - raise; - end; - Stack.SetClass(PStart, NewInputFilePage); - end else if Proc.Name = 'CREATEOUTPUTMSGPAGE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - var NewOutputMsgPage := TOutputMsgWizardPage.Create(GetWizardForm); - try - NewOutputMsgPage.Caption := Stack.GetString(PStart-2); - NewOutputMsgPage.Description := Stack.GetString(PStart-3); - GetWizardForm.AddPage(NewOutputMsgPage, Stack.GetInt(PStart-1)); - NewOutputMsgPage.Initialize(Stack.GetString(PStart-4)); - except - NewOutputMsgPage.Free; - raise; - end; - Stack.SetClass(PStart, NewOutputMsgPage); - end else if Proc.Name = 'CREATEOUTPUTMSGMEMOPAGE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - var NewOutputMsgMemoPage := TOutputMsgMemoWizardPage.Create(GetWizardForm); - try - NewOutputMsgMemoPage.Caption := Stack.GetString(PStart-2); - NewOutputMsgMemoPage.Description := Stack.GetString(PStart-3); - GetWizardForm.AddPage(NewOutputMsgMemoPage, Stack.GetInt(PStart-1)); - NewOutputMsgMemoPage.Initialize(Stack.GetString(PStart-4), - Stack.GetAnsiString(PStart-5)); - except - NewOutputMsgMemoPage.Free; - raise; - end; - Stack.SetClass(PStart, NewOutputMsgMemoPage); - end else if Proc.Name = 'CREATEOUTPUTPROGRESSPAGE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - var NewOutputProgressPage := TOutputProgressWizardPage.Create(GetWizardForm); - try - NewOutputProgressPage.Caption := Stack.GetString(PStart-1); - NewOutputProgressPage.Description := Stack.GetString(PStart-2); - GetWizardForm.AddPage(NewOutputProgressPage, -1); - NewOutputProgressPage.Initialize; - except - NewOutputProgressPage.Free; - raise; - end; - Stack.SetClass(PStart, NewOutputProgressPage); - end else if Proc.Name = 'CREATEOUTPUTMARQUEEPROGRESSPAGE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - var NewOutputMarqueeProgressPage := TOutputMarqueeProgressWizardPage.Create(GetWizardForm); - try - NewOutputMarqueeProgressPage.Caption := Stack.GetString(PStart-1); - NewOutputMarqueeProgressPage.Description := Stack.GetString(PStart-2); - GetWizardForm.AddPage(NewOutputMarqueeProgressPage, -1); - NewOutputMarqueeProgressPage.Initialize; - except - NewOutputMarqueeProgressPage.Free; - raise; - end; - Stack.SetClass(PStart, NewOutputMarqueeProgressPage); - end else if Proc.Name = 'CREATEDOWNLOADPAGE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - var NewDownloadPage := TDownloadWizardPage.Create(GetWizardForm); - try - NewDownloadPage.Caption := Stack.GetString(PStart-1); - NewDownloadPage.Description := Stack.GetString(PStart-2); - GetWizardForm.AddPage(NewDownloadPage, -1); - NewDownloadPage.Initialize; - NewDownloadPage.OnDownloadProgress := TOnDownloadProgress(Stack.GetProc(PStart-3, Caller)); - except - NewDownloadPage.Free; - raise; - end; - Stack.SetClass(PStart, NewDownloadPage); - end else if Proc.Name = 'CREATEEXTRACTIONPAGE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - var NewExtractionPage := TExtractionWizardPage.Create(GetWizardForm); - try - NewExtractionPage.Caption := Stack.GetString(PStart-1); - NewExtractionPage.Description := Stack.GetString(PStart-2); - GetWizardForm.AddPage(NewExtractionPage, -1); - NewExtractionPage.Initialize; - NewExtractionPage.OnExtractionProgress := TOnExtractionProgress(Stack.GetProc(PStart-3, Caller)); - except - NewExtractionPage.Free; - raise; - end; - Stack.SetClass(PStart, NewExtractionPage); - end else if Proc.Name = 'SCALEX' then begin - InitializeScaleBaseUnits; - Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitX, OrigBaseUnitX)); - end else if Proc.Name = 'SCALEY' then begin - InitializeScaleBaseUnits; - Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitY, OrigBaseUnitY)); - end else if Proc.Name = 'CREATECUSTOMFORM' then begin - var NewSetupForm := TSetupForm.CreateNew(nil); - try - NewSetupForm.AutoScroll := False; - NewSetupForm.BorderStyle := bsDialog; - NewSetupForm.InitializeFont; - except - NewSetupForm.Free; - raise; - end; - Stack.SetClass(PStart, NewSetupForm); - end else - Result := False; + if CodeRootKey and CodeRootKeyFlag32Bit <> 0 then + RegView := rv32Bit + else if CodeRootKey and CodeRootKeyFlag64Bit <> 0 then begin + if not IsWin64 then + InternalError('Cannot access 64-bit registry keys on this version of Windows'); + RegView := rv64Bit; + end + else + RegView := InstallDefaultRegView; + RootKey := CodeRootKey and not CodeRootKeyFlagMask; end; -function NewDiskFormProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; +function GetSubkeyOrValueNames(const RegView: TRegView; const RootKey: HKEY; + const SubKeyName: String; const Stack: TPSStack; const ItemNo: Longint; const Subkey: Boolean): Boolean; +const + samDesired: array [Boolean] of REGSAM = (KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS); var - PStart: Cardinal; - S: String; + K: HKEY; + Buf, S: String; + BufSize, R: DWORD; begin - PStart := Stack.Count-1; + Result := False; + SetString(Buf, nil, 512); + if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, samDesired[Subkey], K) <> ERROR_SUCCESS then + Exit; + try + var ArrayBuilder := Stack.InitArrayBuilder(ItemNo); + while True do begin + BufSize := Length(Buf); + if Subkey then + R := RegEnumKeyEx(K, ArrayBuilder.I, @Buf[1], BufSize, nil, nil, nil, nil) + else + R := RegEnumValue(K, ArrayBuilder.I, @Buf[1], BufSize, nil, nil, nil, nil); + case R of + ERROR_SUCCESS: ; + ERROR_NO_MORE_ITEMS: Break; + ERROR_MORE_DATA: + begin + { Double the size of the buffer and try again } + if Length(Buf) >= 65536 then begin + { Sanity check: If we tried a 64 KB buffer and it's still saying + there's more data, something must be seriously wrong. Bail. } + Exit; + end; + SetString(Buf, nil, Length(Buf) * 2); + Continue; + end; + else + Exit; { unknown failure... } + end; + SetString(S, PChar(@Buf[1]), BufSize); + ArrayBuilder.Add(S); + end; + finally + RegCloseKey(K); + end; Result := True; - - if Proc.Name = 'SELECTDISK' then begin - S := Stack.GetString(PStart-3); - Stack.SetBool(PStart, SelectDisk(Stack.GetInt(PStart-1), Stack.GetString(PStart-2), S)); - Stack.SetString(PStart-3, S); - end else - Result := False; end; -function BrowseFuncProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; +function GetMD5OfFile(const DisableFsRedir: Boolean; const Filename: String): TMD5Digest; +{ Gets MD5 sum of the file Filename. An exception will be raised upon + failure. } var - PStart: Cardinal; - S: String; - ParentWnd: HWND; + Buf: array[0..65535] of Byte; begin - PStart := Stack.Count-1; - Result := True; - - if Proc.Name = 'BROWSEFORFOLDER' then begin - if Assigned(WizardForm) then - ParentWnd := WizardForm.Handle - else - ParentWnd := 0; - S := Stack.GetString(PStart-2); - Stack.SetBool(PStart, BrowseForFolder(Stack.GetString(PStart-1), S, ParentWnd, Stack.GetBool(PStart-3))); - Stack.SetString(PStart-2, S); - end else if Proc.Name = 'GETOPENFILENAME' then begin - if Assigned(WizardForm) then - ParentWnd := WizardForm.Handle - else - ParentWnd := 0; - S := Stack.GetString(PStart-2); - Stack.SetBool(PStart, NewGetOpenFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), ParentWnd)); - Stack.SetString(PStart-2, S); - end else if Proc.Name = 'GETOPENFILENAMEMULTI' then begin - if Assigned(WizardForm) then - ParentWnd := WizardForm.Handle - else - ParentWnd := 0; - Stack.SetBool(PStart, NewGetOpenFileNameMulti(Stack.GetString(PStart-1), TStrings(Stack.GetClass(PStart-2)), Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), ParentWnd)); - end else if Proc.Name = 'GETSAVEFILENAME' then begin - if Assigned(WizardForm) then - ParentWnd := WizardForm.Handle - else - ParentWnd := 0; - S := Stack.GetString(PStart-2); - Stack.SetBool(PStart, NewGetSaveFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), ParentWnd)); - Stack.SetString(PStart-2, S); - end else - Result := False; + var Context: TMD5Context; + MD5Init(Context); + var F := TFileRedir.Create(DisableFsRedir, Filename, fdOpenExisting, faRead, fsReadWrite); + try + while True do begin + var NumRead := F.Read(Buf, SizeOf(Buf)); + if NumRead = 0 then + Break; + MD5Update(Context, Buf, NumRead); + end; + finally + F.Free; + end; + Result := MD5Final(Context); end; -function CommonFuncVclProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; +function GetSHA1OfFile(const DisableFsRedir: Boolean; const Filename: String): TSHA1Digest; +{ Gets SHA-1 sum of the file Filename. An exception will be raised upon + failure. } var - PStart: Cardinal; + Buf: array[0..65535] of Byte; begin - PStart := Stack.Count-1; - Result := True; - - if Proc.Name = 'MINIMIZEPATHNAME' then begin - Stack.SetString(PStart, MinimizePathName(Stack.GetString(PStart-1), TFont(Stack.GetClass(PStart-2)), Stack.GetInt(PStart-3))); - end else - Result := False; -end; - -function CommonFuncProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; - - procedure CrackCodeRootKey(CodeRootKey: HKEY; var RegView: TRegView; - var RootKey: HKEY); - begin - if (CodeRootKey and not CodeRootKeyValidFlags) = HKEY_AUTO then begin - { Change HKA to HKLM or HKCU, keeping our special flag bits. } - CodeRootKey := (CodeRootKey and CodeRootKeyValidFlags) or InstallModeRootKey; - end else begin - { Allow only predefined key handles (8xxxxxxx). Can't accept handles to - open keys because they might have our special flag bits set. - Also reject unknown flags which may have a meaning in the future. } - if (CodeRootKey shr 31 <> 1) or - ((CodeRootKey and CodeRootKeyFlagMask) and not CodeRootKeyValidFlags <> 0) then - InternalError('Invalid RootKey value'); - end; - - if CodeRootKey and CodeRootKeyFlag32Bit <> 0 then - RegView := rv32Bit - else if CodeRootKey and CodeRootKeyFlag64Bit <> 0 then begin - if not IsWin64 then - InternalError('Cannot access 64-bit registry keys on this version of Windows'); - RegView := rv64Bit; - end - else - RegView := InstallDefaultRegView; - RootKey := CodeRootKey and not CodeRootKeyFlagMask; - end; - - function GetSubkeyOrValueNames(const RegView: TRegView; const RootKey: HKEY; - const SubKeyName: String; const Stack: TPSStack; const ItemNo: Longint; const Subkey: Boolean): Boolean; - const - samDesired: array [Boolean] of REGSAM = (KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS); - var - K: HKEY; - Buf, S: String; - BufSize, R: DWORD; - begin - Result := False; - SetString(Buf, nil, 512); - if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, samDesired[Subkey], K) <> ERROR_SUCCESS then - Exit; - try - var ArrayBuilder := Stack.InitArrayBuilder(ItemNo); - while True do begin - BufSize := Length(Buf); - if Subkey then - R := RegEnumKeyEx(K, ArrayBuilder.I, @Buf[1], BufSize, nil, nil, nil, nil) - else - R := RegEnumValue(K, ArrayBuilder.I, @Buf[1], BufSize, nil, nil, nil, nil); - case R of - ERROR_SUCCESS: ; - ERROR_NO_MORE_ITEMS: Break; - ERROR_MORE_DATA: - begin - { Double the size of the buffer and try again } - if Length(Buf) >= 65536 then begin - { Sanity check: If we tried a 64 KB buffer and it's still saying - there's more data, something must be seriously wrong. Bail. } - Exit; - end; - SetString(Buf, nil, Length(Buf) * 2); - Continue; - end; - else - Exit; { unknown failure... } - end; - SetString(S, PChar(@Buf[1]), BufSize); - ArrayBuilder.Add(S); - end; - finally - RegCloseKey(K); + var Context: TSHA1Context; + SHA1Init(Context); + var F := TFileRedir.Create(DisableFsRedir, Filename, fdOpenExisting, faRead, fsReadWrite); + try + while True do begin + var NumRead := F.Read(Buf, SizeOf(Buf)); + if NumRead = 0 then + Break; + SHA1Update(Context, Buf, NumRead); end; - Result := True; + finally + F.Free; end; + Result := SHA1Final(Context); +end; -var - PStart: Cardinal; - ExistingFilename: String; - RegView: TRegView; - K, RootKey: HKEY; - S, N, V: String; - DataS: AnsiString; - Typ, ExistingTyp, Data, Size: DWORD; - I: Integer; +function GetMD5OfAnsiString(const S: AnsiString): TMD5Digest; begin - PStart := Stack.Count-1; - Result := True; - - if Proc.Name = 'FILEEXISTS' then begin - Stack.SetBool(PStart, NewFileExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); - end else if Proc.Name = 'DIREXISTS' then begin - Stack.SetBool(PStart, DirExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); - end else if Proc.Name = 'FILEORDIREXISTS' then begin - Stack.SetBool(PStart, FileOrDirExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); - end else if Proc.Name = 'GETINISTRING' then begin - Stack.SetString(PStart, GetIniString(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetString(PStart-4))); - end else if Proc.Name = 'GETINIINT' then begin - Stack.SetInt(PStart, GetIniInt(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4), Stack.GetInt(PStart-5), Stack.GetString(PStart-6))); - end else if Proc.Name = 'GETINIBOOL' then begin - Stack.SetBool(PStart, GetIniBool(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), Stack.GetString(PStart-4))); - end else if Proc.Name = 'INIKEYEXISTS' then begin - Stack.SetBool(PStart, IniKeyExists(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3))); - end else if Proc.Name = 'ISINISECTIONEMPTY' then begin - Stack.SetBool(PStart, IsIniSectionEmpty(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); - end else if Proc.Name = 'SETINISTRING' then begin - Stack.SetBool(PStart, SetIniString(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetString(PStart-4))); - end else if Proc.Name = 'SETINIINT' then begin - Stack.SetBool(PStart, SetIniInt(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetInt(PStart-3), Stack.GetString(PStart-4))); - end else if Proc.Name = 'SETINIBOOL' then begin - Stack.SetBool(PStart, SetIniBool(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), Stack.GetString(PStart-4))); - end else if Proc.Name = 'DELETEINIENTRY' then begin - DeleteIniEntry(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetString(PStart-2)); - end else if Proc.Name = 'DELETEINISECTION' then begin - DeleteIniSection(Stack.GetString(PStart), Stack.GetString(PStart-1)); - end else if Proc.Name = 'GETENV' then begin - Stack.SetString(PStart, GetEnv(Stack.GetString(PStart-1))); - end else if Proc.Name = 'GETCMDTAIL' then begin - Stack.SetString(PStart, GetCmdTail()); - end else if Proc.Name = 'PARAMCOUNT' then begin - if NewParamsForCode.Count = 0 then - InternalError('NewParamsForCode not set'); - Stack.SetInt(PStart, NewParamsForCode.Count-1); - end else if Proc.Name = 'PARAMSTR' then begin - I := Stack.GetInt(PStart-1); - if (I >= 0) and (I < NewParamsForCode.Count) then - Stack.SetString(PStart, NewParamsForCode[I]) - else - Stack.SetString(PStart, ''); - end else if Proc.Name = 'ADDBACKSLASH' then begin - Stack.SetString(PStart, AddBackslash(Stack.GetString(PStart-1))); - end else if Proc.Name = 'REMOVEBACKSLASH' then begin - Stack.SetString(PStart, RemoveBackslash(Stack.GetString(PStart-1))); - end else if Proc.Name = 'REMOVEBACKSLASHUNLESSROOT' then begin - Stack.SetString(PStart, RemoveBackslashUnlessRoot(Stack.GetString(PStart-1))); - end else if Proc.Name = 'ADDQUOTES' then begin - Stack.SetString(PStart, AddQuotes(Stack.GetString(PStart-1))); - end else if Proc.Name = 'REMOVEQUOTES' then begin - Stack.SetString(PStart, RemoveQuotes(Stack.GetString(PStart-1))); - end else if Proc.Name = 'GETSHORTNAME' then begin - Stack.SetString(PStart, GetShortNameRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); - end else if Proc.Name = 'GETWINDIR' then begin - Stack.SetString(PStart, GetWinDir()); - end else if Proc.Name = 'GETSYSTEMDIR' then begin - Stack.SetString(PStart, GetSystemDir()); - end else if Proc.Name = 'GETSYSWOW64DIR' then begin - Stack.SetString(PStart, GetSysWow64Dir()); - end else if Proc.Name = 'GETSYSNATIVEDIR' then begin - Stack.SetString(PStart, GetSysNativeDir(IsWin64)); - end else if Proc.Name = 'GETTEMPDIR' then begin - Stack.SetString(PStart, GetTempDir()); - end else if Proc.Name = 'STRINGCHANGE' then begin - S := Stack.GetString(PStart-1); - Stack.SetInt(PStart, StringChange(S, Stack.GetString(PStart-2), Stack.GetString(PStart-3))); - Stack.SetString(PStart-1, S); - end else if Proc.Name = 'STRINGCHANGEEX' then begin - S := Stack.GetString(PStart-1); - Stack.SetInt(PStart, StringChangeEx(S, Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetBool(PStart-4))); - Stack.SetString(PStart-1, S); - end else if Proc.Name = 'USINGWINNT' then begin - Stack.SetBool(PStart, True); - end else if (Proc.Name = 'COPYFILE') or (Proc.Name = 'FILECOPY') then begin - ExistingFilename := Stack.GetString(PStart-1); - if not IsProtectedSrcExe(ExistingFilename) then - Stack.SetBool(PStart, CopyFileRedir(ScriptFuncDisableFsRedir, - ExistingFilename, Stack.GetString(PStart-2), Stack.GetBool(PStart-3))) - else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'CONVERTPERCENTSTR' then begin - S := Stack.GetString(PStart-1); - Stack.SetBool(PStart, ConvertPercentStr(S)); - Stack.SetString(PStart-1, S); - end else if Proc.Name = 'REGKEYEXISTS' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin - Stack.SetBool(PStart, True); - RegCloseKey(K); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'REGVALUEEXISTS' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - Stack.SetBool(PStart, RegValueExists(K, PChar(N))); - RegCloseKey(K); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'REGDELETEKEYINCLUDINGSUBKEYS' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - Stack.SetBool(PStart, RegDeleteKeyIncludingSubkeys(RegView, RootKey, PChar(S)) = ERROR_SUCCESS); - end else if Proc.Name = 'REGDELETEKEYIFEMPTY' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - Stack.SetBool(PStart, RegDeleteKeyIfEmpty(RegView, RootKey, PChar(S)) = ERROR_SUCCESS); - end else if Proc.Name = 'REGDELETEVALUE' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - Stack.SetBool(PStart, RegDeleteValue(K, PChar(N)) = ERROR_SUCCESS); - RegCloseKey(K); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'REGGETSUBKEYNAMES' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey, - Stack.GetString(PStart-2), Stack, PStart-3, True)); - end else if Proc.Name = 'REGGETVALUENAMES' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey, - Stack.GetString(PStart-2), Stack, PStart-3, False)); - end else if Proc.Name = 'REGQUERYSTRINGVALUE' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - S := Stack.GetString(PStart-4); - Stack.SetBool(PStart, RegQueryStringValue(K, PChar(N), S)); - Stack.SetString(PStart-4, S); - RegCloseKey(K); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'REGQUERYMULTISTRINGVALUE' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - S := Stack.GetString(PStart-4); - Stack.SetBool(PStart, RegQueryMultiStringValue(K, PChar(N), S)); - Stack.SetString(PStart-4, S); - RegCloseKey(K); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'REGQUERYDWORDVALUE' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - Size := SizeOf(Data); - if (RegQueryValueEx(K, PChar(N), nil, @Typ, @Data, @Size) = ERROR_SUCCESS) and (Typ = REG_DWORD) then begin - Stack.SetInt(PStart-4, Data); - Stack.SetBool(PStart, True); - end else - Stack.SetBool(PStart, False); - RegCloseKey(K); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'REGQUERYBINARYVALUE' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - if RegQueryValueEx(K, PChar(N), nil, @Typ, nil, @Size) = ERROR_SUCCESS then begin - SetLength(DataS, Size); - if RegQueryValueEx(K, PChar(N), nil, @Typ, @DataS[1], @Size) = ERROR_SUCCESS then begin - Stack.SetAnsiString(PStart-4, DataS); - Stack.SetBool(PStart, True); - end else - Stack.SetBool(PStart, False); - end else - Stack.SetBool(PStart, False); - RegCloseKey(K); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'REGWRITESTRINGVALUE' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - V := Stack.GetString(PStart-4); - if (RegQueryValueEx(K, PChar(N), nil, @ExistingTyp, nil, nil) = ERROR_SUCCESS) and (ExistingTyp = REG_EXPAND_SZ) then - Typ := REG_EXPAND_SZ - else - Typ := REG_SZ; - if RegSetValueEx(K, PChar(N), 0, Typ, PChar(V), (Length(V)+1)*SizeOf(V[1])) = ERROR_SUCCESS then - Stack.SetBool(PStart, True) - else - Stack.SetBool(PStart, False); - RegCloseKey(K); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'REGWRITEEXPANDSTRINGVALUE' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - V := Stack.GetString(PStart-4); - if RegSetValueEx(K, PChar(N), 0, REG_EXPAND_SZ, PChar(V), (Length(V)+1)*SizeOf(V[1])) = ERROR_SUCCESS then - Stack.SetBool(PStart, True) - else - Stack.SetBool(PStart, False); - RegCloseKey(K); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'REGWRITEMULTISTRINGVALUE' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - V := Stack.GetString(PStart-4); - { 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; - if RegSetValueEx(K, PChar(N), 0, REG_MULTI_SZ, PChar(V), (Length(V)+1)*SizeOf(V[1])) = ERROR_SUCCESS then - Stack.SetBool(PStart, True) - else - Stack.SetBool(PStart, False); - RegCloseKey(K); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'REGWRITEDWORDVALUE' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - Data := Stack.GetInt(PStart-4); - if RegSetValueEx(K, PChar(N), 0, REG_DWORD, @Data, SizeOf(Data)) = ERROR_SUCCESS then - Stack.SetBool(PStart, True) - else - Stack.SetBool(PStart, False); - RegCloseKey(K); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'REGWRITEBINARYVALUE' then begin - CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - DataS := Stack.GetAnsiString(PStart-4); - if RegSetValueEx(K, PChar(N), 0, REG_BINARY, @DataS[1], Length(DataS)) = ERROR_SUCCESS then - Stack.SetBool(PStart, True) - else - Stack.SetBool(PStart, False); - RegCloseKey(K); - end else - Stack.SetBool(PStart, False); - end else if (Proc.Name = 'ISADMIN') or (Proc.Name = 'ISADMINLOGGEDON') then begin - Stack.SetBool(PStart, IsAdmin); - end else if Proc.Name = 'ISPOWERUSERLOGGEDON' then begin - Stack.SetBool(PStart, IsPowerUserLoggedOn()); - end else if Proc.Name= 'ISADMININSTALLMODE' then begin - Stack.SetBool(PStart, IsAdminInstallMode); - end else if Proc.Name = 'FONTEXISTS' then begin - Stack.SetBool(PStart, FontExists(Stack.GetString(PStart-1))); - end else if Proc.Name = 'GETUILANGUAGE' then begin - Stack.SetInt(PStart, GetUILanguage); - end else if Proc.Name = 'ADDPERIOD' then begin - Stack.SetString(PStart, AddPeriod(Stack.GetString(PStart-1))); - end else if Proc.Name = 'CHARLENGTH' then begin - Stack.SetInt(PStart, PathCharLength(Stack.GetString(PStart-1), Stack.GetInt(PStart-2))); - end else if Proc.Name = 'SETNTFSCOMPRESSION' then begin - Stack.SetBool(PStart, SetNTFSCompressionRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetBool(PStart-2))); - end else if Proc.Name = 'ISWILDCARD' then begin - Stack.SetBool(PStart, IsWildcard(Stack.GetString(PStart-1))); - end else if Proc.Name = 'WILDCARDMATCH' then begin - S := Stack.GetString(PStart-1); - N := Stack.GetString(PStart-2); - Stack.SetBool(PStart, WildcardMatch(PChar(S), PChar(N))); - end else - Result := False; + Result := MD5Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); end; -function InstallProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; -var - PStart: Cardinal; +function GetMD5OfUnicodeString(const S: UnicodeString): TMD5Digest; begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); + Result := MD5Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); +end; - PStart := Stack.Count-1; - Result := True; +function GetSHA1OfAnsiString(const S: AnsiString): TSHA1Digest; +begin + Result := SHA1Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); +end; - if Proc.Name = 'EXTRACTTEMPORARYFILE' then begin - ExtractTemporaryFile(Stack.GetString(PStart)); - end else if Proc.Name = 'EXTRACTTEMPORARYFILES' then begin - Stack.SetInt(PStart, ExtractTemporaryFiles(Stack.GetString(PStart-1))); - end else if Proc.Name = 'DOWNLOADTEMPORARYFILE' then begin - Stack.SetInt64(PStart, DownloadTemporaryFile(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), TOnDownloadProgress(Stack.GetProc(PStart-4, Caller)))); - end else if Proc.Name = 'SETDOWNLOADCREDENTIALS' then begin - SetDownloadCredentials(Stack.GetString(PStart),Stack.GetString(PStart-1)); - end else if Proc.Name = 'DOWNLOADTEMPORARYFILESIZE' then begin - Stack.SetInt64(PStart, DownloadTemporaryFileSize(Stack.GetString(PStart-1))); - end else if Proc.Name = 'DOWNLOADTEMPORARYFILEDATE' then begin - Stack.SetString(PStart, DownloadTemporaryFileDate(Stack.GetString(PStart-1))); - end else - Result := False; +function GetSHA1OfUnicodeString(const S: UnicodeString): TSHA1Digest; +begin + Result := SHA1Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); end; -{ InstFunc } procedure ProcessMessagesProc; far; begin Application.ProcessMessages; @@ -931,1273 +501,2101 @@ procedure ExecAndLogOutputLogCustom(const S: String; const Error, FirstLine: Boo OnLog(S, Error, FirstLine); end; -function InstFuncProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; +function CustomMessage(const MsgName: String): String; +begin + if not GetCustomMessageValue(MsgName, Result) then + InternalError(Format('Unknown custom message name "%s"', [MsgName])); +end; - function GetMD5OfFile(const DisableFsRedir: Boolean; const Filename: String): TMD5Digest; - { Gets MD5 sum of the file Filename. An exception will be raised upon - failure. } - var - Buf: array[0..65535] of Byte; +{ ExtractRelativePath is not in Delphi 2's SysUtils. Use the one from Delphi 7.01. } +function NewExtractRelativePath(BaseName, DestName: string): string; +var + BasePath, DestPath: string; + BaseLead, DestLead: PChar; + BasePtr, DestPtr: PChar; + + function ExtractFilePathNoDrive(const FileName: string): string; begin - var Context: TMD5Context; - MD5Init(Context); - var F := TFileRedir.Create(DisableFsRedir, Filename, fdOpenExisting, faRead, fsReadWrite); - try - while True do begin - var NumRead := F.Read(Buf, SizeOf(Buf)); - if NumRead = 0 then - Break; - MD5Update(Context, Buf, NumRead); - end; - finally - F.Free; - end; - Result := MD5Final(Context); + Result := PathExtractPath(FileName); + Delete(Result, 1, Length(PathExtractDrive(FileName))); end; - function GetSHA1OfFile(const DisableFsRedir: Boolean; const Filename: String): TSHA1Digest; - { Gets SHA-1 sum of the file Filename. An exception will be raised upon - failure. } - var - Buf: array[0..65535] of Byte; + function Next(var Lead: PChar): PChar; begin - var Context: TSHA1Context; - SHA1Init(Context); - var F := TFileRedir.Create(DisableFsRedir, Filename, fdOpenExisting, faRead, fsReadWrite); - try - while True do begin - var NumRead := F.Read(Buf, SizeOf(Buf)); - if NumRead = 0 then - Break; - SHA1Update(Context, Buf, NumRead); - end; - finally - F.Free; + Result := Lead; + if Result = nil then Exit; + Lead := PathStrScan(Lead, '\'); + if Lead <> nil then + begin + Lead^ := #0; + Inc(Lead); end; - Result := SHA1Final(Context); end; - function GetMD5OfAnsiString(const S: AnsiString): TMD5Digest; - begin - Result := MD5Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); - end; +begin + { For consistency with the PathExtract* functions, normalize slashes so + that forward slashes and multiple slashes work with this function also } + BaseName := PathNormalizeSlashes(BaseName); + DestName := PathNormalizeSlashes(DestName); - function GetMD5OfUnicodeString(const S: UnicodeString): TMD5Digest; + if PathCompare(PathExtractDrive(BaseName), PathExtractDrive(DestName)) = 0 then begin - Result := MD5Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); - end; + BasePath := ExtractFilePathNoDrive(BaseName); + UniqueString(BasePath); + DestPath := ExtractFilePathNoDrive(DestName); + UniqueString(DestPath); + BaseLead := Pointer(BasePath); + BasePtr := Next(BaseLead); + DestLead := Pointer(DestPath); + DestPtr := Next(DestLead); + while (BasePtr <> nil) and (DestPtr <> nil) and (PathCompare(BasePtr, DestPtr) = 0) do + begin + BasePtr := Next(BaseLead); + DestPtr := Next(DestLead); + end; + Result := ''; + while BaseLead <> nil do + begin + Result := Result + '..\'; { Do not localize } + Next(BaseLead); + end; + if (DestPtr <> nil) and (DestPtr^ <> #0) then + Result := Result + DestPtr + '\'; + if DestLead <> nil then + Result := Result + DestLead; // destlead already has a trailing backslash + Result := Result + PathExtractName(DestName); + end + else + Result := DestName; +end; - function GetSHA1OfAnsiString(const S: AnsiString): TSHA1Digest; - begin - Result := SHA1Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); +{ Use our own FileSearch function which includes these improvements over + Delphi's version: + - it supports MBCS and uses Path* functions + - it uses NewFileExistsRedir instead of FileExists + - it doesn't search the current directory unless it's told to + - it always returns a fully-qualified path } +function NewFileSearch(const DisableFsRedir: Boolean; + const Name, DirList: String): String; +var + I, P, L: Integer; +begin + { If Name is absolute, drive-relative, or root-relative, don't search DirList } + if PathDrivePartLengthEx(Name, True) <> 0 then begin + Result := PathExpand(Name); + if NewFileExistsRedir(DisableFsRedir, Result) then + Exit; + end + else begin + P := 1; + L := Length(DirList); + while True do begin + while (P <= L) and (DirList[P] = ';') do + Inc(P); + if P > L then + Break; + I := P; + while (P <= L) and (DirList[P] <> ';') do + Inc(P, PathCharLength(DirList, P)); + Result := PathExpand(PathCombine(Copy(DirList, I, P - I), Name)); + if NewFileExistsRedir(DisableFsRedir, Result) then + Exit; + end; end; - - function GetSHA1OfUnicodeString(const S: UnicodeString): TSHA1Digest; - begin - Result := SHA1Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); + Result := ''; end; +function GetExceptionMessage(const Caller: TPSExec): String; var - PStart: Cardinal; - Filename: String; - WindowDisabler: TWindowDisabler; - ResultCode, ErrorCode: Integer; - FreeBytes, TotalBytes: Integer64; + Code: TPSError; + E: TObject; begin - PStart := Stack.Count-1; - Result := True; - - if Proc.Name = 'CHECKFORMUTEXES' then begin - Stack.SetBool(PStart, CheckForMutexes(Stack.GetString(PStart-1))); - end else if Proc.Name = 'DECREMENTSHAREDCOUNT' then begin - if Stack.GetBool(PStart-1) then begin - if not IsWin64 then - InternalError('Cannot access 64-bit registry keys on this version of Windows'); - Stack.SetBool(PStart, DecrementSharedCount(rv64Bit, Stack.GetString(PStart-2))); - end - else - Stack.SetBool(PStart, DecrementSharedCount(rv32Bit, Stack.GetString(PStart-2))); - end else if Proc.Name = 'DELAYDELETEFILE' then begin - DelayDeleteFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetInt(PStart-1), 250, 250); - end else if Proc.Name = 'DELTREE' then begin - Stack.SetBool(PStart, DelTree(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetBool(PStart-2), Stack.GetBool(PStart-3), Stack.GetBool(PStart-4), False, nil, nil, nil)); - end else if Proc.Name = 'GENERATEUNIQUENAME' then begin - Stack.SetString(PStart, GenerateUniqueName(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetString(PStart-2))); - end else if Proc.Name = 'GETCOMPUTERNAMESTRING' then begin - Stack.SetString(PStart, GetComputerNameString()); - end else if Proc.Name = 'GETMD5OFFILE' then begin - Stack.SetString(PStart, MD5DigestToString(GetMD5OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)))); - end else if Proc.Name = 'GETMD5OFSTRING' then begin - Stack.SetString(PStart, MD5DigestToString(GetMD5OfAnsiString(Stack.GetAnsiString(PStart-1)))); - end else if Proc.Name = 'GETMD5OFUNICODESTRING' then begin - Stack.SetString(PStart, MD5DigestToString(GetMD5OfUnicodeString(Stack.GetString(PStart-1)))); - end else if Proc.Name = 'GETSHA1OFFILE' then begin - Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)))); - end else if Proc.Name = 'GETSHA1OFSTRING' then begin - Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfAnsiString(Stack.GetAnsiString(PStart-1)))); - end else if Proc.Name = 'GETSHA1OFUNICODESTRING' then begin - Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfUnicodeString(Stack.GetString(PStart-1)))); - end else if Proc.Name = 'GETSHA256OFFILE' then begin - Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)))); - end else if Proc.Name = 'GETSHA256OFSTRING' then begin - Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfAnsiString(Stack.GetAnsiString(PStart-1)))); - end else if Proc.Name = 'GETSHA256OFUNICODESTRING' then begin - Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfUnicodeString(Stack.GetString(PStart-1)))); - end else if Proc.Name = 'GETSPACEONDISK' then begin - if GetSpaceOnDisk(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin - if Stack.GetBool(PStart-2) then begin - Div64(FreeBytes, 1024*1024); - Div64(TotalBytes, 1024*1024); - end; - { Cap at 2 GB, as [Code] doesn't support 64-bit integers } - if (FreeBytes.Hi <> 0) or (FreeBytes.Lo and $80000000 <> 0) then - FreeBytes.Lo := $7FFFFFFF; - if (TotalBytes.Hi <> 0) or (TotalBytes.Lo and $80000000 <> 0) then - TotalBytes.Lo := $7FFFFFFF; - Stack.SetUInt(PStart-3, FreeBytes.Lo); - Stack.SetUInt(PStart-4, TotalBytes.Lo); - Stack.SetBool(PStart, True); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'GETSPACEONDISK64' then begin - if GetSpaceOnDisk(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin - Stack.SetInt64(PStart-2, Int64(FreeBytes.Hi) shl 32 + FreeBytes.Lo); - Stack.SetInt64(PStart-3, Int64(TotalBytes.Hi) shl 32 + TotalBytes.Lo); - Stack.SetBool(PStart, True); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'GETUSERNAMESTRING' then begin - Stack.SetString(PStart, GetUserNameString()); - end else if Proc.Name = 'INCREMENTSHAREDCOUNT' then begin - if Stack.GetBool(PStart) then begin - if not IsWin64 then - InternalError('Cannot access 64-bit registry keys on this version of Windows'); - IncrementSharedCount(rv64Bit, Stack.GetString(PStart-1), Stack.GetBool(PStart-2)); - end + Code := Caller.LastEx; + if Code = erNoError then + Result := '(There is no current exception)' + else begin + E := Caller.LastExObject; + if Assigned(E) and (E is Exception) then + Result := Exception(E).Message else - IncrementSharedCount(rv32Bit, Stack.GetString(PStart-1), Stack.GetBool(PStart-2)); - end else if (Proc.Name = 'EXEC') or (Proc.Name = 'EXECASORIGINALUSER') or - (Proc.Name = 'EXECANDLOGOUTPUT') or (Proc.Name = 'EXECANDCAPTUREOUTPUT') then begin - var RunAsOriginalUser := Proc.Name = 'EXECASORIGINALUSER'; - var Method: TMethod; { Must stay alive until OutputReader is freed } - var OutputReader: TCreateProcessOutputReader := nil; - try - if Proc.Name = 'EXECANDLOGOUTPUT' then begin - Method := Stack.GetProc(PStart-7, Caller); - if Method.Code <> nil then - OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLogCustom, NativeInt(@Method)) - else if GetLogActive then - OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLog, 0); - end else if Proc.Name = 'EXECANDCAPTUREOUTPUT' then - OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLog, 0, omCapture); - var ExecWait := TExecWait(Stack.GetInt(PStart-5)); - if IsUninstaller and RunAsOriginalUser then - NoUninstallFuncError(Proc.Name) - else if (OutputReader <> nil) and (ExecWait <> ewWaitUntilTerminated) then - InternalError(Format('Must call "%s" function with Wait = ewWaitUntilTerminated', [Proc.Name])); - - Filename := Stack.GetString(PStart-1); - if not IsProtectedSrcExe(Filename) then begin - { Disable windows so the user can't utilize our UI during the InstExec - call } - WindowDisabler := TWindowDisabler.Create; - try - Stack.SetBool(PStart, InstExecEx(RunAsOriginalUser, - ScriptFuncDisableFsRedir, Filename, Stack.GetString(PStart-2), - Stack.GetString(PStart-3), ExecWait, - Stack.GetInt(PStart-4), ProcessMessagesProc, OutputReader, ResultCode)); - finally - WindowDisabler.Free; - end; - Stack.SetInt(PStart-6, ResultCode); - if Proc.Name = 'EXECANDCAPTUREOUTPUT' then begin - { Set the three TExecOutput fields } - Stack.SetArray(PStart-7, OutputReader.CaptureOutList, 0); - Stack.SetArray(PStart-7, OutputReader.CaptureErrList, 1); - Stack.SetInt(PStart-7, OutputReader.CaptureError.ToInteger, 2); - end; - end else begin - Stack.SetBool(PStart, False); - Stack.SetInt(PStart-6, ERROR_ACCESS_DENIED); - end; - finally - OutputReader.Free; - end; - end else if (Proc.Name = 'SHELLEXEC') or (Proc.Name = 'SHELLEXECASORIGINALUSER') then begin - var RunAsOriginalUser := Proc.Name = 'SHELLEXECASORIGINALUSER'; - if IsUninstaller and RunAsOriginalUser then - NoUninstallFuncError(Proc.Name); - - Filename := Stack.GetString(PStart-2); - if not IsProtectedSrcExe(Filename) then begin - { Disable windows so the user can't utilize our UI during the - InstShellExec call } - WindowDisabler := TWindowDisabler.Create; - try - Stack.SetBool(PStart, InstShellExecEx(RunAsOriginalUser, - Stack.GetString(PStart-1), Filename, Stack.GetString(PStart-3), - Stack.GetString(PStart-4), TExecWait(Stack.GetInt(PStart-6)), - Stack.GetInt(PStart-5), ProcessMessagesProc, ErrorCode)); - finally - WindowDisabler.Free; - end; - Stack.SetInt(PStart-7, ErrorCode); - end else begin - Stack.SetBool(PStart, False); - Stack.SetInt(PStart-7, ERROR_ACCESS_DENIED); - end; - end else if Proc.Name = 'ISPROTECTEDSYSTEMFILE' then begin - Stack.SetBool(PStart, IsProtectedSystemFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); - end else if Proc.Name = 'MAKEPENDINGFILERENAMEOPERATIONSCHECKSUM' then begin - Stack.SetString(PStart, SHA256DigestToString(MakePendingFileRenameOperationsChecksum)); - end else if Proc.Name = 'MODIFYPIFFILE' then begin - Stack.SetBool(PStart, ModifyPifFile(Stack.GetString(PStart-1), Stack.GetBool(PStart-2))); - end else if Proc.Name = 'REGISTERSERVER' then begin - RegisterServer(False, Stack.GetBool(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2)); - end else if Proc.Name = 'UNREGISTERSERVER' then begin - try - RegisterServer(True, Stack.GetBool(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3)); - Stack.SetBool(PStart, True); - except - Stack.SetBool(PStart, False); - end; - end else if Proc.Name = 'UNREGISTERFONT' then begin - UnregisterFont(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2)); - end else if Proc.Name = 'RESTARTREPLACE' then begin - RestartReplace(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1)); - end else if Proc.Name = 'FORCEDIRECTORIES' then begin - Stack.SetBool(PStart, ForceDirectories(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); - end else - Result := False; + Result := String(PSErrorToString(Code, Caller.LastExParam)); + end; end; -function InstFuncOleProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; -var - PStart: Cardinal; +function GetCodePreviousData(const ExpandedAppID, ValueName, DefaultValueData: String): String; begin - PStart := Stack.Count-1; - Result := True; + { do not localize or change the following string } + Result := GetPreviousData(ExpandedAppId, 'Inno Setup CodeFile: ' + ValueName, DefaultValueData); +end; - if Proc.Name = 'CREATESHELLLINK' then begin - Stack.SetString(PStart, CreateShellLink(Stack.GetString(PStart-1), - Stack.GetString(PStart-2), Stack.GetString(PStart-3), - Stack.GetString(PStart-4), Stack.GetString(PStart-5), - Stack.GetString(PStart-6), Stack.GetInt(PStart-7), - Stack.GetInt(PStart-8), 0, '', nil, False, False)); - end else if Proc.Name = 'REGISTERTYPELIBRARY' then begin - if Stack.GetBool(PStart) then - HelperRegisterTypeLibrary(False, Stack.GetString(PStart-1)) - else - RegisterTypeLibrary(Stack.GetString(PStart-1)); - end else if Proc.Name = 'UNREGISTERTYPELIBRARY' then begin - try - if Stack.GetBool(PStart-1) then - HelperRegisterTypeLibrary(True, Stack.GetString(PStart-2)) - else - UnregisterTypeLibrary(Stack.GetString(PStart-2)); - Stack.SetBool(PStart, True); - except - Stack.SetBool(PStart, False); - end; - end else if Proc.Name = 'UNPINSHELLLINK' then begin - Stack.SetBool(PStart, UnpinShellLink(Stack.GetString(PStart-1))); +{ Also see RegisterUninstallInfo in Install.pas } +function SetCodePreviousData(const PreviousDataKey: HKEY; const ValueName, ValueData: String): Boolean; +begin + if ValueData <> '' then begin + { do not localize or change the following string } + Result := RegSetValueEx(PreviousDataKey, PChar('Inno Setup CodeFile: ' + ValueName), 0, REG_SZ, PChar(ValueData), (Length(ValueData)+1)*SizeOf(ValueData[1])) = ERROR_SUCCESS end else - Result := False; + Result := True; end; -function MainFuncProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; - - function CustomMessage(const MsgName: String): String; - begin - if not GetCustomMessageValue(MsgName, Result) then - InternalError(Format('Unknown custom message name "%s"', [MsgName])); - end; - +function LoadStringFromFile(const FileName: String; var S: AnsiString; + const Sharing: TFileSharing): Boolean; var - PStart: Cardinal; - MinVersion, OnlyBelowVersion: TSetupVersionData; - StringList: TStringList; - S: String; - Components, Suppressible: Boolean; - Default: Integer; + F: TFile; + N: Cardinal; begin - PStart := Stack.Count-1; - Result := True; - - if Proc.Name = 'ACTIVELANGUAGE' then begin - Stack.SetString(PStart, ExpandConst('{language}')); - end else if Proc.Name = 'EXPANDCONSTANT' then begin - Stack.SetString(PStart, ExpandConst(Stack.GetString(PStart-1))); - end else if Proc.Name = 'EXPANDCONSTANTEX' then begin - Stack.SetString(PStart, ExpandConstEx(Stack.GetString(PStart-1), [Stack.GetString(PStart-2), Stack.GetString(PStart-3)])); - end else if Proc.Name = 'EXITSETUPMSGBOX' then begin - Stack.SetBool(PStart, ExitSetupMsgBox()); - end else if Proc.Name = 'GETSHELLFOLDERBYCSIDL' then begin - Stack.SetString(PStart, GetShellFolderByCSIDL(Stack.GetInt(PStart-1), Stack.GetBool(PStart-2))); - end else if Proc.Name = 'INSTALLONTHISVERSION' then begin - if not StrToSetupVersionData(Stack.GetString(PStart-1), MinVersion) then - InternalError('InstallOnThisVersion: Invalid MinVersion string') - else if not StrToSetupVersionData(Stack.GetString(PStart-2), OnlyBelowVersion) then - InternalError('InstallOnThisVersion: Invalid OnlyBelowVersion string') - else - Stack.SetBool(PStart, (InstallOnThisVersion(MinVersion, OnlyBelowVersion) = irInstall)); - end else if Proc.Name = 'GETWINDOWSVERSION' then begin - Stack.SetUInt(PStart, WindowsVersion); - end else if Proc.Name = 'GETWINDOWSVERSIONSTRING' then begin - Stack.SetString(PStart, Format('%u.%.2u.%u', [WindowsVersion shr 24, - (WindowsVersion shr 16) and $FF, WindowsVersion and $FFFF])); - end else if (Proc.Name = 'MSGBOX') or (Proc.Name = 'SUPPRESSIBLEMSGBOX') then begin - if Proc.Name = 'MSGBOX' then begin - Suppressible := False; - Default := 0; - end else begin - Suppressible := True; - Default := Stack.GetInt(PStart-4); - end; - Stack.SetInt(PStart, LoggedMsgBox(Stack.GetString(PStart-1), GetMsgBoxCaption, TMsgBoxType(Stack.GetInt(PStart-2)), Stack.GetInt(PStart-3), Suppressible, Default)); - end else if (Proc.Name = 'TASKDIALOGMSGBOX') or (Proc.Name = 'SUPPRESSIBLETASKDIALOGMSGBOX') then begin - if Proc.Name = 'TASKDIALOGMSGBOX' then begin - Suppressible := False; - Default := 0; - end else begin - Suppressible := True; - Default := Stack.GetInt(PStart-7); - end; - var ButtonLabels := Stack.GetStringArray(PStart-5); - Stack.SetInt(PStart, LoggedTaskDialogMsgBox('', Stack.GetString(PStart-1), Stack.GetString(PStart-2), GetMsgBoxCaption, TMsgBoxType(Stack.GetInt(PStart-3)), Stack.GetInt(PStart-4), ButtonLabels, Stack.GetInt(PStart-6), Suppressible, Default)); - end else if Proc.Name = 'ISWIN64' then begin - Stack.SetBool(PStart, IsWin64); - end else if Proc.Name = 'IS64BITINSTALLMODE' then begin - Stack.SetBool(PStart, Is64BitInstallMode); - end else if Proc.Name = 'PROCESSORARCHITECTURE' then begin - Stack.SetInt(PStart, Integer(ProcessorArchitecture)); - end else if (Proc.Name = 'ISARM32COMPATIBLE') or (Proc.Name = 'ISARM64') or - (Proc.Name = 'ISX64') or (Proc.Name = 'ISX64OS') or (Proc.Name = 'ISX64COMPATIBLE') or - (Proc.Name = 'ISX86') or (Proc.Name = 'ISX86OS') or (Proc.Name = 'ISX86COMPATIBLE') then begin - var ArchitectureIdentifier := LowerCase(Copy(String(Proc.Name), 3, MaxInt)); - Stack.SetBool(PStart, EvalArchitectureIdentifier(ArchitectureIdentifier)); - end else if Proc.Name = 'CUSTOMMESSAGE' then begin - Stack.SetString(PStart, CustomMessage(Stack.GetString(PStart-1))); - end else if Proc.Name = 'RMSESSIONSTARTED' then begin - Stack.SetBool(PStart, RmSessionStarted); - end else if Proc.Name = 'REGISTEREXTRACLOSEAPPLICATIONSRESOURCE' then begin - Stack.SetBool(PStart, CodeRegisterExtraCloseApplicationsResource(Stack.GetBool(PStart-1), Stack.GetString(PStart-2))); - end else if Proc.Name = 'GETMAINFORM' then begin - Stack.SetClass(PStart, GetMainForm); - end else if Proc.Name = 'GETWIZARDFORM' then begin - Stack.SetClass(PStart, GetWizardForm); - end else if (Proc.Name = 'WIZARDISCOMPONENTSELECTED') or (Proc.Name = 'ISCOMPONENTSELECTED') or - (Proc.Name = 'WIZARDISTASKSELECTED') or (Proc.Name = 'ISTASKSELECTED') then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - StringList := TStringList.Create(); + try + F := TFileRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenExisting, faRead, Sharing); try - Components := (Proc.Name = 'WIZARDISCOMPONENTSELECTED') or (Proc.Name = 'ISCOMPONENTSELECTED'); - if Components then - GetWizardForm.GetSelectedComponents(StringList, False, False) - else - GetWizardForm.GetSelectedTasks(StringList, False, False, False); - S := Stack.GetString(PStart-1); - StringChange(S, '/', '\'); - if Components then - Stack.SetBool(PStart, ShouldProcessEntry(StringList, nil, S, '', '', '')) - else - Stack.SetBool(PStart, ShouldProcessEntry(nil, StringList, '', S, '', '')); + N := F.CappedSize; + SetLength(S, N); + F.ReadBuffer(S[1], N); finally - StringList.Free(); + F.Free; end; - end else + + Result := True; + except Result := False; + end; end; -function MessagesProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; +function LoadStringsFromFile(const FileName: String; const Stack: TPSStack; + const ItemNo: Longint; const Sharing: TFileSharing): Boolean; var - PStart: Cardinal; + F: TTextFileReader; begin - PStart := Stack.Count-1; - Result := True; + try + F := TTextFileReaderRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenExisting, faRead, Sharing); + try + var ArrayBuilder := Stack.InitArrayBuilder(ItemNo); + while not F.Eof do + ArrayBuilder.Add(F.ReadLine); + finally + F.Free; + end; - if Proc.Name = 'SETUPMESSAGE' then begin - Stack.SetString(PStart, SetupMessages[TSetupMessageID(Stack.GetInt(PStart-1))]); - end else + Result := True; + except Result := False; + end; end; -function SystemProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; +function SaveStringToFile(const FileName: String; const S: AnsiString; Append: Boolean): Boolean; var - PStart: Cardinal; F: TFile; - TmpFileSize: Integer64; begin - PStart := Stack.Count-1; - Result := True; - - if Proc.Name = 'RANDOM' then begin - Stack.SetInt(PStart, Random(Stack.GetInt(PStart-1))); - end else if Proc.Name = 'FILESIZE' then begin - try - F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite); - try - Stack.SetInt(PStart-2, F.CappedSize); - Stack.SetBool(PStart, True); - finally - F.Free; - end; - except - Stack.SetBool(PStart, False); - end; - end else if Proc.Name = 'FILESIZE64' then begin + try + if Append then + F := TFileRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenAlways, faWrite, fsNone) + else + F := TFileRedir.Create(ScriptFuncDisableFsRedir, FileName, fdCreateAlways, faWrite, fsNone); try - F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite); - try - TmpFileSize := F.Size; { Make sure we access F.Size only once } - Stack.SetInt64(PStart-2, Int64(TmpFileSize.Hi) shl 32 + TmpFileSize.Lo); - Stack.SetBool(PStart, True); - finally - F.Free; - end; - except - Stack.SetBool(PStart, False); - end; - end else if Proc.Name = 'SET8087CW' then begin - Set8087CW(Stack.GetInt(PStart)); - end else if Proc.Name = 'GET8087CW' then begin - Stack.SetInt(PStart, Get8087CW); - end else if Proc.Name = 'UTF8ENCODE' then begin - Stack.SetAnsiString(PStart, Utf8Encode(Stack.GetString(PStart-1))); - end else if Proc.Name = 'UTF8DECODE' then begin - Stack.SetString(PStart, UTF8ToString(Stack.GetAnsiString(PStart-1))); - end else - Result := False; -end; - -type - { *Must* keep this in synch with ScriptFunc_C } - TFindRec = record - Name: String; - Attributes: LongWord; - SizeHigh: LongWord; - SizeLow: LongWord; - CreationTime: TFileTime; - LastAccessTime: TFileTime; - LastWriteTime: TFileTime; - AlternateName: String; - FindHandle: THandle; - end; - -function SysUtilsProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; - - { ExtractRelativePath is not in Delphi 2's SysUtils. Use the one from Delphi 7.01. } - function NewExtractRelativePath(BaseName, DestName: string): string; - var - BasePath, DestPath: string; - BaseLead, DestLead: PChar; - BasePtr, DestPtr: PChar; - - function ExtractFilePathNoDrive(const FileName: string): string; - begin - Result := PathExtractPath(FileName); - Delete(Result, 1, Length(PathExtractDrive(FileName))); - end; - - function Next(var Lead: PChar): PChar; - begin - Result := Lead; - if Result = nil then Exit; - Lead := PathStrScan(Lead, '\'); - if Lead <> nil then - begin - Lead^ := #0; - Inc(Lead); - end; + F.SeekToEnd; + F.WriteAnsiString(S); + finally + F.Free; end; - begin - { For consistency with the PathExtract* functions, normalize slashes so - that forward slashes and multiple slashes work with this function also } - BaseName := PathNormalizeSlashes(BaseName); - DestName := PathNormalizeSlashes(DestName); - - if PathCompare(PathExtractDrive(BaseName), PathExtractDrive(DestName)) = 0 then - begin - BasePath := ExtractFilePathNoDrive(BaseName); - UniqueString(BasePath); - DestPath := ExtractFilePathNoDrive(DestName); - UniqueString(DestPath); - BaseLead := Pointer(BasePath); - BasePtr := Next(BaseLead); - DestLead := Pointer(DestPath); - DestPtr := Next(DestLead); - while (BasePtr <> nil) and (DestPtr <> nil) and (PathCompare(BasePtr, DestPtr) = 0) do - begin - BasePtr := Next(BaseLead); - DestPtr := Next(DestLead); - end; - Result := ''; - while BaseLead <> nil do - begin - Result := Result + '..\'; { Do not localize } - Next(BaseLead); - end; - if (DestPtr <> nil) and (DestPtr^ <> #0) then - Result := Result + DestPtr + '\'; - if DestLead <> nil then - Result := Result + DestLead; // destlead already has a trailing backslash - Result := Result + PathExtractName(DestName); - end - else - Result := DestName; - end; - - { Use our own FileSearch function which includes these improvements over - Delphi's version: - - it supports MBCS and uses Path* functions - - it uses NewFileExistsRedir instead of FileExists - - it doesn't search the current directory unless it's told to - - it always returns a fully-qualified path } - function NewFileSearch(const DisableFsRedir: Boolean; - const Name, DirList: String): String; - var - I, P, L: Integer; - begin - { If Name is absolute, drive-relative, or root-relative, don't search DirList } - if PathDrivePartLengthEx(Name, True) <> 0 then begin - Result := PathExpand(Name); - if NewFileExistsRedir(DisableFsRedir, Result) then - Exit; - end - else begin - P := 1; - L := Length(DirList); - while True do begin - while (P <= L) and (DirList[P] = ';') do - Inc(P); - if P > L then - Break; - I := P; - while (P <= L) and (DirList[P] <> ';') do - Inc(P, PathCharLength(DirList, P)); - Result := PathExpand(PathCombine(Copy(DirList, I, P - I), Name)); - if NewFileExistsRedir(DisableFsRedir, Result) then - Exit; - end; - end; - Result := ''; + Result := True; + except + Result := False; end; +end; +function SaveStringsToFile(const FileName: String; const Stack: TPSStack; + const ItemNo: Longint; Append, UTF8, UTF8WithoutBOM: Boolean): Boolean; var - PStart: Cardinal; - OldName: String; - NewDateSeparator, NewTimeSeparator: Char; - OldDateSeparator, OldTimeSeparator: Char; + F: TTextFileWriter; begin - PStart := Stack.Count-1; - Result := True; - - if Proc.Name = 'BEEP' then begin - Beep; - end else if Proc.Name = 'TRIMLEFT' then begin - Stack.SetString(PStart, TrimLeft(Stack.GetString(PStart-1))); - end else if Proc.Name = 'TRIMRIGHT' then begin - Stack.SetString(PStart, TrimRight(Stack.GetString(PStart-1))); - end else if Proc.Name = 'GETCURRENTDIR' then begin - Stack.SetString(PStart, GetCurrentDir()); - end else if Proc.Name = 'SETCURRENTDIR' then begin - Stack.SetBool(PStart, SetCurrentDir(Stack.GetString(PStart-1))); - end else if Proc.Name = 'EXPANDFILENAME' then begin - Stack.SetString(PStart, PathExpand(Stack.GetString(PStart-1))); - end else if Proc.Name = 'EXPANDUNCFILENAME' then begin - Stack.SetString(PStart, ExpandUNCFileName(Stack.GetString(PStart-1))); - end else if Proc.Name = 'EXTRACTRELATIVEPATH' then begin - Stack.SetString(PStart, NewExtractRelativePath(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); - end else if Proc.Name = 'EXTRACTFILEDIR' then begin - Stack.SetString(PStart, PathExtractDir(Stack.GetString(PStart-1))); - end else if Proc.Name = 'EXTRACTFILEDRIVE' then begin - Stack.SetString(PStart, PathExtractDrive(Stack.GetString(PStart-1))); - end else if Proc.Name = 'EXTRACTFILEEXT' then begin - Stack.SetString(PStart, PathExtractExt(Stack.GetString(PStart-1))); - end else if Proc.Name = 'EXTRACTFILENAME' then begin - Stack.SetString(PStart, PathExtractName(Stack.GetString(PStart-1))); - end else if Proc.Name = 'EXTRACTFILEPATH' then begin - Stack.SetString(PStart, PathExtractPath(Stack.GetString(PStart-1))); - end else if Proc.Name = 'CHANGEFILEEXT' then begin - Stack.SetString(PStart, PathChangeExt(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); - end else if Proc.Name = 'FILESEARCH' then begin - Stack.SetString(PStart, NewFileSearch(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetString(PStart-2))); - end else if Proc.Name = 'RENAMEFILE' then begin - OldName := Stack.GetString(PStart-1); - if not IsProtectedSrcExe(OldName) then - Stack.SetBool(PStart, MoveFileRedir(ScriptFuncDisableFsRedir, OldName, Stack.GetString(PStart-2))) + try + if Append then + F := TTextFileWriterRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenAlways, faWrite, fsNone) else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'DELETEFILE' then begin - Stack.SetBool(PStart, DeleteFileRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); - end else if Proc.Name = 'CREATEDIR' then begin - Stack.SetBool(PStart, CreateDirectoryRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); - end else if Proc.Name = 'REMOVEDIR' then begin - Stack.SetBool(PStart, RemoveDirectoryRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); - end else if Proc.Name = 'COMPARESTR' then begin - Stack.SetInt(PStart, CompareStr(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); - end else if Proc.Name = 'COMPARETEXT' then begin - Stack.SetInt(PStart, CompareText(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); - end else if Proc.Name = 'SAMESTR' then begin - Stack.SetBool(PStart, CompareStr(Stack.GetString(PStart-1), Stack.GetString(PStart-2)) = 0); - end else if Proc.Name = 'SAMETEXT' then begin - Stack.SetBool(PStart, CompareText(Stack.GetString(PStart-1), Stack.GetString(PStart-2)) = 0); - end else if Proc.Name = 'GETDATETIMESTRING' then begin - OldDateSeparator := FormatSettings.DateSeparator; - OldTimeSeparator := FormatSettings.TimeSeparator; + F := TTextFileWriterRedir.Create(ScriptFuncDisableFsRedir, FileName, fdCreateAlways, faWrite, fsNone); try - NewDateSeparator := Stack.GetString(PStart-2)[1]; - NewTimeSeparator := Stack.GetString(PStart-3)[1]; - if NewDateSeparator <> #0 then - FormatSettings.DateSeparator := NewDateSeparator; - if NewTimeSeparator <> #0 then - FormatSettings.TimeSeparator := NewTimeSeparator; - Stack.SetString(PStart, FormatDateTime(Stack.GetString(PStart-1), Now())); + if UTF8 and UTF8WithoutBOM then + F.UTF8WithoutBOM := UTF8WithoutBOM; + var ArrayEnumerator := Stack.InitArrayEnumerator(ItemNo); + while ArrayEnumerator.HasNext do begin + var S := ArrayEnumerator.Next; + if not UTF8 then + F.WriteAnsiLine(AnsiString(S)) + else + F.WriteLine(S); + end; finally - FormatSettings.TimeSeparator := OldTimeSeparator; - FormatSettings.DateSeparator := OldDateSeparator; + F.Free; end; - end else if Proc.Name = 'SYSERRORMESSAGE' then begin - Stack.SetString(PStart, Win32ErrorString(Stack.GetInt(PStart-1))); - end else + + Result := True; + except Result := False; + end; end; -function VerInfoFuncProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; var - PStart: Cardinal; - VersionNumbers: TFileVersionNumbers; + ASMInliners: array of Pointer; + +function CreateCallback(const Caller: TPSExec; const P: PPSVariantProcPtr): LongWord; +var + ProcRec: TPSInternalProcRec; + Method: TMethod; + Inliner: TASMInline; + ParamCount, SwapFirst, SwapLast: Integer; + S: tbtstring; begin - PStart := Stack.Count-1; - Result := True; + { ProcNo 0 means nil was passed by the script } + if P.ProcNo = 0 then + InternalError('Invalid Method value'); + + { Calculate parameter count of our proc, will need this later. } + ProcRec := Caller.GetProcNo(P.ProcNo) as TPSInternalProcRec; + S := ProcRec.ExportDecl; + GRFW(S); + ParamCount := 0; + while S <> '' do begin + Inc(ParamCount); + GRFW(S); + end; - if Proc.Name = 'GETVERSIONNUMBERS' then begin - if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin - Stack.SetInt(PStart-2, VersionNumbers.MS); - Stack.SetInt(PStart-3, VersionNumbers.LS); - Stack.SetBool(PStart, True); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'GETVERSIONCOMPONENTS' then begin - if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin - Stack.SetUInt(PStart-2, VersionNumbers.MS shr 16); - Stack.SetUInt(PStart-3, VersionNumbers.MS and $FFFF); - Stack.SetUInt(PStart-4, VersionNumbers.LS shr 16); - Stack.SetUInt(PStart-5, VersionNumbers.LS and $FFFF); - Stack.SetBool(PStart, True); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'GETVERSIONNUMBERSSTRING' then begin - if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin - Stack.SetString(PStart-2, Format('%u.%u.%u.%u', [VersionNumbers.MS shr 16, - VersionNumbers.MS and $FFFF, VersionNumbers.LS shr 16, VersionNumbers.LS and $FFFF])); - Stack.SetBool(PStart, True); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'GETPACKEDVERSION' then begin - if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin - Stack.SetInt64(PStart-2, (Int64(VersionNumbers.MS) shl 32) or VersionNumbers.LS); - Stack.SetBool(PStart, True); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'PACKVERSIONNUMBERS' then begin - Stack.SetInt64(PStart, Int64((UInt64(Stack.GetUInt(PStart-1)) shl 32) or Stack.GetUInt(PStart-2))); - end else if Proc.Name = 'PACKVERSIONCOMPONENTS' then begin - VersionNumbers.MS := (Stack.GetUInt(PStart-1) shl 16) or (Stack.GetUInt(PStart-2) and $FFFF); - VersionNumbers.LS := (Stack.GetUInt(PStart-3) shl 16) or (Stack.GetUInt(PStart-4) and $FFFF); - Stack.SetInt64(PStart, Int64((UInt64(VersionNumbers.MS) shl 32) or VersionNumbers.LS)); - end else if Proc.Name = 'COMPAREPACKEDVERSION' then begin - Stack.SetInt(PStart, Compare64(Integer64(Stack.GetInt64(PStart-1)), Integer64(Stack.GetInt64(PStart-2)))); - end else if Proc.Name = 'SAMEPACKEDVERSION' then begin - Stack.SetBool(PStart, Compare64(Integer64(Stack.GetInt64(PStart-1)), Integer64(Stack.GetInt64(PStart-2))) = 0); - end else if Proc.Name = 'UNPACKVERSIONNUMBERS' then begin - VersionNumbers.MS := UInt64(Stack.GetInt64(PStart)) shr 32; - VersionNumbers.LS := UInt64(Stack.GetInt64(PStart)) and $FFFFFFFF; - Stack.SetUInt(PStart-1, VersionNumbers.MS); - Stack.SetUInt(PStart-2, VersionNumbers.LS); - end else if Proc.Name = 'UNPACKVERSIONCOMPONENTS' then begin - VersionNumbers.MS := UInt64(Stack.GetInt64(PStart)) shr 32; - VersionNumbers.LS := UInt64(Stack.GetInt64(PStart)) and $FFFFFFFF; - Stack.SetUInt(PStart-1, VersionNumbers.MS shr 16); - Stack.SetUInt(PStart-2, VersionNumbers.MS and $FFFF); - Stack.SetUInt(PStart-3, VersionNumbers.LS shr 16); - Stack.SetUInt(PStart-4, VersionNumbers.LS and $FFFF); - end else if Proc.Name = 'VERSIONTOSTR' then begin - VersionNumbers.MS := UInt64(Stack.GetInt64(PStart-1)) shr 32; - VersionNumbers.LS := UInt64(Stack.GetInt64(PStart-1)) and $FFFFFFFF; - Stack.SetString(PStart, Format('%u.%u.%u.%u', [VersionNumbers.MS shr 16, - VersionNumbers.MS and $FFFF, VersionNumbers.LS shr 16, VersionNumbers.LS and $FFFF])); - end else if Proc.Name = 'STRTOVERSION' then begin - if StrToVersionNumbers(Stack.GetString(PStart-1), VersionNumbers) then begin - Stack.SetInt64(PStart-2, (Int64(VersionNumbers.MS) shl 32) or VersionNumbers.LS); - Stack.SetBool(PStart, True); - end else - Stack.SetBool(PStart, False); - end else - Result := False; -end; + { Turn our proc into a callable TMethod - its Code will point to + ROPS' MyAllMethodsHandler and its Data to a record identifying our proc. + When called, MyAllMethodsHandler will use the record to call our proc. } + Method := MkMethod(Caller, P.ProcNo); -type - TDllProc = function(const Param1, Param2: Longint): Longint; stdcall; + { Wrap our TMethod with a dynamically generated stdcall callback which will + do two things: + -Remember the Data pointer which MyAllMethodsHandler needs. + -Handle the calling convention mismatch. -function WindowsProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; -var - PStart: Cardinal; - DllProc: TDllProc; - DllHandle: THandle; - S: AnsiString; -begin - PStart := Stack.Count-1; - Result := True; + Based on InnoCallback by Sherlock Software, see + http://www.sherlocksoftware.org/page.php?id=54 and + https://github.com/thenickdude/InnoCallback. } + Inliner := TASMInline.create; + try + Inliner.Pop(EAX); //get the retptr off the stack + + SwapFirst := 2; + SwapLast := ParamCount-1; + + //Reverse the order of parameters from param3 onwards in the stack + while SwapLast > SwapFirst do begin + Inliner.Mov(ECX, Inliner.Addr(ESP, SwapFirst * 4)); //load the first item of the pair + Inliner.Mov(EDX, Inliner.Addr(ESP, SwapLast * 4)); //load the last item of the pair + Inliner.Mov(Inliner.Addr(ESP, SwapFirst * 4), EDX); + Inliner.Mov(Inliner.Addr(ESP, SwapLast * 4), ECX); + Inc(SwapFirst); + Dec(SwapLast); + end; - if Proc.Name = 'SLEEP' then begin - Sleep(Stack.GetInt(PStart)); - end else if Proc.Name = 'FINDWINDOWBYCLASSNAME' then begin - Stack.SetInt(PStart, FindWindow(PChar(Stack.GetString(PStart-1)), nil)); - end else if Proc.Name = 'FINDWINDOWBYWINDOWNAME' then begin - Stack.SetInt(PStart, FindWindow(nil, PChar(Stack.GetString(PStart-1)))); - end else if Proc.Name = 'SENDMESSAGE' then begin - Stack.SetInt(PStart, SendMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4))); - end else if Proc.Name = 'POSTMESSAGE' then begin - Stack.SetBool(PStart, PostMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4))); - end else if Proc.Name = 'SENDNOTIFYMESSAGE' then begin - Stack.SetBool(PStart, SendNotifyMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4))); - end else if Proc.Name = 'REGISTERWINDOWMESSAGE' then begin - Stack.SetInt(PStart, RegisterWindowMessage(PChar(Stack.GetString(PStart-1)))); - end else if Proc.Name = 'SENDBROADCASTMESSAGE' then begin - Stack.SetInt(PStart, SendMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3))); - end else if Proc.Name = 'POSTBROADCASTMESSAGE' then begin - Stack.SetBool(PStart, PostMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3))); - end else if Proc.Name = 'SENDBROADCASTNOTIFYMESSAGE' then begin - Stack.SetBool(PStart, SendNotifyMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3))); - end else if Proc.Name = 'LOADDLL' then begin - DllHandle := SafeLoadLibrary(Stack.GetString(PStart-1), SEM_NOOPENFILEERRORBOX); - if DllHandle <> 0 then - Stack.SetInt(PStart-2, 0) - else - Stack.SetInt(PStart-2, GetLastError()); - Stack.SetInt(PStart, DllHandle); - end else if Proc.Name = 'CALLDLLPROC' then begin - @DllProc := GetProcAddress(Stack.GetInt(PStart-1), PChar(Stack.GetString(PStart-2))); - if Assigned(DllProc) then begin - Stack.SetInt(PStart-5, DllProc(Stack.GetInt(PStart-3), Stack.GetInt(PStart-4))); - Stack.SetBool(PStart, True); - end else - Stack.SetBool(PStart, False); - end else if Proc.Name = 'FREEDLL' then begin - Stack.SetBool(PStart, FreeLibrary(Stack.GetInt(PStart-1))); - end else if Proc.Name = 'CREATEMUTEX' then begin - Windows.CreateMutex(nil, False, PChar(Stack.GetString(PStart))); - end else if Proc.Name = 'OEMTOCHARBUFF' then begin - S := Stack.GetAnsiString(PStart); - OemToCharBuffA(PAnsiChar(S), PAnsiChar(S), Length(S)); - Stack.SetAnsiString(PStart, S); - end else if Proc.Name = 'CHARTOOEMBUFF' then begin - S := Stack.GetAnsiString(PStart); - CharToOemBuffA(PAnsiChar(S), PAnsiChar(S), Length(S)); - Stack.SetAnsiString(PStart, S); - end else - Result := False; -end; + if ParamCount >= 1 then + Inliner.Pop(EDX); //load param1 + if ParamCount >= 2 then + Inliner.Pop(ECX); //load param2 -function Ole2Proc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; -begin - Result := True; + Inliner.Push(EAX); //put the retptr back onto the stack - if Proc.Name = 'COFREEUNUSEDLIBRARIES' then begin - CoFreeUnusedLibraries; - end else - Result := False; -end; + Inliner.Mov(EAX, LongWord(Method.Data)); //Load the self ptr -function LoggingFuncProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; -var - PStart: Cardinal; -begin - PStart := Stack.Count-1; - Result := True; + Inliner.Jmp(Method.Code); //jump to the wrapped proc - if Proc.Name = 'LOG' then begin - Log(Stack.GetString(PStart)); - end else - Result := False; + SetLength(ASMInliners, Length(ASMInliners) + 1); + ASMInliners[High(ASMInliners)] := Inliner.SaveAsMemory; + Result := LongWord(ASMInliners[High(ASMInliners)]); + finally + Inliner.Free; + end; end; -{ Other } +{---} + +type + TScriptFunc = reference to procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal); + TScriptFuncs = TDictionary; var - ASMInliners: array of Pointer; + ScriptFuncs: TScriptFuncs; -function OtherProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; +function ScriptFuncPSProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; +begin + var ScriptFunc: TScriptFunc; + Result := ScriptFuncs.TryGetValue(Proc.Name, ScriptFunc); + if Result then + ScriptFunc(Caller, Proc.Name, Stack, Stack.Count-1); +end; - function GetExceptionMessage: String; - var - Code: TPSError; - E: TObject; - begin - Code := Caller.LastEx; - if Code = erNoError then - Result := '(There is no current exception)' - else begin - E := Caller.LastExObject; - if Assigned(E) and (E is Exception) then - Result := Exception(E).Message - else - Result := String(PSErrorToString(Code, Caller.LastExParam)); - end; - end; +procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); +{$IFDEF DEBUG} +var + Count: Integer; +{$ENDIF} - function GetCodePreviousData(const ExpandedAppID, ValueName, DefaultValueData: String): String; + procedure RegisterScriptFunc(const Name: AnsiString; const ScriptFunc: TScriptFunc); overload; begin - { do not localize or change the following string } - Result := GetPreviousData(ExpandedAppId, 'Inno Setup CodeFile: ' + ValueName, DefaultValueData); + ScriptFuncs.Add(FastUpperCase(Name), ScriptFunc); + ScriptInterpreter.RegisterFunctionName(Name, ScriptFuncPSProc, nil, nil); + {$IFDEF DEBUG} + Inc(Count); + {$ENDIF} end; - { Also see RegisterUninstallInfo in Install.pas } - function SetCodePreviousData(const PreviousDataKey: HKEY; const ValueName, ValueData: String): Boolean; + procedure RegisterScriptFunc(const Names: array of AnsiString; const ScriptFunc: TScriptFunc); overload; begin - if ValueData <> '' then begin - { do not localize or change the following string } - Result := RegSetValueEx(PreviousDataKey, PChar('Inno Setup CodeFile: ' + ValueName), 0, REG_SZ, PChar(ValueData), (Length(ValueData)+1)*SizeOf(ValueData[1])) = ERROR_SUCCESS - end else - Result := True; + for var Name in Names do + RegisterScriptFunc(Name, ScriptFunc); end; - function LoadStringFromFile(const FileName: String; var S: AnsiString; - const Sharing: TFileSharing): Boolean; - var - F: TFile; - N: Cardinal; + procedure RegisterScriptDlgScriptFuncs; begin - try - F := TFileRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenExisting, faRead, Sharing); + RegisterScriptFunc('PAGEFROMID', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + Stack.SetClass(PStart, GetWizardForm.PageFromID(Stack.GetInt(PStart-1))); + end); + RegisterScriptFunc('PAGEINDEXFROMID', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + Stack.SetInt(PStart, GetWizardForm.PageIndexFromID(Stack.GetInt(PStart-1))); + end); + RegisterScriptFunc('CREATECUSTOMPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + var NewPage := TWizardPage.Create(GetWizardForm); try - N := F.CappedSize; - SetLength(S, N); - F.ReadBuffer(S[1], N); - finally - F.Free; + NewPage.Caption := Stack.GetString(PStart-2); + NewPage.Description := Stack.GetString(PStart-3); + GetWizardForm.AddPage(NewPage, Stack.GetInt(PStart-1)); + except + NewPage.Free; + raise; end; - - Result := True; - except - Result := False; - end; + Stack.SetClass(PStart, NewPage); + end); + RegisterScriptFunc('CREATEINPUTQUERYPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + var NewInputQueryPage := TInputQueryWizardPage.Create(GetWizardForm); + try + NewInputQueryPage.Caption := Stack.GetString(PStart-2); + NewInputQueryPage.Description := Stack.GetString(PStart-3); + GetWizardForm.AddPage(NewInputQueryPage, Stack.GetInt(PStart-1)); + NewInputQueryPage.Initialize(Stack.GetString(PStart-4)); + except + NewInputQueryPage.Free; + raise; + end; + Stack.SetClass(PStart, NewInputQueryPage); + end); + RegisterScriptFunc('CREATEINPUTOPTIONPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + var NewInputOptionPage := TInputOptionWizardPage.Create(GetWizardForm); + try + NewInputOptionPage.Caption := Stack.GetString(PStart-2); + NewInputOptionPage.Description := Stack.GetString(PStart-3); + GetWizardForm.AddPage(NewInputOptionPage, Stack.GetInt(PStart-1)); + NewInputOptionPage.Initialize(Stack.GetString(PStart-4), + Stack.GetBool(PStart-5), Stack.GetBool(PStart-6)); + except + NewInputOptionPage.Free; + raise; + end; + Stack.SetClass(PStart, NewInputOptionPage); + end); + RegisterScriptFunc('CREATEINPUTDIRPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + var NewInputDirPage := TInputDirWizardPage.Create(GetWizardForm); + try + NewInputDirPage.Caption := Stack.GetString(PStart-2); + NewInputDirPage.Description := Stack.GetString(PStart-3); + GetWizardForm.AddPage(NewInputDirPage, Stack.GetInt(PStart-1)); + NewInputDirPage.Initialize(Stack.GetString(PStart-4), Stack.GetBool(PStart-5), + Stack.GetString(PStart-6)); + except + NewInputDirPage.Free; + raise; + end; + Stack.SetClass(PStart, NewInputDirPage); + end); + RegisterScriptFunc('CREATEINPUTFILEPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + var NewInputFilePage := TInputFileWizardPage.Create(GetWizardForm); + try + NewInputFilePage.Caption := Stack.GetString(PStart-2); + NewInputFilePage.Description := Stack.GetString(PStart-3); + GetWizardForm.AddPage(NewInputFilePage, Stack.GetInt(PStart-1)); + NewInputFilePage.Initialize(Stack.GetString(PStart-4)); + except + NewInputFilePage.Free; + raise; + end; + Stack.SetClass(PStart, NewInputFilePage); + end); + RegisterScriptFunc('CREATEOUTPUTMSGPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + var NewOutputMsgPage := TOutputMsgWizardPage.Create(GetWizardForm); + try + NewOutputMsgPage.Caption := Stack.GetString(PStart-2); + NewOutputMsgPage.Description := Stack.GetString(PStart-3); + GetWizardForm.AddPage(NewOutputMsgPage, Stack.GetInt(PStart-1)); + NewOutputMsgPage.Initialize(Stack.GetString(PStart-4)); + except + NewOutputMsgPage.Free; + raise; + end; + Stack.SetClass(PStart, NewOutputMsgPage); + end); + RegisterScriptFunc('CREATEOUTPUTMSGMEMOPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + var NewOutputMsgMemoPage := TOutputMsgMemoWizardPage.Create(GetWizardForm); + try + NewOutputMsgMemoPage.Caption := Stack.GetString(PStart-2); + NewOutputMsgMemoPage.Description := Stack.GetString(PStart-3); + GetWizardForm.AddPage(NewOutputMsgMemoPage, Stack.GetInt(PStart-1)); + NewOutputMsgMemoPage.Initialize(Stack.GetString(PStart-4), + Stack.GetAnsiString(PStart-5)); + except + NewOutputMsgMemoPage.Free; + raise; + end; + Stack.SetClass(PStart, NewOutputMsgMemoPage); + end); + RegisterScriptFunc('CREATEOUTPUTPROGRESSPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + var NewOutputProgressPage := TOutputProgressWizardPage.Create(GetWizardForm); + try + NewOutputProgressPage.Caption := Stack.GetString(PStart-1); + NewOutputProgressPage.Description := Stack.GetString(PStart-2); + GetWizardForm.AddPage(NewOutputProgressPage, -1); + NewOutputProgressPage.Initialize; + except + NewOutputProgressPage.Free; + raise; + end; + Stack.SetClass(PStart, NewOutputProgressPage); + end); + RegisterScriptFunc('CREATEOUTPUTMARQUEEPROGRESSPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + var NewOutputMarqueeProgressPage := TOutputMarqueeProgressWizardPage.Create(GetWizardForm); + try + NewOutputMarqueeProgressPage.Caption := Stack.GetString(PStart-1); + NewOutputMarqueeProgressPage.Description := Stack.GetString(PStart-2); + GetWizardForm.AddPage(NewOutputMarqueeProgressPage, -1); + NewOutputMarqueeProgressPage.Initialize; + except + NewOutputMarqueeProgressPage.Free; + raise; + end; + Stack.SetClass(PStart, NewOutputMarqueeProgressPage); + end); + RegisterScriptFunc('CREATEDOWNLOADPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + var NewDownloadPage := TDownloadWizardPage.Create(GetWizardForm); + try + NewDownloadPage.Caption := Stack.GetString(PStart-1); + NewDownloadPage.Description := Stack.GetString(PStart-2); + GetWizardForm.AddPage(NewDownloadPage, -1); + NewDownloadPage.Initialize; + NewDownloadPage.OnDownloadProgress := TOnDownloadProgress(Stack.GetProc(PStart-3, Caller)); + except + NewDownloadPage.Free; + raise; + end; + Stack.SetClass(PStart, NewDownloadPage); + end); + RegisterScriptFunc('CREATEEXTRACTIONPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + var NewExtractionPage := TExtractionWizardPage.Create(GetWizardForm); + try + NewExtractionPage.Caption := Stack.GetString(PStart-1); + NewExtractionPage.Description := Stack.GetString(PStart-2); + GetWizardForm.AddPage(NewExtractionPage, -1); + NewExtractionPage.Initialize; + NewExtractionPage.OnExtractionProgress := TOnExtractionProgress(Stack.GetProc(PStart-3, Caller)); + except + NewExtractionPage.Free; + raise; + end; + Stack.SetClass(PStart, NewExtractionPage); + end); + RegisterScriptFunc('SCALEX', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + InitializeScaleBaseUnits; + Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitX, OrigBaseUnitX)); + end); + RegisterScriptFunc('SCALEY', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + InitializeScaleBaseUnits; + Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitY, OrigBaseUnitY)); + end); + RegisterScriptFunc('CREATECUSTOMFORM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + var NewSetupForm := TSetupForm.CreateNew(nil); + try + NewSetupForm.AutoScroll := False; + NewSetupForm.BorderStyle := bsDialog; + NewSetupForm.InitializeFont; + except + NewSetupForm.Free; + raise; + end; + Stack.SetClass(PStart, NewSetupForm); + end); end; - function LoadStringsFromFile(const FileName: String; const Stack: TPSStack; - const ItemNo: Longint; const Sharing: TFileSharing): Boolean; + procedure RegisterNewDiskFormScriptFuncs; var - F: TTextFileReader; + S: String; begin - try - F := TTextFileReaderRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenExisting, faRead, Sharing); - try - var ArrayBuilder := Stack.InitArrayBuilder(ItemNo); - while not F.Eof do - ArrayBuilder.Add(F.ReadLine); - finally - F.Free; - end; - - Result := True; - except - Result := False; - end; + RegisterScriptFunc('SELECTDISK', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + S := Stack.GetString(PStart-3); + Stack.SetBool(PStart, SelectDisk(Stack.GetInt(PStart-1), Stack.GetString(PStart-2), S)); + Stack.SetString(PStart-3, S); + end); end; - function SaveStringToFile(const FileName: String; const S: AnsiString; Append: Boolean): Boolean; + procedure RegisterBrowseFuncScriptFuncs; var - F: TFile; + S: String; + ParentWnd: HWND; begin - try - if Append then - F := TFileRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenAlways, faWrite, fsNone) + RegisterScriptFunc('BROWSEFORFOLDER', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if Assigned(WizardForm) then + ParentWnd := WizardForm.Handle else - F := TFileRedir.Create(ScriptFuncDisableFsRedir, FileName, fdCreateAlways, faWrite, fsNone); + ParentWnd := 0; + S := Stack.GetString(PStart-2); + Stack.SetBool(PStart, BrowseForFolder(Stack.GetString(PStart-1), S, ParentWnd, Stack.GetBool(PStart-3))); + Stack.SetString(PStart-2, S); + end); + RegisterScriptFunc('GETOPENFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if Assigned(WizardForm) then + ParentWnd := WizardForm.Handle + else + ParentWnd := 0; + S := Stack.GetString(PStart-2); + Stack.SetBool(PStart, NewGetOpenFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), ParentWnd)); + Stack.SetString(PStart-2, S); + end); + RegisterScriptFunc('GETOPENFILENAMEMULTI', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if Assigned(WizardForm) then + ParentWnd := WizardForm.Handle + else + ParentWnd := 0; + Stack.SetBool(PStart, NewGetOpenFileNameMulti(Stack.GetString(PStart-1), TStrings(Stack.GetClass(PStart-2)), Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), ParentWnd)); + end); + RegisterScriptFunc('GETSAVEFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if Assigned(WizardForm) then + ParentWnd := WizardForm.Handle + else + ParentWnd := 0; + S := Stack.GetString(PStart-2); + Stack.SetBool(PStart, NewGetSaveFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), ParentWnd)); + Stack.SetString(PStart-2, S); + end); + end; + + procedure RegisterCommonFuncVclScriptFuncs; + begin + RegisterScriptFunc('MINIMIZEPATHNAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, MinimizePathName(Stack.GetString(PStart-1), TFont(Stack.GetClass(PStart-2)), Stack.GetInt(PStart-3))); + end); + end; + + procedure RegisterCommonFuncScriptFuncs; + var + ExistingFilename: String; + RegView: TRegView; + K, RootKey: HKEY; + S, N, V: String; + DataS: AnsiString; + Typ, ExistingTyp, Data, Size: DWORD; + I: Integer; + begin + RegisterScriptFunc('FILEEXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, NewFileExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('DIREXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, DirExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('FILEORDIREXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, FileOrDirExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('GETINISTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetIniString(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetString(PStart-4))); + end); + RegisterScriptFunc('GETINIINT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, GetIniInt(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4), Stack.GetInt(PStart-5), Stack.GetString(PStart-6))); + end); + RegisterScriptFunc('GETINIBOOL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, GetIniBool(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), Stack.GetString(PStart-4))); + end); + RegisterScriptFunc('INIKEYEXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, IniKeyExists(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3))); + end); + RegisterScriptFunc('ISINISECTIONEMPTY', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, IsIniSectionEmpty(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); + end); + RegisterScriptFunc('SETINISTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, SetIniString(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetString(PStart-4))); + end); + RegisterScriptFunc('SETINIINT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, SetIniInt(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetInt(PStart-3), Stack.GetString(PStart-4))); + end); + RegisterScriptFunc('SETINIBOOL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, SetIniBool(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), Stack.GetString(PStart-4))); + end); + RegisterScriptFunc('DELETEINIENTRY', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + DeleteIniEntry(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetString(PStart-2)); + end); + RegisterScriptFunc('DELETEINISECTION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + DeleteIniSection(Stack.GetString(PStart), Stack.GetString(PStart-1)); + end); + RegisterScriptFunc('GETENV', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetEnv(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('GETCMDTAIL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetCmdTail()); + end); + RegisterScriptFunc('PARAMCOUNT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if NewParamsForCode.Count = 0 then + InternalError('NewParamsForCode not set'); + Stack.SetInt(PStart, NewParamsForCode.Count-1); + end); + RegisterScriptFunc('PARAMSTR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + I := Stack.GetInt(PStart-1); + if (I >= 0) and (I < NewParamsForCode.Count) then + Stack.SetString(PStart, NewParamsForCode[I]) + else + Stack.SetString(PStart, ''); + end); + RegisterScriptFunc('ADDBACKSLASH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, AddBackslash(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('REMOVEBACKSLASH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, RemoveBackslash(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('REMOVEBACKSLASHUNLESSROOT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, RemoveBackslashUnlessRoot(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('ADDQUOTES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, AddQuotes(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('REMOVEQUOTES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, RemoveQuotes(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('GETSHORTNAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetShortNameRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('GETWINDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetWinDir()); + end); + RegisterScriptFunc('GETSYSTEMDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetSystemDir()); + end); + RegisterScriptFunc('GETSYSWOW64DIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetSysWow64Dir()); + end); + RegisterScriptFunc('GETSYSNATIVEDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetSysNativeDir(IsWin64)); + end); + RegisterScriptFunc('GETTEMPDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetTempDir()); + end); + RegisterScriptFunc('STRINGCHANGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + S := Stack.GetString(PStart-1); + Stack.SetInt(PStart, StringChange(S, Stack.GetString(PStart-2), Stack.GetString(PStart-3))); + Stack.SetString(PStart-1, S); + end); + RegisterScriptFunc('STRINGCHANGEEX', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + S := Stack.GetString(PStart-1); + Stack.SetInt(PStart, StringChangeEx(S, Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetBool(PStart-4))); + Stack.SetString(PStart-1, S); + end); + RegisterScriptFunc('USINGWINNT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, True); + end); + RegisterScriptFunc(['COPYFILE', 'FILECOPY'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + ExistingFilename := Stack.GetString(PStart-1); + if not IsProtectedSrcExe(ExistingFilename) then + Stack.SetBool(PStart, CopyFileRedir(ScriptFuncDisableFsRedir, + ExistingFilename, Stack.GetString(PStart-2), Stack.GetBool(PStart-3))) + else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('CONVERTPERCENTSTR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + S := Stack.GetString(PStart-1); + Stack.SetBool(PStart, ConvertPercentStr(S)); + Stack.SetString(PStart-1, S); + end); + RegisterScriptFunc('REGKEYEXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + var RegView: TRegView; + var RootKey: HKEY; + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin + Stack.SetBool(PStart, True); + RegCloseKey(K); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('REGVALUEEXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin + N := Stack.GetString(PStart-3); + Stack.SetBool(PStart, RegValueExists(K, PChar(N))); + RegCloseKey(K); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('REGDELETEKEYINCLUDINGSUBKEYS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + Stack.SetBool(PStart, RegDeleteKeyIncludingSubkeys(RegView, RootKey, PChar(S)) = ERROR_SUCCESS); + end); + RegisterScriptFunc('REGDELETEKEYIFEMPTY', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + Stack.SetBool(PStart, RegDeleteKeyIfEmpty(RegView, RootKey, PChar(S)) = ERROR_SUCCESS); + end); + RegisterScriptFunc('REGDELETEVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin + N := Stack.GetString(PStart-3); + Stack.SetBool(PStart, RegDeleteValue(K, PChar(N)) = ERROR_SUCCESS); + RegCloseKey(K); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('REGGETSUBKEYNAMES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey, + Stack.GetString(PStart-2), Stack, PStart-3, True)); + end); + RegisterScriptFunc('REGGETVALUENAMES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey, + Stack.GetString(PStart-2), Stack, PStart-3, False)); + end); + RegisterScriptFunc('REGQUERYSTRINGVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin + N := Stack.GetString(PStart-3); + S := Stack.GetString(PStart-4); + Stack.SetBool(PStart, RegQueryStringValue(K, PChar(N), S)); + Stack.SetString(PStart-4, S); + RegCloseKey(K); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('REGQUERYMULTISTRINGVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin + N := Stack.GetString(PStart-3); + S := Stack.GetString(PStart-4); + Stack.SetBool(PStart, RegQueryMultiStringValue(K, PChar(N), S)); + Stack.SetString(PStart-4, S); + RegCloseKey(K); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('REGQUERYDWORDVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin + N := Stack.GetString(PStart-3); + Size := SizeOf(Data); + if (RegQueryValueEx(K, PChar(N), nil, @Typ, @Data, @Size) = ERROR_SUCCESS) and (Typ = REG_DWORD) then begin + Stack.SetInt(PStart-4, Data); + Stack.SetBool(PStart, True); + end else + Stack.SetBool(PStart, False); + RegCloseKey(K); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('REGQUERYBINARYVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin + N := Stack.GetString(PStart-3); + if RegQueryValueEx(K, PChar(N), nil, @Typ, nil, @Size) = ERROR_SUCCESS then begin + SetLength(DataS, Size); + if RegQueryValueEx(K, PChar(N), nil, @Typ, @DataS[1], @Size) = ERROR_SUCCESS then begin + Stack.SetAnsiString(PStart-4, DataS); + Stack.SetBool(PStart, True); + end else + Stack.SetBool(PStart, False); + end else + Stack.SetBool(PStart, False); + RegCloseKey(K); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('REGWRITESTRINGVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin + N := Stack.GetString(PStart-3); + V := Stack.GetString(PStart-4); + if (RegQueryValueEx(K, PChar(N), nil, @ExistingTyp, nil, nil) = ERROR_SUCCESS) and (ExistingTyp = REG_EXPAND_SZ) then + Typ := REG_EXPAND_SZ + else + Typ := REG_SZ; + if RegSetValueEx(K, PChar(N), 0, Typ, PChar(V), (Length(V)+1)*SizeOf(V[1])) = ERROR_SUCCESS then + Stack.SetBool(PStart, True) + else + Stack.SetBool(PStart, False); + RegCloseKey(K); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('REGWRITEEXPANDSTRINGVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin + N := Stack.GetString(PStart-3); + V := Stack.GetString(PStart-4); + if RegSetValueEx(K, PChar(N), 0, REG_EXPAND_SZ, PChar(V), (Length(V)+1)*SizeOf(V[1])) = ERROR_SUCCESS then + Stack.SetBool(PStart, True) + else + Stack.SetBool(PStart, False); + RegCloseKey(K); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('REGWRITEMULTISTRINGVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin + N := Stack.GetString(PStart-3); + V := Stack.GetString(PStart-4); + { 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; + if RegSetValueEx(K, PChar(N), 0, REG_MULTI_SZ, PChar(V), (Length(V)+1)*SizeOf(V[1])) = ERROR_SUCCESS then + Stack.SetBool(PStart, True) + else + Stack.SetBool(PStart, False); + RegCloseKey(K); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('REGWRITEDWORDVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin + N := Stack.GetString(PStart-3); + Data := Stack.GetInt(PStart-4); + if RegSetValueEx(K, PChar(N), 0, REG_DWORD, @Data, SizeOf(Data)) = ERROR_SUCCESS then + Stack.SetBool(PStart, True) + else + Stack.SetBool(PStart, False); + RegCloseKey(K); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('REGWRITEBINARYVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); + S := Stack.GetString(PStart-2); + if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin + N := Stack.GetString(PStart-3); + DataS := Stack.GetAnsiString(PStart-4); + if RegSetValueEx(K, PChar(N), 0, REG_BINARY, @DataS[1], Length(DataS)) = ERROR_SUCCESS then + Stack.SetBool(PStart, True) + else + Stack.SetBool(PStart, False); + RegCloseKey(K); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc(['ISADMIN', 'ISADMINLOGGEDON'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, IsAdmin); + end); + RegisterScriptFunc('ISPOWERUSERLOGGEDON', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, IsPowerUserLoggedOn()); + end); + RegisterScriptFUnc('ISADMININSTALLMODE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, IsAdminInstallMode); + end); + RegisterScriptFunc('FONTEXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, FontExists(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('GETUILANGUAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, GetUILanguage); + end); + RegisterScriptFunc('ADDPERIOD', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, AddPeriod(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('CHARLENGTH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, PathCharLength(Stack.GetString(PStart-1), Stack.GetInt(PStart-2))); + end); + RegisterScriptFunc('SETNTFSCOMPRESSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, SetNTFSCompressionRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetBool(PStart-2))); + end); + RegisterScriptFunc('ISWILDCARD', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, IsWildcard(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('WILDCARDMATCH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + S := Stack.GetString(PStart-1); + N := Stack.GetString(PStart-2); + Stack.SetBool(PStart, WildcardMatch(PChar(S), PChar(N))); + end); + end; + + procedure RegisterInstallScriptFuncs; + begin + RegisterScriptFunc('EXTRACTTEMPORARYFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + ExtractTemporaryFile(Stack.GetString(PStart)); + end); + RegisterScriptFunc('EXTRACTTEMPORARYFILES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + Stack.SetInt(PStart, ExtractTemporaryFiles(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('DOWNLOADTEMPORARYFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + Stack.SetInt64(PStart, DownloadTemporaryFile(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), TOnDownloadProgress(Stack.GetProc(PStart-4, Caller)))); + end); + RegisterScriptFunc('SETDOWNLOADCREDENTIALS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + SetDownloadCredentials(Stack.GetString(PStart),Stack.GetString(PStart-1)); + end); + RegisterScriptFunc('DOWNLOADTEMPORARYFILESIZE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + Stack.SetInt64(PStart, DownloadTemporaryFileSize(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('DOWNLOADTEMPORARYFILEDATE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + Stack.SetString(PStart, DownloadTemporaryFileDate(Stack.GetString(PStart-1))); + end); + end; + + procedure RegisterInstFuncScriptFuncs; + var + Filename: String; + WindowDisabler: TWindowDisabler; + ResultCode, ErrorCode: Integer; + FreeBytes, TotalBytes: Integer64; + begin + RegisterScriptFunc('CHECKFORMUTEXES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, CheckForMutexes(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('DECREMENTSHAREDCOUNT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if Stack.GetBool(PStart-1) then begin + if not IsWin64 then + InternalError('Cannot access 64-bit registry keys on this version of Windows'); + Stack.SetBool(PStart, DecrementSharedCount(rv64Bit, Stack.GetString(PStart-2))); + end + else + Stack.SetBool(PStart, DecrementSharedCount(rv32Bit, Stack.GetString(PStart-2))); + end); + RegisterScriptFunc('DELAYDELETEFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + DelayDeleteFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetInt(PStart-1), 250, 250); + end); + RegisterScriptFunc('DELTREE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, DelTree(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetBool(PStart-2), Stack.GetBool(PStart-3), Stack.GetBool(PStart-4), False, nil, nil, nil)); + end); + RegisterScriptFunc('GENERATEUNIQUENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GenerateUniqueName(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetString(PStart-2))); + end); + RegisterScriptFunc('GETCOMPUTERNAMESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetComputerNameString()); + end); + RegisterScriptFunc('GETMD5OFFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, MD5DigestToString(GetMD5OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)))); + end); + RegisterScriptFunc('GETMD5OFSTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, MD5DigestToString(GetMD5OfAnsiString(Stack.GetAnsiString(PStart-1)))); + end); + RegisterScriptFunc('GETMD5OFUNICODESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, MD5DigestToString(GetMD5OfUnicodeString(Stack.GetString(PStart-1)))); + end); + RegisterScriptFunc('GETSHA1OFFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)))); + end); + RegisterScriptFunc('GETSHA1OFSTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfAnsiString(Stack.GetAnsiString(PStart-1)))); + end); + RegisterScriptFunc('GETSHA1OFUNICODESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfUnicodeString(Stack.GetString(PStart-1)))); + end); + RegisterScriptFunc('GETSHA256OFFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)))); + end); + RegisterScriptFunc('GETSHA256OFSTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfAnsiString(Stack.GetAnsiString(PStart-1)))); + end); + RegisterScriptFunc('GETSHA256OFUNICODESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfUnicodeString(Stack.GetString(PStart-1)))); + end); + RegisterScriptFunc('GETSPACEONDISK', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if GetSpaceOnDisk(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin + if Stack.GetBool(PStart-2) then begin + Div64(FreeBytes, 1024*1024); + Div64(TotalBytes, 1024*1024); + end; + { Cap at 2 GB, as [Code] doesn't support 64-bit integers } + if (FreeBytes.Hi <> 0) or (FreeBytes.Lo and $80000000 <> 0) then + FreeBytes.Lo := $7FFFFFFF; + if (TotalBytes.Hi <> 0) or (TotalBytes.Lo and $80000000 <> 0) then + TotalBytes.Lo := $7FFFFFFF; + Stack.SetUInt(PStart-3, FreeBytes.Lo); + Stack.SetUInt(PStart-4, TotalBytes.Lo); + Stack.SetBool(PStart, True); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('GETSPACEONDISK64', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if GetSpaceOnDisk(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin + Stack.SetInt64(PStart-2, Int64(FreeBytes.Hi) shl 32 + FreeBytes.Lo); + Stack.SetInt64(PStart-3, Int64(TotalBytes.Hi) shl 32 + TotalBytes.Lo); + Stack.SetBool(PStart, True); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('GETUSERNAMESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetUserNameString()); + end); + RegisterScriptFunc('INCREMENTSHAREDCOUNT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if Stack.GetBool(PStart) then begin + if not IsWin64 then + InternalError('Cannot access 64-bit registry keys on this version of Windows'); + IncrementSharedCount(rv64Bit, Stack.GetString(PStart-1), Stack.GetBool(PStart-2)); + end + else + IncrementSharedCount(rv32Bit, Stack.GetString(PStart-1), Stack.GetBool(PStart-2)); + end); + RegisterScriptFunc(['EXEC', 'EXECASORIGINALUSER', 'EXECANDLOGOUTPUT', 'EXECANDCAPTUREOUTPUT'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + var RunAsOriginalUser := Name = 'EXECASORIGINALUSER'; + var Method: TMethod; { Must stay alive until OutputReader is freed } + var OutputReader: TCreateProcessOutputReader := nil; try - F.SeekToEnd; - F.WriteAnsiString(S); + if Name = 'EXECANDLOGOUTPUT' then begin + Method := Stack.GetProc(PStart-7, Caller); + if Method.Code <> nil then + OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLogCustom, NativeInt(@Method)) + else if GetLogActive then + OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLog, 0); + end else if Name = 'EXECANDCAPTUREOUTPUT' then + OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLog, 0, omCapture); + var ExecWait := TExecWait(Stack.GetInt(PStart-5)); + if IsUninstaller and RunAsOriginalUser then + NoUninstallFuncError(Name) + else if (OutputReader <> nil) and (ExecWait <> ewWaitUntilTerminated) then + InternalError(Format('Must call "%s" function with Wait = ewWaitUntilTerminated', [Name])); + + Filename := Stack.GetString(PStart-1); + if not IsProtectedSrcExe(Filename) then begin + { Disable windows so the user can't utilize our UI during the InstExec + call } + WindowDisabler := TWindowDisabler.Create; + try + Stack.SetBool(PStart, InstExecEx(RunAsOriginalUser, + ScriptFuncDisableFsRedir, Filename, Stack.GetString(PStart-2), + Stack.GetString(PStart-3), ExecWait, + Stack.GetInt(PStart-4), ProcessMessagesProc, OutputReader, ResultCode)); + finally + WindowDisabler.Free; + end; + Stack.SetInt(PStart-6, ResultCode); + if Name = 'EXECANDCAPTUREOUTPUT' then begin + { Set the three TExecOutput fields } + Stack.SetArray(PStart-7, OutputReader.CaptureOutList, 0); + Stack.SetArray(PStart-7, OutputReader.CaptureErrList, 1); + Stack.SetInt(PStart-7, OutputReader.CaptureError.ToInteger, 2); + end; + end else begin + Stack.SetBool(PStart, False); + Stack.SetInt(PStart-6, ERROR_ACCESS_DENIED); + end; finally - F.Free; + OutputReader.Free; end; + end); + RegisterScriptFunc(['SHELLEXEC', 'SHELLEXECASORIGINALUSER'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + var RunAsOriginalUser := Name = 'SHELLEXECASORIGINALUSER'; + if IsUninstaller and RunAsOriginalUser then + NoUninstallFuncError(Name); - Result := True; - except - Result := False; - end; + Filename := Stack.GetString(PStart-2); + if not IsProtectedSrcExe(Filename) then begin + { Disable windows so the user can't utilize our UI during the + InstShellExec call } + WindowDisabler := TWindowDisabler.Create; + try + Stack.SetBool(PStart, InstShellExecEx(RunAsOriginalUser, + Stack.GetString(PStart-1), Filename, Stack.GetString(PStart-3), + Stack.GetString(PStart-4), TExecWait(Stack.GetInt(PStart-6)), + Stack.GetInt(PStart-5), ProcessMessagesProc, ErrorCode)); + finally + WindowDisabler.Free; + end; + Stack.SetInt(PStart-7, ErrorCode); + end else begin + Stack.SetBool(PStart, False); + Stack.SetInt(PStart-7, ERROR_ACCESS_DENIED); + end; + end); + RegisterScriptFunc('ISPROTECTEDSYSTEMFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, IsProtectedSystemFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('MAKEPENDINGFILERENAMEOPERATIONSCHECKSUM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, SHA256DigestToString(MakePendingFileRenameOperationsChecksum)); + end); + RegisterScriptFunc('MODIFYPIFFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, ModifyPifFile(Stack.GetString(PStart-1), Stack.GetBool(PStart-2))); + end); + RegisterScriptFunc('REGISTERSERVER', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + RegisterServer(False, Stack.GetBool(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2)); + end); + RegisterScriptFunc('UNREGISTERSERVER', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + try + RegisterServer(True, Stack.GetBool(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3)); + Stack.SetBool(PStart, True); + except + Stack.SetBool(PStart, False); + end; + end); + RegisterScriptFunc('UNREGISTERFONT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + UnregisterFont(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2)); + end); + RegisterScriptFunc('RESTARTREPLACE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + RestartReplace(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1)); + end); + RegisterScriptFunc('FORCEDIRECTORIES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, ForceDirectories(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); + end); + end; + + procedure RegisterInstFuncOleScriptFuncs; + begin + RegisterScriptFunc('CREATESHELLLINK', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, CreateShellLink(Stack.GetString(PStart-1), + Stack.GetString(PStart-2), Stack.GetString(PStart-3), + Stack.GetString(PStart-4), Stack.GetString(PStart-5), + Stack.GetString(PStart-6), Stack.GetInt(PStart-7), + Stack.GetInt(PStart-8), 0, '', nil, False, False)); + end); + RegisterScriptFunc('REGISTERTYPELIBRARY', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if Stack.GetBool(PStart) then + HelperRegisterTypeLibrary(False, Stack.GetString(PStart-1)) + else + RegisterTypeLibrary(Stack.GetString(PStart-1)); + end); + RegisterScriptFunc('UNREGISTERTYPELIBRARY', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + try + if Stack.GetBool(PStart-1) then + HelperRegisterTypeLibrary(True, Stack.GetString(PStart-2)) + else + UnregisterTypeLibrary(Stack.GetString(PStart-2)); + Stack.SetBool(PStart, True); + except + Stack.SetBool(PStart, False); + end; + end); + RegisterScriptFunc('UNPINSHELLLINK', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, UnpinShellLink(Stack.GetString(PStart-1))); + end); end; - function SaveStringsToFile(const FileName: String; const Stack: TPSStack; - const ItemNo: Longint; Append, UTF8, UTF8WithoutBOM: Boolean): Boolean; + procedure RegisterMainFuncScriptFuncs; var - F: TTextFileWriter; + MinVersion, OnlyBelowVersion: TSetupVersionData; + StringList: TStringList; + S: String; + Components, Suppressible: Boolean; + Default: Integer; begin - try - if Append then - F := TTextFileWriterRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenAlways, faWrite, fsNone) + RegisterScriptFunc('ACTIVELANGUAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, ExpandConst('{language}')); + end); + RegisterScriptFunc('EXPANDCONSTANT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, ExpandConst(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('EXPANDCONSTANTEX', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, ExpandConstEx(Stack.GetString(PStart-1), [Stack.GetString(PStart-2), Stack.GetString(PStart-3)])); + end); + RegisterScriptFunc('EXITSETUPMSGBOX', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, ExitSetupMsgBox()); + end); + RegisterScriptFunc('GETSHELLFOLDERBYCSIDL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetShellFolderByCSIDL(Stack.GetInt(PStart-1), Stack.GetBool(PStart-2))); + end); + RegisterScriptFunc('INSTALLONTHISVERSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if not StrToSetupVersionData(Stack.GetString(PStart-1), MinVersion) then + InternalError('InstallOnThisVersion: Invalid MinVersion string') + else if not StrToSetupVersionData(Stack.GetString(PStart-2), OnlyBelowVersion) then + InternalError('InstallOnThisVersion: Invalid OnlyBelowVersion string') + else + Stack.SetBool(PStart, (InstallOnThisVersion(MinVersion, OnlyBelowVersion) = irInstall)); + end); + RegisterScriptFunc('GETWINDOWSVERSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetUInt(PStart, WindowsVersion); + end); + RegisterScriptFunc('GETWINDOWSVERSIONSTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, Format('%u.%.2u.%u', [WindowsVersion shr 24, + (WindowsVersion shr 16) and $FF, WindowsVersion and $FFFF])); + end); + RegisterScriptFunc(['MSGBOX', 'SUPPRESSIBLEMSGBOX'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if Name = 'MSGBOX' then begin + Suppressible := False; + Default := 0; + end else begin + Suppressible := True; + Default := Stack.GetInt(PStart-4); + end; + Stack.SetInt(PStart, LoggedMsgBox(Stack.GetString(PStart-1), GetMsgBoxCaption, TMsgBoxType(Stack.GetInt(PStart-2)), Stack.GetInt(PStart-3), Suppressible, Default)); + end); + RegisterScriptFunc(['TASKDIALOGMSGBOX', 'SUPPRESSIBLETASKDIALOGMSGBOX'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if Name = 'TASKDIALOGMSGBOX' then begin + Suppressible := False; + Default := 0; + end else begin + Suppressible := True; + Default := Stack.GetInt(PStart-7); + end; + var ButtonLabels := Stack.GetStringArray(PStart-5); + Stack.SetInt(PStart, LoggedTaskDialogMsgBox('', Stack.GetString(PStart-1), Stack.GetString(PStart-2), GetMsgBoxCaption, TMsgBoxType(Stack.GetInt(PStart-3)), Stack.GetInt(PStart-4), ButtonLabels, Stack.GetInt(PStart-6), Suppressible, Default)); + end); + RegisterScriptFunc('ISWIN64', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, IsWin64); + end); + RegisterScriptFunc('IS64BITINSTALLMODE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, Is64BitInstallMode); + end); + RegisterScriptFunc('PROCESSORARCHITECTURE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, Integer(ProcessorArchitecture)); + end); + RegisterScriptFunc(['ISARM32COMPATIBLE', 'ISARM64', 'ISX64', 'ISX64OS', 'ISX64COMPATIBLE', 'ISX86', 'ISX86OS', 'ISX86COMPATIBLE'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + var ArchitectureIdentifier := LowerCase(Copy(String(Name), 3, MaxInt)); + Stack.SetBool(PStart, EvalArchitectureIdentifier(ArchitectureIdentifier)); + end); + RegisterScriptFunc('CUSTOMMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, CustomMessage(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('RMSESSIONSTARTED', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, RmSessionStarted); + end); + RegisterScriptFunc('REGISTEREXTRACLOSEAPPLICATIONSRESOURCE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, CodeRegisterExtraCloseApplicationsResource(Stack.GetBool(PStart-1), Stack.GetString(PStart-2))); + end); + RegisterScriptFunc('GETMAINFORM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetClass(PStart, GetMainForm); + end); + RegisterScriptFunc('GETWIZARDFORM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetClass(PStart, GetWizardForm); + end); + RegisterScriptFunc(['WIZARDISCOMPONENTSELECTED', 'ISCOMPONENTSELECTED', 'WIZARDISTASKSELECTED', 'ISTASKSELECTED'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + StringList := TStringList.Create(); + try + Components := (Name = 'WIZARDISCOMPONENTSELECTED') or (Name = 'ISCOMPONENTSELECTED'); + if Components then + GetWizardForm.GetSelectedComponents(StringList, False, False) + else + GetWizardForm.GetSelectedTasks(StringList, False, False, False); + S := Stack.GetString(PStart-1); + StringChange(S, '/', '\'); + if Components then + Stack.SetBool(PStart, ShouldProcessEntry(StringList, nil, S, '', '', '')) + else + Stack.SetBool(PStart, ShouldProcessEntry(nil, StringList, '', S, '', '')); + finally + StringList.Free(); + end; + end); + end; + + procedure RegisterMessagesScriptFuncs; + begin + RegisterScriptFunc('SETUPMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, SetupMessages[TSetupMessageID(Stack.GetInt(PStart-1))]); + end); + end; + + procedure RegisterSystemScriptFuncs; + var + F: TFile; + TmpFileSize: Integer64; + begin + RegisterScriptFunc('RANDOM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, Random(Stack.GetInt(PStart-1))); + end); + RegisterScriptFunc('FILESIZE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + try + F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite); + try + Stack.SetInt(PStart-2, F.CappedSize); + Stack.SetBool(PStart, True); + finally + F.Free; + end; + except + Stack.SetBool(PStart, False); + end; + end); + RegisterScriptFunc('FILESIZE64', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + try + F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite); + try + TmpFileSize := F.Size; { Make sure we access F.Size only once } + Stack.SetInt64(PStart-2, Int64(TmpFileSize.Hi) shl 32 + TmpFileSize.Lo); + Stack.SetBool(PStart, True); + finally + F.Free; + end; + except + Stack.SetBool(PStart, False); + end; + end); + RegisterScriptFunc('SET8087CW', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Set8087CW(Stack.GetInt(PStart)); + end); + RegisterScriptFunc('GET8087CW', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, Get8087CW); + end); + RegisterScriptFunc('UTF8ENCODE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetAnsiString(PStart, Utf8Encode(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('UTF8DECODE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, UTF8ToString(Stack.GetAnsiString(PStart-1))); + end); + end; + + procedure RegisterSysUtilsScriptFuncs; + var + OldName: String; + NewDateSeparator, NewTimeSeparator: Char; + OldDateSeparator, OldTimeSeparator: Char; + begin + RegisterScriptFunc('BEEP', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Beep; + end); + RegisterScriptFunc('TRIMLEFT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, TrimLeft(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('TRIMRIGHT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, TrimRight(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('GETCURRENTDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetCurrentDir()); + end); + RegisterScriptFunc('SETCURRENTDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, SetCurrentDir(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('EXPANDFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, PathExpand(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('EXPANDUNCFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, ExpandUNCFileName(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('EXTRACTRELATIVEPATH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, NewExtractRelativePath(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); + end); + RegisterScriptFunc('EXTRACTFILEDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, PathExtractDir(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('EXTRACTFILEDRIVE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, PathExtractDrive(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('EXTRACTFILEEXT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, PathExtractExt(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('EXTRACTFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, PathExtractName(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('EXTRACTFILEPATH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, PathExtractPath(Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('CHANGEFILEEXT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, PathChangeExt(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); + end); + RegisterScriptFunc('FILESEARCH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, NewFileSearch(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetString(PStart-2))); + end); + RegisterScriptFunc('RENAMEFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + OldName := Stack.GetString(PStart-1); + if not IsProtectedSrcExe(OldName) then + Stack.SetBool(PStart, MoveFileRedir(ScriptFuncDisableFsRedir, OldName, Stack.GetString(PStart-2))) else - F := TTextFileWriterRedir.Create(ScriptFuncDisableFsRedir, FileName, fdCreateAlways, faWrite, fsNone); + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('DELETEFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, DeleteFileRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('CREATEDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, CreateDirectoryRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('REMOVEDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, RemoveDirectoryRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); + end); + RegisterScriptFunc('COMPARESTR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, CompareStr(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); + end); + RegisterScriptFunc('COMPARETEXT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, CompareText(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); + end); + RegisterScriptFunc('SAMESTR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, CompareStr(Stack.GetString(PStart-1), Stack.GetString(PStart-2)) = 0); + end); + RegisterScriptFunc('SAMETEXT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, CompareText(Stack.GetString(PStart-1), Stack.GetString(PStart-2)) = 0); + end); + RegisterScriptFunc('GETDATETIMESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + OldDateSeparator := FormatSettings.DateSeparator; + OldTimeSeparator := FormatSettings.TimeSeparator; try - if UTF8 and UTF8WithoutBOM then - F.UTF8WithoutBOM := UTF8WithoutBOM; - var ArrayEnumerator := Stack.InitArrayEnumerator(ItemNo); - while ArrayEnumerator.HasNext do begin - var S := ArrayEnumerator.Next; - if not UTF8 then - F.WriteAnsiLine(AnsiString(S)) - else - F.WriteLine(S); - end; + NewDateSeparator := Stack.GetString(PStart-2)[1]; + NewTimeSeparator := Stack.GetString(PStart-3)[1]; + if NewDateSeparator <> #0 then + FormatSettings.DateSeparator := NewDateSeparator; + if NewTimeSeparator <> #0 then + FormatSettings.TimeSeparator := NewTimeSeparator; + Stack.SetString(PStart, FormatDateTime(Stack.GetString(PStart-1), Now())); finally - F.Free; + FormatSettings.TimeSeparator := OldTimeSeparator; + FormatSettings.DateSeparator := OldDateSeparator; end; - - Result := True; - except - Result := False; - end; + end); + RegisterScriptFunc('SYSERRORMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, Win32ErrorString(Stack.GetInt(PStart-1))); + end); end; - - function CreateCallback(P: PPSVariantProcPtr): LongWord; + + procedure RegisterVerInfoFuncScriptFuncs; var - ProcRec: TPSInternalProcRec; - Method: TMethod; - Inliner: TASMInline; - ParamCount, SwapFirst, SwapLast: Integer; - S: tbtstring; + VersionNumbers: TFileVersionNumbers; begin - { ProcNo 0 means nil was passed by the script } - if P.ProcNo = 0 then - InternalError('Invalid Method value'); - - { Calculate parameter count of our proc, will need this later. } - ProcRec := Caller.GetProcNo(P.ProcNo) as TPSInternalProcRec; - S := ProcRec.ExportDecl; - GRFW(S); - ParamCount := 0; - while S <> '' do begin - Inc(ParamCount); - GRFW(S); - end; - - { Turn our proc into a callable TMethod - its Code will point to - ROPS' MyAllMethodsHandler and its Data to a record identifying our proc. - When called, MyAllMethodsHandler will use the record to call our proc. } - Method := MkMethod(Caller, P.ProcNo); - - { Wrap our TMethod with a dynamically generated stdcall callback which will - do two things: - -Remember the Data pointer which MyAllMethodsHandler needs. - -Handle the calling convention mismatch. - - Based on InnoCallback by Sherlock Software, see - http://www.sherlocksoftware.org/page.php?id=54 and - https://github.com/thenickdude/InnoCallback. } - Inliner := TASMInline.create; - try - Inliner.Pop(EAX); //get the retptr off the stack - - SwapFirst := 2; - SwapLast := ParamCount-1; - - //Reverse the order of parameters from param3 onwards in the stack - while SwapLast > SwapFirst do begin - Inliner.Mov(ECX, Inliner.Addr(ESP, SwapFirst * 4)); //load the first item of the pair - Inliner.Mov(EDX, Inliner.Addr(ESP, SwapLast * 4)); //load the last item of the pair - Inliner.Mov(Inliner.Addr(ESP, SwapFirst * 4), EDX); - Inliner.Mov(Inliner.Addr(ESP, SwapLast * 4), ECX); - Inc(SwapFirst); - Dec(SwapLast); - end; - - if ParamCount >= 1 then - Inliner.Pop(EDX); //load param1 - if ParamCount >= 2 then - Inliner.Pop(ECX); //load param2 - - Inliner.Push(EAX); //put the retptr back onto the stack - - Inliner.Mov(EAX, LongWord(Method.Data)); //Load the self ptr - - Inliner.Jmp(Method.Code); //jump to the wrapped proc - - SetLength(ASMInliners, Length(ASMInliners) + 1); - ASMInliners[High(ASMInliners)] := Inliner.SaveAsMemory; - Result := LongWord(ASMInliners[High(ASMInliners)]); - finally - Inliner.Free; - end; + RegisterScriptFunc('GETVERSIONNUMBERS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin + Stack.SetInt(PStart-2, VersionNumbers.MS); + Stack.SetInt(PStart-3, VersionNumbers.LS); + Stack.SetBool(PStart, True); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('GETVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin + Stack.SetUInt(PStart-2, VersionNumbers.MS shr 16); + Stack.SetUInt(PStart-3, VersionNumbers.MS and $FFFF); + Stack.SetUInt(PStart-4, VersionNumbers.LS shr 16); + Stack.SetUInt(PStart-5, VersionNumbers.LS and $FFFF); + Stack.SetBool(PStart, True); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('GETVERSIONNUMBERSSTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin + Stack.SetString(PStart-2, Format('%u.%u.%u.%u', [VersionNumbers.MS shr 16, + VersionNumbers.MS and $FFFF, VersionNumbers.LS shr 16, VersionNumbers.LS and $FFFF])); + Stack.SetBool(PStart, True); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('GETPACKEDVERSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin + Stack.SetInt64(PStart-2, (Int64(VersionNumbers.MS) shl 32) or VersionNumbers.LS); + Stack.SetBool(PStart, True); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('PACKVERSIONNUMBERS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt64(PStart, Int64((UInt64(Stack.GetUInt(PStart-1)) shl 32) or Stack.GetUInt(PStart-2))); + end); + RegisterScriptFunc('PACKVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + VersionNumbers.MS := (Stack.GetUInt(PStart-1) shl 16) or (Stack.GetUInt(PStart-2) and $FFFF); + VersionNumbers.LS := (Stack.GetUInt(PStart-3) shl 16) or (Stack.GetUInt(PStart-4) and $FFFF); + Stack.SetInt64(PStart, Int64((UInt64(VersionNumbers.MS) shl 32) or VersionNumbers.LS)); + end); + RegisterScriptFunc('COMPAREPACKEDVERSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, Compare64(Integer64(Stack.GetInt64(PStart-1)), Integer64(Stack.GetInt64(PStart-2)))); + end); + RegisterScriptFunc('SAMEPACKEDVERSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, Compare64(Integer64(Stack.GetInt64(PStart-1)), Integer64(Stack.GetInt64(PStart-2))) = 0); + end); + RegisterScriptFunc('UNPACKVERSIONNUMBERS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + VersionNumbers.MS := UInt64(Stack.GetInt64(PStart)) shr 32; + VersionNumbers.LS := UInt64(Stack.GetInt64(PStart)) and $FFFFFFFF; + Stack.SetUInt(PStart-1, VersionNumbers.MS); + Stack.SetUInt(PStart-2, VersionNumbers.LS); + end); + RegisterScriptFunc('UNPACKVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + VersionNumbers.MS := UInt64(Stack.GetInt64(PStart)) shr 32; + VersionNumbers.LS := UInt64(Stack.GetInt64(PStart)) and $FFFFFFFF; + Stack.SetUInt(PStart-1, VersionNumbers.MS shr 16); + Stack.SetUInt(PStart-2, VersionNumbers.MS and $FFFF); + Stack.SetUInt(PStart-3, VersionNumbers.LS shr 16); + Stack.SetUInt(PStart-4, VersionNumbers.LS and $FFFF); + end); + RegisterScriptFunc('VERSIONTOSTR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + VersionNumbers.MS := UInt64(Stack.GetInt64(PStart-1)) shr 32; + VersionNumbers.LS := UInt64(Stack.GetInt64(PStart-1)) and $FFFFFFFF; + Stack.SetString(PStart, Format('%u.%u.%u.%u', [VersionNumbers.MS shr 16, + VersionNumbers.MS and $FFFF, VersionNumbers.LS shr 16, VersionNumbers.LS and $FFFF])); + end); + RegisterScriptFunc('STRTOVERSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if StrToVersionNumbers(Stack.GetString(PStart-1), VersionNumbers) then begin + Stack.SetInt64(PStart-2, (Int64(VersionNumbers.MS) shl 32) or VersionNumbers.LS); + Stack.SetBool(PStart, True); + end else + Stack.SetBool(PStart, False); + end); end; -var - PStart: Cardinal; - TypeEntry: PSetupTypeEntry; - StringList: TStringList; - S: String; - AnsiS: AnsiString; - ErrorCode: Cardinal; -begin - PStart := Stack.Count-1; - Result := True; + type + TDllProc = function(const Param1, Param2: Longint): Longint; stdcall; - if Proc.Name = 'BRINGTOFRONTANDRESTORE' then begin - Application.BringToFront(); - Application.Restore(); - end else if Proc.Name = 'WIZARDDIRVALUE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.DirEdit.Text)); - end else if Proc.Name = 'WIZARDGROUPVALUE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.GroupEdit.Text)); - end else if Proc.Name = 'WIZARDNOICONS' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - Stack.SetBool(PStart, GetWizardForm.NoIconsCheck.Checked); - end else if Proc.Name = 'WIZARDSETUPTYPE' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - TypeEntry := GetWizardForm.GetSetupType(); - if TypeEntry <> nil then begin - if Stack.GetBool(PStart-1) then - Stack.SetString(PStart, TypeEntry.Description) - else - Stack.SetString(PStart, TypeEntry.Name); - end - else - Stack.SetString(PStart, ''); - end else if (Proc.Name = 'WIZARDSELECTEDCOMPONENTS') or (Proc.Name = 'WIZARDSELECTEDTASKS') then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - StringList := TStringList.Create(); - try - if Proc.Name = 'WIZARDSELECTEDCOMPONENTS' then - GetWizardForm.GetSelectedComponents(StringList, Stack.GetBool(PStart-1), False) - else - GetWizardForm.GetSelectedTasks(StringList, Stack.GetBool(PStart-1), False, False); - Stack.SetString(PStart, StringsToCommaString(StringList)); - finally - StringList.Free(); - end; - end else if (Proc.Name = 'WIZARDSELECTCOMPONENTS') or (Proc.Name = 'WIZARDSELECTTASKS') then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - StringList := TStringList.Create(); - try - S := Stack.GetString(PStart); - StringChange(S, '/', '\'); - SetStringsFromCommaString(StringList, S); - if Proc.Name = 'WIZARDSELECTCOMPONENTS' then - GetWizardForm.SelectComponents(StringList) + procedure RegisterWindowsScriptFuncs; + var + DllProc: TDllProc; + DllHandle: THandle; + S: AnsiString; + begin + RegisterScriptFunc('SLEEP', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Sleep(Stack.GetInt(PStart)); + end); + RegisterScriptFunc('FINDWINDOWBYCLASSNAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, FindWindow(PChar(Stack.GetString(PStart-1)), nil)); + end); + RegisterScriptFunc('FINDWINDOWBYWINDOWNAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, FindWindow(nil, PChar(Stack.GetString(PStart-1)))); + end); + RegisterScriptFunc('SENDMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, SendMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4))); + end); + RegisterScriptFunc('POSTMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, PostMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4))); + end); + RegisterScriptFunc('SENDNOTIFYMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, SendNotifyMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4))); + end); + RegisterScriptFunc('REGISTERWINDOWMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, RegisterWindowMessage(PChar(Stack.GetString(PStart-1)))); + end); + RegisterScriptFunc('SENDBROADCASTMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, SendMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3))); + end); + RegisterScriptFunc('POSTBROADCASTMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, PostMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3))); + end); + RegisterScriptFunc('SENDBROADCASTNOTIFYMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, SendNotifyMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3))); + end); + RegisterScriptFunc('LOADDLL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + DllHandle := SafeLoadLibrary(Stack.GetString(PStart-1), SEM_NOOPENFILEERRORBOX); + if DllHandle <> 0 then + Stack.SetInt(PStart-2, 0) else - GetWizardForm.SelectTasks(StringList); - finally - StringList.Free(); - end; - end else if Proc.Name = 'WIZARDSILENT' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - Stack.SetBool(PStart, InstallMode <> imNormal); - end else if Proc.Name = 'ISUNINSTALLER' then begin - Stack.SetBool(PStart, IsUninstaller); - end else if Proc.Name = 'UNINSTALLSILENT' then begin - if not IsUninstaller then - NoSetupFuncError(Proc.Name); - Stack.SetBool(PStart, UninstallSilent); - end else if Proc.Name = 'CURRENTFILENAME' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - if CheckOrInstallCurrentFilename <> '' then - Stack.SetString(PStart, CheckOrInstallCurrentFilename) - else - InternalError('An attempt was made to call the "CurrentFilename" function from outside a "Check", "BeforeInstall" or "AfterInstall" event function belonging to a "[Files]" entry'); - end else if Proc.Name = 'CURRENTSOURCEFILENAME' then begin - if IsUninstaller then - NoUninstallFuncError(Proc.Name); - if CheckOrInstallCurrentSourceFilename <> '' then - Stack.SetString(PStart, CheckOrInstallCurrentSourceFilename) - else - InternalError('An attempt was made to call the "CurrentSourceFilename" function from outside a "Check", "BeforeInstall" or "AfterInstall" event function belonging to a "[Files]" entry with flag "external"'); - end else if Proc.Name = 'CASTSTRINGTOINTEGER' then begin - Stack.SetInt(PStart, Integer(PChar(Stack.GetString(PStart-1)))); - end else if Proc.Name = 'CASTINTEGERTOSTRING' then begin - Stack.SetString(PStart, String(PChar(Stack.GetInt(PStart-1)))); - end else if Proc.Name = 'ABORT' then begin - Abort; - end else if Proc.Name = 'GETEXCEPTIONMESSAGE' then begin - Stack.SetString(PStart, GetExceptionMessage); - end else if Proc.Name = 'RAISEEXCEPTION' then begin - raise Exception.Create(Stack.GetString(PStart)); - end else if Proc.Name = 'SHOWEXCEPTIONMESSAGE' then begin - TMainForm.ShowExceptionMsg(AddPeriod(GetExceptionMessage)); - end else if Proc.Name = 'TERMINATED' then begin - Stack.SetBool(PStart, Application.Terminated); - end else if Proc.Name = 'GETPREVIOUSDATA' then begin - if IsUninstaller then - Stack.SetString(PStart, GetCodePreviousData(UninstallExpandedAppId, Stack.GetString(PStart-1), Stack.GetString(PStart-2))) - else - Stack.SetString(PStart, GetCodePreviousData(ExpandConst(SetupHeader.AppId), Stack.GetString(PStart-1), Stack.GetString(PStart-2))); - end else if Proc.Name = 'SETPREVIOUSDATA' then begin - Stack.SetBool(PStart, SetCodePreviousData(Stack.GetInt(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3))); - end else if Proc.Name = 'LOADSTRINGFROMFILE' then begin - AnsiS := Stack.GetAnsiString(PStart-2); - Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), AnsiS, fsRead)); - Stack.SetAnsiString(PStart-2, AnsiS); - end else if Proc.Name = 'LOADSTRINGFROMLOCKEDFILE' then begin - AnsiS := Stack.GetAnsiString(PStart-2); - Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), AnsiS, fsReadWrite)); - Stack.SetAnsiString(PStart-2, AnsiS); - end else if Proc.Name = 'LOADSTRINGSFROMFILE' then begin - Stack.SetBool(PStart, LoadStringsFromFile(Stack.GetString(PStart-1), Stack, PStart-2, fsRead)); - end else if Proc.Name = 'LOADSTRINGSFROMLOCKEDFILE' then begin - Stack.SetBool(PStart, LoadStringsFromFile(Stack.GetString(PStart-1), Stack, PStart-2, fsReadWrite)); - end else if Proc.Name = 'SAVESTRINGTOFILE' then begin - Stack.SetBool(PStart, SaveStringToFile(Stack.GetString(PStart-1), Stack.GetAnsiString(PStart-2), Stack.GetBool(PStart-3))); - end else if Proc.Name = 'SAVESTRINGSTOFILE' then begin - Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), False, False)); - end else if Proc.Name = 'SAVESTRINGSTOUTF8FILE' then begin - Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), True, False)); - end else if Proc.Name = 'SAVESTRINGSTOUTF8FILEWITHOUTBOM' then begin - Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), True, True)); - end else if Proc.Name = 'ENABLEFSREDIRECTION' then begin - Stack.SetBool(PStart, not ScriptFuncDisableFsRedir); - if Stack.GetBool(PStart-1) then - ScriptFuncDisableFsRedir := False - else begin - if not IsWin64 then - InternalError('Cannot disable FS redirection on this version of Windows'); - ScriptFuncDisableFsRedir := True; - end; - end else if Proc.Name = 'GETUNINSTALLPROGRESSFORM' then begin - Stack.SetClass(PStart, GetUninstallProgressForm); - end else if Proc.Name = 'CREATECALLBACK' then begin - Stack.SetInt(PStart, CreateCallback(Stack.Items[PStart-1])); - end else if Proc.Name = 'ISDOTNETINSTALLED' then begin - Stack.SetBool(PStart, IsDotNetInstalled(InstallDefaultRegView, TDotNetVersion(Stack.GetInt(PStart-1)), Stack.GetInt(PStart-2))); - end else if Proc.Name = 'ISMSIPRODUCTINSTALLED' then begin - Stack.SetBool(PStart, IsMsiProductInstalled(Stack.GetString(PStart-1), Stack.GetInt64(PStart-2), ErrorCode)); - if ErrorCode <> 0 then - raise Exception.Create(Win32ErrorString(ErrorCode)); - end else if Proc.Name = 'INITIALIZEBITMAPIMAGEFROMICON' then begin - var AscendingTrySizes := Stack.GetIntArray(PStart-4); - Stack.SetBool(PStart, TBitmapImage(Stack.GetClass(PStart-1)).InitializeFromIcon(0, PChar(Stack.GetString(PStart-2)), Stack.GetInt(PStart-3), AscendingTrySizes)); - end else if Proc.Name = 'EXTRACT7ZIPARCHIVE' then begin - Extract7ZipArchive(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2), TOnExtractionProgress(Stack.GetProc(PStart-3, Caller))); - end else if Proc.Name = 'DEBUGGING' then begin - Stack.SetBool(PStart, Debugging); - end else if Proc.Name = 'STRINGJOIN' then begin - var Values := Stack.GetStringArray(PStart-2); - Stack.SetString(PStart, String.Join(Stack.GetString(PStart-1), Values)); - end else if (Proc.Name = 'STRINGSPLIT') or (Proc.Name = 'STRINGSPLITEX') then begin - var Separators := Stack.GetStringArray(PStart-2); - var Parts: TArray; - if Proc.Name = 'STRINGSPLITEX' then begin - var Quote := Stack.GetString(PStart-3)[1]; - Parts := Stack.GetString(PStart-1).Split(Separators, Quote, Quote, TStringSplitOptions(Stack.GetInt(PStart-4))) - end else - Parts := Stack.GetString(PStart-1).Split(Separators, TStringSplitOptions(Stack.GetInt(PStart-3))); - Stack.SetArray(PStart, Parts); - end else - Result := False; -end; - -{---} - -procedure FindDataToFindRec(const FindData: TWin32FindData; - var FindRec: TFindRec); -begin - FindRec.Name := FindData.cFileName; - FindRec.Attributes := FindData.dwFileAttributes; - FindRec.SizeHigh := FindData.nFileSizeHigh; - FindRec.SizeLow := FindData.nFileSizeLow; - FindRec.CreationTime := FindData.ftCreationTime; - FindRec.LastAccessTime := FindData.ftLastAccessTime; - FindRec.LastWriteTime := FindData.ftLastWriteTime; - FindRec.AlternateName := FindData.cAlternateFileName; -end; - -function _FindFirst(const FileName: String; var FindRec: TFindRec): Boolean; -var - FindHandle: THandle; - FindData: TWin32FindData; -begin - FindHandle := FindFirstFileRedir(ScriptFuncDisableFsRedir, FileName, FindData); - if FindHandle <> INVALID_HANDLE_VALUE then begin - FindRec.FindHandle := FindHandle; - FindDataToFindRec(FindData, FindRec); - Result := True; - end - else begin - FindRec.FindHandle := 0; - Result := False; + Stack.SetInt(PStart-2, GetLastError()); + Stack.SetInt(PStart, DllHandle); + end); + RegisterScriptFunc('CALLDLLPROC', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + @DllProc := GetProcAddress(Stack.GetInt(PStart-1), PChar(Stack.GetString(PStart-2))); + if Assigned(DllProc) then begin + Stack.SetInt(PStart-5, DllProc(Stack.GetInt(PStart-3), Stack.GetInt(PStart-4))); + Stack.SetBool(PStart, True); + end else + Stack.SetBool(PStart, False); + end); + RegisterScriptFunc('FREEDLL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, FreeLibrary(Stack.GetInt(PStart-1))); + end); + RegisterScriptFunc('CREATEMUTEX', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Windows.CreateMutex(nil, False, PChar(Stack.GetString(PStart))); + end); + RegisterScriptFunc('OEMTOCHARBUFF', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + S := Stack.GetAnsiString(PStart); + OemToCharBuffA(PAnsiChar(S), PAnsiChar(S), Length(S)); + Stack.SetAnsiString(PStart, S); + end); + RegisterScriptFunc('CHARTOOEMBUFF', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + S := Stack.GetAnsiString(PStart); + CharToOemBuffA(PAnsiChar(S), PAnsiChar(S), Length(S)); + Stack.SetAnsiString(PStart, S); + end); end; -end; - -function _FindNext(var FindRec: TFindRec): Boolean; -var - FindData: TWin32FindData; -begin - Result := (FindRec.FindHandle <> 0) and FindNextFile(FindRec.FindHandle, FindData); - if Result then - FindDataToFindRec(FindData, FindRec); -end; -procedure _FindClose(var FindRec: TFindRec); -begin - if FindRec.FindHandle <> 0 then begin - Windows.FindClose(FindRec.FindHandle); - FindRec.FindHandle := 0; + procedure RegisterOle2ScriptFuncs; + begin + RegisterScriptFunc('COFREEUNUSEDLIBRARIES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + CoFreeUnusedLibraries; + end); end; -end; -function _FmtMessage(const S: String; const Args: array of String): String; -begin - Result := FmtMessage(PChar(S), Args); -end; - -type - { *Must* keep this in synch with ScriptFunc_C } - TWindowsVersion = packed record - Major: Cardinal; - Minor: Cardinal; - Build: Cardinal; - ServicePackMajor: Cardinal; - ServicePackMinor: Cardinal; - NTPlatform: Boolean; - ProductType: Byte; - SuiteMask: Word; + procedure RegisterLoggingFuncScriptFuncs; + begin + RegisterScriptFunc('LOG', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Log(Stack.GetString(PStart)); + end); end; -procedure _GetWindowsVersionEx(var Version: TWindowsVersion); -begin - Version.Major := WindowsVersion shr 24; - Version.Minor := (WindowsVersion shr 16) and $FF; - Version.Build := WindowsVersion and $FFFF; - Version.ServicePackMajor := Hi(NTServicePackLevel); - Version.ServicePackMinor := Lo(NTServicePackLevel); - Version.NTPlatform := True; - Version.ProductType := WindowsProductType; - Version.SuiteMask := WindowsSuiteMask; -end; - -procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); -{$IFDEF DEBUG} -var - Count: Integer; -{$ENDIF} - - procedure RegisterFunctionTable(const FunctionTable: array of AnsiString; - const ProcPtr: TPSProcPtr); + procedure RegisterOtherScriptFuncs; + var + TypeEntry: PSetupTypeEntry; + StringList: TStringList; + S: String; + AnsiS: AnsiString; + ErrorCode: Cardinal; begin - for var Func in FunctionTable do - ScriptInterpreter.RegisterFunctionName(ExtractScriptFuncName(Func), - ProcPtr, nil, nil); - {$IFDEF DEBUG} - Inc(Count); - {$ENDIF} + RegisterScriptFunc('BRINGTOFRONTANDRESTORE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Application.BringToFront(); + Application.Restore(); + end); + RegisterScriptFunc('WIZARDDIRVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.DirEdit.Text)); + end); + RegisterScriptFunc('WIZARDGROUPVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.GroupEdit.Text)); + end); + RegisterScriptFunc('WIZARDNOICONS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + Stack.SetBool(PStart, GetWizardForm.NoIconsCheck.Checked); + end); + RegisterScriptFunc('WIZARDSETUPTYPE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + TypeEntry := GetWizardForm.GetSetupType(); + if TypeEntry <> nil then begin + if Stack.GetBool(PStart-1) then + Stack.SetString(PStart, TypeEntry.Description) + else + Stack.SetString(PStart, TypeEntry.Name); + end + else + Stack.SetString(PStart, ''); + end); + RegisterScriptFunc(['WIZARDSELECTEDCOMPONENTS', 'WIZARDSELECTEDTASKS'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + StringList := TStringList.Create(); + try + if Name = 'WIZARDSELECTEDCOMPONENTS' then + GetWizardForm.GetSelectedComponents(StringList, Stack.GetBool(PStart-1), False) + else + GetWizardForm.GetSelectedTasks(StringList, Stack.GetBool(PStart-1), False, False); + Stack.SetString(PStart, StringsToCommaString(StringList)); + finally + StringList.Free(); + end; + end); + RegisterScriptFunc(['WIZARDSELECTCOMPONENTS', 'WIZARDSELECTTASKS'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + StringList := TStringList.Create(); + try + S := Stack.GetString(PStart); + StringChange(S, '/', '\'); + SetStringsFromCommaString(StringList, S); + if Name = 'WIZARDSELECTCOMPONENTS' then + GetWizardForm.SelectComponents(StringList) + else + GetWizardForm.SelectTasks(StringList); + finally + StringList.Free(); + end; + end); + RegisterScriptFunc('WIZARDSILENT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + Stack.SetBool(PStart, InstallMode <> imNormal); + end); + RegisterScriptFunc('ISUNINSTALLER', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, IsUninstaller); + end); + RegisterScriptFunc('UNINSTALLSILENT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if not IsUninstaller then + NoSetupFuncError(Name); + Stack.SetBool(PStart, UninstallSilent); + end); + RegisterScriptFunc('CURRENTFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + if CheckOrInstallCurrentFilename <> '' then + Stack.SetString(PStart, CheckOrInstallCurrentFilename) + else + InternalError('An attempt was made to call the "CurrentFilename" function from outside a "Check", "BeforeInstall" or "AfterInstall" event function belonging to a "[Files]" entry'); + end); + RegisterScriptFunc('CURRENTSOURCEFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + NoUninstallFuncError(Name); + if CheckOrInstallCurrentSourceFilename <> '' then + Stack.SetString(PStart, CheckOrInstallCurrentSourceFilename) + else + InternalError('An attempt was made to call the "CurrentSourceFilename" function from outside a "Check", "BeforeInstall" or "AfterInstall" event function belonging to a "[Files]" entry with flag "external"'); + end); + RegisterScriptFunc('CASTSTRINGTOINTEGER', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, Integer(PChar(Stack.GetString(PStart-1)))); + end); + RegisterScriptFunc('CASTINTEGERTOSTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, String(PChar(Stack.GetInt(PStart-1)))); + end); + RegisterScriptFunc('ABORT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Abort; + end); + RegisterScriptFunc('GETEXCEPTIONMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetString(PStart, GetExceptionMessage(Caller)); + end); + RegisterScriptFunc('RAISEEXCEPTION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + raise Exception.Create(Stack.GetString(PStart)); + end); + RegisterScriptFunc('SHOWEXCEPTIONMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + TMainForm.ShowExceptionMsg(AddPeriod(GetExceptionMessage(Caller))); + end); + RegisterScriptFunc('TERMINATED', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, Application.Terminated); + end); + RegisterScriptFunc('GETPREVIOUSDATA', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + if IsUninstaller then + Stack.SetString(PStart, GetCodePreviousData(UninstallExpandedAppId, Stack.GetString(PStart-1), Stack.GetString(PStart-2))) + else + Stack.SetString(PStart, GetCodePreviousData(ExpandConst(SetupHeader.AppId), Stack.GetString(PStart-1), Stack.GetString(PStart-2))); + end); + RegisterScriptFunc('SETPREVIOUSDATA', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, SetCodePreviousData(Stack.GetInt(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3))); + end); + RegisterScriptFunc('LOADSTRINGFROMFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + AnsiS := Stack.GetAnsiString(PStart-2); + Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), AnsiS, fsRead)); + Stack.SetAnsiString(PStart-2, AnsiS); + end); + RegisterScriptFunc('LOADSTRINGFROMLOCKEDFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + AnsiS := Stack.GetAnsiString(PStart-2); + Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), AnsiS, fsReadWrite)); + Stack.SetAnsiString(PStart-2, AnsiS); + end); + RegisterScriptFunc('LOADSTRINGSFROMFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, LoadStringsFromFile(Stack.GetString(PStart-1), Stack, PStart-2, fsRead)); + end); + RegisterScriptFunc('LOADSTRINGSFROMLOCKEDFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, LoadStringsFromFile(Stack.GetString(PStart-1), Stack, PStart-2, fsReadWrite)); + end); + RegisterScriptFunc('SAVESTRINGTOFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, SaveStringToFile(Stack.GetString(PStart-1), Stack.GetAnsiString(PStart-2), Stack.GetBool(PStart-3))); + end); + RegisterScriptFunc('SAVESTRINGSTOFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), False, False)); + end); + RegisterScriptFunc('SAVESTRINGSTOUTF8FILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), True, False)); + end); + RegisterScriptFunc('SAVESTRINGSTOUTF8FILEWITHOUTBOM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), True, True)); + end); + RegisterScriptFunc('ENABLEFSREDIRECTION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, not ScriptFuncDisableFsRedir); + if Stack.GetBool(PStart-1) then + ScriptFuncDisableFsRedir := False + else begin + if not IsWin64 then + InternalError('Cannot disable FS redirection on this version of Windows'); + ScriptFuncDisableFsRedir := True; + end; + end); + RegisterScriptFunc('GETUNINSTALLPROGRESSFORM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetClass(PStart, GetUninstallProgressForm); + end); + RegisterScriptFunc('CREATECALLBACK', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetInt(PStart, CreateCallback(Caller, Stack.Items[PStart-1])); + end); + RegisterScriptFunc('ISDOTNETINSTALLED', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, IsDotNetInstalled(InstallDefaultRegView, TDotNetVersion(Stack.GetInt(PStart-1)), Stack.GetInt(PStart-2))); + end); + RegisterScriptFunc('ISMSIPRODUCTINSTALLED', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, IsMsiProductInstalled(Stack.GetString(PStart-1), Stack.GetInt64(PStart-2), ErrorCode)); + if ErrorCode <> 0 then + raise Exception.Create(Win32ErrorString(ErrorCode)); + end); + RegisterScriptFunc('INITIALIZEBITMAPIMAGEFROMICON', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + var AscendingTrySizes := Stack.GetIntArray(PStart-4); + Stack.SetBool(PStart, TBitmapImage(Stack.GetClass(PStart-1)).InitializeFromIcon(0, PChar(Stack.GetString(PStart-2)), Stack.GetInt(PStart-3), AscendingTrySizes)); + end); + RegisterScriptFunc('EXTRACT7ZIPARCHIVE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Extract7ZipArchive(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2), TOnExtractionProgress(Stack.GetProc(PStart-3, Caller))); + end); + RegisterScriptFunc('DEBUGGING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + Stack.SetBool(PStart, Debugging); + end); + RegisterScriptFunc('StringJoin', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + var Values := Stack.GetStringArray(PStart-2); + Stack.SetString(PStart, String.Join(Stack.GetString(PStart-1), Values)); + end); + RegisterScriptFunc(['StringSplit', 'StringSplitEx'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin + var Separators := Stack.GetStringArray(PStart-2); + var Parts: TArray; + if Name = 'STRINGSPLITEX' then begin + var Quote := Stack.GetString(PStart-3)[1]; + Parts := Stack.GetString(PStart-1).Split(Separators, Quote, Quote, TStringSplitOptions(Stack.GetInt(PStart-4))) + end else + Parts := Stack.GetString(PStart-1).Split(Separators, TStringSplitOptions(Stack.GetInt(PStart-3))); + Stack.SetArray(PStart, Parts); + end); end; procedure RegisterDelphiFunction(ProcPtr: Pointer; const Name: AnsiString); @@ -2209,30 +2607,37 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; begin + if ScriptFuncs <> nil then + ScriptFuncs.Free; + ScriptFuncs := TScriptFuncs.Create; + { The following should register all tables in ScriptFuncTables } {$IFDEF DEBUG} Count := 0; {$ENDIF} - RegisterFunctionTable(ScriptFuncTables[sftScriptDlg], @ScriptDlgProc); - RegisterFunctionTable(ScriptFuncTables[sftNewDiskForm], @NewDiskFormProc); - RegisterFunctionTable(ScriptFuncTables[sftBrowseFunc], @BrowseFuncProc); - RegisterFunctionTable(ScriptFuncTables[sftCommonFuncVcl], @CommonFuncVclProc); - RegisterFunctionTable(ScriptFuncTables[sftCommonFunc], @CommonFuncProc); - RegisterFunctionTable(ScriptFuncTables[sftInstall], @InstallProc); - RegisterFunctionTable(ScriptFuncTables[sftInstFunc], @InstFuncProc); - RegisterFunctionTable(ScriptFuncTables[sftInstFuncOle], @InstFuncOleProc); - RegisterFunctionTable(ScriptFuncTables[sftMainFunc], @MainFuncProc); - RegisterFunctionTable(ScriptFuncTables[sftMessages], @MessagesProc); - RegisterFunctionTable(ScriptFuncTables[sftSystem], @SystemProc); - RegisterFunctionTable(ScriptFuncTables[sftSysUtils], @SysUtilsProc); - RegisterFunctionTable(ScriptFuncTables[sftVerInfoFunc], @VerInfoFuncProc); - RegisterFunctionTable(ScriptFuncTables[sftWindows], @WindowsProc); - RegisterFunctionTable(ScriptFuncTables[sftOle2], @Ole2Proc); - RegisterFunctionTable(ScriptFuncTables[sftLoggingFunc], @LoggingFuncProc); - RegisterFunctionTable(ScriptFuncTables[sftOther], @OtherProc); + RegisterScriptDlgScriptFuncs; + RegisterNewDiskFormScriptFuncs; + RegisterBrowseFuncScriptFuncs; + RegisterCommonFuncVclScriptFuncs; + RegisterCommonFuncScriptFuncs; + RegisterInstallScriptFuncs; + RegisterInstFuncScriptFuncs; + RegisterInstFuncOleScriptFuncs; + RegisterMainFuncScriptFuncs; + RegisterMessagesScriptFuncs; + RegisterSystemScriptFuncs; + RegisterSysUtilsScriptFuncs; + RegisterVerInfoFuncScriptFuncs; + RegisterWindowsScriptFuncs; + RegisterOle2ScriptFuncs; + RegisterLoggingFuncScriptFuncs; + RegisterOtherScriptFuncs; {$IFDEF DEBUG} - if Count <> Length(ScriptFuncTables) then - raise Exception.Create('Count <> Length(ScriptFuncTables)'); + for var ScriptFuncTable in ScriptFuncTables do + for var ScriptFunc in ScriptFuncTable do + Dec(Count); + if Count <> 0 then + raise Exception.Create('Count <> 0'); {$ENDIF} { The following should register all functions in ScriptDelphiFuncTable } @@ -2262,5 +2667,6 @@ procedure FreeASMInliners; initialization finalization + ScriptFuncs.Free; FreeASMInliners; end. From b575511ee37c27bea14925756b6116f04d039308 Mon Sep 17 00:00:00 2001 From: Martijn Laan <1092369+martijnlaan@users.noreply.github.com> Date: Sun, 17 Nov 2024 22:22:16 +0100 Subject: [PATCH 2/8] Cleanup NoUninstallFuncError/NoSetupFuncError handling (centralize checks + show true function names instead of uppercased ones). Also put the helper funcs together. --- Projects/Src/Setup.ScriptFunc.pas | 378 ++++++++++++++---------------- 1 file changed, 179 insertions(+), 199 deletions(-) diff --git a/Projects/Src/Setup.ScriptFunc.pas b/Projects/Src/Setup.ScriptFunc.pas index 7c3902775..cfe80e226 100644 --- a/Projects/Src/Setup.ScriptFunc.pas +++ b/Projects/Src/Setup.ScriptFunc.pas @@ -32,26 +32,141 @@ implementation Shared.DotNetVersion, Setup.MsiFunc, Compression.SevenZipDecoder, Setup.DebugClient; -var - ScaleBaseUnitsInitialized: Boolean; - ScaleBaseUnitX, ScaleBaseUnitY: Integer; +type + TPSStackHelper = class helper for TPSStack + private + function GetArray(const ItemNo, FieldNo: Longint; out N: Integer): TPSVariantIFC; + function SetArray(const ItemNo, FieldNo: Longint; const N: Integer): TPSVariantIFC; overload; + public + type + TArrayOfInteger = array of Integer; + TArrayOfString = array of String; + TArrayBuilder = record + Arr: TPSVariantIFC; + I: Integer; + procedure Add(const Data: String); + end; + TArrayEnumerator = record + Arr: TPSVariantIFC; + N, I: Integer; + function HasNext: Boolean; + function Next: String; + end; + function GetIntArray(const ItemNo: Longint; const FieldNo: Longint = -1): TArrayOfInteger; + function GetProc(const ItemNo: Longint; const Exec: TPSExec): TMethod; + function GetStringArray(const ItemNo: Longint; const FieldNo: Longint = -1): TArrayOfString; + function InitArrayBuilder(const ItemNo: LongInt; const FieldNo: Longint = -1): TArrayBuilder; + function InitArrayEnumerator(const ItemNo: LongInt; const FieldNo: Longint = -1): TArrayEnumerator; + procedure SetArray(const ItemNo: Longint; const Data: TArray; const FieldNo: Longint = -1); overload; + procedure SetArray(const ItemNo: Longint; const Data: TStrings; const FieldNo: Longint = -1); overload; + procedure SetInt(const ItemNo: Longint; const Data: Integer; const FieldNo: Longint = -1); + end; -procedure NoSetupFuncError(const C: AnsiString); overload; +function TPSStackHelper.GetArray(const ItemNo, FieldNo: Longint; + out N: Integer): TPSVariantIFC; begin - InternalError(Format('Cannot call "%s" function during Setup', [C])); + if FieldNo >= 0 then + Result := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo) + else + Result := NewTPSVariantIFC(Items[ItemNo], True); + N := PSDynArrayGetLength(Pointer(Result.Dta^), Result.aType); end; -procedure NoUninstallFuncError(const C: AnsiString); overload; +function TPSStackHelper.SetArray(const ItemNo, FieldNo: Longint; + const N: Integer): TPSVariantIFC; begin - InternalError(Format('Cannot call "%s" function during Uninstall', [C])); + if FieldNo >= 0 then + Result := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo) + else + Result := NewTPSVariantIFC(Items[ItemNo], True); + PSDynArraySetLength(Pointer(Result.Dta^), Result.aType, N); end; -procedure NoSetupFuncError(const C: UnicodeString); overload; +function TPSStackHelper.GetIntArray(const ItemNo, FieldNo: Longint): TArrayOfInteger; begin - InternalError(Format('Cannot call "%s" function during Setup', [C])); + var N: Integer; + var Arr := GetArray(ItemNo, FieldNo, N); + SetLength(Result, N); + for var I := 0 to N-1 do + Result[I] := VNGetInt(PSGetArrayField(Arr, I)); end; -procedure NoUninstallFuncError(const C: UnicodeString); overload; +function TPSStackHelper.GetProc(const ItemNo: Longint; const Exec: TPSExec): TMethod; +begin + var P := PPSVariantProcPtr(Items[ItemNo]); + { ProcNo 0 means nil was passed by the script and GetProcAsMethod will then return a (nil, nil) TMethod } + Result := Exec.GetProcAsMethod(P.ProcNo); +end; + +function TPSStackHelper.GetStringArray(const ItemNo, FieldNo: Longint): TArrayOfString; +begin + var N: Integer; + var Arr := GetArray(ItemNo, FieldNo, N); + SetLength(Result, N); + for var I := 0 to N-1 do + Result[I] := VNGetString(PSGetArrayField(Arr, I)); +end; + +function TPSStackHelper.InitArrayBuilder(const ItemNo, FieldNo: Longint): TArrayBuilder; +begin + Result.Arr := SetArray(ItemNo, FieldNo, 0); + Result.I := 0; +end; + +procedure TPSStackHelper.TArrayBuilder.Add(const Data: String); +begin + PSDynArraySetLength(Pointer(Arr.Dta^), Arr.aType, I+1); + VNSetString(PSGetArrayField(Arr, I), Data); + Inc(I); +end; + +function TPSStackHelper.InitArrayEnumerator(const ItemNo, FieldNo: Longint): TArrayEnumerator; +begin + Result.Arr := GetArray(ItemNo, FieldNo, Result.N); + Result.I := 0; +end; + +function TPSStackHelper.TArrayEnumerator.HasNext: Boolean; +begin + Result := I < N; +end; + +function TPSStackHelper.TArrayEnumerator.Next: String; +begin + Result := VNGetString(PSGetArrayField(Arr, I)); + Inc(I); +end; + +procedure TPSStackHelper.SetArray(const ItemNo: Longint; const Data: TArray; const FieldNo: Longint); +begin + var N := System.Length(Data); + var Arr := SetArray(ItemNo, FieldNo, N); + for var I := 0 to N-1 do + VNSetString(PSGetArrayField(Arr, I), Data[I]); +end; + +procedure TPSStackHelper.SetArray(const ItemNo: Longint; const Data: TStrings; const FieldNo: Longint); +begin + var N := Data.Count; + var Arr := SetArray(ItemNo, FieldNo, N); + for var I := 0 to N-1 do + VNSetString(PSGetArrayField(Arr, I), Data[I]); +end; + +procedure TPSStackHelper.SetInt(const ItemNo: Longint; const Data: Integer; + const FieldNo: Longint); +begin + if FieldNo = -1 then + inherited SetInt(ItemNo, Data) + else begin + var PSVariantIFC := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo); + VNSetInt(PSVariantIFC, Data); + end; +end; + +{---} + +procedure NoUninstallFuncError(const C: AnsiString); overload; begin InternalError(Format('Cannot call "%s" function during Uninstall', [C])); end; @@ -88,6 +203,10 @@ function GetMsgBoxCaption: String; Result := SetupMessages[ID]; end; +var + ScaleBaseUnitsInitialized: Boolean; + ScaleBaseUnitX, ScaleBaseUnitY: Integer; + procedure InitializeScaleBaseUnits; var Font: TFont; @@ -114,8 +233,6 @@ function IsProtectedSrcExe(const Filename: String): Boolean; Result := False; end; -{---} - type { *Must* keep this in synch with ScriptFunc_C } TFindRec = record @@ -183,7 +300,7 @@ function _FmtMessage(const S: String; const Args: array of String): String; end; type - { *Must* keep this in synch with ScriptFunc_C } + { *Must* keep this in synch with Compiler.ScriptFunc.pas } TWindowsVersion = packed record Major: Cardinal; Minor: Cardinal; @@ -207,142 +324,6 @@ procedure _GetWindowsVersionEx(var Version: TWindowsVersion); Version.SuiteMask := WindowsSuiteMask; end; -{---} - -type - TPSStackHelper = class helper for TPSStack - private - function GetArray(const ItemNo, FieldNo: Longint; out N: Integer): TPSVariantIFC; - function SetArray(const ItemNo, FieldNo: Longint; const N: Integer): TPSVariantIFC; overload; - public - type - TArrayOfInteger = array of Integer; - TArrayOfString = array of String; - TArrayBuilder = record - Arr: TPSVariantIFC; - I: Integer; - procedure Add(const Data: String); - end; - TArrayEnumerator = record - Arr: TPSVariantIFC; - N, I: Integer; - function HasNext: Boolean; - function Next: String; - end; - function GetIntArray(const ItemNo: Longint; const FieldNo: Longint = -1): TArrayOfInteger; - function GetProc(const ItemNo: Longint; const Exec: TPSExec): TMethod; - function GetStringArray(const ItemNo: Longint; const FieldNo: Longint = -1): TArrayOfString; - function InitArrayBuilder(const ItemNo: LongInt; const FieldNo: Longint = -1): TArrayBuilder; - function InitArrayEnumerator(const ItemNo: LongInt; const FieldNo: Longint = -1): TArrayEnumerator; - procedure SetArray(const ItemNo: Longint; const Data: TArray; const FieldNo: Longint = -1); overload; - procedure SetArray(const ItemNo: Longint; const Data: TStrings; const FieldNo: Longint = -1); overload; - procedure SetInt(const ItemNo: Longint; const Data: Integer; const FieldNo: Longint = -1); - end; - -function TPSStackHelper.GetArray(const ItemNo, FieldNo: Longint; - out N: Integer): TPSVariantIFC; -begin - if FieldNo >= 0 then - Result := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo) - else - Result := NewTPSVariantIFC(Items[ItemNo], True); - N := PSDynArrayGetLength(Pointer(Result.Dta^), Result.aType); -end; - -function TPSStackHelper.SetArray(const ItemNo, FieldNo: Longint; - const N: Integer): TPSVariantIFC; -begin - if FieldNo >= 0 then - Result := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo) - else - Result := NewTPSVariantIFC(Items[ItemNo], True); - PSDynArraySetLength(Pointer(Result.Dta^), Result.aType, N); -end; - -function TPSStackHelper.GetIntArray(const ItemNo, FieldNo: Longint): TArrayOfInteger; -begin - var N: Integer; - var Arr := GetArray(ItemNo, FieldNo, N); - SetLength(Result, N); - for var I := 0 to N-1 do - Result[I] := VNGetInt(PSGetArrayField(Arr, I)); -end; - -function TPSStackHelper.GetProc(const ItemNo: Longint; const Exec: TPSExec): TMethod; -begin - var P := PPSVariantProcPtr(Items[ItemNo]); - { ProcNo 0 means nil was passed by the script and GetProcAsMethod will then return a (nil, nil) TMethod } - Result := Exec.GetProcAsMethod(P.ProcNo); -end; - -function TPSStackHelper.GetStringArray(const ItemNo, FieldNo: Longint): TArrayOfString; -begin - var N: Integer; - var Arr := GetArray(ItemNo, FieldNo, N); - SetLength(Result, N); - for var I := 0 to N-1 do - Result[I] := VNGetString(PSGetArrayField(Arr, I)); -end; - -function TPSStackHelper.InitArrayBuilder(const ItemNo, FieldNo: Longint): TArrayBuilder; -begin - Result.Arr := SetArray(ItemNo, FieldNo, 0); - Result.I := 0; -end; - -procedure TPSStackHelper.TArrayBuilder.Add(const Data: String); -begin - PSDynArraySetLength(Pointer(Arr.Dta^), Arr.aType, I+1); - VNSetString(PSGetArrayField(Arr, I), Data); - Inc(I); -end; - -function TPSStackHelper.InitArrayEnumerator(const ItemNo, FieldNo: Longint): TArrayEnumerator; -begin - Result.Arr := GetArray(ItemNo, FieldNo, Result.N); - Result.I := 0; -end; - -function TPSStackHelper.TArrayEnumerator.HasNext: Boolean; -begin - Result := I < N; -end; - -function TPSStackHelper.TArrayEnumerator.Next: String; -begin - Result := VNGetString(PSGetArrayField(Arr, I)); - Inc(I); -end; - -procedure TPSStackHelper.SetArray(const ItemNo: Longint; const Data: TArray; const FieldNo: Longint); -begin - var N := System.Length(Data); - var Arr := SetArray(ItemNo, FieldNo, N); - for var I := 0 to N-1 do - VNSetString(PSGetArrayField(Arr, I), Data[I]); -end; - -procedure TPSStackHelper.SetArray(const ItemNo: Longint; const Data: TStrings; const FieldNo: Longint); -begin - var N := Data.Count; - var Arr := SetArray(ItemNo, FieldNo, N); - for var I := 0 to N-1 do - VNSetString(PSGetArrayField(Arr, I), Data[I]); -end; - -procedure TPSStackHelper.SetInt(const ItemNo: Longint; const Data: Integer; - const FieldNo: Longint); -begin - if FieldNo = -1 then - inherited SetInt(ItemNo, Data) - else begin - var PSVariantIFC := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo); - VNSetInt(PSVariantIFC, Data); - end; -end; - -{---} - procedure CrackCodeRootKey(CodeRootKey: HKEY; var RegView: TRegView; var RootKey: HKEY); begin @@ -812,16 +793,37 @@ function CreateCallback(const Caller: TPSExec; const P: PPSVariantProcPtr): Long type TScriptFunc = reference to procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal); - TScriptFuncs = TDictionary; + TScriptFuncTyp = (sfNormal, sfNoUninstall, sfOnlyUninstall); + TScriptFuncEx = record + OrgName: AnsiString; + ScriptFunc: TScriptFunc; + Typ: TScriptFuncTyp; + constructor Create(const AOrgName: AnsiString; const AScriptFunc: TScriptFunc; const ATyp: TScriptFuncTyp); + end; + TScriptFuncs = TDictionary; + var ScriptFuncs: TScriptFuncs; +constructor TScriptFuncEx.Create(const AOrgName: AnsiString; const AScriptFunc: TScriptFunc; const ATyp: TScriptFuncTyp); +begin + OrgName := AOrgName; + ScriptFunc := AScriptFunc; + Typ := ATyp; +end; + function ScriptFuncPSProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; begin - var ScriptFunc: TScriptFunc; - Result := ScriptFuncs.TryGetValue(Proc.Name, ScriptFunc); - if Result then - ScriptFunc(Caller, Proc.Name, Stack, Stack.Count-1); + var ScriptFuncEx: TScriptFuncEx; + Result := ScriptFuncs.TryGetValue(Proc.Name, ScriptFuncEx); + if Result then begin + if (ScriptFuncEx.Typ = sfNoUninstall) and IsUninstaller then + NoUninstallFuncError(Proc.Name) + else if (ScriptFuncEx.Typ = sfOnlyUninstall) and not IsUninstaller then + InternalError(Format('Cannot call "%s" function during Setup', [ScriptFuncEx.OrgName])) + else + ScriptFuncEx.ScriptFunc(Caller, Proc.Name, Stack, Stack.Count-1); + end; end; procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); @@ -830,15 +832,21 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Count: Integer; {$ENDIF} - procedure RegisterScriptFunc(const Name: AnsiString; const ScriptFunc: TScriptFunc); overload; + procedure RegisterScriptFunc(const Name: AnsiString; const ScriptFuncTyp: TScriptFuncTyp; const ScriptFunc: TScriptFunc); overload; begin - ScriptFuncs.Add(FastUpperCase(Name), ScriptFunc); + var ScriptFuncEx: TScriptFuncEx; + ScriptFuncs.Add(FastUpperCase(Name), TScriptFuncEx.Create(Name, ScriptFunc, ScriptFuncTyp)); ScriptInterpreter.RegisterFunctionName(Name, ScriptFuncPSProc, nil, nil); {$IFDEF DEBUG} Inc(Count); {$ENDIF} end; + procedure RegisterScriptFunc(const Name: AnsiString; const ScriptFunc: TScriptFunc); overload; + begin + RegisterScriptFunc(Name, sfNormal, ScriptFunc); + end; + procedure RegisterScriptFunc(const Names: array of AnsiString; const ScriptFunc: TScriptFunc); overload; begin for var Name in Names do @@ -847,22 +855,16 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); procedure RegisterScriptDlgScriptFuncs; begin - RegisterScriptFunc('PAGEFROMID', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('PageFromID', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); Stack.SetClass(PStart, GetWizardForm.PageFromID(Stack.GetInt(PStart-1))); end); - RegisterScriptFunc('PAGEINDEXFROMID', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('PageIndexFromID', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); Stack.SetInt(PStart, GetWizardForm.PageIndexFromID(Stack.GetInt(PStart-1))); end); - RegisterScriptFunc('CREATECUSTOMPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateCustomPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); var NewPage := TWizardPage.Create(GetWizardForm); try NewPage.Caption := Stack.GetString(PStart-2); @@ -874,10 +876,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewPage); end); - RegisterScriptFunc('CREATEINPUTQUERYPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateInputQueryPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); var NewInputQueryPage := TInputQueryWizardPage.Create(GetWizardForm); try NewInputQueryPage.Caption := Stack.GetString(PStart-2); @@ -890,10 +890,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewInputQueryPage); end); - RegisterScriptFunc('CREATEINPUTOPTIONPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateInputOptionPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); var NewInputOptionPage := TInputOptionWizardPage.Create(GetWizardForm); try NewInputOptionPage.Caption := Stack.GetString(PStart-2); @@ -907,10 +905,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewInputOptionPage); end); - RegisterScriptFunc('CREATEINPUTDIRPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATEINPUTDIRPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); var NewInputDirPage := TInputDirWizardPage.Create(GetWizardForm); try NewInputDirPage.Caption := Stack.GetString(PStart-2); @@ -924,10 +920,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewInputDirPage); end); - RegisterScriptFunc('CREATEINPUTFILEPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATEINPUTFILEPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); var NewInputFilePage := TInputFileWizardPage.Create(GetWizardForm); try NewInputFilePage.Caption := Stack.GetString(PStart-2); @@ -940,10 +934,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewInputFilePage); end); - RegisterScriptFunc('CREATEOUTPUTMSGPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATEOUTPUTMSGPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); var NewOutputMsgPage := TOutputMsgWizardPage.Create(GetWizardForm); try NewOutputMsgPage.Caption := Stack.GetString(PStart-2); @@ -956,10 +948,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewOutputMsgPage); end); - RegisterScriptFunc('CREATEOUTPUTMSGMEMOPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATEOUTPUTMSGMEMOPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); var NewOutputMsgMemoPage := TOutputMsgMemoWizardPage.Create(GetWizardForm); try NewOutputMsgMemoPage.Caption := Stack.GetString(PStart-2); @@ -973,10 +963,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewOutputMsgMemoPage); end); - RegisterScriptFunc('CREATEOUTPUTPROGRESSPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATEOUTPUTPROGRESSPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); var NewOutputProgressPage := TOutputProgressWizardPage.Create(GetWizardForm); try NewOutputProgressPage.Caption := Stack.GetString(PStart-1); @@ -989,10 +977,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewOutputProgressPage); end); - RegisterScriptFunc('CREATEOUTPUTMARQUEEPROGRESSPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATEOUTPUTMARQUEEPROGRESSPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); var NewOutputMarqueeProgressPage := TOutputMarqueeProgressWizardPage.Create(GetWizardForm); try NewOutputMarqueeProgressPage.Caption := Stack.GetString(PStart-1); @@ -1005,10 +991,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewOutputMarqueeProgressPage); end); - RegisterScriptFunc('CREATEDOWNLOADPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) - begin - if IsUninstaller then - NoUninstallFuncError(Name); + RegisterScriptFunc('CREATEDOWNLOADPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + begin; var NewDownloadPage := TDownloadWizardPage.Create(GetWizardForm); try NewDownloadPage.Caption := Stack.GetString(PStart-1); @@ -1022,10 +1006,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewDownloadPage); end); - RegisterScriptFunc('CREATEEXTRACTIONPAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATEEXTRACTIONPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); var NewExtractionPage := TExtractionWizardPage.Create(GetWizardForm); try NewExtractionPage.Caption := Stack.GetString(PStart-1); @@ -2439,10 +2421,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); begin Stack.SetBool(PStart, IsUninstaller); end); - RegisterScriptFunc('UNINSTALLSILENT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('UninstallSilent', sfOnlyUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if not IsUninstaller then - NoSetupFuncError(Name); Stack.SetBool(PStart, UninstallSilent); end); RegisterScriptFunc('CURRENTFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) From f1d7e47e592986acc18fbe1c33917abb5e02c5e7 Mon Sep 17 00:00:00 2001 From: Martijn Laan <1092369+martijnlaan@users.noreply.github.com> Date: Mon, 18 Nov 2024 19:44:49 +0100 Subject: [PATCH 3/8] Split off the helper stuff from ScriptFunc into two new other units + some other cleanup. --- Components/PSStackHelper.pas | 152 +++ Projects/Setup.dpr | 4 +- Projects/Setup.dproj | 2 + Projects/Src/Setup.ScriptFunc.HelperFunc.pas | 711 ++++++++++++++ Projects/Src/Setup.ScriptFunc.pas | 936 ++----------------- Projects/Src/Shared.ScriptFunc.pas | 4 +- 6 files changed, 942 insertions(+), 867 deletions(-) create mode 100644 Components/PSStackHelper.pas create mode 100644 Projects/Src/Setup.ScriptFunc.HelperFunc.pas diff --git a/Components/PSStackHelper.pas b/Components/PSStackHelper.pas new file mode 100644 index 000000000..6a37fbe23 --- /dev/null +++ b/Components/PSStackHelper.pas @@ -0,0 +1,152 @@ +unit PSStackHelper; + +{ + Inno Setup + Copyright (C) 1997-2024 Jordan Russell + Portions by Martijn Laan + For conditions of distribution and use, see LICENSE.TXT. + + ROPS TPSStack helper class +} + +interface + +uses + Classes, + uPSRuntime; + +type + TPSStackHelper = class helper for TPSStack + private + function GetArray(const ItemNo, FieldNo: Longint; out N: Integer): TPSVariantIFC; + function SetArray(const ItemNo, FieldNo: Longint; const N: Integer): TPSVariantIFC; overload; + public + type + TArrayOfInteger = array of Integer; + TArrayOfString = array of String; + TArrayBuilder = record + Arr: TPSVariantIFC; + I: Integer; + procedure Add(const Data: String); + end; + TArrayEnumerator = record + Arr: TPSVariantIFC; + N, I: Integer; + function HasNext: Boolean; + function Next: String; + end; + function GetIntArray(const ItemNo: Longint; const FieldNo: Longint = -1): TArrayOfInteger; + function GetProc(const ItemNo: Longint; const Exec: TPSExec): TMethod; + function GetStringArray(const ItemNo: Longint; const FieldNo: Longint = -1): TArrayOfString; + function InitArrayBuilder(const ItemNo: LongInt; const FieldNo: Longint = -1): TArrayBuilder; + function InitArrayEnumerator(const ItemNo: LongInt; const FieldNo: Longint = -1): TArrayEnumerator; + procedure SetArray(const ItemNo: Longint; const Data: TArray; const FieldNo: Longint = -1); overload; + procedure SetArray(const ItemNo: Longint; const Data: TStrings; const FieldNo: Longint = -1); overload; + procedure SetInt(const ItemNo: Longint; const Data: Integer; const FieldNo: Longint = -1); + end; + +implementation + +function TPSStackHelper.GetArray(const ItemNo, FieldNo: Longint; + out N: Integer): TPSVariantIFC; +begin + if FieldNo >= 0 then + Result := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo) + else + Result := NewTPSVariantIFC(Items[ItemNo], True); + N := PSDynArrayGetLength(Pointer(Result.Dta^), Result.aType); +end; + +function TPSStackHelper.SetArray(const ItemNo, FieldNo: Longint; + const N: Integer): TPSVariantIFC; +begin + if FieldNo >= 0 then + Result := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo) + else + Result := NewTPSVariantIFC(Items[ItemNo], True); + PSDynArraySetLength(Pointer(Result.Dta^), Result.aType, N); +end; + +function TPSStackHelper.GetIntArray(const ItemNo, FieldNo: Longint): TArrayOfInteger; +begin + var N: Integer; + var Arr := GetArray(ItemNo, FieldNo, N); + SetLength(Result, N); + for var I := 0 to N-1 do + Result[I] := VNGetInt(PSGetArrayField(Arr, I)); +end; + +function TPSStackHelper.GetProc(const ItemNo: Longint; const Exec: TPSExec): TMethod; +begin + var P := PPSVariantProcPtr(Items[ItemNo]); + { ProcNo 0 means nil was passed by the script and GetProcAsMethod will then return a (nil, nil) TMethod } + Result := Exec.GetProcAsMethod(P.ProcNo); +end; + +function TPSStackHelper.GetStringArray(const ItemNo, FieldNo: Longint): TArrayOfString; +begin + var N: Integer; + var Arr := GetArray(ItemNo, FieldNo, N); + SetLength(Result, N); + for var I := 0 to N-1 do + Result[I] := VNGetString(PSGetArrayField(Arr, I)); +end; + +function TPSStackHelper.InitArrayBuilder(const ItemNo, FieldNo: Longint): TArrayBuilder; +begin + Result.Arr := SetArray(ItemNo, FieldNo, 0); + Result.I := 0; +end; + +procedure TPSStackHelper.TArrayBuilder.Add(const Data: String); +begin + PSDynArraySetLength(Pointer(Arr.Dta^), Arr.aType, I+1); + VNSetString(PSGetArrayField(Arr, I), Data); + Inc(I); +end; + +function TPSStackHelper.InitArrayEnumerator(const ItemNo, FieldNo: Longint): TArrayEnumerator; +begin + Result.Arr := GetArray(ItemNo, FieldNo, Result.N); + Result.I := 0; +end; + +function TPSStackHelper.TArrayEnumerator.HasNext: Boolean; +begin + Result := I < N; +end; + +function TPSStackHelper.TArrayEnumerator.Next: String; +begin + Result := VNGetString(PSGetArrayField(Arr, I)); + Inc(I); +end; + +procedure TPSStackHelper.SetArray(const ItemNo: Longint; const Data: TArray; const FieldNo: Longint); +begin + var N := System.Length(Data); + var Arr := SetArray(ItemNo, FieldNo, N); + for var I := 0 to N-1 do + VNSetString(PSGetArrayField(Arr, I), Data[I]); +end; + +procedure TPSStackHelper.SetArray(const ItemNo: Longint; const Data: TStrings; const FieldNo: Longint); +begin + var N := Data.Count; + var Arr := SetArray(ItemNo, FieldNo, N); + for var I := 0 to N-1 do + VNSetString(PSGetArrayField(Arr, I), Data[I]); +end; + +procedure TPSStackHelper.SetInt(const ItemNo: Longint; const Data: Integer; + const FieldNo: Longint); +begin + if FieldNo = -1 then + inherited SetInt(ItemNo, Data) + else begin + var PSVariantIFC := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo); + VNSetInt(PSVariantIFC, Data); + end; +end; + +end. \ No newline at end of file diff --git a/Projects/Setup.dpr b/Projects/Setup.dpr index 84d7c47e2..5f44135f8 100644 --- a/Projects/Setup.dpr +++ b/Projects/Setup.dpr @@ -93,7 +93,9 @@ uses Shared.DotNetVersion in 'Src\Shared.DotNetVersion.pas', NewUxTheme in '..\Components\NewUxTheme.pas', PBKDF2 in '..\Components\PBKDF2.pas', - Compression.SevenZipDecoder in 'Src\Compression.SevenZipDecoder.pas'; + Compression.SevenZipDecoder in 'Src\Compression.SevenZipDecoder.pas', + PSStackHelper in '..\Components\PSStackHelper.pas', + Setup.ScriptFunc.HelperFunc in 'Src\Setup.ScriptFunc.HelperFunc.pas'; {$SETPEOSVERSION 6.1} {$SETPESUBSYSVERSION 6.1} diff --git a/Projects/Setup.dproj b/Projects/Setup.dproj index 19d4c3470..54b83d8aa 100644 --- a/Projects/Setup.dproj +++ b/Projects/Setup.dproj @@ -167,6 +167,8 @@ + + Base diff --git a/Projects/Src/Setup.ScriptFunc.HelperFunc.pas b/Projects/Src/Setup.ScriptFunc.HelperFunc.pas new file mode 100644 index 000000000..8caf509a8 --- /dev/null +++ b/Projects/Src/Setup.ScriptFunc.HelperFunc.pas @@ -0,0 +1,711 @@ +unit Setup.ScriptFunc.HelperFunc; + +{ + Inno Setup + Copyright (C) 1997-2024 Jordan Russell + Portions by Martijn Laan + For conditions of distribution and use, see LICENSE.TXT. + + Helper functions for the script support functions (run time - used by Setup) +} + +interface + +uses + Windows, + uPSRuntime, MD5, SHA1, + Shared.CommonFunc, Shared.FileClass, Setup.MainForm, Setup.WizardForm, + Setup.UninstallProgressForm; + +type + { Must keep this in synch with Compiler.ScriptFunc.pas } + TOnLog = procedure(const S: String; const Error, FirstLine: Boolean) of object; + + { Must keep this in synch with Compiler.ScriptFunc.pas } + TFindRec = record + Name: String; + Attributes: LongWord; + SizeHigh: LongWord; + SizeLow: LongWord; + CreationTime: TFileTime; + LastAccessTime: TFileTime; + LastWriteTime: TFileTime; + AlternateName: String; + FindHandle: THandle; + end; + + { Must keep this in synch with Compiler.ScriptFunc.pas } + TWindowsVersion = packed record + Major: Cardinal; + Minor: Cardinal; + Build: Cardinal; + ServicePackMajor: Cardinal; + ServicePackMinor: Cardinal; + NTPlatform: Boolean; + ProductType: Byte; + SuiteMask: Word; + end; + +var + ScaleBaseUnitX, ScaleBaseUnitY: Integer; + +procedure NoUninstallFuncError(const C: AnsiString); overload; +procedure OnlyUninstallFuncError(const C: AnsiString); overload; +function GetMainForm: TMainForm; +function GetWizardForm: TWizardForm; +function GetUninstallProgressForm: TUninstallProgressForm; +function GetMsgBoxCaption: String; +procedure InitializeScaleBaseUnits; +function IsProtectedSrcExe(const Filename: String): Boolean; +function FindFirstHelper(const FileName: String; var FindRec: TFindRec): Boolean; +function FindNextHelper(var FindRec: TFindRec): Boolean; +procedure FindCloseHelper(var FindRec: TFindRec); +function FmtMessageHelper(const S: String; const Args: array of String): String; +procedure GetWindowsVersionExHelper(var Version: TWindowsVersion); +procedure CrackCodeRootKey(CodeRootKey: HKEY; var RegView: TRegView; + var RootKey: HKEY); +function GetSubkeyOrValueNames(const RegView: TRegView; const RootKey: HKEY; + const SubKeyName: String; const Stack: TPSStack; const ItemNo: Longint; const Subkey: Boolean): Boolean; +function GetMD5OfFile(const DisableFsRedir: Boolean; const Filename: String): TMD5Digest; +function GetSHA1OfFile(const DisableFsRedir: Boolean; const Filename: String): TSHA1Digest; +function GetMD5OfAnsiString(const S: AnsiString): TMD5Digest; +function GetMD5OfUnicodeString(const S: UnicodeString): TMD5Digest; +function GetSHA1OfAnsiString(const S: AnsiString): TSHA1Digest; +function GetSHA1OfUnicodeString(const S: UnicodeString): TSHA1Digest; +procedure ProcessMessagesProc; far; +procedure ExecAndLogOutputLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt); +procedure ExecAndLogOutputLogCustom(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt); +function CustomMessage(const MsgName: String): String; +function NewExtractRelativePath(BaseName, DestName: string): string; +function NewFileSearch(const DisableFsRedir: Boolean; + const Name, DirList: String): String; +function GetExceptionMessage(const Caller: TPSExec): String; +function GetCodePreviousData(const ExpandedAppID, ValueName, DefaultValueData: String): String; +function SetCodePreviousData(const PreviousDataKey: HKEY; const ValueName, ValueData: String): Boolean; +function LoadStringFromFile(const FileName: String; var S: AnsiString; + const Sharing: TFileSharing): Boolean; +function LoadStringsFromFile(const FileName: String; const Stack: TPSStack; + const ItemNo: Longint; const Sharing: TFileSharing): Boolean; +function SaveStringToFile(const FileName: String; const S: AnsiString; Append: Boolean): Boolean; +function SaveStringsToFile(const FileName: String; const Stack: TPSStack; + const ItemNo: Longint; Append, UTF8, UTF8WithoutBOM: Boolean): Boolean; +function CreateCallback(const Caller: TPSExec; const P: PPSVariantProcPtr): LongWord; + +implementation + +uses + Forms, SysUtils, Graphics, + uPSUtils, PathFunc, ASMInline, PSStackHelper, + Setup.MainFunc, SetupLdrAndSetup.RedirFunc, Setup.InstFunc, + SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, + Shared.SetupTypes, Shared.SetupSteps, Setup.LoggingFunc, Setup.SetupForm; + +procedure NoUninstallFuncError(const C: AnsiString); overload; +begin + InternalError(Format('Cannot call "%s" function during Uninstall', [C])); +end; + +procedure OnlyUninstallFuncError(const C: AnsiString); overload; +begin + InternalError(Format('Cannot call "%s" function during Setup', [C])); +end; + +function GetMainForm: TMainForm; +begin + Result := MainForm; + if Result = nil then + InternalError('An attempt was made to access MainForm before it has been created'); +end; + +function GetWizardForm: TWizardForm; +begin + Result := WizardForm; + if Result = nil then + InternalError('An attempt was made to access WizardForm before it has been created'); +end; + +function GetUninstallProgressForm: TUninstallProgressForm; +begin + Result := UninstallProgressForm; + if Result = nil then + InternalError('An attempt was made to access UninstallProgressForm before it has been created'); +end; + +function GetMsgBoxCaption: String; +var + ID: TSetupMessageID; +begin + if IsUninstaller then + ID := msgUninstallAppTitle + else + ID := msgSetupAppTitle; + Result := SetupMessages[ID]; +end; + +var + ScaleBaseUnitsInitialized: Boolean; + +procedure InitializeScaleBaseUnits; +var + Font: TFont; +begin + if ScaleBaseUnitsInitialized then + Exit; + Font := TFont.Create; + try + SetFontNameSize(Font, LangOptions.DialogFontName, LangOptions.DialogFontSize, + '', 8); + CalculateBaseUnitsFromFont(Font, ScaleBaseUnitX, ScaleBaseUnitY); + finally + Font.Free; + end; + ScaleBaseUnitsInitialized := True; +end; + +function IsProtectedSrcExe(const Filename: String): Boolean; +begin + if (MainForm = nil) or (MainForm.CurStep < ssInstall) then begin + var ExpandedFilename := PathExpand(Filename); + Result := PathCompare(ExpandedFilename, SetupLdrOriginalFilename) = 0; + end else + Result := False; +end; + +procedure FindDataToFindRec(const FindData: TWin32FindData; + var FindRec: TFindRec); +begin + FindRec.Name := FindData.cFileName; + FindRec.Attributes := FindData.dwFileAttributes; + FindRec.SizeHigh := FindData.nFileSizeHigh; + FindRec.SizeLow := FindData.nFileSizeLow; + FindRec.CreationTime := FindData.ftCreationTime; + FindRec.LastAccessTime := FindData.ftLastAccessTime; + FindRec.LastWriteTime := FindData.ftLastWriteTime; + FindRec.AlternateName := FindData.cAlternateFileName; +end; + +function FindFirstHelper(const FileName: String; var FindRec: TFindRec): Boolean; +var + FindHandle: THandle; + FindData: TWin32FindData; +begin + FindHandle := FindFirstFileRedir(ScriptFuncDisableFsRedir, FileName, FindData); + if FindHandle <> INVALID_HANDLE_VALUE then begin + FindRec.FindHandle := FindHandle; + FindDataToFindRec(FindData, FindRec); + Result := True; + end + else begin + FindRec.FindHandle := 0; + Result := False; + end; +end; + +function FindNextHelper(var FindRec: TFindRec): Boolean; +var + FindData: TWin32FindData; +begin + Result := (FindRec.FindHandle <> 0) and FindNextFile(FindRec.FindHandle, FindData); + if Result then + FindDataToFindRec(FindData, FindRec); +end; + +procedure FindCloseHelper(var FindRec: TFindRec); +begin + if FindRec.FindHandle <> 0 then begin + Windows.FindClose(FindRec.FindHandle); + FindRec.FindHandle := 0; + end; +end; + +function FmtMessageHelper(const S: String; const Args: array of String): String; +begin + Result := FmtMessage(PChar(S), Args); +end; + +procedure GetWindowsVersionExHelper(var Version: TWindowsVersion); +begin + Version.Major := WindowsVersion shr 24; + Version.Minor := (WindowsVersion shr 16) and $FF; + Version.Build := WindowsVersion and $FFFF; + Version.ServicePackMajor := Hi(NTServicePackLevel); + Version.ServicePackMinor := Lo(NTServicePackLevel); + Version.NTPlatform := True; + Version.ProductType := WindowsProductType; + Version.SuiteMask := WindowsSuiteMask; +end; + +procedure CrackCodeRootKey(CodeRootKey: HKEY; var RegView: TRegView; + var RootKey: HKEY); +begin + if (CodeRootKey and not CodeRootKeyValidFlags) = HKEY_AUTO then begin + { Change HKA to HKLM or HKCU, keeping our special flag bits. } + CodeRootKey := (CodeRootKey and CodeRootKeyValidFlags) or InstallModeRootKey; + end else begin + { Allow only predefined key handles (8xxxxxxx). Can't accept handles to + open keys because they might have our special flag bits set. + Also reject unknown flags which may have a meaning in the future. } + if (CodeRootKey shr 31 <> 1) or + ((CodeRootKey and CodeRootKeyFlagMask) and not CodeRootKeyValidFlags <> 0) then + InternalError('Invalid RootKey value'); + end; + + if CodeRootKey and CodeRootKeyFlag32Bit <> 0 then + RegView := rv32Bit + else if CodeRootKey and CodeRootKeyFlag64Bit <> 0 then begin + if not IsWin64 then + InternalError('Cannot access 64-bit registry keys on this version of Windows'); + RegView := rv64Bit; + end + else + RegView := InstallDefaultRegView; + RootKey := CodeRootKey and not CodeRootKeyFlagMask; +end; + +function GetSubkeyOrValueNames(const RegView: TRegView; const RootKey: HKEY; + const SubKeyName: String; const Stack: TPSStack; const ItemNo: Longint; const Subkey: Boolean): Boolean; +const + samDesired: array [Boolean] of REGSAM = (KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS); +var + K: HKEY; + Buf, S: String; + BufSize, R: DWORD; +begin + Result := False; + SetString(Buf, nil, 512); + if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, samDesired[Subkey], K) <> ERROR_SUCCESS then + Exit; + try + var ArrayBuilder := Stack.InitArrayBuilder(ItemNo); + while True do begin + BufSize := Length(Buf); + if Subkey then + R := RegEnumKeyEx(K, ArrayBuilder.I, @Buf[1], BufSize, nil, nil, nil, nil) + else + R := RegEnumValue(K, ArrayBuilder.I, @Buf[1], BufSize, nil, nil, nil, nil); + case R of + ERROR_SUCCESS: ; + ERROR_NO_MORE_ITEMS: Break; + ERROR_MORE_DATA: + begin + { Double the size of the buffer and try again } + if Length(Buf) >= 65536 then begin + { Sanity check: If we tried a 64 KB buffer and it's still saying + there's more data, something must be seriously wrong. Bail. } + Exit; + end; + SetString(Buf, nil, Length(Buf) * 2); + Continue; + end; + else + Exit; { unknown failure... } + end; + SetString(S, PChar(@Buf[1]), BufSize); + ArrayBuilder.Add(S); + end; + finally + RegCloseKey(K); + end; + Result := True; +end; + +function GetMD5OfFile(const DisableFsRedir: Boolean; const Filename: String): TMD5Digest; +{ Gets MD5 sum of the file Filename. An exception will be raised upon + failure. } +var + Buf: array[0..65535] of Byte; +begin + var Context: TMD5Context; + MD5Init(Context); + var F := TFileRedir.Create(DisableFsRedir, Filename, fdOpenExisting, faRead, fsReadWrite); + try + while True do begin + var NumRead := F.Read(Buf, SizeOf(Buf)); + if NumRead = 0 then + Break; + MD5Update(Context, Buf, NumRead); + end; + finally + F.Free; + end; + Result := MD5Final(Context); +end; + +function GetSHA1OfFile(const DisableFsRedir: Boolean; const Filename: String): TSHA1Digest; +{ Gets SHA-1 sum of the file Filename. An exception will be raised upon + failure. } +var + Buf: array[0..65535] of Byte; +begin + var Context: TSHA1Context; + SHA1Init(Context); + var F := TFileRedir.Create(DisableFsRedir, Filename, fdOpenExisting, faRead, fsReadWrite); + try + while True do begin + var NumRead := F.Read(Buf, SizeOf(Buf)); + if NumRead = 0 then + Break; + SHA1Update(Context, Buf, NumRead); + end; + finally + F.Free; + end; + Result := SHA1Final(Context); +end; + +function GetMD5OfAnsiString(const S: AnsiString): TMD5Digest; +begin + Result := MD5Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); +end; + +function GetMD5OfUnicodeString(const S: UnicodeString): TMD5Digest; +begin + Result := MD5Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); +end; + +function GetSHA1OfAnsiString(const S: AnsiString): TSHA1Digest; +begin + Result := SHA1Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); +end; + +function GetSHA1OfUnicodeString(const S: UnicodeString): TSHA1Digest; +begin + Result := SHA1Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); +end; + +procedure ProcessMessagesProc; far; +begin + Application.ProcessMessages; +end; + +procedure ExecAndLogOutputLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt); +begin + Log(S); +end; + +procedure ExecAndLogOutputLogCustom(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt); +begin + var OnLog := TOnLog(PMethod(Data)^); + OnLog(S, Error, FirstLine); +end; + +function CustomMessage(const MsgName: String): String; +begin + if not GetCustomMessageValue(MsgName, Result) then + InternalError(Format('Unknown custom message name "%s"', [MsgName])); +end; + +{ ExtractRelativePath is not in Delphi 2's SysUtils. Use the one from Delphi 7.01. } +function NewExtractRelativePath(BaseName, DestName: string): string; +var + BasePath, DestPath: string; + BaseLead, DestLead: PChar; + BasePtr, DestPtr: PChar; + + function ExtractFilePathNoDrive(const FileName: string): string; + begin + Result := PathExtractPath(FileName); + Delete(Result, 1, Length(PathExtractDrive(FileName))); + end; + + function Next(var Lead: PChar): PChar; + begin + Result := Lead; + if Result = nil then Exit; + Lead := PathStrScan(Lead, '\'); + if Lead <> nil then + begin + Lead^ := #0; + Inc(Lead); + end; + end; + +begin + { For consistency with the PathExtract* functions, normalize slashes so + that forward slashes and multiple slashes work with this function also } + BaseName := PathNormalizeSlashes(BaseName); + DestName := PathNormalizeSlashes(DestName); + + if PathCompare(PathExtractDrive(BaseName), PathExtractDrive(DestName)) = 0 then + begin + BasePath := ExtractFilePathNoDrive(BaseName); + UniqueString(BasePath); + DestPath := ExtractFilePathNoDrive(DestName); + UniqueString(DestPath); + BaseLead := Pointer(BasePath); + BasePtr := Next(BaseLead); + DestLead := Pointer(DestPath); + DestPtr := Next(DestLead); + while (BasePtr <> nil) and (DestPtr <> nil) and (PathCompare(BasePtr, DestPtr) = 0) do + begin + BasePtr := Next(BaseLead); + DestPtr := Next(DestLead); + end; + Result := ''; + while BaseLead <> nil do + begin + Result := Result + '..\'; { Do not localize } + Next(BaseLead); + end; + if (DestPtr <> nil) and (DestPtr^ <> #0) then + Result := Result + DestPtr + '\'; + if DestLead <> nil then + Result := Result + DestLead; // destlead already has a trailing backslash + Result := Result + PathExtractName(DestName); + end + else + Result := DestName; +end; + +{ Use our own FileSearch function which includes these improvements over + Delphi's version: + - it supports MBCS and uses Path* functions + - it uses NewFileExistsRedir instead of FileExists + - it doesn't search the current directory unless it's told to + - it always returns a fully-qualified path } +function NewFileSearch(const DisableFsRedir: Boolean; + const Name, DirList: String): String; +var + I, P, L: Integer; +begin + { If Name is absolute, drive-relative, or root-relative, don't search DirList } + if PathDrivePartLengthEx(Name, True) <> 0 then begin + Result := PathExpand(Name); + if NewFileExistsRedir(DisableFsRedir, Result) then + Exit; + end + else begin + P := 1; + L := Length(DirList); + while True do begin + while (P <= L) and (DirList[P] = ';') do + Inc(P); + if P > L then + Break; + I := P; + while (P <= L) and (DirList[P] <> ';') do + Inc(P, PathCharLength(DirList, P)); + Result := PathExpand(PathCombine(Copy(DirList, I, P - I), Name)); + if NewFileExistsRedir(DisableFsRedir, Result) then + Exit; + end; + end; + Result := ''; +end; + +function GetExceptionMessage(const Caller: TPSExec): String; +var + Code: TPSError; + E: TObject; +begin + Code := Caller.LastEx; + if Code = erNoError then + Result := '(There is no current exception)' + else begin + E := Caller.LastExObject; + if Assigned(E) and (E is Exception) then + Result := Exception(E).Message + else + Result := String(PSErrorToString(Code, Caller.LastExParam)); + end; +end; + +function GetCodePreviousData(const ExpandedAppID, ValueName, DefaultValueData: String): String; +begin + { do not localize or change the following string } + Result := GetPreviousData(ExpandedAppId, 'Inno Setup CodeFile: ' + ValueName, DefaultValueData); +end; + +{ Also see RegisterUninstallInfo in Install.pas } +function SetCodePreviousData(const PreviousDataKey: HKEY; const ValueName, ValueData: String): Boolean; +begin + if ValueData <> '' then begin + { do not localize or change the following string } + Result := RegSetValueEx(PreviousDataKey, PChar('Inno Setup CodeFile: ' + ValueName), 0, REG_SZ, PChar(ValueData), (Length(ValueData)+1)*SizeOf(ValueData[1])) = ERROR_SUCCESS + end else + Result := True; +end; + +function LoadStringFromFile(const FileName: String; var S: AnsiString; + const Sharing: TFileSharing): Boolean; +var + F: TFile; + N: Cardinal; +begin + try + F := TFileRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenExisting, faRead, Sharing); + try + N := F.CappedSize; + SetLength(S, N); + F.ReadBuffer(S[1], N); + finally + F.Free; + end; + + Result := True; + except + Result := False; + end; +end; + +function LoadStringsFromFile(const FileName: String; const Stack: TPSStack; + const ItemNo: Longint; const Sharing: TFileSharing): Boolean; +var + F: TTextFileReader; +begin + try + F := TTextFileReaderRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenExisting, faRead, Sharing); + try + var ArrayBuilder := Stack.InitArrayBuilder(ItemNo); + while not F.Eof do + ArrayBuilder.Add(F.ReadLine); + finally + F.Free; + end; + + Result := True; + except + Result := False; + end; +end; + +function SaveStringToFile(const FileName: String; const S: AnsiString; Append: Boolean): Boolean; +var + F: TFile; +begin + try + if Append then + F := TFileRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenAlways, faWrite, fsNone) + else + F := TFileRedir.Create(ScriptFuncDisableFsRedir, FileName, fdCreateAlways, faWrite, fsNone); + try + F.SeekToEnd; + F.WriteAnsiString(S); + finally + F.Free; + end; + + Result := True; + except + Result := False; + end; +end; + +function SaveStringsToFile(const FileName: String; const Stack: TPSStack; + const ItemNo: Longint; Append, UTF8, UTF8WithoutBOM: Boolean): Boolean; +var + F: TTextFileWriter; +begin + try + if Append then + F := TTextFileWriterRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenAlways, faWrite, fsNone) + else + F := TTextFileWriterRedir.Create(ScriptFuncDisableFsRedir, FileName, fdCreateAlways, faWrite, fsNone); + try + if UTF8 and UTF8WithoutBOM then + F.UTF8WithoutBOM := UTF8WithoutBOM; + var ArrayEnumerator := Stack.InitArrayEnumerator(ItemNo); + while ArrayEnumerator.HasNext do begin + var S := ArrayEnumerator.Next; + if not UTF8 then + F.WriteAnsiLine(AnsiString(S)) + else + F.WriteLine(S); + end; + finally + F.Free; + end; + + Result := True; + except + Result := False; + end; +end; + +var + ASMInliners: array of Pointer; + +function CreateCallback(const Caller: TPSExec; const P: PPSVariantProcPtr): LongWord; +var + ProcRec: TPSInternalProcRec; + Method: TMethod; + Inliner: TASMInline; + ParamCount, SwapFirst, SwapLast: Integer; + S: tbtstring; +begin + { ProcNo 0 means nil was passed by the script } + if P.ProcNo = 0 then + InternalError('Invalid Method value'); + + { Calculate parameter count of our proc, will need this later. } + ProcRec := Caller.GetProcNo(P.ProcNo) as TPSInternalProcRec; + S := ProcRec.ExportDecl; + GRFW(S); + ParamCount := 0; + while S <> '' do begin + Inc(ParamCount); + GRFW(S); + end; + + { Turn our proc into a callable TMethod - its Code will point to + ROPS' MyAllMethodsHandler and its Data to a record identifying our proc. + When called, MyAllMethodsHandler will use the record to call our proc. } + Method := MkMethod(Caller, P.ProcNo); + + { Wrap our TMethod with a dynamically generated stdcall callback which will + do two things: + -Remember the Data pointer which MyAllMethodsHandler needs. + -Handle the calling convention mismatch. + + Based on InnoCallback by Sherlock Software, see + http://www.sherlocksoftware.org/page.php?id=54 and + https://github.com/thenickdude/InnoCallback. } + Inliner := TASMInline.create; + try + Inliner.Pop(EAX); //get the retptr off the stack + + SwapFirst := 2; + SwapLast := ParamCount-1; + + //Reverse the order of parameters from param3 onwards in the stack + while SwapLast > SwapFirst do begin + Inliner.Mov(ECX, Inliner.Addr(ESP, SwapFirst * 4)); //load the first item of the pair + Inliner.Mov(EDX, Inliner.Addr(ESP, SwapLast * 4)); //load the last item of the pair + Inliner.Mov(Inliner.Addr(ESP, SwapFirst * 4), EDX); + Inliner.Mov(Inliner.Addr(ESP, SwapLast * 4), ECX); + Inc(SwapFirst); + Dec(SwapLast); + end; + + if ParamCount >= 1 then + Inliner.Pop(EDX); //load param1 + if ParamCount >= 2 then + Inliner.Pop(ECX); //load param2 + + Inliner.Push(EAX); //put the retptr back onto the stack + + Inliner.Mov(EAX, LongWord(Method.Data)); //Load the self ptr + + Inliner.Jmp(Method.Code); //jump to the wrapped proc + + SetLength(ASMInliners, Length(ASMInliners) + 1); + ASMInliners[High(ASMInliners)] := Inliner.SaveAsMemory; + Result := LongWord(ASMInliners[High(ASMInliners)]); + finally + Inliner.Free; + end; +end; + +procedure FreeASMInliners; +var + I: Integer; +begin + for I := 0 to High(ASMInliners) do + FreeMem(ASMInliners[I]); + SetLength(ASMInliners, 0); +end; + +initialization +finalization + FreeASMInliners; +end. diff --git a/Projects/Src/Setup.ScriptFunc.pas b/Projects/Src/Setup.ScriptFunc.pas index cfe80e226..83a8ef505 100644 --- a/Projects/Src/Setup.ScriptFunc.pas +++ b/Projects/Src/Setup.ScriptFunc.pas @@ -19,787 +19,31 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); implementation uses - Windows, Shared.ScriptFunc, - Forms, uPSUtils, SysUtils, Classes, Graphics, Controls, TypInfo, ActiveX, Generics.Collections, - PathFunc, BrowseFunc, MD5, SHA1, SHA256, ASMInline, BitmapImage, - Shared.Struct, Setup.ScriptDlg, Setup.MainForm, Setup.MainFunc, Shared.CommonFunc.Vcl, + Windows, + Forms, SysUtils, Classes, Graphics, ActiveX, Generics.Collections, + uPSUtils, PathFunc, BrowseFunc, MD5, SHA1, SHA256, BitmapImage, PSStackHelper, + Shared.Struct, Setup.ScriptDlg, Setup.MainFunc, Shared.CommonFunc.Vcl, Shared.CommonFunc, Shared.FileClass, SetupLdrAndSetup.RedirFunc, Setup.Install, SetupLdrAndSetup.InstFunc, Setup.InstFunc, Setup.InstFunc.Ole, SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.NewDiskForm, - Setup.WizardForm, Shared.VerInfoFunc, Shared.SetupTypes, Shared.SetupSteps, + Setup.WizardForm, Shared.VerInfoFunc, Shared.SetupTypes, Shared.Int64Em, Setup.LoggingFunc, Setup.SetupForm, Setup.RegDLL, Setup.Helper, - Setup.SpawnClient, Setup.UninstallProgressForm, Setup.DotNetFunc, + Setup.SpawnClient, Setup.DotNetFunc, Shared.DotNetVersion, Setup.MsiFunc, Compression.SevenZipDecoder, - Setup.DebugClient; - -type - TPSStackHelper = class helper for TPSStack - private - function GetArray(const ItemNo, FieldNo: Longint; out N: Integer): TPSVariantIFC; - function SetArray(const ItemNo, FieldNo: Longint; const N: Integer): TPSVariantIFC; overload; - public - type - TArrayOfInteger = array of Integer; - TArrayOfString = array of String; - TArrayBuilder = record - Arr: TPSVariantIFC; - I: Integer; - procedure Add(const Data: String); - end; - TArrayEnumerator = record - Arr: TPSVariantIFC; - N, I: Integer; - function HasNext: Boolean; - function Next: String; - end; - function GetIntArray(const ItemNo: Longint; const FieldNo: Longint = -1): TArrayOfInteger; - function GetProc(const ItemNo: Longint; const Exec: TPSExec): TMethod; - function GetStringArray(const ItemNo: Longint; const FieldNo: Longint = -1): TArrayOfString; - function InitArrayBuilder(const ItemNo: LongInt; const FieldNo: Longint = -1): TArrayBuilder; - function InitArrayEnumerator(const ItemNo: LongInt; const FieldNo: Longint = -1): TArrayEnumerator; - procedure SetArray(const ItemNo: Longint; const Data: TArray; const FieldNo: Longint = -1); overload; - procedure SetArray(const ItemNo: Longint; const Data: TStrings; const FieldNo: Longint = -1); overload; - procedure SetInt(const ItemNo: Longint; const Data: Integer; const FieldNo: Longint = -1); - end; - -function TPSStackHelper.GetArray(const ItemNo, FieldNo: Longint; - out N: Integer): TPSVariantIFC; -begin - if FieldNo >= 0 then - Result := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo) - else - Result := NewTPSVariantIFC(Items[ItemNo], True); - N := PSDynArrayGetLength(Pointer(Result.Dta^), Result.aType); -end; - -function TPSStackHelper.SetArray(const ItemNo, FieldNo: Longint; - const N: Integer): TPSVariantIFC; -begin - if FieldNo >= 0 then - Result := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo) - else - Result := NewTPSVariantIFC(Items[ItemNo], True); - PSDynArraySetLength(Pointer(Result.Dta^), Result.aType, N); -end; - -function TPSStackHelper.GetIntArray(const ItemNo, FieldNo: Longint): TArrayOfInteger; -begin - var N: Integer; - var Arr := GetArray(ItemNo, FieldNo, N); - SetLength(Result, N); - for var I := 0 to N-1 do - Result[I] := VNGetInt(PSGetArrayField(Arr, I)); -end; - -function TPSStackHelper.GetProc(const ItemNo: Longint; const Exec: TPSExec): TMethod; -begin - var P := PPSVariantProcPtr(Items[ItemNo]); - { ProcNo 0 means nil was passed by the script and GetProcAsMethod will then return a (nil, nil) TMethod } - Result := Exec.GetProcAsMethod(P.ProcNo); -end; - -function TPSStackHelper.GetStringArray(const ItemNo, FieldNo: Longint): TArrayOfString; -begin - var N: Integer; - var Arr := GetArray(ItemNo, FieldNo, N); - SetLength(Result, N); - for var I := 0 to N-1 do - Result[I] := VNGetString(PSGetArrayField(Arr, I)); -end; - -function TPSStackHelper.InitArrayBuilder(const ItemNo, FieldNo: Longint): TArrayBuilder; -begin - Result.Arr := SetArray(ItemNo, FieldNo, 0); - Result.I := 0; -end; - -procedure TPSStackHelper.TArrayBuilder.Add(const Data: String); -begin - PSDynArraySetLength(Pointer(Arr.Dta^), Arr.aType, I+1); - VNSetString(PSGetArrayField(Arr, I), Data); - Inc(I); -end; - -function TPSStackHelper.InitArrayEnumerator(const ItemNo, FieldNo: Longint): TArrayEnumerator; -begin - Result.Arr := GetArray(ItemNo, FieldNo, Result.N); - Result.I := 0; -end; - -function TPSStackHelper.TArrayEnumerator.HasNext: Boolean; -begin - Result := I < N; -end; - -function TPSStackHelper.TArrayEnumerator.Next: String; -begin - Result := VNGetString(PSGetArrayField(Arr, I)); - Inc(I); -end; - -procedure TPSStackHelper.SetArray(const ItemNo: Longint; const Data: TArray; const FieldNo: Longint); -begin - var N := System.Length(Data); - var Arr := SetArray(ItemNo, FieldNo, N); - for var I := 0 to N-1 do - VNSetString(PSGetArrayField(Arr, I), Data[I]); -end; - -procedure TPSStackHelper.SetArray(const ItemNo: Longint; const Data: TStrings; const FieldNo: Longint); -begin - var N := Data.Count; - var Arr := SetArray(ItemNo, FieldNo, N); - for var I := 0 to N-1 do - VNSetString(PSGetArrayField(Arr, I), Data[I]); -end; - -procedure TPSStackHelper.SetInt(const ItemNo: Longint; const Data: Integer; - const FieldNo: Longint); -begin - if FieldNo = -1 then - inherited SetInt(ItemNo, Data) - else begin - var PSVariantIFC := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo); - VNSetInt(PSVariantIFC, Data); - end; -end; - -{---} - -procedure NoUninstallFuncError(const C: AnsiString); overload; -begin - InternalError(Format('Cannot call "%s" function during Uninstall', [C])); -end; - -function GetMainForm: TMainForm; -begin - Result := MainForm; - if Result = nil then - InternalError('An attempt was made to access MainForm before it has been created'); -end; - -function GetWizardForm: TWizardForm; -begin - Result := WizardForm; - if Result = nil then - InternalError('An attempt was made to access WizardForm before it has been created'); -end; - -function GetUninstallProgressForm: TUninstallProgressForm; -begin - Result := UninstallProgressForm; - if Result = nil then - InternalError('An attempt was made to access UninstallProgressForm before it has been created'); -end; - -function GetMsgBoxCaption: String; -var - ID: TSetupMessageID; -begin - if IsUninstaller then - ID := msgUninstallAppTitle - else - ID := msgSetupAppTitle; - Result := SetupMessages[ID]; -end; - -var - ScaleBaseUnitsInitialized: Boolean; - ScaleBaseUnitX, ScaleBaseUnitY: Integer; - -procedure InitializeScaleBaseUnits; -var - Font: TFont; -begin - if ScaleBaseUnitsInitialized then - Exit; - Font := TFont.Create; - try - SetFontNameSize(Font, LangOptions.DialogFontName, LangOptions.DialogFontSize, - '', 8); - CalculateBaseUnitsFromFont(Font, ScaleBaseUnitX, ScaleBaseUnitY); - finally - Font.Free; - end; - ScaleBaseUnitsInitialized := True; -end; - -function IsProtectedSrcExe(const Filename: String): Boolean; -begin - if (MainForm = nil) or (MainForm.CurStep < ssInstall) then begin - var ExpandedFilename := PathExpand(Filename); - Result := PathCompare(ExpandedFilename, SetupLdrOriginalFilename) = 0; - end else - Result := False; -end; - -type - { *Must* keep this in synch with ScriptFunc_C } - TFindRec = record - Name: String; - Attributes: LongWord; - SizeHigh: LongWord; - SizeLow: LongWord; - CreationTime: TFileTime; - LastAccessTime: TFileTime; - LastWriteTime: TFileTime; - AlternateName: String; - FindHandle: THandle; - end; - -procedure FindDataToFindRec(const FindData: TWin32FindData; - var FindRec: TFindRec); -begin - FindRec.Name := FindData.cFileName; - FindRec.Attributes := FindData.dwFileAttributes; - FindRec.SizeHigh := FindData.nFileSizeHigh; - FindRec.SizeLow := FindData.nFileSizeLow; - FindRec.CreationTime := FindData.ftCreationTime; - FindRec.LastAccessTime := FindData.ftLastAccessTime; - FindRec.LastWriteTime := FindData.ftLastWriteTime; - FindRec.AlternateName := FindData.cAlternateFileName; -end; - -function _FindFirst(const FileName: String; var FindRec: TFindRec): Boolean; -var - FindHandle: THandle; - FindData: TWin32FindData; -begin - FindHandle := FindFirstFileRedir(ScriptFuncDisableFsRedir, FileName, FindData); - if FindHandle <> INVALID_HANDLE_VALUE then begin - FindRec.FindHandle := FindHandle; - FindDataToFindRec(FindData, FindRec); - Result := True; - end - else begin - FindRec.FindHandle := 0; - Result := False; - end; -end; - -function _FindNext(var FindRec: TFindRec): Boolean; -var - FindData: TWin32FindData; -begin - Result := (FindRec.FindHandle <> 0) and FindNextFile(FindRec.FindHandle, FindData); - if Result then - FindDataToFindRec(FindData, FindRec); -end; - -procedure _FindClose(var FindRec: TFindRec); -begin - if FindRec.FindHandle <> 0 then begin - Windows.FindClose(FindRec.FindHandle); - FindRec.FindHandle := 0; - end; -end; - -function _FmtMessage(const S: String; const Args: array of String): String; -begin - Result := FmtMessage(PChar(S), Args); -end; - -type - { *Must* keep this in synch with Compiler.ScriptFunc.pas } - TWindowsVersion = packed record - Major: Cardinal; - Minor: Cardinal; - Build: Cardinal; - ServicePackMajor: Cardinal; - ServicePackMinor: Cardinal; - NTPlatform: Boolean; - ProductType: Byte; - SuiteMask: Word; - end; - -procedure _GetWindowsVersionEx(var Version: TWindowsVersion); -begin - Version.Major := WindowsVersion shr 24; - Version.Minor := (WindowsVersion shr 16) and $FF; - Version.Build := WindowsVersion and $FFFF; - Version.ServicePackMajor := Hi(NTServicePackLevel); - Version.ServicePackMinor := Lo(NTServicePackLevel); - Version.NTPlatform := True; - Version.ProductType := WindowsProductType; - Version.SuiteMask := WindowsSuiteMask; -end; - -procedure CrackCodeRootKey(CodeRootKey: HKEY; var RegView: TRegView; - var RootKey: HKEY); -begin - if (CodeRootKey and not CodeRootKeyValidFlags) = HKEY_AUTO then begin - { Change HKA to HKLM or HKCU, keeping our special flag bits. } - CodeRootKey := (CodeRootKey and CodeRootKeyValidFlags) or InstallModeRootKey; - end else begin - { Allow only predefined key handles (8xxxxxxx). Can't accept handles to - open keys because they might have our special flag bits set. - Also reject unknown flags which may have a meaning in the future. } - if (CodeRootKey shr 31 <> 1) or - ((CodeRootKey and CodeRootKeyFlagMask) and not CodeRootKeyValidFlags <> 0) then - InternalError('Invalid RootKey value'); - end; - - if CodeRootKey and CodeRootKeyFlag32Bit <> 0 then - RegView := rv32Bit - else if CodeRootKey and CodeRootKeyFlag64Bit <> 0 then begin - if not IsWin64 then - InternalError('Cannot access 64-bit registry keys on this version of Windows'); - RegView := rv64Bit; - end - else - RegView := InstallDefaultRegView; - RootKey := CodeRootKey and not CodeRootKeyFlagMask; -end; - -function GetSubkeyOrValueNames(const RegView: TRegView; const RootKey: HKEY; - const SubKeyName: String; const Stack: TPSStack; const ItemNo: Longint; const Subkey: Boolean): Boolean; -const - samDesired: array [Boolean] of REGSAM = (KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS); -var - K: HKEY; - Buf, S: String; - BufSize, R: DWORD; -begin - Result := False; - SetString(Buf, nil, 512); - if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, samDesired[Subkey], K) <> ERROR_SUCCESS then - Exit; - try - var ArrayBuilder := Stack.InitArrayBuilder(ItemNo); - while True do begin - BufSize := Length(Buf); - if Subkey then - R := RegEnumKeyEx(K, ArrayBuilder.I, @Buf[1], BufSize, nil, nil, nil, nil) - else - R := RegEnumValue(K, ArrayBuilder.I, @Buf[1], BufSize, nil, nil, nil, nil); - case R of - ERROR_SUCCESS: ; - ERROR_NO_MORE_ITEMS: Break; - ERROR_MORE_DATA: - begin - { Double the size of the buffer and try again } - if Length(Buf) >= 65536 then begin - { Sanity check: If we tried a 64 KB buffer and it's still saying - there's more data, something must be seriously wrong. Bail. } - Exit; - end; - SetString(Buf, nil, Length(Buf) * 2); - Continue; - end; - else - Exit; { unknown failure... } - end; - SetString(S, PChar(@Buf[1]), BufSize); - ArrayBuilder.Add(S); - end; - finally - RegCloseKey(K); - end; - Result := True; -end; - -function GetMD5OfFile(const DisableFsRedir: Boolean; const Filename: String): TMD5Digest; -{ Gets MD5 sum of the file Filename. An exception will be raised upon - failure. } -var - Buf: array[0..65535] of Byte; -begin - var Context: TMD5Context; - MD5Init(Context); - var F := TFileRedir.Create(DisableFsRedir, Filename, fdOpenExisting, faRead, fsReadWrite); - try - while True do begin - var NumRead := F.Read(Buf, SizeOf(Buf)); - if NumRead = 0 then - Break; - MD5Update(Context, Buf, NumRead); - end; - finally - F.Free; - end; - Result := MD5Final(Context); -end; - -function GetSHA1OfFile(const DisableFsRedir: Boolean; const Filename: String): TSHA1Digest; -{ Gets SHA-1 sum of the file Filename. An exception will be raised upon - failure. } -var - Buf: array[0..65535] of Byte; -begin - var Context: TSHA1Context; - SHA1Init(Context); - var F := TFileRedir.Create(DisableFsRedir, Filename, fdOpenExisting, faRead, fsReadWrite); - try - while True do begin - var NumRead := F.Read(Buf, SizeOf(Buf)); - if NumRead = 0 then - Break; - SHA1Update(Context, Buf, NumRead); - end; - finally - F.Free; - end; - Result := SHA1Final(Context); -end; - -function GetMD5OfAnsiString(const S: AnsiString): TMD5Digest; -begin - Result := MD5Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); -end; - -function GetMD5OfUnicodeString(const S: UnicodeString): TMD5Digest; -begin - Result := MD5Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); -end; - -function GetSHA1OfAnsiString(const S: AnsiString): TSHA1Digest; -begin - Result := SHA1Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); -end; - -function GetSHA1OfUnicodeString(const S: UnicodeString): TSHA1Digest; -begin - Result := SHA1Buf(Pointer(S)^, Length(S)*SizeOf(S[1])); -end; - -procedure ProcessMessagesProc; far; -begin - Application.ProcessMessages; -end; - -procedure ExecAndLogOutputLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt); -begin - Log(S); -end; - -type - { These must keep this in synch with Compiler.ScriptFunc.pas } - TOnLog = procedure(const S: String; const Error, FirstLine: Boolean) of object; - -procedure ExecAndLogOutputLogCustom(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt); -begin - var OnLog := TOnLog(PMethod(Data)^); - OnLog(S, Error, FirstLine); -end; - -function CustomMessage(const MsgName: String): String; -begin - if not GetCustomMessageValue(MsgName, Result) then - InternalError(Format('Unknown custom message name "%s"', [MsgName])); -end; - -{ ExtractRelativePath is not in Delphi 2's SysUtils. Use the one from Delphi 7.01. } -function NewExtractRelativePath(BaseName, DestName: string): string; -var - BasePath, DestPath: string; - BaseLead, DestLead: PChar; - BasePtr, DestPtr: PChar; - - function ExtractFilePathNoDrive(const FileName: string): string; - begin - Result := PathExtractPath(FileName); - Delete(Result, 1, Length(PathExtractDrive(FileName))); - end; - - function Next(var Lead: PChar): PChar; - begin - Result := Lead; - if Result = nil then Exit; - Lead := PathStrScan(Lead, '\'); - if Lead <> nil then - begin - Lead^ := #0; - Inc(Lead); - end; - end; - -begin - { For consistency with the PathExtract* functions, normalize slashes so - that forward slashes and multiple slashes work with this function also } - BaseName := PathNormalizeSlashes(BaseName); - DestName := PathNormalizeSlashes(DestName); - - if PathCompare(PathExtractDrive(BaseName), PathExtractDrive(DestName)) = 0 then - begin - BasePath := ExtractFilePathNoDrive(BaseName); - UniqueString(BasePath); - DestPath := ExtractFilePathNoDrive(DestName); - UniqueString(DestPath); - BaseLead := Pointer(BasePath); - BasePtr := Next(BaseLead); - DestLead := Pointer(DestPath); - DestPtr := Next(DestLead); - while (BasePtr <> nil) and (DestPtr <> nil) and (PathCompare(BasePtr, DestPtr) = 0) do - begin - BasePtr := Next(BaseLead); - DestPtr := Next(DestLead); - end; - Result := ''; - while BaseLead <> nil do - begin - Result := Result + '..\'; { Do not localize } - Next(BaseLead); - end; - if (DestPtr <> nil) and (DestPtr^ <> #0) then - Result := Result + DestPtr + '\'; - if DestLead <> nil then - Result := Result + DestLead; // destlead already has a trailing backslash - Result := Result + PathExtractName(DestName); - end - else - Result := DestName; -end; - -{ Use our own FileSearch function which includes these improvements over - Delphi's version: - - it supports MBCS and uses Path* functions - - it uses NewFileExistsRedir instead of FileExists - - it doesn't search the current directory unless it's told to - - it always returns a fully-qualified path } -function NewFileSearch(const DisableFsRedir: Boolean; - const Name, DirList: String): String; -var - I, P, L: Integer; -begin - { If Name is absolute, drive-relative, or root-relative, don't search DirList } - if PathDrivePartLengthEx(Name, True) <> 0 then begin - Result := PathExpand(Name); - if NewFileExistsRedir(DisableFsRedir, Result) then - Exit; - end - else begin - P := 1; - L := Length(DirList); - while True do begin - while (P <= L) and (DirList[P] = ';') do - Inc(P); - if P > L then - Break; - I := P; - while (P <= L) and (DirList[P] <> ';') do - Inc(P, PathCharLength(DirList, P)); - Result := PathExpand(PathCombine(Copy(DirList, I, P - I), Name)); - if NewFileExistsRedir(DisableFsRedir, Result) then - Exit; - end; - end; - Result := ''; -end; - -function GetExceptionMessage(const Caller: TPSExec): String; -var - Code: TPSError; - E: TObject; -begin - Code := Caller.LastEx; - if Code = erNoError then - Result := '(There is no current exception)' - else begin - E := Caller.LastExObject; - if Assigned(E) and (E is Exception) then - Result := Exception(E).Message - else - Result := String(PSErrorToString(Code, Caller.LastExParam)); - end; -end; - -function GetCodePreviousData(const ExpandedAppID, ValueName, DefaultValueData: String): String; -begin - { do not localize or change the following string } - Result := GetPreviousData(ExpandedAppId, 'Inno Setup CodeFile: ' + ValueName, DefaultValueData); -end; - -{ Also see RegisterUninstallInfo in Install.pas } -function SetCodePreviousData(const PreviousDataKey: HKEY; const ValueName, ValueData: String): Boolean; -begin - if ValueData <> '' then begin - { do not localize or change the following string } - Result := RegSetValueEx(PreviousDataKey, PChar('Inno Setup CodeFile: ' + ValueName), 0, REG_SZ, PChar(ValueData), (Length(ValueData)+1)*SizeOf(ValueData[1])) = ERROR_SUCCESS - end else - Result := True; -end; - -function LoadStringFromFile(const FileName: String; var S: AnsiString; - const Sharing: TFileSharing): Boolean; -var - F: TFile; - N: Cardinal; -begin - try - F := TFileRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenExisting, faRead, Sharing); - try - N := F.CappedSize; - SetLength(S, N); - F.ReadBuffer(S[1], N); - finally - F.Free; - end; - - Result := True; - except - Result := False; - end; -end; - -function LoadStringsFromFile(const FileName: String; const Stack: TPSStack; - const ItemNo: Longint; const Sharing: TFileSharing): Boolean; -var - F: TTextFileReader; -begin - try - F := TTextFileReaderRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenExisting, faRead, Sharing); - try - var ArrayBuilder := Stack.InitArrayBuilder(ItemNo); - while not F.Eof do - ArrayBuilder.Add(F.ReadLine); - finally - F.Free; - end; - - Result := True; - except - Result := False; - end; -end; - -function SaveStringToFile(const FileName: String; const S: AnsiString; Append: Boolean): Boolean; -var - F: TFile; -begin - try - if Append then - F := TFileRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenAlways, faWrite, fsNone) - else - F := TFileRedir.Create(ScriptFuncDisableFsRedir, FileName, fdCreateAlways, faWrite, fsNone); - try - F.SeekToEnd; - F.WriteAnsiString(S); - finally - F.Free; - end; - - Result := True; - except - Result := False; - end; -end; - -function SaveStringsToFile(const FileName: String; const Stack: TPSStack; - const ItemNo: Longint; Append, UTF8, UTF8WithoutBOM: Boolean): Boolean; -var - F: TTextFileWriter; -begin - try - if Append then - F := TTextFileWriterRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenAlways, faWrite, fsNone) - else - F := TTextFileWriterRedir.Create(ScriptFuncDisableFsRedir, FileName, fdCreateAlways, faWrite, fsNone); - try - if UTF8 and UTF8WithoutBOM then - F.UTF8WithoutBOM := UTF8WithoutBOM; - var ArrayEnumerator := Stack.InitArrayEnumerator(ItemNo); - while ArrayEnumerator.HasNext do begin - var S := ArrayEnumerator.Next; - if not UTF8 then - F.WriteAnsiLine(AnsiString(S)) - else - F.WriteLine(S); - end; - finally - F.Free; - end; - - Result := True; - except - Result := False; - end; -end; - -var - ASMInliners: array of Pointer; - -function CreateCallback(const Caller: TPSExec; const P: PPSVariantProcPtr): LongWord; -var - ProcRec: TPSInternalProcRec; - Method: TMethod; - Inliner: TASMInline; - ParamCount, SwapFirst, SwapLast: Integer; - S: tbtstring; -begin - { ProcNo 0 means nil was passed by the script } - if P.ProcNo = 0 then - InternalError('Invalid Method value'); - - { Calculate parameter count of our proc, will need this later. } - ProcRec := Caller.GetProcNo(P.ProcNo) as TPSInternalProcRec; - S := ProcRec.ExportDecl; - GRFW(S); - ParamCount := 0; - while S <> '' do begin - Inc(ParamCount); - GRFW(S); - end; - - { Turn our proc into a callable TMethod - its Code will point to - ROPS' MyAllMethodsHandler and its Data to a record identifying our proc. - When called, MyAllMethodsHandler will use the record to call our proc. } - Method := MkMethod(Caller, P.ProcNo); - - { Wrap our TMethod with a dynamically generated stdcall callback which will - do two things: - -Remember the Data pointer which MyAllMethodsHandler needs. - -Handle the calling convention mismatch. - - Based on InnoCallback by Sherlock Software, see - http://www.sherlocksoftware.org/page.php?id=54 and - https://github.com/thenickdude/InnoCallback. } - Inliner := TASMInline.create; - try - Inliner.Pop(EAX); //get the retptr off the stack - - SwapFirst := 2; - SwapLast := ParamCount-1; - - //Reverse the order of parameters from param3 onwards in the stack - while SwapLast > SwapFirst do begin - Inliner.Mov(ECX, Inliner.Addr(ESP, SwapFirst * 4)); //load the first item of the pair - Inliner.Mov(EDX, Inliner.Addr(ESP, SwapLast * 4)); //load the last item of the pair - Inliner.Mov(Inliner.Addr(ESP, SwapFirst * 4), EDX); - Inliner.Mov(Inliner.Addr(ESP, SwapLast * 4), ECX); - Inc(SwapFirst); - Dec(SwapLast); - end; - - if ParamCount >= 1 then - Inliner.Pop(EDX); //load param1 - if ParamCount >= 2 then - Inliner.Pop(ECX); //load param2 - - Inliner.Push(EAX); //put the retptr back onto the stack - - Inliner.Mov(EAX, LongWord(Method.Data)); //Load the self ptr - - Inliner.Jmp(Method.Code); //jump to the wrapped proc - - SetLength(ASMInliners, Length(ASMInliners) + 1); - ASMInliners[High(ASMInliners)] := Inliner.SaveAsMemory; - Result := LongWord(ASMInliners[High(ASMInliners)]); - finally - Inliner.Free; - end; -end; - -{---} + Setup.DebugClient, Shared.ScriptFunc, Setup.ScriptFunc.HelperFunc; type TScriptFunc = reference to procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal); + TScriptFuncTyp = (sfNormal, sfNoUninstall, sfOnlyUninstall); + TScriptFuncEx = record OrgName: AnsiString; ScriptFunc: TScriptFunc; Typ: TScriptFuncTyp; constructor Create(const AOrgName: AnsiString; const AScriptFunc: TScriptFunc; const ATyp: TScriptFuncTyp); end; + TScriptFuncs = TDictionary; var @@ -812,15 +56,16 @@ constructor TScriptFuncEx.Create(const AOrgName: AnsiString; const AScriptFunc: Typ := ATyp; end; +{ Called by ROPS } function ScriptFuncPSProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; begin var ScriptFuncEx: TScriptFuncEx; Result := ScriptFuncs.TryGetValue(Proc.Name, ScriptFuncEx); if Result then begin if (ScriptFuncEx.Typ = sfNoUninstall) and IsUninstaller then - NoUninstallFuncError(Proc.Name) + NoUninstallFuncError(ScriptFuncEx.OrgName) else if (ScriptFuncEx.Typ = sfOnlyUninstall) and not IsUninstaller then - InternalError(Format('Cannot call "%s" function during Setup', [ScriptFuncEx.OrgName])) + OnlyUninstallFuncError(ScriptFuncEx.OrgName) else ScriptFuncEx.ScriptFunc(Caller, Proc.Name, Stack, Stack.Count-1); end; @@ -842,6 +87,12 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); {$ENDIF} end; + procedure RegisterScriptFunc(const Names: array of AnsiString; const ScriptFuncTyp: TScriptFuncTyp; const ScriptFunc: TScriptFunc); overload; + begin + for var Name in Names do + RegisterScriptFunc(Name, ScriptFuncTyp, ScriptFunc); + end; + procedure RegisterScriptFunc(const Name: AnsiString; const ScriptFunc: TScriptFunc); overload; begin RegisterScriptFunc(Name, sfNormal, ScriptFunc); @@ -855,15 +106,15 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); procedure RegisterScriptDlgScriptFuncs; begin - RegisterScriptFunc('PageFromID', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('PAGEFROMID', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetClass(PStart, GetWizardForm.PageFromID(Stack.GetInt(PStart-1))); end); - RegisterScriptFunc('PageIndexFromID', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('PAGEINDEXFROMID', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, GetWizardForm.PageIndexFromID(Stack.GetInt(PStart-1))); end); - RegisterScriptFunc('CreateCustomPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATECUSTOMPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewPage := TWizardPage.Create(GetWizardForm); try @@ -876,7 +127,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewPage); end); - RegisterScriptFunc('CreateInputQueryPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATEINPUTQUERYPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewInputQueryPage := TInputQueryWizardPage.Create(GetWizardForm); try @@ -890,7 +141,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewInputQueryPage); end); - RegisterScriptFunc('CreateInputOptionPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATEINPUTOPTIONPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewInputOptionPage := TInputOptionWizardPage.Create(GetWizardForm); try @@ -1179,7 +430,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('GETCMDTAIL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - Stack.SetString(PStart, GetCmdTail()); + Stack.SetString(PStart, GetCmdTail); end); RegisterScriptFunc('PARAMCOUNT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -1221,15 +472,15 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('GETWINDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - Stack.SetString(PStart, GetWinDir()); + Stack.SetString(PStart, GetWinDir); end); RegisterScriptFunc('GETSYSTEMDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - Stack.SetString(PStart, GetSystemDir()); + Stack.SetString(PStart, GetSystemDir); end); RegisterScriptFunc('GETSYSWOW64DIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - Stack.SetString(PStart, GetSysWow64Dir()); + Stack.SetString(PStart, GetSysWow64Dir); end); RegisterScriptFunc('GETSYSNATIVEDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -1237,7 +488,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('GETTEMPDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - Stack.SetString(PStart, GetTempDir()); + Stack.SetString(PStart, GetTempDir); end); RegisterScriptFunc('STRINGCHANGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -1480,7 +731,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('ISPOWERUSERLOGGEDON', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - Stack.SetBool(PStart, IsPowerUserLoggedOn()); + Stack.SetBool(PStart, IsPowerUserLoggedOn); end); RegisterScriptFUnc('ISADMININSTALLMODE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -1520,40 +771,28 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); procedure RegisterInstallScriptFuncs; begin - RegisterScriptFunc('EXTRACTTEMPORARYFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXTRACTTEMPORARYFILE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); ExtractTemporaryFile(Stack.GetString(PStart)); end); - RegisterScriptFunc('EXTRACTTEMPORARYFILES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXTRACTTEMPORARYFILES', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); Stack.SetInt(PStart, ExtractTemporaryFiles(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('DOWNLOADTEMPORARYFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DOWNLOADTEMPORARYFILE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); Stack.SetInt64(PStart, DownloadTemporaryFile(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), TOnDownloadProgress(Stack.GetProc(PStart-4, Caller)))); end); - RegisterScriptFunc('SETDOWNLOADCREDENTIALS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SETDOWNLOADCREDENTIALS', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); SetDownloadCredentials(Stack.GetString(PStart),Stack.GetString(PStart-1)); end); - RegisterScriptFunc('DOWNLOADTEMPORARYFILESIZE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DOWNLOADTEMPORARYFILESIZE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); Stack.SetInt64(PStart, DownloadTemporaryFileSize(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('DOWNLOADTEMPORARYFILEDATE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DOWNLOADTEMPORARYFILEDATE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); Stack.SetString(PStart, DownloadTemporaryFileDate(Stack.GetString(PStart-1))); end); end; @@ -1593,7 +832,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('GETCOMPUTERNAMESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - Stack.SetString(PStart, GetComputerNameString()); + Stack.SetString(PStart, GetComputerNameString); end); RegisterScriptFunc('GETMD5OFFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -1660,7 +899,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('GETUSERNAMESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - Stack.SetString(PStart, GetUserNameString()); + Stack.SetString(PStart, GetUserNameString); end); RegisterScriptFunc('INCREMENTSHAREDCOUNT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -1675,6 +914,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); RegisterScriptFunc(['EXEC', 'EXECASORIGINALUSER', 'EXECANDLOGOUTPUT', 'EXECANDCAPTUREOUTPUT'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var RunAsOriginalUser := Name = 'EXECASORIGINALUSER'; + if IsUninstaller and RunAsOriginalUser then + NoUninstallFuncError(Name); var Method: TMethod; { Must stay alive until OutputReader is freed } var OutputReader: TCreateProcessOutputReader := nil; try @@ -1687,9 +928,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else if Name = 'EXECANDCAPTUREOUTPUT' then OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLog, 0, omCapture); var ExecWait := TExecWait(Stack.GetInt(PStart-5)); - if IsUninstaller and RunAsOriginalUser then - NoUninstallFuncError(Name) - else if (OutputReader <> nil) and (ExecWait <> ewWaitUntilTerminated) then + if (OutputReader <> nil) and (ExecWait <> ewWaitUntilTerminated) then InternalError(Format('Must call "%s" function with Wait = ewWaitUntilTerminated', [Name])); Filename := Stack.GetString(PStart-1); @@ -1725,7 +964,6 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); var RunAsOriginalUser := Name = 'SHELLEXECASORIGINALUSER'; if IsUninstaller and RunAsOriginalUser then NoUninstallFuncError(Name); - Filename := Stack.GetString(PStart-2); if not IsProtectedSrcExe(Filename) then begin { Disable windows so the user can't utilize our UI during the @@ -1841,7 +1079,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('EXITSETUPMSGBOX', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - Stack.SetBool(PStart, ExitSetupMsgBox()); + Stack.SetBool(PStart, ExitSetupMsgBox); end); RegisterScriptFunc('GETSHELLFOLDERBYCSIDL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -1925,11 +1163,9 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); begin Stack.SetClass(PStart, GetWizardForm); end); - RegisterScriptFunc(['WIZARDISCOMPONENTSELECTED', 'ISCOMPONENTSELECTED', 'WIZARDISTASKSELECTED', 'ISTASKSELECTED'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['WIZARDISCOMPONENTSELECTED', 'ISCOMPONENTSELECTED', 'WIZARDISTASKSELECTED', 'ISTASKSELECTED'], sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); - StringList := TStringList.Create(); + StringList := TStringList.Create; try Components := (Name = 'WIZARDISCOMPONENTSELECTED') or (Name = 'ISCOMPONENTSELECTED'); if Components then @@ -1943,7 +1179,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); else Stack.SetBool(PStart, ShouldProcessEntry(nil, StringList, '', S, '', '')); finally - StringList.Free(); + StringList.Free; end; end); end; @@ -2032,7 +1268,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('GETCURRENTDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - Stack.SetString(PStart, GetCurrentDir()); + Stack.SetString(PStart, GetCurrentDir); end); RegisterScriptFunc('SETCURRENTDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -2125,7 +1361,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); FormatSettings.DateSeparator := NewDateSeparator; if NewTimeSeparator <> #0 then FormatSettings.TimeSeparator := NewTimeSeparator; - Stack.SetString(PStart, FormatDateTime(Stack.GetString(PStart-1), Now())); + Stack.SetString(PStart, FormatDateTime(Stack.GetString(PStart-1), Now)); finally FormatSettings.TimeSeparator := OldTimeSeparator; FormatSettings.DateSeparator := OldDateSeparator; @@ -2284,7 +1520,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); if DllHandle <> 0 then Stack.SetInt(PStart-2, 0) else - Stack.SetInt(PStart-2, GetLastError()); + Stack.SetInt(PStart-2, GetLastError); Stack.SetInt(PStart, DllHandle); end); RegisterScriptFunc('CALLDLLPROC', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) @@ -2318,7 +1554,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); end; - procedure RegisterOle2ScriptFuncs; + procedure RegisterActiveXScriptFuncs; begin RegisterScriptFunc('COFREEUNUSEDLIBRARIES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -2344,32 +1580,24 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); begin RegisterScriptFunc('BRINGTOFRONTANDRESTORE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - Application.BringToFront(); - Application.Restore(); + Application.BringToFront; + Application.Restore; end); - RegisterScriptFunc('WIZARDDIRVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WIZARDDIRVALUE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.DirEdit.Text)); end); - RegisterScriptFunc('WIZARDGROUPVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WIZARDGROUPVALUE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.GroupEdit.Text)); end); - RegisterScriptFunc('WIZARDNOICONS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WIZARDNOICONS', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); Stack.SetBool(PStart, GetWizardForm.NoIconsCheck.Checked); end); - RegisterScriptFunc('WIZARDSETUPTYPE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WIZARDSETUPTYPE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); - TypeEntry := GetWizardForm.GetSetupType(); + TypeEntry := GetWizardForm.GetSetupType; if TypeEntry <> nil then begin if Stack.GetBool(PStart-1) then Stack.SetString(PStart, TypeEntry.Description) @@ -2379,11 +1607,9 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); else Stack.SetString(PStart, ''); end); - RegisterScriptFunc(['WIZARDSELECTEDCOMPONENTS', 'WIZARDSELECTEDTASKS'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['WIZARDSELECTEDCOMPONENTS', 'WIZARDSELECTEDTASKS'], sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); - StringList := TStringList.Create(); + StringList := TStringList.Create; try if Name = 'WIZARDSELECTEDCOMPONENTS' then GetWizardForm.GetSelectedComponents(StringList, Stack.GetBool(PStart-1), False) @@ -2391,14 +1617,12 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); GetWizardForm.GetSelectedTasks(StringList, Stack.GetBool(PStart-1), False, False); Stack.SetString(PStart, StringsToCommaString(StringList)); finally - StringList.Free(); + StringList.Free; end; end); - RegisterScriptFunc(['WIZARDSELECTCOMPONENTS', 'WIZARDSELECTTASKS'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['WIZARDSELECTCOMPONENTS', 'WIZARDSELECTTASKS'], sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); - StringList := TStringList.Create(); + StringList := TStringList.Create; try S := Stack.GetString(PStart); StringChange(S, '/', '\'); @@ -2408,13 +1632,11 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); else GetWizardForm.SelectTasks(StringList); finally - StringList.Free(); + StringList.Free; end; end); - RegisterScriptFunc('WIZARDSILENT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WIZARDSILENT', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); Stack.SetBool(PStart, InstallMode <> imNormal); end); RegisterScriptFunc('ISUNINSTALLER', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) @@ -2425,19 +1647,15 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); begin Stack.SetBool(PStart, UninstallSilent); end); - RegisterScriptFunc('CURRENTFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CURRENTFILENAME', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); if CheckOrInstallCurrentFilename <> '' then Stack.SetString(PStart, CheckOrInstallCurrentFilename) else InternalError('An attempt was made to call the "CurrentFilename" function from outside a "Check", "BeforeInstall" or "AfterInstall" event function belonging to a "[Files]" entry'); end); - RegisterScriptFunc('CURRENTSOURCEFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CURRENTSOURCEFILENAME', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if IsUninstaller then - NoUninstallFuncError(Name); if CheckOrInstallCurrentSourceFilename <> '' then Stack.SetString(PStart, CheckOrInstallCurrentSourceFilename) else @@ -2465,7 +1683,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('SHOWEXCEPTIONMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - TMainForm.ShowExceptionMsg(AddPeriod(GetExceptionMessage(Caller))); + GetMainForm.ShowExceptionMsg(AddPeriod(GetExceptionMessage(Caller))); end); RegisterScriptFunc('TERMINATED', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -2609,7 +1827,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); RegisterSysUtilsScriptFuncs; RegisterVerInfoFuncScriptFuncs; RegisterWindowsScriptFuncs; - RegisterOle2ScriptFuncs; + RegisterActiveXScriptFuncs; RegisterLoggingFuncScriptFuncs; RegisterOtherScriptFuncs; {$IFDEF DEBUG} @@ -2624,29 +1842,19 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); {$IFDEF DEBUG} Count := 0; {$ENDIF} - RegisterDelphiFunction(@_FindFirst, 'FindFirst'); - RegisterDelphiFunction(@_FindNext, 'FindNext'); - RegisterDelphiFunction(@_FindClose, 'FindClose'); - RegisterDelphiFunction(@_FmtMessage, 'FmtMessage'); + RegisterDelphiFunction(@FindFirstHelper, 'FindFirst'); + RegisterDelphiFunction(@FindNextHelper, 'FindNext'); + RegisterDelphiFunction(@FindCloseHelper, 'FindClose'); + RegisterDelphiFunction(@FmtMessageHelper, 'FmtMessage'); RegisterDelphiFunction(@Format, 'Format'); - RegisterDelphiFunction(@_GetWindowsVersionEx, 'GetWindowsVersionEx'); + RegisterDelphiFunction(@GetWindowsVersionExHelper, 'GetWindowsVersionEx'); {$IFDEF DEBUG} if Count <> Length(DelphiScriptFuncTable) then raise Exception.Create('Count <> Length(DelphiScriptFuncTable)'); {$ENDIF} end; -procedure FreeASMInliners; -var - I: Integer; -begin - for I := 0 to High(ASMInliners) do - FreeMem(ASMInliners[I]); - SetLength(ASMInliners, 0); -end; - initialization finalization ScriptFuncs.Free; - FreeASMInliners; end. diff --git a/Projects/Src/Shared.ScriptFunc.pas b/Projects/Src/Shared.ScriptFunc.pas index a51f861b6..506dcaee3 100644 --- a/Projects/Src/Shared.ScriptFunc.pas +++ b/Projects/Src/Shared.ScriptFunc.pas @@ -14,7 +14,7 @@ interface type TScriptFuncTableID = (sftScriptDlg, sftNewDiskForm, sftBrowseFunc, sftCommonFuncVcl, sftCommonFunc, sftInstall, sftInstFunc, sftInstFuncOle, sftMainFunc, sftMessages, - sftSystem, sftSysUtils, sftVerInfoFunc, sftWindows, sftOle2, sftLoggingFunc, + sftSystem, sftSysUtils, sftVerInfoFunc, sftWindows, sftActiveX, sftLoggingFunc, sftOther); TScriptTable = array of AnsiString; @@ -491,7 +491,7 @@ initialization 'procedure CharToOemBuff(var S: AnsiString);' ]; - ScriptFuncTables[sftOle2] := + ScriptFuncTables[sftActiveX] := [ 'procedure CoFreeUnusedLibraries;' ]; From 5be0371089076c5ae5eb57354231c7a1916624cd Mon Sep 17 00:00:00 2001 From: Martijn Laan <1092369+martijnlaan@users.noreply.github.com> Date: Mon, 18 Nov 2024 19:45:35 +0100 Subject: [PATCH 4/8] Cleanup the names of the sfNoUninstall/sfOnlyUninstall functions for nicer error messages. --- Projects/Src/Setup.ScriptFunc.pas | 58 +++++++++++++++---------------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/Projects/Src/Setup.ScriptFunc.pas b/Projects/Src/Setup.ScriptFunc.pas index 83a8ef505..7a47afe24 100644 --- a/Projects/Src/Setup.ScriptFunc.pas +++ b/Projects/Src/Setup.ScriptFunc.pas @@ -106,15 +106,15 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); procedure RegisterScriptDlgScriptFuncs; begin - RegisterScriptFunc('PAGEFROMID', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('PageFromID', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetClass(PStart, GetWizardForm.PageFromID(Stack.GetInt(PStart-1))); end); - RegisterScriptFunc('PAGEINDEXFROMID', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('PageIndexFromID', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, GetWizardForm.PageIndexFromID(Stack.GetInt(PStart-1))); end); - RegisterScriptFunc('CREATECUSTOMPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateCustomPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewPage := TWizardPage.Create(GetWizardForm); try @@ -127,7 +127,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewPage); end); - RegisterScriptFunc('CREATEINPUTQUERYPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateInputQueryPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewInputQueryPage := TInputQueryWizardPage.Create(GetWizardForm); try @@ -141,7 +141,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewInputQueryPage); end); - RegisterScriptFunc('CREATEINPUTOPTIONPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateInputOptionPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewInputOptionPage := TInputOptionWizardPage.Create(GetWizardForm); try @@ -156,7 +156,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewInputOptionPage); end); - RegisterScriptFunc('CREATEINPUTDIRPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateInputDirPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewInputDirPage := TInputDirWizardPage.Create(GetWizardForm); try @@ -171,7 +171,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewInputDirPage); end); - RegisterScriptFunc('CREATEINPUTFILEPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateInputFilePage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewInputFilePage := TInputFileWizardPage.Create(GetWizardForm); try @@ -185,7 +185,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewInputFilePage); end); - RegisterScriptFunc('CREATEOUTPUTMSGPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateOutputMsgPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewOutputMsgPage := TOutputMsgWizardPage.Create(GetWizardForm); try @@ -199,7 +199,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewOutputMsgPage); end); - RegisterScriptFunc('CREATEOUTPUTMSGMEMOPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateOutputMsgMemoPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewOutputMsgMemoPage := TOutputMsgMemoWizardPage.Create(GetWizardForm); try @@ -214,7 +214,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewOutputMsgMemoPage); end); - RegisterScriptFunc('CREATEOUTPUTPROGRESSPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateOutputProgressPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewOutputProgressPage := TOutputProgressWizardPage.Create(GetWizardForm); try @@ -228,7 +228,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewOutputProgressPage); end); - RegisterScriptFunc('CREATEOUTPUTMARQUEEPROGRESSPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateOutputMarqueeProgressPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewOutputMarqueeProgressPage := TOutputMarqueeProgressWizardPage.Create(GetWizardForm); try @@ -242,7 +242,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewOutputMarqueeProgressPage); end); - RegisterScriptFunc('CREATEDOWNLOADPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateDownloadPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin; var NewDownloadPage := TDownloadWizardPage.Create(GetWizardForm); try @@ -257,7 +257,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewDownloadPage); end); - RegisterScriptFunc('CREATEEXTRACTIONPAGE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateExtractionPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewExtractionPage := TExtractionWizardPage.Create(GetWizardForm); try @@ -771,27 +771,27 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); procedure RegisterInstallScriptFuncs; begin - RegisterScriptFunc('EXTRACTTEMPORARYFILE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ExtractTemporaryFile', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin ExtractTemporaryFile(Stack.GetString(PStart)); end); - RegisterScriptFunc('EXTRACTTEMPORARYFILES', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ExtractTemporaryFiles', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, ExtractTemporaryFiles(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('DOWNLOADTEMPORARYFILE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DownloadTemporaryFile', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt64(PStart, DownloadTemporaryFile(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), TOnDownloadProgress(Stack.GetProc(PStart-4, Caller)))); end); - RegisterScriptFunc('SETDOWNLOADCREDENTIALS', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SetDownloadCredentials', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin SetDownloadCredentials(Stack.GetString(PStart),Stack.GetString(PStart-1)); end); - RegisterScriptFunc('DOWNLOADTEMPORARYFILESIZE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DownloadTemporaryFileSize', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt64(PStart, DownloadTemporaryFileSize(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('DOWNLOADTEMPORARYFILEDATE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DownloadTemporaryFileDate', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, DownloadTemporaryFileDate(Stack.GetString(PStart-1))); end); @@ -1163,7 +1163,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); begin Stack.SetClass(PStart, GetWizardForm); end); - RegisterScriptFunc(['WIZARDISCOMPONENTSELECTED', 'ISCOMPONENTSELECTED', 'WIZARDISTASKSELECTED', 'ISTASKSELECTED'], sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['WizardIsComponentSelected', 'IsComponentSelected', 'WizardIsTaskSelected', 'IsTaskSelected'], sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin StringList := TStringList.Create; try @@ -1583,19 +1583,19 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Application.BringToFront; Application.Restore; end); - RegisterScriptFunc('WIZARDDIRVALUE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WizardDirValue', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.DirEdit.Text)); end); - RegisterScriptFunc('WIZARDGROUPVALUE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WizardGroupValue', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.GroupEdit.Text)); end); - RegisterScriptFunc('WIZARDNOICONS', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WizardNoIcons', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, GetWizardForm.NoIconsCheck.Checked); end); - RegisterScriptFunc('WIZARDSETUPTYPE', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WizardSetupType', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin TypeEntry := GetWizardForm.GetSetupType; if TypeEntry <> nil then begin @@ -1607,7 +1607,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); else Stack.SetString(PStart, ''); end); - RegisterScriptFunc(['WIZARDSELECTEDCOMPONENTS', 'WIZARDSELECTEDTASKS'], sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['WizardSelectedComponents', 'WizardSelectedTasks'], sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin StringList := TStringList.Create; try @@ -1620,7 +1620,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); StringList.Free; end; end); - RegisterScriptFunc(['WIZARDSELECTCOMPONENTS', 'WIZARDSELECTTASKS'], sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['WizardSelectComponents', 'WizardSelectTasks'], sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin StringList := TStringList.Create; try @@ -1635,7 +1635,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); StringList.Free; end; end); - RegisterScriptFunc('WIZARDSILENT', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WizardSilent', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, InstallMode <> imNormal); end); @@ -1647,14 +1647,14 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); begin Stack.SetBool(PStart, UninstallSilent); end); - RegisterScriptFunc('CURRENTFILENAME', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CurrentFilename', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if CheckOrInstallCurrentFilename <> '' then Stack.SetString(PStart, CheckOrInstallCurrentFilename) else InternalError('An attempt was made to call the "CurrentFilename" function from outside a "Check", "BeforeInstall" or "AfterInstall" event function belonging to a "[Files]" entry'); end); - RegisterScriptFunc('CURRENTSOURCEFILENAME', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CurrentSourceFilename', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if CheckOrInstallCurrentSourceFilename <> '' then Stack.SetString(PStart, CheckOrInstallCurrentSourceFilename) From ab30f81954352a74d9119efe4e0a3471fd4c1670 Mon Sep 17 00:00:00 2001 From: Martijn Laan <1092369+martijnlaan@users.noreply.github.com> Date: Mon, 18 Nov 2024 19:59:06 +0100 Subject: [PATCH 5/8] Pass original name to the procedures + update those which check the name. --- Projects/Src/Setup.ScriptFunc.pas | 526 +++++++++++++++--------------- 1 file changed, 263 insertions(+), 263 deletions(-) diff --git a/Projects/Src/Setup.ScriptFunc.pas b/Projects/Src/Setup.ScriptFunc.pas index 7a47afe24..fb5e0290f 100644 --- a/Projects/Src/Setup.ScriptFunc.pas +++ b/Projects/Src/Setup.ScriptFunc.pas @@ -33,7 +33,7 @@ implementation Setup.DebugClient, Shared.ScriptFunc, Setup.ScriptFunc.HelperFunc; type - TScriptFunc = reference to procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal); + TScriptFunc = reference to procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal); TScriptFuncTyp = (sfNormal, sfNoUninstall, sfOnlyUninstall); @@ -67,7 +67,7 @@ function ScriptFuncPSProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Sta else if (ScriptFuncEx.Typ = sfOnlyUninstall) and not IsUninstaller then OnlyUninstallFuncError(ScriptFuncEx.OrgName) else - ScriptFuncEx.ScriptFunc(Caller, Proc.Name, Stack, Stack.Count-1); + ScriptFuncEx.ScriptFunc(Caller, ScriptFuncEx.OrgName, Stack, Stack.Count-1); end; end; @@ -106,15 +106,15 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); procedure RegisterScriptDlgScriptFuncs; begin - RegisterScriptFunc('PageFromID', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('PageFromID', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetClass(PStart, GetWizardForm.PageFromID(Stack.GetInt(PStart-1))); end); - RegisterScriptFunc('PageIndexFromID', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('PageIndexFromID', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, GetWizardForm.PageIndexFromID(Stack.GetInt(PStart-1))); end); - RegisterScriptFunc('CreateCustomPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateCustomPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewPage := TWizardPage.Create(GetWizardForm); try @@ -127,7 +127,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewPage); end); - RegisterScriptFunc('CreateInputQueryPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateInputQueryPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewInputQueryPage := TInputQueryWizardPage.Create(GetWizardForm); try @@ -141,7 +141,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewInputQueryPage); end); - RegisterScriptFunc('CreateInputOptionPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateInputOptionPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewInputOptionPage := TInputOptionWizardPage.Create(GetWizardForm); try @@ -156,7 +156,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewInputOptionPage); end); - RegisterScriptFunc('CreateInputDirPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateInputDirPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewInputDirPage := TInputDirWizardPage.Create(GetWizardForm); try @@ -171,7 +171,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewInputDirPage); end); - RegisterScriptFunc('CreateInputFilePage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateInputFilePage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewInputFilePage := TInputFileWizardPage.Create(GetWizardForm); try @@ -185,7 +185,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewInputFilePage); end); - RegisterScriptFunc('CreateOutputMsgPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateOutputMsgPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewOutputMsgPage := TOutputMsgWizardPage.Create(GetWizardForm); try @@ -199,7 +199,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewOutputMsgPage); end); - RegisterScriptFunc('CreateOutputMsgMemoPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateOutputMsgMemoPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewOutputMsgMemoPage := TOutputMsgMemoWizardPage.Create(GetWizardForm); try @@ -214,7 +214,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewOutputMsgMemoPage); end); - RegisterScriptFunc('CreateOutputProgressPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateOutputProgressPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewOutputProgressPage := TOutputProgressWizardPage.Create(GetWizardForm); try @@ -228,7 +228,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewOutputProgressPage); end); - RegisterScriptFunc('CreateOutputMarqueeProgressPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateOutputMarqueeProgressPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewOutputMarqueeProgressPage := TOutputMarqueeProgressWizardPage.Create(GetWizardForm); try @@ -242,7 +242,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewOutputMarqueeProgressPage); end); - RegisterScriptFunc('CreateDownloadPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateDownloadPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin; var NewDownloadPage := TDownloadWizardPage.Create(GetWizardForm); try @@ -257,7 +257,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewDownloadPage); end); - RegisterScriptFunc('CreateExtractionPage', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CreateExtractionPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewExtractionPage := TExtractionWizardPage.Create(GetWizardForm); try @@ -272,17 +272,17 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetClass(PStart, NewExtractionPage); end); - RegisterScriptFunc('SCALEX', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SCALEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin InitializeScaleBaseUnits; Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitX, OrigBaseUnitX)); end); - RegisterScriptFunc('SCALEY', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SCALEY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin InitializeScaleBaseUnits; Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitY, OrigBaseUnitY)); end); - RegisterScriptFunc('CREATECUSTOMFORM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATECUSTOMFORM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var NewSetupForm := TSetupForm.CreateNew(nil); try @@ -301,7 +301,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); var S: String; begin - RegisterScriptFunc('SELECTDISK', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SELECTDISK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin S := Stack.GetString(PStart-3); Stack.SetBool(PStart, SelectDisk(Stack.GetInt(PStart-1), Stack.GetString(PStart-2), S)); @@ -314,7 +314,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); S: String; ParentWnd: HWND; begin - RegisterScriptFunc('BROWSEFORFOLDER', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('BROWSEFORFOLDER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if Assigned(WizardForm) then ParentWnd := WizardForm.Handle @@ -324,7 +324,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Stack.SetBool(PStart, BrowseForFolder(Stack.GetString(PStart-1), S, ParentWnd, Stack.GetBool(PStart-3))); Stack.SetString(PStart-2, S); end); - RegisterScriptFunc('GETOPENFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETOPENFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if Assigned(WizardForm) then ParentWnd := WizardForm.Handle @@ -334,7 +334,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Stack.SetBool(PStart, NewGetOpenFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), ParentWnd)); Stack.SetString(PStart-2, S); end); - RegisterScriptFunc('GETOPENFILENAMEMULTI', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETOPENFILENAMEMULTI', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if Assigned(WizardForm) then ParentWnd := WizardForm.Handle @@ -342,7 +342,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); ParentWnd := 0; Stack.SetBool(PStart, NewGetOpenFileNameMulti(Stack.GetString(PStart-1), TStrings(Stack.GetClass(PStart-2)), Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), ParentWnd)); end); - RegisterScriptFunc('GETSAVEFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSAVEFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if Assigned(WizardForm) then ParentWnd := WizardForm.Handle @@ -356,7 +356,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); procedure RegisterCommonFuncVclScriptFuncs; begin - RegisterScriptFunc('MINIMIZEPATHNAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('MINIMIZEPATHNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, MinimizePathName(Stack.GetString(PStart-1), TFont(Stack.GetClass(PStart-2)), Stack.GetInt(PStart-3))); end); @@ -372,73 +372,73 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Typ, ExistingTyp, Data, Size: DWORD; I: Integer; begin - RegisterScriptFunc('FILEEXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('FILEEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, NewFileExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); end); - RegisterScriptFunc('DIREXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DIREXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, DirExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); end); - RegisterScriptFunc('FILEORDIREXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('FILEORDIREXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, FileOrDirExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); end); - RegisterScriptFunc('GETINISTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETINISTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetIniString(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetString(PStart-4))); end); - RegisterScriptFunc('GETINIINT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETINIINT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, GetIniInt(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4), Stack.GetInt(PStart-5), Stack.GetString(PStart-6))); end); - RegisterScriptFunc('GETINIBOOL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETINIBOOL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, GetIniBool(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), Stack.GetString(PStart-4))); end); - RegisterScriptFunc('INIKEYEXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('INIKEYEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, IniKeyExists(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3))); end); - RegisterScriptFunc('ISINISECTIONEMPTY', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ISINISECTIONEMPTY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, IsIniSectionEmpty(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); end); - RegisterScriptFunc('SETINISTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SETINISTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, SetIniString(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetString(PStart-4))); end); - RegisterScriptFunc('SETINIINT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SETINIINT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, SetIniInt(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetInt(PStart-3), Stack.GetString(PStart-4))); end); - RegisterScriptFunc('SETINIBOOL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SETINIBOOL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, SetIniBool(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), Stack.GetString(PStart-4))); end); - RegisterScriptFunc('DELETEINIENTRY', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DELETEINIENTRY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin DeleteIniEntry(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetString(PStart-2)); end); - RegisterScriptFunc('DELETEINISECTION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DELETEINISECTION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin DeleteIniSection(Stack.GetString(PStart), Stack.GetString(PStart-1)); end); - RegisterScriptFunc('GETENV', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETENV', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetEnv(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('GETCMDTAIL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETCMDTAIL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetCmdTail); end); - RegisterScriptFunc('PARAMCOUNT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('PARAMCOUNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if NewParamsForCode.Count = 0 then InternalError('NewParamsForCode not set'); Stack.SetInt(PStart, NewParamsForCode.Count-1); end); - RegisterScriptFunc('PARAMSTR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('PARAMSTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin I := Stack.GetInt(PStart-1); if (I >= 0) and (I < NewParamsForCode.Count) then @@ -446,67 +446,67 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); else Stack.SetString(PStart, ''); end); - RegisterScriptFunc('ADDBACKSLASH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ADDBACKSLASH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, AddBackslash(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('REMOVEBACKSLASH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REMOVEBACKSLASH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, RemoveBackslash(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('REMOVEBACKSLASHUNLESSROOT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REMOVEBACKSLASHUNLESSROOT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, RemoveBackslashUnlessRoot(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('ADDQUOTES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ADDQUOTES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, AddQuotes(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('REMOVEQUOTES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REMOVEQUOTES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, RemoveQuotes(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('GETSHORTNAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSHORTNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetShortNameRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); end); - RegisterScriptFunc('GETWINDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETWINDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetWinDir); end); - RegisterScriptFunc('GETSYSTEMDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSYSTEMDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetSystemDir); end); - RegisterScriptFunc('GETSYSWOW64DIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSYSWOW64DIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetSysWow64Dir); end); - RegisterScriptFunc('GETSYSNATIVEDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSYSNATIVEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetSysNativeDir(IsWin64)); end); - RegisterScriptFunc('GETTEMPDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETTEMPDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetTempDir); end); - RegisterScriptFunc('STRINGCHANGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('STRINGCHANGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin S := Stack.GetString(PStart-1); Stack.SetInt(PStart, StringChange(S, Stack.GetString(PStart-2), Stack.GetString(PStart-3))); Stack.SetString(PStart-1, S); end); - RegisterScriptFunc('STRINGCHANGEEX', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('STRINGCHANGEEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin S := Stack.GetString(PStart-1); Stack.SetInt(PStart, StringChangeEx(S, Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetBool(PStart-4))); Stack.SetString(PStart-1, S); end); - RegisterScriptFunc('USINGWINNT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('USINGWINNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, True); end); - RegisterScriptFunc(['COPYFILE', 'FILECOPY'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['COPYFILE', 'FILECOPY'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin ExistingFilename := Stack.GetString(PStart-1); if not IsProtectedSrcExe(ExistingFilename) then @@ -515,13 +515,13 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('CONVERTPERCENTSTR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CONVERTPERCENTSTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin S := Stack.GetString(PStart-1); Stack.SetBool(PStart, ConvertPercentStr(S)); Stack.SetString(PStart-1, S); end); - RegisterScriptFunc('REGKEYEXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGKEYEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var RegView: TRegView; var RootKey: HKEY; @@ -533,7 +533,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('REGVALUEEXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGVALUEEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); S := Stack.GetString(PStart-2); @@ -544,19 +544,19 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('REGDELETEKEYINCLUDINGSUBKEYS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGDELETEKEYINCLUDINGSUBKEYS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); S := Stack.GetString(PStart-2); Stack.SetBool(PStart, RegDeleteKeyIncludingSubkeys(RegView, RootKey, PChar(S)) = ERROR_SUCCESS); end); - RegisterScriptFunc('REGDELETEKEYIFEMPTY', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGDELETEKEYIFEMPTY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); S := Stack.GetString(PStart-2); Stack.SetBool(PStart, RegDeleteKeyIfEmpty(RegView, RootKey, PChar(S)) = ERROR_SUCCESS); end); - RegisterScriptFunc('REGDELETEVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGDELETEVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); S := Stack.GetString(PStart-2); @@ -567,19 +567,19 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('REGGETSUBKEYNAMES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGGETSUBKEYNAMES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey, Stack.GetString(PStart-2), Stack, PStart-3, True)); end); - RegisterScriptFunc('REGGETVALUENAMES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGGETVALUENAMES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey, Stack.GetString(PStart-2), Stack, PStart-3, False)); end); - RegisterScriptFunc('REGQUERYSTRINGVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGQUERYSTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); S := Stack.GetString(PStart-2); @@ -592,7 +592,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('REGQUERYMULTISTRINGVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGQUERYMULTISTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); S := Stack.GetString(PStart-2); @@ -605,7 +605,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('REGQUERYDWORDVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGQUERYDWORDVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); S := Stack.GetString(PStart-2); @@ -621,7 +621,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('REGQUERYBINARYVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGQUERYBINARYVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); S := Stack.GetString(PStart-2); @@ -640,7 +640,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('REGWRITESTRINGVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGWRITESTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); S := Stack.GetString(PStart-2); @@ -659,7 +659,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('REGWRITEEXPANDSTRINGVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGWRITEEXPANDSTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); S := Stack.GetString(PStart-2); @@ -674,7 +674,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('REGWRITEMULTISTRINGVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGWRITEMULTISTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); S := Stack.GetString(PStart-2); @@ -695,7 +695,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('REGWRITEDWORDVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGWRITEDWORDVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); S := Stack.GetString(PStart-2); @@ -710,7 +710,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('REGWRITEBINARYVALUE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGWRITEBINARYVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); S := Stack.GetString(PStart-2); @@ -725,43 +725,43 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc(['ISADMIN', 'ISADMINLOGGEDON'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['ISADMIN', 'ISADMINLOGGEDON'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, IsAdmin); end); - RegisterScriptFunc('ISPOWERUSERLOGGEDON', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ISPOWERUSERLOGGEDON', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, IsPowerUserLoggedOn); end); - RegisterScriptFUnc('ISADMININSTALLMODE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFUnc('ISADMININSTALLMODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, IsAdminInstallMode); end); - RegisterScriptFunc('FONTEXISTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('FONTEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, FontExists(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('GETUILANGUAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETUILANGUAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, GetUILanguage); end); - RegisterScriptFunc('ADDPERIOD', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ADDPERIOD', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, AddPeriod(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('CHARLENGTH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CHARLENGTH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, PathCharLength(Stack.GetString(PStart-1), Stack.GetInt(PStart-2))); end); - RegisterScriptFunc('SETNTFSCOMPRESSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SETNTFSCOMPRESSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, SetNTFSCompressionRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetBool(PStart-2))); end); - RegisterScriptFunc('ISWILDCARD', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ISWILDCARD', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, IsWildcard(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('WILDCARDMATCH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WILDCARDMATCH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin S := Stack.GetString(PStart-1); N := Stack.GetString(PStart-2); @@ -771,27 +771,27 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); procedure RegisterInstallScriptFuncs; begin - RegisterScriptFunc('ExtractTemporaryFile', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ExtractTemporaryFile', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin ExtractTemporaryFile(Stack.GetString(PStart)); end); - RegisterScriptFunc('ExtractTemporaryFiles', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ExtractTemporaryFiles', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, ExtractTemporaryFiles(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('DownloadTemporaryFile', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DownloadTemporaryFile', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt64(PStart, DownloadTemporaryFile(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), TOnDownloadProgress(Stack.GetProc(PStart-4, Caller)))); end); - RegisterScriptFunc('SetDownloadCredentials', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SetDownloadCredentials', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin SetDownloadCredentials(Stack.GetString(PStart),Stack.GetString(PStart-1)); end); - RegisterScriptFunc('DownloadTemporaryFileSize', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DownloadTemporaryFileSize', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt64(PStart, DownloadTemporaryFileSize(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('DownloadTemporaryFileDate', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DownloadTemporaryFileDate', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, DownloadTemporaryFileDate(Stack.GetString(PStart-1))); end); @@ -804,11 +804,11 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); ResultCode, ErrorCode: Integer; FreeBytes, TotalBytes: Integer64; begin - RegisterScriptFunc('CHECKFORMUTEXES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CHECKFORMUTEXES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, CheckForMutexes(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('DECREMENTSHAREDCOUNT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DECREMENTSHAREDCOUNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if Stack.GetBool(PStart-1) then begin if not IsWin64 then @@ -818,59 +818,59 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); else Stack.SetBool(PStart, DecrementSharedCount(rv32Bit, Stack.GetString(PStart-2))); end); - RegisterScriptFunc('DELAYDELETEFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DELAYDELETEFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin DelayDeleteFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetInt(PStart-1), 250, 250); end); - RegisterScriptFunc('DELTREE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DELTREE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, DelTree(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetBool(PStart-2), Stack.GetBool(PStart-3), Stack.GetBool(PStart-4), False, nil, nil, nil)); end); - RegisterScriptFunc('GENERATEUNIQUENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GENERATEUNIQUENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GenerateUniqueName(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetString(PStart-2))); end); - RegisterScriptFunc('GETCOMPUTERNAMESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETCOMPUTERNAMESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetComputerNameString); end); - RegisterScriptFunc('GETMD5OFFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETMD5OFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, MD5DigestToString(GetMD5OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)))); end); - RegisterScriptFunc('GETMD5OFSTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETMD5OFSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, MD5DigestToString(GetMD5OfAnsiString(Stack.GetAnsiString(PStart-1)))); end); - RegisterScriptFunc('GETMD5OFUNICODESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETMD5OFUNICODESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, MD5DigestToString(GetMD5OfUnicodeString(Stack.GetString(PStart-1)))); end); - RegisterScriptFunc('GETSHA1OFFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSHA1OFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)))); end); - RegisterScriptFunc('GETSHA1OFSTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSHA1OFSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfAnsiString(Stack.GetAnsiString(PStart-1)))); end); - RegisterScriptFunc('GETSHA1OFUNICODESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSHA1OFUNICODESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfUnicodeString(Stack.GetString(PStart-1)))); end); - RegisterScriptFunc('GETSHA256OFFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSHA256OFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)))); end); - RegisterScriptFunc('GETSHA256OFSTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSHA256OFSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfAnsiString(Stack.GetAnsiString(PStart-1)))); end); - RegisterScriptFunc('GETSHA256OFUNICODESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSHA256OFUNICODESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfUnicodeString(Stack.GetString(PStart-1)))); end); - RegisterScriptFunc('GETSPACEONDISK', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSPACEONDISK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if GetSpaceOnDisk(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin if Stack.GetBool(PStart-2) then begin @@ -888,7 +888,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('GETSPACEONDISK64', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSPACEONDISK64', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if GetSpaceOnDisk(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin Stack.SetInt64(PStart-2, Int64(FreeBytes.Hi) shl 32 + FreeBytes.Lo); @@ -897,11 +897,11 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('GETUSERNAMESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETUSERNAMESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetUserNameString); end); - RegisterScriptFunc('INCREMENTSHAREDCOUNT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('INCREMENTSHAREDCOUNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if Stack.GetBool(PStart) then begin if not IsWin64 then @@ -911,25 +911,25 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); else IncrementSharedCount(rv32Bit, Stack.GetString(PStart-1), Stack.GetBool(PStart-2)); end); - RegisterScriptFunc(['EXEC', 'EXECASORIGINALUSER', 'EXECANDLOGOUTPUT', 'EXECANDCAPTUREOUTPUT'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['Exec', 'ExecAsOriginalUser', 'ExecAndLogOutput', 'ExecAndCaptureOutput'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - var RunAsOriginalUser := Name = 'EXECASORIGINALUSER'; + var RunAsOriginalUser := OrgName = 'ExecAsOriginalUser'; if IsUninstaller and RunAsOriginalUser then - NoUninstallFuncError(Name); + NoUninstallFuncError(OrgName); var Method: TMethod; { Must stay alive until OutputReader is freed } var OutputReader: TCreateProcessOutputReader := nil; try - if Name = 'EXECANDLOGOUTPUT' then begin + if OrgName = 'ExecAndLogOutput' then begin Method := Stack.GetProc(PStart-7, Caller); if Method.Code <> nil then OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLogCustom, NativeInt(@Method)) else if GetLogActive then OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLog, 0); - end else if Name = 'EXECANDCAPTUREOUTPUT' then + end else if OrgName = 'ExecAndCaptureOutput' then OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLog, 0, omCapture); var ExecWait := TExecWait(Stack.GetInt(PStart-5)); if (OutputReader <> nil) and (ExecWait <> ewWaitUntilTerminated) then - InternalError(Format('Must call "%s" function with Wait = ewWaitUntilTerminated', [Name])); + InternalError(Format('Must call "%s" function with Wait = ewWaitUntilTerminated', [OrgName])); Filename := Stack.GetString(PStart-1); if not IsProtectedSrcExe(Filename) then begin @@ -945,7 +945,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); WindowDisabler.Free; end; Stack.SetInt(PStart-6, ResultCode); - if Name = 'EXECANDCAPTUREOUTPUT' then begin + if OrgName = 'ExecAndCaptureOutput' then begin { Set the three TExecOutput fields } Stack.SetArray(PStart-7, OutputReader.CaptureOutList, 0); Stack.SetArray(PStart-7, OutputReader.CaptureErrList, 1); @@ -959,11 +959,11 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); OutputReader.Free; end; end); - RegisterScriptFunc(['SHELLEXEC', 'SHELLEXECASORIGINALUSER'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['ShellExec', 'ShellExecAsOriginalUser'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - var RunAsOriginalUser := Name = 'SHELLEXECASORIGINALUSER'; + var RunAsOriginalUser := OrgName = 'ShellExecAsOriginalUser'; if IsUninstaller and RunAsOriginalUser then - NoUninstallFuncError(Name); + NoUninstallFuncError(OrgName); Filename := Stack.GetString(PStart-2); if not IsProtectedSrcExe(Filename) then begin { Disable windows so the user can't utilize our UI during the @@ -983,23 +983,23 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Stack.SetInt(PStart-7, ERROR_ACCESS_DENIED); end; end); - RegisterScriptFunc('ISPROTECTEDSYSTEMFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ISPROTECTEDSYSTEMFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, IsProtectedSystemFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); end); - RegisterScriptFunc('MAKEPENDINGFILERENAMEOPERATIONSCHECKSUM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('MAKEPENDINGFILERENAMEOPERATIONSCHECKSUM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, SHA256DigestToString(MakePendingFileRenameOperationsChecksum)); end); - RegisterScriptFunc('MODIFYPIFFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('MODIFYPIFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, ModifyPifFile(Stack.GetString(PStart-1), Stack.GetBool(PStart-2))); end); - RegisterScriptFunc('REGISTERSERVER', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGISTERSERVER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin RegisterServer(False, Stack.GetBool(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2)); end); - RegisterScriptFunc('UNREGISTERSERVER', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('UNREGISTERSERVER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin try RegisterServer(True, Stack.GetBool(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3)); @@ -1008,15 +1008,15 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Stack.SetBool(PStart, False); end; end); - RegisterScriptFunc('UNREGISTERFONT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('UNREGISTERFONT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin UnregisterFont(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2)); end); - RegisterScriptFunc('RESTARTREPLACE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('RESTARTREPLACE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin RestartReplace(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1)); end); - RegisterScriptFunc('FORCEDIRECTORIES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('FORCEDIRECTORIES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, ForceDirectories(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); end); @@ -1024,7 +1024,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); procedure RegisterInstFuncOleScriptFuncs; begin - RegisterScriptFunc('CREATESHELLLINK', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATESHELLLINK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, CreateShellLink(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), @@ -1032,14 +1032,14 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Stack.GetString(PStart-6), Stack.GetInt(PStart-7), Stack.GetInt(PStart-8), 0, '', nil, False, False)); end); - RegisterScriptFunc('REGISTERTYPELIBRARY', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGISTERTYPELIBRARY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if Stack.GetBool(PStart) then HelperRegisterTypeLibrary(False, Stack.GetString(PStart-1)) else RegisterTypeLibrary(Stack.GetString(PStart-1)); end); - RegisterScriptFunc('UNREGISTERTYPELIBRARY', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('UNREGISTERTYPELIBRARY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin try if Stack.GetBool(PStart-1) then @@ -1051,7 +1051,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Stack.SetBool(PStart, False); end; end); - RegisterScriptFunc('UNPINSHELLLINK', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('UNPINSHELLLINK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, UnpinShellLink(Stack.GetString(PStart-1))); end); @@ -1065,47 +1065,47 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Components, Suppressible: Boolean; Default: Integer; begin - RegisterScriptFunc('ACTIVELANGUAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ACTIVELANGUAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, ExpandConst('{language}')); end); - RegisterScriptFunc('EXPANDCONSTANT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXPANDCONSTANT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, ExpandConst(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('EXPANDCONSTANTEX', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXPANDCONSTANTEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, ExpandConstEx(Stack.GetString(PStart-1), [Stack.GetString(PStart-2), Stack.GetString(PStart-3)])); end); - RegisterScriptFunc('EXITSETUPMSGBOX', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXITSETUPMSGBOX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, ExitSetupMsgBox); end); - RegisterScriptFunc('GETSHELLFOLDERBYCSIDL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETSHELLFOLDERBYCSIDL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetShellFolderByCSIDL(Stack.GetInt(PStart-1), Stack.GetBool(PStart-2))); end); - RegisterScriptFunc('INSTALLONTHISVERSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('INSTALLONTHISVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if not StrToSetupVersionData(Stack.GetString(PStart-1), MinVersion) then - InternalError('InstallOnThisVersion: Invalid MinVersion string') + InternalError(Format('%s: Invalid MinVersion string', [OrgName])) else if not StrToSetupVersionData(Stack.GetString(PStart-2), OnlyBelowVersion) then - InternalError('InstallOnThisVersion: Invalid OnlyBelowVersion string') + InternalError(Format('%s: Invalid OnlyBelowVersion string', [OrgName])) else Stack.SetBool(PStart, (InstallOnThisVersion(MinVersion, OnlyBelowVersion) = irInstall)); end); - RegisterScriptFunc('GETWINDOWSVERSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETWINDOWSVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetUInt(PStart, WindowsVersion); end); - RegisterScriptFunc('GETWINDOWSVERSIONSTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETWINDOWSVERSIONSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, Format('%u.%.2u.%u', [WindowsVersion shr 24, (WindowsVersion shr 16) and $FF, WindowsVersion and $FFFF])); end); - RegisterScriptFunc(['MSGBOX', 'SUPPRESSIBLEMSGBOX'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['MsgBox', 'SuppressibleMsgBox'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if Name = 'MSGBOX' then begin + if OrgName = 'MsgBox' then begin Suppressible := False; Default := 0; end else begin @@ -1114,9 +1114,9 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; Stack.SetInt(PStart, LoggedMsgBox(Stack.GetString(PStart-1), GetMsgBoxCaption, TMsgBoxType(Stack.GetInt(PStart-2)), Stack.GetInt(PStart-3), Suppressible, Default)); end); - RegisterScriptFunc(['TASKDIALOGMSGBOX', 'SUPPRESSIBLETASKDIALOGMSGBOX'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['TaskDialogMsgBox', 'SuppressibleTaskDialogMsgBox'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if Name = 'TASKDIALOGMSGBOX' then begin + if OrgName = 'TaskDialogMsgBox' then begin Suppressible := False; Default := 0; end else begin @@ -1126,48 +1126,48 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); var ButtonLabels := Stack.GetStringArray(PStart-5); Stack.SetInt(PStart, LoggedTaskDialogMsgBox('', Stack.GetString(PStart-1), Stack.GetString(PStart-2), GetMsgBoxCaption, TMsgBoxType(Stack.GetInt(PStart-3)), Stack.GetInt(PStart-4), ButtonLabels, Stack.GetInt(PStart-6), Suppressible, Default)); end); - RegisterScriptFunc('ISWIN64', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ISWIN64', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, IsWin64); end); - RegisterScriptFunc('IS64BITINSTALLMODE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('IS64BITINSTALLMODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, Is64BitInstallMode); end); - RegisterScriptFunc('PROCESSORARCHITECTURE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('PROCESSORARCHITECTURE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, Integer(ProcessorArchitecture)); end); - RegisterScriptFunc(['ISARM32COMPATIBLE', 'ISARM64', 'ISX64', 'ISX64OS', 'ISX64COMPATIBLE', 'ISX86', 'ISX86OS', 'ISX86COMPATIBLE'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['IsArm32Compatible', 'IsArm64', 'IsX64', 'IsX64OS', 'IsX64Compatible', 'IsX86', 'IsX86OS', 'IsX86Compatible'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - var ArchitectureIdentifier := LowerCase(Copy(String(Name), 3, MaxInt)); + var ArchitectureIdentifier := LowerCase(Copy(String(OrgName), 3, MaxInt)); Stack.SetBool(PStart, EvalArchitectureIdentifier(ArchitectureIdentifier)); end); - RegisterScriptFunc('CUSTOMMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CUSTOMMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, CustomMessage(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('RMSESSIONSTARTED', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('RMSESSIONSTARTED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, RmSessionStarted); end); - RegisterScriptFunc('REGISTEREXTRACLOSEAPPLICATIONSRESOURCE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGISTEREXTRACLOSEAPPLICATIONSRESOURCE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, CodeRegisterExtraCloseApplicationsResource(Stack.GetBool(PStart-1), Stack.GetString(PStart-2))); end); - RegisterScriptFunc('GETMAINFORM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETMAINFORM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetClass(PStart, GetMainForm); end); - RegisterScriptFunc('GETWIZARDFORM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETWIZARDFORM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetClass(PStart, GetWizardForm); end); - RegisterScriptFunc(['WizardIsComponentSelected', 'IsComponentSelected', 'WizardIsTaskSelected', 'IsTaskSelected'], sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['WizardIsComponentSelected', 'IsComponentSelected', 'WizardIsTaskSelected', 'IsTaskSelected'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin StringList := TStringList.Create; try - Components := (Name = 'WIZARDISCOMPONENTSELECTED') or (Name = 'ISCOMPONENTSELECTED'); + Components := (OrgName = 'WizardIsComponentSelected') or (OrgName = 'IsComponentSelected'); if Components then GetWizardForm.GetSelectedComponents(StringList, False, False) else @@ -1186,7 +1186,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); procedure RegisterMessagesScriptFuncs; begin - RegisterScriptFunc('SETUPMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SETUPMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, SetupMessages[TSetupMessageID(Stack.GetInt(PStart-1))]); end); @@ -1197,11 +1197,11 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); F: TFile; TmpFileSize: Integer64; begin - RegisterScriptFunc('RANDOM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('RANDOM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, Random(Stack.GetInt(PStart-1))); end); - RegisterScriptFunc('FILESIZE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('FILESIZE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin try F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite); @@ -1215,7 +1215,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Stack.SetBool(PStart, False); end; end); - RegisterScriptFunc('FILESIZE64', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('FILESIZE64', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin try F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite); @@ -1230,19 +1230,19 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Stack.SetBool(PStart, False); end; end); - RegisterScriptFunc('SET8087CW', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SET8087CW', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Set8087CW(Stack.GetInt(PStart)); end); - RegisterScriptFunc('GET8087CW', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GET8087CW', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, Get8087CW); end); - RegisterScriptFunc('UTF8ENCODE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('UTF8ENCODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetAnsiString(PStart, Utf8Encode(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('UTF8DECODE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('UTF8DECODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, UTF8ToString(Stack.GetAnsiString(PStart-1))); end); @@ -1254,67 +1254,67 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); NewDateSeparator, NewTimeSeparator: Char; OldDateSeparator, OldTimeSeparator: Char; begin - RegisterScriptFunc('BEEP', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('BEEP', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Beep; end); - RegisterScriptFunc('TRIMLEFT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('TRIMLEFT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, TrimLeft(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('TRIMRIGHT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('TRIMRIGHT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, TrimRight(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('GETCURRENTDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETCURRENTDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetCurrentDir); end); - RegisterScriptFunc('SETCURRENTDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SETCURRENTDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, SetCurrentDir(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('EXPANDFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXPANDFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, PathExpand(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('EXPANDUNCFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXPANDUNCFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, ExpandUNCFileName(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('EXTRACTRELATIVEPATH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXTRACTRELATIVEPATH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, NewExtractRelativePath(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); end); - RegisterScriptFunc('EXTRACTFILEDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXTRACTFILEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, PathExtractDir(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('EXTRACTFILEDRIVE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXTRACTFILEDRIVE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, PathExtractDrive(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('EXTRACTFILEEXT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXTRACTFILEEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, PathExtractExt(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('EXTRACTFILENAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXTRACTFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, PathExtractName(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('EXTRACTFILEPATH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXTRACTFILEPATH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, PathExtractPath(Stack.GetString(PStart-1))); end); - RegisterScriptFunc('CHANGEFILEEXT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CHANGEFILEEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, PathChangeExt(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); end); - RegisterScriptFunc('FILESEARCH', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('FILESEARCH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, NewFileSearch(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetString(PStart-2))); end); - RegisterScriptFunc('RENAMEFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('RENAMEFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin OldName := Stack.GetString(PStart-1); if not IsProtectedSrcExe(OldName) then @@ -1322,35 +1322,35 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('DELETEFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DELETEFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, DeleteFileRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); end); - RegisterScriptFunc('CREATEDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, CreateDirectoryRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); end); - RegisterScriptFunc('REMOVEDIR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REMOVEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, RemoveDirectoryRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))); end); - RegisterScriptFunc('COMPARESTR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('COMPARESTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, CompareStr(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); end); - RegisterScriptFunc('COMPARETEXT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('COMPARETEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, CompareText(Stack.GetString(PStart-1), Stack.GetString(PStart-2))); end); - RegisterScriptFunc('SAMESTR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SAMESTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, CompareStr(Stack.GetString(PStart-1), Stack.GetString(PStart-2)) = 0); end); - RegisterScriptFunc('SAMETEXT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SAMETEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, CompareText(Stack.GetString(PStart-1), Stack.GetString(PStart-2)) = 0); end); - RegisterScriptFunc('GETDATETIMESTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETDATETIMESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin OldDateSeparator := FormatSettings.DateSeparator; OldTimeSeparator := FormatSettings.TimeSeparator; @@ -1367,7 +1367,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); FormatSettings.DateSeparator := OldDateSeparator; end; end); - RegisterScriptFunc('SYSERRORMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SYSERRORMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, Win32ErrorString(Stack.GetInt(PStart-1))); end); @@ -1377,7 +1377,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); var VersionNumbers: TFileVersionNumbers; begin - RegisterScriptFunc('GETVERSIONNUMBERS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETVERSIONNUMBERS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin Stack.SetInt(PStart-2, VersionNumbers.MS); @@ -1386,7 +1386,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('GETVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin Stack.SetUInt(PStart-2, VersionNumbers.MS shr 16); @@ -1397,7 +1397,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('GETVERSIONNUMBERSSTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETVERSIONNUMBERSSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin Stack.SetString(PStart-2, Format('%u.%u.%u.%u', [VersionNumbers.MS shr 16, @@ -1406,7 +1406,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('GETPACKEDVERSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETPACKEDVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin Stack.SetInt64(PStart-2, (Int64(VersionNumbers.MS) shl 32) or VersionNumbers.LS); @@ -1414,32 +1414,32 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('PACKVERSIONNUMBERS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('PACKVERSIONNUMBERS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt64(PStart, Int64((UInt64(Stack.GetUInt(PStart-1)) shl 32) or Stack.GetUInt(PStart-2))); end); - RegisterScriptFunc('PACKVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('PACKVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin VersionNumbers.MS := (Stack.GetUInt(PStart-1) shl 16) or (Stack.GetUInt(PStart-2) and $FFFF); VersionNumbers.LS := (Stack.GetUInt(PStart-3) shl 16) or (Stack.GetUInt(PStart-4) and $FFFF); Stack.SetInt64(PStart, Int64((UInt64(VersionNumbers.MS) shl 32) or VersionNumbers.LS)); end); - RegisterScriptFunc('COMPAREPACKEDVERSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('COMPAREPACKEDVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, Compare64(Integer64(Stack.GetInt64(PStart-1)), Integer64(Stack.GetInt64(PStart-2)))); end); - RegisterScriptFunc('SAMEPACKEDVERSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SAMEPACKEDVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, Compare64(Integer64(Stack.GetInt64(PStart-1)), Integer64(Stack.GetInt64(PStart-2))) = 0); end); - RegisterScriptFunc('UNPACKVERSIONNUMBERS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('UNPACKVERSIONNUMBERS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin VersionNumbers.MS := UInt64(Stack.GetInt64(PStart)) shr 32; VersionNumbers.LS := UInt64(Stack.GetInt64(PStart)) and $FFFFFFFF; Stack.SetUInt(PStart-1, VersionNumbers.MS); Stack.SetUInt(PStart-2, VersionNumbers.LS); end); - RegisterScriptFunc('UNPACKVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('UNPACKVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin VersionNumbers.MS := UInt64(Stack.GetInt64(PStart)) shr 32; VersionNumbers.LS := UInt64(Stack.GetInt64(PStart)) and $FFFFFFFF; @@ -1448,14 +1448,14 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Stack.SetUInt(PStart-3, VersionNumbers.LS shr 16); Stack.SetUInt(PStart-4, VersionNumbers.LS and $FFFF); end); - RegisterScriptFunc('VERSIONTOSTR', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('VERSIONTOSTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin VersionNumbers.MS := UInt64(Stack.GetInt64(PStart-1)) shr 32; VersionNumbers.LS := UInt64(Stack.GetInt64(PStart-1)) and $FFFFFFFF; Stack.SetString(PStart, Format('%u.%u.%u.%u', [VersionNumbers.MS shr 16, VersionNumbers.MS and $FFFF, VersionNumbers.LS shr 16, VersionNumbers.LS and $FFFF])); end); - RegisterScriptFunc('STRTOVERSION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('STRTOVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if StrToVersionNumbers(Stack.GetString(PStart-1), VersionNumbers) then begin Stack.SetInt64(PStart-2, (Int64(VersionNumbers.MS) shl 32) or VersionNumbers.LS); @@ -1474,47 +1474,47 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); DllHandle: THandle; S: AnsiString; begin - RegisterScriptFunc('SLEEP', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SLEEP', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Sleep(Stack.GetInt(PStart)); end); - RegisterScriptFunc('FINDWINDOWBYCLASSNAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('FINDWINDOWBYCLASSNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, FindWindow(PChar(Stack.GetString(PStart-1)), nil)); end); - RegisterScriptFunc('FINDWINDOWBYWINDOWNAME', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('FINDWINDOWBYWINDOWNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, FindWindow(nil, PChar(Stack.GetString(PStart-1)))); end); - RegisterScriptFunc('SENDMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SENDMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, SendMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4))); end); - RegisterScriptFunc('POSTMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('POSTMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, PostMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4))); end); - RegisterScriptFunc('SENDNOTIFYMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SENDNOTIFYMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, SendNotifyMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4))); end); - RegisterScriptFunc('REGISTERWINDOWMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('REGISTERWINDOWMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, RegisterWindowMessage(PChar(Stack.GetString(PStart-1)))); end); - RegisterScriptFunc('SENDBROADCASTMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SENDBROADCASTMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, SendMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3))); end); - RegisterScriptFunc('POSTBROADCASTMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('POSTBROADCASTMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, PostMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3))); end); - RegisterScriptFunc('SENDBROADCASTNOTIFYMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SENDBROADCASTNOTIFYMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, SendNotifyMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3))); end); - RegisterScriptFunc('LOADDLL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('LOADDLL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin DllHandle := SafeLoadLibrary(Stack.GetString(PStart-1), SEM_NOOPENFILEERRORBOX); if DllHandle <> 0 then @@ -1523,7 +1523,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); Stack.SetInt(PStart-2, GetLastError); Stack.SetInt(PStart, DllHandle); end); - RegisterScriptFunc('CALLDLLPROC', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CALLDLLPROC', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @DllProc := GetProcAddress(Stack.GetInt(PStart-1), PChar(Stack.GetString(PStart-2))); if Assigned(DllProc) then begin @@ -1532,21 +1532,21 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end else Stack.SetBool(PStart, False); end); - RegisterScriptFunc('FREEDLL', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('FREEDLL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, FreeLibrary(Stack.GetInt(PStart-1))); end); - RegisterScriptFunc('CREATEMUTEX', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATEMUTEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Windows.CreateMutex(nil, False, PChar(Stack.GetString(PStart))); end); - RegisterScriptFunc('OEMTOCHARBUFF', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('OEMTOCHARBUFF', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin S := Stack.GetAnsiString(PStart); OemToCharBuffA(PAnsiChar(S), PAnsiChar(S), Length(S)); Stack.SetAnsiString(PStart, S); end); - RegisterScriptFunc('CHARTOOEMBUFF', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CHARTOOEMBUFF', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin S := Stack.GetAnsiString(PStart); CharToOemBuffA(PAnsiChar(S), PAnsiChar(S), Length(S)); @@ -1556,7 +1556,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); procedure RegisterActiveXScriptFuncs; begin - RegisterScriptFunc('COFREEUNUSEDLIBRARIES', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('COFREEUNUSEDLIBRARIES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin CoFreeUnusedLibraries; end); @@ -1564,7 +1564,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); procedure RegisterLoggingFuncScriptFuncs; begin - RegisterScriptFunc('LOG', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('LOG', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Log(Stack.GetString(PStart)); end); @@ -1578,24 +1578,24 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); AnsiS: AnsiString; ErrorCode: Cardinal; begin - RegisterScriptFunc('BRINGTOFRONTANDRESTORE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('BRINGTOFRONTANDRESTORE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Application.BringToFront; Application.Restore; end); - RegisterScriptFunc('WizardDirValue', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WizardDirValue', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.DirEdit.Text)); end); - RegisterScriptFunc('WizardGroupValue', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WizardGroupValue', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.GroupEdit.Text)); end); - RegisterScriptFunc('WizardNoIcons', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WizardNoIcons', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, GetWizardForm.NoIconsCheck.Checked); end); - RegisterScriptFunc('WizardSetupType', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WizardSetupType', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin TypeEntry := GetWizardForm.GetSetupType; if TypeEntry <> nil then begin @@ -1607,11 +1607,11 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); else Stack.SetString(PStart, ''); end); - RegisterScriptFunc(['WizardSelectedComponents', 'WizardSelectedTasks'], sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['WizardSelectedComponents', 'WizardSelectedTasks'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin StringList := TStringList.Create; try - if Name = 'WIZARDSELECTEDCOMPONENTS' then + if OrgName = 'WizardSelectedComponents' then GetWizardForm.GetSelectedComponents(StringList, Stack.GetBool(PStart-1), False) else GetWizardForm.GetSelectedTasks(StringList, Stack.GetBool(PStart-1), False, False); @@ -1620,14 +1620,14 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); StringList.Free; end; end); - RegisterScriptFunc(['WizardSelectComponents', 'WizardSelectTasks'], sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['WizardSelectComponents', 'WizardSelectTasks'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin StringList := TStringList.Create; try S := Stack.GetString(PStart); StringChange(S, '/', '\'); SetStringsFromCommaString(StringList, S); - if Name = 'WIZARDSELECTCOMPONENTS' then + if OrgName = 'WizardSelectComponents' then GetWizardForm.SelectComponents(StringList) else GetWizardForm.SelectTasks(StringList); @@ -1635,108 +1635,108 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); StringList.Free; end; end); - RegisterScriptFunc('WizardSilent', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('WizardSilent', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, InstallMode <> imNormal); end); - RegisterScriptFunc('ISUNINSTALLER', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ISUNINSTALLER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, IsUninstaller); end); - RegisterScriptFunc('UninstallSilent', sfOnlyUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('UninstallSilent', sfOnlyUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, UninstallSilent); end); - RegisterScriptFunc('CurrentFilename', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CurrentFilename', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if CheckOrInstallCurrentFilename <> '' then Stack.SetString(PStart, CheckOrInstallCurrentFilename) else - InternalError('An attempt was made to call the "CurrentFilename" function from outside a "Check", "BeforeInstall" or "AfterInstall" event function belonging to a "[Files]" entry'); + InternalError(Format('An attempt was made to call the "%s" function from outside a "Check", "BeforeInstall" or "AfterInstall" event function belonging to a "[Files]" entry', [OrgName])); end); - RegisterScriptFunc('CurrentSourceFilename', sfNoUninstall, procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CurrentSourceFilename', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if CheckOrInstallCurrentSourceFilename <> '' then Stack.SetString(PStart, CheckOrInstallCurrentSourceFilename) else - InternalError('An attempt was made to call the "CurrentSourceFilename" function from outside a "Check", "BeforeInstall" or "AfterInstall" event function belonging to a "[Files]" entry with flag "external"'); + InternalError(Format('An attempt was made to call the "%s" function from outside a "Check", "BeforeInstall" or "AfterInstall" event function belonging to a "[Files]" entry with flag "external"', [OrgName])); end); - RegisterScriptFunc('CASTSTRINGTOINTEGER', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CASTSTRINGTOINTEGER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, Integer(PChar(Stack.GetString(PStart-1)))); end); - RegisterScriptFunc('CASTINTEGERTOSTRING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CASTINTEGERTOSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, String(PChar(Stack.GetInt(PStart-1)))); end); - RegisterScriptFunc('ABORT', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ABORT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Abort; end); - RegisterScriptFunc('GETEXCEPTIONMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETEXCEPTIONMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetString(PStart, GetExceptionMessage(Caller)); end); - RegisterScriptFunc('RAISEEXCEPTION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('RAISEEXCEPTION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin raise Exception.Create(Stack.GetString(PStart)); end); - RegisterScriptFunc('SHOWEXCEPTIONMESSAGE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SHOWEXCEPTIONMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin GetMainForm.ShowExceptionMsg(AddPeriod(GetExceptionMessage(Caller))); end); - RegisterScriptFunc('TERMINATED', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('TERMINATED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, Application.Terminated); end); - RegisterScriptFunc('GETPREVIOUSDATA', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETPREVIOUSDATA', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin if IsUninstaller then Stack.SetString(PStart, GetCodePreviousData(UninstallExpandedAppId, Stack.GetString(PStart-1), Stack.GetString(PStart-2))) else Stack.SetString(PStart, GetCodePreviousData(ExpandConst(SetupHeader.AppId), Stack.GetString(PStart-1), Stack.GetString(PStart-2))); end); - RegisterScriptFunc('SETPREVIOUSDATA', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SETPREVIOUSDATA', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, SetCodePreviousData(Stack.GetInt(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3))); end); - RegisterScriptFunc('LOADSTRINGFROMFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('LOADSTRINGFROMFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin AnsiS := Stack.GetAnsiString(PStart-2); Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), AnsiS, fsRead)); Stack.SetAnsiString(PStart-2, AnsiS); end); - RegisterScriptFunc('LOADSTRINGFROMLOCKEDFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('LOADSTRINGFROMLOCKEDFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin AnsiS := Stack.GetAnsiString(PStart-2); Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), AnsiS, fsReadWrite)); Stack.SetAnsiString(PStart-2, AnsiS); end); - RegisterScriptFunc('LOADSTRINGSFROMFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('LOADSTRINGSFROMFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, LoadStringsFromFile(Stack.GetString(PStart-1), Stack, PStart-2, fsRead)); end); - RegisterScriptFunc('LOADSTRINGSFROMLOCKEDFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('LOADSTRINGSFROMLOCKEDFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, LoadStringsFromFile(Stack.GetString(PStart-1), Stack, PStart-2, fsReadWrite)); end); - RegisterScriptFunc('SAVESTRINGTOFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SAVESTRINGTOFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, SaveStringToFile(Stack.GetString(PStart-1), Stack.GetAnsiString(PStart-2), Stack.GetBool(PStart-3))); end); - RegisterScriptFunc('SAVESTRINGSTOFILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SAVESTRINGSTOFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), False, False)); end); - RegisterScriptFunc('SAVESTRINGSTOUTF8FILE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SAVESTRINGSTOUTF8FILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), True, False)); end); - RegisterScriptFunc('SAVESTRINGSTOUTF8FILEWITHOUTBOM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('SAVESTRINGSTOUTF8FILEWITHOUTBOM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), True, True)); end); - RegisterScriptFunc('ENABLEFSREDIRECTION', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ENABLEFSREDIRECTION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, not ScriptFuncDisableFsRedir); if Stack.GetBool(PStart-1) then @@ -1747,47 +1747,47 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); ScriptFuncDisableFsRedir := True; end; end); - RegisterScriptFunc('GETUNINSTALLPROGRESSFORM', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('GETUNINSTALLPROGRESSFORM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetClass(PStart, GetUninstallProgressForm); end); - RegisterScriptFunc('CREATECALLBACK', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('CREATECALLBACK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetInt(PStart, CreateCallback(Caller, Stack.Items[PStart-1])); end); - RegisterScriptFunc('ISDOTNETINSTALLED', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ISDOTNETINSTALLED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, IsDotNetInstalled(InstallDefaultRegView, TDotNetVersion(Stack.GetInt(PStart-1)), Stack.GetInt(PStart-2))); end); - RegisterScriptFunc('ISMSIPRODUCTINSTALLED', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('ISMSIPRODUCTINSTALLED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, IsMsiProductInstalled(Stack.GetString(PStart-1), Stack.GetInt64(PStart-2), ErrorCode)); if ErrorCode <> 0 then raise Exception.Create(Win32ErrorString(ErrorCode)); end); - RegisterScriptFunc('INITIALIZEBITMAPIMAGEFROMICON', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('INITIALIZEBITMAPIMAGEFROMICON', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var AscendingTrySizes := Stack.GetIntArray(PStart-4); Stack.SetBool(PStart, TBitmapImage(Stack.GetClass(PStart-1)).InitializeFromIcon(0, PChar(Stack.GetString(PStart-2)), Stack.GetInt(PStart-3), AscendingTrySizes)); end); - RegisterScriptFunc('EXTRACT7ZIPARCHIVE', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('EXTRACT7ZIPARCHIVE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Extract7ZipArchive(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2), TOnExtractionProgress(Stack.GetProc(PStart-3, Caller))); end); - RegisterScriptFunc('DEBUGGING', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('DEBUGGING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin Stack.SetBool(PStart, Debugging); end); - RegisterScriptFunc('StringJoin', procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc('StringJoin', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var Values := Stack.GetStringArray(PStart-2); Stack.SetString(PStart, String.Join(Stack.GetString(PStart-1), Values)); end); - RegisterScriptFunc(['StringSplit', 'StringSplitEx'], procedure(const Caller: TPSExec; const Name: AnsiString; const Stack: TPSStack; const PStart: Cardinal) + RegisterScriptFunc(['StringSplit', 'StringSplitEx'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin var Separators := Stack.GetStringArray(PStart-2); var Parts: TArray; - if Name = 'STRINGSPLITEX' then begin + if OrgName = 'StringSplitEx' then begin var Quote := Stack.GetString(PStart-3)[1]; Parts := Stack.GetString(PStart-1).Split(Separators, Quote, Quote, TStringSplitOptions(Stack.GetInt(PStart-4))) end else From 9d8d78665355e77cc3082954095d7fb4859f4061 Mon Sep 17 00:00:00 2001 From: Martijn Laan <1092369+martijnlaan@users.noreply.github.com> Date: Mon, 18 Nov 2024 20:39:11 +0100 Subject: [PATCH 6/8] Cleanup variables. --- Projects/Src/Setup.ScriptFunc.HelperFunc.pas | 11 +- Projects/Src/Setup.ScriptFunc.pas | 339 ++++++++++--------- 2 files changed, 183 insertions(+), 167 deletions(-) diff --git a/Projects/Src/Setup.ScriptFunc.HelperFunc.pas b/Projects/Src/Setup.ScriptFunc.HelperFunc.pas index 8caf509a8..9e6eb68d4 100644 --- a/Projects/Src/Setup.ScriptFunc.HelperFunc.pas +++ b/Projects/Src/Setup.ScriptFunc.HelperFunc.pas @@ -53,6 +53,7 @@ procedure NoUninstallFuncError(const C: AnsiString); overload; procedure OnlyUninstallFuncError(const C: AnsiString); overload; function GetMainForm: TMainForm; function GetWizardForm: TWizardForm; +function GetWizardFormHandle: HWND; function GetUninstallProgressForm: TUninstallProgressForm; function GetMsgBoxCaption: String; procedure InitializeScaleBaseUnits; @@ -121,7 +122,15 @@ function GetWizardForm: TWizardForm; begin Result := WizardForm; if Result = nil then - InternalError('An attempt was made to access WizardForm before it has been created'); + InternalError('An attempt was made to access WizardForm before it has been created'); +end; + +function GetWizardFormHandle: HWND; +begin + if Assigned(WizardForm) then + Result := WizardForm.Handle + else + Result := 0; end; function GetUninstallProgressForm: TUninstallProgressForm; diff --git a/Projects/Src/Setup.ScriptFunc.pas b/Projects/Src/Setup.ScriptFunc.pas index fb5e0290f..d4a1d1c10 100644 --- a/Projects/Src/Setup.ScriptFunc.pas +++ b/Projects/Src/Setup.ScriptFunc.pas @@ -298,58 +298,37 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; procedure RegisterNewDiskFormScriptFuncs; - var - S: String; begin RegisterScriptFunc('SELECTDISK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - S := Stack.GetString(PStart-3); + var S := Stack.GetString(PStart-3); Stack.SetBool(PStart, SelectDisk(Stack.GetInt(PStart-1), Stack.GetString(PStart-2), S)); Stack.SetString(PStart-3, S); end); end; procedure RegisterBrowseFuncScriptFuncs; - var - S: String; - ParentWnd: HWND; begin RegisterScriptFunc('BROWSEFORFOLDER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if Assigned(WizardForm) then - ParentWnd := WizardForm.Handle - else - ParentWnd := 0; - S := Stack.GetString(PStart-2); - Stack.SetBool(PStart, BrowseForFolder(Stack.GetString(PStart-1), S, ParentWnd, Stack.GetBool(PStart-3))); + var S := Stack.GetString(PStart-2); + Stack.SetBool(PStart, BrowseForFolder(Stack.GetString(PStart-1), S, GetWizardFormHandle, Stack.GetBool(PStart-3))); Stack.SetString(PStart-2, S); end); RegisterScriptFunc('GETOPENFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if Assigned(WizardForm) then - ParentWnd := WizardForm.Handle - else - ParentWnd := 0; - S := Stack.GetString(PStart-2); - Stack.SetBool(PStart, NewGetOpenFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), ParentWnd)); + var S := Stack.GetString(PStart-2); + Stack.SetBool(PStart, NewGetOpenFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), GetWizardFormHandle)); Stack.SetString(PStart-2, S); end); RegisterScriptFunc('GETOPENFILENAMEMULTI', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if Assigned(WizardForm) then - ParentWnd := WizardForm.Handle - else - ParentWnd := 0; - Stack.SetBool(PStart, NewGetOpenFileNameMulti(Stack.GetString(PStart-1), TStrings(Stack.GetClass(PStart-2)), Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), ParentWnd)); + Stack.SetBool(PStart, NewGetOpenFileNameMulti(Stack.GetString(PStart-1), TStrings(Stack.GetClass(PStart-2)), Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), GetWizardFormHandle)); end); RegisterScriptFunc('GETSAVEFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - if Assigned(WizardForm) then - ParentWnd := WizardForm.Handle - else - ParentWnd := 0; - S := Stack.GetString(PStart-2); - Stack.SetBool(PStart, NewGetSaveFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), ParentWnd)); + var S := Stack.GetString(PStart-2); + Stack.SetBool(PStart, NewGetSaveFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), GetWizardFormHandle)); Stack.SetString(PStart-2, S); end); end; @@ -363,14 +342,6 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; procedure RegisterCommonFuncScriptFuncs; - var - ExistingFilename: String; - RegView: TRegView; - K, RootKey: HKEY; - S, N, V: String; - DataS: AnsiString; - Typ, ExistingTyp, Data, Size: DWORD; - I: Integer; begin RegisterScriptFunc('FILEEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -440,7 +411,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('PARAMSTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - I := Stack.GetInt(PStart-1); + var I := Stack.GetInt(PStart-1); if (I >= 0) and (I < NewParamsForCode.Count) then Stack.SetString(PStart, NewParamsForCode[I]) else @@ -492,13 +463,13 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('STRINGCHANGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - S := Stack.GetString(PStart-1); + var S := Stack.GetString(PStart-1); Stack.SetInt(PStart, StringChange(S, Stack.GetString(PStart-2), Stack.GetString(PStart-3))); Stack.SetString(PStart-1, S); end); RegisterScriptFunc('STRINGCHANGEEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - S := Stack.GetString(PStart-1); + var S := Stack.GetString(PStart-1); Stack.SetInt(PStart, StringChangeEx(S, Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetBool(PStart-4))); Stack.SetString(PStart-1, S); end); @@ -508,7 +479,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc(['COPYFILE', 'FILECOPY'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - ExistingFilename := Stack.GetString(PStart-1); + var ExistingFilename := Stack.GetString(PStart-1); if not IsProtectedSrcExe(ExistingFilename) then Stack.SetBool(PStart, CopyFileRedir(ScriptFuncDisableFsRedir, ExistingFilename, Stack.GetString(PStart-2), Stack.GetBool(PStart-3))) @@ -517,7 +488,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('CONVERTPERCENTSTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - S := Stack.GetString(PStart-1); + var S := Stack.GetString(PStart-1); Stack.SetBool(PStart, ConvertPercentStr(S)); Stack.SetString(PStart-1, S); end); @@ -526,8 +497,9 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); var RegView: TRegView; var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin + var SubKeyName := Stack.GetString(PStart-2); + var K: HKEY; + if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin Stack.SetBool(PStart, True); RegCloseKey(K); end else @@ -535,58 +507,75 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('REGVALUEEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - Stack.SetBool(PStart, RegValueExists(K, PChar(N))); + var SubKeyName := Stack.GetString(PStart-2); + var K: HKEY; + if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin + var ValueName := Stack.GetString(PStart-3); + Stack.SetBool(PStart, RegValueExists(K, PChar(ValueName))); RegCloseKey(K); end else Stack.SetBool(PStart, False); end); RegisterScriptFunc('REGDELETEKEYINCLUDINGSUBKEYS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - Stack.SetBool(PStart, RegDeleteKeyIncludingSubkeys(RegView, RootKey, PChar(S)) = ERROR_SUCCESS); + var SubKey := Stack.GetString(PStart-2); + Stack.SetBool(PStart, RegDeleteKeyIncludingSubkeys(RegView, RootKey, PChar(SubKey)) = ERROR_SUCCESS); end); RegisterScriptFunc('REGDELETEKEYIFEMPTY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - Stack.SetBool(PStart, RegDeleteKeyIfEmpty(RegView, RootKey, PChar(S)) = ERROR_SUCCESS); + var SubKeyName := Stack.GetString(PStart-2); + Stack.SetBool(PStart, RegDeleteKeyIfEmpty(RegView, RootKey, PChar(SubKeyName)) = ERROR_SUCCESS); end); RegisterScriptFunc('REGDELETEVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - Stack.SetBool(PStart, RegDeleteValue(K, PChar(N)) = ERROR_SUCCESS); + var SubKeyName := Stack.GetString(PStart-2); + var K: HKEY; + if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin + var ValueName := Stack.GetString(PStart-3); + Stack.SetBool(PStart, RegDeleteValue(K, PChar(ValueName)) = ERROR_SUCCESS); RegCloseKey(K); end else Stack.SetBool(PStart, False); end); RegisterScriptFunc('REGGETSUBKEYNAMES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey, Stack.GetString(PStart-2), Stack, PStart-3, True)); end); RegisterScriptFunc('REGGETVALUENAMES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey, Stack.GetString(PStart-2), Stack, PStart-3, False)); end); RegisterScriptFunc('REGQUERYSTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - S := Stack.GetString(PStart-4); - Stack.SetBool(PStart, RegQueryStringValue(K, PChar(N), S)); + var SubKeyName := Stack.GetString(PStart-2); + var K: HKEY; + if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin + var ValueName := Stack.GetString(PStart-3); + var S := Stack.GetString(PStart-4); + Stack.SetBool(PStart, RegQueryStringValue(K, PChar(ValueName), S)); Stack.SetString(PStart-4, S); RegCloseKey(K); end else @@ -594,12 +583,15 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('REGQUERYMULTISTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - S := Stack.GetString(PStart-4); - Stack.SetBool(PStart, RegQueryMultiStringValue(K, PChar(N), S)); + var SubKeyName := Stack.GetString(PStart-2); + var K: HKEY; + if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin + var ValueName := Stack.GetString(PStart-3); + var S := Stack.GetString(PStart-4); + Stack.SetBool(PStart, RegQueryMultiStringValue(K, PChar(ValueName), S)); Stack.SetString(PStart-4, S); RegCloseKey(K); end else @@ -607,12 +599,16 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('REGQUERYDWORDVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - Size := SizeOf(Data); - if (RegQueryValueEx(K, PChar(N), nil, @Typ, @Data, @Size) = ERROR_SUCCESS) and (Typ = REG_DWORD) then begin + var SubKeyName := Stack.GetString(PStart-2); + var K: HKEY; + if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin + var ValueName := Stack.GetString(PStart-3); + var Typ, Data: DWORD; + var Size: DWORD := SizeOf(Data); + if (RegQueryValueEx(K, PChar(ValueName), nil, @Typ, @Data, @Size) = ERROR_SUCCESS) and (Typ = REG_DWORD) then begin Stack.SetInt(PStart-4, Data); Stack.SetBool(PStart, True); end else @@ -623,14 +619,19 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('REGQUERYBINARYVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegOpenKeyExView(RegView, RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - if RegQueryValueEx(K, PChar(N), nil, @Typ, nil, @Size) = ERROR_SUCCESS then begin - SetLength(DataS, Size); - if RegQueryValueEx(K, PChar(N), nil, @Typ, @DataS[1], @Size) = ERROR_SUCCESS then begin - Stack.SetAnsiString(PStart-4, DataS); + var SubKeyName := Stack.GetString(PStart-2); + var K: HKEY; + if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin + var ValueName := Stack.GetString(PStart-3); + var Typ, Size: DWORD; + if RegQueryValueEx(K, PChar(ValueName), nil, @Typ, nil, @Size) = ERROR_SUCCESS then begin + var Data: AnsiString; + SetLength(Data, Size); + if RegQueryValueEx(K, PChar(ValueName), nil, @Typ, @Data[1], @Size) = ERROR_SUCCESS then begin + Stack.SetAnsiString(PStart-4, Data); Stack.SetBool(PStart, True); end else Stack.SetBool(PStart, False); @@ -642,16 +643,20 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('REGWRITESTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - V := Stack.GetString(PStart-4); - if (RegQueryValueEx(K, PChar(N), nil, @ExistingTyp, nil, nil) = ERROR_SUCCESS) and (ExistingTyp = REG_EXPAND_SZ) then + var SubKeyName := Stack.GetString(PStart-2); + var K: HKEY; + if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin + var ValueName := Stack.GetString(PStart-3); + var Data := Stack.GetString(PStart-4); + var Typ, ExistingTyp: DWORD; + if (RegQueryValueEx(K, PChar(ValueName), nil, @ExistingTyp, nil, nil) = ERROR_SUCCESS) and (ExistingTyp = REG_EXPAND_SZ) then Typ := REG_EXPAND_SZ else Typ := REG_SZ; - if RegSetValueEx(K, PChar(N), 0, Typ, PChar(V), (Length(V)+1)*SizeOf(V[1])) = ERROR_SUCCESS then + if RegSetValueEx(K, PChar(ValueName), 0, Typ, PChar(Data), (Length(Data)+1)*SizeOf(Data[1])) = ERROR_SUCCESS then Stack.SetBool(PStart, True) else Stack.SetBool(PStart, False); @@ -661,12 +666,15 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('REGWRITEEXPANDSTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - V := Stack.GetString(PStart-4); - if RegSetValueEx(K, PChar(N), 0, REG_EXPAND_SZ, PChar(V), (Length(V)+1)*SizeOf(V[1])) = ERROR_SUCCESS then + var SubKeyName := Stack.GetString(PStart-2); + var K: HKEY; + if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin + var ValueName := Stack.GetString(PStart-3); + var Data := Stack.GetString(PStart-4); + if RegSetValueEx(K, PChar(ValueName), 0, REG_EXPAND_SZ, PChar(Data), (Length(Data)+1)*SizeOf(Data[1])) = ERROR_SUCCESS then Stack.SetBool(PStart, True) else Stack.SetBool(PStart, False); @@ -676,18 +684,21 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('REGWRITEMULTISTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - V := Stack.GetString(PStart-4); + var SubKeyName := Stack.GetString(PStart-2); + var K: HKEY; + if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin + var ValueName := Stack.GetString(PStart-3); + var Data := Stack.GetString(PStart-4); { 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; - if RegSetValueEx(K, PChar(N), 0, REG_MULTI_SZ, PChar(V), (Length(V)+1)*SizeOf(V[1])) = ERROR_SUCCESS then + if (Data <> '') and (Data[Length(Data)] <> #0) then + Data := Data + #0; + if RegSetValueEx(K, PChar(ValueName), 0, REG_MULTI_SZ, PChar(Data), (Length(Data)+1)*SizeOf(Data[1])) = ERROR_SUCCESS then Stack.SetBool(PStart, True) else Stack.SetBool(PStart, False); @@ -697,12 +708,15 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('REGWRITEDWORDVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - Data := Stack.GetInt(PStart-4); - if RegSetValueEx(K, PChar(N), 0, REG_DWORD, @Data, SizeOf(Data)) = ERROR_SUCCESS then + var SubKeyName := Stack.GetString(PStart-2); + var K: HKEY; + if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin + var ValueName := Stack.GetString(PStart-3); + var Data: DWORD := Stack.GetInt(PStart-4); + if RegSetValueEx(K, PChar(ValueName), 0, REG_DWORD, @Data, SizeOf(Data)) = ERROR_SUCCESS then Stack.SetBool(PStart, True) else Stack.SetBool(PStart, False); @@ -712,12 +726,15 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('REGWRITEBINARYVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var RegView: TRegView; + var RootKey: HKEY; CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey); - S := Stack.GetString(PStart-2); - if RegCreateKeyExView(RegView, RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin - N := Stack.GetString(PStart-3); - DataS := Stack.GetAnsiString(PStart-4); - if RegSetValueEx(K, PChar(N), 0, REG_BINARY, @DataS[1], Length(DataS)) = ERROR_SUCCESS then + var SubKeyName := Stack.GetString(PStart-2); + var K: HKEY; + if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin + var ValueName := Stack.GetString(PStart-3); + var Data := Stack.GetAnsiString(PStart-4); + if RegSetValueEx(K, PChar(ValueName), 0, REG_BINARY, @Data[1], Length(Data)) = ERROR_SUCCESS then Stack.SetBool(PStart, True) else Stack.SetBool(PStart, False); @@ -763,8 +780,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('WILDCARDMATCH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - S := Stack.GetString(PStart-1); - N := Stack.GetString(PStart-2); + var S := Stack.GetString(PStart-1); + var N := Stack.GetString(PStart-2); Stack.SetBool(PStart, WildcardMatch(PChar(S), PChar(N))); end); end; @@ -798,11 +815,6 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; procedure RegisterInstFuncScriptFuncs; - var - Filename: String; - WindowDisabler: TWindowDisabler; - ResultCode, ErrorCode: Integer; - FreeBytes, TotalBytes: Integer64; begin RegisterScriptFunc('CHECKFORMUTEXES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -872,6 +884,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('GETSPACEONDISK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var FreeBytes, TotalBytes: Integer64; if GetSpaceOnDisk(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin if Stack.GetBool(PStart-2) then begin Div64(FreeBytes, 1024*1024); @@ -890,6 +903,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('GETSPACEONDISK64', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var FreeBytes, TotalBytes: Integer64; if GetSpaceOnDisk(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin Stack.SetInt64(PStart-2, Int64(FreeBytes.Hi) shl 32 + FreeBytes.Lo); Stack.SetInt64(PStart-3, Int64(TotalBytes.Hi) shl 32 + TotalBytes.Lo); @@ -931,11 +945,12 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); if (OutputReader <> nil) and (ExecWait <> ewWaitUntilTerminated) then InternalError(Format('Must call "%s" function with Wait = ewWaitUntilTerminated', [OrgName])); - Filename := Stack.GetString(PStart-1); + var Filename := Stack.GetString(PStart-1); if not IsProtectedSrcExe(Filename) then begin { Disable windows so the user can't utilize our UI during the InstExec call } - WindowDisabler := TWindowDisabler.Create; + var WindowDisabler := TWindowDisabler.Create; + var ResultCode: Integer; try Stack.SetBool(PStart, InstExecEx(RunAsOriginalUser, ScriptFuncDisableFsRedir, Filename, Stack.GetString(PStart-2), @@ -964,11 +979,12 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); var RunAsOriginalUser := OrgName = 'ShellExecAsOriginalUser'; if IsUninstaller and RunAsOriginalUser then NoUninstallFuncError(OrgName); - Filename := Stack.GetString(PStart-2); + var Filename := Stack.GetString(PStart-2); if not IsProtectedSrcExe(Filename) then begin { Disable windows so the user can't utilize our UI during the InstShellExec call } - WindowDisabler := TWindowDisabler.Create; + var WindowDisabler := TWindowDisabler.Create; + var ErrorCode: Integer; try Stack.SetBool(PStart, InstShellExecEx(RunAsOriginalUser, Stack.GetString(PStart-1), Filename, Stack.GetString(PStart-3), @@ -1058,12 +1074,6 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; procedure RegisterMainFuncScriptFuncs; - var - MinVersion, OnlyBelowVersion: TSetupVersionData; - StringList: TStringList; - S: String; - Components, Suppressible: Boolean; - Default: Integer; begin RegisterScriptFunc('ACTIVELANGUAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -1087,6 +1097,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('INSTALLONTHISVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var MinVersion, OnlyBelowVersion: TSetupVersionData; if not StrToSetupVersionData(Stack.GetString(PStart-1), MinVersion) then InternalError(Format('%s: Invalid MinVersion string', [OrgName])) else if not StrToSetupVersionData(Stack.GetString(PStart-2), OnlyBelowVersion) then @@ -1105,6 +1116,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc(['MsgBox', 'SuppressibleMsgBox'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var Suppressible: Boolean; + var Default: Integer; if OrgName = 'MsgBox' then begin Suppressible := False; Default := 0; @@ -1116,6 +1129,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc(['TaskDialogMsgBox', 'SuppressibleTaskDialogMsgBox'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var Suppressible: Boolean; + var Default: Integer; if OrgName = 'TaskDialogMsgBox' then begin Suppressible := False; Default := 0; @@ -1165,14 +1180,14 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc(['WizardIsComponentSelected', 'IsComponentSelected', 'WizardIsTaskSelected', 'IsTaskSelected'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - StringList := TStringList.Create; + var StringList := TStringList.Create; try - Components := (OrgName = 'WizardIsComponentSelected') or (OrgName = 'IsComponentSelected'); + var Components := (OrgName = 'WizardIsComponentSelected') or (OrgName = 'IsComponentSelected'); if Components then GetWizardForm.GetSelectedComponents(StringList, False, False) else GetWizardForm.GetSelectedTasks(StringList, False, False, False); - S := Stack.GetString(PStart-1); + var S := Stack.GetString(PStart-1); StringChange(S, '/', '\'); if Components then Stack.SetBool(PStart, ShouldProcessEntry(StringList, nil, S, '', '', '')) @@ -1193,9 +1208,6 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; procedure RegisterSystemScriptFuncs; - var - F: TFile; - TmpFileSize: Integer64; begin RegisterScriptFunc('RANDOM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -1204,7 +1216,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); RegisterScriptFunc('FILESIZE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin try - F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite); + var F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite); try Stack.SetInt(PStart-2, F.CappedSize); Stack.SetBool(PStart, True); @@ -1218,9 +1230,9 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); RegisterScriptFunc('FILESIZE64', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin try - F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite); + var F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite); try - TmpFileSize := F.Size; { Make sure we access F.Size only once } + var TmpFileSize := F.Size; { Make sure we access F.Size only once } Stack.SetInt64(PStart-2, Int64(TmpFileSize.Hi) shl 32 + TmpFileSize.Lo); Stack.SetBool(PStart, True); finally @@ -1249,10 +1261,6 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; procedure RegisterSysUtilsScriptFuncs; - var - OldName: String; - NewDateSeparator, NewTimeSeparator: Char; - OldDateSeparator, OldTimeSeparator: Char; begin RegisterScriptFunc('BEEP', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -1316,7 +1324,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('RENAMEFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - OldName := Stack.GetString(PStart-1); + var OldName := Stack.GetString(PStart-1); if not IsProtectedSrcExe(OldName) then Stack.SetBool(PStart, MoveFileRedir(ScriptFuncDisableFsRedir, OldName, Stack.GetString(PStart-2))) else @@ -1352,11 +1360,11 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('GETDATETIMESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - OldDateSeparator := FormatSettings.DateSeparator; - OldTimeSeparator := FormatSettings.TimeSeparator; + var OldDateSeparator := FormatSettings.DateSeparator; + var OldTimeSeparator := FormatSettings.TimeSeparator; try - NewDateSeparator := Stack.GetString(PStart-2)[1]; - NewTimeSeparator := Stack.GetString(PStart-3)[1]; + var NewDateSeparator := Stack.GetString(PStart-2)[1]; + var NewTimeSeparator := Stack.GetString(PStart-3)[1]; if NewDateSeparator <> #0 then FormatSettings.DateSeparator := NewDateSeparator; if NewTimeSeparator <> #0 then @@ -1374,11 +1382,10 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; procedure RegisterVerInfoFuncScriptFuncs; - var - VersionNumbers: TFileVersionNumbers; begin RegisterScriptFunc('GETVERSIONNUMBERS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var VersionNumbers: TFileVersionNumbers; if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin Stack.SetInt(PStart-2, VersionNumbers.MS); Stack.SetInt(PStart-3, VersionNumbers.LS); @@ -1388,6 +1395,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('GETVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var VersionNumbers: TFileVersionNumbers; if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin Stack.SetUInt(PStart-2, VersionNumbers.MS shr 16); Stack.SetUInt(PStart-3, VersionNumbers.MS and $FFFF); @@ -1399,6 +1407,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('GETVERSIONNUMBERSSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var VersionNumbers: TFileVersionNumbers; if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin Stack.SetString(PStart-2, Format('%u.%u.%u.%u', [VersionNumbers.MS shr 16, VersionNumbers.MS and $FFFF, VersionNumbers.LS shr 16, VersionNumbers.LS and $FFFF])); @@ -1408,6 +1417,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('GETPACKEDVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var VersionNumbers: TFileVersionNumbers; if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin Stack.SetInt64(PStart-2, (Int64(VersionNumbers.MS) shl 32) or VersionNumbers.LS); Stack.SetBool(PStart, True); @@ -1420,6 +1430,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('PACKVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var VersionNumbers: TFileVersionNumbers; VersionNumbers.MS := (Stack.GetUInt(PStart-1) shl 16) or (Stack.GetUInt(PStart-2) and $FFFF); VersionNumbers.LS := (Stack.GetUInt(PStart-3) shl 16) or (Stack.GetUInt(PStart-4) and $FFFF); Stack.SetInt64(PStart, Int64((UInt64(VersionNumbers.MS) shl 32) or VersionNumbers.LS)); @@ -1434,6 +1445,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('UNPACKVERSIONNUMBERS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var VersionNumbers: TFileVersionNumbers; VersionNumbers.MS := UInt64(Stack.GetInt64(PStart)) shr 32; VersionNumbers.LS := UInt64(Stack.GetInt64(PStart)) and $FFFFFFFF; Stack.SetUInt(PStart-1, VersionNumbers.MS); @@ -1441,6 +1453,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('UNPACKVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var VersionNumbers: TFileVersionNumbers; VersionNumbers.MS := UInt64(Stack.GetInt64(PStart)) shr 32; VersionNumbers.LS := UInt64(Stack.GetInt64(PStart)) and $FFFFFFFF; Stack.SetUInt(PStart-1, VersionNumbers.MS shr 16); @@ -1450,6 +1463,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('VERSIONTOSTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var VersionNumbers: TFileVersionNumbers; VersionNumbers.MS := UInt64(Stack.GetInt64(PStart-1)) shr 32; VersionNumbers.LS := UInt64(Stack.GetInt64(PStart-1)) and $FFFFFFFF; Stack.SetString(PStart, Format('%u.%u.%u.%u', [VersionNumbers.MS shr 16, @@ -1457,6 +1471,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('STRTOVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var VersionNumbers: TFileVersionNumbers; if StrToVersionNumbers(Stack.GetString(PStart-1), VersionNumbers) then begin Stack.SetInt64(PStart-2, (Int64(VersionNumbers.MS) shl 32) or VersionNumbers.LS); Stack.SetBool(PStart, True); @@ -1469,10 +1484,6 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); TDllProc = function(const Param1, Param2: Longint): Longint; stdcall; procedure RegisterWindowsScriptFuncs; - var - DllProc: TDllProc; - DllHandle: THandle; - S: AnsiString; begin RegisterScriptFunc('SLEEP', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -1516,7 +1527,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('LOADDLL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - DllHandle := SafeLoadLibrary(Stack.GetString(PStart-1), SEM_NOOPENFILEERRORBOX); + var DllHandle := SafeLoadLibrary(Stack.GetString(PStart-1), SEM_NOOPENFILEERRORBOX); if DllHandle <> 0 then Stack.SetInt(PStart-2, 0) else @@ -1525,6 +1536,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('CALLDLLPROC', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var DllProc: TDllProc; @DllProc := GetProcAddress(Stack.GetInt(PStart-1), PChar(Stack.GetString(PStart-2))); if Assigned(DllProc) then begin Stack.SetInt(PStart-5, DllProc(Stack.GetInt(PStart-3), Stack.GetInt(PStart-4))); @@ -1542,13 +1554,13 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('OEMTOCHARBUFF', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - S := Stack.GetAnsiString(PStart); + var S := Stack.GetAnsiString(PStart); OemToCharBuffA(PAnsiChar(S), PAnsiChar(S), Length(S)); Stack.SetAnsiString(PStart, S); end); RegisterScriptFunc('CHARTOOEMBUFF', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - S := Stack.GetAnsiString(PStart); + var S := Stack.GetAnsiString(PStart); CharToOemBuffA(PAnsiChar(S), PAnsiChar(S), Length(S)); Stack.SetAnsiString(PStart, S); end); @@ -1571,12 +1583,6 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end; procedure RegisterOtherScriptFuncs; - var - TypeEntry: PSetupTypeEntry; - StringList: TStringList; - S: String; - AnsiS: AnsiString; - ErrorCode: Cardinal; begin RegisterScriptFunc('BRINGTOFRONTANDRESTORE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -1597,7 +1603,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('WizardSetupType', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - TypeEntry := GetWizardForm.GetSetupType; + var TypeEntry := GetWizardForm.GetSetupType; if TypeEntry <> nil then begin if Stack.GetBool(PStart-1) then Stack.SetString(PStart, TypeEntry.Description) @@ -1609,7 +1615,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc(['WizardSelectedComponents', 'WizardSelectedTasks'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - StringList := TStringList.Create; + var StringList := TStringList.Create; try if OrgName = 'WizardSelectedComponents' then GetWizardForm.GetSelectedComponents(StringList, Stack.GetBool(PStart-1), False) @@ -1622,9 +1628,9 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc(['WizardSelectComponents', 'WizardSelectTasks'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - StringList := TStringList.Create; + var StringList := TStringList.Create; try - S := Stack.GetString(PStart); + var S := Stack.GetString(PStart); StringChange(S, '/', '\'); SetStringsFromCommaString(StringList, S); if OrgName = 'WizardSelectComponents' then @@ -1702,15 +1708,15 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('LOADSTRINGFROMFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - AnsiS := Stack.GetAnsiString(PStart-2); - Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), AnsiS, fsRead)); - Stack.SetAnsiString(PStart-2, AnsiS); + var S := Stack.GetAnsiString(PStart-2); + Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), S, fsRead)); + Stack.SetAnsiString(PStart-2, S); end); RegisterScriptFunc('LOADSTRINGFROMLOCKEDFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin - AnsiS := Stack.GetAnsiString(PStart-2); - Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), AnsiS, fsReadWrite)); - Stack.SetAnsiString(PStart-2, AnsiS); + var S := Stack.GetAnsiString(PStart-2); + Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), S, fsReadWrite)); + Stack.SetAnsiString(PStart-2, S); end); RegisterScriptFunc('LOADSTRINGSFROMFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin @@ -1761,6 +1767,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); end); RegisterScriptFunc('ISMSIPRODUCTINSTALLED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal) begin + var ErrorCode: Cardinal; Stack.SetBool(PStart, IsMsiProductInstalled(Stack.GetString(PStart-1), Stack.GetInt64(PStart-2), ErrorCode)); if ErrorCode <> 0 then raise Exception.Create(Win32ErrorString(ErrorCode)); From ca8bbd69bc94c2518793f8b522690deb27295ba4 Mon Sep 17 00:00:00 2001 From: Martijn Laan <1092369+martijnlaan@users.noreply.github.com> Date: Mon, 18 Nov 2024 20:43:56 +0100 Subject: [PATCH 7/8] Another cleanup. --- Projects/Src/Setup.ScriptFunc.pas | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/Projects/Src/Setup.ScriptFunc.pas b/Projects/Src/Setup.ScriptFunc.pas index d4a1d1c10..1b121d956 100644 --- a/Projects/Src/Setup.ScriptFunc.pas +++ b/Projects/Src/Setup.ScriptFunc.pas @@ -42,6 +42,7 @@ TScriptFuncEx = record ScriptFunc: TScriptFunc; Typ: TScriptFuncTyp; constructor Create(const AOrgName: AnsiString; const AScriptFunc: TScriptFunc; const ATyp: TScriptFuncTyp); + procedure Run(const Caller: TPSExec; const Stack: TPSStack); end; TScriptFuncs = TDictionary; @@ -56,19 +57,23 @@ constructor TScriptFuncEx.Create(const AOrgName: AnsiString; const AScriptFunc: Typ := ATyp; end; +procedure TScriptFuncEx.Run(const Caller: TPSExec; const Stack: TPSStack); +begin + if (Typ = sfNoUninstall) and IsUninstaller then + NoUninstallFuncError(OrgName) + else if (Typ = sfOnlyUninstall) and not IsUninstaller then + OnlyUninstallFuncError(OrgName) + else + ScriptFunc(Caller, OrgName, Stack, Stack.Count-1); +end; + { Called by ROPS } function ScriptFuncPSProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; begin var ScriptFuncEx: TScriptFuncEx; Result := ScriptFuncs.TryGetValue(Proc.Name, ScriptFuncEx); - if Result then begin - if (ScriptFuncEx.Typ = sfNoUninstall) and IsUninstaller then - NoUninstallFuncError(ScriptFuncEx.OrgName) - else if (ScriptFuncEx.Typ = sfOnlyUninstall) and not IsUninstaller then - OnlyUninstallFuncError(ScriptFuncEx.OrgName) - else - ScriptFuncEx.ScriptFunc(Caller, ScriptFuncEx.OrgName, Stack, Stack.Count-1); - end; + if Result then + ScriptFuncEx.Run(Caller, Stack); end; procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); From 0e8c3331f96a08c7d090845127f91943dd9f9a74 Mon Sep 17 00:00:00 2001 From: Martijn Laan <1092369+martijnlaan@users.noreply.github.com> Date: Tue, 19 Nov 2024 19:16:24 +0100 Subject: [PATCH 8/8] Cleanup. --- Components/PSStackHelper.pas | 17 +++++++++++++---- Projects/Src/Setup.ScriptFunc.pas | 6 +++--- 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/Components/PSStackHelper.pas b/Components/PSStackHelper.pas index 6a37fbe23..a3a2ed38e 100644 --- a/Components/PSStackHelper.pas +++ b/Components/PSStackHelper.pas @@ -35,6 +35,7 @@ TArrayEnumerator = record function HasNext: Boolean; function Next: String; end; + function GetChar(const ItemNo: Longint): Char; function GetIntArray(const ItemNo: Longint; const FieldNo: Longint = -1): TArrayOfInteger; function GetProc(const ItemNo: Longint; const Exec: TPSExec): TMethod; function GetStringArray(const ItemNo: Longint; const FieldNo: Longint = -1): TArrayOfString; @@ -67,6 +68,15 @@ function TPSStackHelper.SetArray(const ItemNo, FieldNo: Longint; PSDynArraySetLength(Pointer(Result.Dta^), Result.aType, N); end; +function TPSStackHelper.GetChar(const ItemNo: Longint): Char; +begin + var S := GetString(ItemNo); + if S <> '' then + Result := S[1] + else + Result := #0; +end; + function TPSStackHelper.GetIntArray(const ItemNo, FieldNo: Longint): TArrayOfInteger; begin var N: Integer; @@ -141,12 +151,11 @@ procedure TPSStackHelper.SetArray(const ItemNo: Longint; const Data: TStrings; c procedure TPSStackHelper.SetInt(const ItemNo: Longint; const Data: Integer; const FieldNo: Longint); begin - if FieldNo = -1 then - inherited SetInt(ItemNo, Data) - else begin + if FieldNo >= 0 then begin var PSVariantIFC := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo); VNSetInt(PSVariantIFC, Data); - end; + end else + inherited SetInt(ItemNo, Data) end; end. \ No newline at end of file diff --git a/Projects/Src/Setup.ScriptFunc.pas b/Projects/Src/Setup.ScriptFunc.pas index 1b121d956..2b668af14 100644 --- a/Projects/Src/Setup.ScriptFunc.pas +++ b/Projects/Src/Setup.ScriptFunc.pas @@ -1368,8 +1368,8 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); var OldDateSeparator := FormatSettings.DateSeparator; var OldTimeSeparator := FormatSettings.TimeSeparator; try - var NewDateSeparator := Stack.GetString(PStart-2)[1]; - var NewTimeSeparator := Stack.GetString(PStart-3)[1]; + var NewDateSeparator := Stack.GetChar(PStart-2); + var NewTimeSeparator := Stack.GetChar(PStart-3); if NewDateSeparator <> #0 then FormatSettings.DateSeparator := NewDateSeparator; if NewTimeSeparator <> #0 then @@ -1800,7 +1800,7 @@ procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec); var Separators := Stack.GetStringArray(PStart-2); var Parts: TArray; if OrgName = 'StringSplitEx' then begin - var Quote := Stack.GetString(PStart-3)[1]; + var Quote := Stack.GetChar(PStart-3); Parts := Stack.GetString(PStart-1).Split(Separators, Quote, Quote, TStringSplitOptions(Stack.GetInt(PStart-4))) end else Parts := Stack.GetString(PStart-1).Split(Separators, TStringSplitOptions(Stack.GetInt(PStart-3)));