⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvprogramversioncheck.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 5 页
字号:
end;

destructor TJvProgramVersionCheck.Destroy;
begin
  FreeAndNil(FRemoteProgramVersionHistory);
  FreeAndNil(FThreadDialog);
  FreeAndNil(FThread);
  FreeAndNil(FRemoteAppStorage);
  inherited Destroy;
end;

procedure TJvProgramVersionCheck.CheckLocalDirectory;
begin
  LocalDirectory := Trim(LocalDirectory);
  if LocalDirectory <> '' then
    if not DirectoryExists(LocalDirectory) then
      if not ForceDirectories(LocalDirectory) then
        LocalDirectory := '';
end;

function TJvProgramVersionCheck.CurrentApplicationName: string;
var
  FileVersionInfo: TJclFileVersionInfo;
begin
  FileVersionInfo := TJclFileVersionInfo.Create(ParamStr(0));
  try
    try
      Result := FileVersionInfo.ProductName;
    except
      Result := '';
    end;
    if Result = '' then
      Result := PathExtractFileNameNoExt(ParamStr(0));
  finally
    FileVersionInfo.Free;
  end;
end;

function TJvProgramVersionCheck.CurrentFileVersion: string;
var
  FileVersionInfo: TJclFileVersionInfo;
begin
  FileVersionInfo := TJclFileVersionInfo.Create(ParamStr(0));
  try
    try
      Result := FileVersionInfo.FileVersion;
    except
      Result := '';
    end;
  finally
    FileVersionInfo.Free;
  end;
end;

procedure TJvProgramVersionCheck.DownloadInstallerFromRemote;
begin
  if Assigned(FExecuteVersionInfo) then
  begin
    FThread.OnExecute := DownloadThreadOnExecute;
    FThread.OnFinishAll := DownloadThreadOnFinishAll;
    FThread.Execute(Self);
  end;
end;

procedure TJvProgramVersionCheck.DownloadThreadOnExecute(Sender: TObject; Params: Pointer);
begin
  if Assigned(FExecuteVersionInfo) then
  begin
    FExecuteDownloadInstallFileName :=
      LoadRemoteInstallerFile(LocalDirectory, LocalInstallerFileName,
      FExecuteVersionInfo, FThread.LastThread);
    if (FExecuteDownloadInstallFileName <> '') and
      not FileExists(FExecuteDownloadInstallFileName) then
      FExecuteDownloadInstallFileName := '';
  end;
end;

procedure TJvProgramVersionCheck.DownloadThreadOnFinishAll(Sender: TObject);
begin
  if FDownloadError <> '' then
    MessageDlg(FDownloadError, mtError, [mbOK], 0)
  else
  if FExecuteDownloadInstallFileName = '' then
    MessageDlg(RsPVCFileDownloadNotSuccessful, mtError, [mbOK], 0)
  else
  if FExecuteOperation = rvoCopy then
    MessageDlg(Format(RsPVCDownloadSuccessfulInstallManually,
      [FExecuteDownloadInstallFileName]), mtInformation, [mbOK], 0)
  else
  if MessageDlg(RsPVCDownloadSuccessfullInstallNow,
    mtWarning, [mbYes, mbNo], 0) = mrYes then
    if ShellExecEx(FExecuteDownloadInstallFileName) then
      Application.Terminate
    else
      MessageDlg(RsPVCErrorStartingSetup, mtError, [mbOK], 0);
end;

procedure TJvProgramVersionCheck.Execute;
var
  ReleaseType: TJvProgramReleaseType;
begin
  FExecuteVersionInfo := nil;
  LoadProperties;
  if (LastCheck < Now - CheckFrequency) and (LocationTypesSupported <> []) then
  begin
    LastCheck := Now;
    if not DirectoryExists(LocalDirectory) then
      if not ForceDirectories(LocalDirectory) then
        LocalDirectory := '';
    RemoteAppStorage.FileName :=
      LoadRemoteVersionInfoFile(LocalDirectory, LocalVersionInfoFileName);
    if RemoteAppStorage.FileName <> '' then
    begin
      RemoteProgramVersionHistory.LoadProperties;
      StoreProperties;
      StoreRemoteVersionInfoToFile;
      if IsRemoteProgramVersionNewer then
      begin
        FExecuteOperation := GetRemoteVersionOperation(ReleaseType);
        FExecuteVersionInfo :=
          RemoteProgramVersionHistory.CurrentProgramVersion[ReleaseType];
        if FExecuteOperation in [rvoCopy, rvoCopyInstall] then
          DownloadInstallerFromRemote;
      end;
    end;
  end;
end;

