Setup.WizardForm.CustomPages.pas 44 KB

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