Setup.ScriptFunc.pas 105 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025
  1. unit Setup.ScriptFunc;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2025 Jordan Russell
  5. Portions by Martijn Laan
  6. For conditions of distribution and use, see LICENSE.TXT.
  7. Script support functions (run time - used by Setup)
  8. }
  9. interface
  10. uses
  11. uPSRuntime;
  12. procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec);
  13. implementation
  14. uses
  15. Windows,
  16. Forms, SysUtils, Classes, Graphics, ActiveX, Generics.Collections, Math,
  17. uPSUtils, PathFunc, ISSigFunc, ECDSA, BrowseFunc, MD5, SHA1, SHA256, BitmapButton, BitmapImage, PSStackHelper,
  18. Shared.Struct, Setup.ScriptDlg, Setup.MainFunc, Shared.CommonFunc.Vcl,
  19. Shared.CommonFunc, Shared.FileClass, SetupLdrAndSetup.InstFunc, Setup.RedirFunc,
  20. Setup.DownloadFileFunc, Setup.ExtractFileFunc, Setup.ISSigVerifyFunc, Setup.InstFunc, Setup.InstFunc.Ole,
  21. SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.NewDiskForm,
  22. Setup.WizardForm, Shared.VerInfoFunc, Shared.SetupTypes,
  23. Setup.LoggingFunc, Setup.SetupForm, Setup.RegDLL, Setup.Helper,
  24. Setup.SpawnClient, Setup.DotNetFunc, Setup.MainForm,
  25. Shared.DotNetVersion, Setup.MsiFunc, Compression.SevenZipDecoder, Compression.SevenZipDLLDecoder,
  26. Setup.DebugClient, Shared.ScriptFunc, Setup.ScriptFunc.HelperFunc;
  27. type
  28. TScriptFunc = reference to procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal);
  29. TScriptFuncTyp = (sfNormal, sfNoUninstall, sfOnlyUninstall);
  30. TScriptFuncEx = record
  31. OrgName: AnsiString;
  32. ScriptFunc: TScriptFunc;
  33. Typ: TScriptFuncTyp;
  34. constructor Create(const AOrgName: AnsiString; const AScriptFunc: TScriptFunc; const ATyp: TScriptFuncTyp);
  35. procedure Run(const Caller: TPSExec; const Stack: TPSStack);
  36. end;
  37. TScriptFuncs = TDictionary<AnsiString, TScriptFuncEx>;
  38. var
  39. ScriptFuncs: TScriptFuncs;
  40. constructor TScriptFuncEx.Create(const AOrgName: AnsiString; const AScriptFunc: TScriptFunc; const ATyp: TScriptFuncTyp);
  41. begin
  42. OrgName := AOrgName;
  43. ScriptFunc := AScriptFunc;
  44. Typ := ATyp;
  45. end;
  46. procedure TScriptFuncEx.Run(const Caller: TPSExec; const Stack: TPSStack);
  47. begin
  48. if (Typ = sfNoUninstall) and IsUninstaller then
  49. NoUninstallFuncError(OrgName)
  50. else if (Typ = sfOnlyUninstall) and not IsUninstaller then
  51. OnlyUninstallFuncError(OrgName)
  52. else
  53. ScriptFunc(Caller, OrgName, Stack, Stack.Count-1);
  54. end;
  55. { Called by ROPS }
  56. function ScriptFuncPSProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
  57. begin
  58. var ScriptFuncEx: TScriptFuncEx;
  59. Result := ScriptFuncs.TryGetValue(Proc.Name, ScriptFuncEx);
  60. if Result then
  61. ScriptFuncEx.Run(Caller, Stack);
  62. end;
  63. procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec);
  64. {$IFDEF DEBUG}
  65. var
  66. Count: Integer;
  67. {$ENDIF}
  68. procedure RegisterScriptFunc(const Name: AnsiString; const ScriptFuncTyp: TScriptFuncTyp; const ScriptFunc: TScriptFunc); overload;
  69. begin
  70. var ScriptFuncEx: TScriptFuncEx;
  71. ScriptFuncs.Add(FastUpperCase(Name), TScriptFuncEx.Create(Name, ScriptFunc, ScriptFuncTyp));
  72. ScriptInterpreter.RegisterFunctionName(Name, ScriptFuncPSProc, nil, nil);
  73. {$IFDEF DEBUG}
  74. Inc(Count);
  75. {$ENDIF}
  76. end;
  77. procedure RegisterScriptFunc(const Names: array of AnsiString; const ScriptFuncTyp: TScriptFuncTyp; const ScriptFunc: TScriptFunc); overload;
  78. begin
  79. for var Name in Names do
  80. RegisterScriptFunc(Name, ScriptFuncTyp, ScriptFunc);
  81. end;
  82. procedure RegisterScriptFunc(const Name: AnsiString; const ScriptFunc: TScriptFunc); overload;
  83. begin
  84. RegisterScriptFunc(Name, sfNormal, ScriptFunc);
  85. end;
  86. procedure RegisterScriptFunc(const Names: array of AnsiString; const ScriptFunc: TScriptFunc); overload;
  87. begin
  88. for var Name in Names do
  89. RegisterScriptFunc(Name, ScriptFunc);
  90. end;
  91. procedure RegisterScriptDlgScriptFuncs;
  92. begin
  93. RegisterScriptFunc('PageFromID', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  94. begin
  95. Stack.SetClass(PStart, GetWizardForm.PageFromID(Stack.GetInt(PStart-1)));
  96. end);
  97. RegisterScriptFunc('PageIndexFromID', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  98. begin
  99. Stack.SetInt(PStart, GetWizardForm.PageIndexFromID(Stack.GetInt(PStart-1)));
  100. end);
  101. RegisterScriptFunc('CreateCustomPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  102. begin
  103. var NewPage := TWizardPage.Create(GetWizardForm);
  104. try
  105. NewPage.Caption := Stack.GetString(PStart-2);
  106. NewPage.Description := Stack.GetString(PStart-3);
  107. GetWizardForm.AddPage(NewPage, Stack.GetInt(PStart-1));
  108. except
  109. NewPage.Free;
  110. raise;
  111. end;
  112. Stack.SetClass(PStart, NewPage);
  113. end);
  114. RegisterScriptFunc('CreateInputQueryPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  115. begin
  116. var NewInputQueryPage := TInputQueryWizardPage.Create(GetWizardForm);
  117. try
  118. NewInputQueryPage.Caption := Stack.GetString(PStart-2);
  119. NewInputQueryPage.Description := Stack.GetString(PStart-3);
  120. GetWizardForm.AddPage(NewInputQueryPage, Stack.GetInt(PStart-1));
  121. NewInputQueryPage.Initialize(Stack.GetString(PStart-4));
  122. except
  123. NewInputQueryPage.Free;
  124. raise;
  125. end;
  126. Stack.SetClass(PStart, NewInputQueryPage);
  127. end);
  128. RegisterScriptFunc('CreateInputOptionPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  129. begin
  130. var NewInputOptionPage := TInputOptionWizardPage.Create(GetWizardForm);
  131. try
  132. NewInputOptionPage.Caption := Stack.GetString(PStart-2);
  133. NewInputOptionPage.Description := Stack.GetString(PStart-3);
  134. GetWizardForm.AddPage(NewInputOptionPage, Stack.GetInt(PStart-1));
  135. NewInputOptionPage.Initialize(Stack.GetString(PStart-4),
  136. Stack.GetBool(PStart-5), Stack.GetBool(PStart-6));
  137. except
  138. NewInputOptionPage.Free;
  139. raise;
  140. end;
  141. Stack.SetClass(PStart, NewInputOptionPage);
  142. end);
  143. RegisterScriptFunc('CreateInputDirPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  144. begin
  145. var NewInputDirPage := TInputDirWizardPage.Create(GetWizardForm);
  146. try
  147. NewInputDirPage.Caption := Stack.GetString(PStart-2);
  148. NewInputDirPage.Description := Stack.GetString(PStart-3);
  149. GetWizardForm.AddPage(NewInputDirPage, Stack.GetInt(PStart-1));
  150. NewInputDirPage.Initialize(Stack.GetString(PStart-4), Stack.GetBool(PStart-5),
  151. Stack.GetString(PStart-6));
  152. except
  153. NewInputDirPage.Free;
  154. raise;
  155. end;
  156. Stack.SetClass(PStart, NewInputDirPage);
  157. end);
  158. RegisterScriptFunc('CreateInputFilePage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  159. begin
  160. var NewInputFilePage := TInputFileWizardPage.Create(GetWizardForm);
  161. try
  162. NewInputFilePage.Caption := Stack.GetString(PStart-2);
  163. NewInputFilePage.Description := Stack.GetString(PStart-3);
  164. GetWizardForm.AddPage(NewInputFilePage, Stack.GetInt(PStart-1));
  165. NewInputFilePage.Initialize(Stack.GetString(PStart-4));
  166. except
  167. NewInputFilePage.Free;
  168. raise;
  169. end;
  170. Stack.SetClass(PStart, NewInputFilePage);
  171. end);
  172. RegisterScriptFunc('CreateOutputMsgPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  173. begin
  174. var NewOutputMsgPage := TOutputMsgWizardPage.Create(GetWizardForm);
  175. try
  176. NewOutputMsgPage.Caption := Stack.GetString(PStart-2);
  177. NewOutputMsgPage.Description := Stack.GetString(PStart-3);
  178. GetWizardForm.AddPage(NewOutputMsgPage, Stack.GetInt(PStart-1));
  179. NewOutputMsgPage.Initialize(Stack.GetString(PStart-4));
  180. except
  181. NewOutputMsgPage.Free;
  182. raise;
  183. end;
  184. Stack.SetClass(PStart, NewOutputMsgPage);
  185. end);
  186. RegisterScriptFunc('CreateOutputMsgMemoPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  187. begin
  188. var NewOutputMsgMemoPage := TOutputMsgMemoWizardPage.Create(GetWizardForm);
  189. try
  190. NewOutputMsgMemoPage.Caption := Stack.GetString(PStart-2);
  191. NewOutputMsgMemoPage.Description := Stack.GetString(PStart-3);
  192. GetWizardForm.AddPage(NewOutputMsgMemoPage, Stack.GetInt(PStart-1));
  193. NewOutputMsgMemoPage.Initialize(Stack.GetString(PStart-4),
  194. Stack.GetAnsiString(PStart-5));
  195. except
  196. NewOutputMsgMemoPage.Free;
  197. raise;
  198. end;
  199. Stack.SetClass(PStart, NewOutputMsgMemoPage);
  200. end);
  201. RegisterScriptFunc('CreateOutputProgressPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  202. begin
  203. var NewOutputProgressPage := TOutputProgressWizardPage.Create(GetWizardForm);
  204. try
  205. NewOutputProgressPage.Caption := Stack.GetString(PStart-1);
  206. NewOutputProgressPage.Description := Stack.GetString(PStart-2);
  207. GetWizardForm.AddPage(NewOutputProgressPage, -1);
  208. NewOutputProgressPage.Initialize;
  209. except
  210. NewOutputProgressPage.Free;
  211. raise;
  212. end;
  213. Stack.SetClass(PStart, NewOutputProgressPage);
  214. end);
  215. RegisterScriptFunc('CreateOutputMarqueeProgressPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  216. begin
  217. var NewOutputMarqueeProgressPage := TOutputMarqueeProgressWizardPage.Create(GetWizardForm);
  218. try
  219. NewOutputMarqueeProgressPage.Caption := Stack.GetString(PStart-1);
  220. NewOutputMarqueeProgressPage.Description := Stack.GetString(PStart-2);
  221. GetWizardForm.AddPage(NewOutputMarqueeProgressPage, -1);
  222. NewOutputMarqueeProgressPage.Initialize;
  223. except
  224. NewOutputMarqueeProgressPage.Free;
  225. raise;
  226. end;
  227. Stack.SetClass(PStart, NewOutputMarqueeProgressPage);
  228. end);
  229. RegisterScriptFunc('CreateDownloadPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  230. begin;
  231. var NewDownloadPage := TDownloadWizardPage.Create(GetWizardForm);
  232. try
  233. NewDownloadPage.Caption := Stack.GetString(PStart-1);
  234. NewDownloadPage.Description := Stack.GetString(PStart-2);
  235. GetWizardForm.AddPage(NewDownloadPage, -1);
  236. NewDownloadPage.Initialize;
  237. NewDownloadPage.OnDownloadProgress := TOnDownloadProgress(Stack.GetProc(PStart-3, Caller));
  238. except
  239. NewDownloadPage.Free;
  240. raise;
  241. end;
  242. Stack.SetClass(PStart, NewDownloadPage);
  243. end);
  244. RegisterScriptFunc('CreateExtractionPage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  245. begin
  246. var NewExtractionPage := TExtractionWizardPage.Create(GetWizardForm);
  247. try
  248. NewExtractionPage.Caption := Stack.GetString(PStart-1);
  249. NewExtractionPage.Description := Stack.GetString(PStart-2);
  250. GetWizardForm.AddPage(NewExtractionPage, -1);
  251. NewExtractionPage.Initialize;
  252. NewExtractionPage.OnExtractionProgress := TOnExtractionProgress(Stack.GetProc(PStart-3, Caller));
  253. except
  254. NewExtractionPage.Free;
  255. raise;
  256. end;
  257. Stack.SetClass(PStart, NewExtractionPage);
  258. end);
  259. RegisterScriptFunc('SCALEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  260. begin
  261. InitializeScaleBaseUnits;
  262. Stack.SetInt(PStart, TSetupForm.ScalePixelsX(ScaleBaseUnitX, Stack.GetInt(PStart-1)));
  263. end);
  264. RegisterScriptFunc('SCALEY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  265. begin
  266. InitializeScaleBaseUnits;
  267. Stack.SetInt(PStart, TSetupForm.ScalePixelsY(ScaleBaseUnitY, Stack.GetInt(PStart-1)));
  268. end);
  269. RegisterScriptFunc('CREATECUSTOMFORM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  270. begin
  271. var NewSetupForm := TSetupForm.CreateNew(nil);
  272. try
  273. NewSetupForm.PopupMode := pmAuto;
  274. NewSetupForm.AutoScroll := False;
  275. NewSetupForm.BorderStyle := bsDialog;
  276. NewSetupForm.ClientWidth := Stack.GetInt(PStart-1);
  277. NewSetupForm.ClientHeight := Stack.GetInt(PStart-2);
  278. NewSetupForm.InitializeFont(Stack.GetBool(PStart-3), Stack.GetBool(PStart-4));
  279. except
  280. NewSetupForm.Free;
  281. raise;
  282. end;
  283. Stack.SetClass(PStart, NewSetupForm);
  284. end);
  285. end;
  286. procedure RegisterNewDiskFormScriptFuncs;
  287. begin
  288. RegisterScriptFunc('SELECTDISK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  289. begin
  290. var S := Stack.GetString(PStart-3);
  291. Stack.SetBool(PStart, SelectDisk(Stack.GetInt(PStart-1), Stack.GetString(PStart-2), S));
  292. Stack.SetString(PStart-3, S);
  293. end);
  294. end;
  295. procedure RegisterBrowseFuncScriptFuncs;
  296. begin
  297. RegisterScriptFunc('BROWSEFORFOLDER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  298. begin
  299. var S := Stack.GetString(PStart-2);
  300. Stack.SetBool(PStart, BrowseForFolder(Stack.GetString(PStart-1), S, GetOwnerWndForMessageBox, Stack.GetBool(PStart-3)));
  301. Stack.SetString(PStart-2, S);
  302. end);
  303. RegisterScriptFunc('GETOPENFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  304. begin
  305. var S := Stack.GetString(PStart-2);
  306. Stack.SetBool(PStart, NewGetOpenFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), GetOwnerWndForMessageBox));
  307. Stack.SetString(PStart-2, S);
  308. end);
  309. RegisterScriptFunc('GETOPENFILENAMEMULTI', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  310. begin
  311. 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));
  312. end);
  313. RegisterScriptFunc('GETSAVEFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  314. begin
  315. var S := Stack.GetString(PStart-2);
  316. Stack.SetBool(PStart, NewGetSaveFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), GetOwnerWndForMessageBox));
  317. Stack.SetString(PStart-2, S);
  318. end);
  319. end;
  320. procedure RegisterCommonFuncVclScriptFuncs;
  321. begin
  322. RegisterScriptFunc('MINIMIZEPATHNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  323. begin
  324. Stack.SetString(PStart, MinimizePathName(Stack.GetString(PStart-1), TFont(Stack.GetClass(PStart-2)), Stack.GetInt(PStart-3)));
  325. end);
  326. end;
  327. procedure RegisterCommonFuncScriptFuncs;
  328. begin
  329. RegisterScriptFunc('FILEEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  330. begin
  331. Stack.SetBool(PStart, NewFileExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  332. end);
  333. RegisterScriptFunc('DIREXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  334. begin
  335. Stack.SetBool(PStart, DirExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  336. end);
  337. RegisterScriptFunc('FILEORDIREXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  338. begin
  339. Stack.SetBool(PStart, FileOrDirExistsRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  340. end);
  341. RegisterScriptFunc('GETINISTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  342. begin
  343. Stack.SetString(PStart, GetIniString(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetString(PStart-4)));
  344. end);
  345. RegisterScriptFunc('GETINIINT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  346. begin
  347. 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)));
  348. end);
  349. RegisterScriptFunc('GETINIBOOL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  350. begin
  351. Stack.SetBool(PStart, GetIniBool(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), Stack.GetString(PStart-4)));
  352. end);
  353. RegisterScriptFunc('INIKEYEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  354. begin
  355. Stack.SetBool(PStart, IniKeyExists(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3)));
  356. end);
  357. RegisterScriptFunc('ISINISECTIONEMPTY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  358. begin
  359. Stack.SetBool(PStart, IsIniSectionEmpty(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  360. end);
  361. RegisterScriptFunc('SETINISTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  362. begin
  363. Stack.SetBool(PStart, SetIniString(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetString(PStart-4)));
  364. end);
  365. RegisterScriptFunc('SETINIINT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  366. begin
  367. Stack.SetBool(PStart, SetIniInt(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetInt(PStart-3), Stack.GetString(PStart-4)));
  368. end);
  369. RegisterScriptFunc('SETINIBOOL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  370. begin
  371. Stack.SetBool(PStart, SetIniBool(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), Stack.GetString(PStart-4)));
  372. end);
  373. RegisterScriptFunc('DELETEINIENTRY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  374. begin
  375. DeleteIniEntry(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetString(PStart-2));
  376. end);
  377. RegisterScriptFunc('DELETEINISECTION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  378. begin
  379. DeleteIniSection(Stack.GetString(PStart), Stack.GetString(PStart-1));
  380. end);
  381. RegisterScriptFunc('GETENV', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  382. begin
  383. Stack.SetString(PStart, GetEnv(Stack.GetString(PStart-1)));
  384. end);
  385. RegisterScriptFunc('GETCMDTAIL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  386. begin
  387. Stack.SetString(PStart, GetCmdTail);
  388. end);
  389. RegisterScriptFunc('PARAMCOUNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  390. begin
  391. if NewParamsForCode.Count = 0 then
  392. InternalError('NewParamsForCode not set');
  393. Stack.SetInt(PStart, NewParamsForCode.Count-1);
  394. end);
  395. RegisterScriptFunc('PARAMSTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  396. begin
  397. var I := Stack.GetInt(PStart-1);
  398. if (I >= 0) and (I < NewParamsForCode.Count) then
  399. Stack.SetString(PStart, NewParamsForCode[I])
  400. else
  401. Stack.SetString(PStart, '');
  402. end);
  403. RegisterScriptFunc('ADDBACKSLASH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  404. begin
  405. Stack.SetString(PStart, AddBackslash(Stack.GetString(PStart-1)));
  406. end);
  407. RegisterScriptFunc('REMOVEBACKSLASH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  408. begin
  409. Stack.SetString(PStart, RemoveBackslash(Stack.GetString(PStart-1)));
  410. end);
  411. RegisterScriptFunc('REMOVEBACKSLASHUNLESSROOT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  412. begin
  413. Stack.SetString(PStart, RemoveBackslashUnlessRoot(Stack.GetString(PStart-1)));
  414. end);
  415. RegisterScriptFunc('ADDQUOTES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  416. begin
  417. Stack.SetString(PStart, AddQuotes(Stack.GetString(PStart-1)));
  418. end);
  419. RegisterScriptFunc('REMOVEQUOTES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  420. begin
  421. Stack.SetString(PStart, RemoveQuotes(Stack.GetString(PStart-1)));
  422. end);
  423. RegisterScriptFunc('GETSHORTNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  424. begin
  425. Stack.SetString(PStart, GetShortNameRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  426. end);
  427. RegisterScriptFunc('GETWINDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  428. begin
  429. Stack.SetString(PStart, GetWinDir);
  430. end);
  431. RegisterScriptFunc('GETSYSTEMDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  432. begin
  433. Stack.SetString(PStart, GetSystemDir);
  434. end);
  435. RegisterScriptFunc('GETSYSWOW64DIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  436. begin
  437. Stack.SetString(PStart, GetSysWow64Dir);
  438. end);
  439. RegisterScriptFunc('GETSYSNATIVEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  440. begin
  441. Stack.SetString(PStart, GetSysNativeDir(IsWin64));
  442. end);
  443. RegisterScriptFunc('GETTEMPDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  444. begin
  445. Stack.SetString(PStart, GetTempDir);
  446. end);
  447. RegisterScriptFunc('STRINGCHANGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  448. begin
  449. var S := Stack.GetString(PStart-1);
  450. Stack.SetInt(PStart, StringChange(S, Stack.GetString(PStart-2), Stack.GetString(PStart-3)));
  451. Stack.SetString(PStart-1, S);
  452. end);
  453. RegisterScriptFunc('STRINGCHANGEEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  454. begin
  455. var S := Stack.GetString(PStart-1);
  456. Stack.SetInt(PStart, StringChangeEx(S, Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetBool(PStart-4)));
  457. Stack.SetString(PStart-1, S);
  458. end);
  459. RegisterScriptFunc('USINGWINNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  460. begin
  461. Stack.SetBool(PStart, True);
  462. end);
  463. RegisterScriptFunc(['COPYFILE', 'FILECOPY'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  464. begin
  465. var ExistingFilename := Stack.GetString(PStart-1);
  466. if not IsProtectedSrcExe(ExistingFilename) then
  467. Stack.SetBool(PStart, CopyFileRedir(ScriptFuncDisableFsRedir,
  468. ExistingFilename, Stack.GetString(PStart-2), Stack.GetBool(PStart-3)))
  469. else
  470. Stack.SetBool(PStart, False);
  471. end);
  472. RegisterScriptFunc('CONVERTPERCENTSTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  473. begin
  474. var S := Stack.GetString(PStart-1);
  475. Stack.SetBool(PStart, ConvertPercentStr(S));
  476. Stack.SetString(PStart-1, S);
  477. end);
  478. RegisterScriptFunc('REGKEYEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  479. begin
  480. var RegView: TRegView;
  481. var RootKey: HKEY;
  482. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  483. var SubKeyName := Stack.GetString(PStart-2);
  484. var K: HKEY;
  485. if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  486. Stack.SetBool(PStart, True);
  487. RegCloseKey(K);
  488. end else
  489. Stack.SetBool(PStart, False);
  490. end);
  491. RegisterScriptFunc('REGVALUEEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  492. begin
  493. var RegView: TRegView;
  494. var RootKey: HKEY;
  495. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  496. var SubKeyName := Stack.GetString(PStart-2);
  497. var K: HKEY;
  498. if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  499. var ValueName := Stack.GetString(PStart-3);
  500. Stack.SetBool(PStart, RegValueExists(K, PChar(ValueName)));
  501. RegCloseKey(K);
  502. end else
  503. Stack.SetBool(PStart, False);
  504. end);
  505. RegisterScriptFunc('REGDELETEKEYINCLUDINGSUBKEYS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  506. begin
  507. var RegView: TRegView;
  508. var RootKey: HKEY;
  509. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  510. var SubKey := Stack.GetString(PStart-2);
  511. Stack.SetBool(PStart, RegDeleteKeyIncludingSubkeys(RegView, RootKey, PChar(SubKey)) = ERROR_SUCCESS);
  512. end);
  513. RegisterScriptFunc('REGDELETEKEYIFEMPTY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  514. begin
  515. var RegView: TRegView;
  516. var RootKey: HKEY;
  517. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  518. var SubKeyName := Stack.GetString(PStart-2);
  519. Stack.SetBool(PStart, RegDeleteKeyIfEmpty(RegView, RootKey, PChar(SubKeyName)) = ERROR_SUCCESS);
  520. end);
  521. RegisterScriptFunc('REGDELETEVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  522. begin
  523. var RegView: TRegView;
  524. var RootKey: HKEY;
  525. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  526. var SubKeyName := Stack.GetString(PStart-2);
  527. var K: HKEY;
  528. if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
  529. var ValueName := Stack.GetString(PStart-3);
  530. Stack.SetBool(PStart, RegDeleteValue(K, PChar(ValueName)) = ERROR_SUCCESS);
  531. RegCloseKey(K);
  532. end else
  533. Stack.SetBool(PStart, False);
  534. end);
  535. RegisterScriptFunc('REGGETSUBKEYNAMES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  536. begin
  537. var RegView: TRegView;
  538. var RootKey: HKEY;
  539. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  540. Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey,
  541. Stack.GetString(PStart-2), Stack, PStart-3, True));
  542. end);
  543. RegisterScriptFunc('REGGETVALUENAMES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  544. begin
  545. var RegView: TRegView;
  546. var RootKey: HKEY;
  547. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  548. Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey,
  549. Stack.GetString(PStart-2), Stack, PStart-3, False));
  550. end);
  551. RegisterScriptFunc('REGQUERYSTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  552. begin
  553. var RegView: TRegView;
  554. var RootKey: HKEY;
  555. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  556. var SubKeyName := Stack.GetString(PStart-2);
  557. var K: HKEY;
  558. if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  559. var ValueName := Stack.GetString(PStart-3);
  560. var S := Stack.GetString(PStart-4);
  561. Stack.SetBool(PStart, RegQueryStringValue(K, PChar(ValueName), S));
  562. Stack.SetString(PStart-4, S);
  563. RegCloseKey(K);
  564. end else
  565. Stack.SetBool(PStart, False);
  566. end);
  567. RegisterScriptFunc('REGQUERYMULTISTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  568. begin
  569. var RegView: TRegView;
  570. var RootKey: HKEY;
  571. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  572. var SubKeyName := Stack.GetString(PStart-2);
  573. var K: HKEY;
  574. if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  575. var ValueName := Stack.GetString(PStart-3);
  576. var S := Stack.GetString(PStart-4);
  577. Stack.SetBool(PStart, RegQueryMultiStringValue(K, PChar(ValueName), S));
  578. Stack.SetString(PStart-4, S);
  579. RegCloseKey(K);
  580. end else
  581. Stack.SetBool(PStart, False);
  582. end);
  583. RegisterScriptFunc('REGQUERYDWORDVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  584. begin
  585. var RegView: TRegView;
  586. var RootKey: HKEY;
  587. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  588. var SubKeyName := Stack.GetString(PStart-2);
  589. var K: HKEY;
  590. if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  591. var ValueName := Stack.GetString(PStart-3);
  592. var Typ, Data: DWORD;
  593. var Size: DWORD := SizeOf(Data);
  594. if (RegQueryValueEx(K, PChar(ValueName), nil, @Typ, @Data, @Size) = ERROR_SUCCESS) and (Typ = REG_DWORD) then begin
  595. Stack.SetInt(PStart-4, Data);
  596. Stack.SetBool(PStart, True);
  597. end else
  598. Stack.SetBool(PStart, False);
  599. RegCloseKey(K);
  600. end else
  601. Stack.SetBool(PStart, False);
  602. end);
  603. RegisterScriptFunc('REGQUERYBINARYVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  604. begin
  605. var RegView: TRegView;
  606. var RootKey: HKEY;
  607. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  608. var SubKeyName := Stack.GetString(PStart-2);
  609. var K: HKEY;
  610. if RegOpenKeyExView(RegView, RootKey, PChar(SubKeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  611. var ValueName := Stack.GetString(PStart-3);
  612. var Typ, Size: DWORD;
  613. if RegQueryValueEx(K, PChar(ValueName), nil, @Typ, nil, @Size) = ERROR_SUCCESS then begin
  614. var Data: AnsiString;
  615. SetLength(Data, Size);
  616. if RegQueryValueEx(K, PChar(ValueName), nil, @Typ, @Data[1], @Size) = ERROR_SUCCESS then begin
  617. Stack.SetAnsiString(PStart-4, Data);
  618. Stack.SetBool(PStart, True);
  619. end else
  620. Stack.SetBool(PStart, False);
  621. end else
  622. Stack.SetBool(PStart, False);
  623. RegCloseKey(K);
  624. end else
  625. Stack.SetBool(PStart, False);
  626. end);
  627. RegisterScriptFunc('REGWRITESTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  628. begin
  629. var RegView: TRegView;
  630. var RootKey: HKEY;
  631. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  632. var SubKeyName := Stack.GetString(PStart-2);
  633. var K: HKEY;
  634. 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
  635. var ValueName := Stack.GetString(PStart-3);
  636. var Data := Stack.GetString(PStart-4);
  637. var Typ, ExistingTyp: DWORD;
  638. if (RegQueryValueEx(K, PChar(ValueName), nil, @ExistingTyp, nil, nil) = ERROR_SUCCESS) and (ExistingTyp = REG_EXPAND_SZ) then
  639. Typ := REG_EXPAND_SZ
  640. else
  641. Typ := REG_SZ;
  642. if RegSetValueEx(K, PChar(ValueName), 0, Typ, PChar(Data), (Length(Data)+1)*SizeOf(Data[1])) = ERROR_SUCCESS then
  643. Stack.SetBool(PStart, True)
  644. else
  645. Stack.SetBool(PStart, False);
  646. RegCloseKey(K);
  647. end else
  648. Stack.SetBool(PStart, False);
  649. end);
  650. RegisterScriptFunc('REGWRITEEXPANDSTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  651. begin
  652. var RegView: TRegView;
  653. var RootKey: HKEY;
  654. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  655. var SubKeyName := Stack.GetString(PStart-2);
  656. var K: HKEY;
  657. if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin
  658. var ValueName := Stack.GetString(PStart-3);
  659. var Data := Stack.GetString(PStart-4);
  660. if RegSetValueEx(K, PChar(ValueName), 0, REG_EXPAND_SZ, PChar(Data), (Length(Data)+1)*SizeOf(Data[1])) = ERROR_SUCCESS then
  661. Stack.SetBool(PStart, True)
  662. else
  663. Stack.SetBool(PStart, False);
  664. RegCloseKey(K);
  665. end else
  666. Stack.SetBool(PStart, False);
  667. end);
  668. RegisterScriptFunc('REGWRITEMULTISTRINGVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  669. begin
  670. var RegView: TRegView;
  671. var RootKey: HKEY;
  672. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  673. var SubKeyName := Stack.GetString(PStart-2);
  674. var K: HKEY;
  675. if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin
  676. var ValueName := Stack.GetString(PStart-3);
  677. var Data := Stack.GetString(PStart-4);
  678. { Multi-string data requires two null terminators: one after the last
  679. string, and one to mark the end.
  680. Delphi's String type is implicitly null-terminated, so only one null
  681. needs to be added to the end. }
  682. if (Data <> '') and (Data[Length(Data)] <> #0) then
  683. Data := Data + #0;
  684. if RegSetValueEx(K, PChar(ValueName), 0, REG_MULTI_SZ, PChar(Data), (Length(Data)+1)*SizeOf(Data[1])) = ERROR_SUCCESS then
  685. Stack.SetBool(PStart, True)
  686. else
  687. Stack.SetBool(PStart, False);
  688. RegCloseKey(K);
  689. end else
  690. Stack.SetBool(PStart, False);
  691. end);
  692. RegisterScriptFunc('REGWRITEDWORDVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  693. begin
  694. var RegView: TRegView;
  695. var RootKey: HKEY;
  696. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  697. var SubKeyName := Stack.GetString(PStart-2);
  698. var K: HKEY;
  699. if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin
  700. var ValueName := Stack.GetString(PStart-3);
  701. var Data: DWORD := Stack.GetInt(PStart-4);
  702. if RegSetValueEx(K, PChar(ValueName), 0, REG_DWORD, @Data, SizeOf(Data)) = ERROR_SUCCESS then
  703. Stack.SetBool(PStart, True)
  704. else
  705. Stack.SetBool(PStart, False);
  706. RegCloseKey(K);
  707. end else
  708. Stack.SetBool(PStart, False);
  709. end);
  710. RegisterScriptFunc('REGWRITEBINARYVALUE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  711. begin
  712. var RegView: TRegView;
  713. var RootKey: HKEY;
  714. CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
  715. var SubKeyName := Stack.GetString(PStart-2);
  716. var K: HKEY;
  717. if RegCreateKeyExView(RegView, RootKey, PChar(SubKeyName), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, nil) = ERROR_SUCCESS then begin
  718. var ValueName := Stack.GetString(PStart-3);
  719. var Data := Stack.GetAnsiString(PStart-4);
  720. if RegSetValueEx(K, PChar(ValueName), 0, REG_BINARY, @Data[1], Length(Data)) = ERROR_SUCCESS then
  721. Stack.SetBool(PStart, True)
  722. else
  723. Stack.SetBool(PStart, False);
  724. RegCloseKey(K);
  725. end else
  726. Stack.SetBool(PStart, False);
  727. end);
  728. RegisterScriptFunc(['ISADMIN', 'ISADMINLOGGEDON'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  729. begin
  730. Stack.SetBool(PStart, IsAdmin);
  731. end);
  732. RegisterScriptFunc('ISPOWERUSERLOGGEDON', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  733. begin
  734. Stack.SetBool(PStart, IsPowerUserLoggedOn);
  735. end);
  736. RegisterScriptFUnc('ISADMININSTALLMODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  737. begin
  738. Stack.SetBool(PStart, IsAdminInstallMode);
  739. end);
  740. RegisterScriptFunc('FONTEXISTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  741. begin
  742. Stack.SetBool(PStart, FontExists(Stack.GetString(PStart-1)));
  743. end);
  744. RegisterScriptFunc('GETUILANGUAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  745. begin
  746. Stack.SetInt(PStart, GetUILanguage);
  747. end);
  748. RegisterScriptFunc('ADDPERIOD', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  749. begin
  750. Stack.SetString(PStart, AddPeriod(Stack.GetString(PStart-1)));
  751. end);
  752. RegisterScriptFunc('CHARLENGTH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  753. begin
  754. Stack.SetInt(PStart, PathCharLength(Stack.GetString(PStart-1), Stack.GetInt(PStart-2)));
  755. end);
  756. RegisterScriptFunc('SETNTFSCOMPRESSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  757. begin
  758. Stack.SetBool(PStart, SetNTFSCompressionRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetBool(PStart-2)));
  759. end);
  760. RegisterScriptFunc('ISWILDCARD', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  761. begin
  762. Stack.SetBool(PStart, IsWildcard(Stack.GetString(PStart-1)));
  763. end);
  764. RegisterScriptFunc('WILDCARDMATCH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  765. begin
  766. var S := Stack.GetString(PStart-1);
  767. var N := Stack.GetString(PStart-2);
  768. Stack.SetBool(PStart, WildcardMatch(PChar(S), PChar(N)));
  769. end);
  770. RegisterScriptFunc('HighContrastActive', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  771. begin
  772. Stack.SetBool(PStart, HighContrastActive);
  773. end);
  774. end;
  775. procedure RegisterInstallScriptFuncs;
  776. begin
  777. RegisterScriptFunc('ExtractTemporaryFile', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  778. begin
  779. ExtractTemporaryFile(Stack.GetString(PStart));
  780. end);
  781. RegisterScriptFunc('ExtractTemporaryFiles', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  782. begin
  783. Stack.SetInt(PStart, ExtractTemporaryFiles(Stack.GetString(PStart-1)));
  784. end);
  785. RegisterScriptFunc(['DownloadTemporaryFile', 'DownloadTemporaryFileWithISSigVerify'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  786. begin
  787. const ISSigVerify = OrgName = 'DownloadTemporaryFileWithISSigVerify';
  788. var Url, ISSigUrl, BaseName, RequiredSHA256OfFile: String;
  789. var ISSigAllowedKeys: AnsiString;
  790. var OnDownloadProgress: TOnDownloadProgress;
  791. if ISSigVerify then begin
  792. Url := Stack.GetString(PStart-1);
  793. ISSigUrl := Stack.GetString(PStart-2);
  794. BaseName := Stack.GetString(PStart-3);
  795. ISSigAllowedKeys := ConvertAllowedKeysRuntimeIDsToISSigAllowedKeys(TStringList(Stack.GetClass(PStart-4)));
  796. OnDownloadProgress := TOnDownloadProgress(Stack.GetProc(PStart-5, Caller));
  797. end else begin
  798. Url := Stack.GetString(PStart-1);
  799. BaseName := Stack.GetString(PStart-2);
  800. RequiredSHA256OfFile := Stack.GetString(PStart-3);
  801. OnDownloadProgress := TOnDownloadProgress(Stack.GetProc(PStart-4, Caller));
  802. end;
  803. var Verification := NoVerification;
  804. if RequiredSHA256OfFile <> '' then begin
  805. Verification.Typ := fvHash;
  806. Verification.Hash := SHA256DigestFromString(RequiredSHA256OfFile)
  807. end else if ISSigVerify then begin
  808. Verification.Typ := fvISSig;
  809. Verification.ISSigAllowedKeys := ISSigAllowedKeys
  810. end;
  811. const Throttler = TProgressThrottler.Create(OnDownloadProgress);
  812. try
  813. { Also see Setup.ScriptDlg TDownloadWizardPage.AddExWithISSigVerify }
  814. if ISSigVerify then
  815. DownloadTemporaryFile(GetISSigUrl(Url, ISSigUrl), BaseName + ISSigExt, NoVerification, Throttler.OnDownloadProgress, nil);
  816. Throttler.Reset;
  817. Stack.SetInt64(PStart, DownloadTemporaryFile(Url, BaseName, Verification, Throttler.OnDownloadProgress, nil));
  818. finally
  819. Throttler.Free;
  820. end;
  821. end);
  822. RegisterScriptFunc('DownloadTemporaryFileSize', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  823. begin
  824. Stack.SetInt64(PStart, DownloadTemporaryFileSize(Stack.GetString(PStart-1)));
  825. end);
  826. RegisterScriptFunc('DownloadTemporaryFileDate', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  827. begin
  828. Stack.SetString(PStart, DownloadTemporaryFileDate(Stack.GetString(PStart-1)));
  829. end);
  830. RegisterScriptFunc('SetDownloadCredentials', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  831. begin
  832. SetDownloadTemporaryFileCredentials(Stack.GetString(PStart),Stack.GetString(PStart-1));
  833. end);
  834. end;
  835. procedure RegisterInstFuncScriptFuncs;
  836. begin
  837. RegisterScriptFunc('CHECKFORMUTEXES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  838. begin
  839. Stack.SetBool(PStart, CheckForMutexes(Stack.GetString(PStart-1)));
  840. end);
  841. RegisterScriptFunc('DECREMENTSHAREDCOUNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  842. begin
  843. if Stack.GetBool(PStart-1) then begin
  844. if not IsWin64 then
  845. InternalError('Cannot access 64-bit registry keys on this version of Windows');
  846. Stack.SetBool(PStart, DecrementSharedCount(rv64Bit, Stack.GetString(PStart-2)));
  847. end
  848. else
  849. Stack.SetBool(PStart, DecrementSharedCount(rv32Bit, Stack.GetString(PStart-2)));
  850. end);
  851. RegisterScriptFunc('DELAYDELETEFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  852. begin
  853. DelayDeleteFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetInt(PStart-1), 250, 250);
  854. end);
  855. RegisterScriptFunc('DELTREE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  856. begin
  857. Stack.SetBool(PStart, DelTree(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetBool(PStart-2), Stack.GetBool(PStart-3), Stack.GetBool(PStart-4), False, nil, nil, nil));
  858. end);
  859. RegisterScriptFunc('GENERATEUNIQUENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  860. begin
  861. Stack.SetString(PStart, GenerateUniqueName(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  862. end);
  863. RegisterScriptFunc('GETCOMPUTERNAMESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  864. begin
  865. Stack.SetString(PStart, GetComputerNameString);
  866. end);
  867. RegisterScriptFunc('GETMD5OFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  868. begin
  869. Stack.SetString(PStart, MD5DigestToString(GetMD5OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))));
  870. end);
  871. RegisterScriptFunc('GETMD5OFSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  872. begin
  873. Stack.SetString(PStart, MD5DigestToString(GetMD5OfAnsiString(Stack.GetAnsiString(PStart-1))));
  874. end);
  875. RegisterScriptFunc('GETMD5OFUNICODESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  876. begin
  877. Stack.SetString(PStart, MD5DigestToString(GetMD5OfUnicodeString(Stack.GetString(PStart-1))));
  878. end);
  879. RegisterScriptFunc('GETSHA1OFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  880. begin
  881. Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))));
  882. end);
  883. RegisterScriptFunc('GETSHA1OFSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  884. begin
  885. Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfAnsiString(Stack.GetAnsiString(PStart-1))));
  886. end);
  887. RegisterScriptFunc('GETSHA1OFUNICODESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  888. begin
  889. Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfUnicodeString(Stack.GetString(PStart-1))));
  890. end);
  891. RegisterScriptFunc('GETSHA256OFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  892. begin
  893. Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))));
  894. end);
  895. RegisterScriptFunc('GETSHA256OFSTREAM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  896. begin
  897. Stack.SetString(PStart, SHA256DigestToString(ISSigCalcStreamHash(TStream(Stack.GetClass(PStart-1)))));
  898. end);
  899. RegisterScriptFunc('GETSHA256OFSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  900. begin
  901. Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfAnsiString(Stack.GetAnsiString(PStart-1))));
  902. end);
  903. RegisterScriptFunc('GETSHA256OFUNICODESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  904. begin
  905. Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfUnicodeString(Stack.GetString(PStart-1))));
  906. end);
  907. RegisterScriptFunc('GETSPACEONDISK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  908. begin
  909. var FreeBytes, TotalBytes: Int64;
  910. if GetSpaceOnDisk(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin
  911. if Stack.GetBool(PStart-2) then begin
  912. FreeBytes := FreeBytes div (1024*1024);
  913. TotalBytes := TotalBytes div (1024*1024);
  914. end;
  915. { Cap at 2 GB, as GetSpaceOnDisk doesn't use 64-bit integers }
  916. const MaxBytes = High(Int32);
  917. if FreeBytes > MaxBytes then
  918. FreeBytes := MaxBytes;
  919. if TotalBytes > MaxBytes then
  920. TotalBytes := MaxBytes;
  921. Stack.SetUInt(PStart-3, Cardinal(FreeBytes));
  922. Stack.SetUInt(PStart-4, Cardinal(TotalBytes));
  923. Stack.SetBool(PStart, True);
  924. end else
  925. Stack.SetBool(PStart, False);
  926. end);
  927. RegisterScriptFunc('GETSPACEONDISK64', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  928. begin
  929. var FreeBytes, TotalBytes: Int64;
  930. if GetSpaceOnDisk(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin
  931. Stack.SetInt64(PStart-2, FreeBytes);
  932. Stack.SetInt64(PStart-3, TotalBytes);
  933. Stack.SetBool(PStart, True);
  934. end else
  935. Stack.SetBool(PStart, False);
  936. end);
  937. RegisterScriptFunc('GETUSERNAMESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  938. begin
  939. Stack.SetString(PStart, GetUserNameString);
  940. end);
  941. RegisterScriptFunc('INCREMENTSHAREDCOUNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  942. begin
  943. if Stack.GetBool(PStart) then begin
  944. if not IsWin64 then
  945. InternalError('Cannot access 64-bit registry keys on this version of Windows');
  946. IncrementSharedCount(rv64Bit, Stack.GetString(PStart-1), Stack.GetBool(PStart-2));
  947. end
  948. else
  949. IncrementSharedCount(rv32Bit, Stack.GetString(PStart-1), Stack.GetBool(PStart-2));
  950. end);
  951. RegisterScriptFunc(['Exec', 'ExecAsOriginalUser', 'ExecAndLogOutput', 'ExecAndCaptureOutput'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  952. begin
  953. var RunAsOriginalUser := OrgName = 'ExecAsOriginalUser';
  954. if IsUninstaller and RunAsOriginalUser then
  955. NoUninstallFuncError(OrgName);
  956. var Method: TMethod; { Must stay alive until OutputReader is freed }
  957. var OutputReader: TCreateProcessOutputReader := nil;
  958. try
  959. if OrgName = 'ExecAndLogOutput' then begin
  960. Method := Stack.GetProc(PStart-7, Caller);
  961. if Method.Code <> nil then
  962. OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLogCustom, NativeInt(@Method))
  963. else if GetLogActive then
  964. OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLog, 0);
  965. end else if OrgName = 'ExecAndCaptureOutput' then
  966. OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLog, 0, omCapture);
  967. var ExecWait := TExecWait(Stack.GetInt(PStart-5));
  968. if (OutputReader <> nil) and (ExecWait <> ewWaitUntilTerminated) then
  969. InternalError(Format('Must call "%s" function with Wait = ewWaitUntilTerminated', [OrgName]));
  970. var Filename := Stack.GetString(PStart-1);
  971. if not IsProtectedSrcExe(Filename) then begin
  972. { Disable windows so the user can't utilize our UI during the InstExec
  973. call }
  974. var WindowDisabler := TWindowDisabler.Create;
  975. var ResultCode: Integer;
  976. try
  977. Stack.SetBool(PStart, InstExecEx(RunAsOriginalUser,
  978. ScriptFuncDisableFsRedir, Filename, Stack.GetString(PStart-2),
  979. Stack.GetString(PStart-3), ExecWait,
  980. Stack.GetInt(PStart-4), ProcessMessagesProc, OutputReader, ResultCode));
  981. finally
  982. WindowDisabler.Free;
  983. end;
  984. Stack.SetInt(PStart-6, ResultCode);
  985. if OrgName = 'ExecAndCaptureOutput' then begin
  986. { Set the three TExecOutput fields }
  987. Stack.SetArray(PStart-7, OutputReader.CaptureOutList, 0);
  988. Stack.SetArray(PStart-7, OutputReader.CaptureErrList, 1);
  989. Stack.SetInt(PStart-7, OutputReader.CaptureError.ToInteger, 2);
  990. end;
  991. end else begin
  992. Stack.SetBool(PStart, False);
  993. Stack.SetInt(PStart-6, ERROR_ACCESS_DENIED);
  994. end;
  995. finally
  996. OutputReader.Free;
  997. end;
  998. end);
  999. RegisterScriptFunc(['ShellExec', 'ShellExecAsOriginalUser'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1000. begin
  1001. var RunAsOriginalUser := OrgName = 'ShellExecAsOriginalUser';
  1002. if IsUninstaller and RunAsOriginalUser then
  1003. NoUninstallFuncError(OrgName);
  1004. var Filename := Stack.GetString(PStart-2);
  1005. if not IsProtectedSrcExe(Filename) then begin
  1006. { Disable windows so the user can't utilize our UI during the
  1007. InstShellExec call }
  1008. var WindowDisabler := TWindowDisabler.Create;
  1009. var ErrorCode: Integer;
  1010. try
  1011. Stack.SetBool(PStart, InstShellExecEx(RunAsOriginalUser,
  1012. Stack.GetString(PStart-1), Filename, Stack.GetString(PStart-3),
  1013. Stack.GetString(PStart-4), TExecWait(Stack.GetInt(PStart-6)),
  1014. Stack.GetInt(PStart-5), ProcessMessagesProc, ErrorCode));
  1015. finally
  1016. WindowDisabler.Free;
  1017. end;
  1018. Stack.SetInt(PStart-7, ErrorCode);
  1019. end else begin
  1020. Stack.SetBool(PStart, False);
  1021. Stack.SetInt(PStart-7, ERROR_ACCESS_DENIED);
  1022. end;
  1023. end);
  1024. RegisterScriptFunc('ISPROTECTEDSYSTEMFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1025. begin
  1026. Stack.SetBool(PStart, IsProtectedSystemFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  1027. end);
  1028. RegisterScriptFunc('MAKEPENDINGFILERENAMEOPERATIONSCHECKSUM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1029. begin
  1030. Stack.SetString(PStart, SHA256DigestToString(MakePendingFileRenameOperationsChecksum));
  1031. end);
  1032. RegisterScriptFunc('MODIFYPIFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1033. begin
  1034. Stack.SetBool(PStart, ModifyPifFile(Stack.GetString(PStart-1), Stack.GetBool(PStart-2)));
  1035. end);
  1036. RegisterScriptFunc('REGISTERSERVER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1037. begin
  1038. RegisterServer(False, Stack.GetBool(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2));
  1039. end);
  1040. RegisterScriptFunc('UNREGISTERSERVER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1041. begin
  1042. try
  1043. RegisterServer(True, Stack.GetBool(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3));
  1044. Stack.SetBool(PStart, True);
  1045. except
  1046. Stack.SetBool(PStart, False);
  1047. end;
  1048. end);
  1049. RegisterScriptFunc('UNREGISTERFONT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1050. begin
  1051. UnregisterFont(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2));
  1052. end);
  1053. RegisterScriptFunc('RESTARTREPLACE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1054. begin
  1055. RestartReplace(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1));
  1056. end);
  1057. RegisterScriptFunc('FORCEDIRECTORIES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1058. begin
  1059. Stack.SetBool(PStart, ForceDirectories(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  1060. end);
  1061. end;
  1062. procedure RegisterInstFuncOleScriptFuncs;
  1063. begin
  1064. RegisterScriptFunc('CREATESHELLLINK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1065. begin
  1066. Stack.SetString(PStart, CreateShellLink(Stack.GetString(PStart-1),
  1067. Stack.GetString(PStart-2), Stack.GetString(PStart-3),
  1068. Stack.GetString(PStart-4), Stack.GetString(PStart-5),
  1069. Stack.GetString(PStart-6), Stack.GetInt(PStart-7),
  1070. Stack.GetInt(PStart-8), 0, '', nil, False, False));
  1071. end);
  1072. RegisterScriptFunc('REGISTERTYPELIBRARY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1073. begin
  1074. if Stack.GetBool(PStart) then
  1075. HelperRegisterTypeLibrary(False, Stack.GetString(PStart-1))
  1076. else
  1077. RegisterTypeLibrary(Stack.GetString(PStart-1));
  1078. end);
  1079. RegisterScriptFunc('UNREGISTERTYPELIBRARY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1080. begin
  1081. try
  1082. if Stack.GetBool(PStart-1) then
  1083. HelperRegisterTypeLibrary(True, Stack.GetString(PStart-2))
  1084. else
  1085. UnregisterTypeLibrary(Stack.GetString(PStart-2));
  1086. Stack.SetBool(PStart, True);
  1087. except
  1088. Stack.SetBool(PStart, False);
  1089. end;
  1090. end);
  1091. RegisterScriptFunc('UNPINSHELLLINK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1092. begin
  1093. Stack.SetBool(PStart, UnpinShellLink(Stack.GetString(PStart-1)));
  1094. end);
  1095. end;
  1096. procedure RegisterMainFuncScriptFuncs;
  1097. begin
  1098. RegisterScriptFunc('ACTIVELANGUAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1099. begin
  1100. Stack.SetString(PStart, ExpandConst('{language}'));
  1101. end);
  1102. RegisterScriptFunc('EXPANDCONSTANT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1103. begin
  1104. Stack.SetString(PStart, ExpandConst(Stack.GetString(PStart-1)));
  1105. end);
  1106. RegisterScriptFunc('EXPANDCONSTANTEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1107. begin
  1108. Stack.SetString(PStart, ExpandConstEx(Stack.GetString(PStart-1), [Stack.GetString(PStart-2), Stack.GetString(PStart-3)]));
  1109. end);
  1110. RegisterScriptFunc('EXITSETUPMSGBOX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1111. begin
  1112. Stack.SetBool(PStart, ExitSetupMsgBox);
  1113. end);
  1114. RegisterScriptFunc('GETSHELLFOLDERBYCSIDL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1115. begin
  1116. Stack.SetString(PStart, GetShellFolderByCSIDL(Stack.GetInt(PStart-1), Stack.GetBool(PStart-2)));
  1117. end);
  1118. RegisterScriptFunc('INSTALLONTHISVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1119. begin
  1120. var MinVersion, OnlyBelowVersion: TSetupVersionData;
  1121. if not StrToSetupVersionData(Stack.GetString(PStart-1), MinVersion) then
  1122. InternalError(Format('%s: Invalid MinVersion string', [OrgName]))
  1123. else if not StrToSetupVersionData(Stack.GetString(PStart-2), OnlyBelowVersion) then
  1124. InternalError(Format('%s: Invalid OnlyBelowVersion string', [OrgName]))
  1125. else
  1126. Stack.SetBool(PStart, (InstallOnThisVersion(MinVersion, OnlyBelowVersion) = irInstall));
  1127. end);
  1128. RegisterScriptFunc('GETWINDOWSVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1129. begin
  1130. Stack.SetUInt(PStart, WindowsVersion);
  1131. end);
  1132. RegisterScriptFunc('GETWINDOWSVERSIONSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1133. begin
  1134. Stack.SetString(PStart, Format('%u.%.2u.%u', [WindowsVersion shr 24,
  1135. (WindowsVersion shr 16) and $FF, WindowsVersion and $FFFF]));
  1136. end);
  1137. RegisterScriptFunc(['MsgBox', 'SuppressibleMsgBox'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1138. begin
  1139. var Suppressible: Boolean;
  1140. var Default: Integer;
  1141. if OrgName = 'MsgBox' then begin
  1142. Suppressible := False;
  1143. Default := 0;
  1144. end else begin
  1145. Suppressible := True;
  1146. Default := Stack.GetInt(PStart-4);
  1147. end;
  1148. Stack.SetInt(PStart, LoggedMsgBox(Stack.GetString(PStart-1), GetMsgBoxCaption, TMsgBoxType(Stack.GetInt(PStart-2)), Stack.GetInt(PStart-3), Suppressible, Default));
  1149. end);
  1150. RegisterScriptFunc(['TaskDialogMsgBox', 'SuppressibleTaskDialogMsgBox'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1151. begin
  1152. var Suppressible: Boolean;
  1153. var Default: Integer;
  1154. if OrgName = 'TaskDialogMsgBox' then begin
  1155. Suppressible := False;
  1156. Default := 0;
  1157. end else begin
  1158. Suppressible := True;
  1159. Default := Stack.GetInt(PStart-7);
  1160. end;
  1161. var ButtonLabels := Stack.GetStringArray(PStart-5);
  1162. Stack.SetInt(PStart, LoggedTaskDialogMsgBox('', Stack.GetString(PStart-1), Stack.GetString(PStart-2), GetMsgBoxCaption, TMsgBoxType(Stack.GetInt(PStart-3)), Stack.GetInt(PStart-4), ButtonLabels, Stack.GetInt(PStart-6), Suppressible, Default));
  1163. end);
  1164. RegisterScriptFunc('ISWIN64', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1165. begin
  1166. Stack.SetBool(PStart, IsWin64);
  1167. end);
  1168. RegisterScriptFunc('IS64BITINSTALLMODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1169. begin
  1170. Stack.SetBool(PStart, Is64BitInstallMode);
  1171. end);
  1172. RegisterScriptFunc('IsWinDark', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1173. begin
  1174. Stack.SetBool(PStart, IsWinDark);
  1175. end);
  1176. RegisterScriptFunc('IsDarkInstallMode', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1177. begin
  1178. Stack.SetBool(PStart, IsDarkInstallMode);
  1179. end);
  1180. RegisterScriptFunc('PROCESSORARCHITECTURE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1181. begin
  1182. Stack.SetInt(PStart, Integer(ProcessorArchitecture));
  1183. end);
  1184. RegisterScriptFunc(['IsArm32Compatible', 'IsArm64', 'IsX64', 'IsX64OS', 'IsX64Compatible', 'IsX86', 'IsX86OS', 'IsX86Compatible'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1185. begin
  1186. var ArchitectureIdentifier := LowerCase(Copy(String(OrgName), 3, MaxInt));
  1187. Stack.SetBool(PStart, EvalArchitectureIdentifier(ArchitectureIdentifier));
  1188. end);
  1189. RegisterScriptFunc('CUSTOMMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1190. begin
  1191. Stack.SetString(PStart, CustomMessage(Stack.GetString(PStart-1)));
  1192. end);
  1193. RegisterScriptFunc('RMSESSIONSTARTED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1194. begin
  1195. Stack.SetBool(PStart, RmSessionStarted);
  1196. end);
  1197. RegisterScriptFunc('REGISTEREXTRACLOSEAPPLICATIONSRESOURCE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1198. begin
  1199. Stack.SetBool(PStart, CodeRegisterExtraCloseApplicationsResource(Stack.GetBool(PStart-1), Stack.GetString(PStart-2)));
  1200. end);
  1201. RegisterScriptFunc('GETWIZARDFORM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1202. begin
  1203. Stack.SetClass(PStart, GetWizardForm);
  1204. end);
  1205. RegisterScriptFunc(['WizardIsComponentSelected', 'IsComponentSelected', 'WizardIsTaskSelected', 'IsTaskSelected'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1206. begin
  1207. var StringList := TStringList.Create;
  1208. try
  1209. var Components := (OrgName = 'WizardIsComponentSelected') or (OrgName = 'IsComponentSelected');
  1210. if Components then
  1211. GetWizardForm.GetSelectedComponents(StringList, False, False)
  1212. else
  1213. GetWizardForm.GetSelectedTasks(StringList, False, False, False);
  1214. var S := Stack.GetString(PStart-1);
  1215. StringChange(S, '/', '\');
  1216. if Components then
  1217. Stack.SetBool(PStart, ShouldProcessEntry(StringList, nil, S, '', '', ''))
  1218. else
  1219. Stack.SetBool(PStart, ShouldProcessEntry(nil, StringList, '', S, '', ''));
  1220. finally
  1221. StringList.Free;
  1222. end;
  1223. end);
  1224. end;
  1225. procedure RegisterMessagesScriptFuncs;
  1226. begin
  1227. RegisterScriptFunc('SETUPMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1228. begin
  1229. Stack.SetString(PStart, SetupMessages[TSetupMessageID(Stack.GetInt(PStart-1))]);
  1230. end);
  1231. end;
  1232. procedure RegisterSystemScriptFuncs;
  1233. begin
  1234. RegisterScriptFunc('RANDOM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1235. begin
  1236. Stack.SetInt(PStart, Integer(TStrongRandom.GenerateUInt32Range(UInt32(Stack.GetInt(PStart-1)))));
  1237. end);
  1238. RegisterScriptFunc('FILESIZE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1239. begin
  1240. try
  1241. var F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite);
  1242. try
  1243. Stack.SetInt(PStart-2, F.CappedSize);
  1244. Stack.SetBool(PStart, True);
  1245. finally
  1246. F.Free;
  1247. end;
  1248. except
  1249. Stack.SetBool(PStart, False);
  1250. end;
  1251. end);
  1252. RegisterScriptFunc('FILESIZE64', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1253. begin
  1254. try
  1255. var F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite);
  1256. try
  1257. Stack.SetInt64(PStart-2, F.Size);
  1258. Stack.SetBool(PStart, True);
  1259. finally
  1260. F.Free;
  1261. end;
  1262. except
  1263. Stack.SetBool(PStart, False);
  1264. end;
  1265. end);
  1266. RegisterScriptFunc('SET8087CW', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1267. begin
  1268. Set8087CW(Stack.GetInt(PStart));
  1269. end);
  1270. RegisterScriptFunc('GET8087CW', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1271. begin
  1272. Stack.SetInt(PStart, Get8087CW);
  1273. end);
  1274. RegisterScriptFunc('UTF8ENCODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1275. begin
  1276. Stack.SetAnsiString(PStart, Utf8Encode(Stack.GetString(PStart-1)));
  1277. end);
  1278. RegisterScriptFunc('UTF8DECODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1279. begin
  1280. Stack.SetString(PStart, UTF8ToString(Stack.GetAnsiString(PStart-1)));
  1281. end);
  1282. end;
  1283. procedure RegisterSysUtilsScriptFuncs;
  1284. begin
  1285. RegisterScriptFunc('BEEP', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1286. begin
  1287. Beep;
  1288. end);
  1289. RegisterScriptFunc('TRIMLEFT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1290. begin
  1291. Stack.SetString(PStart, TrimLeft(Stack.GetString(PStart-1)));
  1292. end);
  1293. RegisterScriptFunc('TRIMRIGHT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1294. begin
  1295. Stack.SetString(PStart, TrimRight(Stack.GetString(PStart-1)));
  1296. end);
  1297. RegisterScriptFunc('GETCURRENTDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1298. begin
  1299. Stack.SetString(PStart, GetCurrentDir);
  1300. end);
  1301. RegisterScriptFunc('SETCURRENTDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1302. begin
  1303. Stack.SetBool(PStart, SetCurrentDir(Stack.GetString(PStart-1)));
  1304. end);
  1305. RegisterScriptFunc('EXPANDFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1306. begin
  1307. Stack.SetString(PStart, PathExpand(Stack.GetString(PStart-1)));
  1308. end);
  1309. RegisterScriptFunc('EXPANDUNCFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1310. begin
  1311. Stack.SetString(PStart, ExpandUNCFileName(Stack.GetString(PStart-1)));
  1312. end);
  1313. RegisterScriptFunc('EXTRACTRELATIVEPATH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1314. begin
  1315. Stack.SetString(PStart, NewExtractRelativePath(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  1316. end);
  1317. RegisterScriptFunc('EXTRACTFILEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1318. begin
  1319. Stack.SetString(PStart, PathExtractDir(Stack.GetString(PStart-1)));
  1320. end);
  1321. RegisterScriptFunc('EXTRACTFILEDRIVE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1322. begin
  1323. Stack.SetString(PStart, PathExtractDrive(Stack.GetString(PStart-1)));
  1324. end);
  1325. RegisterScriptFunc('EXTRACTFILEEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1326. begin
  1327. Stack.SetString(PStart, PathExtractExt(Stack.GetString(PStart-1)));
  1328. end);
  1329. RegisterScriptFunc('EXTRACTFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1330. begin
  1331. Stack.SetString(PStart, PathExtractName(Stack.GetString(PStart-1)));
  1332. end);
  1333. RegisterScriptFunc('EXTRACTFILEPATH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1334. begin
  1335. Stack.SetString(PStart, PathExtractPath(Stack.GetString(PStart-1)));
  1336. end);
  1337. RegisterScriptFunc('CHANGEFILEEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1338. begin
  1339. Stack.SetString(PStart, PathChangeExt(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  1340. end);
  1341. RegisterScriptFunc('FILESEARCH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1342. begin
  1343. Stack.SetString(PStart, NewFileSearch(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  1344. end);
  1345. RegisterScriptFunc('RENAMEFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1346. begin
  1347. var OldName := Stack.GetString(PStart-1);
  1348. if not IsProtectedSrcExe(OldName) then
  1349. Stack.SetBool(PStart, MoveFileRedir(ScriptFuncDisableFsRedir, OldName, Stack.GetString(PStart-2)))
  1350. else
  1351. Stack.SetBool(PStart, False);
  1352. end);
  1353. RegisterScriptFunc('DELETEFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1354. begin
  1355. Stack.SetBool(PStart, DeleteFileRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  1356. end);
  1357. RegisterScriptFunc('CREATEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1358. begin
  1359. Stack.SetBool(PStart, CreateDirectoryRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  1360. end);
  1361. RegisterScriptFunc('REMOVEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1362. begin
  1363. Stack.SetBool(PStart, RemoveDirectoryRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  1364. end);
  1365. RegisterScriptFunc('COMPARESTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1366. begin
  1367. Stack.SetInt(PStart, CompareStr(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  1368. end);
  1369. RegisterScriptFunc('COMPARETEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1370. begin
  1371. Stack.SetInt(PStart, CompareText(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  1372. end);
  1373. RegisterScriptFunc('SAMESTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1374. begin
  1375. Stack.SetBool(PStart, CompareStr(Stack.GetString(PStart-1), Stack.GetString(PStart-2)) = 0);
  1376. end);
  1377. RegisterScriptFunc('SAMETEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1378. begin
  1379. Stack.SetBool(PStart, CompareText(Stack.GetString(PStart-1), Stack.GetString(PStart-2)) = 0);
  1380. end);
  1381. RegisterScriptFunc('GETDATETIMESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1382. begin
  1383. var OldDateSeparator := FormatSettings.DateSeparator;
  1384. var OldTimeSeparator := FormatSettings.TimeSeparator;
  1385. try
  1386. var NewDateSeparator := Stack.GetChar(PStart-2);
  1387. var NewTimeSeparator := Stack.GetChar(PStart-3);
  1388. if NewDateSeparator <> #0 then
  1389. FormatSettings.DateSeparator := NewDateSeparator;
  1390. if NewTimeSeparator <> #0 then
  1391. FormatSettings.TimeSeparator := NewTimeSeparator;
  1392. Stack.SetString(PStart, FormatDateTime(Stack.GetString(PStart-1), Now));
  1393. finally
  1394. FormatSettings.TimeSeparator := OldTimeSeparator;
  1395. FormatSettings.DateSeparator := OldDateSeparator;
  1396. end;
  1397. end);
  1398. RegisterScriptFunc('SYSERRORMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1399. begin
  1400. Stack.SetString(PStart, Win32ErrorString(Stack.GetInt(PStart-1)));
  1401. end);
  1402. end;
  1403. procedure RegisterVerInfoFuncScriptFuncs;
  1404. begin
  1405. RegisterScriptFunc('GETVERSIONNUMBERS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1406. begin
  1407. var VersionNumbers: TFileVersionNumbers;
  1408. if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin
  1409. Stack.SetInt(PStart-2, VersionNumbers.MS);
  1410. Stack.SetInt(PStart-3, VersionNumbers.LS);
  1411. Stack.SetBool(PStart, True);
  1412. end else
  1413. Stack.SetBool(PStart, False);
  1414. end);
  1415. RegisterScriptFunc('GETVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1416. begin
  1417. var VersionNumbers: TFileVersionNumbers;
  1418. if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin
  1419. Stack.SetUInt(PStart-2, VersionNumbers.MS shr 16);
  1420. Stack.SetUInt(PStart-3, VersionNumbers.MS and $FFFF);
  1421. Stack.SetUInt(PStart-4, VersionNumbers.LS shr 16);
  1422. Stack.SetUInt(PStart-5, VersionNumbers.LS and $FFFF);
  1423. Stack.SetBool(PStart, True);
  1424. end else
  1425. Stack.SetBool(PStart, False);
  1426. end);
  1427. RegisterScriptFunc('GETVERSIONNUMBERSSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1428. begin
  1429. var VersionNumbers: TFileVersionNumbers;
  1430. if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin
  1431. Stack.SetString(PStart-2, Format('%u.%u.%u.%u', [VersionNumbers.MS shr 16,
  1432. VersionNumbers.MS and $FFFF, VersionNumbers.LS shr 16, VersionNumbers.LS and $FFFF]));
  1433. Stack.SetBool(PStart, True);
  1434. end else
  1435. Stack.SetBool(PStart, False);
  1436. end);
  1437. RegisterScriptFunc('GETPACKEDVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1438. begin
  1439. var VersionNumbers: TFileVersionNumbers;
  1440. if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin
  1441. Stack.SetInt64(PStart-2, VersionNumbersToInt64(VersionNumbers));
  1442. Stack.SetBool(PStart, True);
  1443. end else
  1444. Stack.SetBool(PStart, False);
  1445. end);
  1446. RegisterScriptFunc('PACKVERSIONNUMBERS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1447. begin
  1448. const VersionMS = Stack.GetUInt(PStart-1);
  1449. const VersionLS = Stack.GetUInt(PStart-2);
  1450. Stack.SetInt64(PStart, HighLowToInt64(VersionMS, VersionLS));
  1451. end);
  1452. RegisterScriptFunc('PACKVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1453. begin
  1454. var VersionNumbers: TFileVersionNumbers;
  1455. VersionNumbers.MS := (Stack.GetUInt(PStart-1) shl 16) or (Stack.GetUInt(PStart-2) and $FFFF);
  1456. VersionNumbers.LS := (Stack.GetUInt(PStart-3) shl 16) or (Stack.GetUInt(PStart-4) and $FFFF);
  1457. Stack.SetInt64(PStart, VersionNumbersToInt64(VersionNumbers));
  1458. end);
  1459. RegisterScriptFunc('COMPAREPACKEDVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1460. begin
  1461. Stack.SetInt(PStart, CompareInt64(Stack.GetInt64(PStart-1), Stack.GetInt64(PStart-2)));
  1462. end);
  1463. RegisterScriptFunc('SAMEPACKEDVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1464. begin
  1465. Stack.SetBool(PStart, Stack.GetInt64(PStart-1) = Stack.GetInt64(PStart-2));
  1466. end);
  1467. RegisterScriptFunc('UNPACKVERSIONNUMBERS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1468. begin
  1469. var VersionNumbers: TFileVersionNumbers;
  1470. VersionNumbers.MS := UInt64(Stack.GetInt64(PStart)) shr 32;
  1471. VersionNumbers.LS := UInt64(Stack.GetInt64(PStart)) and $FFFFFFFF;
  1472. Stack.SetUInt(PStart-1, VersionNumbers.MS);
  1473. Stack.SetUInt(PStart-2, VersionNumbers.LS);
  1474. end);
  1475. RegisterScriptFunc('UNPACKVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1476. begin
  1477. var VersionNumbers: TFileVersionNumbers;
  1478. VersionNumbers.MS := UInt64(Stack.GetInt64(PStart)) shr 32;
  1479. VersionNumbers.LS := UInt64(Stack.GetInt64(PStart)) and $FFFFFFFF;
  1480. Stack.SetUInt(PStart-1, VersionNumbers.MS shr 16);
  1481. Stack.SetUInt(PStart-2, VersionNumbers.MS and $FFFF);
  1482. Stack.SetUInt(PStart-3, VersionNumbers.LS shr 16);
  1483. Stack.SetUInt(PStart-4, VersionNumbers.LS and $FFFF);
  1484. end);
  1485. RegisterScriptFunc('VERSIONTOSTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1486. begin
  1487. var VersionNumbers: TFileVersionNumbers;
  1488. VersionNumbers.MS := UInt64(Stack.GetInt64(PStart-1)) shr 32;
  1489. VersionNumbers.LS := UInt64(Stack.GetInt64(PStart-1)) and $FFFFFFFF;
  1490. Stack.SetString(PStart, Format('%u.%u.%u.%u', [VersionNumbers.MS shr 16,
  1491. VersionNumbers.MS and $FFFF, VersionNumbers.LS shr 16, VersionNumbers.LS and $FFFF]));
  1492. end);
  1493. RegisterScriptFunc('STRTOVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1494. begin
  1495. var VersionNumbers: TFileVersionNumbers;
  1496. if StrToVersionNumbers(Stack.GetString(PStart-1), VersionNumbers) then begin
  1497. Stack.SetInt64(PStart-2, VersionNumbersToInt64(VersionNumbers));
  1498. Stack.SetBool(PStart, True);
  1499. end else
  1500. Stack.SetBool(PStart, False);
  1501. end);
  1502. end;
  1503. type
  1504. TDllProc = function(const Param1, Param2: Longint): Longint; stdcall;
  1505. procedure RegisterWindowsScriptFuncs;
  1506. begin
  1507. RegisterScriptFunc('SLEEP', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1508. begin
  1509. Sleep(Stack.GetInt(PStart));
  1510. end);
  1511. RegisterScriptFunc('FINDWINDOWBYCLASSNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1512. begin
  1513. Stack.SetInt(PStart, FindWindow(PChar(Stack.GetString(PStart-1)), nil));
  1514. end);
  1515. RegisterScriptFunc('FINDWINDOWBYWINDOWNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1516. begin
  1517. Stack.SetInt(PStart, FindWindow(nil, PChar(Stack.GetString(PStart-1))));
  1518. end);
  1519. RegisterScriptFunc('SENDMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1520. begin
  1521. Stack.SetInt(PStart, SendMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4)));
  1522. end);
  1523. RegisterScriptFunc('POSTMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1524. begin
  1525. Stack.SetBool(PStart, PostMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4)));
  1526. end);
  1527. RegisterScriptFunc('SENDNOTIFYMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1528. begin
  1529. Stack.SetBool(PStart, SendNotifyMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4)));
  1530. end);
  1531. RegisterScriptFunc('REGISTERWINDOWMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1532. begin
  1533. Stack.SetInt(PStart, RegisterWindowMessage(PChar(Stack.GetString(PStart-1))));
  1534. end);
  1535. RegisterScriptFunc('SENDBROADCASTMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1536. begin
  1537. Stack.SetInt(PStart, SendMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3)));
  1538. end);
  1539. RegisterScriptFunc('POSTBROADCASTMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1540. begin
  1541. Stack.SetBool(PStart, PostMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3)));
  1542. end);
  1543. RegisterScriptFunc('SENDBROADCASTNOTIFYMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1544. begin
  1545. Stack.SetBool(PStart, SendNotifyMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3)));
  1546. end);
  1547. RegisterScriptFunc('LOADDLL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1548. begin
  1549. var DllHandle := SafeLoadLibrary(Stack.GetString(PStart-1), SEM_NOOPENFILEERRORBOX);
  1550. if DllHandle <> 0 then
  1551. Stack.SetInt(PStart-2, 0)
  1552. else
  1553. Stack.SetInt(PStart-2, GetLastError);
  1554. Stack.SetInt(PStart, DllHandle);
  1555. end);
  1556. RegisterScriptFunc('CALLDLLPROC', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1557. begin
  1558. var DllProc: TDllProc;
  1559. @DllProc := GetProcAddress(Stack.GetInt(PStart-1), PChar(Stack.GetString(PStart-2)));
  1560. if Assigned(DllProc) then begin
  1561. Stack.SetInt(PStart-5, DllProc(Stack.GetInt(PStart-3), Stack.GetInt(PStart-4)));
  1562. Stack.SetBool(PStart, True);
  1563. end else
  1564. Stack.SetBool(PStart, False);
  1565. end);
  1566. RegisterScriptFunc('FREEDLL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1567. begin
  1568. Stack.SetBool(PStart, FreeLibrary(Stack.GetInt(PStart-1)));
  1569. end);
  1570. RegisterScriptFunc('CREATEMUTEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1571. begin
  1572. Windows.CreateMutex(nil, False, PChar(Stack.GetString(PStart)));
  1573. end);
  1574. RegisterScriptFunc('OEMTOCHARBUFF', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1575. begin
  1576. var S := Stack.GetAnsiString(PStart);
  1577. OemToCharBuffA(PAnsiChar(S), PAnsiChar(S), Length(S));
  1578. Stack.SetAnsiString(PStart, S);
  1579. end);
  1580. RegisterScriptFunc('CHARTOOEMBUFF', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1581. begin
  1582. var S := Stack.GetAnsiString(PStart);
  1583. CharToOemBuffA(PAnsiChar(S), PAnsiChar(S), Length(S));
  1584. Stack.SetAnsiString(PStart, S);
  1585. end);
  1586. end;
  1587. procedure RegisterActiveXScriptFuncs;
  1588. begin
  1589. RegisterScriptFunc('COFREEUNUSEDLIBRARIES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1590. begin
  1591. CoFreeUnusedLibraries;
  1592. end);
  1593. end;
  1594. procedure RegisterLoggingFuncScriptFuncs;
  1595. begin
  1596. RegisterScriptFunc('LOG', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1597. begin
  1598. Log(Stack.GetString(PStart));
  1599. end);
  1600. end;
  1601. procedure RegisterOtherScriptFuncs;
  1602. begin
  1603. RegisterScriptFunc('BRINGTOFRONTANDRESTORE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1604. begin
  1605. { Must be in this order to work around VCL bug }
  1606. Application.Restore;
  1607. Application.BringToFront;
  1608. end);
  1609. RegisterScriptFunc('WizardDirValue', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1610. begin
  1611. Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.DirEdit.Text));
  1612. end);
  1613. RegisterScriptFunc('WizardGroupValue', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1614. begin
  1615. Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.GroupEdit.Text));
  1616. end);
  1617. RegisterScriptFunc('WizardNoIcons', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1618. begin
  1619. Stack.SetBool(PStart, GetWizardForm.NoIconsCheck.Checked);
  1620. end);
  1621. RegisterScriptFunc('WizardSetupType', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1622. begin
  1623. var TypeEntry := GetWizardForm.GetSetupType;
  1624. if TypeEntry <> nil then begin
  1625. if Stack.GetBool(PStart-1) then
  1626. Stack.SetString(PStart, TypeEntry.Description)
  1627. else
  1628. Stack.SetString(PStart, TypeEntry.Name);
  1629. end
  1630. else
  1631. Stack.SetString(PStart, '');
  1632. end);
  1633. RegisterScriptFunc(['WizardSelectedComponents', 'WizardSelectedTasks'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1634. begin
  1635. var StringList := TStringList.Create;
  1636. try
  1637. if OrgName = 'WizardSelectedComponents' then
  1638. GetWizardForm.GetSelectedComponents(StringList, Stack.GetBool(PStart-1), False)
  1639. else
  1640. GetWizardForm.GetSelectedTasks(StringList, Stack.GetBool(PStart-1), False, False);
  1641. Stack.SetString(PStart, StringsToCommaString(StringList));
  1642. finally
  1643. StringList.Free;
  1644. end;
  1645. end);
  1646. RegisterScriptFunc(['WizardSelectComponents', 'WizardSelectTasks'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1647. begin
  1648. var StringList := TStringList.Create;
  1649. try
  1650. var S := Stack.GetString(PStart);
  1651. StringChange(S, '/', '\');
  1652. SetStringsFromCommaString(StringList, S);
  1653. if OrgName = 'WizardSelectComponents' then
  1654. GetWizardForm.SelectComponents(StringList)
  1655. else
  1656. GetWizardForm.SelectTasks(StringList);
  1657. finally
  1658. StringList.Free;
  1659. end;
  1660. end);
  1661. RegisterScriptFunc('WizardSilent', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1662. begin
  1663. Stack.SetBool(PStart, InstallMode <> imNormal);
  1664. end);
  1665. RegisterScriptFunc('ISUNINSTALLER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1666. begin
  1667. Stack.SetBool(PStart, IsUninstaller);
  1668. end);
  1669. RegisterScriptFunc('UninstallSilent', sfOnlyUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1670. begin
  1671. Stack.SetBool(PStart, UninstallSilent);
  1672. end);
  1673. RegisterScriptFunc('CurrentFilename', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1674. begin
  1675. if CheckOrInstallCurrentFilename <> '' then
  1676. Stack.SetString(PStart, CheckOrInstallCurrentFilename)
  1677. else
  1678. 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]));
  1679. end);
  1680. RegisterScriptFunc('CurrentSourceFilename', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1681. begin
  1682. if CheckOrInstallCurrentSourceFilename <> '' then
  1683. Stack.SetString(PStart, CheckOrInstallCurrentSourceFilename)
  1684. else
  1685. 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]));
  1686. end);
  1687. RegisterScriptFunc('CASTSTRINGTOINTEGER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1688. begin
  1689. Stack.SetInt(PStart, Integer(PChar(Stack.GetString(PStart-1))));
  1690. end);
  1691. RegisterScriptFunc('CASTINTEGERTOSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1692. begin
  1693. Stack.SetString(PStart, String(PChar(Stack.GetInt(PStart-1))));
  1694. end);
  1695. RegisterScriptFunc('ABORT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1696. begin
  1697. Abort;
  1698. end);
  1699. RegisterScriptFunc('GETEXCEPTIONMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1700. begin
  1701. Stack.SetString(PStart, GetExceptionMessage(Caller));
  1702. end);
  1703. RegisterScriptFunc('RAISEEXCEPTION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1704. begin
  1705. raise Exception.Create(Stack.GetString(PStart));
  1706. end);
  1707. RegisterScriptFunc('SHOWEXCEPTIONMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1708. begin
  1709. TMainForm.ShowExceptionMsg(AddPeriod(GetExceptionMessage(Caller)));
  1710. end);
  1711. RegisterScriptFunc('TERMINATED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1712. begin
  1713. Stack.SetBool(PStart, Application.Terminated);
  1714. end);
  1715. RegisterScriptFunc('GETPREVIOUSDATA', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1716. begin
  1717. if IsUninstaller then
  1718. Stack.SetString(PStart, GetCodePreviousData(UninstallExpandedAppId, Stack.GetString(PStart-1), Stack.GetString(PStart-2)))
  1719. else
  1720. Stack.SetString(PStart, GetCodePreviousData(ExpandConst(SetupHeader.AppId), Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  1721. end);
  1722. RegisterScriptFunc('SETPREVIOUSDATA', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1723. begin
  1724. Stack.SetBool(PStart, SetCodePreviousData(Stack.GetInt(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3)));
  1725. end);
  1726. RegisterScriptFunc('LOADSTRINGFROMFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1727. begin
  1728. var S := Stack.GetAnsiString(PStart-2);
  1729. Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), S, fsRead));
  1730. Stack.SetAnsiString(PStart-2, S);
  1731. end);
  1732. RegisterScriptFunc('LOADSTRINGFROMLOCKEDFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1733. begin
  1734. var S := Stack.GetAnsiString(PStart-2);
  1735. Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), S, fsReadWrite));
  1736. Stack.SetAnsiString(PStart-2, S);
  1737. end);
  1738. RegisterScriptFunc('LOADSTRINGSFROMFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1739. begin
  1740. Stack.SetBool(PStart, LoadStringsFromFile(Stack.GetString(PStart-1), Stack, PStart-2, fsRead));
  1741. end);
  1742. RegisterScriptFunc('LOADSTRINGSFROMLOCKEDFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1743. begin
  1744. Stack.SetBool(PStart, LoadStringsFromFile(Stack.GetString(PStart-1), Stack, PStart-2, fsReadWrite));
  1745. end);
  1746. RegisterScriptFunc('SAVESTRINGTOFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1747. begin
  1748. Stack.SetBool(PStart, SaveStringToFile(Stack.GetString(PStart-1), Stack.GetAnsiString(PStart-2), Stack.GetBool(PStart-3)));
  1749. end);
  1750. RegisterScriptFunc('SAVESTRINGSTOFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1751. begin
  1752. Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), False, False));
  1753. end);
  1754. RegisterScriptFunc('SAVESTRINGSTOUTF8FILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1755. begin
  1756. Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), True, False));
  1757. end);
  1758. RegisterScriptFunc('SAVESTRINGSTOUTF8FILEWITHOUTBOM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1759. begin
  1760. Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), True, True));
  1761. end);
  1762. RegisterScriptFunc('ENABLEFSREDIRECTION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1763. begin
  1764. Stack.SetBool(PStart, not ScriptFuncDisableFsRedir);
  1765. if Stack.GetBool(PStart-1) then
  1766. ScriptFuncDisableFsRedir := False
  1767. else begin
  1768. if not IsWin64 then
  1769. InternalError('Cannot disable FS redirection on this version of Windows');
  1770. ScriptFuncDisableFsRedir := True;
  1771. end;
  1772. end);
  1773. RegisterScriptFunc('GETUNINSTALLPROGRESSFORM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1774. begin
  1775. Stack.SetClass(PStart, GetUninstallProgressForm);
  1776. end);
  1777. RegisterScriptFunc('CREATECALLBACK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1778. begin
  1779. Stack.SetInt(PStart, CreateCallback(Caller, Stack.Items[PStart-1]));
  1780. end);
  1781. RegisterScriptFunc('ISDOTNETINSTALLED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1782. begin
  1783. Stack.SetBool(PStart, IsDotNetInstalled(InstallDefaultRegView, TDotNetVersion(Stack.GetInt(PStart-1)), Stack.GetInt(PStart-2)));
  1784. end);
  1785. RegisterScriptFunc('ISMSIPRODUCTINSTALLED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1786. begin
  1787. var ErrorCode: Cardinal;
  1788. Stack.SetBool(PStart, IsMsiProductInstalled(Stack.GetString(PStart-1), Stack.GetInt64(PStart-2), ErrorCode));
  1789. if ErrorCode <> 0 then
  1790. raise Exception.Create(Win32ErrorString(ErrorCode));
  1791. end);
  1792. RegisterScriptFunc('INITIALIZEBITMAPBUTTONFROMICON', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1793. begin
  1794. var AscendingTrySizes := Stack.GetIntArray(PStart-4);
  1795. Stack.SetBool(PStart, TBitmapButton(Stack.GetClass(PStart-1)).InitializeFromIcon(0, PChar(Stack.GetString(PStart-2)), Stack.GetInt(PStart-3), AscendingTrySizes));
  1796. end);
  1797. RegisterScriptFunc('INITIALIZEBITMAPIMAGEFROMICON', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1798. begin
  1799. var AscendingTrySizes := Stack.GetIntArray(PStart-4);
  1800. Stack.SetBool(PStart, TBitmapImage(Stack.GetClass(PStart-1)).InitializeFromIcon(0, PChar(Stack.GetString(PStart-2)), Stack.GetInt(PStart-3), AscendingTrySizes));
  1801. end);
  1802. RegisterScriptFunc('InitializeBitmapButtonFromStockIcon', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1803. begin
  1804. var AscendingTrySizes := Stack.GetIntArray(PStart-4);
  1805. Stack.SetBool(PStart, TBitmapButton(Stack.GetClass(PStart-1)).InitializeFromStockIcon(Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), AscendingTrySizes));
  1806. end);
  1807. RegisterScriptFunc('InitializeBitmapImageFromStockIcon', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1808. begin
  1809. var AscendingTrySizes := Stack.GetIntArray(PStart-4);
  1810. Stack.SetBool(PStart, TBitmapImage(Stack.GetClass(PStart-1)).InitializeFromStockIcon(Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), AscendingTrySizes));
  1811. end);
  1812. RegisterScriptFunc(['Extract7ZipArchive', 'ExtractArchive'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1813. begin
  1814. var Password: String;
  1815. var FullDirsItemNo: Longint;
  1816. if OrgName = 'Extract7ZipArchive' then begin
  1817. Password := '';
  1818. FullDirsItemNo := PStart-2;
  1819. end else begin
  1820. Password := Stack.GetString(PStart-2);
  1821. FullDirsItemNo := PStart-3;
  1822. end;
  1823. const Throttler = TProgressThrottler.Create(TOnExtractionProgress(Stack.GetProc(FullDirsItemNo-1, Caller)));
  1824. try
  1825. try
  1826. if SetupHeader.SevenZipLibraryName <> '' then
  1827. ExtractArchiveRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1),
  1828. Password, Stack.GetBool(FullDirsItemNo), Throttler.OnExtractionProgress)
  1829. else
  1830. Extract7ZipArchiveRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1),
  1831. Password, Stack.GetBool(FullDirsItemNo), Throttler.OnExtractionProgress);
  1832. except
  1833. on E: EAbort do
  1834. raise Exception.Create(SetupMessages[msgErrorExtractionAborted])
  1835. else
  1836. raise Exception.Create(FmtSetupMessage1(msgErrorExtractionFailed, GetExceptMessage));
  1837. end;
  1838. finally
  1839. Throttler.Free;
  1840. end;
  1841. end);
  1842. RegisterScriptFunc('MapArchiveExtensions', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1843. begin
  1844. if SetupHeader.SevenZipLibraryName <> '' then
  1845. MapArchiveExtensions(Stack.GetString(PStart), Stack.GetString(PStart-1));
  1846. end);
  1847. RegisterScriptFunc('DEBUGGING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1848. begin
  1849. Stack.SetBool(PStart, Debugging);
  1850. end);
  1851. RegisterScriptFunc('StringJoin', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1852. begin
  1853. var Values := Stack.GetStringArray(PStart-2);
  1854. Stack.SetString(PStart, String.Join(Stack.GetString(PStart-1), Values));
  1855. end);
  1856. RegisterScriptFunc(['StringSplit', 'StringSplitEx'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1857. begin
  1858. var Separators := Stack.GetStringArray(PStart-2);
  1859. var Parts: TArray<String>;
  1860. if OrgName = 'StringSplitEx' then begin
  1861. var Quote := Stack.GetChar(PStart-3);
  1862. Parts := Stack.GetString(PStart-1).Split(Separators, Quote, Quote, TStringSplitOptions(Stack.GetInt(PStart-4)))
  1863. end else
  1864. Parts := Stack.GetString(PStart-1).Split(Separators, TStringSplitOptions(Stack.GetInt(PStart-3)));
  1865. Stack.SetArray(PStart, Parts);
  1866. end);
  1867. RegisterScriptFunc('ISSigVerify', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1868. begin
  1869. const ISSigAllowedKeys = ConvertAllowedKeysRuntimeIDsToISSigAllowedKeys(TStringList(Stack.GetClass(PStart-1)));
  1870. const Filename = Stack.GetString(PStart-2);
  1871. const VerifyFilename = Stack.GetBool(PStart-3);
  1872. const KeepOpen = Stack.GetBool(PStart-4);
  1873. { Verify signature & file, keeping open afterwards if requested
  1874. Also see TrustFunc's CheckFileTrust which can also keep open afterwards }
  1875. var F := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
  1876. try
  1877. var ExpectedFileHash: TSHA256Digest;
  1878. DoISSigVerify(nil, F, Filename, VerifyFilename, ISSigAllowedKeys, ExpectedFileHash);
  1879. { Couldn't get the SHA-256 while downloading so need to get and check it now }
  1880. const ActualFileHash = ISSigCalcStreamHash(F);
  1881. if not SHA256DigestsEqual(ActualFileHash, ExpectedFileHash) then
  1882. VerificationError(veFileHashIncorrect);
  1883. except
  1884. FreeAndNil(F);
  1885. raise;
  1886. end;
  1887. if not KeepOpen then
  1888. FreeAndNil(F);
  1889. Stack.SetClass(PStart, F);
  1890. end);
  1891. RegisterScriptFunc('Round', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1892. begin
  1893. const SaveRoundMode = GetRoundMode;
  1894. try
  1895. SetRoundMode(rmNearest);
  1896. Stack.SetInt64(PStart, Round(Stack.GetReal(PStart-1)));
  1897. finally
  1898. SetRoundMode(SaveRoundMode);
  1899. end;
  1900. end);
  1901. RegisterScriptFunc('Trunc', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1902. begin
  1903. Stack.SetInt64(PStart, Trunc(Stack.GetReal(PStart-1)));
  1904. end);
  1905. RegisterScriptFunc('MulDiv', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1906. begin
  1907. Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3)));
  1908. end);
  1909. RegisterScriptFunc('StrToColor', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1910. begin
  1911. var Hex := Stack.GetString(PStart-1);
  1912. if (Length(Hex) = 7) and (Hex[1] = '#') then
  1913. Hex := '$' + Copy(Hex, 6, 2) + Copy(Hex, 4, 2) + Copy(Hex, 2, 2);
  1914. Stack.SetInt(PStart, SysUtils.StrToInt(Hex));
  1915. end);
  1916. end;
  1917. procedure RegisterDelphiFunction(ProcPtr: Pointer; const Name: AnsiString);
  1918. begin
  1919. ScriptInterpreter.RegisterDelphiFunction(ProcPtr, Name, cdRegister);
  1920. {$IFDEF DEBUG}
  1921. Inc(Count);
  1922. {$ENDIF}
  1923. end;
  1924. begin
  1925. if ScriptFuncs <> nil then
  1926. ScriptFuncs.Free;
  1927. ScriptFuncs := TScriptFuncs.Create;
  1928. { The following should register all tables in ScriptFuncTables }
  1929. {$IFDEF DEBUG}
  1930. Count := 0;
  1931. {$ENDIF}
  1932. RegisterScriptDlgScriptFuncs;
  1933. RegisterNewDiskFormScriptFuncs;
  1934. RegisterBrowseFuncScriptFuncs;
  1935. RegisterCommonFuncVclScriptFuncs;
  1936. RegisterCommonFuncScriptFuncs;
  1937. RegisterInstallScriptFuncs;
  1938. RegisterInstFuncScriptFuncs;
  1939. RegisterInstFuncOleScriptFuncs;
  1940. RegisterMainFuncScriptFuncs;
  1941. RegisterMessagesScriptFuncs;
  1942. RegisterSystemScriptFuncs;
  1943. RegisterSysUtilsScriptFuncs;
  1944. RegisterVerInfoFuncScriptFuncs;
  1945. RegisterWindowsScriptFuncs;
  1946. RegisterActiveXScriptFuncs;
  1947. RegisterLoggingFuncScriptFuncs;
  1948. RegisterOtherScriptFuncs;
  1949. {$IFDEF DEBUG}
  1950. for var ScriptFuncTable in ScriptFuncTables do
  1951. for var ScriptFunc in ScriptFuncTable do
  1952. Dec(Count);
  1953. if Count <> 0 then
  1954. raise Exception.Create('Count <> 0');
  1955. {$ENDIF}
  1956. { The following should register all functions in ScriptDelphiFuncTable }
  1957. {$IFDEF DEBUG}
  1958. Count := 0;
  1959. {$ENDIF}
  1960. RegisterDelphiFunction(@Format, 'Format');
  1961. RegisterDelphiFunction(@LogFmtHelper, 'LogFmt');
  1962. RegisterDelphiFunction(@FmtMessageHelper, 'FmtMessage');
  1963. RegisterDelphiFunction(@FindFirstHelper, 'FindFirst');
  1964. RegisterDelphiFunction(@FindNextHelper, 'FindNext');
  1965. RegisterDelphiFunction(@FindCloseHelper, 'FindClose');
  1966. RegisterDelphiFunction(@GetWindowsVersionExHelper, 'GetWindowsVersionEx');
  1967. {$IFDEF DEBUG}
  1968. if Count <> Length(DelphiScriptFuncTable) then
  1969. raise Exception.Create('Count <> Length(DelphiScriptFuncTable)');
  1970. {$ENDIF}
  1971. end;
  1972. initialization
  1973. finalization
  1974. ScriptFuncs.Free;
  1975. end.