Setup.ScriptDlg.pas 44 KB

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