Setup.ScriptFunc.pas 102 KB

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