paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-26 15:20:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

Generate JSON for updates(package maintainers webpage).

Browse Source 
git-svn-id: trunk@53627 -
This commit is contained in:
balazs 2016-12-10 15:11:31 +00:00
parent 32a637ee11
commit f1e6d30c04
13 changed files with 731 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -3316,6 +3316,8 @@ components/onlinepackagemanager/opkman_categoriesfrm.pas svneol=native#text/pasc
components/onlinepackagemanager/opkman_common.pas svneol=native#text/pascal
components/onlinepackagemanager/opkman_const.pas svneol=native#text/pascal
components/onlinepackagemanager/opkman_contributors.txt svneol=native#text/plain
components/onlinepackagemanager/opkman_createjsonforupdates.lfm svneol=native#text/plain
components/onlinepackagemanager/opkman_createjsonforupdates.pas svneol=native#text/pascal
components/onlinepackagemanager/opkman_createrepositorypackage.lfm svneol=native#text/plain
components/onlinepackagemanager/opkman_createrepositorypackage.pas svneol=native#text/pascal
components/onlinepackagemanager/opkman_downloader.pas svneol=native#text/pascal

6
components/onlinepackagemanager/onlinepackagemanager.lpk
View File

@ -20,7 +20,7 @@
<Description Value="Online package manger"/>
<License Value="GPL"/>
<Version Major="1"/>
<Files Count="18">
<Files Count="19">
<Item1>
<Filename Value="onlinepackagemanagerintf.pas"/>
<HasRegisterProc Value="True"/>
@ -99,6 +99,10 @@
<Filename Value="opkman_updates.pas"/>
<UnitName Value="opkman_updates"/>
</Item18>
<Item19>
<Filename Value="opkman_createjsonforupdates.pas"/>
<UnitName Value="opkman_createjsonforupdates"/>
</Item19>
</Files>
<i18n>
<EnableI18N Value="True"/>

3
components/onlinepackagemanager/onlinepackagemanager.pas
View File

@ -13,7 +13,8 @@ uses
opkman_common, opkman_progressfrm, opkman_zipper, opkman_timer,
opkman_installer, opkman_packagelistfrm, opkman_options,
opkman_createrepositorypackage, opkman_categoriesfrm,
opkman_packagedetailsfrm, opkman_updates, LazarusPackageIntf;
opkman_packagedetailsfrm, opkman_updates, opkman_createjsonforupdates,
LazarusPackageIntf;
implementation

22
components/onlinepackagemanager/opkman_const.pas
View File

@ -90,7 +90,8 @@ resourcestring
rsMainFrm_VSTText_PackageState2 = 'Extracted';
rsMainFrm_VSTText_PackageState3 = 'Installed';
rsMainFrm_VSTText_PackageState4 = 'Up to date';
rsMainFrm_VSTText_PackageState5 = 'New updates available';
rsMainFrm_VSTText_PackageState5 = 'New version available(repository)';
rsMainFrm_VSTText_PackageState6 = 'New updates available';
rsMainFrm_VSTText_PackageCategory0 = 'Charts and Graphs';
rsMainFrm_VSTText_PackageCategory1 = 'Cryptography';
rsMainFrm_VSTText_PackageCategory2 = 'DataControls';
@ -145,7 +146,7 @@ resourcestring
rsMainFrm_TBHelp_Caption = 'Help';
rsMainFrm_TBHelp_Hint = 'Help (' + cHelpPage + ')';
rsMainFrm_miCreateRepositoryPackage = 'Create repository package';
rsMainFrm_miCreateRepository = 'Create repository';
rsMainFrm_miCreateJSONForUpdates = 'Create JSON for updates';
rsMainFrm_miJSONShow = 'Show JSON';
rsMainFrm_miJSONHide = 'Hide JSON';
rsMainFrm_PackagenameAlreadyExists = 'A package with the same name already exists!';
@ -279,6 +280,23 @@ resourcestring
rsCreateRepositoryPackageFrm_Message5 = 'Creating JSON. Please wait...';
rsCreateRepositoryPackageFrm_Message6 = 'Repository package successfully created.';
//createupdatejson
rsCreateJSONForUpdatesFrm_Caption = 'Create update JSON for package: ';
rsCreateJSONForUpdatesFrm_bHelp_Caption = 'Help';
rsCreateJSONForUpdatesFrm_bCreate_Caption = 'Create';
rsCreateJSONForUpdatesFrm_bClose_Caption = 'Cancel';
rsCreateJSONForUpdatesFrm_lbLinkToZip_Caption = 'Link to the package zip file';
rsCreateJSONForUpdatesFrm_bTest_Caption = 'Test';
rsCreateJSONForUpdatesFrm_Column0_Text = 'PackageFileName';
rsCreateJSONForUpdatesFrm_Column1_Text = 'Version';
rsCreateJSONForUpdatesFrm_Column2_Text = 'Force notify';
rsCreateJSONForUpdatesFrm_Column3_Text = 'Internal version';
rsCreateJSONForUpdatesFrm_Message0 = 'Please select a repository package!';
rsCreateJSONForUpdatesFrm_Message1 = 'Please select only one repository package!';
rsCreateJSONForUpdatesFrm_Message2 = 'Please enter a valid URL!';
rsCreateJSONForUpdatesFrm_Message3 = 'Please check at least one package file!';
//categories form
rsCategoriesFrm_Caption = 'List with categories';
rsCategoriesFrm_lbMessage_Caption = 'Please select (check) one or more categories';

173
components/onlinepackagemanager/opkman_createjsonforupdates.lfm Normal file
View File

