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