📄 jvprogramversioncheck.pas
字号:
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 + -