Setup.ScriptDlg.pas 44 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338
  1. unit Setup.ScriptDlg;
  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. Custom wizard pages
  8. }
  9. interface
  10. uses
  11. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, Contnrs, Generics.Collections,
  12. Shared.Struct, Setup.WizardForm, Setup.DownloadFileFunc, Setup.ISSigVerifyFunc,
  13. Setup.ScriptFunc.HelperFunc, Compression.SevenZipDecoder,
  14. NewCheckListBox, NewStaticText, NewProgressBar, PasswordEdit, RichEditViewer,
  15. BidiCtrls, TaskbarProgressFunc;
  16. type
  17. TInputQueryWizardPage = class(TWizardPage)
  18. private
  19. FEdits: TList;
  20. FPromptLabels: TList;
  21. FSubCaptionLabel: TNewStaticText;
  22. FY: Integer;
  23. function GetEdit(Index: Integer): TPasswordEdit;
  24. function GetPromptLabel(Index: Integer): TNewStaticText;
  25. function GetValue(Index: Integer): String;
  26. procedure SetValue(Index: Integer; const Value: String);
  27. public
  28. constructor Create(AOwner: TComponent); override;
  29. destructor Destroy; override;
  30. function Add(const APrompt: String; const APassword: Boolean): Integer;
  31. property Edits[Index: Integer]: TPasswordEdit read GetEdit;
  32. procedure Initialize(const SubCaption: String);
  33. property PromptLabels[Index: Integer]: TNewStaticText read GetPromptLabel;
  34. property Values[Index: Integer]: String read GetValue write SetValue;
  35. published
  36. property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
  37. end;
  38. TInputOptionWizardPage = class(TWizardPage)
  39. private
  40. FCheckListBox: TNewCheckListBox;
  41. FExclusive: Boolean;
  42. FSubCaptionLabel: TNewStaticText;
  43. function GetSelectedValueIndex: Integer;
  44. function GetValue(Index: Integer): Boolean;
  45. procedure SetSelectedValueIndex(Value: Integer);
  46. procedure SetValue(Index: Integer; Value: Boolean);
  47. public
  48. function Add(const ACaption: String): Integer;
  49. function AddEx(const ACaption: String; const ALevel: Byte; const AExclusive: Boolean): Integer;
  50. procedure Initialize(const SubCaption: String; const Exclusive, ListBox: Boolean);
  51. property SelectedValueIndex: Integer read GetSelectedValueIndex write SetSelectedValueIndex;
  52. property Values[Index: Integer]: Boolean read GetValue write SetValue;
  53. published
  54. property CheckListBox: TNewCheckListBox read FCheckListBox;
  55. property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
  56. end;
  57. TInputDirWizardPage = class(TWizardPage)
  58. private
  59. FAppendDir: Boolean;
  60. FButtons: TList;
  61. FEdits: TList;
  62. FNewFolderName: String;
  63. FPromptLabels: TList;
  64. FSubCaptionLabel: TNewStaticText;
  65. FY: Integer;
  66. procedure ButtonClick(Sender: TObject);
  67. function GetButton(Index: Integer): TNewButton;
  68. function GetEdit(Index: Integer): TEdit;
  69. function GetPromptLabel(Index: Integer): TNewStaticText;
  70. function GetValue(Index: Integer): String;
  71. procedure SetValue(Index: Integer; const Value: String);
  72. protected
  73. procedure NextButtonClick(var Continue: Boolean); override;
  74. public
  75. constructor Create(AOwner: TComponent); override;
  76. destructor Destroy; override;
  77. function Add(const APrompt: String): Integer;
  78. property Buttons[Index: Integer]: TNewButton read GetButton;
  79. property Edits[Index: Integer]: TEdit read GetEdit;
  80. procedure Initialize(const SubCaption: String; const AppendDir: Boolean;
  81. const NewFolderName: String);
  82. property PromptLabels[Index: Integer]: TNewStaticText read GetPromptLabel;
  83. property Values[Index: Integer]: String read GetValue write SetValue;
  84. published
  85. property NewFolderName: String read FNewFolderName write FNewFolderName;
  86. property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
  87. end;
  88. TInputFileWizardPage = class(TWizardPage)
  89. private
  90. FButtons: TList;
  91. FEdits: TList;
  92. FInputFileDefaultExtensions: TStringList;
  93. FInputFileFilters: TStringList;
  94. FPromptLabels: TList;
  95. FSubCaptionLabel: TNewStaticText;
  96. FY: Integer;
  97. procedure ButtonClick(Sender: TObject);
  98. function GetButton(Index: Integer): TNewButton;
  99. function GetEdit(Index: Integer): TEdit;
  100. function GetPromptLabel(Index: Integer): TNewStaticText;
  101. function GetValue(Index: Integer): String;
  102. procedure SetValue(Index: Integer; const Value: String);
  103. function GetIsSaveButton(Index: Integer): Boolean;
  104. procedure SetIsSaveButton(Index: Integer; const IsSaveButton: Boolean);
  105. public
  106. constructor Create(AOwner: TComponent); override;
  107. destructor Destroy; override;
  108. function Add(const APrompt, AFilter, ADefaultExtension: String): Integer;
  109. property Buttons[Index: Integer]: TNewButton read GetButton;
  110. property Edits[Index: Integer]: TEdit read GetEdit;
  111. procedure Initialize(const SubCaption: String);
  112. property PromptLabels[Index: Integer]: TNewStaticText read GetPromptLabel;
  113. property Values[Index: Integer]: String read GetValue write SetValue;
  114. property IsSaveButton[Index: Integer]: Boolean read GetIsSaveButton write SetIsSaveButton;
  115. published
  116. property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
  117. end;
  118. TOutputMsgWizardPage = class(TWizardPage)
  119. private
  120. FMsgLabel: TNewStaticText;
  121. public
  122. procedure Initialize(const Msg: String);
  123. published
  124. property MsgLabel: TNewStaticText read FMsgLabel;
  125. end;
  126. TOutputMsgMemoWizardPage = class(TWizardPage)
  127. private
  128. FRichEditViewer: TRichEditViewer;
  129. FSubCaptionLabel: TNewStaticText;
  130. public
  131. procedure Initialize(const SubCaption: String; const Msg: AnsiString);
  132. published
  133. property RichEditViewer: TRichEditViewer read FRichEditViewer;
  134. property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
  135. end;
  136. TOutputProgressWizardPage = class(TWizardPage)
  137. private
  138. FMsg1Label: TNewStaticText;
  139. FMsg2Label: TNewStaticText;
  140. FProgressBar: TNewProgressBar;
  141. FUseMarqueeStyle: Boolean;
  142. FSavePageID: Integer;
  143. procedure ProcessMsgs;
  144. public
  145. constructor Create(AOwner: TComponent); override;
  146. procedure Hide;
  147. procedure Initialize; virtual;
  148. procedure SetProgress(const Position, Max: Longint);
  149. procedure SetText(const Msg1, Msg2: String);
  150. procedure Show; virtual;
  151. published
  152. property Msg1Label: TNewStaticText read FMsg1Label;
  153. property Msg2Label: TNewStaticText read FMsg2Label;
  154. property ProgressBar: TNewProgressBar read FProgressBar;
  155. end;
  156. TOutputMarqueeProgressWizardPage = class(TOutputProgressWizardPage)
  157. public
  158. constructor Create(AOwner: TComponent); override;
  159. procedure Animate;
  160. procedure Initialize; override;
  161. procedure SetProgress(const Position, Max: Longint);
  162. end;
  163. TDownloadFile = class
  164. Url, BaseName, UserName, Password: String;
  165. Verification: TSetupFileVerification;
  166. DotISSigEntry: Boolean;
  167. Data: NativeUInt; { Only valid if DotISSigEntry is False }
  168. end;
  169. TDownloadFiles = TObjectList<TDownloadFile>;
  170. TDownloadFileCompleted = reference to procedure(const DownloadedFile: TDownloadFile;
  171. const DestFile: String; var Remove: Boolean);
  172. TDownloadWizardPage = class(TOutputProgressWizardPage)
  173. private
  174. FFiles: TDownloadFiles;
  175. FOnDownloadProgress: TOnDownloadProgress;
  176. FShowBaseNameInsteadOfUrl: Boolean;
  177. FAbortButton: TNewButton;
  178. FShowProgressControlsOnNextProgress, FAbortedByUser: Boolean;
  179. FThrottler: TProgressThrottler;
  180. FLastBaseNameOrUrl: String;
  181. function DoAdd(const Url, BaseName, RequiredSHA256OfFile: String;
  182. const UserName, Password: String; const ISSigVerify: Boolean;
  183. const ISSigAllowedKeys: AnsiString; const DotISSigEntry: Boolean; const Data: NativeUInt): Integer;
  184. procedure AbortButtonClick(Sender: TObject);
  185. function InternalOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
  186. function InternalOnDownloadNoProgress: Boolean;
  187. function InternalThrottledOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
  188. procedure ShowProgressControls(const AVisible: Boolean);
  189. public
  190. constructor Create(AOwner: TComponent); override;
  191. destructor Destroy; override;
  192. procedure Initialize; override;
  193. function Add(const Url, BaseName, RequiredSHA256OfFile: String): Integer;
  194. function AddWithISSigVerify(const Url, ISSigUrl, BaseName: String;
  195. const AllowedKeysRuntimeIDs: TStringList): Integer;
  196. function AddEx(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String;
  197. const Data: NativeUInt): Integer;
  198. function AddExWithISSigVerify(const Url, ISSigUrl, BaseName, UserName, Password: String;
  199. const AllowedKeysRuntimeIDs: TStringList; const Data: NativeUInt): Integer; overload;
  200. function AddExWithISSigVerify(const Url, ISSigUrl, BaseName, UserName, Password: String;
  201. const ISSigAllowedKeys: AnsiString; const Data: NativeUInt): Integer; overload;
  202. procedure Clear;
  203. function Download(const OnDownloadFileCompleted: TDownloadFileCompleted): Int64;
  204. property OnDownloadProgress: TOnDownloadProgress write FOnDownloadProgress;
  205. procedure Show; override;
  206. published
  207. property AbortButton: TNewButton read FAbortButton;
  208. property AbortedByUser: Boolean read FAbortedByUser;
  209. property LastBaseNameOrUrl: String read FLastBaseNameOrUrl;
  210. property ShowBaseNameInsteadOfUrl: Boolean read FShowBaseNameInsteadOfUrl write FShowBaseNameInsteadOfUrl;
  211. end;
  212. TArchive = class
  213. FileName, DestDir, Password: String;
  214. FullPaths: Boolean;
  215. end;
  216. TArchives = TObjectList<TArchive>;
  217. TExtractionWizardPage = class(TOutputProgressWizardPage)
  218. private
  219. FArchives: TArchives;
  220. FOnExtractionProgress: TOnExtractionProgress;
  221. FShowArchiveInsteadOfFile: Boolean;
  222. FAbortButton: TNewButton;
  223. FShowProgressControlsOnNextProgress, FAbortedByUser: Boolean;
  224. FThrottler: TProgressThrottler;
  225. procedure AbortButtonClick(Sender: TObject);
  226. function InternalOnExtractionProgress(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
  227. function InternalThrottledOnExtractionProgress(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
  228. procedure ShowProgressControls(const AVisible: Boolean);
  229. public
  230. constructor Create(AOwner: TComponent); override;
  231. destructor Destroy; override;
  232. procedure Initialize; override;
  233. function Add(const ArchiveFileName, DestDir: String; const FullPaths: Boolean): Integer;
  234. function AddEx(const ArchiveFileName, DestDir, Password: String; const FullPaths: Boolean): Integer;
  235. procedure Clear;
  236. procedure Extract;
  237. property OnExtractionProgress: TOnExtractionProgress write FOnExtractionProgress;
  238. procedure Show; override;
  239. published
  240. property AbortButton: TNewButton read FAbortButton;
  241. property AbortedByUser: Boolean read FAbortedByUser;
  242. property ShowArchiveInsteadOfFile: Boolean read FShowArchiveInsteadOfFile write FShowArchiveInsteadOfFile;
  243. end;
  244. function ConvertAllowedKeysRuntimeIDsToISSigAllowedKeys(const AllowedKeysRuntimeIDs: TStringList): AnsiString;
  245. implementation
  246. uses
  247. StrUtils, ISSigFunc, SHA256,
  248. Shared.SetupTypes, Setup.MainFunc, Setup.SelectFolderForm,
  249. SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, PathFunc, Shared.CommonFunc.Vcl,
  250. Shared.CommonFunc, BrowseFunc, Setup.LoggingFunc, Setup.InstFunc,
  251. Compression.SevenZipDLLDecoder;
  252. const
  253. DefaultLabelHeight = 14;
  254. DefaultBoxTop = 24; { relative to top of InnerNotebook }
  255. DefaultBoxBottom = DefaultBoxTop + 205;
  256. {------}
  257. procedure SetCtlParent(const AControl, AParent: TWinControl);
  258. begin
  259. { Set CurrentPPI of the control to be parented to the CurrentPPI of the parent, preventing VCL
  260. from scaling the control. Also see TSetupForm.CreateWnd. }
  261. AControl.SetCurrentPPI(AParent.CurrentPPI);
  262. AControl.Parent := AParent;
  263. end;
  264. procedure SetCtlParentAtBack(const AControl, AParent: TWinControl);
  265. { Like assigning to AControl.Parent, but puts the control at the *bottom* of
  266. the z-order instead of the top, for MSAA compatibility }
  267. var
  268. OldVisible: Boolean;
  269. begin
  270. { Hide the control so the handle won't be created yet, so that unnecessary
  271. "OBJ_REORDER" MSAA events don't get sent }
  272. OldVisible := AControl.Visible;
  273. AControl.Visible := False;
  274. SetCtlParent(AControl, AParent);
  275. AControl.SendToBack;
  276. AControl.Visible := OldVisible;
  277. end;
  278. {--- InputQuery ---}
  279. constructor TInputQueryWizardPage.Create(AOwner: TComponent);
  280. begin
  281. inherited;
  282. FEdits := TList.Create;
  283. FPromptLabels := TList.Create;
  284. end;
  285. destructor TInputQueryWizardPage.Destroy;
  286. begin
  287. FPromptLabels.Free;
  288. FEdits.Free;
  289. inherited;
  290. end;
  291. procedure TInputQueryWizardPage.Initialize(const SubCaption: String);
  292. begin
  293. FSubCaptionLabel := TNewStaticText.Create(Self);
  294. with FSubCaptionLabel do begin
  295. AutoSize := False;
  296. Width := SurfaceWidth;
  297. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  298. WordWrap := True;
  299. Caption := SubCaption;
  300. end;
  301. SetCtlParent(FSubCaptionLabel, Surface);
  302. FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
  303. end;
  304. function TInputQueryWizardPage.Add(const APrompt: String;
  305. const APassword: Boolean): Integer;
  306. var
  307. PromptLabel: TNewStaticText;
  308. Edit: TPasswordEdit;
  309. begin
  310. if APrompt <> '' then begin
  311. PromptLabel := TNewStaticText.Create(Self);
  312. with PromptLabel do begin
  313. AutoSize := False;
  314. Top := FY;
  315. Width := SurfaceWidth;
  316. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  317. WordWrap := True;
  318. Caption := APrompt;
  319. end;
  320. SetCtlParentAtBack(PromptLabel, Surface);
  321. Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
  322. end else
  323. PromptLabel := nil;
  324. Edit := TPasswordEdit.Create(Self);
  325. with Edit do begin
  326. Password := APassword;
  327. Top := FY;
  328. Width := SurfaceWidth;
  329. end;
  330. SetCtlParentAtBack(Edit, Surface);
  331. Inc(FY, WizardForm.ScalePixelsY(36));
  332. if PromptLabel <> nil then
  333. PromptLabel.FocusControl := Edit;
  334. FPromptLabels.Add(PromptLabel);
  335. Result := FEdits.Add(Edit);
  336. end;
  337. function TInputQueryWizardPage.GetEdit(Index: Integer): TPasswordEdit;
  338. begin
  339. Result := TPasswordEdit(FEdits[Index]);
  340. end;
  341. function TInputQueryWizardPage.GetPromptLabel(Index: Integer): TNewStaticText;
  342. begin
  343. Result := TNewStaticText(FPromptLabels[Index]);
  344. end;
  345. function TInputQueryWizardPage.GetValue(Index: Integer): String;
  346. begin
  347. Result := GetEdit(Index).Text;
  348. end;
  349. procedure TInputQueryWizardPage.SetValue(Index: Integer; const Value: String);
  350. begin
  351. GetEdit(Index).Text := Value;
  352. end;
  353. {--- InputOption ---}
  354. procedure TInputOptionWizardPage.Initialize(const SubCaption: String;
  355. const Exclusive, ListBox: Boolean);
  356. var
  357. CaptionYDiff: Integer;
  358. begin
  359. FSubCaptionLabel := TNewStaticText.Create(Self);
  360. with SubCaptionLabel do begin
  361. AutoSize := False;
  362. Width := SurfaceWidth;
  363. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  364. WordWrap := True;
  365. Caption := SubCaption;
  366. end;
  367. SetCtlParent(FSubCaptionLabel, Surface);
  368. CaptionYDiff := WizardForm.AdjustLabelHeight(SubCaptionLabel);
  369. FCheckListBox := TNewCheckListBox.Create(Self);
  370. with FCheckListBox do begin
  371. Top := CaptionYDiff + WizardForm.ScalePixelsY(DefaultBoxTop);
  372. Width := SurfaceWidth;
  373. Height := WizardForm.ScalePixelsY(DefaultBoxBottom) + SurfaceExtraHeight - Top;
  374. Flat := ListBox and (shFlatComponentsList in SetupHeader.Options);
  375. end;
  376. SetCtlParentAtBack(FCheckListBox, Surface);
  377. FExclusive := Exclusive;
  378. if not ListBox then begin
  379. FCheckListBox.BorderStyle := bsNone;
  380. FCheckListBox.Color := SurfaceColor;
  381. FCheckListBox.MinItemHeight := WizardForm.ScalePixelsY(22);
  382. FCheckListBox.WantTabs := True;
  383. end;
  384. end;
  385. function TInputOptionWizardPage.Add(const ACaption: String): Integer;
  386. begin
  387. Result := AddEx(ACaption, 0, FExclusive);
  388. end;
  389. function TInputOptionWizardPage.AddEx(const ACaption: String;
  390. const ALevel: Byte; const AExclusive: Boolean): Integer;
  391. begin
  392. if AExclusive then
  393. Result := FCheckListBox.AddRadioButton(ACaption, '', ALevel, False, True, nil)
  394. else
  395. Result := FCheckListBox.AddCheckBox(ACaption, '', ALevel, False, True, True,
  396. True, nil);
  397. end;
  398. function TInputOptionWizardPage.GetSelectedValueIndex: Integer;
  399. var
  400. I: Integer;
  401. begin
  402. for I := 0 to FCheckListBox.Items.Count-1 do
  403. if (FCheckListBox.ItemLevel[I] = 0) and FCheckListBox.Checked[I] then begin
  404. Result := I;
  405. Exit;
  406. end;
  407. Result := -1;
  408. end;
  409. function TInputOptionWizardPage.GetValue(Index: Integer): Boolean;
  410. begin
  411. Result := FCheckListBox.Checked[Index];
  412. end;
  413. procedure TInputOptionWizardPage.SetSelectedValueIndex(Value: Integer);
  414. var
  415. I: Integer;
  416. begin
  417. for I := 0 to FCheckListBox.Items.Count-1 do
  418. if FCheckListBox.ItemLevel[I] = 0 then
  419. FCheckListBox.Checked[I] := (I = Value);
  420. end;
  421. procedure TInputOptionWizardPage.SetValue(Index: Integer; Value: Boolean);
  422. begin
  423. FCheckListBox.Checked[Index] := Value;
  424. end;
  425. {--- InputDir ---}
  426. constructor TInputDirWizardPage.Create(AOwner: TComponent);
  427. begin
  428. inherited;
  429. FButtons := TList.Create;
  430. FEdits := TList.Create;
  431. FPromptLabels := TList.Create;
  432. end;
  433. destructor TInputDirWizardPage.Destroy;
  434. begin
  435. FPromptLabels.Free;
  436. FEdits.Free;
  437. FButtons.Free;
  438. inherited;
  439. end;
  440. procedure TInputDirWizardPage.ButtonClick(Sender: TObject);
  441. var
  442. I: Integer;
  443. Edit: TEdit;
  444. S: String;
  445. begin
  446. I := FButtons.IndexOf(Sender);
  447. if I <> -1 then begin
  448. Edit := TEdit(FEdits[I]);
  449. S := Edit.Text;
  450. if ShowSelectFolderDialog(False, FAppendDir, S, FNewFolderName) then
  451. Edit.Text := S;
  452. end;
  453. end;
  454. procedure TInputDirWizardPage.NextButtonClick(var Continue: Boolean);
  455. var
  456. I: Integer;
  457. Edit: TEdit;
  458. begin
  459. for I := 0 to FEdits.Count-1 do begin
  460. Edit := FEdits[I];
  461. if not ValidateCustomDirEdit(Edit, True, True, True) then begin
  462. if WizardForm.Visible then
  463. Edit.SetFocus;
  464. Continue := False;
  465. Exit;
  466. end;
  467. end;
  468. inherited;
  469. end;
  470. procedure TInputDirWizardPage.Initialize(const SubCaption: String;
  471. const AppendDir: Boolean; const NewFolderName: String);
  472. begin
  473. FSubCaptionLabel := TNewStaticText.Create(Self);
  474. with FSubCaptionLabel do begin
  475. AutoSize := False;
  476. Width := SurfaceWidth;
  477. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  478. WordWrap := True;
  479. Caption := SubCaption;
  480. end;
  481. SetCtlParent(FSubCaptionLabel, Surface);
  482. FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
  483. FAppendDir := AppendDir;
  484. FNewFolderName := NewFolderName;
  485. end;
  486. function TInputDirWizardPage.Add(const APrompt: String): Integer;
  487. var
  488. ButtonWidth: Integer;
  489. PromptLabel: TNewStaticText;
  490. Edit: TEdit;
  491. Button: TNewButton;
  492. begin
  493. ButtonWidth := WizardForm.CalculateButtonWidth([SetupMessages[msgButtonWizardBrowse]]);
  494. if APrompt <> '' then begin
  495. PromptLabel := TNewStaticText.Create(Self);
  496. with PromptLabel do begin
  497. AutoSize := False;
  498. Top := FY;
  499. Width := SurfaceWidth;
  500. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  501. WordWrap := True;
  502. Caption := APrompt;
  503. end;
  504. SetCtlParentAtBack(PromptLabel, Surface);
  505. Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
  506. end else
  507. PromptLabel := nil;
  508. Edit := TEdit.Create(Self);
  509. with Edit do begin
  510. Top := FY;
  511. Width := SurfaceWidth-ButtonWidth-WizardForm.ScalePixelsX(10);
  512. end;
  513. SetCtlParentAtBack(Edit, Surface);
  514. TryEnableAutoCompleteFileSystem(Edit.Handle);
  515. if PromptLabel <> nil then
  516. PromptLabel.FocusControl := Edit;
  517. Button := TNewButton.Create(Self);
  518. with Button do begin
  519. Left := SurfaceWidth-ButtonWidth;
  520. Top := Edit.Top-1;
  521. Width := ButtonWidth;
  522. Height := WizardForm.NextButton.Height;
  523. if FEdits.Count = 0 then
  524. Caption := SetupMessages[msgButtonWizardBrowse]
  525. else
  526. { Can't use the same accel key for secondary buttons... }
  527. Caption := RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]);
  528. OnClick := ButtonClick;
  529. end;
  530. SetCtlParentAtBack(Button, Surface);
  531. Inc(FY, WizardForm.ScalePixelsY(36));
  532. FButtons.Add(Button);
  533. FPromptLabels.Add(PromptLabel);
  534. Result := FEdits.Add(Edit);
  535. end;
  536. function TInputDirWizardPage.GetButton(Index: Integer): TNewButton;
  537. begin
  538. Result := TNewButton(FButtons[Index]);
  539. end;
  540. function TInputDirWizardPage.GetEdit(Index: Integer): TEdit;
  541. begin
  542. Result := TEdit(FEdits[Index]);
  543. end;
  544. function TInputDirWizardPage.GetPromptLabel(Index: Integer): TNewStaticText;
  545. begin
  546. Result := TNewStaticText(FPromptLabels[Index]);
  547. end;
  548. function TInputDirWizardPage.GetValue(Index: Integer): String;
  549. begin
  550. Result := GetEdit(Index).Text;
  551. end;
  552. procedure TInputDirWizardPage.SetValue(Index: Integer; const Value: String);
  553. begin
  554. GetEdit(Index).Text := RemoveBackslashUnlessRoot(PathExpand(Value));
  555. end;
  556. {--- InputFile ---}
  557. constructor TInputFileWizardPage.Create(AOwner: TComponent);
  558. begin
  559. inherited;
  560. FButtons := TList.Create;
  561. FEdits := TList.Create;
  562. FInputFileDefaultExtensions := TStringList.Create;
  563. FInputFileFilters := TStringList.Create;
  564. FPromptLabels := TList.Create;
  565. end;
  566. destructor TInputFileWizardPage.Destroy;
  567. begin
  568. FPromptLabels.Free;
  569. FInputFileFilters.Free;
  570. FInputFileDefaultExtensions.Free;
  571. FEdits.Free;
  572. FButtons.Free;
  573. inherited;
  574. end;
  575. procedure TInputFileWizardPage.ButtonClick(Sender: TObject);
  576. var
  577. I: Integer;
  578. Edit: TEdit;
  579. FileName: String;
  580. begin
  581. I := FButtons.IndexOf(Sender);
  582. if I <> -1 then begin
  583. Edit := TEdit(FEdits[I]);
  584. FileName := Edit.Text;
  585. if (not IsSaveButton[I] and NewGetOpenFileName(RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]),
  586. FileName, PathExtractPath(FileName), FInputFileFilters[I],
  587. FInputFileDefaultExtensions[I], Surface.Handle)) or
  588. (IsSaveButton[I] and NewGetSaveFileName(RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]),
  589. FileName, PathExtractPath(FileName), FInputFileFilters[I],
  590. FInputFileDefaultExtensions[I], Surface.Handle)) then
  591. Edit.Text := FileName;
  592. end;
  593. end;
  594. procedure TInputFileWizardPage.Initialize(const SubCaption: String);
  595. begin
  596. FSubCaptionLabel := TNewStaticText.Create(Self);
  597. with FSubCaptionLabel do begin
  598. AutoSize := False;
  599. Width := SurfaceWidth;
  600. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  601. WordWrap := True;
  602. Caption := SubCaption;
  603. end;
  604. SetCtlParent(FSubCaptionLabel, Surface);
  605. FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
  606. end;
  607. function TInputFileWizardPage.Add(const APrompt, AFilter,
  608. ADefaultExtension: String): Integer;
  609. var
  610. ButtonWidth: Integer;
  611. PromptLabel: TNewStaticText;
  612. Edit: TEdit;
  613. Button: TNewButton;
  614. begin
  615. ButtonWidth := WizardForm.CalculateButtonWidth([SetupMessages[msgButtonWizardBrowse]]);
  616. if APrompt <> '' then begin
  617. PromptLabel := TNewStaticText.Create(Self);
  618. with PromptLabel do begin
  619. AutoSize := False;
  620. Top := FY;
  621. Width := SurfaceWidth;
  622. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  623. WordWrap := True;
  624. Caption := APrompt;
  625. end;
  626. SetCtlParentAtBack(PromptLabel, Surface);
  627. Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
  628. end else
  629. PromptLabel := nil;
  630. Edit := TEdit.Create(Self);
  631. with Edit do begin
  632. Top := FY;
  633. Width := SurfaceWidth-ButtonWidth-WizardForm.ScalePixelsX(10);
  634. end;
  635. SetCtlParentAtBack(Edit, Surface);
  636. TryEnableAutoCompleteFileSystem(Edit.Handle);
  637. if PromptLabel <> nil then
  638. PromptLabel.FocusControl := Edit;
  639. Button := TNewButton.Create(Self);
  640. with Button do begin
  641. Left := SurfaceWidth-ButtonWidth;
  642. Top := Edit.Top-1;
  643. Width := ButtonWidth;
  644. Height := WizardForm.NextButton.Height;
  645. if FButtons.Count = 0 then
  646. Caption := SetupMessages[msgButtonWizardBrowse]
  647. else
  648. { Can't use the same accel key for secondary buttons... }
  649. Caption := RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]);
  650. OnClick := ButtonClick;
  651. end;
  652. SetCtlParentAtBack(Button, Surface);
  653. Inc(FY, WizardForm.ScalePixelsY(36));
  654. FInputFileFilters.Add(AFilter);
  655. FInputFileDefaultExtensions.Add(ADefaultExtension);
  656. FButtons.Add(Button);
  657. FPromptLabels.Add(PromptLabel);
  658. Result := FEdits.Add(Edit);
  659. end;
  660. function TInputFileWizardPage.GetButton(Index: Integer): TNewButton;
  661. begin
  662. Result := TNewButton(FButtons[Index]);
  663. end;
  664. function TInputFileWizardPage.GetEdit(Index: Integer): TEdit;
  665. begin
  666. Result := TEdit(FEdits[Index]);
  667. end;
  668. function TInputFileWizardPage.GetPromptLabel(Index: Integer): TNewStaticText;
  669. begin
  670. Result := TNewStaticText(FPromptLabels[Index]);
  671. end;
  672. function TInputFileWizardPage.GetValue(Index: Integer): String;
  673. begin
  674. Result := GetEdit(Index).Text;
  675. end;
  676. procedure TInputFileWizardPage.SetValue(Index: Integer; const Value: String);
  677. begin
  678. GetEdit(Index).Text := Value;
  679. end;
  680. function TInputFileWizardPage.GetIsSaveButton(Index: Integer): Boolean;
  681. begin
  682. Result := GetButton(Index).Tag = 1;
  683. end;
  684. procedure TInputFileWizardPage.SetIsSaveButton(Index: Integer; const IsSaveButton: Boolean);
  685. begin
  686. if IsSaveButton then
  687. GetButton(Index).Tag := 1
  688. else
  689. GetButton(Index).Tag := 0;
  690. end;
  691. {--- OutputMsg ---}
  692. procedure TOutputMsgWizardPage.Initialize(const Msg: String);
  693. begin
  694. FMsgLabel := TNewStaticText.Create(Self);
  695. with FMsgLabel do begin
  696. AutoSize := False;
  697. Width := SurfaceWidth;
  698. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  699. WordWrap := True;
  700. Caption := Msg;
  701. end;
  702. SetCtlParent(FMsgLabel, Surface);
  703. WizardForm.AdjustLabelHeight(MsgLabel);
  704. end;
  705. {--- OutputMsgMemo ---}
  706. procedure TOutputMsgMemoWizardPage.Initialize(const SubCaption: String; const Msg: AnsiString);
  707. var
  708. Y: Integer;
  709. begin
  710. Y := 0;
  711. if SubCaption <> '' then begin
  712. FSubCaptionLabel := TNewStaticText.Create(Self);
  713. with FSubCaptionLabel do begin
  714. AutoSize := False;
  715. Width := SurfaceWidth;
  716. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  717. WordWrap := True;
  718. Caption := SubCaption;
  719. end;
  720. SetCtlParent(FSubCaptionLabel, Surface);
  721. Inc(Y, WizardForm.ScalePixelsY(DefaultBoxTop) +
  722. WizardForm.AdjustLabelHeight(FSubCaptionLabel));
  723. end else
  724. FSubCaptionLabel := nil;
  725. FRichEditViewer := TRichEditViewer.Create(Self);
  726. with FRichEditViewer do begin
  727. Top := Y;
  728. Width := SurfaceWidth;
  729. Height := WizardForm.ScalePixelsY(DefaultBoxBottom) + SurfaceExtraHeight - Y;
  730. BevelKind := bkFlat;
  731. BorderStyle := bsNone;
  732. ReadOnly := True;
  733. ScrollBars := ssVertical;
  734. WantReturns := False;
  735. end;
  736. SetCtlParentAtBack(FRichEditViewer, Surface);
  737. with FRichEditViewer do begin
  738. UseRichEdit := True;
  739. RTFText := Msg;
  740. end;
  741. end;
  742. {--- OutputProgress ---}
  743. constructor TOutputProgressWizardPage.Create(AOwner: TComponent);
  744. begin
  745. inherited;
  746. Style := Style + [psAlwaysSkip, psNoButtons];
  747. end;
  748. procedure TOutputProgressWizardPage.Initialize;
  749. begin
  750. FMsg1Label := TNewStaticText.Create(Self);
  751. with FMsg1Label do begin
  752. AutoSize := False;
  753. ShowAccelChar := False;
  754. Width := SurfaceWidth;
  755. Height := WizardForm.StatusLabel.Height;
  756. WordWrap := WizardForm.StatusLabel.WordWrap;
  757. end;
  758. SetCtlParent(FMsg1Label, Surface);
  759. FMsg2Label := TNewStaticText.Create(Self);
  760. with FMsg2Label do begin
  761. AutoSize := False;
  762. ForceLTRReading := True;
  763. ShowAccelChar := False;
  764. Top := WizardForm.ScalePixelsY(16);
  765. Width := SurfaceWidth;
  766. Height := WizardForm.FileNameLabel.Height;
  767. end;
  768. SetCtlParentAtBack(FMsg2Label, Surface);
  769. FProgressBar := TNewProgressBar.Create(Self);
  770. with FProgressBar do begin
  771. Top := WizardForm.ScalePixelsY(42);
  772. Width := SurfaceWidth;
  773. Height := WizardForm.ScalePixelsY(21);
  774. Visible := False;
  775. end;
  776. SetCtlParentAtBack(FProgressBar, Surface);
  777. end;
  778. procedure TOutputProgressWizardPage.Hide;
  779. begin
  780. if (WizardForm.CurPageID = ID) and (FSavePageID <> 0) then begin
  781. SetMessageBoxCallbackFunc(nil, 0);
  782. SetAppTaskbarProgressState(tpsNoProgress);
  783. WizardForm.SetCurPage(FSavePageID);
  784. FSavePageID := 0;
  785. end;
  786. end;
  787. procedure TOutputProgressWizardPage.ProcessMsgs;
  788. { Process messages to repaint and keep Windows from thinking the process is
  789. hung. This is safe; due to the psNoButtons style the user shouldn't be able
  790. to cancel or do anything else during this time. }
  791. begin
  792. if WizardForm.CurPageID = ID then
  793. Application.ProcessMessages;
  794. end;
  795. procedure TOutputProgressWizardPage.SetProgress(const Position, Max: Longint);
  796. begin
  797. if Max > 0 then begin
  798. FProgressBar.Style := npbstNormal;
  799. FProgressBar.Max := Max;
  800. FProgressBar.Position := Position;
  801. FProgressBar.Visible := True;
  802. SetAppTaskbarProgressState(tpsNormal);
  803. SetAppTaskbarProgressValue(Position, Max);
  804. end else begin
  805. if FUseMarqueeStyle then
  806. FProgressBar.Style := npbstMarquee
  807. else
  808. FProgressBar.Visible := False;
  809. SetAppTaskbarProgressState(tpsNoProgress);
  810. end;
  811. ProcessMsgs;
  812. end;
  813. procedure TOutputProgressWizardPage.SetText(const Msg1, Msg2: String);
  814. begin
  815. FMsg1Label.Caption := Msg1;
  816. FMsg2Label.Caption := MinimizePathName(Msg2, FMsg2Label.Font,
  817. FMsg2Label.Width);
  818. ProcessMsgs;
  819. end;
  820. procedure OutputProgressWizardPageMessageBoxCallback(const Flags: LongInt; const After: Boolean;
  821. const Param: LongInt);
  822. const
  823. States: array [TNewProgressBarState] of TTaskbarProgressState =
  824. (tpsNormal, tpsError, tpsPaused);
  825. var
  826. OutputProgressWizardPage: TOutputProgressWizardPage;
  827. NewState: TNewProgressBarState;
  828. begin
  829. OutputProgressWizardPage := TOutputProgressWizardPage(Param);
  830. if After then
  831. NewState := npbsNormal
  832. else if (Flags and MB_ICONSTOP) <> 0 then
  833. NewState := npbsError
  834. else
  835. NewState := npbsPaused;
  836. with OutputProgressWizardPage.ProgressBar do begin
  837. State := NewState;
  838. Invalidate;
  839. end;
  840. SetAppTaskbarProgressState(States[NewState]);
  841. end;
  842. procedure TOutputProgressWizardPage.Show;
  843. begin
  844. if WizardForm.CurPageID <> ID then begin
  845. FSavePageID := WizardForm.CurPageID;
  846. WizardForm.SetCurPage(ID);
  847. SetMessageBoxCallbackFunc(OutputProgressWizardPageMessageBoxCallback, LongInt(Self));
  848. ProcessMsgs;
  849. end;
  850. end;
  851. constructor TOutputMarqueeProgressWizardPage.Create(AOwner: TComponent);
  852. begin
  853. inherited;
  854. FUseMarqueeStyle := True;
  855. end;
  856. procedure TOutputMarqueeProgressWizardPage.Animate;
  857. begin
  858. ProcessMsgs;
  859. end;
  860. procedure TOutputMarqueeProgressWizardPage.Initialize;
  861. begin
  862. inherited;
  863. FProgressBar.Visible := True;
  864. inherited SetProgress(0, 0);
  865. end;
  866. procedure TOutputMarqueeProgressWizardPage.SetProgress(const Position, Max: Longint);
  867. begin
  868. InternalError('Cannot call TOutputMarqueeProgressWizardPage.SetProgress');
  869. end;
  870. {--- Download ---}
  871. procedure TDownloadWizardPage.AbortButtonClick(Sender: TObject);
  872. begin
  873. FAbortedByUser := LoggedMsgBox(SetupMessages[msgStopDownload], '', mbConfirmation, MB_YESNO, True, ID_YES) = IDYES;
  874. end;
  875. function TDownloadWizardPage.InternalOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
  876. var
  877. Progress32, ProgressMax32: LongInt;
  878. begin
  879. if FAbortedByUser then begin
  880. Log('Need to abort download.');
  881. Result := False;
  882. end else begin
  883. FMsg2Label.Caption := IfThen(FShowBaseNameInsteadOfUrl, PathExtractName(BaseName), Url);
  884. if ProgressMax > MaxLongInt then begin
  885. Progress32 := Round((Progress / ProgressMax) * MaxLongInt);
  886. ProgressMax32 := MaxLongInt;
  887. end else begin
  888. Progress32 := Progress;
  889. ProgressMax32 := ProgressMax;
  890. end;
  891. SetProgress(Progress32, ProgressMax32); { This will process messages which we need for the abort button to work }
  892. if FShowProgressControlsOnNextProgress then begin
  893. ShowProgressControls(True);
  894. FShowProgressControlsOnNextProgress := False;
  895. ProcessMsgs;
  896. end;
  897. { This will call InternalThrottledOnDownloadProgress, which will log progress and call the script's FOnDownloadProgress, but throttled }
  898. if FThrottler = nil then begin
  899. const OnDownloadProgress: TOnDownloadProgress = InternalThrottledOnDownloadProgress;
  900. FThrottler := TProgressThrottler.Create(OnDownloadProgress);
  901. end;
  902. Result := FThrottler.OnDownloadProgress(Url, BaseName, Progress, ProgressMax);
  903. end;
  904. end;
  905. function TDownloadWizardPage.InternalOnDownloadNoProgress: Boolean;
  906. begin
  907. if FAbortedByUser then begin
  908. Log('Need to abort download.');
  909. Result := False;
  910. end else begin
  911. ProcessMsgs;
  912. Result := True;
  913. end;
  914. end;
  915. function TDownloadWizardPage.InternalThrottledOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
  916. begin
  917. if ProgressMax > 0 then
  918. Log(Format(' %d of %d bytes done.', [Progress, ProgressMax]))
  919. else
  920. Log(Format(' %d bytes done.', [Progress]));
  921. if Assigned(FOnDownloadProgress) then
  922. Result := FOnDownloadProgress(Url, BaseName, Progress, ProgressMax)
  923. else
  924. Result := True;
  925. end;
  926. constructor TDownloadWizardPage.Create(AOwner: TComponent);
  927. begin
  928. inherited;
  929. FUseMarqueeStyle := True;
  930. FFiles := TDownloadFiles.Create;
  931. end;
  932. destructor TDownloadWizardPage.Destroy;
  933. begin
  934. FThrottler.Free;
  935. FFiles.Free;
  936. inherited;
  937. end;
  938. procedure TDownloadWizardPage.Initialize;
  939. begin
  940. inherited;
  941. FMsg1Label.Caption := SetupMessages[msgDownloadingLabel2];
  942. FAbortButton := TNewButton.Create(Self);
  943. with FAbortButton do begin
  944. Caption := SetupMessages[msgButtonStopDownload];
  945. Top := FProgressBar.Top + FProgressBar.Height + WizardForm.ScalePixelsY(8);
  946. Width := WizardForm.CalculateButtonWidth([Caption]);
  947. Height := WizardForm.CancelButton.Height;
  948. OnClick := AbortButtonClick;
  949. end;
  950. SetCtlParentAtBack(FAbortButton, Surface);
  951. end;
  952. procedure TDownloadWizardPage.Show;
  953. begin
  954. if WizardForm.CurPageID <> ID then begin
  955. ShowProgressControls(False);
  956. FShowProgressControlsOnNextProgress := True;
  957. end;
  958. inherited;
  959. end;
  960. procedure TDownloadWizardPage.ShowProgressControls(const AVisible: Boolean);
  961. begin
  962. FMsg2Label.Visible := AVisible;
  963. FProgressBar.Visible := AVisible;
  964. end;
  965. function TDownloadWizardPage.DoAdd(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String;
  966. const ISSigVerify: Boolean; const ISSigAllowedKeys: AnsiString; const DotISSigEntry: Boolean;
  967. const Data: NativeUInt): Integer;
  968. begin
  969. if ISSigVerify and DotISSigEntry then
  970. InternalError('ISSigVerify and DotISSigEntry');
  971. var F := TDownloadFile.Create;
  972. F.Url := Url;
  973. F.BaseName := BaseName;
  974. F.UserName := UserName;
  975. F.Password := Password;
  976. F.Verification := NoVerification;
  977. if RequiredSHA256OfFile <> '' then begin
  978. F.Verification.Typ := fvHash;
  979. F.Verification.Hash := SHA256DigestFromString(RequiredSHA256OfFile)
  980. end else if ISSigVerify then begin
  981. F.Verification.Typ := fvISSig;
  982. F.Verification.ISSigAllowedKeys := ISSigAllowedKeys
  983. end;
  984. F.DotISSigEntry := DotISSigEntry;
  985. F.Data := Data;
  986. Result := FFiles.Add(F);
  987. end;
  988. function ConvertAllowedKeysRuntimeIDsToISSigAllowedKeys(const AllowedKeysRuntimeIDs: TStringList): AnsiString;
  989. begin
  990. Result := '';
  991. if AllowedKeysRuntimeIDs <> nil then begin
  992. for var I := 0 to AllowedKeysRuntimeIDs.Count-1 do begin
  993. const RuntimeID = AllowedKeysRuntimeIDs[I];
  994. if RuntimeID = '' then
  995. InternalError('RuntimeID cannot be empty');
  996. var Found := False;
  997. for var KeyIndex := 0 to Entries[seISSigKey].Count-1 do begin
  998. var ISSigKeyEntry := PSetupISSigKeyEntry(Entries[seISSigKey][KeyIndex]);
  999. if SameText(ISSigKeyEntry.RuntimeID, RuntimeID) then begin
  1000. SetISSigAllowedKey(Result, KeyIndex);
  1001. Found := True;
  1002. Break;
  1003. end;
  1004. end;
  1005. if not Found then
  1006. InternalError(Format('Unknown RuntimeID ''%s''', [RuntimeID]));
  1007. end;
  1008. end;
  1009. end;
  1010. function TDownloadWizardPage.Add(const Url, BaseName, RequiredSHA256OfFile: String): Integer;
  1011. begin
  1012. Result := DoAdd(Url, BaseName, RequiredSHA256OfFile, '', '', False, '', False, 0);
  1013. end;
  1014. function TDownloadWizardPage.AddWithISSigVerify(const Url, ISSigUrl, BaseName: String;
  1015. const AllowedKeysRuntimeIDs: TStringList): Integer;
  1016. begin
  1017. Result := AddExWithISSigVerify(Url, ISSigUrl, BaseName, '', '', AllowedKeysRuntimeIDs, 0);
  1018. end;
  1019. function TDownloadWizardPage.AddEx(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String;
  1020. const Data: NativeUInt): Integer;
  1021. begin
  1022. Result := DoAdd(Url, BaseName, RequiredSHA256OfFile, UserName, Password, False, '', False, Data);
  1023. end;
  1024. function TDownloadWizardPage.AddExWithISSigVerify(const Url, ISSigUrl, BaseName, UserName,
  1025. Password: String; const AllowedKeysRuntimeIDs: TStringList; const Data: NativeUInt): Integer;
  1026. begin
  1027. const ISSigAllowedKeys = ConvertAllowedKeysRuntimeIDsToISSigAllowedKeys(AllowedKeysRuntimeIDs);
  1028. Result := AddExWithISSigVerify(Url, ISSigUrl, BaseName, UserName, Password, ISSigAllowedKeys, Data);
  1029. end;
  1030. function TDownloadWizardPage.AddExWithISSigVerify(const Url, ISSigUrl, BaseName, UserName,
  1031. Password: String; const ISSigAllowedKeys: AnsiString; const Data: NativeUInt): Integer;
  1032. begin
  1033. { Also see Setup.ScriptFunc DownloadTemporaryFileWithISSigVerify }
  1034. DoAdd(GetISSigUrl(Url, ISSigUrl), BaseName + ISSigExt, '', UserName, Password, False, '', True, 0);
  1035. Result := DoAdd(Url, BaseName, '', UserName, Password, True, ISSigAllowedKeys, False, Data);
  1036. end;
  1037. procedure TDownloadWizardPage.Clear;
  1038. begin
  1039. FFiles.Clear;
  1040. end;
  1041. function TDownloadWizardPage.Download(const OnDownloadFileCompleted: TDownloadFileCompleted): Int64;
  1042. begin
  1043. FAbortedByUser := False;
  1044. Result := 0;
  1045. try
  1046. for var I := 0 to FFiles.Count-1 do begin
  1047. { Don't need to set DownloadTemporaryFileOrExtractArchiveProcessMessages before downloading since we already process messages ourselves }
  1048. const F = FFiles[I];
  1049. FLastBaseNameOrUrl := IfThen(FShowBaseNameInsteadOfUrl, PathExtractName(F.BaseName), F.Url);
  1050. SetDownloadTemporaryFileCredentials(F.UserName, F.Password);
  1051. var DestFile: String;
  1052. Result := Result + DownloadTemporaryFile(F.Url, F.BaseName, F.Verification,
  1053. InternalOnDownloadProgress, InternalOnDownloadNoProgress, DestFile);
  1054. if Assigned(OnDownloadFileCompleted) then begin
  1055. var Remove := False;
  1056. OnDownloadFileCompleted(F, DestFile, Remove);
  1057. if Remove then
  1058. FFiles[I] := nil;
  1059. end;
  1060. end;
  1061. finally
  1062. SetDownloadTemporaryFileCredentials('', '');
  1063. FFiles.Pack;
  1064. end;
  1065. end;
  1066. {--- Extraction ---}
  1067. procedure TExtractionWizardPage.AbortButtonClick(Sender: TObject);
  1068. begin
  1069. FAbortedByUser := LoggedMsgBox(SetupMessages[msgStopExtraction], '', mbConfirmation, MB_YESNO, True, ID_YES) = IDYES;
  1070. end;
  1071. function TExtractionWizardPage.InternalOnExtractionProgress(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
  1072. var
  1073. Progress32, ProgressMax32: LongInt;
  1074. begin
  1075. if FAbortedByUser then begin
  1076. Log('Need to abort extraction.');
  1077. Result := False;
  1078. end else begin
  1079. { Unlike TDownloadWizardPage we don't log progress here. This is because 7zMain.c already logs output dirs and names. }
  1080. FMsg2Label.Caption := IfThen(FShowArchiveInsteadOfFile, ArchiveName, FileName);
  1081. if ProgressMax > MaxLongInt then begin
  1082. Progress32 := Round((Progress / ProgressMax) * MaxLongInt);
  1083. ProgressMax32 := MaxLongInt;
  1084. end else begin
  1085. Progress32 := Progress;
  1086. ProgressMax32 := ProgressMax;
  1087. end;
  1088. SetProgress(Progress32, ProgressMax32); { This will process messages which we need for the abort button to work }
  1089. if FShowProgressControlsOnNextProgress then begin
  1090. ShowProgressControls(True);
  1091. FShowProgressControlsOnNextProgress := False;
  1092. ProcessMsgs;
  1093. end;
  1094. { This will call InternalThrottledOnExtractionProgress, which will call the script's FOnExtractionProgress, but throttled
  1095. Because it does nothing else we first check if FOnExtractionProgress is actually assigned }
  1096. if Assigned(FOnExtractionProgress) then begin
  1097. if FThrottler = nil then begin
  1098. const OnExtractionProgress: TOnExtractionProgress = InternalThrottledOnExtractionProgress;
  1099. FThrottler := TProgressThrottler.Create(OnExtractionProgress);
  1100. end;
  1101. Result := FThrottler.OnExtractionProgress(ArchiveName, FileName, Progress, ProgressMax);
  1102. end else
  1103. Result := True;
  1104. end;
  1105. end;
  1106. function TExtractionWizardPage.InternalThrottledOnExtractionProgress(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
  1107. begin
  1108. if Assigned(FOnExtractionProgress) then { Always True, see above }
  1109. Result := FOnExtractionProgress(ArchiveName, FileName, Progress, ProgressMax)
  1110. else
  1111. Result := True;
  1112. end;
  1113. constructor TExtractionWizardPage.Create(AOwner: TComponent);
  1114. begin
  1115. inherited;
  1116. FUseMarqueeStyle := True;
  1117. FArchives := TArchives.Create;
  1118. end;
  1119. destructor TExtractionWizardPage.Destroy;
  1120. begin
  1121. FThrottler.Free;
  1122. FArchives.Free;
  1123. inherited;
  1124. end;
  1125. procedure TExtractionWizardPage.Initialize;
  1126. begin
  1127. inherited;
  1128. FMsg1Label.Caption := SetupMessages[msgExtractingLabel];
  1129. FAbortButton := TNewButton.Create(Self);
  1130. with FAbortButton do begin
  1131. Caption := SetupMessages[msgButtonStopExtraction];
  1132. Top := FProgressBar.Top + FProgressBar.Height + WizardForm.ScalePixelsY(8);
  1133. Width := WizardForm.CalculateButtonWidth([Caption]);
  1134. Height := WizardForm.CancelButton.Height;
  1135. OnClick := AbortButtonClick;
  1136. end;
  1137. SetCtlParentAtBack(FAbortButton, Surface);
  1138. end;
  1139. procedure TExtractionWizardPage.Show;
  1140. begin
  1141. if WizardForm.CurPageID <> ID then begin
  1142. ShowProgressControls(False);
  1143. FShowProgressControlsOnNextProgress := True;
  1144. end;
  1145. inherited;
  1146. end;
  1147. procedure TExtractionWizardPage.ShowProgressControls(const AVisible: Boolean);
  1148. begin
  1149. FMsg2Label.Visible := AVisible;
  1150. FProgressBar.Visible := AVisible;
  1151. end;
  1152. function TExtractionWizardPage.Add(const ArchiveFileName, DestDir: String; const FullPaths: Boolean): Integer;
  1153. begin
  1154. Result := AddEx(ArchiveFileName, DestDir, '', FullPaths);
  1155. end;
  1156. function TExtractionWizardPage.AddEx(const ArchiveFileName, DestDir, Password: String; const FullPaths: Boolean): Integer;
  1157. begin
  1158. const A = TArchive.Create;
  1159. A.FileName := ArchiveFileName;
  1160. A.DestDir := DestDir;
  1161. A.Password := Password;
  1162. A.FullPaths := FullPaths;
  1163. Result := FArchives.Add(A);
  1164. end;
  1165. procedure TExtractionWizardPage.Clear;
  1166. begin
  1167. FArchives.Clear;
  1168. end;
  1169. procedure TExtractionWizardPage.Extract;
  1170. begin
  1171. FAbortedByUser := False;
  1172. try
  1173. for var A in FArchives do begin
  1174. { Don't need to set DownloadTemporaryFileOrExtractArchiveProcessMessages before extraction since we already process messages ourselves }
  1175. if SetupHeader.SevenZipLibraryName <> '' then
  1176. ExtractArchiveRedir(ScriptFuncDisableFsRedir, A.FileName, A.DestDir, A.Password, A.FullPaths, InternalOnExtractionProgress)
  1177. else
  1178. Extract7ZipArchiveRedir(ScriptFuncDisableFsRedir, A.FileName, A.DestDir, A.Password, A.FullPaths, InternalOnExtractionProgress);
  1179. end;
  1180. except
  1181. on E: EAbort do
  1182. raise Exception.Create(SetupMessages[msgErrorExtractionAborted])
  1183. else
  1184. raise Exception.Create(FmtSetupMessage1(msgErrorExtractionFailed, GetExceptMessage));
  1185. end;
  1186. end;
  1187. end.