Setup.ScriptFunc.pas 100 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919
  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', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  780. begin
  781. Stack.SetInt64(PStart, DownloadTemporaryFile(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), False, '', TOnDownloadProgress(Stack.GetProc(PStart-4, Caller))));
  782. end);
  783. RegisterScriptFunc('SetDownloadCredentials', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  784. begin
  785. SetDownloadCredentials(Stack.GetString(PStart),Stack.GetString(PStart-1));
  786. end);
  787. RegisterScriptFunc('DownloadTemporaryFileSize', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  788. begin
  789. Stack.SetInt64(PStart, DownloadTemporaryFileSize(Stack.GetString(PStart-1)));
  790. end);
  791. RegisterScriptFunc('DownloadTemporaryFileDate', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  792. begin
  793. Stack.SetString(PStart, DownloadTemporaryFileDate(Stack.GetString(PStart-1)));
  794. end);
  795. end;
  796. procedure RegisterInstFuncScriptFuncs;
  797. begin
  798. RegisterScriptFunc('CHECKFORMUTEXES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  799. begin
  800. Stack.SetBool(PStart, CheckForMutexes(Stack.GetString(PStart-1)));
  801. end);
  802. RegisterScriptFunc('DECREMENTSHAREDCOUNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  803. begin
  804. if Stack.GetBool(PStart-1) then begin
  805. if not IsWin64 then
  806. InternalError('Cannot access 64-bit registry keys on this version of Windows');
  807. Stack.SetBool(PStart, DecrementSharedCount(rv64Bit, Stack.GetString(PStart-2)));
  808. end
  809. else
  810. Stack.SetBool(PStart, DecrementSharedCount(rv32Bit, Stack.GetString(PStart-2)));
  811. end);
  812. RegisterScriptFunc('DELAYDELETEFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  813. begin
  814. DelayDeleteFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetInt(PStart-1), 250, 250);
  815. end);
  816. RegisterScriptFunc('DELTREE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  817. begin
  818. 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));
  819. end);
  820. RegisterScriptFunc('GENERATEUNIQUENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  821. begin
  822. Stack.SetString(PStart, GenerateUniqueName(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  823. end);
  824. RegisterScriptFunc('GETCOMPUTERNAMESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  825. begin
  826. Stack.SetString(PStart, GetComputerNameString);
  827. end);
  828. RegisterScriptFunc('GETMD5OFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  829. begin
  830. Stack.SetString(PStart, MD5DigestToString(GetMD5OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))));
  831. end);
  832. RegisterScriptFunc('GETMD5OFSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  833. begin
  834. Stack.SetString(PStart, MD5DigestToString(GetMD5OfAnsiString(Stack.GetAnsiString(PStart-1))));
  835. end);
  836. RegisterScriptFunc('GETMD5OFUNICODESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  837. begin
  838. Stack.SetString(PStart, MD5DigestToString(GetMD5OfUnicodeString(Stack.GetString(PStart-1))));
  839. end);
  840. RegisterScriptFunc('GETSHA1OFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  841. begin
  842. Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))));
  843. end);
  844. RegisterScriptFunc('GETSHA1OFSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  845. begin
  846. Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfAnsiString(Stack.GetAnsiString(PStart-1))));
  847. end);
  848. RegisterScriptFunc('GETSHA1OFUNICODESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  849. begin
  850. Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfUnicodeString(Stack.GetString(PStart-1))));
  851. end);
  852. RegisterScriptFunc('GETSHA256OFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  853. begin
  854. Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))));
  855. end);
  856. RegisterScriptFunc('GETSHA256OFSTREAM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  857. begin
  858. Stack.SetString(PStart, SHA256DigestToString(ISSigCalcStreamHash(TStream(Stack.GetClass(PStart-1)))));
  859. end);
  860. RegisterScriptFunc('GETSHA256OFSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  861. begin
  862. Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfAnsiString(Stack.GetAnsiString(PStart-1))));
  863. end);
  864. RegisterScriptFunc('GETSHA256OFUNICODESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  865. begin
  866. Stack.SetString(PStart, SHA256DigestToString(GetSHA256OfUnicodeString(Stack.GetString(PStart-1))));
  867. end);
  868. RegisterScriptFunc('GETSPACEONDISK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  869. begin
  870. var FreeBytes, TotalBytes: Integer64;
  871. if GetSpaceOnDisk(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin
  872. if Stack.GetBool(PStart-2) then begin
  873. Div64(FreeBytes, 1024*1024);
  874. Div64(TotalBytes, 1024*1024);
  875. end;
  876. { Cap at 2 GB, as [Code] doesn't support 64-bit integers }
  877. if (FreeBytes.Hi <> 0) or (FreeBytes.Lo and $80000000 <> 0) then
  878. FreeBytes.Lo := $7FFFFFFF;
  879. if (TotalBytes.Hi <> 0) or (TotalBytes.Lo and $80000000 <> 0) then
  880. TotalBytes.Lo := $7FFFFFFF;
  881. Stack.SetUInt(PStart-3, FreeBytes.Lo);
  882. Stack.SetUInt(PStart-4, TotalBytes.Lo);
  883. Stack.SetBool(PStart, True);
  884. end else
  885. Stack.SetBool(PStart, False);
  886. end);
  887. RegisterScriptFunc('GETSPACEONDISK64', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  888. begin
  889. var FreeBytes, TotalBytes: Integer64;
  890. if GetSpaceOnDisk(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin
  891. Stack.SetInt64(PStart-2, Int64(FreeBytes.Hi) shl 32 + FreeBytes.Lo);
  892. Stack.SetInt64(PStart-3, Int64(TotalBytes.Hi) shl 32 + TotalBytes.Lo);
  893. Stack.SetBool(PStart, True);
  894. end else
  895. Stack.SetBool(PStart, False);
  896. end);
  897. RegisterScriptFunc('GETUSERNAMESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  898. begin
  899. Stack.SetString(PStart, GetUserNameString);
  900. end);
  901. RegisterScriptFunc('INCREMENTSHAREDCOUNT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  902. begin
  903. if Stack.GetBool(PStart) then begin
  904. if not IsWin64 then
  905. InternalError('Cannot access 64-bit registry keys on this version of Windows');
  906. IncrementSharedCount(rv64Bit, Stack.GetString(PStart-1), Stack.GetBool(PStart-2));
  907. end
  908. else
  909. IncrementSharedCount(rv32Bit, Stack.GetString(PStart-1), Stack.GetBool(PStart-2));
  910. end);
  911. RegisterScriptFunc(['Exec', 'ExecAsOriginalUser', 'ExecAndLogOutput', 'ExecAndCaptureOutput'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  912. begin
  913. var RunAsOriginalUser := OrgName = 'ExecAsOriginalUser';
  914. if IsUninstaller and RunAsOriginalUser then
  915. NoUninstallFuncError(OrgName);
  916. var Method: TMethod; { Must stay alive until OutputReader is freed }
  917. var OutputReader: TCreateProcessOutputReader := nil;
  918. try
  919. if OrgName = 'ExecAndLogOutput' then begin
  920. Method := Stack.GetProc(PStart-7, Caller);
  921. if Method.Code <> nil then
  922. OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLogCustom, NativeInt(@Method))
  923. else if GetLogActive then
  924. OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLog, 0);
  925. end else if OrgName = 'ExecAndCaptureOutput' then
  926. OutputReader := TCreateProcessOutputReader.Create(ExecAndLogOutputLog, 0, omCapture);
  927. var ExecWait := TExecWait(Stack.GetInt(PStart-5));
  928. if (OutputReader <> nil) and (ExecWait <> ewWaitUntilTerminated) then
  929. InternalError(Format('Must call "%s" function with Wait = ewWaitUntilTerminated', [OrgName]));
  930. var Filename := Stack.GetString(PStart-1);
  931. if not IsProtectedSrcExe(Filename) then begin
  932. { Disable windows so the user can't utilize our UI during the InstExec
  933. call }
  934. var WindowDisabler := TWindowDisabler.Create;
  935. var ResultCode: Integer;
  936. try
  937. Stack.SetBool(PStart, InstExecEx(RunAsOriginalUser,
  938. ScriptFuncDisableFsRedir, Filename, Stack.GetString(PStart-2),
  939. Stack.GetString(PStart-3), ExecWait,
  940. Stack.GetInt(PStart-4), ProcessMessagesProc, OutputReader, ResultCode));
  941. finally
  942. WindowDisabler.Free;
  943. end;
  944. Stack.SetInt(PStart-6, ResultCode);
  945. if OrgName = 'ExecAndCaptureOutput' then begin
  946. { Set the three TExecOutput fields }
  947. Stack.SetArray(PStart-7, OutputReader.CaptureOutList, 0);
  948. Stack.SetArray(PStart-7, OutputReader.CaptureErrList, 1);
  949. Stack.SetInt(PStart-7, OutputReader.CaptureError.ToInteger, 2);
  950. end;
  951. end else begin
  952. Stack.SetBool(PStart, False);
  953. Stack.SetInt(PStart-6, ERROR_ACCESS_DENIED);
  954. end;
  955. finally
  956. OutputReader.Free;
  957. end;
  958. end);
  959. RegisterScriptFunc(['ShellExec', 'ShellExecAsOriginalUser'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  960. begin
  961. var RunAsOriginalUser := OrgName = 'ShellExecAsOriginalUser';
  962. if IsUninstaller and RunAsOriginalUser then
  963. NoUninstallFuncError(OrgName);
  964. var Filename := Stack.GetString(PStart-2);
  965. if not IsProtectedSrcExe(Filename) then begin
  966. { Disable windows so the user can't utilize our UI during the
  967. InstShellExec call }
  968. var WindowDisabler := TWindowDisabler.Create;
  969. var ErrorCode: Integer;
  970. try
  971. Stack.SetBool(PStart, InstShellExecEx(RunAsOriginalUser,
  972. Stack.GetString(PStart-1), Filename, Stack.GetString(PStart-3),
  973. Stack.GetString(PStart-4), TExecWait(Stack.GetInt(PStart-6)),
  974. Stack.GetInt(PStart-5), ProcessMessagesProc, ErrorCode));
  975. finally
  976. WindowDisabler.Free;
  977. end;
  978. Stack.SetInt(PStart-7, ErrorCode);
  979. end else begin
  980. Stack.SetBool(PStart, False);
  981. Stack.SetInt(PStart-7, ERROR_ACCESS_DENIED);
  982. end;
  983. end);
  984. RegisterScriptFunc('ISPROTECTEDSYSTEMFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  985. begin
  986. Stack.SetBool(PStart, IsProtectedSystemFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  987. end);
  988. RegisterScriptFunc('MAKEPENDINGFILERENAMEOPERATIONSCHECKSUM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  989. begin
  990. Stack.SetString(PStart, SHA256DigestToString(MakePendingFileRenameOperationsChecksum));
  991. end);
  992. RegisterScriptFunc('MODIFYPIFFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  993. begin
  994. Stack.SetBool(PStart, ModifyPifFile(Stack.GetString(PStart-1), Stack.GetBool(PStart-2)));
  995. end);
  996. RegisterScriptFunc('REGISTERSERVER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  997. begin
  998. RegisterServer(False, Stack.GetBool(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2));
  999. end);
  1000. RegisterScriptFunc('UNREGISTERSERVER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1001. begin
  1002. try
  1003. RegisterServer(True, Stack.GetBool(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3));
  1004. Stack.SetBool(PStart, True);
  1005. except
  1006. Stack.SetBool(PStart, False);
  1007. end;
  1008. end);
  1009. RegisterScriptFunc('UNREGISTERFONT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1010. begin
  1011. UnregisterFont(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2));
  1012. end);
  1013. RegisterScriptFunc('RESTARTREPLACE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1014. begin
  1015. RestartReplace(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1));
  1016. end);
  1017. RegisterScriptFunc('FORCEDIRECTORIES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1018. begin
  1019. Stack.SetBool(PStart, ForceDirectories(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  1020. end);
  1021. end;
  1022. procedure RegisterInstFuncOleScriptFuncs;
  1023. begin
  1024. RegisterScriptFunc('CREATESHELLLINK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1025. begin
  1026. Stack.SetString(PStart, CreateShellLink(Stack.GetString(PStart-1),
  1027. Stack.GetString(PStart-2), Stack.GetString(PStart-3),
  1028. Stack.GetString(PStart-4), Stack.GetString(PStart-5),
  1029. Stack.GetString(PStart-6), Stack.GetInt(PStart-7),
  1030. Stack.GetInt(PStart-8), 0, '', nil, False, False));
  1031. end);
  1032. RegisterScriptFunc('REGISTERTYPELIBRARY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1033. begin
  1034. if Stack.GetBool(PStart) then
  1035. HelperRegisterTypeLibrary(False, Stack.GetString(PStart-1))
  1036. else
  1037. RegisterTypeLibrary(Stack.GetString(PStart-1));
  1038. end);
  1039. RegisterScriptFunc('UNREGISTERTYPELIBRARY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1040. begin
  1041. try
  1042. if Stack.GetBool(PStart-1) then
  1043. HelperRegisterTypeLibrary(True, Stack.GetString(PStart-2))
  1044. else
  1045. UnregisterTypeLibrary(Stack.GetString(PStart-2));
  1046. Stack.SetBool(PStart, True);
  1047. except
  1048. Stack.SetBool(PStart, False);
  1049. end;
  1050. end);
  1051. RegisterScriptFunc('UNPINSHELLLINK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1052. begin
  1053. Stack.SetBool(PStart, UnpinShellLink(Stack.GetString(PStart-1)));
  1054. end);
  1055. end;
  1056. procedure RegisterMainFuncScriptFuncs;
  1057. begin
  1058. RegisterScriptFunc('ACTIVELANGUAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1059. begin
  1060. Stack.SetString(PStart, ExpandConst('{language}'));
  1061. end);
  1062. RegisterScriptFunc('EXPANDCONSTANT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1063. begin
  1064. Stack.SetString(PStart, ExpandConst(Stack.GetString(PStart-1)));
  1065. end);
  1066. RegisterScriptFunc('EXPANDCONSTANTEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1067. begin
  1068. Stack.SetString(PStart, ExpandConstEx(Stack.GetString(PStart-1), [Stack.GetString(PStart-2), Stack.GetString(PStart-3)]));
  1069. end);
  1070. RegisterScriptFunc('EXITSETUPMSGBOX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1071. begin
  1072. Stack.SetBool(PStart, ExitSetupMsgBox);
  1073. end);
  1074. RegisterScriptFunc('GETSHELLFOLDERBYCSIDL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1075. begin
  1076. Stack.SetString(PStart, GetShellFolderByCSIDL(Stack.GetInt(PStart-1), Stack.GetBool(PStart-2)));
  1077. end);
  1078. RegisterScriptFunc('INSTALLONTHISVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1079. begin
  1080. var MinVersion, OnlyBelowVersion: TSetupVersionData;
  1081. if not StrToSetupVersionData(Stack.GetString(PStart-1), MinVersion) then
  1082. InternalError(Format('%s: Invalid MinVersion string', [OrgName]))
  1083. else if not StrToSetupVersionData(Stack.GetString(PStart-2), OnlyBelowVersion) then
  1084. InternalError(Format('%s: Invalid OnlyBelowVersion string', [OrgName]))
  1085. else
  1086. Stack.SetBool(PStart, (InstallOnThisVersion(MinVersion, OnlyBelowVersion) = irInstall));
  1087. end);
  1088. RegisterScriptFunc('GETWINDOWSVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1089. begin
  1090. Stack.SetUInt(PStart, WindowsVersion);
  1091. end);
  1092. RegisterScriptFunc('GETWINDOWSVERSIONSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1093. begin
  1094. Stack.SetString(PStart, Format('%u.%.2u.%u', [WindowsVersion shr 24,
  1095. (WindowsVersion shr 16) and $FF, WindowsVersion and $FFFF]));
  1096. end);
  1097. RegisterScriptFunc(['MsgBox', 'SuppressibleMsgBox'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1098. begin
  1099. var Suppressible: Boolean;
  1100. var Default: Integer;
  1101. if OrgName = 'MsgBox' then begin
  1102. Suppressible := False;
  1103. Default := 0;
  1104. end else begin
  1105. Suppressible := True;
  1106. Default := Stack.GetInt(PStart-4);
  1107. end;
  1108. Stack.SetInt(PStart, LoggedMsgBox(Stack.GetString(PStart-1), GetMsgBoxCaption, TMsgBoxType(Stack.GetInt(PStart-2)), Stack.GetInt(PStart-3), Suppressible, Default));
  1109. end);
  1110. RegisterScriptFunc(['TaskDialogMsgBox', 'SuppressibleTaskDialogMsgBox'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1111. begin
  1112. var Suppressible: Boolean;
  1113. var Default: Integer;
  1114. if OrgName = 'TaskDialogMsgBox' then begin
  1115. Suppressible := False;
  1116. Default := 0;
  1117. end else begin
  1118. Suppressible := True;
  1119. Default := Stack.GetInt(PStart-7);
  1120. end;
  1121. var ButtonLabels := Stack.GetStringArray(PStart-5);
  1122. 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));
  1123. end);
  1124. RegisterScriptFunc('ISWIN64', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1125. begin
  1126. Stack.SetBool(PStart, IsWin64);
  1127. end);
  1128. RegisterScriptFunc('IS64BITINSTALLMODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1129. begin
  1130. Stack.SetBool(PStart, Is64BitInstallMode);
  1131. end);
  1132. RegisterScriptFunc('PROCESSORARCHITECTURE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1133. begin
  1134. Stack.SetInt(PStart, Integer(ProcessorArchitecture));
  1135. end);
  1136. RegisterScriptFunc(['IsArm32Compatible', 'IsArm64', 'IsX64', 'IsX64OS', 'IsX64Compatible', 'IsX86', 'IsX86OS', 'IsX86Compatible'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1137. begin
  1138. var ArchitectureIdentifier := LowerCase(Copy(String(OrgName), 3, MaxInt));
  1139. Stack.SetBool(PStart, EvalArchitectureIdentifier(ArchitectureIdentifier));
  1140. end);
  1141. RegisterScriptFunc('CUSTOMMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1142. begin
  1143. Stack.SetString(PStart, CustomMessage(Stack.GetString(PStart-1)));
  1144. end);
  1145. RegisterScriptFunc('RMSESSIONSTARTED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1146. begin
  1147. Stack.SetBool(PStart, RmSessionStarted);
  1148. end);
  1149. RegisterScriptFunc('REGISTEREXTRACLOSEAPPLICATIONSRESOURCE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1150. begin
  1151. Stack.SetBool(PStart, CodeRegisterExtraCloseApplicationsResource(Stack.GetBool(PStart-1), Stack.GetString(PStart-2)));
  1152. end);
  1153. RegisterScriptFunc('GETWIZARDFORM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1154. begin
  1155. Stack.SetClass(PStart, GetWizardForm);
  1156. end);
  1157. RegisterScriptFunc(['WizardIsComponentSelected', 'IsComponentSelected', 'WizardIsTaskSelected', 'IsTaskSelected'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1158. begin
  1159. var StringList := TStringList.Create;
  1160. try
  1161. var Components := (OrgName = 'WizardIsComponentSelected') or (OrgName = 'IsComponentSelected');
  1162. if Components then
  1163. GetWizardForm.GetSelectedComponents(StringList, False, False)
  1164. else
  1165. GetWizardForm.GetSelectedTasks(StringList, False, False, False);
  1166. var S := Stack.GetString(PStart-1);
  1167. StringChange(S, '/', '\');
  1168. if Components then
  1169. Stack.SetBool(PStart, ShouldProcessEntry(StringList, nil, S, '', '', ''))
  1170. else
  1171. Stack.SetBool(PStart, ShouldProcessEntry(nil, StringList, '', S, '', ''));
  1172. finally
  1173. StringList.Free;
  1174. end;
  1175. end);
  1176. end;
  1177. procedure RegisterMessagesScriptFuncs;
  1178. begin
  1179. RegisterScriptFunc('SETUPMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1180. begin
  1181. Stack.SetString(PStart, SetupMessages[TSetupMessageID(Stack.GetInt(PStart-1))]);
  1182. end);
  1183. end;
  1184. procedure RegisterSystemScriptFuncs;
  1185. begin
  1186. RegisterScriptFunc('RANDOM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1187. begin
  1188. Stack.SetInt(PStart, Random(Stack.GetInt(PStart-1)));
  1189. end);
  1190. RegisterScriptFunc('FILESIZE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1191. begin
  1192. try
  1193. var F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite);
  1194. try
  1195. Stack.SetInt(PStart-2, F.CappedSize);
  1196. Stack.SetBool(PStart, True);
  1197. finally
  1198. F.Free;
  1199. end;
  1200. except
  1201. Stack.SetBool(PStart, False);
  1202. end;
  1203. end);
  1204. RegisterScriptFunc('FILESIZE64', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1205. begin
  1206. try
  1207. var F := TFileRedir.Create(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite);
  1208. try
  1209. var TmpFileSize := F.Size; { Make sure we access F.Size only once }
  1210. Stack.SetInt64(PStart-2, Int64(TmpFileSize.Hi) shl 32 + TmpFileSize.Lo);
  1211. Stack.SetBool(PStart, True);
  1212. finally
  1213. F.Free;
  1214. end;
  1215. except
  1216. Stack.SetBool(PStart, False);
  1217. end;
  1218. end);
  1219. RegisterScriptFunc('SET8087CW', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1220. begin
  1221. Set8087CW(Stack.GetInt(PStart));
  1222. end);
  1223. RegisterScriptFunc('GET8087CW', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1224. begin
  1225. Stack.SetInt(PStart, Get8087CW);
  1226. end);
  1227. RegisterScriptFunc('UTF8ENCODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1228. begin
  1229. Stack.SetAnsiString(PStart, Utf8Encode(Stack.GetString(PStart-1)));
  1230. end);
  1231. RegisterScriptFunc('UTF8DECODE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1232. begin
  1233. Stack.SetString(PStart, UTF8ToString(Stack.GetAnsiString(PStart-1)));
  1234. end);
  1235. end;
  1236. procedure RegisterSysUtilsScriptFuncs;
  1237. begin
  1238. RegisterScriptFunc('BEEP', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1239. begin
  1240. Beep;
  1241. end);
  1242. RegisterScriptFunc('TRIMLEFT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1243. begin
  1244. Stack.SetString(PStart, TrimLeft(Stack.GetString(PStart-1)));
  1245. end);
  1246. RegisterScriptFunc('TRIMRIGHT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1247. begin
  1248. Stack.SetString(PStart, TrimRight(Stack.GetString(PStart-1)));
  1249. end);
  1250. RegisterScriptFunc('GETCURRENTDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1251. begin
  1252. Stack.SetString(PStart, GetCurrentDir);
  1253. end);
  1254. RegisterScriptFunc('SETCURRENTDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1255. begin
  1256. Stack.SetBool(PStart, SetCurrentDir(Stack.GetString(PStart-1)));
  1257. end);
  1258. RegisterScriptFunc('EXPANDFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1259. begin
  1260. Stack.SetString(PStart, PathExpand(Stack.GetString(PStart-1)));
  1261. end);
  1262. RegisterScriptFunc('EXPANDUNCFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1263. begin
  1264. Stack.SetString(PStart, ExpandUNCFileName(Stack.GetString(PStart-1)));
  1265. end);
  1266. RegisterScriptFunc('EXTRACTRELATIVEPATH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1267. begin
  1268. Stack.SetString(PStart, NewExtractRelativePath(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  1269. end);
  1270. RegisterScriptFunc('EXTRACTFILEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1271. begin
  1272. Stack.SetString(PStart, PathExtractDir(Stack.GetString(PStart-1)));
  1273. end);
  1274. RegisterScriptFunc('EXTRACTFILEDRIVE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1275. begin
  1276. Stack.SetString(PStart, PathExtractDrive(Stack.GetString(PStart-1)));
  1277. end);
  1278. RegisterScriptFunc('EXTRACTFILEEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1279. begin
  1280. Stack.SetString(PStart, PathExtractExt(Stack.GetString(PStart-1)));
  1281. end);
  1282. RegisterScriptFunc('EXTRACTFILENAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1283. begin
  1284. Stack.SetString(PStart, PathExtractName(Stack.GetString(PStart-1)));
  1285. end);
  1286. RegisterScriptFunc('EXTRACTFILEPATH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1287. begin
  1288. Stack.SetString(PStart, PathExtractPath(Stack.GetString(PStart-1)));
  1289. end);
  1290. RegisterScriptFunc('CHANGEFILEEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1291. begin
  1292. Stack.SetString(PStart, PathChangeExt(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  1293. end);
  1294. RegisterScriptFunc('FILESEARCH', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1295. begin
  1296. Stack.SetString(PStart, NewFileSearch(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  1297. end);
  1298. RegisterScriptFunc('RENAMEFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1299. begin
  1300. var OldName := Stack.GetString(PStart-1);
  1301. if not IsProtectedSrcExe(OldName) then
  1302. Stack.SetBool(PStart, MoveFileRedir(ScriptFuncDisableFsRedir, OldName, Stack.GetString(PStart-2)))
  1303. else
  1304. Stack.SetBool(PStart, False);
  1305. end);
  1306. RegisterScriptFunc('DELETEFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1307. begin
  1308. Stack.SetBool(PStart, DeleteFileRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  1309. end);
  1310. RegisterScriptFunc('CREATEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1311. begin
  1312. Stack.SetBool(PStart, CreateDirectoryRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  1313. end);
  1314. RegisterScriptFunc('REMOVEDIR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1315. begin
  1316. Stack.SetBool(PStart, RemoveDirectoryRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
  1317. end);
  1318. RegisterScriptFunc('COMPARESTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1319. begin
  1320. Stack.SetInt(PStart, CompareStr(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  1321. end);
  1322. RegisterScriptFunc('COMPARETEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1323. begin
  1324. Stack.SetInt(PStart, CompareText(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  1325. end);
  1326. RegisterScriptFunc('SAMESTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1327. begin
  1328. Stack.SetBool(PStart, CompareStr(Stack.GetString(PStart-1), Stack.GetString(PStart-2)) = 0);
  1329. end);
  1330. RegisterScriptFunc('SAMETEXT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1331. begin
  1332. Stack.SetBool(PStart, CompareText(Stack.GetString(PStart-1), Stack.GetString(PStart-2)) = 0);
  1333. end);
  1334. RegisterScriptFunc('GETDATETIMESTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1335. begin
  1336. var OldDateSeparator := FormatSettings.DateSeparator;
  1337. var OldTimeSeparator := FormatSettings.TimeSeparator;
  1338. try
  1339. var NewDateSeparator := Stack.GetChar(PStart-2);
  1340. var NewTimeSeparator := Stack.GetChar(PStart-3);
  1341. if NewDateSeparator <> #0 then
  1342. FormatSettings.DateSeparator := NewDateSeparator;
  1343. if NewTimeSeparator <> #0 then
  1344. FormatSettings.TimeSeparator := NewTimeSeparator;
  1345. Stack.SetString(PStart, FormatDateTime(Stack.GetString(PStart-1), Now));
  1346. finally
  1347. FormatSettings.TimeSeparator := OldTimeSeparator;
  1348. FormatSettings.DateSeparator := OldDateSeparator;
  1349. end;
  1350. end);
  1351. RegisterScriptFunc('SYSERRORMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1352. begin
  1353. Stack.SetString(PStart, Win32ErrorString(Stack.GetInt(PStart-1)));
  1354. end);
  1355. end;
  1356. procedure RegisterVerInfoFuncScriptFuncs;
  1357. begin
  1358. RegisterScriptFunc('GETVERSIONNUMBERS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1359. begin
  1360. var VersionNumbers: TFileVersionNumbers;
  1361. if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin
  1362. Stack.SetInt(PStart-2, VersionNumbers.MS);
  1363. Stack.SetInt(PStart-3, VersionNumbers.LS);
  1364. Stack.SetBool(PStart, True);
  1365. end else
  1366. Stack.SetBool(PStart, False);
  1367. end);
  1368. RegisterScriptFunc('GETVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1369. begin
  1370. var VersionNumbers: TFileVersionNumbers;
  1371. if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin
  1372. Stack.SetUInt(PStart-2, VersionNumbers.MS shr 16);
  1373. Stack.SetUInt(PStart-3, VersionNumbers.MS and $FFFF);
  1374. Stack.SetUInt(PStart-4, VersionNumbers.LS shr 16);
  1375. Stack.SetUInt(PStart-5, VersionNumbers.LS and $FFFF);
  1376. Stack.SetBool(PStart, True);
  1377. end else
  1378. Stack.SetBool(PStart, False);
  1379. end);
  1380. RegisterScriptFunc('GETVERSIONNUMBERSSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1381. begin
  1382. var VersionNumbers: TFileVersionNumbers;
  1383. if GetVersionNumbersRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), VersionNumbers) then begin
  1384. Stack.SetString(PStart-2, Format('%u.%u.%u.%u', [VersionNumbers.MS shr 16,
  1385. VersionNumbers.MS and $FFFF, VersionNumbers.LS shr 16, VersionNumbers.LS and $FFFF]));
  1386. Stack.SetBool(PStart, True);
  1387. end else
  1388. Stack.SetBool(PStart, False);
  1389. end);
  1390. RegisterScriptFunc('GETPACKEDVERSION', 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.SetInt64(PStart-2, (Int64(VersionNumbers.MS) shl 32) or VersionNumbers.LS);
  1395. Stack.SetBool(PStart, True);
  1396. end else
  1397. Stack.SetBool(PStart, False);
  1398. end);
  1399. RegisterScriptFunc('PACKVERSIONNUMBERS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1400. begin
  1401. Stack.SetInt64(PStart, Int64((UInt64(Stack.GetUInt(PStart-1)) shl 32) or Stack.GetUInt(PStart-2)));
  1402. end);
  1403. RegisterScriptFunc('PACKVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1404. begin
  1405. var VersionNumbers: TFileVersionNumbers;
  1406. VersionNumbers.MS := (Stack.GetUInt(PStart-1) shl 16) or (Stack.GetUInt(PStart-2) and $FFFF);
  1407. VersionNumbers.LS := (Stack.GetUInt(PStart-3) shl 16) or (Stack.GetUInt(PStart-4) and $FFFF);
  1408. Stack.SetInt64(PStart, Int64((UInt64(VersionNumbers.MS) shl 32) or VersionNumbers.LS));
  1409. end);
  1410. RegisterScriptFunc('COMPAREPACKEDVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1411. begin
  1412. Stack.SetInt(PStart, Compare64(Integer64(Stack.GetInt64(PStart-1)), Integer64(Stack.GetInt64(PStart-2))));
  1413. end);
  1414. RegisterScriptFunc('SAMEPACKEDVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1415. begin
  1416. Stack.SetBool(PStart, Compare64(Integer64(Stack.GetInt64(PStart-1)), Integer64(Stack.GetInt64(PStart-2))) = 0);
  1417. end);
  1418. RegisterScriptFunc('UNPACKVERSIONNUMBERS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1419. begin
  1420. var VersionNumbers: TFileVersionNumbers;
  1421. VersionNumbers.MS := UInt64(Stack.GetInt64(PStart)) shr 32;
  1422. VersionNumbers.LS := UInt64(Stack.GetInt64(PStart)) and $FFFFFFFF;
  1423. Stack.SetUInt(PStart-1, VersionNumbers.MS);
  1424. Stack.SetUInt(PStart-2, VersionNumbers.LS);
  1425. end);
  1426. RegisterScriptFunc('UNPACKVERSIONCOMPONENTS', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1427. begin
  1428. var VersionNumbers: TFileVersionNumbers;
  1429. VersionNumbers.MS := UInt64(Stack.GetInt64(PStart)) shr 32;
  1430. VersionNumbers.LS := UInt64(Stack.GetInt64(PStart)) and $FFFFFFFF;
  1431. Stack.SetUInt(PStart-1, VersionNumbers.MS shr 16);
  1432. Stack.SetUInt(PStart-2, VersionNumbers.MS and $FFFF);
  1433. Stack.SetUInt(PStart-3, VersionNumbers.LS shr 16);
  1434. Stack.SetUInt(PStart-4, VersionNumbers.LS and $FFFF);
  1435. end);
  1436. RegisterScriptFunc('VERSIONTOSTR', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1437. begin
  1438. var VersionNumbers: TFileVersionNumbers;
  1439. VersionNumbers.MS := UInt64(Stack.GetInt64(PStart-1)) shr 32;
  1440. VersionNumbers.LS := UInt64(Stack.GetInt64(PStart-1)) and $FFFFFFFF;
  1441. Stack.SetString(PStart, Format('%u.%u.%u.%u', [VersionNumbers.MS shr 16,
  1442. VersionNumbers.MS and $FFFF, VersionNumbers.LS shr 16, VersionNumbers.LS and $FFFF]));
  1443. end);
  1444. RegisterScriptFunc('STRTOVERSION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1445. begin
  1446. var VersionNumbers: TFileVersionNumbers;
  1447. if StrToVersionNumbers(Stack.GetString(PStart-1), VersionNumbers) then begin
  1448. Stack.SetInt64(PStart-2, (Int64(VersionNumbers.MS) shl 32) or VersionNumbers.LS);
  1449. Stack.SetBool(PStart, True);
  1450. end else
  1451. Stack.SetBool(PStart, False);
  1452. end);
  1453. end;
  1454. type
  1455. TDllProc = function(const Param1, Param2: Longint): Longint; stdcall;
  1456. procedure RegisterWindowsScriptFuncs;
  1457. begin
  1458. RegisterScriptFunc('SLEEP', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1459. begin
  1460. Sleep(Stack.GetInt(PStart));
  1461. end);
  1462. RegisterScriptFunc('FINDWINDOWBYCLASSNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1463. begin
  1464. Stack.SetInt(PStart, FindWindow(PChar(Stack.GetString(PStart-1)), nil));
  1465. end);
  1466. RegisterScriptFunc('FINDWINDOWBYWINDOWNAME', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1467. begin
  1468. Stack.SetInt(PStart, FindWindow(nil, PChar(Stack.GetString(PStart-1))));
  1469. end);
  1470. RegisterScriptFunc('SENDMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1471. begin
  1472. Stack.SetInt(PStart, SendMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4)));
  1473. end);
  1474. RegisterScriptFunc('POSTMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1475. begin
  1476. Stack.SetBool(PStart, PostMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4)));
  1477. end);
  1478. RegisterScriptFunc('SENDNOTIFYMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1479. begin
  1480. Stack.SetBool(PStart, SendNotifyMessage(Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4)));
  1481. end);
  1482. RegisterScriptFunc('REGISTERWINDOWMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1483. begin
  1484. Stack.SetInt(PStart, RegisterWindowMessage(PChar(Stack.GetString(PStart-1))));
  1485. end);
  1486. RegisterScriptFunc('SENDBROADCASTMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1487. begin
  1488. Stack.SetInt(PStart, SendMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3)));
  1489. end);
  1490. RegisterScriptFunc('POSTBROADCASTMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1491. begin
  1492. Stack.SetBool(PStart, PostMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3)));
  1493. end);
  1494. RegisterScriptFunc('SENDBROADCASTNOTIFYMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1495. begin
  1496. Stack.SetBool(PStart, SendNotifyMessage(HWND_BROADCAST, Stack.GetInt(PStart-1), Stack.GetInt(PStart-2), Stack.GetInt(PStart-3)));
  1497. end);
  1498. RegisterScriptFunc('LOADDLL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1499. begin
  1500. var DllHandle := SafeLoadLibrary(Stack.GetString(PStart-1), SEM_NOOPENFILEERRORBOX);
  1501. if DllHandle <> 0 then
  1502. Stack.SetInt(PStart-2, 0)
  1503. else
  1504. Stack.SetInt(PStart-2, GetLastError);
  1505. Stack.SetInt(PStart, DllHandle);
  1506. end);
  1507. RegisterScriptFunc('CALLDLLPROC', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1508. begin
  1509. var DllProc: TDllProc;
  1510. @DllProc := GetProcAddress(Stack.GetInt(PStart-1), PChar(Stack.GetString(PStart-2)));
  1511. if Assigned(DllProc) then begin
  1512. Stack.SetInt(PStart-5, DllProc(Stack.GetInt(PStart-3), Stack.GetInt(PStart-4)));
  1513. Stack.SetBool(PStart, True);
  1514. end else
  1515. Stack.SetBool(PStart, False);
  1516. end);
  1517. RegisterScriptFunc('FREEDLL', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1518. begin
  1519. Stack.SetBool(PStart, FreeLibrary(Stack.GetInt(PStart-1)));
  1520. end);
  1521. RegisterScriptFunc('CREATEMUTEX', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1522. begin
  1523. Windows.CreateMutex(nil, False, PChar(Stack.GetString(PStart)));
  1524. end);
  1525. RegisterScriptFunc('OEMTOCHARBUFF', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1526. begin
  1527. var S := Stack.GetAnsiString(PStart);
  1528. OemToCharBuffA(PAnsiChar(S), PAnsiChar(S), Length(S));
  1529. Stack.SetAnsiString(PStart, S);
  1530. end);
  1531. RegisterScriptFunc('CHARTOOEMBUFF', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1532. begin
  1533. var S := Stack.GetAnsiString(PStart);
  1534. CharToOemBuffA(PAnsiChar(S), PAnsiChar(S), Length(S));
  1535. Stack.SetAnsiString(PStart, S);
  1536. end);
  1537. end;
  1538. procedure RegisterActiveXScriptFuncs;
  1539. begin
  1540. RegisterScriptFunc('COFREEUNUSEDLIBRARIES', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1541. begin
  1542. CoFreeUnusedLibraries;
  1543. end);
  1544. end;
  1545. procedure RegisterLoggingFuncScriptFuncs;
  1546. begin
  1547. RegisterScriptFunc('LOG', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1548. begin
  1549. Log(Stack.GetString(PStart));
  1550. end);
  1551. end;
  1552. procedure RegisterOtherScriptFuncs;
  1553. begin
  1554. RegisterScriptFunc('BRINGTOFRONTANDRESTORE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1555. begin
  1556. { Must be in this order to work around VCL bug }
  1557. Application.Restore;
  1558. Application.BringToFront;
  1559. end);
  1560. RegisterScriptFunc('WizardDirValue', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1561. begin
  1562. Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.DirEdit.Text));
  1563. end);
  1564. RegisterScriptFunc('WizardGroupValue', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1565. begin
  1566. Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.GroupEdit.Text));
  1567. end);
  1568. RegisterScriptFunc('WizardNoIcons', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1569. begin
  1570. Stack.SetBool(PStart, GetWizardForm.NoIconsCheck.Checked);
  1571. end);
  1572. RegisterScriptFunc('WizardSetupType', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1573. begin
  1574. var TypeEntry := GetWizardForm.GetSetupType;
  1575. if TypeEntry <> nil then begin
  1576. if Stack.GetBool(PStart-1) then
  1577. Stack.SetString(PStart, TypeEntry.Description)
  1578. else
  1579. Stack.SetString(PStart, TypeEntry.Name);
  1580. end
  1581. else
  1582. Stack.SetString(PStart, '');
  1583. end);
  1584. RegisterScriptFunc(['WizardSelectedComponents', 'WizardSelectedTasks'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1585. begin
  1586. var StringList := TStringList.Create;
  1587. try
  1588. if OrgName = 'WizardSelectedComponents' then
  1589. GetWizardForm.GetSelectedComponents(StringList, Stack.GetBool(PStart-1), False)
  1590. else
  1591. GetWizardForm.GetSelectedTasks(StringList, Stack.GetBool(PStart-1), False, False);
  1592. Stack.SetString(PStart, StringsToCommaString(StringList));
  1593. finally
  1594. StringList.Free;
  1595. end;
  1596. end);
  1597. RegisterScriptFunc(['WizardSelectComponents', 'WizardSelectTasks'], sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1598. begin
  1599. var StringList := TStringList.Create;
  1600. try
  1601. var S := Stack.GetString(PStart);
  1602. StringChange(S, '/', '\');
  1603. SetStringsFromCommaString(StringList, S);
  1604. if OrgName = 'WizardSelectComponents' then
  1605. GetWizardForm.SelectComponents(StringList)
  1606. else
  1607. GetWizardForm.SelectTasks(StringList);
  1608. finally
  1609. StringList.Free;
  1610. end;
  1611. end);
  1612. RegisterScriptFunc('WizardSilent', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1613. begin
  1614. Stack.SetBool(PStart, InstallMode <> imNormal);
  1615. end);
  1616. RegisterScriptFunc('ISUNINSTALLER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1617. begin
  1618. Stack.SetBool(PStart, IsUninstaller);
  1619. end);
  1620. RegisterScriptFunc('UninstallSilent', sfOnlyUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1621. begin
  1622. Stack.SetBool(PStart, UninstallSilent);
  1623. end);
  1624. RegisterScriptFunc('CurrentFilename', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1625. begin
  1626. if CheckOrInstallCurrentFilename <> '' then
  1627. Stack.SetString(PStart, CheckOrInstallCurrentFilename)
  1628. else
  1629. 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]));
  1630. end);
  1631. RegisterScriptFunc('CurrentSourceFilename', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1632. begin
  1633. if CheckOrInstallCurrentSourceFilename <> '' then
  1634. Stack.SetString(PStart, CheckOrInstallCurrentSourceFilename)
  1635. else
  1636. 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]));
  1637. end);
  1638. RegisterScriptFunc('CASTSTRINGTOINTEGER', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1639. begin
  1640. Stack.SetInt(PStart, Integer(PChar(Stack.GetString(PStart-1))));
  1641. end);
  1642. RegisterScriptFunc('CASTINTEGERTOSTRING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1643. begin
  1644. Stack.SetString(PStart, String(PChar(Stack.GetInt(PStart-1))));
  1645. end);
  1646. RegisterScriptFunc('ABORT', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1647. begin
  1648. Abort;
  1649. end);
  1650. RegisterScriptFunc('GETEXCEPTIONMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1651. begin
  1652. Stack.SetString(PStart, GetExceptionMessage(Caller));
  1653. end);
  1654. RegisterScriptFunc('RAISEEXCEPTION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1655. begin
  1656. raise Exception.Create(Stack.GetString(PStart));
  1657. end);
  1658. RegisterScriptFunc('SHOWEXCEPTIONMESSAGE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1659. begin
  1660. TMainForm.ShowExceptionMsg(AddPeriod(GetExceptionMessage(Caller)));
  1661. end);
  1662. RegisterScriptFunc('TERMINATED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1663. begin
  1664. Stack.SetBool(PStart, Application.Terminated);
  1665. end);
  1666. RegisterScriptFunc('GETPREVIOUSDATA', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1667. begin
  1668. if IsUninstaller then
  1669. Stack.SetString(PStart, GetCodePreviousData(UninstallExpandedAppId, Stack.GetString(PStart-1), Stack.GetString(PStart-2)))
  1670. else
  1671. Stack.SetString(PStart, GetCodePreviousData(ExpandConst(SetupHeader.AppId), Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  1672. end);
  1673. RegisterScriptFunc('SETPREVIOUSDATA', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1674. begin
  1675. Stack.SetBool(PStart, SetCodePreviousData(Stack.GetInt(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3)));
  1676. end);
  1677. RegisterScriptFunc('LOADSTRINGFROMFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1678. begin
  1679. var S := Stack.GetAnsiString(PStart-2);
  1680. Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), S, fsRead));
  1681. Stack.SetAnsiString(PStart-2, S);
  1682. end);
  1683. RegisterScriptFunc('LOADSTRINGFROMLOCKEDFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1684. begin
  1685. var S := Stack.GetAnsiString(PStart-2);
  1686. Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), S, fsReadWrite));
  1687. Stack.SetAnsiString(PStart-2, S);
  1688. end);
  1689. RegisterScriptFunc('LOADSTRINGSFROMFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1690. begin
  1691. Stack.SetBool(PStart, LoadStringsFromFile(Stack.GetString(PStart-1), Stack, PStart-2, fsRead));
  1692. end);
  1693. RegisterScriptFunc('LOADSTRINGSFROMLOCKEDFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1694. begin
  1695. Stack.SetBool(PStart, LoadStringsFromFile(Stack.GetString(PStart-1), Stack, PStart-2, fsReadWrite));
  1696. end);
  1697. RegisterScriptFunc('SAVESTRINGTOFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1698. begin
  1699. Stack.SetBool(PStart, SaveStringToFile(Stack.GetString(PStart-1), Stack.GetAnsiString(PStart-2), Stack.GetBool(PStart-3)));
  1700. end);
  1701. RegisterScriptFunc('SAVESTRINGSTOFILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1702. begin
  1703. Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), False, False));
  1704. end);
  1705. RegisterScriptFunc('SAVESTRINGSTOUTF8FILE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1706. begin
  1707. Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), True, False));
  1708. end);
  1709. RegisterScriptFunc('SAVESTRINGSTOUTF8FILEWITHOUTBOM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1710. begin
  1711. Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), Stack, PStart-2, Stack.GetBool(PStart-3), True, True));
  1712. end);
  1713. RegisterScriptFunc('ENABLEFSREDIRECTION', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1714. begin
  1715. Stack.SetBool(PStart, not ScriptFuncDisableFsRedir);
  1716. if Stack.GetBool(PStart-1) then
  1717. ScriptFuncDisableFsRedir := False
  1718. else begin
  1719. if not IsWin64 then
  1720. InternalError('Cannot disable FS redirection on this version of Windows');
  1721. ScriptFuncDisableFsRedir := True;
  1722. end;
  1723. end);
  1724. RegisterScriptFunc('GETUNINSTALLPROGRESSFORM', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1725. begin
  1726. Stack.SetClass(PStart, GetUninstallProgressForm);
  1727. end);
  1728. RegisterScriptFunc('CREATECALLBACK', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1729. begin
  1730. Stack.SetInt(PStart, CreateCallback(Caller, Stack.Items[PStart-1]));
  1731. end);
  1732. RegisterScriptFunc('ISDOTNETINSTALLED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1733. begin
  1734. Stack.SetBool(PStart, IsDotNetInstalled(InstallDefaultRegView, TDotNetVersion(Stack.GetInt(PStart-1)), Stack.GetInt(PStart-2)));
  1735. end);
  1736. RegisterScriptFunc('ISMSIPRODUCTINSTALLED', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1737. begin
  1738. var ErrorCode: Cardinal;
  1739. Stack.SetBool(PStart, IsMsiProductInstalled(Stack.GetString(PStart-1), Stack.GetInt64(PStart-2), ErrorCode));
  1740. if ErrorCode <> 0 then
  1741. raise Exception.Create(Win32ErrorString(ErrorCode));
  1742. end);
  1743. RegisterScriptFunc('INITIALIZEBITMAPIMAGEFROMICON', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1744. begin
  1745. var AscendingTrySizes := Stack.GetIntArray(PStart-4);
  1746. Stack.SetBool(PStart, TBitmapImage(Stack.GetClass(PStart-1)).InitializeFromIcon(0, PChar(Stack.GetString(PStart-2)), Stack.GetInt(PStart-3), AscendingTrySizes));
  1747. end);
  1748. RegisterScriptFunc(['Extract7ZipArchive', 'ExtractArchive'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1749. begin
  1750. var Password: String;
  1751. var FullDirsItemNo: Longint;
  1752. if OrgName = 'Extract7ZipArchive' then begin
  1753. Password := '';
  1754. FullDirsItemNo := PStart-2;
  1755. end else begin
  1756. Password := Stack.GetString(PStart-2);
  1757. FullDirsItemNo := PStart-3;
  1758. end;
  1759. try
  1760. if SetupHeader.SevenZipLibraryName <> '' then
  1761. ExtractArchiveRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1), Password, Stack.GetBool(FullDirsItemNo), TOnExtractionProgress(Stack.GetProc(FullDirsItemNo-1, Caller)))
  1762. else
  1763. Extract7ZipArchiveRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1), Password, Stack.GetBool(FullDirsItemNo), TOnExtractionProgress(Stack.GetProc(FullDirsItemNo-1, Caller)));
  1764. except
  1765. on E: EAbort do
  1766. raise Exception.Create(SetupMessages[msgErrorExtractionAborted])
  1767. else
  1768. raise Exception.Create(FmtSetupMessage1(msgErrorExtractionFailed, GetExceptMessage));
  1769. end;
  1770. end);
  1771. RegisterScriptFunc('DEBUGGING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1772. begin
  1773. Stack.SetBool(PStart, Debugging);
  1774. end);
  1775. RegisterScriptFunc('StringJoin', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1776. begin
  1777. var Values := Stack.GetStringArray(PStart-2);
  1778. Stack.SetString(PStart, String.Join(Stack.GetString(PStart-1), Values));
  1779. end);
  1780. RegisterScriptFunc(['StringSplit', 'StringSplitEx'], procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1781. begin
  1782. var Separators := Stack.GetStringArray(PStart-2);
  1783. var Parts: TArray<String>;
  1784. if OrgName = 'StringSplitEx' then begin
  1785. var Quote := Stack.GetChar(PStart-3);
  1786. Parts := Stack.GetString(PStart-1).Split(Separators, Quote, Quote, TStringSplitOptions(Stack.GetInt(PStart-4)))
  1787. end else
  1788. Parts := Stack.GetString(PStart-1).Split(Separators, TStringSplitOptions(Stack.GetInt(PStart-3)));
  1789. Stack.SetArray(PStart, Parts);
  1790. end);
  1791. RegisterScriptFunc('ISSigVerify', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
  1792. begin
  1793. const ISSigAllowedKeys = ConvertAllowedKeysRuntimeIDsToISSigAllowedKeys(TStringList(Stack.GetClass(PStart-1)));
  1794. const Filename = Stack.GetString(PStart-2);
  1795. const KeepOpen = Stack.GetBool(PStart-3);
  1796. { Verify signature & file, keeping open afterwards if requested
  1797. Also see TrustFunc's CheckFileTrust }
  1798. var F := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
  1799. try
  1800. var ExpectedFileHash: TSHA256Digest;
  1801. DoISSigVerify(nil, F, Filename, ISSigAllowedKeys, ExpectedFileHash);
  1802. { Couldn't get the SHA-256 while downloading so need to get and check it now }
  1803. const ActualFileHash = ISSigCalcStreamHash(F);
  1804. if not SHA256DigestsEqual(ActualFileHash, ExpectedFileHash) then
  1805. ISSigVerifyError(vseFileHashIncorrect);
  1806. except
  1807. FreeAndNil(F);
  1808. raise;
  1809. end;
  1810. if not KeepOpen then
  1811. FreeAndNil(F);
  1812. Stack.SetClass(PStart, F);
  1813. end);
  1814. end;
  1815. procedure RegisterDelphiFunction(ProcPtr: Pointer; const Name: AnsiString);
  1816. begin
  1817. ScriptInterpreter.RegisterDelphiFunction(ProcPtr, Name, cdRegister);
  1818. {$IFDEF DEBUG}
  1819. Inc(Count);
  1820. {$ENDIF}
  1821. end;
  1822. begin
  1823. if ScriptFuncs <> nil then
  1824. ScriptFuncs.Free;
  1825. ScriptFuncs := TScriptFuncs.Create;
  1826. { The following should register all tables in ScriptFuncTables }
  1827. {$IFDEF DEBUG}
  1828. Count := 0;
  1829. {$ENDIF}
  1830. RegisterScriptDlgScriptFuncs;
  1831. RegisterNewDiskFormScriptFuncs;
  1832. RegisterBrowseFuncScriptFuncs;
  1833. RegisterCommonFuncVclScriptFuncs;
  1834. RegisterCommonFuncScriptFuncs;
  1835. RegisterInstallScriptFuncs;
  1836. RegisterInstFuncScriptFuncs;
  1837. RegisterInstFuncOleScriptFuncs;
  1838. RegisterMainFuncScriptFuncs;
  1839. RegisterMessagesScriptFuncs;
  1840. RegisterSystemScriptFuncs;
  1841. RegisterSysUtilsScriptFuncs;
  1842. RegisterVerInfoFuncScriptFuncs;
  1843. RegisterWindowsScriptFuncs;
  1844. RegisterActiveXScriptFuncs;
  1845. RegisterLoggingFuncScriptFuncs;
  1846. RegisterOtherScriptFuncs;
  1847. {$IFDEF DEBUG}
  1848. for var ScriptFuncTable in ScriptFuncTables do
  1849. for var ScriptFunc in ScriptFuncTable do
  1850. Dec(Count);
  1851. if Count <> 0 then
  1852. raise Exception.Create('Count <> 0');
  1853. {$ENDIF}
  1854. { The following should register all functions in ScriptDelphiFuncTable }
  1855. {$IFDEF DEBUG}
  1856. Count := 0;
  1857. {$ENDIF}
  1858. RegisterDelphiFunction(@FindFirstHelper, 'FindFirst');
  1859. RegisterDelphiFunction(@FindNextHelper, 'FindNext');
  1860. RegisterDelphiFunction(@FindCloseHelper, 'FindClose');
  1861. RegisterDelphiFunction(@FmtMessageHelper, 'FmtMessage');
  1862. RegisterDelphiFunction(@Format, 'Format');
  1863. RegisterDelphiFunction(@GetWindowsVersionExHelper, 'GetWindowsVersionEx');
  1864. {$IFDEF DEBUG}
  1865. if Count <> Length(DelphiScriptFuncTable) then
  1866. raise Exception.Create('Count <> Length(DelphiScriptFuncTable)');
  1867. {$ENDIF}
  1868. end;
  1869. initialization
  1870. finalization
  1871. ScriptFuncs.Free;
  1872. end.