2024-08-03 20:33:25 +02:00
unit Setup. ScriptFunc;
2011-10-06 20:53:09 +02:00
{
Inno Setup
2025-01-12 02:29:33 -06:00
Copyright ( C) 1 9 9 7 - 2 0 2 5 Jordan Russell
2011-10-06 20:53:09 +02:00
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE. TXT.
2024-07-04 08:57:36 +02:00
Script support functions ( run time - used by Setup)
2011-10-06 20:53:09 +02:00
}
interface
uses
uPSRuntime;
procedure ScriptFuncLibraryRegister_R( ScriptInterpreter: TPSExec) ;
implementation
uses
2024-11-18 19:44:49 +01:00
Windows,
Forms, SysUtils, Classes, Graphics, ActiveX, Generics. Collections,
2025-05-12 20:46:02 +02:00
uPSUtils, PathFunc, ISSigFunc, ECDSA, BrowseFunc, MD5, SHA1, SHA256, BitmapImage, PSStackHelper,
2024-11-18 19:44:49 +01:00
Shared. Struct, Setup. ScriptDlg, Setup. MainFunc, Shared. CommonFunc. Vcl,
2024-08-06 13:54:25 +02:00
Shared. CommonFunc, Shared. FileClass, SetupLdrAndSetup. RedirFunc,
2024-09-27 16:07:30 +02:00
Setup. Install, SetupLdrAndSetup. InstFunc, Setup. InstFunc, Setup. InstFunc. Ole,
SetupLdrAndSetup. Messages, Shared. SetupMessageIDs, Setup. NewDiskForm,
2024-11-18 19:44:49 +01:00
Setup. WizardForm, Shared. VerInfoFunc, Shared. SetupTypes,
2024-09-27 16:07:30 +02:00
Shared. Int64Em, Setup. LoggingFunc, Setup. SetupForm, Setup. RegDLL, Setup. Helper ,
2025-02-06 18:24:50 +01:00
Setup. SpawnClient, Setup. DotNetFunc, Setup. MainForm,
2025-05-24 14:24:23 +02:00
Shared. DotNetVersion, Setup. MsiFunc, Compression. SevenZipDecoder, Compression. SevenZipDLLDecoder,
2024-11-18 19:44:49 +01:00
Setup. DebugClient, Shared. ScriptFunc, Setup. ScriptFunc. HelperFunc;
2024-11-17 19:29:17 +01:00
type
2024-11-18 19:59:06 +01:00
TScriptFunc = reference to procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal ) ;
2024-11-18 19:44:49 +01:00
2024-11-17 22:22:16 +01:00
TScriptFuncTyp = ( sfNormal, sfNoUninstall, sfOnlyUninstall) ;
2024-11-18 19:44:49 +01:00
2024-11-17 22:22:16 +01:00
TScriptFuncEx = record
OrgName: AnsiString ;
ScriptFunc: TScriptFunc;
Typ: TScriptFuncTyp;
constructor Create( const AOrgName: AnsiString ; const AScriptFunc: TScriptFunc; const ATyp: TScriptFuncTyp) ;
2024-11-18 20:43:56 +01:00
procedure Run( const Caller: TPSExec; const Stack: TPSStack) ;
2024-11-17 22:22:16 +01:00
end ;
2024-11-18 19:44:49 +01:00
2024-11-17 22:22:16 +01:00
TScriptFuncs = TDictionary< AnsiString , TScriptFuncEx> ;
2018-12-16 17:35:49 +01:00
var
2024-11-17 19:29:17 +01:00
ScriptFuncs: TScriptFuncs;
2018-12-16 17:35:49 +01:00
2024-11-17 22:22:16 +01:00
constructor TScriptFuncEx. Create( const AOrgName: AnsiString ; const AScriptFunc: TScriptFunc; const ATyp: TScriptFuncTyp) ;
begin
OrgName : = AOrgName;
ScriptFunc : = AScriptFunc;
Typ : = ATyp;
end ;
2024-11-18 20:43:56 +01:00
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 ;
2024-11-18 19:44:49 +01:00
{ Called by ROPS }
2024-11-17 19:29:17 +01:00
function ScriptFuncPSProc( Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack) : Boolean ;
begin
2024-11-17 22:22:16 +01:00
var ScriptFuncEx: TScriptFuncEx;
Result : = ScriptFuncs. TryGetValue( Proc. Name , ScriptFuncEx) ;
2024-11-18 20:43:56 +01:00
if Result then
ScriptFuncEx. Run( Caller, Stack) ;
2024-11-17 19:29:17 +01:00
end ;
2011-10-06 20:53:09 +02:00
2024-11-17 19:29:17 +01:00
procedure ScriptFuncLibraryRegister_R( ScriptInterpreter: TPSExec) ;
{$IFDEF DEBUG}
var
Count: Integer ;
{$ENDIF}
2011-10-06 20:53:09 +02:00
2024-11-17 22:22:16 +01:00
procedure RegisterScriptFunc( const Name : AnsiString ; const ScriptFuncTyp: TScriptFuncTyp; const ScriptFunc: TScriptFunc) ; overload ;
2011-10-06 20:53:09 +02:00
begin
2024-11-17 22:22:16 +01:00
var ScriptFuncEx: TScriptFuncEx;
ScriptFuncs. Add( FastUpperCase( Name ) , TScriptFuncEx. Create( Name , ScriptFunc, ScriptFuncTyp) ) ;
2024-11-17 19:29:17 +01:00
ScriptInterpreter. RegisterFunctionName( Name , ScriptFuncPSProc, nil , nil ) ;
{$IFDEF DEBUG}
Inc( Count) ;
{$ENDIF}
2011-10-06 20:53:09 +02:00
end ;
2024-11-18 19:44:49 +01:00
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 ;
2024-11-17 22:22:16 +01:00
procedure RegisterScriptFunc( const Name : AnsiString ; const ScriptFunc: TScriptFunc) ; overload ;
begin
RegisterScriptFunc( Name , sfNormal, ScriptFunc) ;
end ;
2024-11-17 19:29:17 +01:00
procedure RegisterScriptFunc( const Names: array of AnsiString ; const ScriptFunc: TScriptFunc) ; overload ;
2011-10-06 20:53:09 +02:00
begin
2024-11-17 19:29:17 +01:00
for var Name in Names do
RegisterScriptFunc( Name , ScriptFunc) ;
2011-10-06 20:53:09 +02:00
end ;
2024-11-17 19:29:17 +01:00
procedure RegisterScriptDlgScriptFuncs;
2011-10-06 20:53:09 +02:00
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'PageFromID' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetClass( PStart, GetWizardForm. PageFromID( Stack. GetInt( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'PageIndexFromID' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, GetWizardForm. PageIndexFromID( Stack. GetInt( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CreateCustomPage' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
var NewPage : = TWizardPage. Create( GetWizardForm) ;
2011-10-06 20:53:09 +02:00
try
2024-11-17 19:29:17 +01:00
NewPage. Caption : = Stack. GetString( PStart- 2 ) ;
NewPage. Description : = Stack. GetString( PStart- 3 ) ;
GetWizardForm. AddPage( NewPage, Stack. GetInt( PStart- 1 ) ) ;
except
NewPage. Free;
raise ;
2011-10-06 20:53:09 +02:00
end ;
2024-11-17 19:29:17 +01:00
Stack. SetClass( PStart, NewPage) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CreateInputQueryPage' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CreateInputOptionPage' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CreateInputDirPage' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CreateInputFilePage' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CreateOutputMsgPage' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CreateOutputMsgMemoPage' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CreateOutputProgressPage' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CreateOutputMarqueeProgressPage' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CreateDownloadPage' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 22:22:16 +01:00
begin ;
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CreateExtractionPage' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SCALEX' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
InitializeScaleBaseUnits;
Stack. SetInt( PStart, MulDiv( Stack. GetInt( PStart- 1 ) , ScaleBaseUnitX, OrigBaseUnitX) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SCALEY' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
InitializeScaleBaseUnits;
Stack. SetInt( PStart, MulDiv( Stack. GetInt( PStart- 1 ) , ScaleBaseUnitY, OrigBaseUnitY) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CREATECUSTOMFORM' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
var NewSetupForm : = TSetupForm. CreateNew( nil ) ;
try
2025-01-12 02:29:33 -06:00
NewSetupForm. PopupMode : = pmAuto;
2024-11-17 19:29:17 +01:00
NewSetupForm. AutoScroll : = False ;
NewSetupForm. BorderStyle : = bsDialog;
NewSetupForm. InitializeFont;
except
NewSetupForm. Free;
raise ;
end ;
Stack. SetClass( PStart, NewSetupForm) ;
end ) ;
2011-10-06 20:53:09 +02:00
end ;
2024-11-17 19:29:17 +01:00
procedure RegisterNewDiskFormScriptFuncs;
2011-10-06 20:53:09 +02:00
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SELECTDISK' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var S : = Stack. GetString( PStart- 3 ) ;
2024-11-17 19:29:17 +01:00
Stack. SetBool( PStart, SelectDisk( Stack. GetInt( PStart- 1 ) , Stack. GetString( PStart- 2 ) , S) ) ;
Stack. SetString( PStart- 3 , S) ;
end ) ;
2011-10-06 20:53:09 +02:00
end ;
2024-11-17 19:29:17 +01:00
procedure RegisterBrowseFuncScriptFuncs;
2011-10-06 20:53:09 +02:00
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'BROWSEFORFOLDER' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var S : = Stack. GetString( PStart- 2 ) ;
2024-12-22 03:18:48 -06:00
Stack. SetBool( PStart, BrowseForFolder( Stack. GetString( PStart- 1 ) , S, GetOwnerWndForMessageBox, Stack. GetBool( PStart- 3 ) ) ) ;
2024-11-17 19:29:17 +01:00
Stack. SetString( PStart- 2 , S) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETOPENFILENAME' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var S : = Stack. GetString( PStart- 2 ) ;
2024-12-22 03:18:48 -06:00
Stack. SetBool( PStart, NewGetOpenFileName( Stack. GetString( PStart- 1 ) , S, Stack. GetString( PStart- 3 ) , Stack. GetString( PStart- 4 ) , Stack. GetString( PStart- 5 ) , GetOwnerWndForMessageBox) ) ;
2024-11-17 19:29:17 +01:00
Stack. SetString( PStart- 2 , S) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETOPENFILENAMEMULTI' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-12-22 03:18:48 -06:00
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 ) , GetOwnerWndForMessageBox) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSAVEFILENAME' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var S : = Stack. GetString( PStart- 2 ) ;
2024-12-22 03:18:48 -06:00
Stack. SetBool( PStart, NewGetSaveFileName( Stack. GetString( PStart- 1 ) , S, Stack. GetString( PStart- 3 ) , Stack. GetString( PStart- 4 ) , Stack. GetString( PStart- 5 ) , GetOwnerWndForMessageBox) ) ;
2024-11-17 19:29:17 +01:00
Stack. SetString( PStart- 2 , S) ;
end ) ;
end ;
procedure RegisterCommonFuncVclScriptFuncs;
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'MINIMIZEPATHNAME' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, MinimizePathName( Stack. GetString( PStart- 1 ) , TFont( Stack. GetClass( PStart- 2 ) ) , Stack. GetInt( PStart- 3 ) ) ) ;
end ) ;
end ;
procedure RegisterCommonFuncScriptFuncs;
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'FILEEXISTS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, NewFileExistsRedir( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'DIREXISTS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, DirExistsRedir( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'FILEORDIREXISTS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, FileOrDirExistsRedir( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETINISTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, GetIniString( Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) , Stack. GetString( PStart- 3 ) , Stack. GetString( PStart- 4 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETINIINT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETINIBOOL' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, GetIniBool( Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) , Stack. GetBool( PStart- 3 ) , Stack. GetString( PStart- 4 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'INIKEYEXISTS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, IniKeyExists( Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) , Stack. GetString( PStart- 3 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ISINISECTIONEMPTY' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, IsIniSectionEmpty( Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SETINISTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, SetIniString( Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) , Stack. GetString( PStart- 3 ) , Stack. GetString( PStart- 4 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SETINIINT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, SetIniInt( Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) , Stack. GetInt( PStart- 3 ) , Stack. GetString( PStart- 4 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SETINIBOOL' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, SetIniBool( Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) , Stack. GetBool( PStart- 3 ) , Stack. GetString( PStart- 4 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'DELETEINIENTRY' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
DeleteIniEntry( Stack. GetString( PStart) , Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'DELETEINISECTION' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
DeleteIniSection( Stack. GetString( PStart) , Stack. GetString( PStart- 1 ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETENV' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, GetEnv( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETCMDTAIL' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:44:49 +01:00
Stack. SetString( PStart, GetCmdTail) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'PARAMCOUNT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
if NewParamsForCode. Count = 0 then
InternalError( 'NewParamsForCode not set' ) ;
Stack. SetInt( PStart, NewParamsForCode. Count- 1 ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'PARAMSTR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var I : = Stack. GetInt( PStart- 1 ) ;
2024-11-17 19:29:17 +01:00
if ( I > = 0 ) and ( I < NewParamsForCode. Count) then
Stack. SetString( PStart, NewParamsForCode[ I] )
else
Stack. SetString( PStart, '' ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ADDBACKSLASH' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, AddBackslash( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REMOVEBACKSLASH' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, RemoveBackslash( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REMOVEBACKSLASHUNLESSROOT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, RemoveBackslashUnlessRoot( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ADDQUOTES' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, AddQuotes( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REMOVEQUOTES' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, RemoveQuotes( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSHORTNAME' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, GetShortNameRedir( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETWINDIR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:44:49 +01:00
Stack. SetString( PStart, GetWinDir) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSYSTEMDIR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:44:49 +01:00
Stack. SetString( PStart, GetSystemDir) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSYSWOW64DIR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:44:49 +01:00
Stack. SetString( PStart, GetSysWow64Dir) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSYSNATIVEDIR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, GetSysNativeDir( IsWin64) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETTEMPDIR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:44:49 +01:00
Stack. SetString( PStart, GetTempDir) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'STRINGCHANGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var S : = Stack. GetString( PStart- 1 ) ;
2024-11-17 19:29:17 +01:00
Stack. SetInt( PStart, StringChange( S, Stack. GetString( PStart- 2 ) , Stack. GetString( PStart- 3 ) ) ) ;
Stack. SetString( PStart- 1 , S) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'STRINGCHANGEEX' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var S : = Stack. GetString( PStart- 1 ) ;
2024-11-17 19:29:17 +01:00
Stack. SetInt( PStart, StringChangeEx( S, Stack. GetString( PStart- 2 ) , Stack. GetString( PStart- 3 ) , Stack. GetBool( PStart- 4 ) ) ) ;
Stack. SetString( PStart- 1 , S) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'USINGWINNT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, True ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( [ 'COPYFILE' , 'FILECOPY' ] , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var ExistingFilename : = Stack. GetString( PStart- 1 ) ;
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CONVERTPERCENTSTR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var S : = Stack. GetString( PStart- 1 ) ;
2024-11-17 19:29:17 +01:00
Stack. SetBool( PStart, ConvertPercentStr( S) ) ;
Stack. SetString( PStart- 1 , S) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGKEYEXISTS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
var RegView: TRegView;
var RootKey: HKEY;
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
var SubKeyName : = Stack. GetString( PStart- 2 ) ;
var K: HKEY;
if RegOpenKeyExView( RegView, RootKey, PChar( SubKeyName) , 0 , KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
2024-11-17 19:29:17 +01:00
Stack. SetBool( PStart, True ) ;
RegCloseKey( K) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGVALUEEXISTS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
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) ) ) ;
2024-11-17 19:29:17 +01:00
RegCloseKey( K) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGDELETEKEYINCLUDINGSUBKEYS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
var SubKey : = Stack. GetString( PStart- 2 ) ;
Stack. SetBool( PStart, RegDeleteKeyIncludingSubkeys( RegView, RootKey, PChar( SubKey) ) = ERROR_SUCCESS) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGDELETEKEYIFEMPTY' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
var SubKeyName : = Stack. GetString( PStart- 2 ) ;
Stack. SetBool( PStart, RegDeleteKeyIfEmpty( RegView, RootKey, PChar( SubKeyName) ) = ERROR_SUCCESS) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGDELETEVALUE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
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) ;
2024-11-17 19:29:17 +01:00
RegCloseKey( K) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGGETSUBKEYNAMES' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
Stack. SetBool( PStart, GetSubkeyOrValueNames( RegView, RootKey,
Stack. GetString( PStart- 2 ) , Stack, PStart- 3 , True ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGGETVALUENAMES' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
Stack. SetBool( PStart, GetSubkeyOrValueNames( RegView, RootKey,
Stack. GetString( PStart- 2 ) , Stack, PStart- 3 , False ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGQUERYSTRINGVALUE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
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) ) ;
2024-11-17 19:29:17 +01:00
Stack. SetString( PStart- 4 , S) ;
RegCloseKey( K) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGQUERYMULTISTRINGVALUE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
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) ) ;
2024-11-17 19:29:17 +01:00
Stack. SetString( PStart- 4 , S) ;
RegCloseKey( K) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGQUERYDWORDVALUE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
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
2024-11-17 19:29:17 +01:00
Stack. SetInt( PStart- 4 , Data) ;
Stack. SetBool( PStart, True ) ;
end else
Stack. SetBool( PStart, False ) ;
RegCloseKey( K) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGQUERYBINARYVALUE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
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) ;
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGWRITESTRINGVALUE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
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
2024-11-17 19:29:17 +01:00
Typ : = REG_EXPAND_SZ
else
Typ : = REG_SZ;
2024-11-18 20:39:11 +01:00
if RegSetValueEx( K, PChar( ValueName) , 0 , Typ, PChar( Data) , ( Length( Data) + 1 ) * SizeOf( Data[ 1 ] ) ) = ERROR_SUCCESS then
2024-11-17 19:29:17 +01:00
Stack. SetBool( PStart, True )
else
Stack. SetBool( PStart, False ) ;
RegCloseKey( K) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGWRITEEXPANDSTRINGVALUE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
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
2024-11-17 19:29:17 +01:00
Stack. SetBool( PStart, True )
else
Stack. SetBool( PStart, False ) ;
RegCloseKey( K) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGWRITEMULTISTRINGVALUE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
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 ) ;
2024-11-17 19:29:17 +01:00
{ 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 . }
2024-11-18 20:39:11 +01:00
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
2024-11-17 19:29:17 +01:00
Stack. SetBool( PStart, True )
else
Stack. SetBool( PStart, False ) ;
RegCloseKey( K) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGWRITEDWORDVALUE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
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
2024-11-17 19:29:17 +01:00
Stack. SetBool( PStart, True )
else
Stack. SetBool( PStart, False ) ;
RegCloseKey( K) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGWRITEBINARYVALUE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var RegView: TRegView;
var RootKey: HKEY;
2024-11-17 19:29:17 +01:00
CrackCodeRootKey( Stack. GetInt( PStart- 1 ) , RegView, RootKey) ;
2024-11-18 20:39:11 +01:00
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
2024-11-17 19:29:17 +01:00
Stack. SetBool( PStart, True )
else
Stack. SetBool( PStart, False ) ;
RegCloseKey( K) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( [ 'ISADMIN' , 'ISADMINLOGGEDON' ] , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, IsAdmin) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ISPOWERUSERLOGGEDON' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:44:49 +01:00
Stack. SetBool( PStart, IsPowerUserLoggedOn) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFUnc( 'ISADMININSTALLMODE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, IsAdminInstallMode) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'FONTEXISTS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, FontExists( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETUILANGUAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, GetUILanguage) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ADDPERIOD' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, AddPeriod( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CHARLENGTH' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, PathCharLength( Stack. GetString( PStart- 1 ) , Stack. GetInt( PStart- 2 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SETNTFSCOMPRESSION' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, SetNTFSCompressionRedir( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) , Stack. GetBool( PStart- 2 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ISWILDCARD' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, IsWildcard( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'WILDCARDMATCH' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var S : = Stack. GetString( PStart- 1 ) ;
var N : = Stack. GetString( PStart- 2 ) ;
2024-11-17 19:29:17 +01:00
Stack. SetBool( PStart, WildcardMatch( PChar( S) , PChar( N) ) ) ;
end ) ;
end ;
procedure RegisterInstallScriptFuncs;
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ExtractTemporaryFile' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
ExtractTemporaryFile( Stack. GetString( PStart) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ExtractTemporaryFiles' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, ExtractTemporaryFiles( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2025-06-07 16:15:36 +02:00
RegisterScriptFunc( [ 'DownloadTemporaryFile' , 'DownloadTemporaryFileWithISSigVerify' ] , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-06-07 16:15:36 +02:00
const ISSigVerify = OrgName = 'DownloadTemporaryFileWithISSigVerify' ;
var Url, ISSigUrl, BaseName, RequiredSHA256OfFile: String ;
var ISSigAllowedKeys: AnsiString ;
var OnDownloadProgress: TOnDownloadProgress;
if ISSigVerify then begin
Url : = Stack. GetString( PStart- 1 ) ;
ISSigUrl : = Stack. GetString( PStart- 2 ) ;
BaseName : = Stack. GetString( PStart- 3 ) ;
ISSigAllowedKeys : = ConvertAllowedKeysRuntimeIDsToISSigAllowedKeys( TStringList( Stack. GetClass( PStart- 4 ) ) ) ;
OnDownloadProgress : = TOnDownloadProgress( Stack. GetProc( PStart- 5 , Caller) ) ;
end else begin
Url : = Stack. GetString( PStart- 1 ) ;
BaseName : = Stack. GetString( PStart- 2 ) ;
RequiredSHA256OfFile : = Stack. GetString( PStart- 3 ) ;
OnDownloadProgress : = TOnDownloadProgress( Stack. GetProc( PStart- 4 , Caller) ) ;
end ;
2025-06-12 10:51:25 +02:00
var Verification : = NoVerification;
2025-06-12 10:29:31 +02:00
if RequiredSHA256OfFile < > '' then begin
Verification. Typ : = fvHash;
Verification. Hash : = SHA256DigestFromString( RequiredSHA256OfFile)
end else if ISSigVerify then begin
Verification. Typ : = fvISSig;
Verification. ISSigAllowedKeys : = ISSigAllowedKeys
end ;
2025-06-12 09:31:14 +02:00
2025-06-07 16:15:36 +02:00
{ Also see Setup.ScriptDlg TDownloadWizardPage.AddExWithISSigVerify }
if ISSigVerify then
2025-06-12 10:51:25 +02:00
DownloadTemporaryFile( GetISSigUrl( Url, ISSigUrl) , BaseName + ISSigExt, NoVerification, OnDownloadProgress) ;
2025-06-12 10:29:31 +02:00
Stack. SetInt64( PStart, DownloadTemporaryFile( Url, BaseName, Verification, OnDownloadProgress) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'DownloadTemporaryFileSize' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt64( PStart, DownloadTemporaryFileSize( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'DownloadTemporaryFileDate' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, DownloadTemporaryFileDate( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2025-06-07 16:15:36 +02:00
RegisterScriptFunc( 'SetDownloadCredentials' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
begin
2025-06-08 18:33:39 +02:00
SetDownloadTemporaryFileCredentials( Stack. GetString( PStart) , Stack. GetString( PStart- 1 ) ) ;
2025-06-07 16:15:36 +02:00
end ) ;
2024-11-17 19:29:17 +01:00
end ;
procedure RegisterInstFuncScriptFuncs;
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CHECKFORMUTEXES' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, CheckForMutexes( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'DECREMENTSHAREDCOUNT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'DELAYDELETEFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-05-20 13:31:46 +02:00
DelayDeleteFile( ScriptFuncDisableFsRedir, Stack. GetString( PStart) , Stack. GetInt( PStart- 1 ) , 2 5 0 , 2 5 0 ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'DELTREE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-05-20 13:31:46 +02:00
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 ) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GENERATEUNIQUENAME' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-05-20 13:31:46 +02:00
Stack. SetString( PStart, GenerateUniqueName( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) ) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETCOMPUTERNAMESTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:44:49 +01:00
Stack. SetString( PStart, GetComputerNameString) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETMD5OFFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-05-20 13:31:46 +02:00
Stack. SetString( PStart, MD5DigestToString( GetMD5OfFile( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) ) ) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETMD5OFSTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, MD5DigestToString( GetMD5OfAnsiString( Stack. GetAnsiString( PStart- 1 ) ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETMD5OFUNICODESTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, MD5DigestToString( GetMD5OfUnicodeString( Stack. GetString( PStart- 1 ) ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSHA1OFFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-05-20 13:31:46 +02:00
Stack. SetString( PStart, SHA1DigestToString( GetSHA1OfFile( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) ) ) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSHA1OFSTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, SHA1DigestToString( GetSHA1OfAnsiString( Stack. GetAnsiString( PStart- 1 ) ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSHA1OFUNICODESTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, SHA1DigestToString( GetSHA1OfUnicodeString( Stack. GetString( PStart- 1 ) ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSHA256OFFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-05-20 13:31:46 +02:00
Stack. SetString( PStart, SHA256DigestToString( GetSHA256OfFile( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) ) ) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2025-05-12 20:46:02 +02:00
RegisterScriptFunc( 'GETSHA256OFSTREAM' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
begin
2025-05-13 12:44:59 +02:00
Stack. SetString( PStart, SHA256DigestToString( ISSigCalcStreamHash( TStream( Stack. GetClass( PStart- 1 ) ) ) ) ) ;
2025-05-12 20:46:02 +02:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSHA256OFSTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, SHA256DigestToString( GetSHA256OfAnsiString( Stack. GetAnsiString( PStart- 1 ) ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSHA256OFUNICODESTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, SHA256DigestToString( GetSHA256OfUnicodeString( Stack. GetString( PStart- 1 ) ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSPACEONDISK' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var FreeBytes, TotalBytes: Integer64;
2025-05-20 13:31:46 +02:00
if GetSpaceOnDisk( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) , FreeBytes, TotalBytes) then begin
2024-11-17 19:29:17 +01:00
if Stack. GetBool( PStart- 2 ) then begin
Div64( FreeBytes, 1 0 2 4 * 1 0 2 4 ) ;
Div64( TotalBytes, 1 0 2 4 * 1 0 2 4 ) ;
end ;
2025-06-11 20:46:41 +02:00
{ Cap at 2 GB, as GetSpaceOnDisk doesn't use 64-bit integers }
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSPACEONDISK64' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var FreeBytes, TotalBytes: Integer64;
2025-05-20 13:31:46 +02:00
if GetSpaceOnDisk( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) , FreeBytes, TotalBytes) then begin
2024-11-17 19:29:17 +01:00
Stack. SetInt64( PStart- 2 , Int64( FreeBytes. Hi ) shl 3 2 + FreeBytes. Lo ) ;
Stack. SetInt64( PStart- 3 , Int64( TotalBytes. Hi ) shl 3 2 + TotalBytes. Lo ) ;
Stack. SetBool( PStart, True ) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETUSERNAMESTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:44:49 +01:00
Stack. SetString( PStart, GetUserNameString) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'INCREMENTSHAREDCOUNT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( [ 'Exec' , 'ExecAsOriginalUser' , 'ExecAndLogOutput' , 'ExecAndCaptureOutput' ] , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:59:06 +01:00
var RunAsOriginalUser : = OrgName = 'ExecAsOriginalUser' ;
2024-11-18 19:44:49 +01:00
if IsUninstaller and RunAsOriginalUser then
2024-11-18 19:59:06 +01:00
NoUninstallFuncError( OrgName) ;
2024-11-17 19:29:17 +01:00
var Method: TMethod; { Must stay alive until OutputReader is freed }
var OutputReader: TCreateProcessOutputReader : = nil ;
2011-10-06 20:53:09 +02:00
try
2024-11-18 19:59:06 +01:00
if OrgName = 'ExecAndLogOutput' then begin
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
end else if OrgName = 'ExecAndCaptureOutput' then
2024-11-17 19:29:17 +01:00
OutputReader : = TCreateProcessOutputReader. Create( ExecAndLogOutputLog, 0 , omCapture) ;
var ExecWait : = TExecWait( Stack. GetInt( PStart- 5 ) ) ;
2024-11-18 19:44:49 +01:00
if ( OutputReader < > nil ) and ( ExecWait < > ewWaitUntilTerminated) then
2024-11-18 19:59:06 +01:00
InternalError( Format( 'Must call "%s" function with Wait = ewWaitUntilTerminated' , [ OrgName] ) ) ;
2024-11-17 19:29:17 +01:00
2024-11-18 20:39:11 +01:00
var Filename : = Stack. GetString( PStart- 1 ) ;
2024-11-17 19:29:17 +01:00
if not IsProtectedSrcExe( Filename) then begin
{ Disable windows so the user can' t utilize our UI during the InstExec
call }
2024-11-18 20:39:11 +01:00
var WindowDisabler : = TWindowDisabler. Create;
var ResultCode: Integer ;
2024-11-17 19:29:17 +01:00
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) ;
2024-11-18 19:59:06 +01:00
if OrgName = 'ExecAndCaptureOutput' then begin
2024-11-17 19:29:17 +01:00
{ 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 ;
2011-10-06 20:53:09 +02:00
finally
2024-11-17 19:29:17 +01:00
OutputReader. Free;
2011-10-06 20:53:09 +02:00
end ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( [ 'ShellExec' , 'ShellExecAsOriginalUser' ] , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:59:06 +01:00
var RunAsOriginalUser : = OrgName = 'ShellExecAsOriginalUser' ;
2024-11-17 19:29:17 +01:00
if IsUninstaller and RunAsOriginalUser then
2024-11-18 19:59:06 +01:00
NoUninstallFuncError( OrgName) ;
2024-11-18 20:39:11 +01:00
var Filename : = Stack. GetString( PStart- 2 ) ;
2024-11-17 19:29:17 +01:00
if not IsProtectedSrcExe( Filename) then begin
{ Disable windows so the user can' t utilize our UI during the
InstShellExec call }
2024-11-18 20:39:11 +01:00
var WindowDisabler : = TWindowDisabler. Create;
var ErrorCode: Integer ;
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ISPROTECTEDSYSTEMFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-05-20 13:31:46 +02:00
Stack. SetBool( PStart, IsProtectedSystemFile( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) ) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'MAKEPENDINGFILERENAMEOPERATIONSCHECKSUM' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, SHA256DigestToString( MakePendingFileRenameOperationsChecksum) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'MODIFYPIFFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, ModifyPifFile( Stack. GetString( PStart- 1 ) , Stack. GetBool( PStart- 2 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGISTERSERVER' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
RegisterServer( False , Stack. GetBool( PStart) , Stack. GetString( PStart- 1 ) , Stack. GetBool( PStart- 2 ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'UNREGISTERSERVER' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'UNREGISTERFONT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
UnregisterFont( Stack. GetString( PStart) , Stack. GetString( PStart- 1 ) , Stack. GetBool( PStart- 2 ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'RESTARTREPLACE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-05-20 13:31:46 +02:00
RestartReplace( ScriptFuncDisableFsRedir, Stack. GetString( PStart) , Stack. GetString( PStart- 1 ) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'FORCEDIRECTORIES' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-05-20 13:31:46 +02:00
Stack. SetBool( PStart, ForceDirectories( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) ) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
end ;
procedure RegisterInstFuncOleScriptFuncs;
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CREATESHELLLINK' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGISTERTYPELIBRARY' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
if Stack. GetBool( PStart) then
HelperRegisterTypeLibrary( False , Stack. GetString( PStart- 1 ) )
else
RegisterTypeLibrary( Stack. GetString( PStart- 1 ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'UNREGISTERTYPELIBRARY' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'UNPINSHELLLINK' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, UnpinShellLink( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2011-10-06 20:53:09 +02:00
end ;
2024-11-17 19:29:17 +01:00
procedure RegisterMainFuncScriptFuncs;
2011-10-06 20:53:09 +02:00
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ACTIVELANGUAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, ExpandConst( '{language}' ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'EXPANDCONSTANT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, ExpandConst( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'EXPANDCONSTANTEX' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, ExpandConstEx( Stack. GetString( PStart- 1 ) , [ Stack. GetString( PStart- 2 ) , Stack. GetString( PStart- 3 ) ] ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'EXITSETUPMSGBOX' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:44:49 +01:00
Stack. SetBool( PStart, ExitSetupMsgBox) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETSHELLFOLDERBYCSIDL' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, GetShellFolderByCSIDL( Stack. GetInt( PStart- 1 ) , Stack. GetBool( PStart- 2 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'INSTALLONTHISVERSION' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var MinVersion, OnlyBelowVersion: TSetupVersionData;
2024-11-17 19:29:17 +01:00
if not StrToSetupVersionData( Stack. GetString( PStart- 1 ) , MinVersion) then
2024-11-18 19:59:06 +01:00
InternalError( Format( '%s: Invalid MinVersion string' , [ OrgName] ) )
2024-11-17 19:29:17 +01:00
else if not StrToSetupVersionData( Stack. GetString( PStart- 2 ) , OnlyBelowVersion) then
2024-11-18 19:59:06 +01:00
InternalError( Format( '%s: Invalid OnlyBelowVersion string' , [ OrgName] ) )
2024-11-17 19:29:17 +01:00
else
Stack. SetBool( PStart, ( InstallOnThisVersion( MinVersion, OnlyBelowVersion) = irInstall) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETWINDOWSVERSION' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetUInt( PStart, WindowsVersion) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETWINDOWSVERSIONSTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, Format( '%u.%.2u.%u' , [ WindowsVersion shr 2 4 ,
( WindowsVersion shr 1 6 ) and $FF , WindowsVersion and $FFFF ] ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( [ 'MsgBox' , 'SuppressibleMsgBox' ] , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var Suppressible: Boolean ;
var Default : Integer ;
2024-11-18 19:59:06 +01:00
if OrgName = 'MsgBox' then begin
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( [ 'TaskDialogMsgBox' , 'SuppressibleTaskDialogMsgBox' ] , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var Suppressible: Boolean ;
var Default : Integer ;
2024-11-18 19:59:06 +01:00
if OrgName = 'TaskDialogMsgBox' then begin
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ISWIN64' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, IsWin64) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'IS64BITINSTALLMODE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, Is64BitInstallMode) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'PROCESSORARCHITECTURE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, Integer( ProcessorArchitecture) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( [ 'IsArm32Compatible' , 'IsArm64' , 'IsX64' , 'IsX64OS' , 'IsX64Compatible' , 'IsX86' , 'IsX86OS' , 'IsX86Compatible' ] , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:59:06 +01:00
var ArchitectureIdentifier : = LowerCase( Copy( String( OrgName) , 3 , MaxInt) ) ;
2024-11-17 19:29:17 +01:00
Stack. SetBool( PStart, EvalArchitectureIdentifier( ArchitectureIdentifier) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CUSTOMMESSAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, CustomMessage( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'RMSESSIONSTARTED' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, RmSessionStarted) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGISTEREXTRACLOSEAPPLICATIONSRESOURCE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-05-20 13:31:46 +02:00
Stack. SetBool( PStart, CodeRegisterExtraCloseApplicationsResource( Stack. GetBool( PStart- 1 ) , Stack. GetString( PStart- 2 ) ) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETWIZARDFORM' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetClass( PStart, GetWizardForm) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( [ 'WizardIsComponentSelected' , 'IsComponentSelected' , 'WizardIsTaskSelected' , 'IsTaskSelected' ] , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var StringList : = TStringList. Create;
2024-11-17 19:29:17 +01:00
try
2024-11-18 20:39:11 +01:00
var Components : = ( OrgName = 'WizardIsComponentSelected' ) or ( OrgName = 'IsComponentSelected' ) ;
2024-11-17 19:29:17 +01:00
if Components then
GetWizardForm. GetSelectedComponents( StringList, False , False )
else
GetWizardForm. GetSelectedTasks( StringList, False , False , False ) ;
2024-11-18 20:39:11 +01:00
var S : = Stack. GetString( PStart- 1 ) ;
2024-11-17 19:29:17 +01:00
StringChange( S, '/' , '\' ) ;
if Components then
Stack. SetBool( PStart, ShouldProcessEntry( StringList, nil , S, '' , '' , '' ) )
else
Stack. SetBool( PStart, ShouldProcessEntry( nil , StringList, '' , S, '' , '' ) ) ;
finally
2024-11-18 19:44:49 +01:00
StringList. Free;
2024-11-17 19:29:17 +01:00
end ;
end ) ;
end ;
procedure RegisterMessagesScriptFuncs;
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SETUPMESSAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, SetupMessages[ TSetupMessageID( Stack. GetInt( PStart- 1 ) ) ] ) ;
end ) ;
end ;
procedure RegisterSystemScriptFuncs;
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'RANDOM' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, Random( Stack. GetInt( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'FILESIZE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
try
2024-11-18 20:39:11 +01:00
var F : = TFileRedir. Create( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) , fdOpenExisting, faRead, fsReadWrite) ;
2024-11-17 19:29:17 +01:00
try
Stack. SetInt( PStart- 2 , F. CappedSize) ;
Stack. SetBool( PStart, True ) ;
finally
F. Free;
end ;
except
Stack. SetBool( PStart, False ) ;
end ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'FILESIZE64' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
try
2024-11-18 20:39:11 +01:00
var F : = TFileRedir. Create( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) , fdOpenExisting, faRead, fsReadWrite) ;
2024-11-17 19:29:17 +01:00
try
2024-11-18 20:39:11 +01:00
var TmpFileSize : = F. Size; { Make sure we access F.Size only once }
2024-11-17 19:29:17 +01:00
Stack. SetInt64( PStart- 2 , Int64( TmpFileSize. Hi ) shl 3 2 + TmpFileSize. Lo ) ;
Stack. SetBool( PStart, True ) ;
finally
F. Free;
end ;
except
Stack. SetBool( PStart, False ) ;
end ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SET8087CW' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Set8087CW( Stack. GetInt( PStart) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GET8087CW' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, Get8087CW) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'UTF8ENCODE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetAnsiString( PStart, Utf8Encode( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'UTF8DECODE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, UTF8ToString( Stack. GetAnsiString( PStart- 1 ) ) ) ;
end ) ;
end ;
procedure RegisterSysUtilsScriptFuncs;
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'BEEP' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Beep;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'TRIMLEFT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, TrimLeft( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'TRIMRIGHT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, TrimRight( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETCURRENTDIR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:44:49 +01:00
Stack. SetString( PStart, GetCurrentDir) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SETCURRENTDIR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, SetCurrentDir( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'EXPANDFILENAME' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, PathExpand( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'EXPANDUNCFILENAME' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, ExpandUNCFileName( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'EXTRACTRELATIVEPATH' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, NewExtractRelativePath( Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'EXTRACTFILEDIR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, PathExtractDir( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'EXTRACTFILEDRIVE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, PathExtractDrive( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'EXTRACTFILEEXT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, PathExtractExt( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'EXTRACTFILENAME' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, PathExtractName( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'EXTRACTFILEPATH' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, PathExtractPath( Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CHANGEFILEEXT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, PathChangeExt( Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'FILESEARCH' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-05-20 13:31:46 +02:00
Stack. SetString( PStart, NewFileSearch( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) ) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'RENAMEFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var OldName : = Stack. GetString( PStart- 1 ) ;
2024-11-17 19:29:17 +01:00
if not IsProtectedSrcExe( OldName) then
Stack. SetBool( PStart, MoveFileRedir( ScriptFuncDisableFsRedir, OldName, Stack. GetString( PStart- 2 ) ) )
2011-10-06 20:53:09 +02:00
else
2024-11-17 19:29:17 +01:00
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'DELETEFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, DeleteFileRedir( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CREATEDIR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, CreateDirectoryRedir( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REMOVEDIR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, RemoveDirectoryRedir( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'COMPARESTR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, CompareStr( Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'COMPARETEXT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, CompareText( Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SAMESTR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, CompareStr( Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) ) = 0 ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SAMETEXT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, CompareText( Stack. GetString( PStart- 1 ) , Stack. GetString( PStart- 2 ) ) = 0 ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETDATETIMESTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var OldDateSeparator : = FormatSettings. DateSeparator;
var OldTimeSeparator : = FormatSettings. TimeSeparator;
2011-10-06 20:53:09 +02:00
try
2024-11-19 19:16:24 +01:00
var NewDateSeparator : = Stack. GetChar( PStart- 2 ) ;
var NewTimeSeparator : = Stack. GetChar( PStart- 3 ) ;
2024-11-17 19:29:17 +01:00
if NewDateSeparator < > #0 then
FormatSettings. DateSeparator : = NewDateSeparator;
if NewTimeSeparator < > #0 then
FormatSettings. TimeSeparator : = NewTimeSeparator;
2024-11-18 19:44:49 +01:00
Stack. SetString( PStart, FormatDateTime( Stack. GetString( PStart- 1 ) , Now) ) ;
2011-10-06 20:53:09 +02:00
finally
2024-11-17 19:29:17 +01:00
FormatSettings. TimeSeparator : = OldTimeSeparator;
FormatSettings. DateSeparator : = OldDateSeparator;
2011-10-06 20:53:09 +02:00
end ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SYSERRORMESSAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, Win32ErrorString( Stack. GetInt( PStart- 1 ) ) ) ;
end ) ;
2011-10-06 20:53:09 +02:00
end ;
2024-11-17 19:29:17 +01:00
procedure RegisterVerInfoFuncScriptFuncs;
2018-12-16 17:35:49 +01:00
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETVERSIONNUMBERS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var VersionNumbers: TFileVersionNumbers;
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETVERSIONCOMPONENTS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var VersionNumbers: TFileVersionNumbers;
2024-11-17 19:29:17 +01:00
if GetVersionNumbersRedir( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) , VersionNumbers) then begin
Stack. SetUInt( PStart- 2 , VersionNumbers. MS shr 1 6 ) ;
Stack. SetUInt( PStart- 3 , VersionNumbers. MS and $FFFF ) ;
Stack. SetUInt( PStart- 4 , VersionNumbers. LS shr 1 6 ) ;
Stack. SetUInt( PStart- 5 , VersionNumbers. LS and $FFFF ) ;
Stack. SetBool( PStart, True ) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETVERSIONNUMBERSSTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var VersionNumbers: TFileVersionNumbers;
2024-11-17 19:29:17 +01:00
if GetVersionNumbersRedir( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) , VersionNumbers) then begin
Stack. SetString( PStart- 2 , Format( '%u.%u.%u.%u' , [ VersionNumbers. MS shr 1 6 ,
VersionNumbers. MS and $FFFF , VersionNumbers. LS shr 1 6 , VersionNumbers. LS and $FFFF ] ) ) ;
Stack. SetBool( PStart, True ) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETPACKEDVERSION' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var VersionNumbers: TFileVersionNumbers;
2024-11-17 19:29:17 +01:00
if GetVersionNumbersRedir( ScriptFuncDisableFsRedir, Stack. GetString( PStart- 1 ) , VersionNumbers) then begin
Stack. SetInt64( PStart- 2 , ( Int64( VersionNumbers. MS) shl 3 2 ) or VersionNumbers. LS) ;
Stack. SetBool( PStart, True ) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'PACKVERSIONNUMBERS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt64( PStart, Int64( ( UInt64( Stack. GetUInt( PStart- 1 ) ) shl 3 2 ) or Stack. GetUInt( PStart- 2 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'PACKVERSIONCOMPONENTS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var VersionNumbers: TFileVersionNumbers;
2024-11-17 19:29:17 +01:00
VersionNumbers. MS : = ( Stack. GetUInt( PStart- 1 ) shl 1 6 ) or ( Stack. GetUInt( PStart- 2 ) and $FFFF ) ;
VersionNumbers. LS : = ( Stack. GetUInt( PStart- 3 ) shl 1 6 ) or ( Stack. GetUInt( PStart- 4 ) and $FFFF ) ;
Stack. SetInt64( PStart, Int64( ( UInt64( VersionNumbers. MS) shl 3 2 ) or VersionNumbers. LS) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'COMPAREPACKEDVERSION' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, Compare64( Integer64( Stack. GetInt64( PStart- 1 ) ) , Integer64( Stack. GetInt64( PStart- 2 ) ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SAMEPACKEDVERSION' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, Compare64( Integer64( Stack. GetInt64( PStart- 1 ) ) , Integer64( Stack. GetInt64( PStart- 2 ) ) ) = 0 ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'UNPACKVERSIONNUMBERS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var VersionNumbers: TFileVersionNumbers;
2024-11-17 19:29:17 +01:00
VersionNumbers. MS : = UInt64( Stack. GetInt64( PStart) ) shr 3 2 ;
VersionNumbers. LS : = UInt64( Stack. GetInt64( PStart) ) and $FFFFFFFF ;
Stack. SetUInt( PStart- 1 , VersionNumbers. MS) ;
Stack. SetUInt( PStart- 2 , VersionNumbers. LS) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'UNPACKVERSIONCOMPONENTS' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var VersionNumbers: TFileVersionNumbers;
2024-11-17 19:29:17 +01:00
VersionNumbers. MS : = UInt64( Stack. GetInt64( PStart) ) shr 3 2 ;
VersionNumbers. LS : = UInt64( Stack. GetInt64( PStart) ) and $FFFFFFFF ;
Stack. SetUInt( PStart- 1 , VersionNumbers. MS shr 1 6 ) ;
Stack. SetUInt( PStart- 2 , VersionNumbers. MS and $FFFF ) ;
Stack. SetUInt( PStart- 3 , VersionNumbers. LS shr 1 6 ) ;
Stack. SetUInt( PStart- 4 , VersionNumbers. LS and $FFFF ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'VERSIONTOSTR' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var VersionNumbers: TFileVersionNumbers;
2024-11-17 19:29:17 +01:00
VersionNumbers. MS : = UInt64( Stack. GetInt64( PStart- 1 ) ) shr 3 2 ;
VersionNumbers. LS : = UInt64( Stack. GetInt64( PStart- 1 ) ) and $FFFFFFFF ;
Stack. SetString( PStart, Format( '%u.%u.%u.%u' , [ VersionNumbers. MS shr 1 6 ,
VersionNumbers. MS and $FFFF , VersionNumbers. LS shr 1 6 , VersionNumbers. LS and $FFFF ] ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'STRTOVERSION' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var VersionNumbers: TFileVersionNumbers;
2024-11-17 19:29:17 +01:00
if StrToVersionNumbers( Stack. GetString( PStart- 1 ) , VersionNumbers) then begin
Stack. SetInt64( PStart- 2 , ( Int64( VersionNumbers. MS) shl 3 2 ) or VersionNumbers. LS) ;
Stack. SetBool( PStart, True ) ;
end else
Stack. SetBool( PStart, False ) ;
end ) ;
2018-12-16 17:35:49 +01:00
end ;
2011-10-06 20:53:09 +02:00
2024-11-17 19:29:17 +01:00
type
TDllProc = function( const Param1, Param2: Longint ) : Longint ; stdcall ;
2011-10-06 20:53:09 +02:00
2024-11-17 19:29:17 +01:00
procedure RegisterWindowsScriptFuncs;
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SLEEP' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Sleep( Stack. GetInt( PStart) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'FINDWINDOWBYCLASSNAME' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, FindWindow( PChar( Stack. GetString( PStart- 1 ) ) , nil ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'FINDWINDOWBYWINDOWNAME' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, FindWindow( nil , PChar( Stack. GetString( PStart- 1 ) ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SENDMESSAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, SendMessage( Stack. GetInt( PStart- 1 ) , Stack. GetInt( PStart- 2 ) , Stack. GetInt( PStart- 3 ) , Stack. GetInt( PStart- 4 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'POSTMESSAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, PostMessage( Stack. GetInt( PStart- 1 ) , Stack. GetInt( PStart- 2 ) , Stack. GetInt( PStart- 3 ) , Stack. GetInt( PStart- 4 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SENDNOTIFYMESSAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, SendNotifyMessage( Stack. GetInt( PStart- 1 ) , Stack. GetInt( PStart- 2 ) , Stack. GetInt( PStart- 3 ) , Stack. GetInt( PStart- 4 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'REGISTERWINDOWMESSAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, RegisterWindowMessage( PChar( Stack. GetString( PStart- 1 ) ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SENDBROADCASTMESSAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, SendMessage( HWND_BROADCAST, Stack. GetInt( PStart- 1 ) , Stack. GetInt( PStart- 2 ) , Stack. GetInt( PStart- 3 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'POSTBROADCASTMESSAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, PostMessage( HWND_BROADCAST, Stack. GetInt( PStart- 1 ) , Stack. GetInt( PStart- 2 ) , Stack. GetInt( PStart- 3 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SENDBROADCASTNOTIFYMESSAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, SendNotifyMessage( HWND_BROADCAST, Stack. GetInt( PStart- 1 ) , Stack. GetInt( PStart- 2 ) , Stack. GetInt( PStart- 3 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'LOADDLL' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var DllHandle : = SafeLoadLibrary( Stack. GetString( PStart- 1 ) , SEM_NOOPENFILEERRORBOX) ;
2024-11-17 19:29:17 +01:00
if DllHandle < > 0 then
Stack. SetInt( PStart- 2 , 0 )
2019-04-27 09:40:36 +02:00
else
2024-11-18 19:44:49 +01:00
Stack. SetInt( PStart- 2 , GetLastError) ;
2024-11-17 19:29:17 +01:00
Stack. SetInt( PStart, DllHandle) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CALLDLLPROC' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var DllProc: TDllProc;
2024-11-17 19:29:17 +01:00
@ 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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'FREEDLL' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, FreeLibrary( Stack. GetInt( PStart- 1 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CREATEMUTEX' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Windows. CreateMutex( nil , False , PChar( Stack. GetString( PStart) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'OEMTOCHARBUFF' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var S : = Stack. GetAnsiString( PStart) ;
2024-11-17 19:29:17 +01:00
OemToCharBuffA( PAnsiChar( S) , PAnsiChar( S) , Length( S) ) ;
Stack. SetAnsiString( PStart, S) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CHARTOOEMBUFF' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var S : = Stack. GetAnsiString( PStart) ;
2024-11-17 19:29:17 +01:00
CharToOemBuffA( PAnsiChar( S) , PAnsiChar( S) , Length( S) ) ;
Stack. SetAnsiString( PStart, S) ;
end ) ;
2024-11-16 11:45:58 +01:00
end ;
2024-11-18 19:44:49 +01:00
procedure RegisterActiveXScriptFuncs;
2024-11-17 19:29:17 +01:00
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'COFREEUNUSEDLIBRARIES' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
CoFreeUnusedLibraries;
end ) ;
2024-11-16 11:45:58 +01:00
end ;
2024-11-17 19:29:17 +01:00
procedure RegisterLoggingFuncScriptFuncs;
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'LOG' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Log( Stack. GetString( PStart) ) ;
end ) ;
2024-11-16 11:45:58 +01:00
end ;
2024-11-17 19:29:17 +01:00
procedure RegisterOtherScriptFuncs;
2011-10-06 20:53:09 +02:00
begin
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'BRINGTOFRONTANDRESTORE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-12-18 02:20:42 -06:00
{ Must be in this order to work around VCL bug }
2024-11-18 19:44:49 +01:00
Application. Restore;
2024-12-18 02:20:42 -06:00
Application. BringToFront;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'WizardDirValue' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, RemoveBackslashUnlessRoot( GetWizardForm. DirEdit. Text ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'WizardGroupValue' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, RemoveBackslashUnlessRoot( GetWizardForm. GroupEdit. Text ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'WizardNoIcons' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, GetWizardForm. NoIconsCheck. Checked) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'WizardSetupType' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var TypeEntry : = GetWizardForm. GetSetupType;
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( [ 'WizardSelectedComponents' , 'WizardSelectedTasks' ] , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var StringList : = TStringList. Create;
2024-11-17 19:29:17 +01:00
try
2024-11-18 19:59:06 +01:00
if OrgName = 'WizardSelectedComponents' then
2024-11-17 19:29:17 +01:00
GetWizardForm. GetSelectedComponents( StringList, Stack. GetBool( PStart- 1 ) , False )
else
GetWizardForm. GetSelectedTasks( StringList, Stack. GetBool( PStart- 1 ) , False , False ) ;
Stack. SetString( PStart, StringsToCommaString( StringList) ) ;
finally
2024-11-18 19:44:49 +01:00
StringList. Free;
2024-11-17 19:29:17 +01:00
end ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( [ 'WizardSelectComponents' , 'WizardSelectTasks' ] , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var StringList : = TStringList. Create;
2024-11-17 19:29:17 +01:00
try
2024-11-18 20:39:11 +01:00
var S : = Stack. GetString( PStart) ;
2024-11-17 19:29:17 +01:00
StringChange( S, '/' , '\' ) ;
SetStringsFromCommaString( StringList, S) ;
2024-11-18 19:59:06 +01:00
if OrgName = 'WizardSelectComponents' then
2024-11-17 19:29:17 +01:00
GetWizardForm. SelectComponents( StringList)
else
GetWizardForm. SelectTasks( StringList) ;
finally
2024-11-18 19:44:49 +01:00
StringList. Free;
2024-11-17 19:29:17 +01:00
end ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'WizardSilent' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, InstallMode < > imNormal) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ISUNINSTALLER' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, IsUninstaller) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'UninstallSilent' , sfOnlyUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, UninstallSilent) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CurrentFilename' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
if CheckOrInstallCurrentFilename < > '' then
Stack. SetString( PStart, CheckOrInstallCurrentFilename)
else
2024-11-18 19:59:06 +01:00
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] ) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CurrentSourceFilename' , sfNoUninstall, procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
if CheckOrInstallCurrentSourceFilename < > '' then
Stack. SetString( PStart, CheckOrInstallCurrentSourceFilename)
else
2024-11-18 19:59:06 +01:00
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] ) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CASTSTRINGTOINTEGER' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, Integer( PChar( Stack. GetString( PStart- 1 ) ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CASTINTEGERTOSTRING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, String( PChar( Stack. GetInt( PStart- 1 ) ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ABORT' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Abort;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETEXCEPTIONMESSAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetString( PStart, GetExceptionMessage( Caller) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'RAISEEXCEPTION' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
raise Exception. Create( Stack. GetString( PStart) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SHOWEXCEPTIONMESSAGE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-02-06 18:24:50 +01:00
TMainForm. ShowExceptionMsg( AddPeriod( GetExceptionMessage( Caller) ) ) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'TERMINATED' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, Application. Terminated) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETPREVIOUSDATA' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SETPREVIOUSDATA' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, SetCodePreviousData( Stack. GetInt( PStart- 1 ) , Stack. GetString( PStart- 2 ) , Stack. GetString( PStart- 3 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'LOADSTRINGFROMFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var S : = Stack. GetAnsiString( PStart- 2 ) ;
Stack. SetBool( PStart, LoadStringFromFile( Stack. GetString( PStart- 1 ) , S, fsRead) ) ;
Stack. SetAnsiString( PStart- 2 , S) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'LOADSTRINGFROMLOCKEDFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var S : = Stack. GetAnsiString( PStart- 2 ) ;
Stack. SetBool( PStart, LoadStringFromFile( Stack. GetString( PStart- 1 ) , S, fsReadWrite) ) ;
Stack. SetAnsiString( PStart- 2 , S) ;
2024-11-17 19:29:17 +01:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'LOADSTRINGSFROMFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, LoadStringsFromFile( Stack. GetString( PStart- 1 ) , Stack, PStart- 2 , fsRead) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'LOADSTRINGSFROMLOCKEDFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, LoadStringsFromFile( Stack. GetString( PStart- 1 ) , Stack, PStart- 2 , fsReadWrite) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SAVESTRINGTOFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, SaveStringToFile( Stack. GetString( PStart- 1 ) , Stack. GetAnsiString( PStart- 2 ) , Stack. GetBool( PStart- 3 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SAVESTRINGSTOFILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, SaveStringsToFile( Stack. GetString( PStart- 1 ) , Stack, PStart- 2 , Stack. GetBool( PStart- 3 ) , False , False ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SAVESTRINGSTOUTF8FILE' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, SaveStringsToFile( Stack. GetString( PStart- 1 ) , Stack, PStart- 2 , Stack. GetBool( PStart- 3 ) , True , False ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'SAVESTRINGSTOUTF8FILEWITHOUTBOM' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, SaveStringsToFile( Stack. GetString( PStart- 1 ) , Stack, PStart- 2 , Stack. GetBool( PStart- 3 ) , True , True ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ENABLEFSREDIRECTION' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
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 ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'GETUNINSTALLPROGRESSFORM' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetClass( PStart, GetUninstallProgressForm) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'CREATECALLBACK' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetInt( PStart, CreateCallback( Caller, Stack. Items[ PStart- 1 ] ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ISDOTNETINSTALLED' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, IsDotNetInstalled( InstallDefaultRegView, TDotNetVersion( Stack. GetInt( PStart- 1 ) ) , Stack. GetInt( PStart- 2 ) ) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'ISMSIPRODUCTINSTALLED' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2024-11-18 20:39:11 +01:00
var ErrorCode: Cardinal ;
2024-11-17 19:29:17 +01:00
Stack. SetBool( PStart, IsMsiProductInstalled( Stack. GetString( PStart- 1 ) , Stack. GetInt64( PStart- 2 ) , ErrorCode) ) ;
if ErrorCode < > 0 then
raise Exception. Create( Win32ErrorString( ErrorCode) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'INITIALIZEBITMAPIMAGEFROMICON' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
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 ) ;
2025-05-24 14:11:08 +02:00
RegisterScriptFunc( [ 'Extract7ZipArchive' , 'ExtractArchive' ] , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
2025-05-24 14:11:08 +02:00
var Password: String ;
var FullDirsItemNo: Longint ;
if OrgName = 'Extract7ZipArchive' then begin
Password : = '' ;
FullDirsItemNo : = PStart- 2 ;
end else begin
Password : = Stack. GetString( PStart- 2 ) ;
FullDirsItemNo : = PStart- 3 ;
end ;
2025-06-06 20:11:14 +02:00
try
if SetupHeader. SevenZipLibraryName < > '' then
ExtractArchiveRedir( ScriptFuncDisableFsRedir, Stack. GetString( PStart) , Stack. GetString( PStart- 1 ) , Password, Stack. GetBool( FullDirsItemNo) , TOnExtractionProgress( Stack. GetProc( FullDirsItemNo- 1 , Caller) ) )
else
Extract7ZipArchiveRedir( ScriptFuncDisableFsRedir, Stack. GetString( PStart) , Stack. GetString( PStart- 1 ) , Password, Stack. GetBool( FullDirsItemNo) , TOnExtractionProgress( Stack. GetProc( FullDirsItemNo- 1 , Caller) ) ) ;
except
on E: EAbort do
raise Exception. Create( SetupMessages[ msgErrorExtractionAborted] )
else
raise Exception. Create( FmtSetupMessage1( msgErrorExtractionFailed, GetExceptMessage) ) ;
end ;
2025-05-18 20:31:54 +02:00
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'DEBUGGING' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
Stack. SetBool( PStart, Debugging) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( 'StringJoin' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
var Values : = Stack. GetStringArray( PStart- 2 ) ;
Stack. SetString( PStart, String . Join( Stack. GetString( PStart- 1 ) , Values) ) ;
end ) ;
2024-11-18 19:59:06 +01:00
RegisterScriptFunc( [ 'StringSplit' , 'StringSplitEx' ] , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
2024-11-17 19:29:17 +01:00
begin
var Separators : = Stack. GetStringArray( PStart- 2 ) ;
var Parts: TArray< String > ;
2024-11-18 19:59:06 +01:00
if OrgName = 'StringSplitEx' then begin
2024-11-19 19:16:24 +01:00
var Quote : = Stack. GetChar( PStart- 3 ) ;
2024-11-17 19:29:17 +01:00
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 ) ;
2025-05-12 20:46:02 +02:00
RegisterScriptFunc( 'ISSigVerify' , procedure( const Caller: TPSExec; const OrgName: AnsiString ; const Stack: TPSStack; const PStart: Cardinal )
begin
2025-06-04 16:33:32 +02:00
const ISSigAllowedKeys = ConvertAllowedKeysRuntimeIDsToISSigAllowedKeys( TStringList( Stack. GetClass( PStart- 1 ) ) ) ;
2025-05-12 20:46:02 +02:00
const Filename = Stack. GetString( PStart- 2 ) ;
const KeepOpen = Stack. GetBool( PStart- 3 ) ;
2025-06-04 16:24:16 +02:00
{ Verify signature & file , keeping open afterwards if requested
2025-05-29 17:07:57 +02:00
Also see TrustFunc' s CheckFileTrust }
2025-05-18 19:55:05 +02:00
var F : = TFileStream. Create( Filename, fmOpenRead or fmShareDenyWrite) ;
try
2025-06-04 16:24:16 +02:00
var ExpectedFileHash: TSHA256Digest;
2025-06-08 09:55:37 +02:00
DoISSigVerify( nil , F, Filename, ISSigAllowedKeys, ExpectedFileHash) ;
2025-06-04 16:24:16 +02:00
{ Couldn't get the SHA-256 while downloading so need to get and check it now }
2025-05-18 19:55:05 +02:00
const ActualFileHash = ISSigCalcStreamHash( F) ;
if not SHA256DigestsEqual( ActualFileHash, ExpectedFileHash) then
2025-06-12 09:31:14 +02:00
VerificationError( veFileHashIncorrect) ;
2025-05-18 19:55:05 +02:00
except
FreeAndNil( F) ;
raise ;
end ;
if not KeepOpen then
FreeAndNil( F) ;
2025-05-12 20:46:02 +02:00
Stack. SetClass( PStart, F) ;
end ) ;
2024-07-03 12:28:10 +02:00
end ;
2024-07-03 19:57:53 +02:00
procedure RegisterDelphiFunction( ProcPtr: Pointer ; const Name : AnsiString ) ;
2024-07-03 12:28:10 +02:00
begin
ScriptInterpreter. RegisterDelphiFunction( ProcPtr, Name , cdRegister) ;
2024-07-03 19:57:53 +02:00
{$IFDEF DEBUG}
2024-07-03 12:28:10 +02:00
Inc( Count) ;
2024-07-03 19:57:53 +02:00
{$ENDIF}
2011-10-06 20:53:09 +02:00
end ;
begin
2024-11-17 19:29:17 +01:00
if ScriptFuncs < > nil then
ScriptFuncs. Free;
ScriptFuncs : = TScriptFuncs. Create;
2024-07-03 12:28:10 +02:00
{ The following should register all tables in ScriptFuncTables }
2024-07-03 19:57:53 +02:00
{$IFDEF DEBUG}
Count : = 0 ;
{$ENDIF}
2024-11-17 19:29:17 +01:00
RegisterScriptDlgScriptFuncs;
RegisterNewDiskFormScriptFuncs;
RegisterBrowseFuncScriptFuncs;
RegisterCommonFuncVclScriptFuncs;
RegisterCommonFuncScriptFuncs;
RegisterInstallScriptFuncs;
RegisterInstFuncScriptFuncs;
RegisterInstFuncOleScriptFuncs;
RegisterMainFuncScriptFuncs;
RegisterMessagesScriptFuncs;
RegisterSystemScriptFuncs;
RegisterSysUtilsScriptFuncs;
RegisterVerInfoFuncScriptFuncs;
RegisterWindowsScriptFuncs;
2024-11-18 19:44:49 +01:00
RegisterActiveXScriptFuncs;
2024-11-17 19:29:17 +01:00
RegisterLoggingFuncScriptFuncs;
RegisterOtherScriptFuncs;
2024-07-03 19:57:53 +02:00
{$IFDEF DEBUG}
2024-11-17 19:29:17 +01:00
for var ScriptFuncTable in ScriptFuncTables do
for var ScriptFunc in ScriptFuncTable do
Dec( Count) ;
if Count < > 0 then
raise Exception. Create( 'Count <> 0' ) ;
2024-07-03 19:57:53 +02:00
{$ENDIF}
2024-07-03 12:28:10 +02:00
{ The following should register all functions in ScriptDelphiFuncTable }
2024-07-03 19:57:53 +02:00
{$IFDEF DEBUG}
2024-07-03 12:28:10 +02:00
Count : = 0 ;
2024-07-03 19:57:53 +02:00
{$ENDIF}
2024-11-18 19:44:49 +01:00
RegisterDelphiFunction( @ FindFirstHelper, 'FindFirst' ) ;
RegisterDelphiFunction( @ FindNextHelper, 'FindNext' ) ;
RegisterDelphiFunction( @ FindCloseHelper, 'FindClose' ) ;
RegisterDelphiFunction( @ FmtMessageHelper, 'FmtMessage' ) ;
2024-07-03 19:57:53 +02:00
RegisterDelphiFunction( @ Format, 'Format' ) ;
2024-11-18 19:44:49 +01:00
RegisterDelphiFunction( @ GetWindowsVersionExHelper, 'GetWindowsVersionEx' ) ;
2024-07-03 19:57:53 +02:00
{$IFDEF DEBUG}
2024-07-04 08:57:36 +02:00
if Count < > Length( DelphiScriptFuncTable) then
raise Exception. Create( 'Count <> Length(DelphiScriptFuncTable)' ) ;
2024-07-03 19:57:53 +02:00
{$ENDIF}
2011-10-06 20:53:09 +02:00
end ;
2018-12-16 17:35:49 +01:00
initialization
finalization
2024-11-17 19:29:17 +01:00
ScriptFuncs. Free;
2011-10-06 20:53:09 +02:00
end .