{$IFNDEF CLR} {$I Dac.inc} unit Download; {$ENDIF} interface uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, Buttons, ExtCtrls, Registry; type TDownloadForm = class(TForm) OKBtn: TButton; CancelBtn: TButton; Bevel1: TBevel; chkDontAsk: TCheckBox; Image: TImage; lblQuestion: TLabel; btHelp: TButton; lblText1: TLabel; lblText3: TLabel; lblProduct: TLabel; lblText2: TLabel; lblText3Wrap: TLabel; procedure FormShow(Sender: TObject); procedure OKBtnClick(Sender: TObject); procedure btHelpClick(Sender: TObject); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure lblProductMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure lblProductClick(Sender: TObject); private { Private declarations } public { Public declarations } end; procedure SetToolsCheckingParams(const ADialogCaptionStr, AToolsNameStr, AProjectVersionStr, AAskIncompatibleStr, AAskNoAddinStr, ARegKeyStr, AHelpProjectStr, AHelpTopicStr, AUrlStr, AUrlExeStr, AAtomName: string; const ADeveloperProjectNameStr: string = ''); function NoCheckForTools(Incompatible: boolean; ARegIniFile: TRegIniFile = nil): boolean; procedure CheckForTools(Incompatible: boolean); function DownloadTools(ProVersion: boolean): boolean; implementation uses ShellApi, DacVcl, HelpUtils; {$IFDEF IDE} {$R *.dfm} {$ENDIF} {$IFNDEF LINUX} {$R Download.dfm} {$ENDIF} resourcestring sToolsWrongVersion1 = 'Current version of '; sToolsWrongVersion2 = ' is incompatible with'; sNoTools1 = 'You don''t have '; sNoTools2 = ' installed.'; sToolsDownloadQuestion = 'Do you wish to download the latest %s version?'; sDeveloperEdition1 = 'If you have '; sDeveloperEdition2 = ', you can'; sDeveloperEdition3 = 'download full version of %s. ' + 'Please consult your order confirmation email for more information.'; sDeveloperEditionQuestion = 'Do you wish download a trial version of %s?'; var DialogCaptionStr, ToolsNameStr, ProjectVersionStr, AskIncompatibleStr, AskNoAddinStr, RegKeyStr, HelpProjectStr, HelpTopicStr, UrlStr, UrlExeStr, AtomName, DeveloperProjectNameStr: string; AddedAtoms: array of ATOM; procedure SetToolsCheckingParams(const ADialogCaptionStr, AToolsNameStr, AProjectVersionStr, AAskIncompatibleStr, AAskNoAddinStr, ARegKeyStr, AHelpProjectStr, AHelpTopicStr, AUrlStr, AUrlExeStr, AAtomName: string; const ADeveloperProjectNameStr: string = ''); begin DialogCaptionStr := ADialogCaptionStr; ToolsNameStr := AToolsNameStr; ProjectVersionStr := AProjectVersionStr; AskIncompatibleStr := AAskIncompatibleStr; AskNoAddinStr := AAskNoAddinStr; RegKeyStr := ARegKeyStr; HelpProjectStr := AHelpProjectStr; HelpTopicStr := AHelpTopicStr; UrlStr := AUrlStr; UrlExeStr := 'http://' + AUrlStr + '/' + AUrlExeStr; AtomName := AAtomName; DeveloperProjectNameStr := ADeveloperProjectNameStr; end; function NoCheckForTools(Incompatible: boolean; ARegIniFile: TRegIniFile = nil): boolean; var RegIniFile: TRegIniFile; begin if ARegIniFile = nil then RegIniFile := TRegIniFile.Create(RegKeyStr) else RegIniFile := ARegIniFile; if Incompatible then Result := not RegIniFile.ReadBool('', AskIncompatibleStr, True) else Result := not RegIniFile.ReadBool('', AskNoAddinStr, True); if ARegIniFile = nil then RegIniFile.Free; end; procedure CheckForTools(Incompatible: boolean); var RegIniFile: TRegIniFile; begin RegIniFile := TRegIniFile.Create(RegKeyStr); with TDownloadForm.Create(Application) do try try if AtomName <> '' then if FindAtom({$IFDEF WIN32}PChar(AtomName){$ELSE}AtomName{$ENDIF}) = 0 then begin SetLength(AddedAtoms, Length(AddedAtoms) + 1); AddedAtoms[High(AddedAtoms)] := AddAtom({$IFDEF WIN32}PChar(AtomName){$ELSE}AtomName{$ENDIF}); end else Exit; if not NoCheckForTools(Incompatible, RegIniFile) then begin if Incompatible then begin lblText1.Caption := sToolsWrongVersion1; lblText2.Caption := sToolsWrongVersion2; lblText3.Caption := ProjectVersionStr + '.'; end else begin lblText1.Caption := sNoTools1; lblText2.Caption := sNoTools2; lblText3.Caption := ''; end; lblProduct.Left := lblText1.Left + lblText1.Width; lblProduct.Caption := ToolsNameStr; if lblProduct.Left + lblProduct.Width + lblText2.Width > ClientWidth - 8 then begin lblText2.Caption := Trim(lblText2.Caption) + ' '; lblText2.Top := lblText1.Top + 13; lblText2.Left := lblText1.Left; lblText3.Left := lblText2.Left + lblText2.Width; end else begin lblText2.Top := lblText1.Top; lblText2.Left := lblProduct.Left + lblProduct.Width; lblText3.Left := lblText1.Left; end; lblQuestion.Caption := Format(sToolsDownloadQuestion, [ToolsNameStr]); ShowModal; if Incompatible then RegIniFile.WriteBool('', AskIncompatibleStr, not chkDontAsk.Checked) else RegIniFile.WriteBool('', AskNoAddinStr, not chkDontAsk.Checked); end; finally Free; RegIniFile.Free; end; except on E: Exception do MessageBox(0, {$IFDEF WIN32}PChar(E.Message){$ELSE}E.Message{$ENDIF}, 'Add-in ñheck error!', 0); end; end; function DownloadTools(ProVersion: boolean): boolean; begin if ProVersion then with TDownloadForm.Create(Application) do try chkDontAsk.Visible := False; Result := ShowModal = mrYes; finally Free; end else begin Result := True; OpenUrl(UrlExeStr); end; end; procedure TDownloadForm.FormShow(Sender: TObject); begin Caption := DialogCaptionStr; Image.Picture.Icon.Handle := LoadIcon(0, IDI_QUESTION); if (DeveloperProjectNameStr = '') or not chkDontAsk.Visible then OKBtn.ModalResult := mrYes else OKBtn.ModalResult := mrNone; if not chkDontAsk.Visible then begin lblText3.Visible := False; lblText3Wrap.Visible := True; lblProduct.ParentFont := True; lblProduct.Font.Style := [fsBold]; Height := Height + 26; lblText1.Caption := sDeveloperEdition1; lblProduct.Cursor := crDefault; lblProduct.Left := lblText1.Left + lblText1.Width; lblProduct.Caption := DeveloperProjectNameStr; lblText2.Caption := sDeveloperEdition2; lblText2.Left := lblProduct.Left + lblProduct.Width; lblText3Wrap.Caption := Format(sDeveloperEdition3, [ToolsNameStr]); lblQuestion.Caption := Format(sDeveloperEditionQuestion, [ToolsNameStr]); end; end; procedure TDownloadForm.OKBtnClick(Sender: TObject); begin if OKBtn.ModalResult = mrYes then OpenUrl(UrlExeStr) else if DownloadTools(True) then Close; end; procedure TDownloadForm.btHelpClick(Sender: TObject); begin if HelpTopicStr <> '' then {$IFDEF VER8P} ShowHelp('ms-help://CoreLab.' + HelpProjectStr, Format('ms-help://CoreLab.%s/%s/%s.htm', [HelpProjectStr, HelpProjectStr, HelpTopicStr])); {$ELSE} ShowHelp(GetHelpFileName(HelpProjectStr), HelpTopicStr); {$ENDIF} end; procedure TDownloadForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if chkDontAsk.Visible then lblProduct.Font.Color := $FF0000; end; procedure TDownloadForm.lblProductMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if chkDontAsk.Visible then lblProduct.Font.Color := $4080FF; end; procedure TDownloadForm.lblProductClick(Sender: TObject); begin if chkDontAsk.Visible then begin OpenUrl('http://' + UrlStr); lblProduct.Font.Color := $FF0000; end; end; procedure DeleteAddedAtoms; var i: integer; begin for i := 0 to High(AddedAtoms) do DeleteAtom(AddedAtoms[i]); end; initialization finalization DeleteAddedAtoms; end.