function TJvProgramVersionCheck.GetAllowedRemoteProgramVersion: string;
begin
  if Assigned(RemoteProgramVersionHistory.AllowedCurrentProgramVersion(AllowedReleaseType)) then
    Result := RemoteProgramVersionHistory.AllowedCurrentProgramVersion(AllowedReleaseType).ProgramVersion
  else
    Result := '';
end;

function TJvProgramVersionCheck.GetAllowedRemoteProgramVersionReleaseType: string;
begin
  if Assigned(RemoteProgramVersionHistory.AllowedCurrentProgramVersion(AllowedReleaseType)) then
    Result := RemoteProgramVersionHistory.AllowedCurrentProgramVersion(AllowedReleaseType).ProgramVersionReleaseType
  else
    Result := '';
end;

function TJvProgramVersionCheck.GetLocationTypesSupported: TJvProgramVersionLocationTypes;
begin
  Result := [];
  if Assigned(FLocationNetwork) then
    Result := Result + [pvltNetWork];
  if Assigned(FLocationDatabase) then
    Result := Result + [pvltDatabase];
  if Assigned(FLocationHTTP) then
    Result := Result + [pvltHTTP];
  if Assigned(FLocationFTP) then
    Result := Result + [pvltFTP];
end;

function TJvProgramVersionCheck.GetRemoteVersionOperation(
  var ReleaseType: TJvProgramReleaseType): TJvRemoteVersionOperation;
var
  ParameterList: TJvParameterList;
  GroupParameter: TJvGroupBoxParameter;
  Parameter: TJvBaseParameter;
  I: TJvProgramReleaseType;
begin
  Result := rvoIgnore;
  ParameterList := TJvParameterList.Create(Self);
  try
    ParameterList.MaxWidth := 460;
    ParameterList.Messages.Caption :=
      Format(RsPVCDialogCaption, [CurrentApplicationName]);
    ParameterList.Messages.OkButton := RsPVCDialogExecuteButton;
    Parameter := TJvBaseParameter(TJvLabelParameter.Create(ParameterList));
    with Parameter do
    begin
      SearchName := SParamNameNewVersionLabel;
      Caption := Format(RsPVCNewVersionAvailable,
        [GetAllowedRemoteProgramVersionReleaseType, CurrentApplicationName]);
      Width := 350;
      Height := 45;
    end;
    ParameterList.AddParameter(Parameter);
    GroupParameter := TJvGroupBoxParameter.Create(ParameterList);
    with GroupParameter do
    begin
      SearchName := SParamNameGroupBox;
      Caption := RsPVCChooseWhichVersion;
      Width := 350;
      Height := 10;
    end;
    ParameterList.AddParameter(GroupParameter);
    for I := High(I) downto Low(I) do
      if (I <= AllowedReleaseType) and
        Assigned(RemoteProgramVersionHistory.CurrentProgramVersion[I]) then
        if CompareVersionNumbers(CurrentFileVersion,
          RemoteProgramVersionHistory.CurrentProgramVersion[I].ProgramVersion) > 0 then
        begin
          Parameter := TJvBaseParameter(TJvRadioButtonParameter.Create(ParameterList));
          with Parameter do
          begin
            ParentParameterName := SParamNameGroupBox;
            SearchName := SParamNameRadioButton + IntToStr(Ord(I));
            Caption := RemoteProgramVersionHistory.CurrentProgramVersion[I].ProgramVersionInfo;
            Width := 250;
            AsBoolean := GroupParameter.Height <= 10;
          end;
          ParameterList.AddParameter(Parameter);
          Parameter := TJvBaseParameter(TJvButtonParameter.Create(ParameterList));
          with TJvButtonParameter(Parameter) do
          begin
            ParentParameterName := SParamNameGroupBox;
            SearchName := SParamNameVersionButtonInfo + IntToStr(Ord(I));
            Caption := RsPVInfoButtonCaption;
            Width := 80;
            Tag := Ord(I);
            OnClick := VersionInfoButtonClick;
          end;
          ParameterList.AddParameter(Parameter);
          GroupParameter.Height := GroupParameter.Height + 25;
        end;
    Parameter := TJvBaseParameter(TJvRadioGroupParameter.Create(ParameterList));
    with TJvRadioGroupParameter(Parameter) do
    begin
      SearchName := SParamNameOperation;
      Caption := RsPVCChooseOperation;
      ItemList.Add(RsPVCOperationIgnore);
      ItemList.Add(RsPVCOperationDownloadOnly);
      ItemList.Add(RsPVCOperationDownloadInstall);
      ItemIndex := 2;
      Width := 350;
      Height := 79;
    end;
    ParameterList.AddParameter(Parameter);
    if ParameterList.ShowParameterDialog then
    begin
      case TJvRadioGroupParameter(ParameterList.ParameterByName(SParamNameOperation)).ItemIndex of
        0:
          Result := rvoIgnore;
        1:
          Result := rvoCopy;
        2:
          Result := rvoCopyInstall;
      end;
      ReleaseType := prtProduction;
      for I := High(I) downto Low(I) do
        if IsRemoteProgramVersionReleaseTypeNewer(I) then
        begin
          Parameter := ParameterList.ParameterByName(SParamNameRadioButton + IntToStr(Ord(I)));
          if Assigned(Parameter) then
            if Parameter.AsBoolean then
            begin
              ReleaseType := I;
              Break;
            end;
        end;
    end;
  finally
    ParameterList.Free;
  end;
