1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972 |
- 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, BitmapButton, 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;
- const Throttler = TProgressThrottler.Create(OnDownloadProgress);
- try
- { Also see Setup.ScriptDlg TDownloadWizardPage.AddExWithISSigVerify }
- if ISSigVerify then
- DownloadTemporaryFile(GetISSigUrl(Url, ISSigUrl), BaseName + ISSigExt, NoVerification, Throttler.OnDownloadProgress);
- Throttler.Reset;
- Stack.SetInt64(PStart, DownloadTemporaryFile(Url, BaseName, Verification, Throttler.OnDownloadProgress));
- finally
- Throttler.Free;
- end;
- 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
- Stack.SetInt64(PStart-2, F.Size);
- 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('INITIALIZEBITMAPBUTTONFROMICON', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var AscendingTrySizes := Stack.GetIntArray(PStart-4);
- Stack.SetBool(PStart, TBitmapButton(Stack.GetClass(PStart-1)).InitializeFromIcon(0, PChar(Stack.GetString(PStart-2)), Stack.GetInt(PStart-3), AscendingTrySizes));
- 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;
- const Throttler = TProgressThrottler.Create(TOnExtractionProgress(Stack.GetProc(FullDirsItemNo-1, Caller)));
- try
- try
- if SetupHeader.SevenZipLibraryName <> '' then
- ExtractArchiveRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1),
- Password, Stack.GetBool(FullDirsItemNo), Throttler.OnExtractionProgress)
- else
- Extract7ZipArchiveRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1),
- Password, Stack.GetBool(FullDirsItemNo), Throttler.OnExtractionProgress);
- except
- on E: EAbort do
- raise Exception.Create(SetupMessages[msgErrorExtractionAborted])
- else
- raise Exception.Create(FmtSetupMessage1(msgErrorExtractionFailed, GetExceptMessage));
- end;
- finally
- Throttler.Free;
- end;
- end);
- RegisterScriptFunc('MapArchiveExtensions', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- if SetupHeader.SevenZipLibraryName <> '' then
- MapArchiveExtensions(Stack.GetString(PStart), Stack.GetString(PStart-1));
- 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 VerifyFilename = Stack.GetBool(PStart-3);
- const KeepOpen = Stack.GetBool(PStart-4);
- { Verify signature & file, keeping open afterwards if requested
- Also see TrustFunc's CheckFileTrust which can also keep open afterwards }
- var F := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
- try
- var ExpectedFileHash: TSHA256Digest;
- DoISSigVerify(nil, F, Filename, VerifyFilename, 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.
|