mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-04 02:40:00 +01:00
Update feature, partially implemented(part2).
git-svn-id: trunk@53564 -
This commit is contained in:
balazs
parent
612a26c207
commit
d6392d8f24
@ -110,6 +110,7 @@ type
|
||||
procedure DoOnJSONProgress(Sender: TObject);
|
||||
procedure DoOnJSONDownloadCompleted(Sender: TObject; AJSON: TJSONStringType; AErrTyp: TErrorType; const AErrMsg: String = '');
|
||||
procedure DoOnProcessJSON(Sender: TObject);
|
||||
procedure DoOnUpdate(Sender: TObject);
|
||||
function IsSomethingChecked(const AIsUpdate: Boolean = False): Boolean;
|
||||
function Download(const ADstDir: String; var ADoExtract: Boolean): TModalResult;
|
||||
function Extract(const ASrcDir, ADstDir: String; var ADoOpen: Boolean; const AIsUpdate: Boolean = False): TModalResult;
|
||||
@ -144,6 +145,7 @@ begin
|
||||
PackageDownloader.OnJSONProgress := @DoOnJSONProgress;
|
||||
PackageDownloader.OnJSONDownloadCompleted := @DoOnJSONDownloadCompleted;
|
||||
Updates := TUpdates.Create(LocalRepositoryUpdatesFile);
|
||||
Updates.OnUpdate := @DoOnUpdate;
|
||||
InstallPackageList := TObjectList.Create(True);
|
||||
FHintTimeOut := Application.HintHidePause;
|
||||
Application.HintHidePause := 1000000;
|
||||
@ -325,6 +327,11 @@ begin
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
|
||||
procedure TMainFrm.DoOnUpdate(Sender: TObject);
|
||||
begin
|
||||
VisualTree.UpdatePackageUStatus;
|
||||
end;
|
||||
|
||||
procedure TMainFrm.ShowOptions;
|
||||
begin
|
||||
OptionsFrm := TOptionsFrm.Create(MainFrm);
|
||||
|
||||
@ -1,9 +1,3 @@
|
||||
unit opkman_options;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
{
|
||||
***************************************************************************
|
||||
* *
|
||||
@ -26,6 +20,12 @@ interface
|
||||
|
||||
Author: Balázs Székely
|
||||
}
|
||||
unit opkman_options;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LazIDEIntf, Laz2_XMLCfg, LazFileUtils;
|
||||
|
||||
|
||||
@ -189,6 +189,7 @@ type
|
||||
FHomePageURL: String;
|
||||
FDownloadURL: String;
|
||||
FForceUpdate: Boolean;
|
||||
FDownloadZipURL: String;
|
||||
FSVNURL: String;
|
||||
FUpdateSize: Int64;
|
||||
FIsDirZipped: Boolean;
|
||||
@ -199,6 +200,7 @@ type
|
||||
constructor Create; reintroduce;
|
||||
destructor Destroy; override;
|
||||
procedure ChangePackageStates(const AChangeType: TChangeType; APackageState: TPackageState);
|
||||
function FindPackageFile(const APackageFileName: String): TPackageFile;
|
||||
public
|
||||
property PackageStates: TPackageStates read FPackageStates;
|
||||
property PackageState: TPackageState read FPackageState;
|
||||
@ -207,6 +209,7 @@ type
|
||||
property UpdateSize: Int64 read FUpdateSize write FUpdateSize;
|
||||
property IsDirZipped: Boolean read FIsDirZipped write FIsDirZipped;
|
||||
property ForceUpdate: Boolean read FForceUpdate write FForceUpdate;
|
||||
property DownloadZipURL: String read FDownloadZipURL write FDownloadZipURL;
|
||||
published
|
||||
property Name: String read FName write FName;
|
||||
property DisplayName: String read FDisplayName write FDisplayName;
|
||||
@ -630,6 +633,21 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPackage.FindPackageFile(const APackageFileName: String): TPackageFile;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
for I := 0 to FPackageFiles.Count - 1 do
|
||||
begin
|
||||
if UpperCase(TPackageFile(FPackageFiles.Items[I]).Name) = UpperCase(APackageFileName) then
|
||||
begin
|
||||
Result := TPackageFile(FPackageFiles.Items[I]);
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TSerializablePackages }
|
||||
|
||||
constructor TSerializablePackages.Create;
|
||||
@ -771,8 +789,8 @@ begin
|
||||
for I := 0 to Count - 1 do
|
||||
begin
|
||||
case AFindPackageBy of
|
||||
fpbPackageName: NeedToBreak := Items[I].Name = AValue;
|
||||
fpbRepositoryFilename: NeedToBreak := Items[I].RepositoryFileName = AValue
|
||||
fpbPackageName: NeedToBreak := UpperCase(Items[I].Name) = UpperCase(AValue);
|
||||
fpbRepositoryFilename: NeedToBreak := UpperCase(Items[I].RepositoryFileName) = UpperCase(AValue)
|
||||
end;
|
||||
if NeedToBreak then
|
||||
begin
|
||||
@ -813,7 +831,7 @@ begin
|
||||
begin
|
||||
for J := 0 to Items[I].FPackageFiles.Count - 1 do
|
||||
begin
|
||||
if TPackageFile(Items[I].FPackageFiles.Items[J]).Name = APackageFileName then
|
||||
if UpperCase(TPackageFile(Items[I].FPackageFiles.Items[J]).Name) = UpperCase(APackageFileName) then
|
||||
begin
|
||||
Result := TPackageFile(Items[I].FPackageFiles.Items[J]);
|
||||
Break;
|
||||
|
||||
@ -5,48 +5,88 @@ unit opkman_updates;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LazIDEIntf, Laz2_XMLCfg, LazFileUtils, fpjson,
|
||||
opkman_httpclient, opkman_timer,
|
||||
|
||||
dialogs;
|
||||
Classes, SysUtils, LazIDEIntf, Laz2_XMLCfg, LazFileUtils, fpjson, fpjsonrtti,
|
||||
opkman_httpclient, opkman_timer;
|
||||
|
||||
const
|
||||
OpkVersion = 1;
|
||||
UpdateInterval = 6000;
|
||||
|
||||
type
|
||||
TUpdateInfo = record
|
||||
FPackageName: String;
|
||||
FPackageFileName: String;
|
||||
FUpdateVersion: String;
|
||||
FForceUpdate: Boolean;
|
||||
|
||||
{ TUpdatePackageFiles }
|
||||
|
||||
TUpdatePackageFiles = class(TCollectionItem)
|
||||
private
|
||||
FName: String;
|
||||
FVersion: String;
|
||||
published
|
||||
property Name: String read FName write FName;
|
||||
property Version: String read FVersion write FVersion;
|
||||
end;
|
||||
|
||||
{ TUpdatePackageData }
|
||||
|
||||
TUpdatePackageData = class(TPersistent)
|
||||
private
|
||||
FDownloadZipURL: String;
|
||||
FForceUpdate: boolean;
|
||||
FName: String;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
published
|
||||
property Name: String read FName write FName;
|
||||
property ForceUpdate: boolean read FForceUpdate write FForceUpdate;
|
||||
property DownloadZipURL: String read FDownloadZipURL write FDownloadZipURL;
|
||||
end;
|
||||
|
||||
{TUpdatePackage}
|
||||
|
||||
TUpdatePackage = class(TPersistent)
|
||||
private
|
||||
FUpdatePackageData: TUpdatePackageData;
|
||||
FUpdatePackageFiles: TCollection;
|
||||
procedure Clear;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function LoadFromJSON(const AJSON: TJSONStringType): boolean;
|
||||
published
|
||||
property UpdatePackageData: TUpdatePackageData read FUpdatePackageData write FUpdatePackageData;
|
||||
property UpdatePackageFiles: TCollection read FUpdatePackageFiles write FUpdatePackageFiles;
|
||||
end;
|
||||
|
||||
{ TUpdates }
|
||||
|
||||
TUpdates = class(TThread)
|
||||
private
|
||||
FXML: TXMLConfig;
|
||||
FHTTPClient: TFPHTTPClient;
|
||||
FTimer: TThreadTimer;
|
||||
FUpdatePackage: TUpdatePackage;
|
||||
FStarted: Boolean;
|
||||
FVersion: Integer;
|
||||
FNeedToBreak: Boolean;
|
||||
FNeedToUpdate: Boolean;
|
||||
FBusyUpdating: Boolean;
|
||||
procedure SetUpdateInfo(const AUpdateInfo: TUpdateInfo);
|
||||
FOnUpdate: TNotifyEvent;
|
||||
FPaused: Boolean;
|
||||
function GetUpdateInfo(const AURL: String; var AJSON: TJSONStringType): Boolean;
|
||||
function ParseJSON(const AJSON: TJSONStringType; var AUpdateInfo: TUpdateInfo): Boolean;
|
||||
procedure DoOnTimer(Sender: TObject);
|
||||
procedure DoOnUpdate;
|
||||
procedure Load;
|
||||
procedure Save;
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
procedure Load;
|
||||
procedure Save;
|
||||
constructor Create(const AFileName: String);
|
||||
destructor Destroy; override;
|
||||
procedure StartUpdate;
|
||||
procedure StopUpdate;
|
||||
published
|
||||
property Paused: Boolean read FPaused write FPaused;
|
||||
property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
|
||||
end;
|
||||
|
||||
var
|
||||
@ -56,6 +96,73 @@ implementation
|
||||
|
||||
uses opkman_serializablepackages, opkman_options, opkman_common;
|
||||
|
||||
{ TUpdatePackage }
|
||||
|
||||
procedure TUpdatePackage.Clear;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
FUpdatePackageData.Clear;
|
||||
for I := FUpdatePackageFiles.Count - 1 downto 0 do
|
||||
FUpdatePackageFiles.Items[I].Free;
|
||||
FUpdatePackageFiles.Clear;
|
||||
end;
|
||||
|
||||
constructor TUpdatePackage.Create;
|
||||
begin
|
||||
FUpdatePackageData := TUpdatePackageData.Create;
|
||||
FUpdatePackageFiles := TCollection.Create(TUpdatePackageFiles);
|
||||
end;
|
||||
|
||||
destructor TUpdatePackage.Destroy;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
FUpdatePackageData.Free;
|
||||
for I := FUpdatePackageFiles.Count - 1 downto 0 do
|
||||
FUpdatePackageFiles.Items[I].Free;
|
||||
FUpdatePackageFiles.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TUpdatePackage.LoadFromJSON(const AJSON: TJSONStringType): boolean;
|
||||
var
|
||||
DeStreamer: TJSONDeStreamer;
|
||||
begin
|
||||
DeStreamer := TJSONDeStreamer.Create(nil);
|
||||
try
|
||||
Clear;
|
||||
try
|
||||
DeStreamer.JSONToObject(AJSON, Self);
|
||||
Result := True;
|
||||
except
|
||||
Result := False;
|
||||
end;
|
||||
finally
|
||||
DeStreamer.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TUpdatePackageData }
|
||||
|
||||
constructor TUpdatePackageData.Create;
|
||||
begin
|
||||
Clear;
|
||||
end;
|
||||
|
||||
destructor TUpdatePackageData.Destroy;
|
||||
begin
|
||||
//
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TUpdatePackageData.Clear;
|
||||
begin
|
||||
FName := '';
|
||||
FForceUpdate := False;
|
||||
FDownloadZipURL := '';
|
||||
end;
|
||||
|
||||
{ TUpdates }
|
||||
|
||||
constructor TUpdates.Create(const AFileName: String);
|
||||
@ -71,6 +178,7 @@ begin
|
||||
FHTTPClient.Proxy.UserName:= Options.ProxyUser;
|
||||
FHTTPClient.Proxy.Password:= Options.ProxyPassword;
|
||||
end;
|
||||
FUpdatePackage := TUpdatePackage.Create;
|
||||
FTimer := nil;
|
||||
end;
|
||||
|
||||
@ -84,53 +192,38 @@ begin
|
||||
FTimer.Terminate;
|
||||
end;
|
||||
FHTTPClient.Free;
|
||||
FUpdatePackage.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TUpdates.SetUpdateInfo(const AUpdateInfo: TUpdateInfo);
|
||||
var
|
||||
I, J: Integer;
|
||||
Package: TPackage;
|
||||
PackageFile: TPackageFile;
|
||||
begin
|
||||
for I := 0 to SerializablePackages.Count - 1 do
|
||||
begin
|
||||
Package := SerializablePackages.Items[I];
|
||||
for J := 0 to SerializablePackages.Items[I].PackageFiles.Count - 1 do
|
||||
begin
|
||||
PackageFile := TPackageFile(SerializablePackages.Items[I].PackageFiles.Items[J]);
|
||||
if (UpperCase(Package.Name) = UpperCase(AUpdateInfo.FPackageName)) and
|
||||
(UpperCase(PackageFile.Name) = UpperCase(AUpdateInfo.FPackageFileName)) then
|
||||
begin
|
||||
Package.ForceUpdate := AUpdateInfo.FForceUpdate;
|
||||
PackageFile.UpdateVersion := AUpdateInfo.FUpdateVersion;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TUpdates.Load;
|
||||
var
|
||||
Count: Integer;
|
||||
I: Integer;
|
||||
Path: String;
|
||||
UpdateInfo: TUpdateInfo;
|
||||
PackageName: String;
|
||||
PackageFileName: String;
|
||||
Package: TPackage;
|
||||
PackageFile: TPackageFile;
|
||||
begin
|
||||
FVersion := FXML.GetValue('Version/Value', 0);
|
||||
Count := FXML.GetValue('Count/Value', 0);
|
||||
for I := 0 to Count - 1 do
|
||||
begin
|
||||
Path := 'Item' + IntToStr(I);
|
||||
with UpdateInfo do
|
||||
PackageName := FXML.GetValue('Items/' + Path + '/PackageName', '');
|
||||
Package := SerializablePackages.FindPackage(PackageName, fpbPackageName);
|
||||
if Package <> nil then
|
||||
begin
|
||||
FPackageName := FXML.GetValue('Items/' + Path + '/PackageName', '');
|
||||
FForceUpdate := FXML.GetValue('Items/' + Path + '/ForceUpdate', False);
|
||||
FPackageFileName := FXML.GetValue('Items/' + Path + '/PackageFileName', '');
|
||||
FUpdateVersion := FXML.GetValue('Items/' + Path + '/UpdateVersion', '');
|
||||
Package.ForceUpdate := FXML.GetValue('Items/' + Path + '/ForceUpdate', False);
|
||||
Package.DownloadZipURL := FXML.GetValue('Items/' + Path + '/DownloadZipURL', '');
|
||||
end;
|
||||
SetUpdateInfo(UpdateInfo);
|
||||
PackageFileName := FXML.GetValue('Items/' + Path + '/PackageFileName', '');
|
||||
PackageFile := Package.FindPackageFile(PackageFileName);
|
||||
if PackageFile <> nil then
|
||||
PackageFile.UpdateVersion := FXML.GetValue('Items/' + Path + '/UpdateVersion', '');
|
||||
end;
|
||||
Synchronize(@DoOnUpdate);
|
||||
end;
|
||||
|
||||
procedure TUpdates.Save;
|
||||
@ -155,11 +248,12 @@ begin
|
||||
PackageFile := TPackageFile(SerializablePackages.Items[I].PackageFiles.Items[J]);
|
||||
FXML.SetDeleteValue('Items/' + Path + '/PackageName', Package.Name, '');
|
||||
FXML.SetDeleteValue('Items/' + Path + '/ForceUpdate', Package.ForceUpdate, False);
|
||||
FXML.SetDeleteValue('Items/' + Path + '/DownloadZipURL', Package.DownloadZipURL, '');
|
||||
FXML.SetDeleteValue('Items/' + Path + '/PackageFileName', PackageFile.Name, '');
|
||||
FXML.SetDeleteValue('Items/' + Path + '/UpdateVersion', PackageFile.UpdateVersion, '');
|
||||
end;
|
||||
end;
|
||||
FXML.SetDeleteExtendedValue('Count/Value', Count, 0);
|
||||
FXML.SetDeleteValue('Count/Value', Count, 0);
|
||||
FXML.Flush;
|
||||
end;
|
||||
|
||||
@ -171,16 +265,14 @@ end;
|
||||
|
||||
function TUpdates.GetUpdateInfo(const AURL: String; var AJSON: TJSONStringType): Boolean;
|
||||
var
|
||||
URL: string;
|
||||
URL: String;
|
||||
Ms: TMemoryStream;
|
||||
begin
|
||||
Result := False;
|
||||
if Trim(AURL) = '' then
|
||||
Exit;
|
||||
|
||||
if Pos('update.json', AURL) = 0 then
|
||||
if Pos('.json', AURL) = 0 then
|
||||
Exit;
|
||||
|
||||
URL := FixProtocol(AURL);
|
||||
Ms := TMemoryStream.Create;
|
||||
try
|
||||
@ -202,39 +294,60 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUpdates.ParseJSON(const AJSON: TJSONStringType; var AUpdateInfo: TUpdateInfo): Boolean;
|
||||
procedure TUpdates.DoOnUpdate;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if Assigned(FOnUpdate) then
|
||||
FOnUpdate(Self);
|
||||
end;
|
||||
|
||||
procedure TUpdates.Execute;
|
||||
var
|
||||
I: Integer;
|
||||
UpdateInfo: TUpdateInfo;
|
||||
I, J: Integer;
|
||||
JSON: TJSONStringType;
|
||||
PackageFile: TPackageFile;
|
||||
NeedToUpdate: Boolean;
|
||||
begin
|
||||
Load;
|
||||
while not Terminated do
|
||||
begin
|
||||
if (FNeedToUpdate) and (not FBusyUpdating) then
|
||||
if (FNeedToUpdate) and (not FBusyUpdating) and (not FPaused) then
|
||||
begin
|
||||
NeedToUpdate := False;
|
||||
FBusyUpdating := True;
|
||||
try
|
||||
for I := 0 to SerializablePackages.Count - 1 do
|
||||
begin
|
||||
if not FNeedToBreak then
|
||||
if FPaused then
|
||||
Break;
|
||||
if (not FNeedToBreak) then
|
||||
begin
|
||||
JSON := '';
|
||||
if GetUpdateInfo(SerializablePackages.Items[I].DownloadURL, JSON) then
|
||||
begin
|
||||
if ParseJSON(JSON, UpdateInfo) then
|
||||
if FUpdatePackage.LoadFromJSON(JSON) then
|
||||
begin
|
||||
SetUpdateInfo(UpdateInfo);
|
||||
SerializablePackages.Items[I].DownloadZipURL := FUpdatePackage.FUpdatePackageData.DownloadZipURL;
|
||||
SerializablePackages.Items[I].ForceUpdate := FUpdatePackage.FUpdatePackageData.ForceUpdate;
|
||||
NeedToUpdate := FUpdatePackage.FUpdatePackageData.ForceUpdate = True;
|
||||
for J := 0 to FUpdatePackage.FUpdatePackageFiles.Count - 1 do
|
||||
begin
|
||||
PackageFile := SerializablePackages.Items[I].FindPackageFile(TUpdatePackageFiles(FUpdatePackage.FUpdatePackageFiles.Items[J]).Name);
|
||||
if PackageFile <> nil then
|
||||
begin
|
||||
if not NeedToUpdate then
|
||||
NeedToUpdate := TUpdatePackageFiles(FUpdatePackage.FUpdatePackageFiles.Items[J]).Version > PackageFile.UpdateVersion;
|
||||
PackageFile.UpdateVersion := TUpdatePackageFiles(FUpdatePackage.FUpdatePackageFiles.Items[J]).Version;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
FHTTPClient.NeedToBreak := True;
|
||||
end;
|
||||
if (NeedToUpdate) and (not FNeedToBreak) and (not FPaused) then
|
||||
if Assigned(FOnUpdate) then
|
||||
Synchronize(@DoOnUpdate);
|
||||
finally
|
||||
FBusyUpdating := False;
|
||||
FNeedToUpdate := False;
|
||||
@ -248,6 +361,7 @@ begin
|
||||
if FStarted then
|
||||
Exit;
|
||||
FStarted := True;
|
||||
FPaused := False;
|
||||
Load;
|
||||
FTimer := TThreadTimer.Create;
|
||||
FTimer.Interval := UpdateInterval;
|
||||
|
||||
@ -61,6 +61,9 @@ type
|
||||
RepositoryDate: TDate;
|
||||
HomePageURL: String;
|
||||
DownloadURL: String;
|
||||
DownloadZipURL: String;
|
||||
ForceUpadate: Boolean;
|
||||
HasUpdate: Boolean;
|
||||
SVNURL: String;
|
||||
IsInstalled: Boolean;
|
||||
ButtonID: Integer;
|
||||
@ -134,6 +137,7 @@ type
|
||||
procedure CollapseEx;
|
||||
procedure GetPackageList;
|
||||
procedure UpdatePackageStates;
|
||||
procedure UpdatePackageUStatus;
|
||||
function ResolveDependencies: TModalResult;
|
||||
published
|
||||
property OnChecking: TOnChecking read FOnChecking write FOnChecking;
|
||||
@ -178,6 +182,7 @@ begin
|
||||
Position := 1;
|
||||
Alignment := taCenter;
|
||||
Width := 80;
|
||||
Options := Options - [coResizable];
|
||||
Text := rsMainFrm_VSTHeaderColumn_Installed;
|
||||
end;
|
||||
with Header.Columns.Add do
|
||||
@ -185,6 +190,7 @@ begin
|
||||
Position := 2;
|
||||
Alignment := taCenter;
|
||||
Width := 85;
|
||||
Options := Options - [coResizable];
|
||||
Text := rsMainFrm_VSTHeaderColumn_Repository;
|
||||
end;
|
||||
with Header.Columns.Add do
|
||||
@ -192,6 +198,7 @@ begin
|
||||
Position := 3;
|
||||
Alignment := taCenter;
|
||||
Width := 80;
|
||||
Options := Options - [coResizable];
|
||||
Text := rsMainFrm_VSTHeaderColumn_Update;
|
||||
end;
|
||||
with Header.Columns.Add do
|
||||
@ -204,6 +211,7 @@ begin
|
||||
begin
|
||||
Position := 5;
|
||||
Width := 25;
|
||||
Options := Options - [coResizable];
|
||||
Text := rsMainFrm_VSTHeaderColumn_Button;
|
||||
Options := Options - [coResizable];
|
||||
end;
|
||||
@ -287,6 +295,7 @@ begin
|
||||
Data^.PackageDisplayName := SerializablePackages.Items[I].DisplayName;
|
||||
Data^.PackageState := SerializablePackages.Items[I].PackageState;
|
||||
Data^.DataType := 1;
|
||||
Data^.HasUpdate := False;
|
||||
for J := 0 to SerializablePackages.Items[I].PackageFiles.Count - 1 do
|
||||
begin
|
||||
//add packagefiles(DataType = 2)
|
||||
@ -957,39 +966,110 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVisualTree.UpdatePackageUStatus;
|
||||
var
|
||||
Node, ParentNode: PVirtualNode;
|
||||
Data, ParentData: PData;
|
||||
Package: TPackage;
|
||||
PackageFile: TPackageFile;
|
||||
begin
|
||||
Node := FVST.GetFirst;
|
||||
while Assigned(Node) do
|
||||
begin
|
||||
Data := FVST.GetNodeData(Node);
|
||||
if (Data^.DataType = 1) then
|
||||
begin
|
||||
Package := SerializablePackages.FindPackage(Data^.PackageName, fpbPackageName);
|
||||
if Package <> nil then
|
||||
begin
|
||||
Data^.DownloadZipURL := Package.DownloadZipURL;
|
||||
Data^.ForceUpadate := Package.ForceUpdate;
|
||||
FVST.ReinitNode(Node, False);
|
||||
FVST.RepaintNode(Node);
|
||||
if Package.ForceUpdate then
|
||||
begin
|
||||
Data^.HasUpdate := True;
|
||||
FVST.ReinitNode(Node, False);
|
||||
FVST.RepaintNode(Node);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if Data^.DataType = 2 then
|
||||
begin
|
||||
PackageFile := SerializablePackages.FindPackageFile(Data^.PackageFileName);
|
||||
if PackageFile <> nil then
|
||||
begin
|
||||
Data^.UpdateVersion := PackageFile.UpdateVersion;
|
||||
FVST.ReinitNode(Node, False);
|
||||
FVST.RepaintNode(Node);
|
||||
if Data^.UpdateVersion > Data^.InstalledVersion then
|
||||
begin
|
||||
ParentNode := Node^.Parent;
|
||||
ParentData := FVST.GetNodeData(ParentNode);
|
||||
ParentData^.HasUpdate := True;
|
||||
FVST.ReinitNode(ParentNode, False);
|
||||
FVST.RepaintNode(ParentNode);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Node := FVST.GetNext(Node);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVisualTree.VSTBeforeCellPaint(Sender: TBaseVirtualTree;
|
||||
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
|
||||
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
|
||||
var
|
||||
Data: PData;
|
||||
Data, ParentData: PData;
|
||||
ParentNode: PVirtualNode;
|
||||
begin
|
||||
Data := Sender.GetNodeData(Node);
|
||||
if (Data^.DataType = 0) or (Data^.DataType = 1) then
|
||||
if (Data^.DataType = 0) or (Data^.DataType = 1) or (Data^.DataType = 2) then
|
||||
begin
|
||||
if (Node = Sender.FocusedNode) then
|
||||
begin
|
||||
if Column = 0 then
|
||||
begin
|
||||
if Data^.DataType = 0 then
|
||||
TargetCanvas.Brush.Color := $00E5E5E5 //00D8D8D8
|
||||
else if Data^.DataType = 1 then
|
||||
TargetCanvas.Brush.Color := $00E5E5E5;
|
||||
TargetCanvas.FillRect(CellRect);
|
||||
TargetCanvas.Brush.Color := FVST.Colors.FocusedSelectionColor;
|
||||
TargetCanvas.FillRect(ContentRect)
|
||||
end
|
||||
else
|
||||
begin
|
||||
TargetCanvas.Brush.Color := FVST.Colors.FocusedSelectionColor;
|
||||
TargetCanvas.FillRect(CellRect)
|
||||
case Column of
|
||||
0: begin
|
||||
if Data^.DataType = 0 then
|
||||
TargetCanvas.Brush.Color := $00E5E5E5 //00D8D8D8
|
||||
else
|
||||
TargetCanvas.Brush.Color := $00E5E5E5;
|
||||
TargetCanvas.FillRect(CellRect);
|
||||
TargetCanvas.Brush.Color := FVST.Colors.FocusedSelectionColor;
|
||||
TargetCanvas.FillRect(ContentRect)
|
||||
end
|
||||
else
|
||||
begin
|
||||
TargetCanvas.Brush.Color := FVST.Colors.FocusedSelectionColor;
|
||||
TargetCanvas.FillRect(CellRect)
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if Data^.DataType = 0 then
|
||||
TargetCanvas.Brush.Color := $00E5E5E5 //00D8D8D8
|
||||
else if Data^.DataType = 1 then
|
||||
TargetCanvas.Brush.Color := $00E5E5E5;
|
||||
case Column of
|
||||
0, 1, 2, 4, 5:
|
||||
begin
|
||||
if Data^.DataType = 0 then
|
||||
TargetCanvas.Brush.Color := $00E5E5E5 //00D8D8D8
|
||||
else
|
||||
TargetCanvas.Brush.Color := $00E5E5E5;
|
||||
end;
|
||||
3:begin
|
||||
if (Data^.DataType = 2) then
|
||||
begin
|
||||
ParentNode := Node^.Parent;
|
||||
ParentData := FVST.GetNodeData(ParentNode);
|
||||
if (Data^.UpdateVersion > Data^.InstalledVersion) then
|
||||
begin
|
||||
TargetCanvas.Brush.Color := $00E5E5E5;
|
||||
ParentData^.HasUpdate := True;
|
||||
end
|
||||
else
|
||||
ParentData^.HasUpdate := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
TargetCanvas.FillRect(CellRect);
|
||||
end;
|
||||
end
|
||||
@ -1122,8 +1202,8 @@ begin
|
||||
else if (Data1^.DataType = 2) and (Data1^.DataType = 2) then
|
||||
Result := CompareText(Data1^.PackageFileName, Data2^.PackageFileName);
|
||||
end;
|
||||
4: if (Data1^.DataType = 1) and (Data1^.DataType = 1) then
|
||||
Result := Ord(Data1^.PackageState) - Ord(Data2^.PackageState);
|
||||
3: if (Data1^.DataType = 1) and (Data1^.DataType = 1) then
|
||||
Result := Ord(Data2^.HasUpdate) - Ord(Data1^.HasUpdate);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1209,12 +1289,20 @@ begin
|
||||
end
|
||||
else if Column = 3 then
|
||||
begin
|
||||
if Data^.UpdateVersion = '' then
|
||||
Data^.UpdateVersion := '-';
|
||||
if Data^.DataType = 2 then
|
||||
CellText := Data^.UpdateVersion
|
||||
else
|
||||
CellText := '';
|
||||
case Data^.DataType of
|
||||
1: if Data^.HasUpdate then
|
||||
CellText := 'NEW';
|
||||
2: begin
|
||||
if Data^.UpdateVersion = '' then
|
||||
Data^.UpdateVersion := '-';
|
||||
if Data^.DataType = 2 then
|
||||
CellText := Data^.UpdateVersion
|
||||
else
|
||||
CellText := '';
|
||||
end
|
||||
else
|
||||
CellText := '';
|
||||
end
|
||||
end
|
||||
else if Column = 4 then
|
||||
begin
|
||||
@ -1226,7 +1314,7 @@ begin
|
||||
1: CellText := rsMainFrm_VSTText_PackageState1;
|
||||
2: CellText := rsMainFrm_VSTText_PackageState2;
|
||||
3: begin
|
||||
Data^.IsInstalled := Data^.InstalledVersion >= Data^.Version;
|
||||
Data^.IsInstalled := Data^.InstalledVersion >= Data^.UpdateVersion;
|
||||
if Data^.IsInstalled then
|
||||
CellText := rsMainFrm_VSTText_PackageState4
|
||||
else
|
||||
@ -1266,7 +1354,7 @@ end;
|
||||
procedure TVisualTree.VSTHeaderClick(Sender: TVTHeader; Column: TColumnIndex;
|
||||
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
if (Column > 0) then
|
||||
if (Column <> 0) and (Column <> 3) then
|
||||
Exit;
|
||||
if Button = mbLeft then
|
||||
begin
|
||||
@ -1298,28 +1386,39 @@ var
|
||||
Data: PData;
|
||||
begin
|
||||
Data := FVST.GetNodeData(Node);
|
||||
if (Column = 4) and (FHoverNode = Node) and (FHoverColumn = Column) and ((Data^.DataType = 17) or (Data^.DataType = 18)) then
|
||||
begin
|
||||
TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsUnderline];
|
||||
if Node <> Sender.FocusedNode then
|
||||
TargetCanvas.Font.Color := clBlue
|
||||
case column of
|
||||
3: begin
|
||||
TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
|
||||
if Node <> Sender.FocusedNode then
|
||||
TargetCanvas.Font.Color := clBlack
|
||||
else
|
||||
TargetCanvas.Font.Color := clWhite;
|
||||
end;
|
||||
4: begin
|
||||
if (FHoverNode = Node) and (FHoverColumn = Column) and ((Data^.DataType = 17) or (Data^.DataType = 18)) then
|
||||
begin
|
||||
TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsUnderline];
|
||||
if Node <> Sender.FocusedNode then
|
||||
TargetCanvas.Font.Color := clBlue
|
||||
else
|
||||
TargetCanvas.Font.Color := clWhite;
|
||||
end
|
||||
else if (Data^.DataType = 2) and (Data^.IsInstalled) then
|
||||
begin
|
||||
TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
|
||||
if Node <> Sender.FocusedNode then
|
||||
TargetCanvas.Font.Color := clGreen
|
||||
else
|
||||
TargetCanvas.Font.Color := clWhite;
|
||||
end;
|
||||
end
|
||||
else
|
||||
TargetCanvas.Font.Color := clWhite;
|
||||
end
|
||||
else if (Column = 4) and (Data^.DataType = 2) and (Data^.IsInstalled) then
|
||||
begin
|
||||
TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
|
||||
if Node <> Sender.FocusedNode then
|
||||
TargetCanvas.Font.Color := clGreen
|
||||
else
|
||||
TargetCanvas.Font.Color := clWhite;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if Node <> Sender.FocusedNode then
|
||||
TargetCanvas.Font.Color := FVST.Font.Color
|
||||
else
|
||||
TargetCanvas.Font.Color := clWhite;
|
||||
begin
|
||||
if Node <> Sender.FocusedNode then
|
||||
TargetCanvas.Font.Color := FVST.Font.Color
|
||||
else
|
||||
TargetCanvas.Font.Color := clWhite;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user