12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967 |
- unit Setup.ScriptFunc;
- {
- Inno Setup
- Copyright (C) 1997-2025 Jordan Russell
- Portions by Martijn Laan
- For conditions of distribution and use, see LICENSE.TXT.
- Script support functions (run time - used by Setup)
- }
- interface
- uses
- uPSRuntime;
- procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec);
- implementation
- uses
- Windows,
- Forms, SysUtils, Classes, Graphics, ActiveX, Generics.Collections,
- uPSUtils, PathFunc, ISSigFunc, ECDSA, BrowseFunc, MD5, SHA1, SHA256, BitmapImage, PSStackHelper,
- Shared.Struct, Setup.ScriptDlg, Setup.MainFunc, Shared.CommonFunc.Vcl,
- Shared.CommonFunc, Shared.FileClass, SetupLdrAndSetup.RedirFunc,
- Setup.Install, SetupLdrAndSetup.InstFunc, Setup.InstFunc, Setup.InstFunc.Ole,
- SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.NewDiskForm,
- Setup.WizardForm, Shared.VerInfoFunc, Shared.SetupTypes,
- Shared.Int64Em, Setup.LoggingFunc, Setup.SetupForm, Setup.RegDLL, Setup.Helper,
- Setup.SpawnClient, Setup.DotNetFunc, Setup.MainForm,
- Shared.DotNetVersion, Setup.MsiFunc, Compression.SevenZipDecoder, Compression.SevenZipDLLDecoder,
- Setup.DebugClient, Shared.ScriptFunc, Setup.ScriptFunc.HelperFunc;
- type
- TScriptFunc = reference to procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal);
- TScriptFuncTyp = (sfNormal, sfNoUninstall, sfOnlyUninstall);
- TScriptFuncEx = record
- OrgName: AnsiString;
- ScriptFunc: TScriptFunc;
- Typ: TScriptFuncTyp;
- constructor Create(const AOrgName: AnsiString; const AScriptFunc: TScriptFunc; const ATyp: TScriptFuncTyp);
- procedure Run(const Caller: TPSExec; const Stack: TPSStack);
- end;
- TScriptFuncs = TDictionary<AnsiString, TScriptFuncEx>;
- var
- ScriptFuncs: TScriptFuncs;
- constructor TScriptFuncEx.Create(const AOrgName: AnsiString; const AScriptFunc: TScriptFunc; const ATyp: TScriptFuncTyp);
- begin
- OrgName := AOrgName;
- ScriptFunc := AScriptFunc;
- Typ := ATyp;
- end;
- procedure TScriptFuncEx.Run(const Caller: TPSExec; const Stack: TPSStack);
- begin
- if (Typ = sfNoUninstall) and IsUninstaller then
- NoUninstallFuncError(OrgName)
- else if (Typ = sfOnlyUninstall) and not IsUninstaller then
- OnlyUninstallFuncError(OrgName)
- else
- ScriptFunc(Caller, OrgName, Stack, Stack.Count-1);
- end;
- { Called by ROPS }
- function ScriptFuncPSProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
- begin
- var ScriptFuncEx: TScriptFuncEx;
- Result := ScriptFuncs.TryGetValue(Proc.Name, ScriptFuncEx);
- if Result then
- ScriptFuncEx.Run(Caller, Stack);
- end;
- procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec);
- {$IFDEF DEBUG}
- var
- Count: Integer;
- {$ENDIF}
- procedure RegisterScriptFunc(const Name: AnsiString; const ScriptFuncTyp: TScriptFuncTyp; const ScriptFunc: TScriptFunc); overload;
- begin
- var ScriptFuncEx: TScriptFuncEx;
- ScriptFuncs.Add(FastUpperCase(Name), TScriptFuncEx.Create(Name, ScriptFunc, ScriptFuncTyp));
- ScriptInterpreter.RegisterFunctionName(Name, ScriptFuncPSProc, nil, nil);
- {$IFDEF DEBUG}
- Inc(Count);
- {$ENDIF}
- end;
- procedure RegisterScriptFunc(const Names: array of AnsiString; const ScriptFuncTyp: TScriptFuncTyp; const ScriptFunc: TScriptFunc); overload;
- begin
- for var Name in Names do
- RegisterScriptFunc(Name, ScriptFuncTyp, ScriptFunc);
- end;
- procedure RegisterScriptFunc(const Name: AnsiString; const ScriptFunc: TScriptFunc); overload;
- begin
- RegisterScriptFunc(Name, sfNormal, ScriptFunc);
- end;
- procedure RegisterScriptFunc(const Names: array of AnsiString; const ScriptFunc: TScriptFunc); overload;
- begin
- for var Name in Names do
- RegisterScriptFunc(Name, ScriptFunc);
- end;
- procedure RegisterScriptDlgScriptFuncs;
- begin
- RegisterScriptFunc('PageFromID', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetClass(PStart, GetWizardForm.PageFromID(Stack.GetInt(PStart-1)));
- end);
- RegisterScriptFunc('PageIndexFromID', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetInt(PStart, GetWizardForm.PageIndexFromID(Stack.GetInt(PStart-1)));
- end);
- RegisterScriptFunc('CreateCustomPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var NewPage := TWizardPage.Create(GetWizardForm);
- try
- NewPage.Caption := Stack.GetString(PStart-2);
- NewPage.Description := Stack.GetString(PStart-3);
- GetWizardForm.AddPage(NewPage, Stack.GetInt(PStart-1));
- except
- NewPage.Free;
- raise;
- end;
- Stack.SetClass(PStart, NewPage);
- end);
- RegisterScriptFunc('CreateInputQueryPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var NewInputQueryPage := TInputQueryWizardPage.Create(GetWizardForm);
- try
- NewInputQueryPage.Caption := Stack.GetString(PStart-2);
- NewInputQueryPage.Description := Stack.GetString(PStart-3);
- GetWizardForm.AddPage(NewInputQueryPage, Stack.GetInt(PStart-1));
- NewInputQueryPage.Initialize(Stack.GetString(PStart-4));
- except
- NewInputQueryPage.Free;
- raise;
- end;
- Stack.SetClass(PStart, NewInputQueryPage);
- end);
- RegisterScriptFunc('CreateInputOptionPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var NewInputOptionPage := TInputOptionWizardPage.Create(GetWizardForm);
- try
- NewInputOptionPage.Caption := Stack.GetString(PStart-2);
- NewInputOptionPage.Description := Stack.GetString(PStart-3);
- GetWizardForm.AddPage(NewInputOptionPage, Stack.GetInt(PStart-1));
- NewInputOptionPage.Initialize(Stack.GetString(PStart-4),
- Stack.GetBool(PStart-5), Stack.GetBool(PStart-6));
- except
- NewInputOptionPage.Free;
- raise;
- end;
- Stack.SetClass(PStart, NewInputOptionPage);
- end);
- RegisterScriptFunc('CreateInputDirPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var NewInputDirPage := TInputDirWizardPage.Create(GetWizardForm);
- try
- NewInputDirPage.Caption := Stack.GetString(PStart-2);
- NewInputDirPage.Description := Stack.GetString(PStart-3);
- GetWizardForm.AddPage(NewInputDirPage, Stack.GetInt(PStart-1));
- NewInputDirPage.Initialize(Stack.GetString(PStart-4), Stack.GetBool(PStart-5),
- Stack.GetString(PStart-6));
- except
- NewInputDirPage.Free;
- raise;
- end;
- Stack.SetClass(PStart, NewInputDirPage);
- end);
- RegisterScriptFunc('CreateInputFilePage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var NewInputFilePage := TInputFileWizardPage.Create(GetWizardForm);
- try
- NewInputFilePage.Caption := Stack.GetString(PStart-2);
- NewInputFilePage.Description := Stack.GetString(PStart-3);
- GetWizardForm.AddPage(NewInputFilePage, Stack.GetInt(PStart-1));
- NewInputFilePage.Initialize(Stack.GetString(PStart-4));
- except
- NewInputFilePage.Free;
- raise;
- end;
- Stack.SetClass(PStart, NewInputFilePage);
- end);
- RegisterScriptFunc('CreateOutputMsgPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var NewOutputMsgPage := TOutputMsgWizardPage.Create(GetWizardForm);
- try
- NewOutputMsgPage.Caption := Stack.GetString(PStart-2);
- NewOutputMsgPage.Description := Stack.GetString(PStart-3);
- GetWizardForm.AddPage(NewOutputMsgPage, Stack.GetInt(PStart-1));
- NewOutputMsgPage.Initialize(Stack.GetString(PStart-4));
- except
- NewOutputMsgPage.Free;
- raise;
- end;
- Stack.SetClass(PStart, NewOutputMsgPage);
- end);
- RegisterScriptFunc('CreateOutputMsgMemoPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var NewOutputMsgMemoPage := TOutputMsgMemoWizardPage.Create(GetWizardForm);
- try
- NewOutputMsgMemoPage.Caption := Stack.GetString(PStart-2);
- NewOutputMsgMemoPage.Description := Stack.GetString(PStart-3);
- GetWizardForm.AddPage(NewOutputMsgMemoPage, Stack.GetInt(PStart-1));
- NewOutputMsgMemoPage.Initialize(Stack.GetString(PStart-4),
- Stack.GetAnsiString(PStart-5));
- except
- NewOutputMsgMemoPage.Free;
- raise;
- end;
- Stack.SetClass(PStart, NewOutputMsgMemoPage);
- end);
- RegisterScriptFunc('CreateOutputProgressPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var NewOutputProgressPage := TOutputProgressWizardPage.Create(GetWizardForm);
- try
- NewOutputProgressPage.Caption := Stack.GetString(PStart-1);
- NewOutputProgressPage.Description := Stack.GetString(PStart-2);
- GetWizardForm.AddPage(NewOutputProgressPage, -1);
- NewOutputProgressPage.Initialize;
- except
- NewOutputProgressPage.Free;
- raise;
- end;
- Stack.SetClass(PStart, NewOutputProgressPage);
- end);
- RegisterScriptFunc('CreateOutputMarqueeProgressPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var NewOutputMarqueeProgressPage := TOutputMarqueeProgressWizardPage.Create(GetWizardForm);
- try
- NewOutputMarqueeProgressPage.Caption := Stack.GetString(PStart-1);
- NewOutputMarqueeProgressPage.Description := Stack.GetString(PStart-2);
- GetWizardForm.AddPage(NewOutputMarqueeProgressPage, -1);
- NewOutputMarqueeProgressPage.Initialize;
- except
- NewOutputMarqueeProgressPage.Free;
- raise;
- end;
- Stack.SetClass(PStart, NewOutputMarqueeProgressPage);
- end);
- RegisterScriptFunc('CreateDownloadPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin;
- var NewDownloadPage := TDownloadWizardPage.Create(GetWizardForm);
- try
- NewDownloadPage.Caption := Stack.GetString(PStart-1);
- NewDownloadPage.Description := Stack.GetString(PStart-2);
- GetWizardForm.AddPage(NewDownloadPage, -1);
- NewDownloadPage.Initialize;
- NewDownloadPage.OnDownloadProgress := TOnDownloadProgress(Stack.GetProc(PStart-3, Caller));
- except
- NewDownloadPage.Free;
- raise;
- end;
- Stack.SetClass(PStart, NewDownloadPage);
- end);
- RegisterScriptFunc('CreateExtractionPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var NewExtractionPage := TExtractionWizardPage.Create(GetWizardForm);
- try
- NewExtractionPage.Caption := Stack.GetString(PStart-1);
- NewExtractionPage.Description := Stack.GetString(PStart-2);
- GetWizardForm.AddPage(NewExtractionPage, -1);
- NewExtractionPage.Initialize;
- NewExtractionPage.OnExtractionProgress := TOnExtractionProgress(Stack.GetProc(PStart-3, Caller));
- except
- NewExtractionPage.Free;
- raise;
- end;
- Stack.SetClass(PStart, NewExtractionPage);
- end);
- RegisterScriptFunc('SCALEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- InitializeScaleBaseUnits;
- Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitX, OrigBaseUnitX));
- end);
- RegisterScriptFunc('SCALEY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- InitializeScaleBaseUnits;
- Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitY, OrigBaseUnitY));
- end);
- RegisterScriptFunc('CREATECUSTOMFORM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var NewSetupForm := TSetupForm.CreateNew(nil);
- try
- NewSetupForm.PopupMode := pmAuto;
- NewSetupForm.AutoScroll := False;
- NewSetupForm.BorderStyle := bsDialog;
- NewSetupForm.InitializeFont;
- except
- NewSetupForm.Free;
- raise;
- end;
- Stack.SetClass(PStart, NewSetupForm);
- end);
- end;
- procedure RegisterNewDiskFormScriptFuncs;
- begin
- RegisterScriptFunc('SELECTDISK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var S := Stack.GetString(PStart-3);
- Stack.SetBool(PStart, SelectDisk(Stack.GetInt(PStart-1), Stack.GetString(PStart-2), S));
- Stack.SetString(PStart-3, S);
- end);
- end;
- procedure RegisterBrowseFuncScriptFuncs;
- begin
- RegisterScriptFunc('BROWSEFORFOLDER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var S := Stack.GetString(PStart-2);
- Stack.SetBool(PStart, BrowseForFolder(Stack.GetString(PStart-1), S, GetOwnerWndForMessageBox, Stack.GetBool(PStart-3)));
- Stack.SetString(PStart-2, S);
- end);
- RegisterScriptFunc('GETOPENFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var S := Stack.GetString(PStart-2);
- Stack.SetBool(PStart, NewGetOpenFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), GetOwnerWndForMessageBox));
- Stack.SetString(PStart-2, S);
- end);
- RegisterScriptFunc('GETOPENFILENAMEMULTI', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, NewGetOpenFileNameMulti(Stack.GetString(PStart-1), TStrings(Stack.GetClass(PStart-2)), Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), GetOwnerWndForMessageBox));
- end);
- RegisterScriptFunc('GETSAVEFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var S := Stack.GetString(PStart-2);
- Stack.SetBool(PStart, NewGetSaveFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), GetOwnerWndForMessageBox));
- Stack.SetString(PStart-2, S);
- end);
- end;
- procedure RegisterCommonFuncVclScriptFuncs;
- begin
- RegisterScriptFunc('MINIMIZEPATHNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, MinimizePathName(Stack.GetString(PStart-1), TFont(Stack.GetClass(PStart-2)), Stack.GetInt(PStart-3)));
- end);
- end;
- procedure RegisterCommonFuncScriptFuncs;
- begin
- RegisterScriptFunc('FILEEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, NewFileExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('DIREXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, DirExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('FILEORDIREXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, FileOrDirExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('GETINISTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, GetIniString(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetString(PStart-4)));
- end);
- RegisterScriptFunc('GETINIINT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetInt(PStart, GetIniInt(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4), Stack.GetInt(PStart-5), Stack.GetString(PStart-6)));
- end);
- RegisterScriptFunc('GETINIBOOL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, GetIniBool(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), Stack.GetString(PStart-4)));
- end);
- RegisterScriptFunc('INIKEYEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, IniKeyExists(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3)));
- end);
- RegisterScriptFunc('ISINISECTIONEMPTY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, IsIniSectionEmpty(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
- end);
- RegisterScriptFunc('SETINISTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, SetIniString(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetString(PStart-4)));
- end);
- RegisterScriptFunc('SETINIINT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, SetIniInt(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetInt(PStart-3), Stack.GetString(PStart-4)));
- end);
- RegisterScriptFunc('SETINIBOOL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, SetIniBool(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), Stack.GetString(PStart-4)));
- end);
- RegisterScriptFunc('DELETEINIENTRY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- DeleteIniEntry(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetString(PStart-2));
- end);
- RegisterScriptFunc('DELETEINISECTION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- DeleteIniSection(Stack.GetString(PStart), Stack.GetString(PStart-1));
- end);
- RegisterScriptFunc('GETENV', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, GetEnv(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('GETCMDTAIL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, GetCmdTail);
- end);
- RegisterScriptFunc('PARAMCOUNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- if NewParamsForCode.Count = 0 then
- InternalError('NewParamsForCode not set');
- Stack.SetInt(PStart, NewParamsForCode.Count-1);
- end);
- RegisterScriptFunc('PARAMSTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var I := Stack.GetInt(PStart-1);
- if (I >= 0) and (I < NewParamsForCode.Count) then
- Stack.SetString(PStart, NewParamsForCode[I])
- else
- Stack.SetString(PStart, '');
- end);
- RegisterScriptFunc('ADDBACKSLASH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, AddBackslash(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('REMOVEBACKSLASH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, RemoveBackslash(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('REMOVEBACKSLASHUNLESSROOT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, RemoveBackslashUnlessRoot(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('ADDQUOTES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, AddQuotes(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('REMOVEQUOTES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, RemoveQuotes(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('GETSHORTNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, GetShortNameRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('GETWINDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, GetWinDir);
- end);
- RegisterScriptFunc('GETSYSTEMDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, GetSystemDir);
- end);
- RegisterScriptFunc('GETSYSWOW64DIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, GetSysWow64Dir);
- end);
- RegisterScriptFunc('GETSYSNATIVEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, GetSysNativeDir(IsWin64));
- end);
- RegisterScriptFunc('GETTEMPDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, GetTempDir);
- end);
- RegisterScriptFunc('STRINGCHANGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var S := Stack.GetString(PStart-1);
- Stack.SetInt(PStart, StringChange(S, Stack.GetString(PStart-2), Stack.GetString(PStart-3)));
- Stack.SetString(PStart-1, S);
- end);
- RegisterScriptFunc('STRINGCHANGEEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var S := Stack.GetString(PStart-1);
- Stack.SetInt(PStart, StringChangeEx(S, Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetBool(PStart-4)));
- Stack.SetString(PStart-1, S);
- end);
- RegisterScriptFunc('USINGWINNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, True);
- end);
- RegisterScriptFunc(['COPYFILE', 'FILECOPY'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var ExistingFilename := Stack.GetString(PStart-1);
- if not IsProtectedSrcExe(ExistingFilename) then
- Stack.SetBool(PStart, CopyFileRedir(ScriptFuncDisableFsRedir,
- ExistingFilename, Stack.GetString(PStart-2), Stack.GetBool(PStart-3)))
- else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc('CONVERTPERCENTSTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var S := Stack.GetString(PStart-1);
- Stack.SetBool(PStart, ConvertPercentStr(S));
- Stack.SetString(PStart-1, S);
- end);
- RegisterScriptFunc('REGKEYEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKeyName := Stack.GetString(PStart-2);
- var K: HKEY;
- if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
- Stack.SetBool(PStart, True);
- RegCloseKey(K);
- end else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc('REGVALUEEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKeyName := Stack.GetString(PStart-2);
- var K: HKEY;
- if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
- var ValueName := Stack.GetString(PStart-3);
- Stack.SetBool(PStart, RegValueExists(K, PChar(ValueName)));
- RegCloseKey(K);
- end else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc('REGDELETEKEYINCLUDINGSUBKEYS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKey := Stack.GetString(PStart-2);
- Stack.SetBool(PStart, RegDeleteKeyIncludingSubkeys(RegView, RootKey, PChar(SubKey)) = ERROR_SUCCESS);
- end);
- RegisterScriptFunc('REGDELETEKEYIFEMPTY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKeyName := Stack.GetString(PStart-2);
- Stack.SetBool(PStart, RegDeleteKeyIfEmpty(RegView, RootKey, PChar(SubKeyName)) = ERROR_SUCCESS);
- end);
- RegisterScriptFunc('REGDELETEVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKeyName := Stack.GetString(PStart-2);
- var K: HKEY;
- if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
- var ValueName := Stack.GetString(PStart-3);
- Stack.SetBool(PStart, RegDeleteValue(K, PChar(ValueName)) = ERROR_SUCCESS);
- RegCloseKey(K);
- end else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc('REGGETSUBKEYNAMES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey,
- Stack.GetString(PStart-2), Stack, PStart-3, True));
- end);
- RegisterScriptFunc('REGGETVALUENAMES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey,
- Stack.GetString(PStart-2), Stack, PStart-3, False));
- end);
- RegisterScriptFunc('REGQUERYSTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKeyName := Stack.GetString(PStart-2);
- var K: HKEY;
- if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
- var ValueName := Stack.GetString(PStart-3);
- var S := Stack.GetString(PStart-4);
- Stack.SetBool(PStart, RegQueryStringValue(K, PChar(ValueName), S));
- Stack.SetString(PStart-4, S);
- RegCloseKey(K);
- end else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc('REGQUERYMULTISTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKeyName := Stack.GetString(PStart-2);
- var K: HKEY;
- if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
- var ValueName := Stack.GetString(PStart-3);
- var S := Stack.GetString(PStart-4);
- Stack.SetBool(PStart, RegQueryMultiStringValue(K, PChar(ValueName), S));
- Stack.SetString(PStart-4, S);
- RegCloseKey(K);
- end else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc('REGQUERYDWORDVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKeyName := Stack.GetString(PStart-2);
- var K: HKEY;
- if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
- var ValueName := Stack.GetString(PStart-3);
- var Typ, Data: DWORD;
- var Size: DWORD := SizeOf(Data);
- if (RegQueryValueEx(K, PChar(ValueName), nil, @Typ, @Data, @Size) = ERROR_SUCCESS) and (Typ = REG_DWORD) then begin
- Stack.SetInt(PStart-4, Data);
- Stack.SetBool(PStart, True);
- end else
- Stack.SetBool(PStart, False);
- RegCloseKey(K);
- end else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc('REGQUERYBINARYVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKeyName := Stack.GetString(PStart-2);
- var K: HKEY;
- if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
- var ValueName := Stack.GetString(PStart-3);
- var Typ, Size: DWORD;
- if RegQueryValueEx(K, PChar(ValueName), nil, @Typ, nil, @Size) = ERROR_SUCCESS then begin
- var Data: AnsiString;
- SetLength(Data, Size);
- if RegQueryValueEx(K, PChar(ValueName), nil, @Typ, @Data[1], @Size) = ERROR_SUCCESS then begin
- Stack.SetAnsiString(PStart-4, Data);
- Stack.SetBool(PStart, True);
- end else
- Stack.SetBool(PStart, False);
- end else
- Stack.SetBool(PStart, False);
- RegCloseKey(K);
- end else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc('REGWRITESTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKeyName := Stack.GetString(PStart-2);
- var K: HKEY;
- if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin
- var ValueName := Stack.GetString(PStart-3);
- var Data := Stack.GetString(PStart-4);
- var Typ, ExistingTyp: DWORD;
- if (RegQueryValueEx(K, PChar(ValueName), nil, @ExistingTyp, nil, nil) = ERROR_SUCCESS) and (ExistingTyp = REG_EXPAND_SZ) then
- Typ := REG_EXPAND_SZ
- else
- Typ := REG_SZ;
- if RegSetValueEx(K, PChar(ValueName), 0, Typ, PChar(Data), (Length(Data)+1)*SizeOf(Data[1])) = ERROR_SUCCESS then
- Stack.SetBool(PStart, True)
- else
- Stack.SetBool(PStart, False);
- RegCloseKey(K);
- end else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc('REGWRITEEXPANDSTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKeyName := Stack.GetString(PStart-2);
- var K: HKEY;
- if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin
- var ValueName := Stack.GetString(PStart-3);
- var Data := Stack.GetString(PStart-4);
- if RegSetValueEx(K, PChar(ValueName), 0, REG_EXPAND_SZ, PChar(Data), (Length(Data)+1)*SizeOf(Data[1])) = ERROR_SUCCESS then
- Stack.SetBool(PStart, True)
- else
- Stack.SetBool(PStart, False);
- RegCloseKey(K);
- end else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc('REGWRITEMULTISTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKeyName := Stack.GetString(PStart-2);
- var K: HKEY;
- if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin
- var ValueName := Stack.GetString(PStart-3);
- var Data := Stack.GetString(PStart-4);
- { Multi-string data requires two null terminators: one after the last
- string, and one to mark the end.
- Delphi's String type is implicitly null-terminated, so only one null
- needs to be added to the end. }
- if (Data <> '') and (Data[Length(Data)] <> #0) then
- Data := Data + #0;
- if RegSetValueEx(K, PChar(ValueName), 0, REG_MULTI_SZ, PChar(Data), (Length(Data)+1)*SizeOf(Data[1])) = ERROR_SUCCESS then
- Stack.SetBool(PStart, True)
- else
- Stack.SetBool(PStart, False);
- RegCloseKey(K);
- end else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc('REGWRITEDWORDVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKeyName := Stack.GetString(PStart-2);
- var K: HKEY;
- if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin
- var ValueName := Stack.GetString(PStart-3);
- var Data: DWORD := Stack.GetInt(PStart-4);
- if RegSetValueEx(K, PChar(ValueName), 0, REG_DWORD, @Data, SizeOf(Data)) = ERROR_SUCCESS then
- Stack.SetBool(PStart, True)
- else
- Stack.SetBool(PStart, False);
- RegCloseKey(K);
- end else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc('REGWRITEBINARYVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
- var SubKeyName := Stack.GetString(PStart-2);
- var K: HKEY;
- if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin
- var ValueName := Stack.GetString(PStart-3);
- var Data := Stack.GetAnsiString(PStart-4);
- if RegSetValueEx(K, PChar(ValueName), 0, REG_BINARY, @Data[1], Length(Data)) = ERROR_SUCCESS then
- Stack.SetBool(PStart, True)
- else
- Stack.SetBool(PStart, False);
- RegCloseKey(K);
- end else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc(['ISADMIN', 'ISADMINLOGGEDON'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, IsAdmin);
- end);
- RegisterScriptFunc('ISPOWERUSERLOGGEDON', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, IsPowerUserLoggedOn);
- end);
- RegisterScriptFUnc('ISADMININSTALLMODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, IsAdminInstallMode);
- end);
- RegisterScriptFunc('FONTEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, FontExists(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('GETUILANGUAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetInt(PStart, GetUILanguage);
- end);
- RegisterScriptFunc('ADDPERIOD', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetString(PStart, AddPeriod(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('CHARLENGTH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetInt(PStart, PathCharLength(Stack.GetString(PStart-1), Stack.GetInt(PStart-2)));
- end);
- RegisterScriptFunc('SETNTFSCOMPRESSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, SetNTFSCompressionRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetBool(PStart-2)));
- end);
- RegisterScriptFunc('ISWILDCARD', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetBool(PStart, IsWildcard(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('WILDCARDMATCH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- var S := Stack.GetString(PStart-1);
- var N := Stack.GetString(PStart-2);
- Stack.SetBool(PStart, WildcardMatch(PChar(S), PChar(N)));
- end);
- end;
- procedure RegisterInstallScriptFuncs;
- begin
- RegisterScriptFunc('ExtractTemporaryFile', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- ExtractTemporaryFile(Stack.GetString(PStart));
- end);
- RegisterScriptFunc('ExtractTemporaryFiles', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- Stack.SetInt(PStart, ExtractTemporaryFiles(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc(['DownloadTemporaryFile', 'DownloadTemporaryFileWithISSigVerify'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
- begin
- const ISSigVerify = OrgName = 'DownloadTemporaryFileWithISSigVerify';
- var Url, ISSigUrl, BaseName, RequiredSHA256OfFile: String;
- var ISSigAllowedKeys: AnsiString;
- var OnDownloadProgress: TOnDownloadProgress;
- if ISSigVerify then begin
- Url := Stack.GetString(PStart-1);
- ISSigUrl := Stack.GetString(PStart-2);
- BaseName := Stack.GetString(PStart-3);
- ISSigAllowedKeys := ConvertAllowedKeysRuntimeIDsToISSigAllowedKeys(TStringList(Stack.GetClass(PStart-4)));
- OnDownloadProgress := TOnDownloadProgress(Stack.GetProc(PStart-5, Caller));
- end else begin
- Url := Stack.GetString(PStart-1);
- BaseName := Stack.GetString(PStart-2);
- RequiredSHA256OfFile := Stack.GetString(PStart-3);
- OnDownloadProgress := TOnDownloadProgress(Stack.GetProc(PStart-4, Caller));
- end;
- var Verification := NoVerification;
- if RequiredSHA256OfFile <> '' then begin
- Verification.Typ := fvHash;
- Verification.Hash := SHA256DigestFromString(RequiredSHA256OfFile)
- end else if ISSigVerify then begin
- Verification.Typ := fvISSig;
- Verification.ISSigAllowedKeys := ISSigAllowedKeys
- end;
- 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('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.
|