@ -0,0 +1,173 @@
object CreateJSONForUpdatesFrm: TCreateJSONForUpdatesFrm
Left = 659
Height = 268
Top = 255
Width = 423
BorderIcons = [biSystemMenu]
Caption = 'CreateJSONForUpdatesFrm'
ClientHeight = 268
ClientWidth = 423
Color = clBtnFace
Constraints.MinHeight = 200
Constraints.MinWidth = 300
OnCreate = FormCreate
OnDestroy = FormDestroy
PopupMode = pmExplicit
Position = poOwnerFormCenter
LCLVersion = '1.7'
object pnButtons: TPanel
Left = 0
Height = 41
Top = 227
Width = 423
Align = alBottom
BevelOuter = bvNone
ClientHeight = 41
ClientWidth = 423
TabOrder = 1
object bCreate: TButton
Left = 257
Height = 26
Top = 8
Width = 75
Anchors = [akTop, akRight]
Caption = 'Create'
OnClick = bCreateClick
TabOrder = 1
end
object bClose: TButton
Left = 334
Height = 26
Top = 8
Width = 75
Anchors = [akTop, akRight]
Caption = 'Close'
ModalResult = 2
TabOrder = 2
end
object bHelp: TButton
Left = 15
Height = 25
Top = 9
Width = 75
Caption = 'Help'
TabOrder = 0
Visible = False
end
end
object pnTop: TPanel
Left = 0
Height = 72
Top = 0
Width = 423
Align = alTop
BevelOuter = bvNone
ClientHeight = 72
ClientWidth = 423
TabOrder = 0
Visible = False
object lbLinkToZip: TLabel
Left = 15
Height = 15
Top = 16
Width = 104
Caption = 'Link to package zip:'
ParentColor = False
end
object edLinkToZip: TEdit
Left = 15
Height = 23
Top = 32
Width = 341
Anchors = [akTop, akLeft, akRight]
TabOrder = 0
end
object bTest: TButton
Left = 359
Height = 25
Top = 31
Width = 50
Anchors = [akTop, akRight]
Caption = 'Test'
OnClick = bTestClick
TabOrder = 1
end
end
object imTree: TImageList
left = 16
top = 144
Bitmap = {
4C69020000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00E1F2F8007DC3DCFF76C0DCFFDCEFF700FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F0F9
FC0099CEE00055B6D9FF9CD5EAFF88CCE7FF4DAFD6FF8FC7DD00ECF6FB00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FCFEFE00AFD8E60063BD
DBFF92CFE5FFE6F8FCFFE3F6FEFFAFDDF2FFB2E4F7FF72C0E1FF55ADD5FFA3CF
E100F8FCFD00FFFFFF00FFFFFF00FFFFFF00C7E4EE0076C4DEFF7EC6E0FFD1EE
F7FFF6FFFFFFF0FEFFFFCBEDFBFF50ADDAFF8BD7F7FFAAE1F9FF95D6F2FF62B2
DBFF61AED4FFBAD9E800FFFFFF0089CADE004EB5D9FFA5D9EDFFD2EBF5FFBEDE
EDFF95C9DEFF89C3DBFF70B8D6FF69B9DDFF90D7F5FF7FCFF5FF9DDBF8FFAAE3
FAFF84CAECFF51A6D5FF74B3D5004FB4D8FFE1F8FEFFCDEBF9FF92D2EDFF84CC
EBFF6FBFE5FF56B1DBFF3B94C8FFCEECFAFFD9F5FFFFB9EAFFFF95DFFEFF77D5
FFFFA5E4FFFF84DCFBFF3193C9FF55B6D8FFE2F8FDFFD4F3FFFFB0E4FAFF86CF
F1FF7FD0F5FF78D0F5FF4CB1E4FFB0E4FAFFB6E9FFFF9BE1FFFF78D6FEFF40BD
F5FF3DB5E9FF90D5F1FF3895CAFF53B4D7FFE2F6FDFFDAF4FFFFD5F3FFFFBDEB
FFFF89D5F7FF69C9F5FF4CB4E9FF8DDAFBFF8CDCFFFF009600FF009600FF0096
00FF4FBBE8FF8CD0F0FF3693C9FF51B1D6FFE2F6FCFFD7F4FFFFCEF2FFFFC8EF
FFFFBAEBFFFF92DBFBFF56C1F1FF48C2F9FF3BBDF0FF009600FF00C000FF0096
00FF47B1E6FF88CAEEFF3490C8FF4EAED6FFE2F6FCFFD4F3FFFFC9F0FFFFBEED
FFFFB3EAFFFFADE7FFFF7CD9FEFF48C7EFFF43C4EAFF009600FF00C000FF0096
00FF40A7E1FF83C5ECFF328DC7FF45A9D3FFE7FBFEFFDDF6FFFFC1EFFFFFB7EB
FFFFABE8FFFFA4E4FFFF009600FF009600FF009600FF009600FF00C000FF0096
00FF009600FF009600FF009600FF6FB8D80077BDDCFFBFE5F6FFDBF6FFFFC1EE
FFFFA5E5FFFF9FE3FFFF009600FF00C000FF00C000FF00C000FF00C000FF00C0
00FF00C000FF00C000FF009600FFFAFDFE00AFD8EB0055ABD5FF7DC0E0FFC7EE
FCFFCCF2FFFFA8E8FFFF009600FF009600FF009600FF009600FF00C000FF0096
00FF009600FF009600FF009600FFFFFFFF00FFFFFF00ECF4F90093C9E3FF3F9C
CEFF82C4E5FFCCF4FFFFC4EFFFFF8BD2F1FF8ACEF0FF009600FF00C000FF0096
00FFD1E9E100FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D7E9
F20078B7DBFF2D8EC8FF8FCDEBFF6FB7E2FF408EC8FF009600FF00C000FF0096
00FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00BDD8E8005FA7D3FF56A2D0FFB5D3E500009600FF009600FF0096
00FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF004DB4D82B4BB2D8AF4AB0D7BC48AED631FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004EB6
D9164DB4D8844BB2D7EF9CD5EAFF88CCE7FF45ACD5F344AAD48C42A7D31AFFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004FB7DA054EB6D9654CB4
D8DB92CFE5FFE6F8FCFFE3F6FEFFAFDDF2FFB2E4F7FF72C0E1FF3FA4D1E03DA2
D06C3BA0CF09FFFFFF00FFFFFF00FFFFFF004FB7D9464EB5D9C27EC6E0FFD1EE
F7FFF6FFFFFFF0FEFFFFCBEDFBFF50ADDAFF8BD7F7FFAAE1F9FF95D6F2FF62B2
DBFF399DCEC8369ACD4DFFFFFF004FB7D99F4DB5D9FEA5D9EDFFD2EBF5FFBEDE
EDFF95C9DEFF89C3DBFF70B8D6FF6ABADEFF90D7F5FF7FCFF5FF9DDBF8FFAAE3
FAFF84CAECFF51A6D5FF3295CBA64DB4D8FBE1F8FEFFCDEBF9FF92D2EDFF84CC
EBFF6FBFE5FF56B1DBFF3B94C8FFCEECFAFFD9F5FFFFB9EAFFFF95DFFEFF77D5
FFFFA5E4FFFF84DCFBFF2F92C9FB4BB2D7F0E2F8FDFFD4F3FFFFB0E4FAFF86CF
F1FF7FD0F5FF78D0F5FF4CB1E4FFB0E4FAFFB6E9FFFF9BE1FFFF78D6FEFF40BD
F5FF3DB5E9FF90D5F1FF2D8FC8F049B0D6F8DBF6F8FFD9F3FFFFD5F3FFFFBDEB
FFFF89D5F7FF69C9F5FF4CB4E9FF8DDAFBFF8CDCFFFF48C4F9FF38B6ECFF48BF
E8FF48B8E7FF90D3F1FF2B8DC7FA47ADD5FB92E7D4FF80E5D8FFC8F1FDFFC8EF
FFFFBAEBFFFF92DBFBFF56C1F1FF48C2F9FF3BBDF0FF47C5ECFF45BDE9FF43B5
E6FF39ADD4FF88D2CCFF288AC6FF44AAD4F7A8EDE2FF41D6B3FF49D8BAFF8CE4
E4FFB3EAFFFFADE7FFFF7CD9FEFF48C7EFFF43C4EAFF43BEE8FF3DB3DCFF2DAE
A9FF29B188FF85D3BBFF2687C5FE42A8D3F9E7FBFEFFD0F3F9FF46D7B8FF39D4
AEFF50D9C3FF8EE2F2FF96E1FEFF48C6EBFF3FBCE3FF30AFB1FF24AC84FF24AD
81FF67BFC2FF83C4ECFF2485C4F840A5D2BB77BDDCFFBFE5F6FFDBF6FFFF9EE8
EBFF37D3ACFF37D2ACFF55D8D1FF37B8BCFF24AA85FF22AA7CFF4DB7A9FF86C6
EBFF74B3E4FF4A90CAFF2283C3C13DA2D0063BA0CF65399DCEDB7DC0E0FFC7EE
FCFFCBF2FEFF65DDD0FF33D1A8FF22AA7CFF35B091FF89CBE8FF82C1EBFF5397
D0FF2384C3E02282C26D2080C20AFFFFFF00FFFFFF00369ACD163498CC853295
CBEF82C4E5FFCCF4FFFFBCEEFAFF88D1E4FF8ACEF0FF5FA4D7FF2586C4F32384
C38D2182C21BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003093
CA2B2E90C9A52C8EC8FE8FCDEBFF6FB7E2FF408EC8FF2485C4AC2383C331FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF002A8BC6462889C5BE2687C5C42485C44DFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00
}
end
object SD: TSaveDialog
DefaultExt = '.json'
Filter = '*.json|*.json'
left = 75
top = 145
end
end

