Setup.ScriptFunc.pas 102 KB

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