Setup.ScriptDlg.pas 44 KB

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