328
components/onlinepackagemanager/opkman_createjsonforupdates.pas Normal file
View File

@ -0,0 +1,328 @@
unit opkman_createjsonforupdates;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, EditBtn, LCLIntf, MaskEdit, fpjson,
opkman_VirtualTrees, opkman_serializablepackages;
type
{ TCreateJSONForUpdatesFrm }
TCreateJSONForUpdatesFrm = class(TForm)
bClose: TButton;
bCreate: TButton;
bTest: TButton;
bHelp: TButton;
edLinkToZip: TEdit;
imTree: TImageList;
lbLinkToZip: TLabel;
pnTop: TPanel;
pnButtons: TPanel;
SD: TSaveDialog;
procedure bCreateClick(Sender: TObject);
procedure bTestClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FVST: TVirtualStringTree;
FPackage: TPackage;
FSortCol: Integer;
FSortDir: opkman_VirtualTrees.TSortDirection;
procedure VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String);
procedure VSTGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
{%H-}Kind: TVTImageKind; Column: TColumnIndex; var {%H-}Ghosted: Boolean;
var ImageIndex: Integer);
procedure VSTCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
procedure VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure VSTHeaderClick(Sender: TVTHeader; Column: TColumnIndex;
Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
public
procedure PopluateTree;
end;
var
CreateJSONForUpdatesFrm: TCreateJSONForUpdatesFrm;
implementation
uses opkman_const, opkman_common, opkman_updates;
{$R *.lfm}
{ TCreateJSONForUpdatesFrm }
type
PData = ^TData;
TData = record
FName: string;
FVersion: String;
FForceNotify: Boolean;
FInternalVersion: Integer;
FImageIndex: Integer;
end;
procedure TCreateJSONForUpdatesFrm.FormCreate(Sender: TObject);
begin
Caption := rsCreateJSONForUpdatesFrm_Caption;
lbLinkToZip.Caption := rsCreateJSONForUpdatesFrm_lbLinkToZip_Caption;
bTest.Caption := rsCreateJSONForUpdatesFrm_bTest_Caption;
bHelp.Caption := rsCreateJSONForUpdatesFrm_bHelp_Caption;
bCreate.Caption := rsCreateJSONForUpdatesFrm_bCreate_Caption;
bClose.Caption := rsCreateJSONForUpdatesFrm_bClose_Caption;
FVST := TVirtualStringTree.Create(nil);
with FVST do
begin
Parent := Self;
Align := alClient;
Anchors := [akLeft, akTop, akRight];
Images := imTree;
Color := clBtnFace;
DefaultNodeHeight := 25;
Indent := 0;
TabOrder := 1;
DefaultText := '';
Header.AutoSizeIndex := 0;
Header.Height := 25;
Colors.BorderColor := clBlack;
BorderSpacing.Top := 15;
BorderSpacing.Left := 15;
BorderSpacing.Right := 15;
BorderSpacing.Bottom := 0;
with Header.Columns.Add do
begin
Position := 0;
Width := 250;
Text := rsCreateJSONForUpdatesFrm_Column0_Text;
end;
with Header.Columns.Add do
begin
Position := 1;
Width := 75;
Text := rsCreateJSONForUpdatesFrm_Column1_Text;
Alignment := taCenter;
end;
with Header.Columns.Add do
begin
Position := 2;
Width := 100;
Text := rsCreateJSONForUpdatesFrm_Column2_Text;
Alignment := taCenter;
Options := Options - [coVisible];
end;
with Header.Columns.Add do
begin
Position := 3;
Width := 100;
Text := rsCreateJSONForUpdatesFrm_Column3_Text;
Alignment := taCenter;
Options := Options - [coVisible];
end;
Header.Options := [hoAutoResize, hoRestrictDrag, hoShowSortGlyphs, hoAutoSpring, hoVisible];
Header.SortColumn := 0;
TabOrder := 2;
TreeOptions.MiscOptions := [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toCheckSupport, toEditable];
TreeOptions.PaintOptions := [toHideFocusRect, toPopupMode, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages];
TreeOptions.SelectionOptions := [toFullRowSelect, toRightClickSelect];
TreeOptions.AutoOptions := [toAutoTristateTracking];
OnGetText := @VSTGetText;
OnGetImageIndex := @VSTGetImageIndex;
OnCompareNodes := @VSTCompareNodes;
OnHeaderClick := @VSTHeaderClick;
OnFreeNode := @VSTFreeNode;
end;
FVST.NodeDataSize := SizeOf(TData);
end;
procedure TCreateJSONForUpdatesFrm.FormDestroy(Sender: TObject);
begin
FVST.Free;
end;
procedure TCreateJSONForUpdatesFrm.bTestClick(Sender: TObject);
begin
if Trim(edLinkToZip.Text) = '' then
begin
MessageDlgEx(rsCreateJSONForUpdatesFrm_Message2, mtInformation, [mbOk], Self);
edLinkToZip.SetFocus;
Exit;
end;
OpenURL(edLinkToZip.Text);
end;
procedure TCreateJSONForUpdatesFrm.bCreateClick(Sender: TObject);
var
UpdatePackage: TUpdatePackage;
UpdatePackageFiles: TUpdatePackageFiles;
JSON: TJSONStringType;
Ms: TMemoryStream;
Node: PVirtualNode;
Data: PData;
begin
if FVST.CheckedCount = 0 then
begin
MessageDlgEx(rsCreateJSONForUpdatesFrm_Message3, mtInformation, [mbOk], Self);
Exit;
end;
SD.FileName := 'update_' + FPackage.DisplayName;
if SD.Execute then
begin
UpdatePackage := TUpdatePackage.Create;
try
UpdatePackage.UpdatePackageData.Name := FPackage.Name;
UpdatePackage.UpdatePackageData.DownloadZipURL := edLinkToZip.Text;
Node := FVST.GetFirst;
while Assigned(Node) do
begin
if FVST.CheckState[Node] = csCheckedNormal then
begin
Data := FVST.GetNodeData(Node);
UpdatePackageFiles := TUpdatePackageFiles(UpdatePackage.UpdatePackageFiles.Add);
UpdatePackageFiles.Name := Data^.FName;
UpdatePackageFiles.Version := Data^.FVersion;
UpdatePackageFiles.ForceNotify := Data^.FForceNotify;
UpdatePackageFiles.InternalVersion := Data^.FInternalVersion;
end;
Node := FVST.GetNext(Node);
end;
JSON := '';
if UpdatePackage.SaveToJSON(JSON) then
begin
JSON := StringReplace(JSON, '\/', '/', [rfReplaceAll]);
Ms := TMemoryStream.Create;
try
Ms.Write(Pointer(JSON)^, Length(JSON));
Ms.Position := 0;
Ms.SaveToFile(SD.FileName);
finally
MS.Free;
end;
end;
finally
UpdatePackage.Free;
end;
end;
end;
procedure TCreateJSONForUpdatesFrm.VSTGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
var
Data: PData;
begin
Data := FVST.GetNodeData(Node);
case Column of
0: CellText := Data^.FName;
1: CellText := Data^.FVersion;
2: CellText := BoolToStr(Data^.FForceNotify, True);
3: CellText := IntToStr(Data^.FInternalVersion);
end;
end;
procedure TCreateJSONForUpdatesFrm.VSTGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer);
var
Data: PData;
begin
Data := FVST.GetNodeData(Node);
if Column = 0 then
ImageIndex := Data^.FImageIndex;
end;
procedure TCreateJSONForUpdatesFrm.VSTCompareNodes(Sender: TBaseVirtualTree;
Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
Data1: PData;
Data2: PData;
begin
Data1 := Sender.GetNodeData(Node1);
Data2 := Sender.GetNodeData(Node2);
case Column of
0: Result := CompareText(Data1^.FName, Data2^.FName);
1: Result := CompareText(Data1^.FVersion, Data2^.FVersion);
end;
end;
procedure TCreateJSONForUpdatesFrm.VSTFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
Data: PData;
begin
Data := FVST.GetNodeData(Node);
Finalize(Data^)
end;
procedure TCreateJSONForUpdatesFrm.VSTHeaderClick(Sender: TVTHeader;
Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Column > 1 then
Exit;
if Button = mbLeft then
begin
with Sender, Treeview do
begin
if (SortColumn = NoColumn) or (SortColumn <> Column) then
begin
SortColumn := Column;
SortDirection := opkman_VirtualTrees.sdAscending;
end
else
begin
if SortDirection = opkman_VirtualTrees.sdAscending then
SortDirection := opkman_VirtualTrees.sdDescending
else
SortDirection := opkman_VirtualTrees.sdAscending;
FSortDir := SortDirection;
end;
SortTree(SortColumn, SortDirection, False);
FSortCol := Sender.SortColumn;
end;
end;
end;
procedure TCreateJSONForUpdatesFrm.PopluateTree;
var
I, J: Integer;
Node: PVirtualNode;
Data: PData;
PackageFile: TPackageFile;
begin
for I := 0 to SerializablePackages.Count - 1 do
begin
FPackage := SerializablePackages.Items[I];
if FPackage.Checked then
begin
Caption := Caption + ' "' + FPackage.DisplayName +'"';
for J := 0 to FPackage.PackageFiles.Count - 1 do
begin
PackageFile := TPackageFile(FPackage.PackageFiles.Items[J]);
if PackageFile.Checked then
begin
Node := FVST.AddChild(nil);
Node^.CheckType := ctTriStateCheckBox;
FVST.CheckState[Node] := csCheckedNormal;
Data := FVST.GetNodeData(Node);
Data^.FName := PackageFile.Name;
Data^.FVersion := PackageFile.VersionAsString;
Data^.FForceNotify := False;
Data^.FInternalVersion := 1;
Data^.FImageIndex := 1;
end;
end;
Break;
end;
end;
end;
end.

7
components/onlinepackagemanager/opkman_installer.pas
View File

@ -35,6 +35,7 @@ uses
opkman_serializablepackages;
type
TInstallStatus = (isSuccess, isPartiallyFailed, isFailed);
TInstallMessage = (imOpenPackage, imOpenPackageSuccess, imOpenPackageError,
@ -255,7 +256,13 @@ begin
-1, 1:
begin
if CompRes = 1 then
begin
DoOnPackageInstallProgress(imCompilePackageSuccess, PackageFile);
if PackageAction = paUpdate then
if PackageFile.ForceNotify then
if PackageFile.InternalVersion > PackageFile.InternalVersionOld then
PackageFile.InternalVersionOld := PackageFile.InternalVersion;
end;
if PackageFile.PackageType in [ptRunAndDesignTime, ptDesigntime] then
begin
DoOnPackageInstallProgress(imInstallPackage, PackageFile);

8
components/onlinepackagemanager/opkman_mainfrm.lfm
View File

@ -461,7 +461,7 @@ object MainFrm: TMainFrm
Top = 0
AutoSize = True
Caption = 'Create'
DropdownMenu = pmRepository
DropdownMenu = pmCreate
ImageIndex = 5
ParentShowHint = False
ShowHint = True
@ -514,7 +514,7 @@ object MainFrm: TMainFrm
OnClick = miJSONShowClick
end
end
object pmRepository: TPopupMenu
object pmCreate: TPopupMenu
left = 144
top = 224
object miCreateRepositoryPackage: TMenuItem
@ -522,8 +522,8 @@ object MainFrm: TMainFrm
OnClick = miCreateRepositoryPackageClick
end
object miCreateRepository: TMenuItem
Caption = 'Create repository'
Enabled = False
Caption = 'Create JSON for updates'
OnClick = miCreateRepositoryClick
end
end
object SDD: TSelectDirectoryDialog

39
components/onlinepackagemanager/opkman_mainfrm.pas
View File

@ -62,7 +62,7 @@ type
pnTop: TPanel;
pnMain: TPanel;
pmTree: TPopupMenu;
pmRepository: TPopupMenu;
pmCreate: TPopupMenu;
SDD: TSelectDirectoryDialog;
spCollapse: TSpeedButton;
spClear: TSpeedButton;
@ -76,6 +76,7 @@ type
tbCleanUp: TToolButton;
tbCreate: TToolButton;
tbUpdate: TToolButton;
procedure miCreateRepositoryClick(Sender: TObject);
procedure miCreateRepositoryPackageClick(Sender: TObject);
procedure pnToolBarResize(Sender: TObject);
procedure tbCleanUpClick(Sender: TObject);
@ -130,7 +131,8 @@ implementation
uses LCLVersion,
opkman_serializablepackages, opkman_visualtree, opkman_const, opkman_common,
opkman_progressfrm, opkman_zipper, opkman_packagelistfrm, opkman_options,
opkman_optionsfrm, opkman_createrepositorypackage, opkman_updates;
opkman_optionsfrm, opkman_createrepositorypackage, opkman_updates,
opkman_createjsonforupdates;
{$R *.lfm}
{ TMainFrm }
@ -611,8 +613,6 @@ var
begin
if not IsSomethingChecked(True) then
Exit;
if MessageDlgEx(rsMainFrm_PackageUpdateWarning, mtConfirmation, [mbYes, mbNo], Self) = mrNo then
Exit;
CanGo := True;
NeedToRebuild := False;
VisualTree.UpdatePackageStates;
@ -630,6 +630,9 @@ begin
if CanGo then
begin
if MessageDlgEx(rsMainFrm_PackageUpdateWarning, mtConfirmation, [mbYes, mbNo], Self) = mrNo then
Exit;
Updates.PauseUpdate;
PackageAction := paUpdate;
VisualTree.UpdatePackageStates;
@ -793,12 +796,36 @@ procedure TMainFrm.miCreateRepositoryPackageClick(Sender: TObject);
begin
CreateRepositoryPackagesFrm := TCreateRepositoryPackagesFrm.Create(MainFrm);
try
CreateRepositoryPackagesFrm.ShowModal;
CreateRepositoryPackagesFrm.ShowModal;
finally
CreateRepositoryPackagesFrm.Free;
end;
end;
procedure TMainFrm.miCreateRepositoryClick(Sender: TObject);
var
Msg: String;
begin
case VisualTree.GetCheckedRepositoryPackages of
0: Msg := rsCreateJSONForUpdatesFrm_Message0;
1: Msg := '';
2: Msg := rsCreateJSONForUpdatesFrm_Message1;
end;
if Msg <> '' then
begin
MessageDlgEx(Msg, mtInformation, [mbOk], MainFrm);
Exit;
end;
VisualTree.GetPackageList;
CreateJSONForUpdatesFrm := TCreateJSONForUpdatesFrm.Create(MainFrm);
try
CreateJSONForUpdatesFrm.PopluateTree;
CreateJSONForUpdatesFrm.ShowModal;
finally
CreateJSONForUpdatesFrm.Free;
end;
end;
procedure TMainFrm.pnMainResize(Sender: TObject);
begin
pnMessage.Left := (pnMain.Width - pnMessage.Width) div 2;
@ -880,7 +907,7 @@ begin
tbHelp.Hint := rsMainFrm_TBHelp_Hint;
miCreateRepositoryPackage.Caption := rsMainFrm_miCreateRepositoryPackage;
miCreateRepository.Caption := rsMainFrm_miCreateRepository;
miCreateRepository.Caption := rsMainFrm_miCreateJSONForUpdates;
miJSONShow.Caption := rsMainFrm_miJSONShow;
miJSONHide.Caption := rsMainFrm_miJSONHide;

10
components/onlinepackagemanager/opkman_packagelistfrm.pas
View File

@ -156,7 +156,7 @@ begin
begin
Node := FVST.AddChild(nil);
Data := FVST.GetNodeData(Node);
Data^.FName := SerializablePackages.Items[I].Name;
Data^.FName := SerializablePackages.Items[I].DisplayName;
Data^.FImageIndex := 0;
end;
end
@ -165,13 +165,13 @@ begin
if (SerializablePackages.Items[I].Checked) then
begin
Inc(ChkCnt);
if (Trim(SerializablePackages.Items[I].DownloadZipURL) = '') or
if (Trim(SerializablePackages.Items[I].DownloadURL) = '') or
(SerializablePackages.GetPackageInstallState(SerializablePackages.Items[I]) = 0) then
begin
Inc(InvCnt);
Node := FVST.AddChild(nil);
Data := FVST.GetNodeData(Node);
Data^.FName := SerializablePackages.Items[I].Name;
Data^.FName := SerializablePackages.Items[I].DisplayName;
Data^.FImageIndex := 0;
SerializablePackages.Items[I].ChangePackageStates(ctAdd, psError);
end;
@ -213,8 +213,8 @@ begin
Header.Height := 25;
Colors.BorderColor := clBlack;
BorderSpacing.Top := 5;
BorderSpacing.Left := 10;
BorderSpacing.Right := 10;
BorderSpacing.Left := 15;
BorderSpacing.Right := 15;
with Header.Columns.Add do begin
Position := 0;
Width := 250;

12
components/onlinepackagemanager/opkman_serializablepackages.pas
View File

@ -133,6 +133,10 @@ type
FInstalledFileName: String;
FInstalledFileVersion: String;
FUpdateVersion: String;
FForceNotify: Boolean;
FInternalVersion: Integer;
FInternalVersionOld: Integer;
FHasUpdate: Boolean;
FVersion: TPackageVersion;
FVersionAsString: String;
FDependencies: TPackageDependencies;
@ -157,6 +161,10 @@ type
property PackageAbsolutePath: String read FPackageAbsolutePath write FPackageAbsolutePath;
property Checked: Boolean read FChecked write FChecked;
property IsInstallable: Boolean read GetInstallable;
property ForceNotify: Boolean read FForceNotify write FForceNotify;
property InternalVersion: Integer read FInternalVersion write FInternalVersion;
property InternalVersionOld: Integer read FInternalVersionOld write FInternalVersionOld;
property HasUpdate: Boolean read FHasUpdate write FHasUpdate;
published
property Name: String read FName write FName;
property Author: String read FAuthor write FAuthor;
@ -188,8 +196,8 @@ type
FPackageBaseDir: String;
FHomePageURL: String;
FDownloadURL: String;
FForceNotify: Boolean;
FDownloadZipURL: String;
FHasUpdate: Boolean;
FSVNURL: String;
FUpdateSize: Int64;
FIsDirZipped: Boolean;
@ -208,8 +216,8 @@ type
property IsExtractable: Boolean read GetExtractable;
property UpdateSize: Int64 read FUpdateSize write FUpdateSize;
property IsDirZipped: Boolean read FIsDirZipped write FIsDirZipped;
property ForceNotify: Boolean read FForceNotify write FForceNotify;
property DownloadZipURL: String read FDownloadZipURL write FDownloadZipURL;
property HasUpdate: Boolean read FHasUpdate write FHasUpdate;
published
property Name: String read FName write FName;
property DisplayName: String read FDisplayName write FDisplayName;

123
components/onlinepackagemanager/opkman_updates.pas
View File

@ -20,9 +20,13 @@ type
private
FName: String;
FVersion: String;
FForceNotify: Boolean;
FInternalVersion: Integer;
published
property Name: String read FName write FName;
property Version: String read FVersion write FVersion;
property ForceNotify: Boolean read FForceNotify write FForceNotify;
property InternalVersion: Integer read FInternalVersion write FInternalVersion;
end;
{ TUpdatePackageData }
@ -30,7 +34,6 @@ type
TUpdatePackageData = class(TPersistent)
private
FDownloadZipURL: String;
FForceNotify: boolean;
FName: String;
public
constructor Create;
@ -38,7 +41,6 @@ type
procedure Clear;
published
property Name: String read FName write FName;
property ForceNotify: boolean read FForceNotify write FForceNotify;
property DownloadZipURL: String read FDownloadZipURL write FDownloadZipURL;
end;
@ -52,7 +54,8 @@ type
public
constructor Create;
destructor Destroy; override;
function LoadFromJSON(const AJSON: TJSONStringType): boolean;
function LoadFromJSON(const AJSON: TJSONStringType): Boolean;
function SaveToJSON(var AJSON: TJSONStringType): Boolean;
published
property UpdatePackageData: TUpdatePackageData read FUpdatePackageData write FUpdatePackageData;
property UpdatePackageFiles: TCollection read FUpdatePackageFiles write FUpdatePackageFiles;
@ -129,7 +132,7 @@ begin
inherited Destroy;
end;
function TUpdatePackage.LoadFromJSON(const AJSON: TJSONStringType): boolean;
function TUpdatePackage.LoadFromJSON(const AJSON: TJSONStringType): Boolean;
var
DeStreamer: TJSONDeStreamer;
begin
@ -147,6 +150,24 @@ begin
end;
end;
function TUpdatePackage.SaveToJSON(var AJSON: TJSONStringType): Boolean;
var
Streamer: TJSONStreamer;
begin
Streamer := TJSONStreamer.Create(nil);
try
Streamer.Options := Streamer.Options + [jsoUseFormatString];
try
AJSON := Streamer.ObjectToJSONString(Self);
Result := AJSON <> '';
except
Result := False;
end;
finally
Streamer.Free;
end;
end;
{ TUpdatePackageData }
constructor TUpdatePackageData.Create;
@ -163,7 +184,6 @@ end;
procedure TUpdatePackageData.Clear;
begin
FName := '';
FForceNotify := False;
FDownloadZipURL := '';
end;
@ -202,29 +222,49 @@ end;
procedure TUpdates.Load;
var
Count: Integer;
I: Integer;
Path: String;
PackageCount: Integer;
PackageFileCount: Integer;
I, J: Integer;
Path, SubPath: String;
PackageName: String;
PackageFileName: String;
Package: TPackage;
PackageFile: TPackageFile;
HasUpdate: Boolean;
begin
FVersion := FXML.GetValue('Version/Value', 0);
Count := FXML.GetValue('Count/Value', 0);
for I := 0 to Count - 1 do
PackageCount := FXML.GetValue('Count/Value', 0);
for I := 0 to PackageCount - 1 do
begin
Path := 'Item' + IntToStr(I);
PackageName := FXML.GetValue('Items/' + Path + '/PackageName', '');
Path := 'Package' + IntToStr(I) + '/';
PackageName := FXML.GetValue(Path + 'Name', '');
Package := SerializablePackages.FindPackage(PackageName, fpbPackageName);
if Package <> nil then
begin
Package.ForceNotify := FXML.GetValue('Items/' + Path + '/ForceNotify', False);
Package.DownloadZipURL := FXML.GetValue('Items/' + Path + '/DownloadZipURL', '');
PackageFileName := FXML.GetValue('Items/' + Path + '/PackageFileName', '');
PackageFile := Package.FindPackageFile(PackageFileName);
if PackageFile <> nil then
PackageFile.UpdateVersion := FXML.GetValue('Items/' + Path + '/UpdateVersion', '');
HasUpdate := False;
Package.DownloadZipURL := FXML.GetValue(Path + '/DownloadZipURL', '');
PackageFileCount := FXML.GetValue(Path + 'Count', 0);
for J := 0 to PackageFileCount - 1 do
begin
SubPath := Path + 'PackageFile' + IntToStr(J) + '/';
PackageFileName := FXML.GetValue(SubPath + 'Name', '');
PackageFile := Package.FindPackageFile(PackageFileName);
if PackageFile <> nil then
begin
PackageFile.UpdateVersion := FXML.GetValue(SubPath + 'UpdateVersion', '');
PackageFile.ForceNotify := FXML.GetValue(SubPath + 'ForceNotify', False);
PackageFile.InternalVersion := FXML.GetValue(SubPath + 'InternalVersion', 0);;
PackageFile.InternalVersionOld := FXML.GetValue(SubPath + 'InternalVersionOld', 0);
PackageFile.HasUpdate := (PackageFile.UpdateVersion <> '') and (PackageFile.InstalledFileVersion <> '') and
(
((not PackageFile.ForceNotify) and (PackageFile.UpdateVersion > PackageFile.InstalledFileVersion)) or
((PackageFile.ForceNotify) and (PackageFile.InternalVersion > PackageFile.InternalVersionOld))
);
if not HasUpdate then
HasUpdate := PackageFile.HasUpdate;
end;
end;
Package.HasUpdate := HasUpdate;
end;
end;
Synchronize(@DoOnUpdate);
@ -233,31 +273,32 @@ end;
procedure TUpdates.Save;
var
I, J: Integer;
Count: Integer;
Path: String;
Path, SubPath: String;
Package: TPackage;
PackageFile: TPackageFile;
begin
FNeedToBreak := True;
FXML.Clear;
Count := -1;
FXML.SetDeleteValue('Version/Value', OpkVersion, 0);
FXML.SetDeleteValue('Count/Value', SerializablePackages.Count, 0);
for I := 0 to SerializablePackages.Count - 1 do
begin
Package := SerializablePackages.Items[I];
Path := 'Package' + IntToStr(I) + '/';
FXML.SetDeleteValue(Path + 'Name', Package.Name, '');
FXML.SetDeleteValue(Path + 'DownloadZipURL', Package.DownloadZipURL, '');
FXML.SetDeleteValue(Path + 'Count', SerializablePackages.Items[I].PackageFiles.Count, 0);
for J := 0 to SerializablePackages.Items[I].PackageFiles.Count - 1 do
begin
Inc(Count);
Path := 'Item' + IntToStr(Count);
SubPath := Path + 'PackageFile' + IntToStr(J) + '/';
PackageFile := TPackageFile(SerializablePackages.Items[I].PackageFiles.Items[J]);
FXML.SetDeleteValue('Items/' + Path + '/PackageName', Package.Name, '');
FXML.SetDeleteValue('Items/' + Path + '/ForceNotify', Package.ForceNotify, False);
FXML.SetDeleteValue('Items/' + Path + '/DownloadZipURL', Package.DownloadZipURL, '');
FXML.SetDeleteValue('Items/' + Path + '/PackageFileName', PackageFile.Name, '');
FXML.SetDeleteValue('Items/' + Path + '/UpdateVersion', PackageFile.UpdateVersion, '');
FXML.SetDeleteValue(SubPath + 'Name', PackageFile.Name, '');
FXML.SetDeleteValue(SubPath + 'UpdateVersion', PackageFile.UpdateVersion, '');
FXML.SetDeleteValue(SubPath + 'ForceNotify', PackageFile.ForceNotify, False);
FXML.SetDeleteValue(SubPath + 'InternalVersion', PackageFile.InternalVersion, 0);
FXML.SetDeleteValue(SubPath + 'InternalVersionOld', PackageFile.InternalVersionOld, 0);
end;
end;
FXML.SetDeleteValue('Count/Value', Count + 1, 0);
FXML.Flush;
end;
@ -274,16 +315,29 @@ end;
procedure TUpdates.AssignPackageData(APackage: TPackage);
var
I: Integer;
HasUpdate: Boolean;
PackageFile: TPackageFile;
begin
HasUpdate := False;
APackage.DownloadZipURL := FUpdatePackage.FUpdatePackageData.DownloadZipURL;
APackage.ForceNotify := FUpdatePackage.FUpdatePackageData.ForceNotify;
for I := 0 to FUpdatePackage.FUpdatePackageFiles.Count - 1 do
begin
PackageFile := APackage.FindPackageFile(TUpdatePackageFiles(FUpdatePackage.FUpdatePackageFiles.Items[I]).Name);
if PackageFile <> nil then
begin
PackageFile.UpdateVersion := TUpdatePackageFiles(FUpdatePackage.FUpdatePackageFiles.Items[I]).Version;
PackageFile.ForceNotify := TUpdatePackageFiles(FUpdatePackage.FUpdatePackageFiles.Items[I]).ForceNotify;
PackageFile.InternalVersion := TUpdatePackageFiles(FUpdatePackage.FUpdatePackageFiles.Items[I]).InternalVersion;
PackageFile.HasUpdate := (PackageFile.UpdateVersion <> '') and (PackageFile.InstalledFileVersion <> '') and
(
((not PackageFile.ForceNotify) and (PackageFile.UpdateVersion > PackageFile.InstalledFileVersion)) or
((PackageFile.ForceNotify) and (PackageFile.InternalVersion > PackageFile.InternalVersionOld))
);
if not HasUpdate then
HasUpdate := PackageFile.HasUpdate;
end;
end;
APackage.HasUpdate := HasUpdate;
end;
procedure TUpdates.ResetPackageData(APackage: TPackage);
@ -292,14 +346,19 @@ var
PackageFile: TPackageFile;
begin
APackage.DownloadZipURL := '';
APackage.ForceNotify := False;
APackage.HasUpdate := False;
for I := 0 to APackage.PackageFiles.Count - 1 do
begin
PackageFile := APackage.FindPackageFile(TPackageFile(APackage.PackageFiles.Items[I]).Name);
if PackageFile <> nil then
begin
PackageFile.HasUpdate := False;
PackageFile.UpdateVersion := '';
PackageFile.ForceNotify := False;
PackageFile.InternalVersion := 0;
PackageFile.InternalVersionOld := 0;
end;
end;
end;
procedure TUpdates.DoOnTimer(Sender: TObject);

88
components/onlinepackagemanager/opkman_visualtree.pas
View File

@ -62,8 +62,8 @@ type
HomePageURL: String;
DownloadURL: String;
DownloadZipURL: String;
ForceUpadate: Boolean;
HasUpdate: Boolean;
IsUpdated: Boolean;
SVNURL: String;
InstallState: Integer;
ButtonID: Integer;
@ -139,6 +139,7 @@ type
procedure UpdatePackageStates;
procedure UpdatePackageUStatus;
function ResolveDependencies: TModalResult;
function GetCheckedRepositoryPackages: Integer;
published
property OnChecking: TOnChecking read FOnChecking write FOnChecking;
property OnChecked: TNotifyEvent read FOnChecked write FOnChecked;
@ -296,6 +297,7 @@ begin
Data^.PackageDisplayName := SerializablePackages.Items[I].DisplayName;
Data^.PackageState := SerializablePackages.Items[I].PackageState;
Data^.InstallState := SerializablePackages.GetPackageInstallState(SerializablePackages.Items[I]);
Data^.HasUpdate := SerializablePackages.Items[I].HasUpdate;
Data^.DataType := 1;
for J := 0 to SerializablePackages.Items[I].PackageFiles.Count - 1 do
begin
@ -309,6 +311,7 @@ begin
ChildData^.UpdateVersion := PackageFile.UpdateVersion;
ChildData^.Version := PackageFile.VersionAsString;
ChildData^.PackageState := PackageFile.PackageState;
ChildData^.HasUpdate := PackageFile.HasUpdate;
ChildData^.DataType := 2;
//add description(DataType = 3)
GrandChildNode := FVST.AddChild(ChildNode);
@ -971,8 +974,8 @@ end;
procedure TVisualTree.UpdatePackageUStatus;
var
Node, ParentNode: PVirtualNode;
Data, ParentData: PData;
Node: PVirtualNode;
Data: PData;
Package: TPackage;
PackageFile: TPackageFile;
begin
@ -986,15 +989,9 @@ begin
if Package <> nil then
begin
Data^.DownloadZipURL := Package.DownloadZipURL;
Data^.ForceUpadate := Package.ForceNotify;
Data^.HasUpdate := Package.HasUpdate;
FVST.ReinitNode(Node, False);
FVST.RepaintNode(Node);
if (Package.ForceNotify) and (SerializablePackages.GetPackageInstallState(Package) > 0) then
begin
Data^.HasUpdate := True;
FVST.ReinitNode(Node, False);
FVST.RepaintNode(Node);
end;
end;
end;
if Data^.DataType = 2 then
@ -1003,19 +1000,9 @@ begin
if PackageFile <> nil then
begin
Data^.UpdateVersion := PackageFile.UpdateVersion;
Data^.HasUpdate := PackageFile.HasUpdate;
FVST.ReinitNode(Node, False);
FVST.RepaintNode(Node);
if (Data^.InstalledVersion <> '') and (Trim(Data^.UpdateVersion) <> '') then
begin
ParentNode := Node^.Parent;
ParentData := FVST.GetNodeData(ParentNode);
Data^.HasUpdate := (Data^.UpdateVersion > Data^.InstalledVersion) or (ParentData^.ForceUpadate);
ParentData^.HasUpdate := Data^.HasUpdate;
FVST.ReinitNode(Node, False);
FVST.RepaintNode(Node);
FVST.ReinitNode(ParentNode, False);
FVST.RepaintNode(ParentNode);
end;
end;
end;
Node := FVST.GetNext(Node);
@ -1169,6 +1156,24 @@ begin
end;
end;
function TVisualTree.GetCheckedRepositoryPackages: Integer;
var
Node: PVirtualNode;
Data: PData;
begin
Result := 0;
Node := FVST.GetFirst;
while Assigned(Node) do
begin
Data := FVST.GetNodeData(Node);
if (Data^.DataType = 1) and ((FVST.CheckState[Node] = csCheckedNormal) or (FVST.CheckState[Node] = csMixedNormal)) then
Inc(Result);
if Result > 1 then
Break;
Node := FVST.GetNext(Node);
end;
end;
procedure TVisualTree.VSTCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
@ -1309,13 +1314,26 @@ begin
1: CellText := rsMainFrm_VSTText_PackageState1;
2: CellText := rsMainFrm_VSTText_PackageState2;
3: begin
if Data^.HasUpdate then
CellText := rsMainFrm_VSTText_PackageState5
else
if (Data^.UpdateVersion = '') or (Data^.UpdateVersion = Data^.InstalledVersion) then
CellText := rsMainFrm_VSTText_PackageState4
if not Data^.HasUpdate then
begin
if (Data^.UpdateVersion = '') then
begin
if Data^.InstalledVersion >= Data^.Version then
CellText := rsMainFrm_VSTText_PackageState4
else
CellText := rsMainFrm_VSTText_PackageState5
end
else
CellText := rsMainFrm_VSTText_PackageState3
begin
if (Data^.InstalledVersion >= Data^.UpdateVersion) then
CellText := rsMainFrm_VSTText_PackageState4
else
CellText := rsMainFrm_VSTText_PackageState6
end;
end
else
CellText := rsMainFrm_VSTText_PackageState6;
Data^.IsUpdated := CellText = rsMainFrm_VSTText_PackageState4;
end;
end;
3: CellText := GetDisplayString(Data^.Description);
@ -1380,7 +1398,7 @@ procedure TVisualTree.VSTPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
var
Data, ParentData: PData;
Data: PData;
begin
Data := FVST.GetNodeData(Node);
case column of
@ -1401,13 +1419,10 @@ begin
3: begin
case Data^.DataType of
1: TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
2: begin
ParentData := FVST.GetNodeData(Node^.Parent);
if (Data^.UpdateVersion > Data^.InstalledVersion) or (ParentData^.HasUpdate) then
TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]
else
TargetCanvas.Font.Style := TargetCanvas.Font.Style - [fsBold];
end;
2: if Data^.HasUpdate then
TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]
else
TargetCanvas.Font.Style := TargetCanvas.Font.Style - [fsBold];
end;
if Node <> Sender.FocusedNode then
TargetCanvas.Font.Color := clBlack
@ -1423,8 +1438,7 @@ begin
else
TargetCanvas.Font.Color := clWhite;
end
else if (Data^.DataType = 2) and (not Data^.HasUpdate) and (Data^.InstalledVersion <> '') and
((Data^.UpdateVersion = '') or (Data^.UpdateVersion = Data^.InstalledVersion)) then
else if (Data^.DataType = 2) and (Data^.IsUpdated) then
begin
TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
if Node <> Sender.FocusedNode then