Setup.ScriptFunc.pas 103 KB

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