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