| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115 |
- unit Setup.ScriptFunc;
- {
- Inno Setup
- Copyright (C) 1997-2026 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, Math,
- uPSUtils, PathFunc, ISSigFunc, ECDSA, BrowseFunc, MD5, SHA1, SHA256, BitmapButton, BitmapImage,
- PSStackHelper, UnsignedFunc,
- Shared.Struct, Setup.WizardForm.CustomPages, Setup.MainFunc, Shared.CommonFunc.Vcl,
- Shared.CommonFunc, Shared.FileClass, SetupLdrAndSetup.InstFunc,
- Setup.DownloadFileFunc, Setup.ExtractFileFunc, Setup.ISSigVerifyFunc, Setup.InstFunc, Setup.InstFunc.Ole,
- SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.NewDiskForm,
- Setup.WizardForm, Shared.VerInfoFunc, Shared.SetupTypes,
- Setup.LoggingFunc, Setup.SetupForm, Setup.RegDLL,
- Setup.SpawnClient, Setup.DotNetFunc,
- Shared.DotNetVersion, Setup.MsiFunc, Compression.SevenZipDecoder, Compression.SevenZipDLLDecoder,
- Setup.DebugClient, Shared.ScriptFunc, Setup.ScriptFunc.HelperFunc, Setup.PathRedir;
- type
- TScriptFunc = reference to procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer);
- 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, Integer(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: Integer)
- 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: Integer)
- begin
- Stack.SetNativeInt(PStart, GetWizardForm.PageIndexFromID(Stack.GetInt(PStart-1)));
- end);
- RegisterScriptFunc('CreateCustomPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- begin
- InitializeScaleBaseUnits;
- Stack.SetInt(PStart, TSetupForm.ScalePixelsX(OrigScaleBaseUnitX, ScaleBaseUnitX, Stack.GetInt(PStart-1)));
- end);
- RegisterScriptFunc('SCALEY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- InitializeScaleBaseUnits;
- Stack.SetInt(PStart, TSetupForm.ScalePixelsY(OrigScaleBaseUnitY, ScaleBaseUnitY, Stack.GetInt(PStart-1)));
- end);
- RegisterScriptFunc('CREATECUSTOMFORM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var NewSetupForm := TSetupForm.CreateNew(nil);
- try
- NewSetupForm.PopupMode := pmAuto;
- NewSetupForm.AutoScroll := False;
- NewSetupForm.BorderStyle := bsDialog;
- NewSetupForm.ClientWidth := Stack.GetInt(PStart-1);
- NewSetupForm.ClientHeight := Stack.GetInt(PStart-2);
- NewSetupForm.InitializeFont(Stack.GetBool(PStart-3), Stack.GetBool(PStart-4));
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- begin
- Stack.SetBool(PStart, NewFileExists(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('DIREXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, DirExists(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('FILEORDIREXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, FileOrDirExists(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('GETINISTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- begin
- DeleteIniSection(Stack.GetString(PStart), Stack.GetString(PStart-1));
- end);
- RegisterScriptFunc('GETENV', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, GetEnv(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('GETCMDTAIL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, GetCmdTail);
- end);
- RegisterScriptFunc('PARAMCOUNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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('ADDQUOTES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, AddQuotes(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('REMOVEQUOTES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, RemoveQuotes(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('GETSHORTNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, GetShortName(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('GETWINDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, GetWinDir);
- end);
- RegisterScriptFunc('GETSYSTEMDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, GetSystemDir);
- end);
- RegisterScriptFunc('GETSYSWOW64DIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, GetSysWow64Dir);
- end);
- RegisterScriptFunc('GETSYSNATIVEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, GetSysNativeDir(IsWin64));
- end);
- RegisterScriptFunc('GETTEMPDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, GetTempDir);
- end);
- RegisterScriptFunc('STRINGCHANGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- begin
- Stack.SetBool(PStart, True);
- end);
- RegisterScriptFunc(['COPYFILE', 'FILECOPY'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var ExistingFilename := Stack.GetString(PStart-1);
- if not IsProtectedSrcExe(ExistingFilename) then
- Stack.SetBool(PStart, CopyFile(PChar(ExistingFilename), PChar(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: Integer)
- 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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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, PByte(@Data), @Size) = ERROR_SUCCESS) and (Typ = REG_DWORD) then begin
- Stack.SetInt(PStart-4, Integer(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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, PByte(@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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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), (ULength(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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), (ULength(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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), (ULength(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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.GetUInt(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: Integer)
- begin
- var RegView: TRegView;
- var RootKey: HKEY;
- CrackCodeRootKey(UInt32(Stack.GetNativeUInt(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], ULength(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: Integer)
- begin
- Stack.SetBool(PStart, IsAdmin);
- end);
- RegisterScriptFunc('ISPOWERUSERLOGGEDON', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, IsPowerUserLoggedOn);
- end);
- RegisterScriptFUnc('ISADMININSTALLMODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, IsAdminInstallMode);
- end);
- RegisterScriptFunc('FONTEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, FontExists(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('GETUILANGUAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetInt(PStart, GetUILanguage);
- end);
- RegisterScriptFunc('ADDPERIOD', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, AddPeriod(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('SETNTFSCOMPRESSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, SetNTFSCompression(Stack.GetString(PStart-1), Stack.GetBool(PStart-2)));
- end);
- RegisterScriptFunc('ISWILDCARD', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, IsWildcard(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('WILDCARDMATCH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var S := Stack.GetString(PStart-1);
- var N := Stack.GetString(PStart-2);
- Stack.SetBool(PStart, WildcardMatch(PChar(S), PChar(N)));
- end);
- RegisterScriptFunc('HighContrastActive', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, HighContrastActive);
- end);
- end;
- procedure RegisterPathFuncScriptFuncs;
- begin
- RegisterScriptFunc('AddBackslash', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, AddBackslash(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('RemoveBackslash', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, RemoveBackslash(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('RemoveBackslashUnlessRoot', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, RemoveBackslashUnlessRoot(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('PathCombine', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, PathCombine(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
- end);
- RegisterScriptFunc('PathHasInvalidCharacters', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, PathHasInvalidCharacters(Stack.GetString(PStart-1), Stack.GetBool(PStart-2)));
- end);
- RegisterScriptFunc('PathIsRooted', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, PathIsRooted(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('PathNormalizeSlashes', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, PathNormalizeSlashes(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('PathSame', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, PathSame(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
- end);
- RegisterScriptFunc('PathStartsWith', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, PathStartsWith(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3)));
- end);
- RegisterScriptFunc('PathEndsWith', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, PathEndsWith(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3)));
- end);
- RegisterScriptFunc('PathConvertNormalToSuper', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var SuperFilename: String;
- Stack.SetBool(PStart, PathConvertNormalToSuper(Stack.GetString(PStart-1), SuperFilename, Stack.GetBool(PStart-3)));
- Stack.SetString(PStart-2, SuperFilename);
- end);
- RegisterScriptFunc('PathConvertSuperToNormal', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, PathConvertSuperToNormal(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('CHARLENGTH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetInt(PStart, PathCharLength(Stack.GetString(PStart-1), Stack.GetInt(PStart-2)));
- end);
- RegisterScriptFunc('EXPANDFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, PathExpand(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('EXTRACTFILEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, PathExtractDir(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('EXTRACTFILEDRIVE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, PathExtractDrive(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('EXTRACTFILEEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, PathExtractExt(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('EXTRACTFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, PathExtractName(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('EXTRACTFILEPATH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, PathExtractPath(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('CHANGEFILEEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, PathChangeExt(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
- end);
- end;
- procedure RegisterInstallScriptFuncs;
- begin
- RegisterScriptFunc('ExtractTemporaryFile', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- ExtractTemporaryFile(Stack.GetString(PStart));
- end);
- RegisterScriptFunc('ExtractTemporaryFiles', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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.WizardForm.CustomPages TDownloadWizardPage.AddExWithISSigVerify }
- if ISSigVerify then
- DownloadTemporaryFile(GetISSigUrl(Url, ISSigUrl), BaseName + ISSigExt, NoVerification, Throttler.OnDownloadProgress, nil);
- Throttler.Reset;
- Stack.SetInt64(PStart, DownloadTemporaryFile(Url, BaseName, Verification, Throttler.OnDownloadProgress, nil));
- finally
- Throttler.Free;
- end;
- end);
- RegisterScriptFunc('DownloadTemporaryFileSize', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- begin
- Stack.SetBool(PStart, CheckForMutexes(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('DECREMENTSHAREDCOUNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- begin
- DelayDeleteFile(Stack.GetString(PStart), Stack.GetInt(PStart-1), 250, 250);
- end);
- RegisterScriptFunc('DELTREE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, DelTree(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: Integer)
- begin
- Stack.SetString(PStart, GenerateUniqueName(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
- end);
- RegisterScriptFunc('GETCOMPUTERNAMESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, GetComputerNameString);
- end);
- RegisterScriptFunc('GETMD5OFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, MD5DigestToString(GetMD5OfFile(Stack.GetString(PStart-1))));
- end);
- RegisterScriptFunc('GETMD5OFSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- begin
- Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfFile(Stack.GetString(PStart-1))));
- end);
- RegisterScriptFunc('GETSHA1OFSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- begin
- Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfFile(Stack.GetString(PStart-1))));
- end);
- RegisterScriptFunc('GETSHA256OFSTREAM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- begin
- var FreeBytes, TotalBytes: Int64;
- if GetSpaceOnDisk(Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin
- if Stack.GetBool(PStart-2) then begin
- FreeBytes := FreeBytes div (1024*1024);
- TotalBytes := TotalBytes div (1024*1024);
- end;
- { Cap at 2 GB, as GetSpaceOnDisk doesn't use 64-bit integers }
- const MaxBytes = High(Int32);
- if FreeBytes > MaxBytes then
- FreeBytes := MaxBytes;
- if TotalBytes > MaxBytes then
- TotalBytes := MaxBytes;
- Stack.SetUInt(PStart-3, Cardinal(FreeBytes));
- Stack.SetUInt(PStart-4, Cardinal(TotalBytes));
- 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: Integer)
- begin
- var FreeBytes, TotalBytes: Int64;
- if GetSpaceOnDisk(Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin
- Stack.SetInt64(PStart-2, FreeBytes);
- Stack.SetInt64(PStart-3, TotalBytes);
- 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: Integer)
- begin
- Stack.SetString(PStart, GetUserNameString);
- end);
- RegisterScriptFunc('INCREMENTSHAREDCOUNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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', 'ExecAndLogOutput', 'ExecAndCaptureOutput',
- 'ExecWithNativeSysDir', 'ExecAndLogOutputWithNativeSysDir', 'ExecAndCaptureOutputWithNativeSysDir',
- 'ExecAsOriginalUser'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- const RunAsOriginalUser = OrgName = 'ExecAsOriginalUser';
- if IsUninstaller and RunAsOriginalUser then
- NoUninstallFuncError(OrgName);
- const S = String(OrgName);
- const LogOutput = S.Contains('LogOutput');
- const CaptureOutput = S.Contains('CaptureOutput');
- const WithNativeSysDir = S.Contains('WithNativeSysDir');
- var Method: TMethod; { Must stay alive until OutputReader is freed }
- var OutputReader: TCreateProcessOutputReader := nil;
- try
- if LogOutput 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 CaptureOutput 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: DWORD;
- try
- Stack.SetBool(PStart, InstExecEx(RunAsOriginalUser,
- IsWin64 and WithNativeSysDir, 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, Integer(ResultCode));
- if CaptureOutput 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: Integer)
- 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: DWORD;
- 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, Integer(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: Integer)
- begin
- Stack.SetBool(PStart, IsProtectedSystemFile(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('MAKEPENDINGFILERENAMEOPERATIONSCHECKSUM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, SHA256DigestToString(MakePendingFileRenameOperationsChecksum));
- end);
- RegisterScriptFunc('MODIFYPIFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- begin
- RestartReplace(Stack.GetString(PStart), Stack.GetString(PStart-1));
- end);
- RegisterScriptFunc('FORCEDIRECTORIES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, ForceDirectories(Stack.GetString(PStart-1)));
- end);
- end;
- procedure RegisterInstFuncOleScriptFuncs;
- begin
- RegisterScriptFunc('CREATESHELLLINK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- begin
- const Is64Bit = Stack.GetBool(PStart);
- {$IFDEF WIN64}
- if not Is64Bit then
- InternalError('Cannot register 32-bit type libraries on this version of Setup');
- {$ELSE}
- if Is64Bit then
- InternalError('Cannot register 64-bit type libraries on this version of Setup');
- {$ENDIF}
- RegisterTypeLibrary(Stack.GetString(PStart-1));
- end);
- RegisterScriptFunc('UNREGISTERTYPELIBRARY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- const Is64Bit = Stack.GetBool(PStart-1);
- {$IFDEF WIN64}
- if not Is64Bit then
- InternalError('Cannot unregister 32-bit type libraries on this version of Setup');
- {$ELSE}
- if Is64Bit then
- InternalError('Cannot unregister 64-bit type libraries on this version of Setup');
- {$ENDIF}
- try
- 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: Integer)
- 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: Integer)
- begin
- Stack.SetString(PStart, ExpandConst('{language}'));
- end);
- RegisterScriptFunc('EXPANDCONSTANT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, ExpandConst(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('EXPANDCONSTANTEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- begin
- Stack.SetBool(PStart, ExitSetupMsgBox);
- end);
- RegisterScriptFunc('GETSHELLFOLDERBYCSIDL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- begin
- Stack.SetUInt(PStart, WindowsVersion);
- end);
- RegisterScriptFunc('GETWINDOWSVERSIONSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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), '', TMsgBoxType(Stack.GetInt(PStart-2)), Cardinal(Stack.GetInt(PStart-3)), Suppressible, Default));
- end);
- RegisterScriptFunc(['TaskDialogMsgBox', 'SuppressibleTaskDialogMsgBox'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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), '', TMsgBoxType(Stack.GetInt(PStart-3)), Cardinal(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: Integer)
- begin
- Stack.SetBool(PStart, IsWin64);
- end);
- RegisterScriptFunc('IS64BITINSTALLMODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, Is64BitInstallMode);
- end);
- RegisterScriptFunc('IsWinDark', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, IsWinDark);
- end);
- RegisterScriptFunc('IsDarkInstallMode', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, IsDarkInstallMode);
- end);
- RegisterScriptFunc('PROCESSORARCHITECTURE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- begin
- var ArchitectureIdentifier := LowerCase(Copy(String(OrgName), 3, MaxInt));
- Stack.SetBool(PStart, EvalArchitectureIdentifier(ArchitectureIdentifier));
- end);
- RegisterScriptFunc(['IsCurrentProcess64Bit'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, IsCurrentProcess64Bit);
- end);
- RegisterScriptFunc('CUSTOMMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, CustomMessage(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('RMSESSIONSTARTED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, RmSessionStarted);
- end);
- RegisterScriptFunc('REGISTEREXTRACLOSEAPPLICATIONSRESOURCE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, CodeRegisterExtraCloseApplicationsResource(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('GETWIZARDFORM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetClass(PStart, GetWizardForm);
- end);
- RegisterScriptFunc(['WizardIsComponentSelected', 'IsComponentSelected', 'WizardIsTaskSelected', 'IsTaskSelected'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- begin
- Stack.SetInt(PStart, Integer(TStrongRandom.GenerateUInt32Range(UInt32(Stack.GetInt(PStart-1)))));
- end);
- RegisterScriptFunc('FILESIZE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- try
- var F := TFile.Create(Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite);
- try
- Stack.SetInt(PStart-2, Integer(F.CappedSize)); { Even though CappedSize returns Cardinal, it's capped at High(Int32) }
- 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: Integer)
- begin
- try
- var F := TFile.Create(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: Integer)
- begin
- Set8087CW(Word(Stack.GetInt(PStart)));
- end);
- RegisterScriptFunc('GET8087CW', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetInt(PStart, Get8087CW);
- end);
- RegisterScriptFunc('UTF8ENCODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetAnsiString(PStart, Utf8Encode(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('UTF8DECODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- begin
- Beep;
- end);
- RegisterScriptFunc('TRIMLEFT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, TrimLeft(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('TRIMRIGHT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, TrimRight(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('GETCURRENTDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, GetCurrentDir);
- end);
- RegisterScriptFunc('SETCURRENTDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, SetCurrentDir(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('EXPANDUNCFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, ExpandUNCFileName(Stack.GetString(PStart-1)));
- end);
- RegisterScriptFunc('EXTRACTRELATIVEPATH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, NewExtractRelativePath(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
- end);
- RegisterScriptFunc('FILESEARCH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, NewFileSearch(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
- end);
- RegisterScriptFunc('RENAMEFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var OldName := Stack.GetString(PStart-1);
- if not IsProtectedSrcExe(OldName) then
- Stack.SetBool(PStart, MoveFile(PChar(OldName), PChar(Stack.GetString(PStart-2))))
- else
- Stack.SetBool(PStart, False);
- end);
- RegisterScriptFunc('DELETEFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, Windows.DeleteFile(PChar(Stack.GetString(PStart-1))));
- end);
- RegisterScriptFunc('CREATEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, CreateDirectory(PChar(Stack.GetString(PStart-1)), nil));
- end);
- RegisterScriptFunc('REMOVEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, RemoveDirectory(PChar(Stack.GetString(PStart-1))));
- end);
- RegisterScriptFunc('COMPARESTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- begin
- Stack.SetString(PStart, Win32ErrorString(Stack.GetUInt(PStart-1)));
- end);
- end;
- procedure RegisterVerInfoFuncScriptFuncs;
- begin
- RegisterScriptFunc('GETVERSIONNUMBERS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var VersionNumbers: TFileVersionNumbers;
- if GetVersionNumbers(Stack.GetString(PStart-1), VersionNumbers) then begin
- Stack.SetUInt(PStart-2, VersionNumbers.MS);
- Stack.SetUInt(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: Integer)
- begin
- var VersionNumbers: TFileVersionNumbers;
- if GetVersionNumbers(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: Integer)
- begin
- var VersionNumbers: TFileVersionNumbers;
- if GetVersionNumbers(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: Integer)
- begin
- var VersionNumbers: TFileVersionNumbers;
- if GetVersionNumbers(Stack.GetString(PStart-1), VersionNumbers) then begin
- Stack.SetInt64(PStart-2, VersionNumbersToInt64(VersionNumbers));
- 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: Integer)
- begin
- const VersionMS = Stack.GetUInt(PStart-1);
- const VersionLS = Stack.GetUInt(PStart-2);
- Stack.SetInt64(PStart, HighLowToInt64(VersionMS, VersionLS));
- end);
- RegisterScriptFunc('PACKVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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, VersionNumbersToInt64(VersionNumbers));
- end);
- RegisterScriptFunc('COMPAREPACKEDVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetInt(PStart, CompareInt64(Stack.GetInt64(PStart-1), Stack.GetInt64(PStart-2)));
- end);
- RegisterScriptFunc('SAMEPACKEDVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, Stack.GetInt64(PStart-1) = Stack.GetInt64(PStart-2));
- end);
- RegisterScriptFunc('UNPACKVERSIONNUMBERS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var VersionNumbers: TFileVersionNumbers;
- VersionNumbers.MS := UInt32(UInt64(Stack.GetInt64(PStart)) shr 32);
- VersionNumbers.LS := UInt32(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: Integer)
- begin
- var VersionNumbers: TFileVersionNumbers;
- VersionNumbers.MS := UInt32(UInt64(Stack.GetInt64(PStart)) shr 32);
- VersionNumbers.LS := UInt32(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: Integer)
- begin
- var VersionNumbers: TFileVersionNumbers;
- VersionNumbers.MS := UInt32(UInt64(Stack.GetInt64(PStart-1)) shr 32);
- VersionNumbers.LS := UInt32(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: Integer)
- begin
- var VersionNumbers: TFileVersionNumbers;
- if StrToVersionNumbers(Stack.GetString(PStart-1), VersionNumbers) then begin
- Stack.SetInt64(PStart-2, VersionNumbersToInt64(VersionNumbers));
- Stack.SetBool(PStart, True);
- end else
- Stack.SetBool(PStart, False);
- end);
- end;
- type
- TDllProc = function(const Param1, Param2: NativeInt): NativeInt; stdcall;
- procedure RegisterWindowsScriptFuncs;
- begin
- RegisterScriptFunc('SLEEP', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Sleep(Stack.GetUInt(PStart));
- end);
- RegisterScriptFunc('FINDWINDOWBYCLASSNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetNativeUInt(PStart, FindWindow(PChar(Stack.GetString(PStart-1)), nil));
- end);
- RegisterScriptFunc('FINDWINDOWBYWINDOWNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetNativeUInt(PStart, FindWindow(nil, PChar(Stack.GetString(PStart-1))));
- end);
- RegisterScriptFunc('SENDMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetNativeInt(PStart, SendMessage(Stack.GetNativeUInt(PStart-1), Stack.GetUInt(PStart-2), Stack.GetNativeUInt(PStart-3), Stack.GetNativeInt(PStart-4)));
- end);
- RegisterScriptFunc('POSTMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, PostMessage(Stack.GetNativeUInt(PStart-1), Stack.GetUInt(PStart-2), Stack.GetNativeUInt(PStart-3), Stack.GetNativeInt(PStart-4)));
- end);
- RegisterScriptFunc('SENDNOTIFYMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, SendNotifyMessage(Stack.GetNativeUInt(PStart-1), Stack.GetUInt(PStart-2), Stack.GetNativeUInt(PStart-3), Stack.GetNativeInt(PStart-4)));
- end);
- RegisterScriptFunc('REGISTERWINDOWMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetUInt(PStart, RegisterWindowMessage(PChar(Stack.GetString(PStart-1))));
- end);
- RegisterScriptFunc('SENDBROADCASTMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetNativeInt(PStart, SendMessage(HWND_BROADCAST, Stack.GetUInt(PStart-1), Stack.GetNativeUInt(PStart-2), Stack.GetNativeInt(PStart-3)));
- end);
- RegisterScriptFunc('POSTBROADCASTMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, PostMessage(HWND_BROADCAST, Stack.GetUInt(PStart-1), Stack.GetNativeUInt(PStart-2), Stack.GetNativeInt(PStart-3)));
- end);
- RegisterScriptFunc('SENDBROADCASTNOTIFYMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, SendNotifyMessage(HWND_BROADCAST, Stack.GetUInt(PStart-1), Stack.GetNativeUInt(PStart-2), Stack.GetNativeInt(PStart-3)));
- end);
- RegisterScriptFunc('LOADDLL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var DllHandle := SafeLoadLibrary(Stack.GetString(PStart-1), SEM_NOOPENFILEERRORBOX);
- if DllHandle <> 0 then
- Stack.SetInt(PStart-2, 0)
- else
- Stack.SetInt(PStart-2, Integer(GetLastError));
- Stack.SetNativeUInt(PStart, DllHandle);
- end);
- RegisterScriptFunc('CALLDLLPROC', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var DllProc: TDllProc;
- @DllProc := GetProcAddress(Stack.GetNativeUInt(PStart-1), PChar(Stack.GetString(PStart-2)));
- if Assigned(DllProc) then begin
- Stack.SetNativeInt(PStart-5, DllProc(Stack.GetNativeInt(PStart-3), Stack.GetNativeInt(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: Integer)
- begin
- Stack.SetBool(PStart, FreeLibrary(Stack.GetNativeUInt(PStart-1)));
- end);
- RegisterScriptFunc('CREATEMUTEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Windows.CreateMutex(nil, False, PChar(Stack.GetString(PStart)));
- end);
- RegisterScriptFunc('OEMTOCHARBUFF', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var S := Stack.GetAnsiString(PStart);
- OemToCharBuffA(PAnsiChar(S), PAnsiChar(S), ULength(S));
- Stack.SetAnsiString(PStart, S);
- end);
- RegisterScriptFunc('CHARTOOEMBUFF', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var S := Stack.GetAnsiString(PStart);
- CharToOemBuffA(PAnsiChar(S), PAnsiChar(S), ULength(S));
- Stack.SetAnsiString(PStart, S);
- end);
- end;
- procedure RegisterActiveXScriptFuncs;
- begin
- RegisterScriptFunc('COFREEUNUSEDLIBRARIES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- CoFreeUnusedLibraries;
- end);
- end;
- procedure RegisterLoggingFuncScriptFuncs;
- begin
- RegisterScriptFunc('LOG', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Log(Stack.GetString(PStart));
- end);
- end;
- procedure RegisterOtherScriptFuncs;
- begin
- RegisterScriptFunc('BRINGTOFRONTANDRESTORE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- begin
- Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.DirEdit.Text));
- end);
- RegisterScriptFunc('WizardGroupValue', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.GroupEdit.Text));
- end);
- RegisterScriptFunc('WizardNoIcons', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, GetWizardForm.NoIconsCheck.Checked);
- end);
- RegisterScriptFunc('WizardSetupType', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- 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('WizardSetBackImage', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- const WizardImages = TWizardImages.Create(False);
- try
- const BackImages = Stack.GetClassArray(PStart);
- for var BackImage in BackImages do
- WizardImages.Add(TGraphic(BackImage));
- var Form: TSetupForm;
- if IsUninstaller then
- Form := GetUninstallProgressForm
- else
- Form := GetWizardForm;
- Form.SetBackImage(WizardImages, Stack.GetBool(PStart-1) , Stack.GetBool(PStart-2), Byte(Stack.GetInt(PStart-3)), True);
- finally
- WizardImages.Free;
- end;
- end);
- RegisterScriptFunc('WizardSilent', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, InstallMode <> imNormal);
- end);
- RegisterScriptFunc('ISUNINSTALLER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, IsUninstaller);
- end);
- RegisterScriptFunc('UninstallSilent', sfOnlyUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, UninstallSilent);
- end);
- RegisterScriptFunc('CurrentFilename', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- begin
- Abort;
- end);
- RegisterScriptFunc('GETEXCEPTIONMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetString(PStart, GetExceptionMessage(Caller));
- end);
- RegisterScriptFunc('RAISEEXCEPTION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- raise Exception.Create(Stack.GetString(PStart));
- end);
- RegisterScriptFunc('SHOWEXCEPTIONMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- ShowExceptionMsgText(AddPeriod(GetExceptionMessage(Caller)));
- end);
- RegisterScriptFunc('TERMINATED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, Application.Terminated);
- end);
- RegisterScriptFunc('GETPREVIOUSDATA', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- begin
- Stack.SetBool(PStart, SetCodePreviousData(HKEY(UInt32(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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- 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: Integer)
- begin
- Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), True, True));
- end);
- RegisterScriptFunc('GETUNINSTALLPROGRESSFORM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetClass(PStart, GetUninstallProgressForm);
- end);
- RegisterScriptFunc('CREATECALLBACK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetNativeInt(PStart, CreateCallback(Caller, PPSVariantProcPtr(Stack.Items[PStart-1])));
- end);
- RegisterScriptFunc('ISDOTNETINSTALLED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetBool(PStart, IsDotNetInstalled(InstallDefaultRegView, TDotNetVersion(Stack.GetInt(PStart-1)), Stack.GetUInt(PStart-2)));
- end);
- RegisterScriptFunc('ISMSIPRODUCTINSTALLED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var ErrorCode: Cardinal;
- Stack.SetBool(PStart, IsMsiProductInstalled(Stack.GetString(PStart-1), Stack.GetInt64(PStart-2), ErrorCode));
- if ErrorCode <> 0 then
- raise Exception.Create(Win32ErrorString(ErrorCode));
- end);
- RegisterScriptFunc('INITIALIZEBITMAPBUTTONFROMICON', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var AscendingTrySizes := Stack.GetIntArray(PStart-4);
- Stack.SetBool(PStart, TBitmapButton(Stack.GetClass(PStart-1)).InitializeFromIcon(0, PChar(Stack.GetString(PStart-2)), Stack.GetInt(PStart-3), AscendingTrySizes));
- end);
- RegisterScriptFunc('INITIALIZEBITMAPIMAGEFROMICON', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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('InitializeBitmapButtonFromStockIcon', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var AscendingTrySizes := Stack.GetIntArray(PStart-4);
- Stack.SetBool(PStart, TBitmapButton(Stack.GetClass(PStart-1)).InitializeFromStockIcon(Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), AscendingTrySizes));
- end);
- RegisterScriptFunc('InitializeBitmapImageFromStockIcon', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var AscendingTrySizes := Stack.GetIntArray(PStart-4);
- Stack.SetBool(PStart, TBitmapImage(Stack.GetClass(PStart-1)).InitializeFromStockIcon(Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), AscendingTrySizes));
- end);
- RegisterScriptFunc(['Extract7ZipArchive', 'ExtractArchive'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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
- ExtractArchive(Stack.GetString(PStart), Stack.GetString(PStart-1),
- Password, Stack.GetBool(FullDirsItemNo), Throttler.OnExtractionProgress)
- else
- Extract7ZipArchive(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: Integer)
- 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: Integer)
- begin
- Stack.SetBool(PStart, Debugging);
- end);
- RegisterScriptFunc('StringJoin', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- 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: Integer)
- 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: Integer)
- 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);
- RegisterScriptFunc('Round', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- const SaveRoundMode = GetRoundMode;
- try
- SetRoundMode(rmNearest);
- Stack.SetInt64(PStart, Round(Stack.GetReal(PStart-1)));
- finally
- SetRoundMode(SaveRoundMode);
- end;
- end);
- RegisterScriptFunc('Trunc', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetInt64(PStart, Trunc(Stack.GetReal(PStart-1)));
- end);
- RegisterScriptFunc('MulDiv', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3)));
- end);
- RegisterScriptFunc('StrToColor', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var Hex := Stack.GetString(PStart-1);
- if (Length(Hex) = 7) and (Hex[1] = '#') then
- Hex := '$' + Copy(Hex, 6, 2) + Copy(Hex, 4, 2) + Copy(Hex, 2, 2);
- Stack.SetInt(PStart, SysUtils.StrToInt(Hex));
- end);
- RegisterScriptFunc('RPos', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- Stack.SetInt(PStart, Stack.GetString(PStart-2).LastIndexOf(Stack.GetString(PStart-1)) + 1);
- end);
- RegisterScriptFunc(['ApplyPathRedirRules', 'ApplyPathRedirRulesForCurrentProcess'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
- begin
- var TargetProcess: TPathRedirTargetProcess;
- if OrgName = 'ApplyPathRedirRulesForCurrentProcess' then
- TargetProcess := tpCurrent
- else begin
- const TargetProcess64Bit = Stack.GetBool(PStart-3);
- if TargetProcess64Bit then
- TargetProcess := tpNativeBit { Since ApplyPathRedirRules does not rewrite on 32-bit Windows this effectively means tp64Bit }
- else
- TargetProcess := tp32Bit;
- end;
- Stack.SetString(PStart, ApplyPathRedirRules(Stack.GetBool(PStart-1),
- Stack.GetString(PStart-2), TargetProcess));
- 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;
- RegisterPathFuncScriptFuncs;
- 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(@Format, 'Format');
- RegisterDelphiFunction(@LogFmtHelper, 'LogFmt');
- RegisterDelphiFunction(@FmtMessageHelper, 'FmtMessage');
- RegisterDelphiFunction(@FindFirstHelper, 'FindFirst');
- RegisterDelphiFunction(@FindNextHelper, 'FindNext');
- RegisterDelphiFunction(@FindCloseHelper, 'FindClose');
- RegisterDelphiFunction(@GetWindowsVersionExHelper, 'GetWindowsVersionEx');
- {$IFDEF DEBUG}
- if Count <> Length(DelphiScriptFuncTable) then
- raise Exception.Create('Count <> Length(DelphiScriptFuncTable)');
- {$ENDIF}
- end;
- initialization
- finalization
- ScriptFuncs.Free;
- end.
|