{ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * * * *************************************************************************** Author: Balázs Székely } unit opkman_createrepositorypackagefrm; {$mode objfpc}{$H+} interface uses Classes, SysUtils, md5, fpjson, laz.VirtualTrees, // LCL Forms, Controls, ExtCtrls, StdCtrls, Dialogs, Graphics, Buttons, EditBtn, // IDEIntf LCLIntf, PackageIntf, // LazUtils FileUtil, LazFileUtils, Laz2_XMLCfg, // OpkMan opkman_serializablepackages, opkman_zipper, opkman_uploader; type TPackageOperation = (poCreate, poSubmit); { TCreateRepositoryPackagesFrm } TCreateRepositoryPackagesFrm = class(TForm) bCancel: TButton; bCreate: TButton; Bevel1: TBevel; bHelp: TButton; bOptions: TButton; bSubmit: TButton; cbJSONForUpdates: TCheckBox; cbOrphanedPackage: TCheckBox; edCategories: TEdit; edFPCCompatibility: TEdit; edSupportedWidgetset: TEdit; edLazCompatibility: TEdit; edPackageDir: TDirectoryEdit; edDownloadURL: TEdit; edDisplayName: TEdit; edSVNURL: TEdit; edHomePageURL: TEdit; lbCategory: TLabel; lbExternalDependencies: TLabel; lbDownloadURL: TLabel; lbDisplayName: TLabel; lbSVNURL: TLabel; lbFPCCompatibility: TLabel; lbHomePageURL: TLabel; lbLazCompatibility: TLabel; lbOF1: TLabel; lbOF2: TLabel; lbOF3: TLabel; lbOF4: TLabel; lbPackagedir: TLabel; lbSupportedWidgetSet: TLabel; lbComDescr: TLabel; mComDescr: TMemo; mExternalDependencies: TMemo; pnB: TPanel; pnButtons: TPanel; pnCategories: TPanel; pnFPCCompatibility: TPanel; pnSupportedWidgetset: TPanel; pnLazCompatibility: TPanel; pnPackageData: TPanel; pnBrowse: TPanel; pnCategory: TPanel; pnMessage: TPanel; pnPackages: TPanel; pnData: TPanel; SDD: TSelectDirectoryDialog; spCategories: TSpeedButton; spFPCCompatibility: TSpeedButton; spSupportedWidgetset: TSpeedButton; spLazCompatibility: TSpeedButton; spMain: TSplitter; procedure bCancelClick(Sender: TObject); procedure bCreateClick(Sender: TObject); procedure bHelpClick(Sender: TObject); procedure bOptionsClick(Sender: TObject); procedure bSubmitClick(Sender: TObject); procedure cbOrphanedPackageClick(Sender: TObject); procedure edDisplayNameKeyPress(Sender: TObject; var Key: char); procedure edPackageDirAcceptDirectory(Sender: TObject; Var Value: String); procedure edPackageDirButtonClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure spCategoriesClick(Sender: TObject); private FVSTPackages: TLazVirtualStringTree; FVSTPackageData: TLazVirtualStringTree; FPackageZipper: TPackageZipper; FPackageDir: String; FPackageName: String; FPackageFile: String; FJSONFile: String; FDestDir: String; FPackageOperation: TPackageOperation; FTyp: Integer; FFocusChanging: Boolean; FPreventClose: Boolean; procedure VSTPackagesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String); procedure VSTPackagesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; {%H-}Kind: TVTImageKind; Column: TColumnIndex; var {%H-}Ghosted: Boolean; var ImageIndex: Integer); procedure VSTPackagesFocusChanging(Sender: TBaseVirtualTree; OldNode, {%H-}NewNode: PVirtualNode; {%H-}OldColumn, {%H-}NewColumn: TColumnIndex; var Allowed: Boolean); procedure VSTPackagesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; {%H-}Column: TColumnIndex); procedure VSTPackagesChecked(Sender: TBaseVirtualTree; {%H-}Node: PVirtualNode); procedure VSTPackagesFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure VSTPackageDataGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String); procedure VSTPackageDataGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; {%H-}Kind: TVTImageKind; Column: TColumnIndex; var {%H-}Ghosted: Boolean; var ImageIndex: Integer); procedure VSTCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); procedure VSTPackageDataFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure DoOnZippError(Sender: TObject; AZipFile: String; const AErrMsg: String); procedure DoOnZipCompleted(Sender: TObject); // function LoadPackageData(const APath: String; AData: PData): Boolean; procedure ShowHideControls(const AType: Integer); procedure EnableDisableControls(const AEnable: Boolean); procedure SaveExtraInfo(const ANode: PVirtualNode); function TranslateCategories(const AStr: String): String; function CanCreate: Boolean; function CreateJSON(var AErrMsg: String): Boolean; function CreateJSONForUpdates(var AErrMsg: String): Boolean; procedure DoOnUploadProgress(Sender: TObject; AFileName: String); procedure DoOnUploadError(Sender: TObject; AErrMsg: String); procedure DoOnUploadCompleted(Sender: TObject); procedure CreatePackage; procedure ChangeCursor(ACursor: TCursor); public procedure SetType(const ATyp: Integer); property DestDir: String read FDestDir write FDestDir; property PackageFile: string read FPackageFile; property JSONFile: String read FJSONFile; end; var CreateRepositoryPackagesFrm: TCreateRepositoryPackagesFrm; implementation uses opkman_const, opkman_common, opkman_options, opkman_categoriesfrm, opkman_mainfrm, opkman_maindm, opkman_updates; {$R *.lfm} const IMAGE_INDEX_MAP: array[0..7] of Integer = ( IMG_PKG_PLUS, IMG_PKG_FILE, IMG_REPO_FILE, IMG_DESCRIPTION, IMG_AUTHOR, IMG_PKG_TYPE, IMG_DEPENDENCIES, IMG_LICENSE); { TCreateRepositoryPackagesFrm } type PData = ^TData; TData = record FPackageRelativePath: String; FPackageBaseDir: String; FFullPath: String; FDataType: Integer; FName: String; FDisplayName: String; FPackageType: TLazPackageType; FAuthor: String; FDescription: String; FLicense: String; FVersionAsString: String; FDependenciesAsString: String; FCategory: String; FLazCompatibility: String; FFPCCompatibility: String; FSupportedWidgetSet: String; FHomePageURL: String; FDownloadURL: String; FSVNURL: String; FCommunityDescription: String; FExternalDependencies: String; FOrphanedPackage: Integer; end; procedure TCreateRepositoryPackagesFrm.FormCreate(Sender: TObject); begin Caption := rsCreateRepositoryPackageFrm_Caption; lbPackagedir.Caption := rsCreateRepositoryPackageFrm_lbPackageDir_Caption; pnMessage.Caption := rsCreateRepositoryPackageFrm_pnMessage_Caption; edCategories.Text := ''; lbLazCompatibility.Caption := rsCreateRepositoryPackageFrm_lbLazCompatibility_Caption; lbFPCCompatibility.Caption := rsCreateRepositoryPackageFrm_lbFPCCompatibility_Caption; lbSupportedWidgetSet.Caption := rsCreateRepositoryPackageFrm_lbSupportedWidgetset_Caption; lbCategory.Caption := rsCreateRepositoryPackageFrm_lbCategory_Caption; lbDisplayName.Caption := rsCreateRepositoryPackageFrm_lbDisplayName_Caption; lbHomePageURL.Caption := rsCreateRepositoryPackageFrm_lbHomePageURL_Caption; lbDownloadURL.Caption := rsCreateRepositoryPackageFrm_lbDownloadURL_Caption; lbSVNURL.Caption := rsCreateRepositoryPackageFrm_lbSVNURL_Caption; lbComDescr.Caption := rsMainFrm_VSTText_CommunityDescription + ':'; lbExternalDependencies.Caption := rsMainFrm_VSTText_ExternalDeps + ':'; cbOrphanedPackage.Caption := rsMainFrm_VSTText_OrphanedPackage1 + ' (' + rsMainFrm_VSTText_OrphanedPackage2 + ')'; bHelp.Caption := rsCreateRepositoryPackageFrm_bHelp_Caption; bHelp.Hint := rsCreateRepositoryPackageFrm_bHelp_Hint; bOptions.Caption := rsCreateRepositoryPackageFrm_bOptions_Caption; bOptions.Hint := rsCreateRepositoryPackageFrm_bOptions_Hint; bCreate.Caption := rsCreateRepositoryPackageFrm_bCreate_Caption; bCreate.Hint := rsCreateRepositoryPackageFrm_bCreate_Hint; bSubmit.Caption := rsCreateRepositoryPackageFrm_bSubmit_Caption; bSubmit.Hint := rsCreateRepositoryPackageFrm_bSubmit_Hint; bCancel.Caption := rsCreateRepositoryPackageFrm_bCancel_Caption; bCancel.Hint := rsCreateRepositoryPackageFrm_bCancel_Hint; if not Options.UseDefaultTheme then Self.Color := clBtnFace; FVSTPackages := TLazVirtualStringTree.Create(nil); with FVSTPackages do begin Parent := pnPackages; Align := alClient; Anchors := [akLeft, akTop, akRight]; Images := MainDM.Images; if not Options.UseDefaultTheme then Color := clBtnFace; DefaultNodeHeight := Scale96ToForm(25); Indent := Scale96ToForm(15); TabOrder := 1; DefaultText := ''; Header.AutoSizeIndex := 0; Header.Height := Scale96ToForm(25); Colors.BorderColor := clBlack; with Header.Columns.Add do begin Position := 0; Width := Scale96ToForm(250); Text := rsCreateRepositoryPackageFrm_pnCaption_Caption0; end; Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoVisible, hoAutoSpring]; Header.SortColumn := 0; TabOrder := 2; TreeOptions.MiscOptions := [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]; TreeOptions.PaintOptions := [toHideFocusRect, toPopupMode, toShowButtons, toShowDropmark, toShowRoot, toThemeAware, toUseBlendedImages]; TreeOptions.SelectionOptions := [toRightClickSelect]; TreeOptions.AutoOptions := [toAutoTristateTracking]; OnGetText := @VSTPackagesGetText; OnGetImageIndex := @VSTPackagesGetImageIndex; OnChecked := @VSTPackagesChecked; OnFocusChanging := @VSTPackagesFocusChanging; OnFocusChanged := @VSTPackagesFocusChanged; OnFreeNode := @VSTPackagesFreeNode; end; FVSTPackages.NodeDataSize := SizeOf(TData); FVSTPackageData := TLazVirtualStringTree.Create(nil); with FVSTPackageData do begin Parent := pnData; Align := alTop; Height := Scale96ToForm(200); Anchors := [akLeft, akTop, akRight]; Images := MainDM.Images; if not Options.UseDefaultTheme then Color := clBtnFace; DefaultNodeHeight := Scale96ToForm(25); Indent := Scale96ToForm(15); TabOrder := 1; DefaultText := ''; Header.AutoSizeIndex := 1; Header.Height := Scale96ToForm(25); Colors.BorderColor := clBlack; with Header.Columns.Add do begin Position := 0; Width := Scale96ToForm(150); Text := rsCreateRepositoryPackageFrm_pnCaption_Caption1; end; with Header.Columns.Add do begin Position := 1; Width := Scale96ToForm(250); Text := rsCreateRepositoryPackageFrm_pnCaption_Caption2; end; Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoVisible, hoAutoSpring]; Header.SortColumn := 0; TabOrder := 2; TreeOptions.MiscOptions := [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]; TreeOptions.PaintOptions := [toHideFocusRect, toPopupMode, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]; TreeOptions.SelectionOptions := [toRightClickSelect, toFullRowSelect]; TreeOptions.AutoOptions := [toAutoTristateTracking]; OnGetText := @VSTPackageDataGetText; OnGetImageIndex := @VSTPackageDataGetImageIndex; OnFreeNode := @VSTPackageDataFreeNode; end; FVSTPackageData.NodeDataSize := SizeOf(TData); ShowHideControls(0); EnableDisableControls(True); end; procedure TCreateRepositoryPackagesFrm.FormDestroy(Sender: TObject); begin if Uploader <> nil then begin pnMessage.Caption := rsCreateRepositoryPackageFrm_Message10; pnMessage.Invalidate; Application.ProcessMessages; Uploader.StopUpload; Uploader.WaitFor; Uploader := nil; end; FVSTPackages.Clear; FVSTPackages.Free; FVSTPackageData.Clear; FVSTPackageData.Free; end; function LoadPackageData(const APath: String; AData: PData): Boolean; function VersionBound(const AVersion: Integer): Integer; begin if AVersion > 9999 then Result := 9999 else if AVersion < 0 then Result := 0 else Result := AVersion; end; function GetVersion(const AXMLConfig: TXMLConfig; const APath: String): String; var Major, Minor, Release, Build: Integer; begin Major := VersionBound(AXMLConfig.GetValue(APath + '/Major', 0)); Minor := VersionBound(AXMLConfig.GetValue(APath + '/Minor', 0)); Release := VersionBound(AXMLConfig.GetValue(APath + '/Release', 0)); Build := VersionBound(AXMLConfig.GetValue(APath + '/Build', 0)); Result := IntToStr(Major) + '.' + IntToStr(Minor) + '.' + IntToStr(Release) + '.' + IntToStr(Build); end; var XMLConfig: TXMLConfig; BasePath, Path: String; I, DepCount: Integer; PackageName: String; MinVer, MaxVer: String; begin Result := False; BasePath := 'Package/'; XMLConfig := TXMLConfig.Create(APath); try AData^.FPackageType := LazPackageTypeIdentToType(XMLConfig.GetValue(BasePath + 'Type/Value', LazPackageTypeIdents[lptRunTime])); AData^.FDescription := String(XMLConfig.GetValue(BasePath + 'Description/Value', '')); AData^.FAuthor := String(XMLConfig.GetValue(BasePath + 'Author/Value', '')); AData^.FLicense := String(XMLConfig.GetValue(BasePath + 'License/Value', '')); AData^.FVersionAsString := GetVersion(XMLConfig, BasePath + 'Version'); DepCount := XMLConfig.GetValue(BasePath + 'RequiredPkgs/Count', 0); for I := 0 to DepCount - 1 do begin MinVer := ''; MaxVer := ''; Path := BasePath + 'RequiredPkgs/Item' + IntToStr(I + 1) + '/'; PackageName := XMLConfig.GetValue(Path + 'PackageName/Value', ''); if XMLConfig.GetValue(Path + 'MinVersion/Valid', False) then begin MinVer := GetVersion(XMLConfig, Path + 'MinVersion'); PackageName := PackageName + '(' + MinVer + ')'; end; if XMLConfig.GetValue(Path + 'MaxVersion/Valid', False) then begin MaxVer := GetVersion(XMLConfig, Path + 'MaxVersion'); if MinVer = '' then PackageName := PackageName + '(0.0.0.0)' + '(' + MaxVer + ')' else PackageName := PackageName + '(' + MaxVer + ')'; end; if AData^.FDependenciesAsString = '' then AData^.FDependenciesAsString := PackageName else AData^.FDependenciesAsString := AData^.FDependenciesAsString + ', ' + PackageName; end; Result := True; finally XMLConfig.Free; end; end; procedure TCreateRepositoryPackagesFrm.ShowHideControls(const AType: Integer); var Node: PVirtualNode; begin case AType of 0: begin pnPackages.Visible := False; pnData.Visible := False; pnMessage.Visible := False; end; 1: begin pnPackages.Visible := False; pnData.Visible := False; pnMessage.Visible := True; end; 2: begin pnPackages.Visible := True; pnData.Visible := True; pnMessage.Visible := False; Node := FVSTPackages.GetFirstSelected; if Node <> nil then case FVSTPackages.GetNodeLevel(Node) of 0: begin FVSTPackageData.Visible := False; pnPackageData.Visible := False; pnCategory.Visible := True; end; 1: begin FVSTPackageData.Visible := True; pnPackageData.Visible := True; pnCategory.Visible := False; end; end; end; end; end; procedure TCreateRepositoryPackagesFrm.EnableDisableControls(const AEnable: Boolean); begin pnBrowse.Enabled := AEnable; cbJSONForUpdates.Enabled := AEnable; bHelp.Enabled := AEnable; bOptions.Enabled := AEnable; bCreate.Enabled := (AEnable) and (FVSTPackages.CheckedCount > 0); bSubmit.Enabled := (AEnable) and (FVSTPackages.CheckedCount > 0); bCancel.Enabled := AEnable; end; procedure TCreateRepositoryPackagesFrm.edPackageDirAcceptDirectory( Sender: TObject; Var Value: String); var PackageList: TStringList; procedure GetData(ARootData: PData); var I: Integer; ct4laz_name: String; begin ARootData^.FCategory := ''; ARootData^.FDisplayName := ''; ARootData^.FHomePageURL := ''; ARootData^.FDownloadURL := ''; ARootData^.FSVNURL := ''; ARootData^.FCommunityDescription := ''; ARootData^.FExternalDependencies := ''; ARootData^.FDataType := 0; if ARootData^.FName = 'ct4laz' then ct4laz_name := ExtractFileName(TPackageData(PackageList.Objects[0]).FPackageRelativePath); for I := 0 to SerializablePackages.Count - 1 do begin if (SerializablePackages.Items[I].Name = ARootData^.FName) or ((ARootData^.FName = 'ct4laz') and (SerializablePackages.Items[I].Name = ct4laz_name)) then begin ARootData^.FCategory := SerializablePackages.Items[I].Category; ARootData^.FDisplayName := SerializablePackages.Items[I].DisplayName; ARootData^.FHomePageURL := SerializablePackages.Items[I].HomePageURL; ARootData^.FDownloadURL := SerializablePackages.Items[I].DownloadURL; ARootData^.FSVNURL := SerializablePackages.Items[I].SVNURL; ARootData^.FCommunityDescription := SerializablePackages.Items[I].CommunityDescription; ARootData^.FExternalDependencies := SerializablePackages.Items[I].ExternalDependecies; ARootData^.FOrphanedPackage := SerializablePackages.Items[I].OrphanedPackage; Break; end; end; end; var I: Integer; Node, RootNode: PVirtualNode; Data, RootData: PData; CanGo: Boolean; begin CanGo := False; ShowHideControls(1); Application.ProcessMessages; try FPackageDir := Value; Options.LastPackageDirSrc := FPackageDir; Options.Changed := True; PackageList := TStringList.Create; try FindPackages(FPackageDir, PackageList); if PackageList.Count > 0 then begin FVSTPackages.Clear; FVSTPackages.NodeDataSize := SizeOf(TData); FVSTPackageData.Clear; FVSTPackageData.NodeDataSize := SizeOf(TData); RootNode := FVSTPackages.AddChild(nil); RootNode^.CheckType := ctTriStateCheckBox; RootNode^.CheckState := csCheckedNormal; RootData := FVSTPackages.GetNodeData(RootNode); RootData^.FName := TPackageData(PackageList.Objects[0]).FPackageBaseDir; GetData(RootData); FPackageName := RootData^.FName; for I := 0 to PackageList.Count - 1 do begin Node := FVSTPackages.AddChild(RootNode); Node^.CheckType := ctTriStateCheckBox; Node^.CheckState := csCheckedNormal; Data := FVSTPackages.GetNodeData(Node); Data^.FName := TPackageData(PackageList.Objects[I]).FName; Data^.FPackageBaseDir := TPackageData(PackageList.Objects[I]).FPackageBaseDir; RootData^.FPackageBaseDir := Data^.FPackageBaseDir; Data^.FPackageRelativePath := TPackageData(PackageList.Objects[I]).FPackageRelativePath; Data^.FFullPath := TPackageData(PackageList.Objects[I]).FFullPath; if not LoadPackageData(Data^.FFullPath, Data) then MessageDlgEx(rsCreateRepositoryPackageFrm_Error0, mtError, [mbOk], Self); Data^.FLazCompatibility := LazDefVersions; Data^.FFPCCompatibility := FPCDefVersion; Data^.FSupportedWidgetSet := DefWidgetSets; Data^.FDataType := 1; end; FVSTPackages.FullExpand; RootNode := FVSTPackages.GetFirst; if RootNode <> nil then begin FVSTPackages.FocusedNode := RootNode; FVSTPackages.Selected[RootNode] := True; CanGo := True; end; FVSTPackages.SortTree(0, laz.VirtualTrees.sdAscending); end else MessageDlgEx(rsCreateRepositoryPackageFrm_NoPackage, mtInformation, [mbOk], Self); finally for I := PackageList.Count - 1 downto 0 do PackageList.Objects[I].Free; PackageList.Free; end; finally if CanGo then begin ShowHideControls(2); EnableDisableControls(True); end else ShowHideControls(0); end; end; procedure TCreateRepositoryPackagesFrm.edPackageDirButtonClick(Sender: TObject); begin edPackageDir.DialogTitle := rsCreateRepositoryPackageFrm_SDDTitleSrc; edPackageDir.Directory := Options.LastPackagedirSrc; end; procedure TCreateRepositoryPackagesFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose := not FPreventClose; end; procedure TCreateRepositoryPackagesFrm.spCategoriesClick(Sender: TObject); begin CategoriesFrm := TCategoriesFrm.Create(Self); try CategoriesFrm.SetupControls(TButton(Sender).Tag); case TButton(Sender).Tag of 1: CategoriesFrm.CategoriesCSV := edCategories.Text; 2: CategoriesFrm.LazCompatibility := edLazCompatibility.Text; 3: CategoriesFrm.FPCCompatibility := edFPCCompatibility.Text; 4: CategoriesFrm.SupportedWidgetSets := edSupportedWidgetset.Text; end; CategoriesFrm.PopulateTree(TButton(Sender).Tag); if CategoriesFrm.ShowModal = mrOK then case TButton(Sender).Tag of 1: edCategories.Text := CategoriesFrm.CategoriesCSV; 2: edLazCompatibility.Text := CategoriesFrm.LazCompatibility; 3: edFPCCompatibility.Text := CategoriesFrm.FPCCompatibility; 4: edSupportedWidgetset.Text := CategoriesFrm.SupportedWidgetSets; end; finally CategoriesFrm.Free; end; end; function TCreateRepositoryPackagesFrm.CanCreate: Boolean; procedure SelectAndFocusNode(const ANode: PVirtualNode); begin FVSTPackages.Selected[ANode ] := True; FVSTPackages.FocusedNode := ANode; end; var Node: PVirtualNode; Data: PData; begin Result := False; Node := FVSTPackages.GetFirstSelected; if Node <> nil then SaveExtraInfo(Node); Node := FVSTPackages.GetFirst; while Assigned(Node) do begin Data := FVSTPackages.GetNodeData(Node); if ((FVSTPackages.CheckState[Node] = csCheckedNormal) or (FVSTPackages.CheckState[Node] = csMixedNormal)) and (FVSTPackages.GetNodeLevel(Node) = 0) then begin ShowHideControls(2); if Data^.FCategory = '' then begin SelectAndFocusNode(Node); MessageDlgEx(rsCreateRepositoryPackageFrm_Message0 + ' "' + Data^.FName + '".', mtInformation, [mbOk], Self); edCategories.SetFocus; Exit; end; end; if (FVSTPackages.CheckState[Node] = csCheckedNormal) and (FVSTPackages.GetNodeLevel(Node) = 1) then begin ShowHideControls(2); if Trim(Data^.FLazCompatibility) = '' then begin SelectAndFocusNode(Node); MessageDlgEx(rsCreateRepositoryPackageFrm_Message1 + ' "' + Data^.FName + '".', mtInformation, [mbOk], Self); edLazCompatibility.SetFocus; Exit; end; if Trim(Data^.FFPCCompatibility) = '' then begin SelectAndFocusNode(Node); MessageDlgEx(rsCreateRepositoryPackageFrm_Message2 + ' "' + Data^.FName + '".', mtInformation, [mbOk], Self); edFPCCompatibility.SetFocus; Exit; end; if Trim(Data^.FSupportedWidgetSet) = '' then begin SelectAndFocusNode(Node); MessageDlgEx(rsCreateRepositoryPackageFrm_Message3 + ' "' + Data^.FName + '".', mtInformation, [mbOk], Self); edSupportedWidgetset.SetFocus; Exit; end; end; Node := FVSTPackages.GetNext(Node); end; Result := True; end; procedure TCreateRepositoryPackagesFrm.ChangeCursor(ACursor: TCursor); begin pnMessage.Cursor := ACursor; pnButtons.Cursor := ACursor; end; procedure TCreateRepositoryPackagesFrm.CreatePackage; var RootNode: PVirtualNode; RootData: PData; begin FPreventClose := True; ChangeCursor(crHourGlass); FPackageOperation := poCreate; FPackageZipper := TPackageZipper.Create; FPackageZipper.OnZipError := @DoOnZippError; FPackageZipper.OnZipCompleted := @DoOnZipCompleted; RootNode := FVSTPackages.GetFirst; RootData := FVSTPackages.GetNodeData(RootNode); if RootData^.FDisplayName <> '' then FPackageName := StringReplace(RootData^.FDisplayName, ' ', '', [rfReplaceAll]) else FPackageName := StringReplace(RootData^.FName, ' ', '', [rfReplaceAll]); FPackageFile := FDestDir + FPackageName + '.zip'; FJSONFile := FDestDir + FPackageName + '.json'; pnMessage.Caption := rsCreateRepositoryPackageFrm_Message4; fPackageZipper.StartZip(FPackageDir, FPackageFile); end; procedure TCreateRepositoryPackagesFrm.bCreateClick(Sender: TObject); begin if not CanCreate then Exit; ShowHideControls(1); EnableDisableControls(False); if FTyp = 0 then begin SDD.Title := rsCreateRepositoryPackageFrm_SDDTitleDst; SDD.InitialDir := Options.LastPackagedirDst; if SDD.Execute then begin FDestDir := AppendPathDelim(SDD.FileName); Options.LastPackagedirDst := FDestDir; Options.Changed := True; CreatePackage; end else begin ShowHideControls(2); EnableDisableControls(True); end; end else if FTyp = 1 then begin Options.LastPackagedirDst := FDestDir; Options.Changed := True; CreatePackage; end; end; procedure TCreateRepositoryPackagesFrm.bSubmitClick(Sender: TObject); var RootNode: PVirtualNode; RootData: PData; begin if not CanCreate then Exit; FPackageOperation := poSubmit; FPreventClose := True; ChangeCursor(crHourGlass); EnableDisableControls(False); ShowHideControls(1); fPackageZipper := TPackageZipper.Create; fPackageZipper.OnZipError := @DoOnZippError; fPackageZipper.OnZipCompleted := @DoOnZipCompleted; FDestDir := Options.LocalRepositoryUpdateExpanded; RootNode := FVSTPackages.GetFirst; RootData := FVSTPackages.GetNodeData(RootNode); if RootData^.FDisplayName <> '' then FPackageName := StringReplace(RootData^.FDisplayName, ' ', '', [rfReplaceAll]) else FPackageName := StringReplace(RootData^.FName, ' ', '', [rfReplaceAll]); FPackageFile := FDestDir + FPackageName + '.zip'; FJSONFile := FDestDir + FPackageName + '.json'; pnMessage.Caption := rsCreateRepositoryPackageFrm_Message4; fPackageZipper.StartZip(FPackageDir, FPackageFile); end; procedure TCreateRepositoryPackagesFrm.cbOrphanedPackageClick(Sender: TObject); var Node: PVirtualNode; Data: PData; begin Node := FVSTPackages.GetFirstSelected; if Node = nil then Exit; if FVSTPackages.GetNodeLevel(Node) <> 0 then Exit; Data := FVSTPackages.GetNodeData(Node); Data^.FOrphanedPackage := Ord(cbOrphanedPackage.Checked); FVSTPackages.ReinitNode(Node, False); FVSTPackages.RepaintNode(Node); end; procedure TCreateRepositoryPackagesFrm.edDisplayNameKeyPress(Sender: TObject; var Key: char); begin if Key in ['\', '/', ':', '*', '?', '"', '<', '>', '|'] then Key := #0; end; procedure TCreateRepositoryPackagesFrm.bHelpClick(Sender: TObject); begin OpenURL(cHelpPage_CreateRepositoryPackage); end; procedure TCreateRepositoryPackagesFrm.bOptionsClick(Sender: TObject); begin {$IFDEF MSWINDOWS} MainFrm.ShowOptions(4); {$ELSE} MainFrm.ShowOptions(3); {$ENDIF} end; procedure TCreateRepositoryPackagesFrm.bCancelClick(Sender: TObject); begin if Assigned(FPackageZipper) then FPackageZipper.Terminate; ModalResult := mrCancel; end; procedure TCreateRepositoryPackagesFrm.VSTPackagesGetText( Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); var Data: PData; begin Data := FVSTPackages.GetNodeData(Node); if Column = 0 then CellText := Data^.FName; end; procedure TCreateRepositoryPackagesFrm.VSTPackagesGetImageIndex( Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); var Data: PData; begin if Column = 0 then begin Data := FVSTPackages.GetNodeData(Node); if FVSTPackages.GetNodeLevel(Node) = 0 then begin if Data^.FOrphanedPackage = 1 then ImageIndex := 36 else ImageIndex := 1; end else ImageIndex := IMAGE_INDEX_MAP[FVSTPackages.GetNodeLevel(Node)]; end; end; procedure TCreateRepositoryPackagesFrm.SaveExtraInfo(const ANode: PVirtualNode); var Data: PData; begin Data := FVSTPackages.GetNodeData(ANode); case FVSTPackages.GetNodeLevel(ANode) of 0: begin Data^.FCategory := edCategories.Text; Data^.FDisplayName := edDisplayName.Text; Data^.FHomePageURL := edHomePageURL.Text; Data^.FDownloadURL := edDownloadURL.Text; Data^.FSVNURL := edSVNURL.Text; Data^.FCommunityDescription := mComDescr.Text; Data^.FExternalDependencies := mExternalDependencies.Text; Data^.FOrphanedPackage := Ord(cbOrphanedPackage.Checked); end; 1: begin Data^.FLazCompatibility := edLazCompatibility.Text; Data^.FFPCCompatibility := edFPCCompatibility.Text; Data^.FSupportedWidgetSet := edSupportedWidgetset.Text; end; end; end; procedure TCreateRepositoryPackagesFrm.VSTPackagesFocusChanging( Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean); begin if (OldNode = nil) or (NewNode = nil) or (OldNode = NewNode) or (FFocusChanging) then Exit; FFocusChanging := True; SaveExtraInfo(OldNode); edCategories.Text := ''; edLazCompatibility.Text := ''; edFPCCompatibility.Text := ''; edSupportedWidgetset.Text := ''; edDisplayName.Text := ''; edHomePageURL.Text := ''; edDownloadURL.Text := ''; edSVNURL.Text := ''; Allowed := True; end; procedure TCreateRepositoryPackagesFrm.VSTPackagesFocusChanged( Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); var Data: PData; PDNode: PVirtualNode; PDData: PData; Level: Integer; begin FFocusChanging := False; if Node = nil then Exit; Level := FVSTPackages.GetNodeLevel(Node); Data := FVSTPackages.GetNodeData(Node); if Level = 0 then begin edCategories.Text := Data^.FCategory; edDisplayName.Text := Data^.FDisplayName; edHomePageURL.Text := Data^.FHomePageURL; edDownloadURL.Text := Data^.FDownloadURL; edSVNURL.Text := Data^.FSVNURL; mComDescr.Text := Data^.FCommunityDescription; mExternalDependencies.Text := Data^.FExternalDependencies; cbOrphanedPackage.Checked := Data^.FOrphanedPackage = 1; end else if Level = 1 then begin FVSTPackageData.Clear; PDNode := FVSTPackageData.AddChild(nil); PDData := FVSTPackageData.GetNodeData(PDNode); PDData^.FVersionAsString := Data^.FVersionAsString; PDData^.FDataType := 2; PDNode := FVSTPackageData.AddChild(nil); PDData := FVSTPackageData.GetNodeData(PDNode); PDData^.FDescription := Trim(Data^.FDescription); PDData^.FDataType := 3; PDNode := FVSTPackageData.AddChild(nil); PDData := FVSTPackageData.GetNodeData(PDNode); PDData^.FAuthor := Data^.FAuthor; PDData^.FDataType := 4; PDNode := FVSTPackageData.AddChild(nil); PDData := FVSTPackageData.GetNodeData(PDNode); PDData^.FPackageType := Data^.FPackageType; PDData^.FDataType := 5; PDNode := FVSTPackageData.AddChild(nil); PDData := FVSTPackageData.GetNodeData(PDNode); PDData^.FDependenciesAsString := Data^.FDependenciesAsString; PDData^.FDataType := 6; PDNode := FVSTPackageData.AddChild(nil); PDData := FVSTPackageData.GetNodeData(PDNode); PDData^.FLicense := Trim(Data^.FLicense); PDData^.FDataType := 7; edLazCompatibility.Text := Data^.FLazCompatibility; edFPCCompatibility.Text := Data^.FFPCCompatibility; edSupportedWidgetset.Text := Data^.FSupportedWidgetSet; end; ShowHideControls(2); end; procedure TCreateRepositoryPackagesFrm.VSTPackagesChecked( Sender: TBaseVirtualTree; Node: PVirtualNode); begin EnableDisableControls(True); end; procedure TCreateRepositoryPackagesFrm.VSTPackagesFreeNode( Sender: TBaseVirtualTree; Node: PVirtualNode); var Data: PData; begin Data := FVSTPackages.GetNodeData(Node); Finalize(Data^); end; procedure TCreateRepositoryPackagesFrm.VSTPackageDataGetText( Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); var Data: PData; begin Data := FVSTPackageData.GetNodeData(Node); case Column of 0: case Data^.FDataType of 2: CellText := rsMainFrm_VSTText_Version; 3: CellText := rsMainFrm_VSTText_Description; 4: CellText := rsMainFrm_VSTText_Author; 5: CellText := rsMainFrm_VSTText_Packagetype; 6: CellText := rsMainFrm_VSTText_Dependecies; 7: CellText := rsMainFrm_VSTText_License; end; 1: case Data^.FDataType of 2: CellText := Data^.FVersionAsString; 3: CellText := Data^.FDescription; 4: CellText := Data^.FAuthor; 5: case Data^.FPackageType of lptRunAndDesignTime: CellText := rsMainFrm_VSTText_PackageType0; lptDesignTime: CellText := rsMainFrm_VSTText_PackageType1; lptRunTime: CellText := rsMainFrm_VSTText_PackageType2; lptRunTimeOnly: CellText := rsMainFrm_VSTText_PackageType3; end; 6: CellText := Data^.FDependenciesAsString; 7: CellText := Data^.FLicense; end; end; end; procedure TCreateRepositoryPackagesFrm.VSTPackageDataGetImageIndex( Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); var Data: PData; begin if Column = 0 then begin Data := FVSTPackageData.GetNodeData(Node); ImageIndex := IMAGE_INDEX_MAP[Data^.FDataType]; end; end; procedure TCreateRepositoryPackagesFrm.VSTCompareNodes( Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); var Data1: PData; Data2: PData; begin Data1 := Sender.GetNodeData(Node1); Data2 := Sender.GetNodeData(Node2); if Column = 0 then begin if (Data1^.FDataType = 1) and (Data1^.FDataType = 1) then Result := CompareText(Data1^.FName, Data2^.FName); if (Data1^.FDataType < Data2^.FDataType) then Result := 0 else if (Data1^.FDataType > Data2^.FDataType) then Result := 1 end; end; procedure TCreateRepositoryPackagesFrm.VSTPackageDataFreeNode( Sender: TBaseVirtualTree; Node: PVirtualNode); var Data: PData; begin Data := FVSTPackageData.GetNodeData(Node); Finalize(Data^); end; procedure TCreateRepositoryPackagesFrm.DoOnZippError(Sender: TObject; AZipFile: String; const AErrMsg: String); begin FPreventClose := False; ChangeCursor(crDefault); MessageDlgEx(rsCreateRepositoryPackageFrm_Error1 + ' "' + AZipFile + '". ' + rsProgressFrm_Error1 + sLineBreak + AErrMsg, mtError, [mbOk], Self); ShowHideControls(2); EnableDisableControls(True); end; function TCreateRepositoryPackagesFrm.TranslateCategories(const AStr: String ): String; var SL: TStringList; I, J: Integer; Str: String; begin if Categories[0] = CategoriesEng[0] then begin Result := AStr; Exit; end; Result := ''; SL := TStringList.Create; try SL.Delimiter := ','; SL.StrictDelimiter := True; SL.DelimitedText := AStr; for I := 0 to SL.Count - 1 do begin Str := Trim(SL.Strings[I]); for J := 0 to MaxCategories - 1 do begin if Str = Categories[J] then begin if Result = '' then Result := CategoriesEng[J] else Result := Result + ', ' + CategoriesEng[J]; Break; end; end; end; finally SL.Free; end; if Result = '' then Result := AStr; end; function TCreateRepositoryPackagesFrm.CreateJSONForUpdates(var AErrMsg: String ): Boolean; var RootNode, Node: PVirtualNode; RootData, Data: PData; JSON: TJSONStringType; Ms: TMemoryStream; UpdatePackage: TUpdatePackage; UpdateLazPkgs: TUpdateLazPackages; begin Result := False; pnMessage.Caption := rsCreateRepositoryPackageFrm_Message6; pnMessage.Invalidate; Application.ProcessMessages; Sleep(2000); UpdatePackage := TUpdatePackage.Create; try RootNode := FVSTPackages.GetFirst; if RootNode <> nil then begin RootData := FVSTPackages.GetNodeData(RootNode); UpdatePackage.UpdatePackageData.Name := RootData^.FName; UpdatePackage.UpdatePackageData.DownloadZipURL := RootData^.FDownloadURL; Node := FVSTPackages.GetFirstChild(RootNode); while Assigned(Node) do begin if FVSTPackages.CheckState[Node] = csCheckedNormal then begin Data := FVSTPackages.GetNodeData(Node); UpdateLazPkgs := TUpdateLazPackages(UpdatePackage.UpdateLazPackages.Add); UpdateLazPkgs.Name := Data^.FName; UpdateLazPkgs.Version := Data^.FVersionAsString; UpdateLazPkgs.ForceNotify := False; UpdateLazPkgs.InternalVersion := 1; end; Node := FVSTPackages.GetNextSibling(Node); end; end; JSON := ''; if UpdatePackage.SaveToJSON(JSON) then begin JSON := StringReplace(JSON, '\/', '/', [rfReplaceAll]); Ms := TMemoryStream.Create; try Ms.Write(Pointer(JSON)^, Length(JSON)); Ms.Position := 0; Ms.SaveToFile(FDestDir + 'update_' + FPackageName + '.json'); finally MS.Free; end; Result := True; end else AErrMsg := rsCreateJSONForUpdatesFrm_Error1 + sLineBreak + '"' + StringReplace(UpdatePackage.LastError, '"', '', [rfReplaceAll]) + '"'; finally UpdatePackage.Free; end; end; function TCreateRepositoryPackagesFrm.CreateJSON(var AErrMsg: String): Boolean; var SerializablePackages: TSerializablePackages; MetaPkg: TMetaPackage; LazarusPkg: TLazarusPackage; RootNode, Node: PVirtualNode; RootData, Data: PData; JSON: TJSONStringType; MS: TMemoryStream; begin Result := False; pnMessage.Caption := rsCreateRepositoryPackageFrm_Message5; pnMessage.Invalidate; Application.ProcessMessages; Sleep(2000); SerializablePackages := TSerializablePackages.Create; try RootNode := FVSTPackages.GetFirst; if RootNode <> nil then begin RootData := FVSTPackages.GetNodeData(RootNode); MetaPkg := SerializablePackages.AddMetaPackage(RootData^.FName); MetaPkg.Category := TranslateCategories(RootData^.FCategory); MetaPkg.RepositoryFileName := ExtractFileName(FPackageFile); MetaPkg.RepositoryFileSize := FileUtil.FileSize(FPackageFile); MetaPkg.RepositoryFileHash := MD5Print(MD5File(FPackageFile)); MetaPkg.RepositoryDate := now; MetaPkg.PackageBaseDir := RootData^.FPackageBaseDir; if Trim(RootData^.FDisplayName) <> '' then begin MetaPkg.Name := RootData^.FDisplayName; MetaPkg.DisplayName := RootData^.FDisplayName; end else MetaPkg.DisplayName := RootData^.FName; MetaPkg.HomePageURL := RootData^.FHomePageURL; MetaPkg.DownloadURL := RootData^.FDownloadURL; MetaPkg.SVNURL := RootData^.FSVNURL; MetaPkg.CommunityDescription := RootData^.FCommunityDescription; MetaPkg.ExternalDependecies := RootData^.FExternalDependencies; Node := FVSTPackages.GetFirstChild(RootNode); while Assigned(Node) do begin if FVSTPackages.CheckState[Node] = csCheckedNormal then begin Data := FVSTPackages.GetNodeData(Node); LazarusPkg := TLazarusPackage(MetaPkg.LazarusPackages.Add); LazarusPkg.Name := Data^.FName; LazarusPkg.PackageRelativePath := Data^.FPackageRelativePath; LazarusPkg.Version := TPackageVersion.Create; LazarusPkg.Version.AsString := Data^.FVersionAsString; LazarusPkg.Description := Data^.FDescription; LazarusPkg.Author := Data^.FAuthor; LazarusPkg.LazCompatibility := Data^.FLazCompatibility; LazarusPkg.FPCCompatibility := Data^.FFPCCompatibility; LazarusPkg.SupportedWidgetSet := Data^.FSupportedWidgetSet; LazarusPkg.PackageType := Data^.FPackageType; LazarusPkg.Dependencies := TPackageDependencies.Create(TPackageDependency); LazarusPkg.Dependencies.SetDependenciesAsString(Data^.FDependenciesAsString); LazarusPkg.License := Data^.FLicense; end; Node := FVSTPackages.GetNextSibling(Node); end; end; if SerializablePackages.Count > 0 then begin JSON := ''; if SerializablePackages.PackagesToJSON(JSON) then begin MS := TMemoryStream.Create; try MS.Write(Pointer(JSON)^, Length(JSON)); MS.Position := 0; MS.SaveToFile(FJSONFile); Result := True; finally MS.Free; end; end else AErrMsg := rsCreateRepositoryPackageFrm_Error2 + sLineBreak + '"' + StringReplace(SerializablePackages.LastError, '"', '', [rfReplaceAll]) + '"' end; finally SerializablePackages.Free; end; end; procedure TCreateRepositoryPackagesFrm.DoOnZipCompleted(Sender: TObject); var ErrMsg, JsonUpd: String; begin ErrMsg := ''; if not CreateJSON(ErrMsg) then begin FPreventClose := False; ChangeCursor(crDefault); MessageDlgEx(ErrMsg, mtError, [mbOk], Self); Exit; end; if cbJSONForUpdates.Checked then begin ErrMsg := ''; if not CreateJSONForUpdates(ErrMsg) then begin FPreventClose := False; ChangeCursor(crDefault); MessageDlgEx(ErrMsg, mtError, [mbOk], Self); Exit; end; end; case FPackageOperation of poCreate: begin FPreventClose := False; ChangeCursor(crDefault); ShowHideControls(2); EnableDisableControls(True); if FTyp = 0 then MessageDlgEx(rsCreateRepositoryPackageFrm_Message7, mtInformation, [mbOk], Self); ModalResult := mrOk; end; poSubmit: begin Uploader := TUploader.Create; Uploader.OnUploadProgress := @DoOnUploadProgress; Uploader.OnUploadError := @DoOnUploadError; Uploader.OnUploadCompleted := @DoOnUploadCompleted; if cbJSONForUpdates.Checked then JsonUpd := FDestDir + 'update_' + FPackageName + '.json' else JsonUpd := ''; Uploader.StartUpload(cSubmitURL_Zip, cSubmitURL_JSON, FPackageFile, FJSONFile, JsonUpd); end; end; end; procedure TCreateRepositoryPackagesFrm.DoOnUploadProgress(Sender: TObject; AFileName: String); begin pnMessage.Caption := Format(rsCreateRepositoryPackageFrm_Message8, [AFileName]); pnMessage.Invalidate; Application.ProcessMessages; end; procedure TCreateRepositoryPackagesFrm.DoOnUploadError(Sender: TObject; AErrMsg: String); begin FPreventClose := False; ChangeCursor(crDefault); ShowHideControls(2); EnableDisableControls(True); MessageDlgEx(AErrMsg, mtError, [mbOk], Self); end; procedure TCreateRepositoryPackagesFrm.DoOnUploadCompleted(Sender: TObject); begin FPreventClose := False; ChangeCursor(crDefault); ShowHideControls(2); EnableDisableControls(True); Uploader := nil; if FileExists(FPackageFile) then DeleteFile(FPackageFile); if FileExists(FJSONFile) then DeleteFile(FJSONFile); if FileExists(FDestDir + 'update_' + FPackageName + '.json') then DeleteFile(FDestDir + 'update_' + FPackageName + '.json'); MessageDlgEx(rsCreateRepositoryPackageFrm_Message9, mtInformation, [mbOk], Self); ModalResult := mrOk; end; procedure TCreateRepositoryPackagesFrm.SetType(const ATyp: Integer); begin FTyp := ATyp; bSubmit.Visible := FTyp = 0; cbJSONForUpdates.Visible := FTyp = 0; bCreate.Visible := True; if FTyp = 1 then begin bCreate.Caption := rsCreateRepositoryPackageFrm_bCreate_Caption1; bCreate.Hint := rsCreateRepositoryPackageFrm_bCreate_Hint1; pnB.AutoSize := True; end; end; end.