end;

function TJvProgramVersionCheck.IsRemoteProgramVersionNewer: Boolean;
begin
  Result := CompareVersionNumbers(CurrentFileVersion, GetAllowedRemoteProgramVersion) = 1;
end;

function TJvProgramVersionCheck.IsRemoteProgramVersionReleaseTypeNewer(AReleaseType: TJvProgramReleaseType): Boolean;
begin
  if Assigned(RemoteProgramVersionHistory.CurrentProgramVersion[AReleaseType]) then
    Result := CompareVersionNumbers(CurrentFileVersion,
      RemoteProgramVersionHistory.CurrentProgramVersion[AReleaseType].ProgramVersion) = 1
  else
    Result := False;
end;

procedure TJvProgramVersionCheck.LoadData;
begin
  inherited LoadData;
  LastCheck := AppStorage.ReadDateTime(AppStorage.ConcatPaths([AppStoragePath, SLastCheck]), LastCheck);
end;

function TJvProgramVersionCheck.LoadRemoteInstallerFile(const ALocalDirectory, ALocalInstallerFileName: string;
  AProgramVersionInfo: TJvProgramVersionInfo; ABaseThread: TJvBaseThread): string;
begin
  if Assigned(AProgramVersionInfo) and (SelectedLocation <> nil) then
  begin
    Result := SelectedLocation.LoadInstallerFileFromRemote(AProgramVersionInfo.ProgramLocationPath,
      AProgramVersionInfo.ProgramLocationFileName, ALocalDirectory, ALocalInstallerFileName, ABaseThread);
    FDownloadError := SelectedLocation.DownloadError;
  end
  else                                     
    Result := '';
end;

function TJvProgramVersionCheck.LoadRemoteVersionInfoFile(
  const ALocalDirectory, ALocalVersionInfoFileName: string): string;
begin
  if SelectedLocation <> nil then
    Result := SelectedLocation.LoadVersionInfoFromRemote(ALocalDirectory, ALocalVersionInfoFileName, nil)
  else
    Result := '';
end;

procedure TJvProgramVersionCheck.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);

  if Operation = opRemove then
    if AComponent = FLocationNetwork then
      FLocationNetwork := nil
    else
    if AComponent = FLocationDatabase then
      FLocationDatabase := nil
    else
    if AComponent = FLocationHTTP then
      FLocationHTTP := nil
    else
    if AComponent = FLocationFTP then
      FLocationFTP := nil
end;

function TJvProgramVersionCheck.SelectedLocation: TJvCustomProgramVersionLocation;
begin
  case LocationType of
    pvltDatabase:
      Result := LocationDatabase;
    pvltHTTP:
      Result := LocationHTTP;
    pvltFTP:
      Result := LocationFTP;
    pvltNetwork:
      Result := LocationNetwork;
  else
    Result := nil;
  end
end;

procedure TJvProgramVersionCheck.SetThreadInfo(const Info: string);
begin
  if Assigned(FThreadDialog) then
    FThreadDialog.DialogOptions.InfoText := Info;
end;

procedure TJvProgramVersionCheck.SetUserOptions(Value: TJvProgramVersionUserOptions);
begin
  FUserOptions := Value;
  IgnoreProperties.AddDelete('CheckFrequency', (uoCheckFrequency in Value));
  IgnoreProperties.AddDelete('LocalDirectory', (uoLocalDirectory in Value));
  IgnoreProperties.AddDelete('AllowedReleaseType', (uoAllowedReleaseType in Value));
  IgnoreProperties.AddDelete('LocationType', (uoLocationType in Value));
  IgnoreProperties.AddDelete('LocationNetwork', (uoLocationNetwork in Value));
  IgnoreProperties.AddDelete('LocationHTTP', (uoLocationHTTP in Value));
  IgnoreProperties.AddDelete('LocationFTP', (uoLocationFTP in Value));
  IgnoreProperties.AddDelete('LocationDatabase', (uoLocationDatabase in Value));
end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -