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