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