1 {
2  ***************************************************************************
3  *                                                                         *
4  *   This source is free software; you can redistribute it and/or modify   *
5  *   it under the terms of the GNU General Public License as published by  *
6  *   the Free Software Foundation; either version 2 of the License, or     *
7  *   (at your option) any later version.                                   *
8  *                                                                         *
9  *   This code is distributed in the hope that it will be useful, but      *
10  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12  *   General Public License for more details.                              *
13  *                                                                         *
14  *   A copy of the GNU General Public License is available on the World    *
15  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16  *   obtain it by writing to the Free Software Foundation,                 *
17  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18  *                                                                         *
19  ***************************************************************************
20 
21  Author: Balázs Székely
22 }
23 
24 unit opkman_createrepositoryfrm;
25 
26 {$mode objfpc}{$H+}
27 
28 interface
29 
30 uses
31   Classes, SysUtils, FileUtil, fpjson, laz.VirtualTrees,
32   // LCL
33   Forms, Controls, Graphics, Dialogs, ExtCtrls,
34   StdCtrls, Buttons, Menus,
35   // IDEIntf
36   PackageIntf,
37   // LazUtils
38   LazFileUtils, LazUTF8,
39   // OpkMan
40   opkman_serializablepackages, opkman_maindm;
41 
42 type
43 
44   PRepository = ^TRepository;
45   TRepository = record
46     FName: String;
47     FPath: String;
48     FAddress: String;
49     FDescription: String;
50   end;
51 
52 
53   { TCreateRepositoryFrm }
54 
55   TCreateRepositoryFrm = class(TForm)
56     bCancel: TButton;
57     bAdd: TBitBtn;
58     bDelete: TBitBtn;
59     bOpen: TButton;
60     bCreate: TButton;
61     miRepDetails: TMenuItem;
62     ODRep: TOpenDialog;
63     pnButtons: TPanel;
64     pnMessage: TPanel;
65     pnPackages: TPanel;
66     pnDetails: TPanel;
67     pm: TPopupMenu;
68     spMain: TSplitter;
69     tmWait: TTimer;
70     procedure bAddClick(Sender: TObject);
71     procedure bCreateClick(Sender: TObject);
72     procedure bDeleteClick(Sender: TObject);
73     procedure bOpenClick(Sender: TObject);
74     procedure FormCreate(Sender: TObject);
75     procedure FormDestroy(Sender: TObject);
76     procedure FormShow(Sender: TObject);
77     procedure miRepDetailsClick(Sender: TObject);
78     procedure pnButtonsResize(Sender: TObject);
79     procedure tmWaitTimer(Sender: TObject);
80   private
81     FVSTPackages: TLazVirtualStringTree;
82     FVSTDetails: TLazVirtualStringTree;
83     FRepository: TRepository;
84     FSortDirection: TSortDirection;
85     FSerializablePackages: TSerializablePackages;
86     procedure EnableDisableButtons(const AEnable: Boolean);
87     procedure ShowHideControls(const AType: Integer);
LoadRepositorynull88     function LoadRepository(const AFileName: String): Boolean;
SaveRepositorynull89     function SaveRepository(const AFileName: String): Boolean;
90     procedure PopulatePackageTree;
91     procedure AddNewPackage;
92     procedure AddExistingPackage(const AJSONFile, APackageFile: String);
GetDisplayStringnull93     function GetDisplayString(const AStr: String): String;
LoadJSONFromFilenull94     function LoadJSONFromFile(const AFileName: String; out AJSON: TJSONStringType): Boolean;
SaveJSONToFilenull95     function SaveJSONToFile(const AFileName: String; const AJSON: TJSONStringType): Boolean;
IsDuplicatePackagenull96     function IsDuplicatePackage(const AJSON: TJSONStringType; const APackageFile: String): Boolean;
97     procedure VSTPackagesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
98       {%H-}Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String);
99     procedure VSTPackagesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
100       {%H-}Kind: TVTImageKind; {%H-}Column: TColumnIndex; var {%H-}Ghosted: Boolean;
101       var ImageIndex: Integer);
102     procedure VSTPackagesHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
103     procedure VSTPackagesCompareNodes(Sender: TBaseVirtualTree; Node1,
104       Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
105     procedure VSTPackagesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
106       {%H-}Column: TColumnIndex);
107     procedure VSTPackagesFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
108 
109     procedure VSTDetailsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
110       {%H-}Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String);
111     procedure VSTDetailsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
112       {%H-}Kind: TVTImageKind; {%H-}Column: TColumnIndex; var {%H-}Ghosted: Boolean;
113       var ImageIndex: Integer);
114     procedure VSTDetailsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
115   public
116 
117   end;
118 
119 var
120   CreateRepositoryFrm: TCreateRepositoryFrm;
121 
122 implementation
123 
124 uses opkman_common, opkman_const, opkman_options, opkman_repositorydetailsfrm,
125      opkman_addrepositorypackagefrm, opkman_createrepositorypackagefrm;
126 
127 {$R *.lfm}
128 
129 { TCreateRepositoryFrm }
130 
131 type
132   PData = ^TData;
133   TData = record
134     FRepository: TRepository;
135     FPackageRelativePath: String;
136     FPackageBaseDir: String;
137     FFullPath: String;
138     FDataType: Integer;
139     FName: String;
140     FDisplayName: String;
141     FPackageType: TLazPackageType;
142     FRepositoryFileName: String;
143     FRepositoryFileSize: Int64;
144     FRepositoryFileHash: String;
145     FRepositoryDate: TDateTime;
146     FAuthor: String;
147     FDescription: String;
148     FLicense: String;
149     FVersionAsString: String;
150     FDependenciesAsString: String;
151     FCategory: String;
152     FLazCompatibility: String;
153     FFPCCompatibility: String;
154     FSupportedWidgetSet: String;
155     FHomePageURL: String;
156     FDownloadURL: String;
157     FSVNURL: String;
158     FCommunityDescription: String;
159     FExternalDependencies: String;
160     FOrphanPackage: Integer;
161   end;
162 
163 procedure TCreateRepositoryFrm.FormCreate(Sender: TObject);
164 begin
165   Caption := rsCreateRepositoryFrm_Caption;
166   bCreate.Caption := rsCreateRepositoryFrm_bCreate_Caption;
167   bCreate.Hint := rsCreateRepositoryFrm_bCreate_Hint;
168   bOpen.Caption := rsCreateRepositoryFrm_bOpen_Caption;
169   bOpen.Hint := rsCreateRepositoryFrm_bOpen_Hint;
170   bAdd.Caption := rsCreateRepositoryFrm_bAdd_Caption;
171   bAdd.Hint := rsCreateRepositoryFrm_bAdd_Hint;
172   bAdd.Images := MainDM.Images;
173   bAdd.ImageIndex := IMG_PKG_PLUS;
174   bDelete.Caption := rsCreateRepositoryFrm_bDelete_Caption;
175   bDelete.Hint := rsCreateRepositoryFrm_bDelete_Hint;
176   bDelete.Images := MainDM.Images;
177   bDelete.ImageIndex := IMG_PKG_MINUS;
178   bCancel.Caption := rsCreateRepositoryFrm_bCancel_Caption;
179   bCancel.Hint := rsCreateRepositoryFrm_bCancel_Hint;
180   miRepDetails.Caption := rsCreateRepositoryFrm_miRepDetails_Caption;
181   FSortDirection := sdAscending;
182   EnableDisableButtons(True);
183   ShowHideControls(0);
184 
185   FSerializablePackages := TSerializablePackages.Create;
186   FVSTPackages := TLazVirtualStringTree.Create(nil);
187   with FVSTPackages do
188   begin
189     NodeDataSize := SizeOf(TData);
190     Parent := pnPackages;
191     Align := alClient;
192     Images := MainDM.Images;
193     if not Options.UseDefaultTheme then
194       Color := clBtnFace;
195     DefaultNodeHeight := Scale96ToForm(25);
196     Indent := Scale96ToForm(15);
197     TabOrder := 1;
198     DefaultText := '';
199     Header.AutoSizeIndex := 0;
200     Header.Height := Scale96ToForm(25);
201     Colors.BorderColor := clBlack;
202     with Header.Columns.Add do begin
203       Position := 0;
204       Width := Scale96ToForm(300);
205       Text := rsCreateRepositoryFrm_VSTPackages_Column0;
206     end;
207     Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoVisible, hoAutoSpring];
208     Header.SortColumn := 0;
209     TabOrder := 0;
210     TreeOptions.MiscOptions := [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning];
211     TreeOptions.PaintOptions := [toHideFocusRect, toPopupMode, toShowButtons, toShowDropmark, toShowRoot, toThemeAware, toUseBlendedImages];
212     TreeOptions.SelectionOptions := [toRightClickSelect];
213     TreeOptions.AutoOptions := [toAutoTristateTracking];
214     IncrementalSearch := isAll;
215     IncrementalSearchDirection := sdForward;
216     IncrementalSearchStart := ssAlwaysStartOver;
217     IncrementalSearchTimeout := 1500;
218     PopupMenu := pm;
219     OnGetText := @VSTPackagesGetText;
220     OnGetImageIndex := @VSTPackagesGetImageIndex;
221     OnHeaderClick := @VSTPackagesHeaderClick;
222     OnCompareNodes := @VSTPackagesCompareNodes;
223     OnFocusChanged := @VSTPackagesFocusChanged;
224     OnFreeNode := @VSTPackagesFreeNode;
225   end;
226 
227   FVSTDetails := TLazVirtualStringTree.Create(nil);
228   with FVSTDetails do
229   begin
230     NodeDataSize := SizeOf(TData);
231     Parent := pnDetails;
232     Align := alClient;
233     Images := MainDM.Images;
234     if not Options.UseDefaultTheme then
235       Color := clBtnFace;
236     DefaultNodeHeight := Scale96ToForm(25);
237     Indent := Scale96ToForm(15);
238     TabOrder := 0;
239     DefaultText := '';
240     Header.AutoSizeIndex := 1;
241     Header.Height := Scale96ToForm(25);
242     Colors.BorderColor := clBlack;
243     with Header.Columns.Add do begin
244       Position := 0;
245       Width := Scale96ToForm(200);
246       Text := rsCreateRepositoryFrm_VSTDetails_Column0;
247     end;
248     with Header.Columns.Add do begin
249       Position := 1;
250       Width := Scale96ToForm(250);
251       Text := rsCreateRepositoryFrm_VSTDetails_Column1;
252     end;
253     Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoVisible, hoAutoSpring];
254     Header.SortColumn := 0;
255     TreeOptions.MiscOptions := [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning];
256     TreeOptions.PaintOptions := [toHideFocusRect, toPopupMode, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages];
257     TreeOptions.SelectionOptions := [toRightClickSelect, toFullRowSelect];
258     TreeOptions.AutoOptions := [toAutoTristateTracking];
259     PopupMenu := pm;
260     OnGetText := @VSTDetailsGetText;
261     OnGetImageIndex := @VSTDetailsGetImageIndex;
262     OnFreeNode := @VSTDetailsFreeNode;
263   end;
264 end;
265 
266 procedure TCreateRepositoryFrm.bCreateClick(Sender: TObject);
267 var
268   RepositoryDetailsFrm: TRepositoryDetailsFrm;
269 begin
270   RepositoryDetailsFrm := TRepositoryDetailsFrm.Create(Self);
271   try
272     RepositoryDetailsFrm.IsNew := True;
273     RepositoryDetailsFrm.ShowModal;
274     if RepositoryDetailsFrm.ModalResult = mrOk then
275     begin
276       FRepository.FName := RepositoryDetailsFrm.edName.Text;
277       FRepository.FAddress := RepositoryDetailsFrm.edAddress.Text;
278       FRepository.FDescription := RepositoryDetailsFrm.mDescription.Text;
279       if SaveRepository(RepositoryDetailsFrm.FileName) then
280         if LoadRepository(RepositoryDetailsFrm.FileName) then
281            PopulatePackageTree;
282     end;
283   finally
284     RepositoryDetailsFrm.Free;
285   end;
286 end;
287 
288 procedure TCreateRepositoryFrm.bDeleteClick(Sender: TObject);
289 var
290   Node: PVirtualNode;
291   Data: PData;
292   PackageFile: String;
293   PackageIndex: Integer;
294   CanGo: Boolean;
295   JSON: TJSONStringType;
296 begin
297   Node := FVSTPackages.GetFirstSelected;
298   if Node <> nil then
299   begin
300     Data := FVSTPackages.GetNodeData(Node);
301     if Data^.FDataType = 1 then
302     begin
303       if MessageDlgEx(Format(rsCreateRepositoryFrm_Conf1, [Data^.FDisplayname]), mtConfirmation, [mbYes, mbNo], Self) = mrNo then
304         Exit;
305       CanGo := False;
306       PackageIndex := FSerializablePackages.FindPackageIndex(Data^.FName, fpbPackageName);
307       if PackageIndex <> -1 then
308       begin
309         PackageFile := ExtractFilePath(FRepository.FPath) + Data^.FRepositoryFileName;
310         FSerializablePackages.DeletePackage(PackageIndex);
311         JSON := '';
312         if FSerializablePackages.PackagesToJSON(JSON) then
313         begin
314           if SaveJSONToFile(ExtractFilePath(FRepository.FPath) + cRemoteJSONFile, JSON) then
315           begin
316             DeleteFile(PackageFile);
317             if LoadRepository(FRepository.FPath) then
318             begin
319               CanGo := True;
320               PopulatePackageTree;
321             end;
322           end;
323         end;
324       end;
325       if not CanGo then
326         MessageDlgEx(Format(rsCreateRepositoryFrm_Error5, [Data^.FDisplayname]), mtError, [mbOk], Self);
327     end;
328   end;
329 end;
330 
IsDuplicatePackagenull331 function TCreateRepositoryFrm.IsDuplicatePackage(const AJSON: TJSONStringType;
332   const APackageFile: String): Boolean;
333 var
334   SP: TSerializablePackages;
335   MetaPackage: TMetaPackage;
336   LazarusPackage: TLazarusPackage;
337   TargetPackageFile: String;
338   I: Integer;
339 begin
340   Result := False;
341   SP := TSerializablePackages.Create;
342   try
343     if SP.JSONToPackages(AJSON) then
344     begin
345       MetaPackage := FSerializablePackages.FindMetaPackage(SP.Items[0].Name, fpbPackageName);
346       if MetaPackage <> nil then
347       begin
348         Result := True;
349         MessageDlgEx(Format(rsCreateRepositoryFrm_Info3, [MetaPackage.DisplayName]), mtInformation, [mbOk], Self);
350       end;
351 
352       if not Result then
353       begin
354         for I := 0 to SP.Items[0].LazarusPackages.Count - 1 do
355         begin
356           LazarusPackage := FSerializablePackages.FindLazarusPackage(TLazarusPackage(SP.Items[0].LazarusPackages.Items[I]).Name);
357           if LazarusPackage <> nil then
358           begin
359             Result := True;
360             MessageDlgEx(Format(rsCreateRepositoryFrm_Info5, [TLazarusPackage(SP.Items[0].LazarusPackages.Items[I]).Name]), mtInformation, [mbOk], Self);
361             Break;
362           end;
363         end;
364 
365         if not Result then
366         begin
367           TargetPackageFile := AppendPathDelim(ExtractFilePath(FRepository.FPath)) + ExtractFileName(APackageFile);
368           if TargetPackageFile <> APackageFile then
369           begin
370             if FileExists(TargetPackageFile) then
371               if MessageDlgEx(Format(rsCreateRepositoryFrm_Conf2, [TargetPackageFile]), mtInformation, [mbYes, mbNo], Self) = mrNo then
372                 Result := True;
373 
374             if (not Result) and (not CopyFile(APackageFile, TargetPackageFile, [cffOverwriteFile], True)) then
375               Result := True;
376           end;
377         end;
378       end;
379     end;
380   finally
381     SP.Free;
382   end;
383 end;
384 
385 procedure TCreateRepositoryFrm.AddNewPackage;
386 var
387   CreateRepositoryPackagesFrm: TCreateRepositoryPackagesFrm;
388   JSON: TJSONStringType;
389   CanGo: Boolean;
390 begin
391   CreateRepositoryPackagesFrm := TCreateRepositoryPackagesFrm.Create(Self);
392   try
393     with CreateRepositoryPackagesFrm do
394     begin
395       SetType(1);
396       DestDir := AppendPathDelim(AppendPathDelim(ExtractFilePath(FRepository.FPath)) + 'Temp');
397       if not DirectoryExists(DestDir) then
398         CreateDir(DestDir);
399       ShowModal;
400       if ModalResult = mrOk then
401       begin
402         CanGo := False;
403         if FileExists(PackageFile) and FileExists(JSONFile) then
404         begin
405           if LoadJSONFromFile(JSONFile, JSON) then
406           begin
407             if not IsDuplicatePackage(JSON, PackageFile) then
408             begin
409               if FSerializablePackages.AddPackageFromJSON(JSON) then
410               begin
411                 JSON := '';
412                 FSerializablePackages.Sort(stName, soAscendent);
413                 if FSerializablePackages.PackagesToJSON(JSON) then
414                 begin
415                   if SaveJSONToFile(ExtractFilePath(FRepository.FPath) + cRemoteJSONFile, JSON) then
416                   begin
417                     if LoadRepository(FRepository.FPath) then
418                     begin
419                       CanGo := True;
420                       PopulatePackageTree;
421                     end;
422                   end;
423                 end;
424               end;
425             end;
426           end;
427           DeleteDirectory(DestDir, False);
428         end;
429         if not CanGo then
430           MessageDlgEx(rsCreateRepositoryFrm_Error4, mtError, [mbOk], Self)
431         else
432           MessageDlgEx(rsCreateRepositoryFrm_Info7, mtInformation, [mbOk], Self);
433       end;
434     end;
435   finally
436     CreateRepositoryPackagesFrm.Free;
437   end;
438 end;
439 
440 procedure TCreateRepositoryFrm.AddExistingPackage(const AJSONFile,
441   APackageFile: String);
442 var
443   JSON: TJSONStringType;
444   CanGo: Boolean;
445 begin
446   CanGo := False;
447   if LoadJSONFromFile(AJSONFile, JSON) then
448   begin
449     if not IsDuplicatePackage(JSON, APackageFile) then
450     begin
451       if FSerializablePackages.AddPackageFromJSON(JSON) then
452       begin
453         JSON := '';
454         FSerializablePackages.Sort(stName, soAscendent);
455         if FSerializablePackages.PackagesToJSON(JSON) then
456         begin
457           if SaveJSONToFile(ExtractFilePath(FRepository.FPath) + cRemoteJSONFile, JSON) then
458           begin
459             if LoadRepository(FRepository.FPath) then
460             begin
461               CanGo := True;
462               PopulatePackageTree;
463             end;
464           end;
465         end;
466       end;
467     end;
468   end;
469   if not CanGo then
470     MessageDlgEx(rsCreateRepositoryFrm_Error4, mtError, [mbOk], Self)
471   else
472     MessageDlgEx(rsCreateRepositoryFrm_Info7, mtInformation, [mbOk], Self);
473 end;
474 
475 procedure TCreateRepositoryFrm.bAddClick(Sender: TObject);
476 begin
477   AddRepositoryPackageFrm := TAddRepositoryPackageFrm.Create(Self);
478   try
479     AddRepositoryPackageFrm.ShowModal;
480     if AddRepositoryPackageFrm.ModalResult = mrOk then
481     begin
482       if AddRepositoryPackageFrm.rbCreateNew.Checked then
483         AddNewPackage
484       else
485         AddExistingPackage(AddRepositoryPackageFrm.JSONFile, AddRepositoryPackageFrm.PackageFile);
486       FVSTPackages.SortTree(0, FSortDirection);
487     end;
488   finally
489     AddRepositoryPackageFrm.Free;
490   end;
491 end;
492 
493 procedure TCreateRepositoryFrm.bOpenClick(Sender: TObject);
494 begin
495   if ODRep.Execute then
496     if LoadRepository(ODRep.FileName) then
497       PopulatePackageTree;
498 end;
499 
500 procedure TCreateRepositoryFrm.FormDestroy(Sender: TObject);
501 begin
502   FVSTPackages.Free;
503   FVSTDetails.Free;
504   FSerializablePackages.Free
505 end;
506 
507 procedure TCreateRepositoryFrm.FormShow(Sender: TObject);
508 begin
509   tmWait.Enabled := True;
510 end;
511 
512 procedure TCreateRepositoryFrm.miRepDetailsClick(Sender: TObject);
513 var
514   RepositoryDetailsFrm: TRepositoryDetailsFrm;
515   Node: PVirtualNode;
516   Data: PData;
517 begin
518   RepositoryDetailsFrm := TRepositoryDetailsFrm.Create(Self);
519   try
520     RepositoryDetailsFrm.edName.Text := FRepository.FName;
521     RepositoryDetailsFrm.edAddress.Text := FRepository.FAddress;
522     RepositoryDetailsFrm.mDescription.Text := FRepository.FDescription;
523     RepositoryDetailsFrm.IsNew := False;
524     RepositoryDetailsFrm.ShowModal;
525     if RepositoryDetailsFrm.ModalResult = mrOk then
526     begin
527       if FRepository.FName <> RepositoryDetailsFrm.edName.Text then
528       begin
529         Node := FVSTPackages.GetFirst;
530         if Node <> nil then
531         begin
532           Data := FVSTPackages.GetNodeData(Node);
533           if Data^.FDataType = 0 then
534           begin
535             Data^.FName := RepositoryDetailsFrm.edName.Text;
536             FVSTPackages.ReinitNode(Node, False);
537             FVSTPackages.RepaintNode(Node);
538           end;
539         end;
540       end;
541       FRepository.FName := RepositoryDetailsFrm.edName.Text;
542       FRepository.FAddress := RepositoryDetailsFrm.edAddress.Text;
543       FRepository.FDescription := RepositoryDetailsFrm.mDescription.Text;
544       if SaveRepository(FRepository.FPath) then
545         if LoadRepository(FRepository.FPath) then
546           PopulatePackageTree;
547     end;
548   finally
549     RepositoryDetailsFrm.Free;
550   end;
551 end;
552 
553 procedure TCreateRepositoryFrm.tmWaitTimer(Sender: TObject);
554 begin
555   tmWait.Enabled := False;
556   if (Options.LastPrivateRepository <> '') and (FileExists(Options.LastPrivateRepository)) then
557   begin
558     if LoadRepository(Options.LastPrivateRepository) then
559       PopulatePackageTree;
560   end;
561 end;
562 
563 procedure TCreateRepositoryFrm.pnButtonsResize(Sender: TObject);
564 begin
565   bAdd.Left := (pnButtons.Width - (bAdd.Width + bDelete.Width)) div 2;
566   bDelete.Left := bAdd.Left + bAdd.Width + 1;
567 end;
568 
569 procedure TCreateRepositoryFrm.EnableDisableButtons(const AEnable: Boolean);
570 var
571   Node: PVirtualNode;
572   Data: PData;
573 begin
574   bOpen.Enabled := AEnable;
575   bCreate.Enabled := AEnable;
576   bAdd.Enabled := AEnable and FileExists(Trim(FRepository.FPath));
577   bCancel.Enabled := AEnable;
578   if Assigned(FVSTPackages) then
579   begin
580     Node := FVSTPackages.GetFirstSelected;
581     if Node <> nil then
582     begin
583       Data := FVSTPackages.GetNodeData(Node);
584       bDelete.Enabled := AEnable and FileExists(Trim(FRepository.FPath)) and (Data^.FDataType = 1);
585     end
586     else
587       bDelete.Enabled := False;
588   end
589   else
590     bDelete.Enabled := False;
591 end;
592 
593 procedure TCreateRepositoryFrm.ShowHideControls(const AType: Integer);
594 begin
595   case AType of
596     0: begin
597          pnPackages.Visible := False;
598          pnDetails.Visible := False;
599          pnMessage.Visible := False;
600        end;
601     1: begin
602          pnPackages.Visible := False;
603          pnDetails.Visible := False;
604          pnMessage.Visible := True;
605        end;
606     2: begin
607          pnPackages.Visible := True;
608          pnDetails.Visible := True;
609          pnMessage.Visible := False;
610        end;
611   end;
612 end;
613 
LoadRepositorynull614 function TCreateRepositoryFrm.LoadRepository(const AFileName: String): Boolean;
615 var
616   FS: TFileStream;
617   DestDir: String;
618 begin
619   Result := False;
620   FS := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
621   try
622     try
623       FRepository.FName := FS.ReadAnsiString;
624       FRepository.FAddress := FS.ReadAnsiString;
625       FRepository.FDescription := FS.ReadAnsiString;
626       FRepository.FPath := AFileName;
627       Caption := rsCreateRepositoryFrm_Caption + '(' + AFileName + ')';
628       Options.LastPrivateRepository := AFileName;
629       Options.Changed := True;
630       DestDir := AppendPathDelim(AppendPathDelim(ExtractFilePath(AFileName)) + 'Temp');
631       if DirectoryExists(DestDir) then
632         DeleteDirectory(DestDir, False);
633       Result := True;
634     except
635       on E: Exception do
636       begin
637         MessageDlgEx(Format(rsCreateRepositoryFrm_Error1, [AFileName, E.Message]), mtError, [mbOk], Self);
638         Options.LastPrivateRepository := '';
639         Options.Changed := True;
640       end;
641     end;
642   finally
643     FS.Free;
644   end;
645 end;
646 
SaveRepositorynull647 function TCreateRepositoryFrm.SaveRepository(const AFileName: String): Boolean;
648 var
649   FS: TFileStream;
650 begin
651   Result := False;
652   FS := TFileStream.Create(AFileName, fmCreate or fmOpenWrite or fmShareDenyWrite);
653   try
654     try
655       FS.WriteAnsiString(FRepository.FName);
656       FS.WriteAnsiString(FRepository.FAddress);
657       FS.WriteAnsiString(FRepository.FDescription);
658       Result := True;
659     except
660       on E: Exception do
661         MessageDlgEx(Format(rsCreateRepositoryFrm_Error3, [AFileName, E.Message]), mtError, [mbOk], Self);
662     end;
663   finally
664     FS.Free;
665   end;
666 end;
667 
668 procedure TCreateRepositoryFrm.PopulatePackageTree;
669 var
670   RootNode, Node, ChildNode: PVirtualNode;
671   RootData, Data, ChildData: PData;
672   JSON: TJSONStringType;
673   i, j: Integer;
674   MetaPackage: TMetaPackage;
675   LazarusPackage: TLazarusPackage;
676 begin
677 
678   FVSTPackages.Clear;
679   FVSTPackages.NodeDataSize := SizeOf(TData);
680 
681   //add repository(DataType = 0)
682   RootNode := FVSTPackages.AddChild(nil);
683   RootData := FVSTPackages.GetNodeData(RootNode);
684   RootData^.FName := FRepository.FName;
685   RootData^.FDataType := 0;
686 
687   if LoadJSONFromFile(ExtractFilePath(FRepository.FPath) + cRemoteJSONFile, JSON) then
688   begin
689     FSerializablePackages.JSONToPackages(JSON);
690     for I := 0 to FSerializablePackages.Count - 1 do
691     begin
692       MetaPackage := TMetaPackage(FSerializablePackages.Items[I]);
693       Node := FVSTPackages.AddChild(RootNode);
694       Data := FVSTPackages.GetNodeData(Node);
695       Data^.FDisplayName := MetaPackage.DisplayName;
696       Data^.FName := MetaPackage.Name;
697       Data^.FCategory := MetaPackage.Category;
698       Data^.FRepositoryFileName := MetaPackage.RepositoryFileName;
699       Data^.FRepositoryFileSize := MetaPackage.RepositoryFileSize;
700       Data^.FRepositoryFileHash := MetaPackage.RepositoryFileHash;
701       Data^.FRepositoryDate := MetaPackage.RepositoryDate;
702       Data^.FHomePageURL := MetaPackage.HomePageURL;
703       Data^.FDownloadURL := MetaPackage.DownloadURL;
704       Data^.FCommunityDescription := MetaPackage.CommunityDescription;
705       Data^.FExternalDependencies := MetaPackage.ExternalDependecies;
706       Data^.FOrphanPackage := MetaPackage.OrphanedPackage;
707       Data^.FDataType := 1;
708       for J := 0 to MetaPackage.LazarusPackages.Count - 1 do
709       begin
710         LazarusPackage := TLazarusPackage(MetaPackage.LazarusPackages.Items[J]);
711         ChildNode := FVSTPackages.AddChild(Node);
712         ChildData := FVSTPackages.GetNodeData(ChildNode);
713         ChildData^.FName := LazarusPackage.Name;
714         ChildData^.FVersionAsString := LazarusPackage.VersionAsString;
715         ChildData^.FDescription := LazarusPackage.Description;
716         ChildData^.FAuthor := LazarusPackage.Author;
717         ChildData^.FLazCompatibility := LazarusPackage.LazCompatibility;
718         ChildData^.FFPCCompatibility := LazarusPackage.FPCCompatibility;
719         ChildData^.FSupportedWidgetSet := LazarusPackage.SupportedWidgetSet;
720         ChildData^.FPackageType := LazarusPackage.PackageType;
721         ChildData^.FLicense := LazarusPackage.License;
722         ChildData^.FDependenciesAsString := LazarusPackage.DependenciesAsString;
723         ChildData^.FDataType := 2;
724       end;
725     end;
726   end;
727   //properly init each node to prevent memory leaks
728   FVSTPackages.FullExpand;
729   FVSTPackages.FullCollapse;
730   if RootNode <> nil then
731   begin
732     FVSTPackages.Selected[RootNode] := True;
733     FVSTPackages.FocusedNode := RootNode;
734     FVSTPackages.Expanded[RootNode] := True;
735   end;
736   ShowHideControls(2);
737   EnableDisableButtons(True);
738 end;
739 
TCreateRepositoryFrm.GetDisplayStringnull740 function TCreateRepositoryFrm.GetDisplayString(const AStr: String): String;
741 var
742   SL: TStringList;
743   I: Integer;
744 begin
745   Result := '';
746   SL := TStringList.Create;
747   try
748     SL.Text := AStr;
749     for I := 0 to SL.Count - 1 do
750       if Result = '' then
751         Result := SL.Strings[I]
752       else
753         Result := Result + ' ' + SL.Strings[I];
754   finally
755     SL.Free;
756   end;
757 end;
758 
LoadJSONFromFilenull759 function TCreateRepositoryFrm.LoadJSONFromFile(const AFileName: String;
760   out AJSON: TJSONStringType): Boolean;
761 var
762   MS: TMemoryStream;
763 begin
764   Result := False;
765   if not FileExists(AFileName) then
766     Exit;
767   MS := TMemoryStream.Create;
768   try
769     Ms.LoadFromFile(AFileName);
770     if Ms.Size > 0 then
771     begin
772       Ms.Position := 0;
773       SetLength({%H-}AJSON, MS.Size);
774       MS.Read(Pointer(AJSON)^, Length(AJSON));
775       Result := True;
776     end;
777   finally
778     MS.Free;
779   end;
780 end;
781 
SaveJSONToFilenull782 function TCreateRepositoryFrm.SaveJSONToFile(const AFileName: String;
783   const AJSON: TJSONStringType): Boolean;
784 var
785   MS: TMemoryStream;
786 begin
787   Result := False;
788   MS := TMemoryStream.Create;
789   try
790     Ms.Write(Pointer(AJSON)^, Length(AJSON));
791     Ms.Position := 0;
792     Ms.SaveToFile(AFileName);
793     Result := True;
794   finally
795     MS.Free;
796   end;
797 end;
798 
799 procedure TCreateRepositoryFrm.VSTPackagesGetText(Sender: TBaseVirtualTree;
800   Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
801   var CellText: String);
802 var
803   Data: PData;
804 begin
805   Data := FVSTPackages.GetNodeData(Node);
806   case Data^.FDataType of
807     0: CellText := FRepository.FName;
808     1: CellText := Data^.FDisplayName;
809     2: CellText := Data^.FName;
810   end;
811 end;
812 
813 procedure TCreateRepositoryFrm.VSTPackagesGetImageIndex(Sender: TBaseVirtualTree;
814   Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
815   var Ghosted: Boolean; var ImageIndex: Integer);
816 var
817   Data: PData;
818 begin
819   Data := FVSTPackages.GetNodeData(Node);
820   case Data^.FDataType of
821     0: ImageIndex := 0;
822     1: if Data^.FOrphanPackage = 1 then
823          ImageIndex := 36
824        else
825          ImageIndex := 1;
826 
827     2: ImageIndex := 0;
828   end;
829 end;
830 
831 procedure TCreateRepositoryFrm.VSTPackagesHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
832 begin
833   if HitInfo.Button = mbLeft then
834   begin
835     with Sender, Treeview do
836     begin
837       if (SortColumn = NoColumn) or (SortColumn <> HitInfo.Column) then
838       begin
839         SortColumn    := HitInfo.Column;
840         SortDirection := laz.VirtualTrees.sdAscending;
841       end
842       else
843       begin
844         if SortDirection = laz.VirtualTrees.sdAscending then
845           SortDirection := laz.VirtualTrees.sdDescending
846         else
847           SortDirection := laz.VirtualTrees.sdAscending;
848       end;
849       SortTree(SortColumn, SortDirection, False);
850       FSortDirection := SortDirection;
851     end;
852   end;
853 end;
854 
855 procedure TCreateRepositoryFrm.VSTPackagesCompareNodes(Sender: TBaseVirtualTree; Node1,
856   Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
857 var
858   Data1: PData;
859   Data2: PData;
860 begin
861   Data1 := Sender.GetNodeData(Node1);
862   Data2 := Sender.GetNodeData(Node2);
863   case Column of
864     0: begin
865          if (Data1^.FDataType < Data2^.FDataType) then
866            Result := 0
867          else
868            Result := CompareText(Data1^.FName, Data2^.FName)
869        end;
870   end;
871 end;
872 
873 procedure TCreateRepositoryFrm.VSTPackagesFocusChanged(
874   Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
875 var
876   Data: PData;
877   DetailNode: PVirtualNode;
878   DetailData: PData;
879 begin
880   if Node = nil then
881     Exit;
882 
883   FVSTDetails.Clear;
884   FVSTDetails.NodeDataSize := SizeOf(TData);
885   Data := FVSTPackages.GetNodeData(Node);
886   case Data^.FDataType of
887     0: begin
888          //address
889          DetailNode := FVSTDetails.AddChild(nil);
890          DetailData := FVSTDetails.GetNodeData(DetailNode);
891          DetailData^.FDataType := 17;
892          DetailData^.FRepository.FAddress := FRepository.FAddress;
893          //description
894          DetailNode := FVSTDetails.AddChild(nil);
895          DetailData := FVSTDetails.GetNodeData(DetailNode);
896          DetailData^.FDataType := 3;
897          DetailData^.FRepository.FDescription := FRepository.FDescription;
898        end;
899     1: begin
900          //add category(DataType = 12)
901          DetailNode := FVSTDetails.AddChild(nil);
902          DetailData := FVSTDetails.GetNodeData(DetailNode);
903          DetailData^.FCategory := Data^.FCategory;
904          DetailData^.FDataType := 12;
905          //add Repository Filename(DataType = 13)
906          DetailNode := FVSTDetails.AddChild(nil);
907          DetailData := FVSTDetails.GetNodeData(DetailNode);
908          DetailData^.FRepositoryFileName := Data^.FRepositoryFileName;
909          DetailData^.FDataType := 13;
910          //add Repository Filesize(DataType = 14)
911          DetailNode := FVSTDetails.AddChild(nil);
912          DetailData := FVSTDetails.GetNodeData(DetailNode);
913          DetailData^.FRepositoryFileSize := Data^.FRepositoryFileSize;
914          DetailData^.FDataType := 14;
915          //add Repository Hash(DataType = 15)
916          DetailNode := FVSTDetails.AddChild(nil);
917          DetailData := FVSTDetails.GetNodeData(DetailNode);
918          DetailData^.FRepositoryFileHash := Data^.FRepositoryFileHash;
919          DetailData^.FDataType := 15;
920          //add Repository Date(DataType = 16)
921          DetailNode := FVSTDetails.AddChild(nil);
922          DetailData := FVSTDetails.GetNodeData(DetailNode);
923          DetailData^.FRepositoryDate := Data^.FRepositoryDate;
924          DetailData^.FDataType := 16;
925          FVSTDetails.Expanded[DetailNode] := True;
926          //add HomePageURL(DataType = 17)
927          DetailNode := FVSTDetails.AddChild(nil);
928          DetailData := FVSTDetails.GetNodeData(DetailNode);
929          DetailData^.FHomePageURL := Data^.FHomePageURL;
930          DetailData^.FDataType := 17;
931          //add DownloadURL(DataType = 18)
932          DetailNode := FVSTDetails.AddChild(nil);
933          DetailData := FVSTDetails.GetNodeData(DetailNode);
934          DetailData^.FDownloadURL := Data^.FDownloadURL;
935          DetailData^.FDataType := 18;
936          //add CommunityDescription(DataType = 19)
937          DetailNode := FVSTDetails.AddChild(nil);
938          DetailData := FVSTDetails.GetNodeData(DetailNode);
939          DetailData^.FCommunityDescription := Data^.FCommunityDescription;
940          DetailData^.FDataType := 19;
941          //add ExternalDependencies(DataType = 20)
942          DetailNode := FVSTDetails.AddChild(nil);
943          DetailData := FVSTDetails.GetNodeData(DetailNode);
944          DetailData^.FExternalDependencies := Data^.FExternalDependencies;
945          DetailData^.FDataType := 20;
946          //add OrphanedPackage(DataType = 21)
947          DetailNode := FVSTDetails.AddChild(nil);
948          DetailData := FVSTDetails.GetNodeData(DetailNode);
949          DetailData^.FOrphanPackage := Data^.FOrphanPackage;
950          DetailData^.FDataType := 21;
951 
952 
953        end;
954     2: begin
955          //add description(DataType = 2)
956          DetailNode := FVSTDetails.AddChild(nil);
957          DetailData := FVSTDetails.GetNodeData(DetailNode);
958          DetailData^.FVersionAsString := Data^.FVersionAsString;
959          DetailData^.FDataType := 2;
960          //add description(DataType = 3)
961          DetailNode := FVSTDetails.AddChild(nil);
962          DetailData := FVSTDetails.GetNodeData(DetailNode);
963          DetailData^.FDescription := Data^.FDescription;
964          DetailData^.FDataType := 3;
965          //add author(DataType = 4)
966          DetailNode := FVSTDetails.AddChild(nil);
967          DetailData := FVSTDetails.GetNodeData(DetailNode);
968          DetailData^.FAuthor := Data^.FAuthor;
969          DetailData^.FDataType := 4;
970          //add lazcompatibility(DataType = 5)
971          DetailNode := FVSTDetails.AddChild(nil);
972          DetailData := FVSTDetails.GetNodeData(DetailNode);
973          DetailData^.FLazCompatibility := Data^.FLazCompatibility;
974          DetailData^.FDataType := 5;
975          //add fpccompatibility(DataType = 6)
976          DetailNode := FVSTDetails.AddChild(nil);
977          DetailData := FVSTDetails.GetNodeData(DetailNode);
978          DetailData^.FFPCCompatibility := Data^.FFPCCompatibility;
979          DetailData^.FDataType := 6;
980          //add widgetset(DataType = 7)
981          DetailNode := FVSTDetails.AddChild(nil);
982          DetailData := FVSTDetails.GetNodeData(DetailNode);
983          DetailData^.FSupportedWidgetSet := Data^.FSupportedWidgetSet;
984          DetailData^.FDataType := 7;
985          //add packagetype(DataType = 8)
986          DetailNode := FVSTDetails.AddChild(nil);
987          DetailData := FVSTDetails.GetNodeData(DetailNode);
988          DetailData^.FPackageType := Data^.FPackageType;
989          DetailData^.FDataType := 8;
990          //add license(DataType = 9)
991          DetailNode := FVSTDetails.AddChild(nil);
992          DetailData := FVSTDetails.GetNodeData(DetailNode);
993          DetailData^.FLicense := Data^.FLicense;
994          DetailData^.FDataType := 9;
995          //add dependencies(DataType = 10)
996          DetailNode := FVSTDetails.AddChild(nil);
997          DetailData := FVSTDetails.GetNodeData(DetailNode);
998          DetailData^.FDependenciesAsString := Data^.FDependenciesAsString;
999          DetailData^.FDataType := 10;
1000        end;
1001   end;
1002   EnableDisableButtons(True);
1003 end;
1004 
1005 procedure TCreateRepositoryFrm.VSTPackagesFreeNode(Sender: TBaseVirtualTree;
1006   Node: PVirtualNode);
1007 var
1008   Data: PData;
1009 begin
1010   Data := FVSTPackages.GetNodeData(Node);
1011   Finalize(Data^);
1012 end;
1013 
1014 procedure TCreateRepositoryFrm.VSTDetailsGetText(Sender: TBaseVirtualTree;
1015   Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
1016   var CellText: String);
1017 var
1018   PackageNode: PVirtualNode;
1019   PackageData: PData;
1020   DetailData: PData;
1021 begin
1022   if TextType <> ttNormal then
1023     Exit;
1024 
1025   PackageNode := FVSTPackages.GetFirstSelected;
1026   if PackageNode = nil then
1027     Exit;
1028 
1029   PackageData := FVSTPackages.GetNodeData(PackageNode);
1030   case PackageData^.FDataType of
1031     0: begin
1032          DetailData := FVSTDetails.GetNodeData(Node);
1033          case DetailData^.FDataType of
1034            17: if Column = 0 then
1035                 CellText := rsCreateRepositoryFrm_RepositoryAddress
1036               else
1037                 CellText := DetailData^.FRepository.FAddress;
1038            3: if Column = 0 then
1039                 CellText := rsCreateRepositoryFrm_RepositoryDescription
1040               else
1041                 CellText := DetailData^.FRepository.FDescription;
1042          end;
1043        end;
1044     1: begin
1045          DetailData := FVSTDetails.GetNodeData(Node);
1046          case DetailData^.FDataType of
1047            12: if Column = 0 then
1048                  CellText := rsCreateRepositoryFrm_VSTText_Category
1049                else
1050                  CellText := DetailData^.FCategory;
1051            13: if Column = 0 then
1052                  CellText := rsCreateRepositoryFrm_VSTText_RepositoryFilename
1053                else
1054                  CellText := DetailData^.FRepositoryFileName;
1055            14: if Column = 0 then
1056                  CellText := rsCreateRepositoryFrm_VSTText_RepositoryFileSize
1057                else
1058                  CellText := FormatSize(DetailData^.FRepositoryFileSize);
1059            15: if Column = 0 then
1060                  CellText := rsCreateRepositoryFrm_VSTText_RepositoryFileHash
1061                else
1062                  CellText := DetailData^.FRepositoryFileHash;
1063            16: if Column = 0 then
1064                  CellText := rsCreateRepositoryFrm_VSTText_RepositoryFileDate
1065                else
1066                  CellText := FormatDateTime('YYYY.MM.DD', DetailData^.FRepositoryDate);
1067            17: if Column = 0 then
1068                  CellText := rsCreateRepositoryFrm_VSTText_HomePageURL
1069                else
1070                  CellText := DetailData^.FHomePageURL;
1071           18:  if Column = 0 then
1072                  CellText := rsCreateRepositoryFrm_VSTText_DownloadURL
1073                else
1074                  CellText := DetailData^.FDownloadURL;
1075           19:  if Column = 0 then
1076                   CellText := rsMainFrm_VSTText_CommunityDescription
1077                 else
1078                   CellText := DetailData^.FCommunityDescription;
1079           20:  if Column = 0 then
1080                   CellText := rsMainFrm_VSTText_ExternalDeps
1081                 else
1082                   CellText := DetailData^.FExternalDependencies;
1083           21:  if Column = 0 then
1084                   CellText := rsMainFrm_VSTText_OrphanedPackage1
1085                 else
1086                   case DetailData^.FOrphanPackage of
1087                     0: CellText := rsMainFrm_VSTText_Install0;
1088                     1: CellText := rsMainFrm_VSTText_Install1;
1089                   end;
1090          end;
1091        end;
1092     2: begin
1093          DetailData := FVSTDetails.GetNodeData(Node);
1094          case DetailData^.FDataType of
1095            2: if Column = 0 then
1096                 CellText := rsCreateRepositoryFrm_VSTText_Version
1097               else
1098                 CellText := DetailData^.FVersionAsString;
1099            3: if Column = 0 then
1100                 CellText := rsCreateRepositoryFrm_VSTText_Description
1101               else
1102                 CellText := GetDisplayString(DetailData^.FDescription);
1103            4: if Column = 0 then
1104                 CellText := rsCreateRepositoryFrm_VSTText_Author
1105               else
1106                 CellText := DetailData^.FAuthor;
1107            5: if Column = 0 then
1108                 CellText := rsCreateRepositoryFrm_VSTText_LazCompatibility
1109               else
1110                 CellText := DetailData^.FLazCompatibility;
1111            6: if Column = 0 then
1112                 CellText := rsCreateRepositoryFrm_VSTText_FPCCompatibility
1113               else
1114                 CellText := DetailData^.FFPCCompatibility;
1115            7: if Column = 0 then
1116                 CellText := rsCreateRepositoryFrm_VSTText_SupportedWidgetsets
1117               else
1118                 CellText := DetailData^.FSupportedWidgetSet;
1119            8: if Column = 0 then
1120                 CellText := rsCreateRepositoryFrm_VSTText_Packagetype
1121               else
1122                 case DetailData^.FPackageType of
1123                    lptRunAndDesignTime: CellText := rsMainFrm_VSTText_PackageType0;
1124                    lptDesignTime:       CellText := rsMainFrm_VSTText_PackageType1;
1125                    lptRunTime:          CellText := rsMainFrm_VSTText_PackageType2;
1126                    lptRunTimeOnly:      CellText := rsMainFrm_VSTText_PackageType3;
1127                 end;
1128            9: if Column = 0 then
1129                 CellText := rsCreateRepositoryFrm_VSTText_License
1130               else
1131                 CellText := GetDisplayString(DetailData^.FLicense);
1132           10: if Column = 0 then
1133                 CellText := rsCreateRepositoryFrm_VSTText_Dependecies
1134               else
1135                 CellText := DetailData^.FDependenciesAsString;
1136 
1137          end;
1138        end;
1139   end;
1140 end;
1141 
1142 procedure TCreateRepositoryFrm.VSTDetailsGetImageIndex(
1143   Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
1144   Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
1145 var
1146   Data: PData;
1147 begin
1148   if Column = 0 then
1149   begin
1150     Data := FVSTDetails.GetNodeData(Node);
1151     case Data^.FDataType of
1152       20: ImageIndex := 10;
1153       21: ImageIndex := 36;
1154       else
1155         ImageIndex := Data^.FDataType;
1156       end;
1157   end;
1158 end;
1159 
1160 procedure TCreateRepositoryFrm.VSTDetailsFreeNode(Sender: TBaseVirtualTree;
1161   Node: PVirtualNode);
1162 var
1163   Data: PData;
1164 begin
1165   Data := FVSTDetails.GetNodeData(Node);
1166   Finalize(Data^);
1167 end;
1168 
1169 end.
1170 
1171