1berry/Inno-Setup-issrc
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity
Inno-Setup-issrc/Projects/Src/Setup.ScriptFunc.pas
Martijn Laan 46252ab541
Cleanup.
2025-06-12 10:51:25 +02:00

1950 lines
101 KiB
ObjectPascal
Raw Permalink Blame History

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