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_createrepositorypackagefrm;
25 
26 {$mode objfpc}{$H+}
27 
28 interface
29 
30 uses
31   Classes, SysUtils, md5, fpjson, VirtualTrees,
32   // LCL
33   Forms, Controls, ExtCtrls, StdCtrls, Dialogs, Graphics, Buttons, EditBtn,
34   // IDEIntf
35   LCLIntf, PackageIntf,
36   // LazUtils
37   FileUtil, LazFileUtils, Laz2_XMLCfg,
38   // OpkMan
39   opkman_serializablepackages, opkman_zipper, opkman_uploader;
40 
41 type
42   TPackageOperation = (poCreate, poSubmit);
43 
44   { TCreateRepositoryPackagesFrm }
45   TCreateRepositoryPackagesFrm = class(TForm)
46     bCancel: TButton;
47     bCreate: TButton;
48     Bevel1: TBevel;
49     bHelp: TButton;
50     bOptions: TButton;
51     bSubmit: TButton;
52     cbJSONForUpdates: TCheckBox;
53     edCategories: TEdit;
54     edPackageDir: TDirectoryEdit;
55     edDownloadURL: TEdit;
56     edDisplayName: TEdit;
57     edSVNURL: TEdit;
58     edFPCCompatibility: TEdit;
59     edHomePageURL: TEdit;
60     edLazCompatibility: TEdit;
61     edSupportedWidgetset: TEdit;
62     imTree: TImageList;
63     lbCategory: TLabel;
64     lbDownloadURL: TLabel;
65     lbDisplayName: TLabel;
66     lbSVNURL: TLabel;
67     lbFPCCompatibility: TLabel;
68     lbHomePageURL: TLabel;
69     lbLazCompatibility: TLabel;
70     lbOF1: TLabel;
71     lbOF2: TLabel;
72     lbOF3: TLabel;
73     lbOF4: TLabel;
74     lbPackagedir: TLabel;
75     lbSupportedWidgetSet: TLabel;
76     lbComDescr: TLabel;
77     mComDescr: TMemo;
78     pnB: TPanel;
79     pnButtons: TPanel;
80     pnCategories: TPanel;
81     pnPackageData: TPanel;
82     pnBrowse: TPanel;
83     pnCategory: TPanel;
84     pnMessage: TPanel;
85     pnPackages: TPanel;
86     pnData: TPanel;
87     SDD: TSelectDirectoryDialog;
88     spCategories: TSpeedButton;
89     spMain: TSplitter;
90     procedure bCancelClick(Sender: TObject);
91     procedure bCreateClick(Sender: TObject);
92     procedure bHelpClick(Sender: TObject);
93     procedure bOptionsClick(Sender: TObject);
94     procedure bSubmitClick(Sender: TObject);
95     procedure edDisplayNameKeyPress(Sender: TObject; var Key: char);
96     procedure edPackageDirAcceptDirectory(Sender: TObject; Var Value: String);
97     procedure edPackageDirButtonClick(Sender: TObject);
98     procedure FormCreate(Sender: TObject);
99     procedure FormDestroy(Sender: TObject);
100     procedure spCategoriesClick(Sender: TObject);
101   private
102     FVSTPackages: TVirtualStringTree;
103     FVSTPackageData: TVirtualStringTree;
104     FPackageZipper: TPackageZipper;
105     FPackageDir: String;
106     FPackageName: String;
107     FPackageFile: String;
108     FJSONFile: String;
109     FDestDir: String;
110     FPackageOperation: TPackageOperation;
111     FTyp: Integer;
112     FFocusChanging: Boolean;
113     procedure VSTPackagesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
114       Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String);
115     procedure VSTPackagesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
116       {%H-}Kind: TVTImageKind; Column: TColumnIndex; var {%H-}Ghosted: Boolean;
117       var ImageIndex: Integer);
118     procedure VSTPackagesFocusChanging(Sender: TBaseVirtualTree; OldNode, {%H-}NewNode: PVirtualNode;
119       {%H-}OldColumn, {%H-}NewColumn: TColumnIndex;  var Allowed: Boolean);
120     procedure VSTPackagesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; {%H-}Column: TColumnIndex);
121     procedure VSTPackagesChecked(Sender: TBaseVirtualTree; {%H-}Node: PVirtualNode);
122     procedure VSTPackagesFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
123     procedure VSTPackageDataGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
124       Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String);
125     procedure VSTPackageDataGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
126       {%H-}Kind: TVTImageKind; Column: TColumnIndex; var {%H-}Ghosted: Boolean;
127       var ImageIndex: Integer);
128     procedure VSTCompareNodes(Sender: TBaseVirtualTree; Node1,
129       Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
130     procedure VSTPackageDataFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
131     procedure DoOnZippError(Sender: TObject; AZipFile: String; const AErrMsg: String);
132     procedure DoOnZipCompleted(Sender: TObject);
LoadPackageDatanull133 //    function LoadPackageData(const APath: String; AData: PData): Boolean;
134     procedure ShowHideControls(const AType: Integer);
135     procedure EnableDisableControls(const AEnable: Boolean);
136     procedure SaveExtraInfo(const ANode: PVirtualNode);
TranslateCategoriesnull137     function TranslateCategories(const AStr: String): String;
CanCreatenull138     function CanCreate: Boolean;
CreateJSONnull139     function CreateJSON(var AErrMsg: String): Boolean;
CreateJSONForUpdatesnull140     function CreateJSONForUpdates(var AErrMsg: String): Boolean;
141     procedure DoOnUploadProgress(Sender: TObject; AFileName: String);
142     procedure DoOnUploadError(Sender: TObject; AErrMsg: String);
143     procedure DoOnUploadCompleted(Sender: TObject);
144     procedure CreatePackage;
145   public
146     procedure SetType(const ATyp: Integer);
147     property DestDir: String read FDestDir write FDestDir;
148     property PackageFile: string read FPackageFile;
149     property JSONFile: String read FJSONFile;
150   end;
151 
152 var
153   CreateRepositoryPackagesFrm: TCreateRepositoryPackagesFrm;
154 
155 implementation
156 
157 uses opkman_const, opkman_common, opkman_options, opkman_categoriesfrm,
158      opkman_mainfrm, opkman_updates;
159 
160 {$R *.lfm}
161 
162 { TCreateRepositoryPackagesFrm }
163 
164 type
165   PData = ^TData;
166   TData = record
167     FPackageRelativePath: String;
168     FPackageBaseDir: String;
169     FFullPath: String;
170     FDataType: Integer;
171     FName: String;
172     FDisplayName: String;
173     FPackageType: TLazPackageType;
174     FAuthor: String;
175     FDescription: String;
176     FLicense: String;
177     FVersionAsString: String;
178     FDependenciesAsString: String;
179     FCategory: String;
180     FLazCompatibility: String;
181     FFPCCompatibility: String;
182     FSupportedWidgetSet: String;
183     FHomePageURL: String;
184     FDownloadURL: String;
185     FSVNURL: String;
186     FCommunityDescription: String;
187   end;
188 
189 procedure TCreateRepositoryPackagesFrm.FormCreate(Sender: TObject);
190 begin
191   Caption := rsCreateRepositoryPackageFrm_Caption;
192   lbPackagedir.Caption := rsCreateRepositoryPackageFrm_lbPackageDir_Caption;
193   pnMessage.Caption := rsCreateRepositoryPackageFrm_pnMessage_Caption;
194   edCategories.Text := '';
195   lbLazCompatibility.Caption := rsCreateRepositoryPackageFrm_lbLazCompatibility_Caption;
196   lbFPCCompatibility.Caption := rsCreateRepositoryPackageFrm_lbFPCCompatibility_Caption;
197   lbSupportedWidgetSet.Caption := rsCreateRepositoryPackageFrm_lbSupportedWidgetset_Caption;
198   lbCategory.Caption := rsCreateRepositoryPackageFrm_lbCategory_Caption;
199   lbDisplayName.Caption := rsCreateRepositoryPackageFrm_lbDisplayName_Caption;
200   lbHomePageURL.Caption := rsCreateRepositoryPackageFrm_lbHomePageURL_Caption;
201   lbDownloadURL.Caption := rsCreateRepositoryPackageFrm_lbDownloadURL_Caption;
202   lbSVNURL.Caption := rsCreateRepositoryPackageFrm_lbSVNURL_Caption;
203   lbComDescr.Caption := rsMainFrm_VSTText_CommunityDescription + ':';
204 
205   bHelp.Caption := rsCreateRepositoryPackageFrm_bHelp_Caption;
206   bHelp.Hint := rsCreateRepositoryPackageFrm_bHelp_Hint;
207   bOptions.Caption := rsCreateRepositoryPackageFrm_bOptions_Caption;
208   bOptions.Hint := rsCreateRepositoryPackageFrm_bOptions_Hint;
209   bCreate.Caption := rsCreateRepositoryPackageFrm_bCreate_Caption;
210   bCreate.Hint := rsCreateRepositoryPackageFrm_bCreate_Hint;
211   bSubmit.Caption := rsCreateRepositoryPackageFrm_bSubmit_Caption;
212   bSubmit.Hint := rsCreateRepositoryPackageFrm_bSubmit_Hint;
213   bCancel.Caption := rsCreateRepositoryPackageFrm_bCancel_Caption;
214   bCancel.Hint := rsCreateRepositoryPackageFrm_bCancel_Hint;
215   if not Options.UseDefaultTheme then
216     Self.Color := clBtnFace;
217 
218   FVSTPackages := TVirtualStringTree.Create(nil);
219   with FVSTPackages do
220   begin
221     Parent := pnPackages;
222     Align := alClient;
223     Anchors := [akLeft, akTop, akRight];
224     Images := imTree;
225     if not Options.UseDefaultTheme then
226       Color := clBtnFace;
227     DefaultNodeHeight := 25;
228     Indent := 15;
229     TabOrder := 1;
230     DefaultText := '';
231     Header.AutoSizeIndex := 0;
232     Header.Height := 25;
233     Colors.BorderColor := clBlack;
234     with Header.Columns.Add do begin
235       Position := 0;
236       Width := 250;
237       Text := rsCreateRepositoryPackageFrm_pnCaption_Caption0;
238     end;
239     Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoVisible, hoAutoSpring];
240     Header.SortColumn := 0;
241     TabOrder := 2;
242     TreeOptions.MiscOptions := [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning];
243     TreeOptions.PaintOptions := [toHideFocusRect, toPopupMode, toShowButtons, toShowDropmark, toShowRoot, toThemeAware, toUseBlendedImages];
244     TreeOptions.SelectionOptions := [toRightClickSelect];
245     TreeOptions.AutoOptions := [toAutoTristateTracking];
246     OnGetText := @VSTPackagesGetText;
247     OnGetImageIndex := @VSTPackagesGetImageIndex;
248     OnChecked := @VSTPackagesChecked;
249     OnFocusChanging := @VSTPackagesFocusChanging;
250     OnFocusChanged := @VSTPackagesFocusChanged;
251     OnFreeNode := @VSTPackagesFreeNode;
252   end;
253   FVSTPackages.NodeDataSize := SizeOf(TData);
254 
255   FVSTPackageData := TVirtualStringTree.Create(nil);
256   with FVSTPackageData do
257   begin
258     Parent := pnData;
259     Align := alTop;
260     Height := 200;
261     Anchors := [akLeft, akTop, akRight];
262     Images := imTree;
263     if not Options.UseDefaultTheme then
264       Color := clBtnFace;
265     DefaultNodeHeight := 25;
266     Indent := 15;
267     TabOrder := 1;
268     DefaultText := '';
269     Header.AutoSizeIndex := 1;
270     Header.Height := 25;
271     Colors.BorderColor := clBlack;
272     with Header.Columns.Add do begin
273       Position := 0;
274       Width := 150;
275       Text := rsCreateRepositoryPackageFrm_pnCaption_Caption1;
276     end;
277     with Header.Columns.Add do begin
278       Position := 1;
279       Width := 250;
280       Text := rsCreateRepositoryPackageFrm_pnCaption_Caption2;
281     end;
282     Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoVisible, hoAutoSpring];
283     Header.SortColumn := 0;
284     TabOrder := 2;
285     TreeOptions.MiscOptions := [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning];
286     TreeOptions.PaintOptions := [toHideFocusRect, toPopupMode, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages];
287     TreeOptions.SelectionOptions := [toRightClickSelect, toFullRowSelect];
288     TreeOptions.AutoOptions := [toAutoTristateTracking];
289     OnGetText := @VSTPackageDataGetText;
290     OnGetImageIndex := @VSTPackageDataGetImageIndex;
291     OnFreeNode := @VSTPackageDataFreeNode;
292   end;
293   FVSTPackageData.NodeDataSize := SizeOf(TData);
294   ShowHideControls(0);
295   EnableDisableControls(True);
296 end;
297 
298 procedure TCreateRepositoryPackagesFrm.FormDestroy(Sender: TObject);
299 begin
300   if Uploader <> nil then
301   begin
302     pnMessage.Caption := rsCreateRepositoryPackageFrm_Message10;
303     pnMessage.Invalidate;
304     Application.ProcessMessages;
305     Uploader.StopUpload;
306     Uploader.WaitFor;
307     Uploader := nil;
308   end;
309   FVSTPackages.Clear;
310   FVSTPackages.Free;
311   FVSTPackageData.Clear;
312   FVSTPackageData.Free;
313 end;
314 
LoadPackageDatanull315 function LoadPackageData(const APath: String; AData: PData): Boolean;
316 
VersionBoundnull317   function VersionBound(const AVersion: Integer): Integer;
318   begin
319     if AVersion > 9999 then
320       Result := 9999
321     else if AVersion < 0 then
322       Result := 0
323     else
324       Result := AVersion;
325   end;
326 
GetVersionnull327   function GetVersion(const AXMLConfig: TXMLConfig; const APath: String): String;
328   var
329     Major, Minor, Release, Build: Integer;
330   begin
331     Major := VersionBound(AXMLConfig.GetValue(APath + '/Major', 0));
332     Minor := VersionBound(AXMLConfig.GetValue(APath + '/Minor', 0));
333     Release := VersionBound(AXMLConfig.GetValue(APath + '/Release', 0));
334     Build := VersionBound(AXMLConfig.GetValue(APath + '/Build', 0));
335     Result := IntToStr(Major) + '.' + IntToStr(Minor) + '.' + IntToStr(Release) + '.' + IntToStr(Build);
336   end;
337 
338 var
339   XMLConfig: TXMLConfig;
340   BasePath, Path: String;
341   I, DepCount: Integer;
342   PackageName: String;
343   MinVer, MaxVer: String;
344 begin
345   Result := False;
346   BasePath := 'Package/';
347   XMLConfig := TXMLConfig.Create(APath);
348   try
349     AData^.FPackageType :=
350       LazPackageTypeIdentToType(XMLConfig.GetValue(BasePath + 'Type/Value', LazPackageTypeIdents[lptRunTime]));
351     AData^.FDescription := String(XMLConfig.GetValue(BasePath + 'Description/Value', ''));
352     AData^.FAuthor := String(XMLConfig.GetValue(BasePath + 'Author/Value', ''));
353     AData^.FLicense := String(XMLConfig.GetValue(BasePath + 'License/Value', ''));
354     AData^.FVersionAsString := GetVersion(XMLConfig, BasePath + 'Version');
355     DepCount := XMLConfig.GetValue(BasePath + 'RequiredPkgs/Count', 0);
356     for I := 0 to DepCount - 1 do
357     begin
358       MinVer := '';
359       MaxVer := '';
360       Path := BasePath + 'RequiredPkgs/Item' + IntToStr(I + 1) + '/';
361       PackageName := XMLConfig.GetValue(Path + 'PackageName/Value', '');
362       if XMLConfig.GetValue(Path + 'MinVersion/Valid', False) then
363       begin
364         MinVer := GetVersion(XMLConfig, Path + 'MinVersion');
365         PackageName := PackageName + '(' + MinVer + ')';
366       end;
367       if XMLConfig.GetValue(Path + 'MaxVersion/Valid', False) then
368       begin
369         MaxVer := GetVersion(XMLConfig, Path + 'MaxVersion');
370         if MinVer = '' then
371           PackageName := PackageName + '(0.0.0.0)' + '(' + MaxVer + ')'
372         else
373           PackageName := PackageName + '(' + MaxVer + ')';
374       end;
375       if AData^.FDependenciesAsString = '' then
376         AData^.FDependenciesAsString := PackageName
377       else
378         AData^.FDependenciesAsString := AData^.FDependenciesAsString + ', ' + PackageName;
379     end;
380     Result := True;
381   finally
382     XMLConfig.Free;
383   end;
384 end;
385 
386 procedure TCreateRepositoryPackagesFrm.ShowHideControls(const AType: Integer);
387 var
388   Node: PVirtualNode;
389 begin
390   case AType of
391     0: begin
392          pnPackages.Visible := False;
393          pnData.Visible := False;
394          pnMessage.Visible := False;
395        end;
396     1: begin
397          pnPackages.Visible := False;
398          pnData.Visible := False;
399          pnMessage.Visible := True;
400        end;
401     2: begin
402          pnPackages.Visible := True;
403          pnData.Visible := True;
404          pnMessage.Visible := False;
405          Node := FVSTPackages.GetFirstSelected;
406          if Node <> nil then
407          case FVSTPackages.GetNodeLevel(Node) of
408            0: begin
409                 FVSTPackageData.Visible := False;
410                 pnPackageData.Visible := False;
411                 pnCategory.Visible := True;
412               end;
413            1: begin
414                 FVSTPackageData.Visible := True;
415                 pnPackageData.Visible := True;
416                 pnCategory.Visible := False;
417               end;
418          end;
419        end;
420   end;
421 end;
422 
423 procedure TCreateRepositoryPackagesFrm.EnableDisableControls(const AEnable: Boolean);
424 begin
425   pnBrowse.Enabled := AEnable;
426   cbJSONForUpdates.Enabled := AEnable;
427   bHelp.Enabled := AEnable;
428   bOptions.Enabled := AEnable;
429   bCreate.Enabled := (AEnable) and (FVSTPackages.CheckedCount > 0);
430   bSubmit.Enabled := (AEnable) and (FVSTPackages.CheckedCount > 0);
431   bCancel.Enabled := AEnable;
432 end;
433 
434 procedure TCreateRepositoryPackagesFrm.edPackageDirAcceptDirectory(
435   Sender: TObject; Var Value: String);
436 var
437   PackageList: TStringList;
438   I: Integer;
439   Node, RootNode: PVirtualNode;
440   Data, RootData: PData;
441   CanGo: Boolean;
442 begin
443   CanGo := False;
444   ShowHideControls(1);
445   Application.ProcessMessages;
446   try
447     FPackageDir := Value;
448     Options.LastPackageDirSrc := FPackageDir;
449     Options.Changed := True;
450     PackageList := TStringList.Create;
451     try
452       FindPackages(FPackageDir, PackageList);
453       if PackageList.Count > 0 then
454       begin
455         FVSTPackages.Clear;
456         FVSTPackages.NodeDataSize := SizeOf(TData);
457         FVSTPackageData.Clear;
458         FVSTPackageData.NodeDataSize := SizeOf(TData);
459         RootNode := FVSTPackages.AddChild(nil);
460         RootNode^.CheckType := ctTriStateCheckBox;
461         RootData := FVSTPackages.GetNodeData(RootNode);
462         RootData^.FName := TPackageData(PackageList.Objects[0]).FPackageBaseDir;
463         RootData^.FCategory := '';
464         RootData^.FDisplayName := '';
465         RootData^.FHomePageURL := '';
466         RootData^.FDownloadURL := '';
467         RootData^.FSVNURL := '';
468         RootData^.FCommunityDescription := '';
469         RootData^.FDataType := 0;
470         FPackageName := RootData^.FName;
471         for I := 0 to PackageList.Count - 1 do
472         begin
473           Node := FVSTPackages.AddChild(RootNode);
474           Node^.CheckType := ctTriStateCheckBox;
475           Data := FVSTPackages.GetNodeData(Node);
476           Data^.FName := TPackageData(PackageList.Objects[I]).FName;
477           Data^.FPackageBaseDir := TPackageData(PackageList.Objects[I]).FPackageBaseDir;
478           RootData^.FPackageBaseDir := Data^.FPackageBaseDir;
479           Data^.FPackageRelativePath := TPackageData(PackageList.Objects[I]).FPackageRelativePath;
480           Data^.FFullPath := TPackageData(PackageList.Objects[I]).FFullPath;
481           if not LoadPackageData(Data^.FFullPath, Data) then
482             MessageDlgEx(rsCreateRepositoryPackageFrm_Error0, mtError, [mbOk], Self);
483           Data^.FLazCompatibility := '1.6, 1.8, Trunk';
484           Data^.FFPCCompatibility := '2.6.4, 3.0.0, 3.0.2, 3.0.4';
485           Data^.FSupportedWidgetSet := 'win32/64, gtk2, carbon';
486           Data^.FDataType := 1;
487         end;
488         FVSTPackages.FullExpand;
489         RootNode := FVSTPackages.GetFirst;
490         if RootNode <> nil then
491         begin
492           FVSTPackages.FocusedNode := RootNode;
493           FVSTPackages.Selected[RootNode] := True;
494           CanGo := True;
495         end;
496         FVSTPackages.SortTree(0, VirtualTrees.sdAscending);
497       end
498       else
499         MessageDlgEx(rsCreateRepositoryPackageFrm_NoPackage, mtInformation, [mbOk], Self);
500     finally
501       for I := PackageList.Count - 1 downto 0 do
502         PackageList.Objects[I].Free;
503       PackageList.Free;
504     end;
505   finally
506     if CanGo then
507       ShowHideControls(2)
508     else
509       ShowHideControls(0)
510   end;
511 end;
512 
513 procedure TCreateRepositoryPackagesFrm.edPackageDirButtonClick(Sender: TObject);
514 begin
515   edPackageDir.DialogTitle := rsCreateRepositoryPackageFrm_SDDTitleSrc;
516   edPackageDir.Directory := Options.LastPackagedirSrc;
517 end;
518 
519 procedure TCreateRepositoryPackagesFrm.spCategoriesClick(Sender: TObject);
520 begin
521   CategoriesFrm := TCategoriesFrm.Create(Self);
522   try
523     CategoriesFrm.SetupControls;
524     CategoriesFrm.CategoriesCSV := edCategories.Text;
525     CategoriesFrm.PopulateTree;
526     if CategoriesFrm.ShowModal = mrOK then
527       edCategories.Text := CategoriesFrm.CategoriesCSV;
528   finally
529     CategoriesFrm.Free;
530   end;
531 end;
532 
TCreateRepositoryPackagesFrm.CanCreatenull533 function TCreateRepositoryPackagesFrm.CanCreate: Boolean;
534   procedure SelectAndFocusNode(const ANode: PVirtualNode);
535   begin
536     FVSTPackages.Selected[ANode ] := True;
537     FVSTPackages.FocusedNode := ANode;
538   end;
539 
540 var
541   Node: PVirtualNode;
542   Data: PData;
543 begin
544   Result := False;
545   Node := FVSTPackages.GetFirstSelected;
546   if Node <> nil then
547     SaveExtraInfo(Node);
548   Node := FVSTPackages.GetFirst;
549   while Assigned(Node) do
550   begin
551     Data := FVSTPackages.GetNodeData(Node);
552     if ((FVSTPackages.CheckState[Node] = csCheckedNormal) or (FVSTPackages.CheckState[Node] = csMixedNormal)) and (FVSTPackages.GetNodeLevel(Node) = 0) then
553     begin
554       ShowHideControls(2);
555       if Data^.FCategory = '' then
556       begin
557         SelectAndFocusNode(Node);
558         MessageDlgEx(rsCreateRepositoryPackageFrm_Message0 + ' "' + Data^.FName + '".', mtInformation, [mbOk], Self);
559         edCategories.SetFocus;
560         Exit;
561       end;
562     end;
563     if (FVSTPackages.CheckState[Node] = csCheckedNormal) and (FVSTPackages.GetNodeLevel(Node) = 1) then
564     begin
565       ShowHideControls(2);
566       if Trim(Data^.FLazCompatibility) = '' then
567       begin
568         SelectAndFocusNode(Node);
569         MessageDlgEx(rsCreateRepositoryPackageFrm_Message1 + ' "' + Data^.FName + '".', mtInformation, [mbOk], Self);
570         edLazCompatibility.SetFocus;
571         Exit;
572       end;
573       if Trim(Data^.FFPCCompatibility) = '' then
574       begin
575         SelectAndFocusNode(Node);
576         MessageDlgEx(rsCreateRepositoryPackageFrm_Message2 + ' "' + Data^.FName + '".', mtInformation, [mbOk], Self);
577         edFPCCompatibility.SetFocus;
578         Exit;
579       end;
580       if Trim(Data^.FSupportedWidgetSet) = '' then
581       begin
582         SelectAndFocusNode(Node);
583         MessageDlgEx(rsCreateRepositoryPackageFrm_Message3 + ' "' + Data^.FName + '".', mtInformation, [mbOk], Self);
584         edSupportedWidgetset.SetFocus;
585         Exit;
586       end;
587     end;
588     Node := FVSTPackages.GetNext(Node);
589   end;
590   Result := True;
591 end;
592 
593 procedure TCreateRepositoryPackagesFrm.CreatePackage;
594 var
595   RootNode: PVirtualNode;
596   RootData: PData;
597 begin
598   FPackageOperation := poCreate;
599   Screen.Cursor := crHourGlass;
600   ShowHideControls(1);
601   FPackageZipper := TPackageZipper.Create;
602   FPackageZipper.OnZipError := @DoOnZippError;
603   FPackageZipper.OnZipCompleted := @DoOnZipCompleted;
604   RootNode := FVSTPackages.GetFirst;
605   RootData := FVSTPackages.GetNodeData(RootNode);
606   if RootData^.FDisplayName <> '' then
607     FPackageName := StringReplace(RootData^.FDisplayName, ' ', '', [rfReplaceAll])
608   else
609     FPackageName := StringReplace(RootData^.FName, ' ', '', [rfReplaceAll]);
610   FPackageFile := FDestDir + FPackageName + '.zip';
611   FJSONFile := FDestDir + FPackageName + '.json';
612   pnMessage.Caption := rsCreateRepositoryPackageFrm_Message4;
613   fPackageZipper.StartZip(FPackageDir, FPackageFile);
614 end;
615 
616 
617 procedure TCreateRepositoryPackagesFrm.bCreateClick(Sender: TObject);
618 begin
619   if not CanCreate then
620     Exit;
621   if FTyp = 0 then
622   begin
623     SDD.Title := rsCreateRepositoryPackageFrm_SDDTitleDst;
624     SDD.InitialDir := Options.LastPackagedirDst;
625     EnableDisableControls(False);
626     if SDD.Execute then
627     begin
628       FDestDir := AppendPathDelim(SDD.FileName);
629       Options.LastPackagedirDst := FDestDir;
630       Options.Changed := True;
631       CreatePackage;
632     end
633     else
634       EnableDisableControls(True);
635   end
636   else if FTyp = 1 then
637   begin
638     Options.LastPackagedirDst := FDestDir;
639     Options.Changed := True;
640     CreatePackage;
641   end;
642 end;
643 
644 procedure TCreateRepositoryPackagesFrm.bSubmitClick(Sender: TObject);
645 var
646   RootNode: PVirtualNode;
647   RootData: PData;
648 begin
649   if not CanCreate then
650     Exit;
651   FPackageOperation := poSubmit;
652   EnableDisableControls(False);
653   ShowHideControls(1);
654   Screen.Cursor := crHourGlass;
655   fPackageZipper := TPackageZipper.Create;
656   fPackageZipper.OnZipError := @DoOnZippError;
657   fPackageZipper.OnZipCompleted := @DoOnZipCompleted;
658   FDestDir := Options.LocalRepositoryUpdateExpanded;
659   RootNode := FVSTPackages.GetFirst;
660   RootData := FVSTPackages.GetNodeData(RootNode);
661   if RootData^.FDisplayName <> '' then
662     FPackageName := StringReplace(RootData^.FDisplayName, ' ', '', [rfReplaceAll])
663   else
664     FPackageName := StringReplace(RootData^.FName, ' ', '', [rfReplaceAll]);
665   FPackageFile := FDestDir + FPackageName + '.zip';
666   FJSONFile := FDestDir + FPackageName + '.json';
667   pnMessage.Caption := rsCreateRepositoryPackageFrm_Message4;
668   fPackageZipper.StartZip(FPackageDir, FPackageFile);
669 end;
670 
671 procedure TCreateRepositoryPackagesFrm.edDisplayNameKeyPress(Sender: TObject;
672   var Key: char);
673 begin
674   if Key in ['\', '/', ':', '*', '?', '"', '<', '>', '|'] then
675     Key := #0;
676 end;
677 
678 procedure TCreateRepositoryPackagesFrm.bHelpClick(Sender: TObject);
679 begin
680   OpenURL(cHelpPage_CreateRepositoryPackage);
681 end;
682 
683 procedure TCreateRepositoryPackagesFrm.bOptionsClick(Sender: TObject);
684 begin
685   MainFrm.ShowOptions(3);
686 end;
687 
688 procedure TCreateRepositoryPackagesFrm.bCancelClick(Sender: TObject);
689 begin
690   if Assigned(FPackageZipper) then
691     FPackageZipper.Terminate;
692   ModalResult := mrCancel;
693 end;
694 
695 procedure TCreateRepositoryPackagesFrm.VSTPackagesGetText(
696   Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
697   TextType: TVSTTextType; var CellText: String);
698 var
699   Data: PData;
700 begin
701   Data := FVSTPackages.GetNodeData(Node);
702   if Column = 0 then
703     CellText := Data^.FName;
704 end;
705 
706 procedure TCreateRepositoryPackagesFrm.VSTPackagesGetImageIndex(
707   Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
708   Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
709 begin
710   if Column = 0 then
711     ImageIndex := FVSTPackages.GetNodeLevel(Node);
712 end;
713 
714 procedure TCreateRepositoryPackagesFrm.SaveExtraInfo(const ANode: PVirtualNode);
715 var
716   Data: PData;
717 begin
718   Data := FVSTPackages.GetNodeData(ANode);
719   case FVSTPackages.GetNodeLevel(ANode) of
720     0: begin
721          Data^.FCategory := edCategories.Text;
722          Data^.FDisplayName := edDisplayName.Text;
723          Data^.FHomePageURL := edHomePageURL.Text;
724          Data^.FDownloadURL :=   edDownloadURL.Text;
725          Data^.FSVNURL := edSVNURL.Text;
726          Data^.FCommunityDescription := mComDescr.Text;
727        end;
728     1: begin
729          Data^.FLazCompatibility := edLazCompatibility.Text;
730          Data^.FFPCCompatibility := edFPCCompatibility.Text;
731          Data^.FSupportedWidgetSet := edSupportedWidgetset.Text;
732        end;
733   end;
734 end;
735 
736 procedure TCreateRepositoryPackagesFrm.VSTPackagesFocusChanging(
737   Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn,
738   NewColumn: TColumnIndex; var Allowed: Boolean);
739 begin
740   if (OldNode = nil) or (NewNode = nil) or (OldNode = NewNode) or (FFocusChanging) then
741     Exit;
742   FFocusChanging := True;
743   SaveExtraInfo(OldNode);
744   edCategories.Text := '';
745   edLazCompatibility.Text := '';
746   edFPCCompatibility.Text := '';
747   edSupportedWidgetset.Text := '';
748   edDisplayName.Text := '';
749   edHomePageURL.Text := '';
750   edDownloadURL.Text := '';
751   edSVNURL.Text := '';
752   Allowed := True;
753 end;
754 
755 procedure TCreateRepositoryPackagesFrm.VSTPackagesFocusChanged(
756   Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
757 var
758   Data: PData;
759   PDNode: PVirtualNode;
760   PDData: PData;
761   Level: Integer;
762 begin
763   FFocusChanging := False;
764   if Node = nil then
765     Exit;
766   Level := FVSTPackages.GetNodeLevel(Node);
767   Data := FVSTPackages.GetNodeData(Node);
768   if Level = 0 then
769   begin
770     edCategories.Text := Data^.FCategory;
771     edDisplayName.Text := Data^.FDisplayName;
772     edHomePageURL.Text := Data^.FHomePageURL;
773     edDownloadURL.Text := Data^.FDownloadURL;
774     edSVNURL.Text := Data^.FSVNURL;
775     mComDescr.Text := Data^.FCommunityDescription;
776   end
777   else if Level = 1 then
778   begin
779     FVSTPackageData.Clear;
780 
781     PDNode := FVSTPackageData.AddChild(nil);
782     PDData := FVSTPackageData.GetNodeData(PDNode);
783     PDData^.FVersionAsString := Data^.FVersionAsString;
784     PDData^.FDataType := 2;
785 
786     PDNode := FVSTPackageData.AddChild(nil);
787     PDData := FVSTPackageData.GetNodeData(PDNode);
788     PDData^.FDescription := Trim(Data^.FDescription);
789     PDData^.FDataType := 3;
790 
791     PDNode := FVSTPackageData.AddChild(nil);
792     PDData := FVSTPackageData.GetNodeData(PDNode);
793     PDData^.FAuthor := Data^.FAuthor;
794     PDData^.FDataType := 4;
795 
796     PDNode := FVSTPackageData.AddChild(nil);
797     PDData := FVSTPackageData.GetNodeData(PDNode);
798     PDData^.FPackageType := Data^.FPackageType;
799     PDData^.FDataType := 5;
800 
801     PDNode := FVSTPackageData.AddChild(nil);
802     PDData := FVSTPackageData.GetNodeData(PDNode);
803     PDData^.FDependenciesAsString := Data^.FDependenciesAsString;
804     PDData^.FDataType := 6;
805 
806     PDNode := FVSTPackageData.AddChild(nil);
807     PDData := FVSTPackageData.GetNodeData(PDNode);
808     PDData^.FLicense := Trim(Data^.FLicense);
809     PDData^.FDataType := 7;
810 
811     edLazCompatibility.Text := Data^.FLazCompatibility;
812     edFPCCompatibility.Text := Data^.FFPCCompatibility;
813     edSupportedWidgetset.Text := Data^.FSupportedWidgetSet;
814   end;
815   ShowHideControls(2);
816 end;
817 
818 procedure TCreateRepositoryPackagesFrm.VSTPackagesChecked(
819   Sender: TBaseVirtualTree; Node: PVirtualNode);
820 begin
821   EnableDisableControls(True);
822 end;
823 
824 procedure TCreateRepositoryPackagesFrm.VSTPackagesFreeNode(
825   Sender: TBaseVirtualTree; Node: PVirtualNode);
826 var
827   Data: PData;
828 begin
829   Data := FVSTPackages.GetNodeData(Node);
830   Finalize(Data^);
831 end;
832 
833 procedure TCreateRepositoryPackagesFrm.VSTPackageDataGetText(
834   Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
835   TextType: TVSTTextType; var CellText: String);
836 var
837   Data: PData;
838 begin
839   Data := FVSTPackageData.GetNodeData(Node);
840   case Column of
841     0: case Data^.FDataType of
842          2: CellText := rsMainFrm_VSTText_Version;
843          3: CellText := rsMainFrm_VSTText_Description;
844          4: CellText := rsMainFrm_VSTText_Author;
845          5: CellText := rsMainFrm_VSTText_Packagetype;
846          6: CellText := rsMainFrm_VSTText_Dependecies;
847          7: CellText := rsMainFrm_VSTText_License;
848        end;
849     1: case Data^.FDataType of
850          2: CellText := Data^.FVersionAsString;
851          3: CellText := Data^.FDescription;
852          4: CellText := Data^.FAuthor;
853          5: case Data^.FPackageType of
854               lptRunAndDesignTime: CellText := rsMainFrm_VSTText_PackageType0;
855               lptDesignTime:       CellText := rsMainFrm_VSTText_PackageType1;
856               lptRunTime:          CellText := rsMainFrm_VSTText_PackageType2;
857               lptRunTimeOnly:      CellText := rsMainFrm_VSTText_PackageType3;
858             end;
859          6: CellText := Data^.FDependenciesAsString;
860          7: CellText := Data^.FLicense;
861        end;
862   end;
863 end;
864 
865 procedure TCreateRepositoryPackagesFrm.VSTPackageDataGetImageIndex(
866   Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
867   Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
868 var
869   Data: PData;
870 begin
871   if Column = 0 then
872   begin
873     Data := FVSTPackageData.GetNodeData(Node);
874     ImageIndex := Data^.FDataType;
875   end;
876 end;
877 
878 procedure TCreateRepositoryPackagesFrm.VSTCompareNodes(
879   Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex;
880   var Result: Integer);
881 var
882   Data1: PData;
883   Data2: PData;
884 begin
885   Data1 := Sender.GetNodeData(Node1);
886   Data2 := Sender.GetNodeData(Node2);
887   if Column = 0 then
888   begin
889     if (Data1^.FDataType = 1) and (Data1^.FDataType = 1) then
890        Result := CompareText(Data1^.FName, Data2^.FName);
891      if (Data1^.FDataType < Data2^.FDataType) then
892        Result := 0
893      else if (Data1^.FDataType > Data2^.FDataType) then
894        Result := 1
895   end;
896 end;
897 
898 procedure TCreateRepositoryPackagesFrm.VSTPackageDataFreeNode(
899   Sender: TBaseVirtualTree; Node: PVirtualNode);
900 var
901   Data: PData;
902 begin
903   Data := FVSTPackageData.GetNodeData(Node);
904   Finalize(Data^);
905 end;
906 
907 procedure TCreateRepositoryPackagesFrm.DoOnZippError(Sender: TObject;
908   AZipFile: String; const AErrMsg: String);
909 begin
910   Screen.Cursor := crDefault;
911   MessageDlgEx(rsCreateRepositoryPackageFrm_Error1 + ' "' + AZipFile + '". ' + rsProgressFrm_Error1 + sLineBreak +
912                AErrMsg, mtError, [mbOk], Self);
913   ShowHideControls(2);
914   EnableDisableControls(True);
915 end;
916 
TranslateCategoriesnull917 function TCreateRepositoryPackagesFrm.TranslateCategories(const AStr: String
918   ): String;
919 var
920   SL: TStringList;
921   I, J: Integer;
922   Str: String;
923 begin
924   if Categories[0] = CategoriesEng[0] then
925   begin
926     Result := AStr;
927     Exit;
928   end;
929   Result := '';
930   SL := TStringList.Create;
931   try
932     SL.Delimiter := ',';
933     SL.StrictDelimiter := True;
934     SL.DelimitedText := AStr;
935     for I := 0 to SL.Count - 1 do
936     begin
937       Str := Trim(SL.Strings[I]);
938       for J := 0 to MaxCategories - 1 do
939       begin
940         if Str = Categories[J] then
941         begin
942           if Result = '' then
943             Result := CategoriesEng[J]
944           else
945             Result := Result + ', ' + CategoriesEng[J];
946           Break;
947         end;
948       end;
949     end;
950   finally
951     SL.Free;
952   end;
953   if Result = '' then
954     Result := AStr;
955 end;
956 
TCreateRepositoryPackagesFrm.CreateJSONForUpdatesnull957 function TCreateRepositoryPackagesFrm.CreateJSONForUpdates(var AErrMsg: String
958   ): Boolean;
959 var
960   RootNode, Node: PVirtualNode;
961   RootData, Data: PData;
962   JSON: TJSONStringType;
963   Ms: TMemoryStream;
964   UpdatePackage: TUpdatePackage;
965   UpdateLazPkgs: TUpdateLazPackages;
966 begin
967   Result := False;
968   pnMessage.Caption := rsCreateRepositoryPackageFrm_Message6;
969   pnMessage.Invalidate;
970   Application.ProcessMessages;
971   Sleep(2000);
972   UpdatePackage := TUpdatePackage.Create;
973   try
974     RootNode := FVSTPackages.GetFirst;
975     if RootNode <> nil then
976     begin
977       RootData := FVSTPackages.GetNodeData(RootNode);
978       UpdatePackage.UpdatePackageData.Name := RootData^.FName;
979       UpdatePackage.UpdatePackageData.DownloadZipURL := RootData^.FDownloadURL;
980       Node := FVSTPackages.GetFirstChild(RootNode);
981       while Assigned(Node) do
982       begin
983         if FVSTPackages.CheckState[Node] = csCheckedNormal then
984         begin
985           Data := FVSTPackages.GetNodeData(Node);
986           UpdateLazPkgs := TUpdateLazPackages(UpdatePackage.UpdateLazPackages.Add);
987           UpdateLazPkgs.Name := Data^.FName;
988           UpdateLazPkgs.Version := Data^.FVersionAsString;
989           UpdateLazPkgs.ForceNotify := False;
990           UpdateLazPkgs.InternalVersion := 1;
991         end;
992         Node := FVSTPackages.GetNextSibling(Node);
993       end;
994     end;
995     JSON := '';
996     if UpdatePackage.SaveToJSON(JSON) then
997     begin
998       JSON := StringReplace(JSON, '\/', '/', [rfReplaceAll]);
999       Ms := TMemoryStream.Create;
1000       try
1001         Ms.Write(Pointer(JSON)^, Length(JSON));
1002         Ms.Position := 0;
1003         Ms.SaveToFile(FDestDir + 'update_' + FPackageName + '.json');
1004       finally
1005         MS.Free;
1006       end;
1007       Result := True;
1008     end
1009     else
1010       AErrMsg := rsCreateJSONForUpdatesFrm_Error1 + sLineBreak + '"' + StringReplace(UpdatePackage.LastError, '"', '', [rfReplaceAll]) + '"';
1011   finally
1012     UpdatePackage.Free;
1013   end;
1014 end;
1015 
TCreateRepositoryPackagesFrm.CreateJSONnull1016 function TCreateRepositoryPackagesFrm.CreateJSON(var AErrMsg: String): Boolean;
1017 var
1018   SerializablePackages: TSerializablePackages;
1019   MetaPkg: TMetaPackage;
1020   LazarusPkg: TLazarusPackage;
1021   RootNode, Node: PVirtualNode;
1022   RootData, Data: PData;
1023   JSON: TJSONStringType;
1024   MS: TMemoryStream;
1025 begin
1026   Result := False;
1027   pnMessage.Caption := rsCreateRepositoryPackageFrm_Message5;
1028   pnMessage.Invalidate;
1029   Application.ProcessMessages;
1030   Sleep(2000);
1031   SerializablePackages := TSerializablePackages.Create;
1032   try
1033     RootNode := FVSTPackages.GetFirst;
1034     if RootNode <> nil then
1035     begin
1036       RootData := FVSTPackages.GetNodeData(RootNode);
1037       MetaPkg := SerializablePackages.AddMetaPackage(RootData^.FName);
1038       MetaPkg.Category := TranslateCategories(RootData^.FCategory);
1039       MetaPkg.RepositoryFileName := ExtractFileName(FPackageFile);
1040       MetaPkg.RepositoryFileSize := FileUtil.FileSize(FPackageFile);
1041       MetaPkg.RepositoryFileHash := MD5Print(MD5File(FPackageFile));
1042       MetaPkg.RepositoryDate := now;
1043       MetaPkg.PackageBaseDir := RootData^.FPackageBaseDir;
1044       if Trim(RootData^.FDisplayName) <> '' then
1045         MetaPkg.DisplayName := RootData^.FDisplayName
1046       else
1047         MetaPkg.DisplayName := RootData^.FName;
1048       MetaPkg.HomePageURL := RootData^.FHomePageURL;
1049       MetaPkg.DownloadURL := RootData^.FDownloadURL;
1050       MetaPkg.SVNURL := RootData^.FSVNURL;
1051       MetaPkg.CommunityDescription := RootData^.FCommunityDescription;
1052       Node := FVSTPackages.GetFirstChild(RootNode);
1053       while Assigned(Node) do
1054       begin
1055         if FVSTPackages.CheckState[Node] = csCheckedNormal then
1056         begin
1057           Data := FVSTPackages.GetNodeData(Node);
1058           LazarusPkg := TLazarusPackage(MetaPkg.LazarusPackages.Add);
1059           LazarusPkg.Name := Data^.FName;
1060           LazarusPkg.PackageRelativePath := Data^.FPackageRelativePath;
1061           LazarusPkg.Version := TPackageVersion.Create;
1062           LazarusPkg.Version.AsString := Data^.FVersionAsString;
1063           LazarusPkg.Description := Data^.FDescription;
1064           LazarusPkg.Author := Data^.FAuthor;
1065           LazarusPkg.LazCompatibility := Data^.FLazCompatibility;
1066           LazarusPkg.FPCCompatibility := Data^.FFPCCompatibility;
1067           LazarusPkg.SupportedWidgetSet := Data^.FSupportedWidgetSet;
1068           LazarusPkg.PackageType := Data^.FPackageType;
1069           LazarusPkg.Dependencies := TPackageDependencies.Create(TPackageDependency);
1070           LazarusPkg.Dependencies.SetDependenciesAsString(Data^.FDependenciesAsString);
1071           LazarusPkg.License := Data^.FLicense;
1072         end;
1073         Node := FVSTPackages.GetNextSibling(Node);
1074       end;
1075     end;
1076     if SerializablePackages.Count > 0 then
1077     begin
1078       JSON := '';
1079       if SerializablePackages.PackagesToJSON(JSON) then
1080       begin
1081         MS := TMemoryStream.Create;
1082         try
1083           MS.Write(Pointer(JSON)^, Length(JSON));
1084           MS.Position := 0;
1085           MS.SaveToFile(FJSONFile);
1086           Result := True;
1087         finally
1088           MS.Free;
1089         end;
1090       end
1091       else
1092         AErrMsg := rsCreateRepositoryPackageFrm_Error2 + sLineBreak + '"' + StringReplace(SerializablePackages.LastError, '"', '', [rfReplaceAll]) + '"'
1093     end;
1094   finally
1095     SerializablePackages.Free;
1096   end;
1097 end;
1098 
1099 procedure TCreateRepositoryPackagesFrm.DoOnZipCompleted(Sender: TObject);
1100 var
1101   ErrMsg, JsonUpd: String;
1102 begin
1103   ErrMsg := '';
1104   if not CreateJSON(ErrMsg) then
1105   begin
1106     MessageDlgEx(ErrMsg, mtError, [mbOk], Self);
1107     Exit;
1108   end;
1109 
1110   if cbJSONForUpdates.Checked then
1111   begin
1112     ErrMsg := '';
1113     if not CreateJSONForUpdates(ErrMsg) then
1114     begin
1115       MessageDlgEx(ErrMsg, mtError, [mbOk], Self);
1116       Exit;
1117     end;
1118   end;
1119 
1120   case FPackageOperation of
1121     poCreate:
1122       begin
1123         Screen.Cursor := crDefault;
1124         ShowHideControls(2);
1125         EnableDisableControls(True);
1126         if FTyp = 0 then
1127           MessageDlgEx(rsCreateRepositoryPackageFrm_Message7, mtInformation, [mbOk], Self);
1128         ModalResult := mrOk;
1129       end;
1130     poSubmit:
1131       begin
1132         Uploader := TUploader.Create;
1133         Uploader.OnUploadProgress := @DoOnUploadProgress;
1134         Uploader.OnUploadError := @DoOnUploadError;
1135         Uploader.OnUploadCompleted := @DoOnUploadCompleted;
1136         if cbJSONForUpdates.Checked then
1137           JsonUpd := FDestDir + 'update_' + FPackageName + '.json'
1138         else
1139           JsonUpd := '';
1140         Uploader.StartUpload(cSubmitURL_Zip, cSubmitURL_JSON, FPackageFile, FJSONFile, JsonUpd);
1141       end;
1142   end;
1143 end;
1144 
1145 procedure TCreateRepositoryPackagesFrm.DoOnUploadProgress(Sender: TObject;
1146   AFileName: String);
1147 begin
1148   pnMessage.Caption := Format(rsCreateRepositoryPackageFrm_Message8, [AFileName]);
1149   pnMessage.Invalidate;
1150   Application.ProcessMessages;
1151 end;
1152 
1153 procedure TCreateRepositoryPackagesFrm.DoOnUploadError(Sender: TObject;
1154   AErrMsg: String);
1155 begin
1156   Screen.Cursor := crDefault;
1157   ShowHideControls(2);
1158   EnableDisableControls(True);
1159   MessageDlgEx(AErrMsg, mtError, [mbOk], Self);
1160 end;
1161 
1162 procedure TCreateRepositoryPackagesFrm.DoOnUploadCompleted(Sender: TObject);
1163 begin
1164   Screen.Cursor := crDefault;
1165   ShowHideControls(2);
1166   EnableDisableControls(True);
1167   Uploader := nil;
1168   if FileExists(FPackageFile) then
1169     DeleteFile(FPackageFile);
1170   if FileExists(FJSONFile) then
1171     DeleteFile(FJSONFile);
1172   if FileExists(FDestDir + 'update_' + FPackageName + '.json') then
1173     DeleteFile(FDestDir + 'update_' + FPackageName + '.json');
1174   MessageDlgEx(rsCreateRepositoryPackageFrm_Message9, mtInformation, [mbOk], Self);
1175   ModalResult := mrOk;
1176 end;
1177 
1178 procedure TCreateRepositoryPackagesFrm.SetType(const ATyp: Integer);
1179 begin
1180   FTyp := ATyp;
1181   bSubmit.Visible := FTyp = 0;
1182   cbJSONForUpdates.Visible := FTyp = 0;
1183   bCreate.Visible := True;
1184   if FTyp = 1 then
1185   begin
1186     bCreate.Caption := rsCreateRepositoryPackageFrm_bCreate_Caption1;
1187     bCreate.Hint := rsCreateRepositoryPackageFrm_bCreate_Hint1;
1188     pnB.AutoSize := True;
1189   end;
1190 end;
1191 
1192 end.
1193 
1194