Setup.ScriptFunc.pas 108 KB

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