paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-15 08:43:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

Opkman: Private repositories. End implementation.

Browse Source 
git-svn-id: trunk@55859 -
This commit is contained in:
balazs 2017-09-14 12:37:10 +00:00
parent b6a1099f7e
commit 898593b5bf
7 changed files with 154 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
components/onlinepackagemanager/opkman_addrepositorypackagefrm.lfm
View File

@ -54,9 +54,9 @@ object AddRepositoryPackageFrm: TAddRepositoryPackageFrm
LCLVersion = '1.9.0.0' LCLVersion = '1.9.0.0'
object rbCreateNew: TRadioButton object rbCreateNew: TRadioButton
Left = 31 Left = 31
Height = 19 Height = 25
Top = 24 Top = 24
Width = 135 Width = 168
Caption = 'Create a new package' Caption = 'Create a new package'
Checked = True Checked = True
TabOrder = 0 TabOrder = 0
@ -64,9 +64,9 @@ object AddRepositoryPackageFrm: TAddRepositoryPackageFrm
end end
object rbAddExisting: TRadioButton object rbAddExisting: TRadioButton
Left = 31 Left = 31
Height = 19 Height = 25
Top = 64 Top = 64
Width = 180 Width = 220
Caption = 'Add existing package from file' Caption = 'Add existing package from file'
TabOrder = 1 TabOrder = 1
end end
@ -78,23 +78,23 @@ object AddRepositoryPackageFrm: TAddRepositoryPackageFrm
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
BorderStyle = bsSingle BorderStyle = bsSingle
ClientHeight = 37 ClientHeight = 39
ClientWidth = 455 ClientWidth = 457
TabOrder = 2 TabOrder = 2
object bOk: TButton object bOk: TButton
Left = 266 Left = 268
Height = 27 Height = 27
Top = 4 Top = 4
Width = 85 Width = 85
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Caption = 'OK' Caption = 'OK'
ModalResult = 1 OnClick = bOkClick
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
TabOrder = 0 TabOrder = 0
end end
object bCancel: TButton object bCancel: TButton
Left = 352 Left = 354
Height = 27 Height = 27
Top = 4 Top = 4
Width = 85 Width = 85
@ -108,4 +108,10 @@ object AddRepositoryPackageFrm: TAddRepositoryPackageFrm
TabOrder = 1 TabOrder = 1
end end
end end
object ODPack: TOpenDialog
DefaultExt = '.json'
Filter = '*.json|*.json'
left = 304
top = 16
end
end end

32
components/onlinepackagemanager/opkman_addrepositorypackagefrm.pas
View File

@ -15,21 +15,26 @@ type
TAddRepositoryPackageFrm = class(TForm) TAddRepositoryPackageFrm = class(TForm)
bCancel: TButton; bCancel: TButton;
bOk: TButton; bOk: TButton;
ODPack: TOpenDialog;
pnButtons: TPanel; pnButtons: TPanel;
rbCreateNew: TRadioButton; rbCreateNew: TRadioButton;
rbAddExisting: TRadioButton; rbAddExisting: TRadioButton;
procedure bOkClick(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
private private
FJSONFile: String;
FPackageFile: String;
public public
property JSONFile: String read FJSONFile;
property PackageFile: String read FPackageFile;
end; end;
var var
AddRepositoryPackageFrm: TAddRepositoryPackageFrm; AddRepositoryPackageFrm: TAddRepositoryPackageFrm;
implementation implementation
uses opkman_const;
uses opkman_const, opkman_options, opkman_common;
{$R *.lfm} {$R *.lfm}
{ TAddRepositoryPackageFrm } { TAddRepositoryPackageFrm }
@ -45,5 +50,26 @@ begin
bCancel.Hint := rsAddRepositoryPackageFrm_bCancel_Hint; bCancel.Hint := rsAddRepositoryPackageFrm_bCancel_Hint;
end; end;
procedure TAddRepositoryPackageFrm.bOkClick(Sender: TObject);
begin
if rbAddExisting.Checked then
begin
ODPack.InitialDir := Options.LastPackagedirDst;
if ODPack.Execute then
begin
FJSONFile := ODPack.FileName;
FPackageFile := ChangeFileExt(FJSONFile, '.zip');
if not FileExists(FPackageFile) then
begin
MessageDlgEx(Format(rsCreateRepositoryFrm_Info5, [ExtractFileName(FPackageFile)]), mtInformation, [mbOk], Self);
Exit;
end;
end
else
Exit;
end;
ModalResult := mrOk;
end;
end. end.

2
components/onlinepackagemanager/opkman_const.pas
View File

@ -440,7 +440,7 @@ resourcestring
rsCreateRepositoryFrm_Error5 = 'Cannot delete package: "%s"!'; rsCreateRepositoryFrm_Error5 = 'Cannot delete package: "%s"!';
rsCreateRepositoryFrm_Info1 = 'The following directory: "%s" is not empty.' + sLineBreak + 'It''s recommended to save the repository to an empty directory. Continue?'; rsCreateRepositoryFrm_Info1 = 'The following directory: "%s" is not empty.' + sLineBreak + 'It''s recommended to save the repository to an empty directory. Continue?';
rsCreateRepositoryFrm_Info2 = 'The following directory: "%s" is read only.'; rsCreateRepositoryFrm_Info2 = 'The following directory: "%s" is read only.';
rsCreateRepositoryFrm_Info3 = 'The following repository package: "%s" is already in the current repository.' + sLineBreak + 'Each repository and lazarus package must be unique!'; rsCreateRepositoryFrm_Info3 = 'The following package: "%s" is already in the current repository.' + sLineBreak + 'Each repository and lazarus package must be unique!';
rsCreateRepositoryFrm_Info5 = 'The following lazarus package: "%s" is already in the current repository.' + sLineBreak + 'Each repository and lazarus package must be unique!'; rsCreateRepositoryFrm_Info5 = 'The following lazarus package: "%s" is already in the current repository.' + sLineBreak + 'Each repository and lazarus package must be unique!';
rsCreateRepositoryFrm_Info6 = 'Cannot locate package file: "%s"!'; rsCreateRepositoryFrm_Info6 = 'Cannot locate package file: "%s"!';
rsCreateRepositoryFrm_Info7 = 'Package successfully added to repository.'; rsCreateRepositoryFrm_Info7 = 'Package successfully added to repository.';

45
components/onlinepackagemanager/opkman_createrepositoryfrm.lfm
View File

@ -1,12 +1,12 @@
object CreateRepositoryFrm: TCreateRepositoryFrm object CreateRepositoryFrm: TCreateRepositoryFrm
Left = 350 Left = 286
Height = 600 Height = 600
Top = 250 Top = 116
Width = 800 Width = 900
BorderIcons = [biSystemMenu] BorderIcons = [biSystemMenu]
Caption = 'CreateRepositoryFrm' Caption = 'CreateRepositoryFrm'
ClientHeight = 600 ClientHeight = 600
ClientWidth = 800 ClientWidth = 900
Constraints.MinHeight = 450 Constraints.MinHeight = 450
Constraints.MinWidth = 650 Constraints.MinWidth = 650
OnCreate = FormCreate OnCreate = FormCreate
@ -19,12 +19,12 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
Left = 0 Left = 0
Height = 41 Height = 41
Top = 559 Top = 559
Width = 800 Width = 900
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
BorderStyle = bsSingle BorderStyle = bsSingle
ClientHeight = 37 ClientHeight = 39
ClientWidth = 796 ClientWidth = 898
TabOrder = 2 TabOrder = 2
OnResize = pnButtonsResize OnResize = pnButtonsResize
object bOpen: TButton object bOpen: TButton
@ -50,7 +50,7 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
TabOrder = 0 TabOrder = 0
end end
object bCancel: TButton object bCancel: TButton
Left = 700 Left = 802
Height = 27 Height = 27
Top = 4 Top = 4
Width = 85 Width = 85
@ -239,7 +239,7 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
Left = 287 Left = 287
Height = 559 Height = 559
Top = 0 Top = 0
Width = 513 Width = 613
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 1 TabOrder = 1
@ -258,7 +258,7 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
Left = 287 Left = 287
Height = 559 Height = 559
Top = 0 Top = 0
Width = 513 Width = 613
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
Caption = 'No items to show' Caption = 'No items to show'
@ -273,19 +273,6 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
TabOrder = 3 TabOrder = 3
Visible = False Visible = False
end end
object SD: TSaveDialog
DefaultExt = '.opkman'
Filter = '*.opkman|*.opkman'
Options = [ofOverwritePrompt, ofEnableSizing, ofViewDetail]
left = 41
top = 83
end
object OD: TOpenDialog
DefaultExt = '.opkman'
Filter = '*.opkman|*.opkman'
left = 88
top = 84
end
object imTree: TImageList object imTree: TImageList
left = 40 left = 40
top = 32 top = 32
@ -1132,12 +1119,6 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
left = 85 left = 85
top = 32 top = 32
end end
object ODPack: TOpenDialog
DefaultExt = '.json'
Filter = '*.json|*.json'
left = 139
top = 84
end
object pm: TPopupMenu object pm: TPopupMenu
left = 139 left = 139
top = 37 top = 37
@ -1146,4 +1127,10 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
OnClick = miRepDetailsClick OnClick = miRepDetailsClick
end end
end end
object ODRep: TOpenDialog
DefaultExt = '.opmrep'
Filter = '*.opmrep|*.opmrep'
left = 85
top = 104
end
end end

123
components/onlinepackagemanager/opkman_createrepositoryfrm.pas
View File

@ -58,14 +58,12 @@ type
bCreate: TButton; bCreate: TButton;
imTree: TImageList; imTree: TImageList;
miRepDetails: TMenuItem; miRepDetails: TMenuItem;
OD: TOpenDialog; ODRep: TOpenDialog;
ODPack: TOpenDialog;
pnButtons: TPanel; pnButtons: TPanel;
pnMessage: TPanel; pnMessage: TPanel;
pnPackages: TPanel; pnPackages: TPanel;
pnDetails: TPanel; pnDetails: TPanel;
pm: TPopupMenu; pm: TPopupMenu;
SD: TSaveDialog;
spMain: TSplitter; spMain: TSplitter;
tmWait: TTimer; tmWait: TTimer;
procedure bAddClick(Sender: TObject); procedure bAddClick(Sender: TObject);
@ -86,10 +84,10 @@ type
procedure EnableDisableButtons(const AEnable: Boolean); procedure EnableDisableButtons(const AEnable: Boolean);
procedure ShowHideControls(const AType: Integer); procedure ShowHideControls(const AType: Integer);
function LoadRepository(const AFileName: String): Boolean; function LoadRepository(const AFileName: String): Boolean;
function SaveRepository(const AFileName: String; const AIsNew: Boolean): Boolean; function SaveRepository(const AFileName: String): Boolean;
procedure PopulatePackageTree; procedure PopulatePackageTree;
procedure AddNewPackage; procedure AddNewPackage;
procedure AddExistingPackage; procedure AddExistingPackage(const AJSONFile, APackageFile: String);
function GetDisplayString(const AStr: String): String; function GetDisplayString(const AStr: String): String;
function LoadJSONFromFile(const AFileName: String; out AJSON: TJSONStringType): Boolean; function LoadJSONFromFile(const AFileName: String; out AJSON: TJSONStringType): Boolean;
function SaveJSONToFile(const AFileName: String; const AJSON: TJSONStringType): Boolean; function SaveJSONToFile(const AFileName: String; const AJSON: TJSONStringType): Boolean;
@ -194,7 +192,7 @@ begin
Colors.BorderColor := clBlack; Colors.BorderColor := clBlack;
with Header.Columns.Add do begin with Header.Columns.Add do begin
Position := 0; Position := 0;
Width := 250; Width := 300;
Text := rsCreateRepositoryFrm_VSTPackages_Column0; Text := rsCreateRepositoryFrm_VSTPackages_Column0;
end; end;
Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoVisible, hoAutoSpring]; Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoVisible, hoAutoSpring];
@ -231,7 +229,7 @@ begin
Colors.BorderColor := clBlack; Colors.BorderColor := clBlack;
with Header.Columns.Add do begin with Header.Columns.Add do begin
Position := 0; Position := 0;
Width := 150; Width := 200;
Text := rsCreateRepositoryFrm_VSTDetails_Column0; Text := rsCreateRepositoryFrm_VSTDetails_Column0;
end; end;
with Header.Columns.Add do begin with Header.Columns.Add do begin
@ -253,32 +251,21 @@ begin
end; end;
procedure TCreateRepositoryFrm.bCreateClick(Sender: TObject); procedure TCreateRepositoryFrm.bCreateClick(Sender: TObject);
label
ShowFormAgain;
var var
RepositoryDetailsFrm: TRepositoryDetailsFrm; RepositoryDetailsFrm: TRepositoryDetailsFrm;
begin begin
RepositoryDetailsFrm := TRepositoryDetailsFrm.Create(Self); RepositoryDetailsFrm := TRepositoryDetailsFrm.Create(Self);
try try
ShowFormAgain: RepositoryDetailsFrm.IsNew := True;
RepositoryDetailsFrm.ShowModal; RepositoryDetailsFrm.ShowModal;
if RepositoryDetailsFrm.ModalResult = mrOk then if RepositoryDetailsFrm.ModalResult = mrOk then
begin begin
FRepository.FName := RepositoryDetailsFrm.edName.Text; FRepository.FName := RepositoryDetailsFrm.edName.Text;
FRepository.FAddress := RepositoryDetailsFrm.edAddress.Text; FRepository.FAddress := RepositoryDetailsFrm.edAddress.Text;
FRepository.FDescription := RepositoryDetailsFrm.mDescription.Text; FRepository.FDescription := RepositoryDetailsFrm.mDescription.Text;
if SD.Execute then if SaveRepository(RepositoryDetailsFrm.FileName) then
begin if LoadRepository(RepositoryDetailsFrm.FileName) then
if SaveRepository(SD.FileName, True) then PopulatePackageTree;
begin
if RepositoryDetailsFrm.Address <> '' then
Options.RemoteRepository.Add(RepositoryDetailsFrm.Address);
if LoadRepository(SD.FileName) then
PopulatePackageTree;
end
else
GoTo ShowFormAgain;
end;
end; end;
finally finally
RepositoryDetailsFrm.Free; RepositoryDetailsFrm.Free;
@ -436,52 +423,38 @@ begin
end; end;
end; end;
procedure TCreateRepositoryFrm.AddExistingPackage; procedure TCreateRepositoryFrm.AddExistingPackage(const AJSONFile,
APackageFile: String);
var var
PackageFile: String;
JSONFile: String;
JSON: TJSONStringType; JSON: TJSONStringType;
CanGo: Boolean; CanGo: Boolean;
begin begin
ODPack.InitialDir := Options.LastPackagedirDst; CanGo := False;
if ODPack.Execute then if LoadJSONFromFile(AJSONFile, JSON) then
begin begin
JSONFile := ODPack.FileName; if not IsDuplicatePackage(JSON, APackageFile) then
PackageFile := ChangeFileExt(JSONFile, '.zip');
if not FileExists(PackageFile) then
begin begin
MessageDlgEx(Format(rsCreateRepositoryFrm_Info5, [ExtractFileName(PackageFile)]), mtInformation, [mbOk], Self); if FSerializablePackages.AddPackageFromJSON(JSON) then
MessageDlgEx(rsCreateRepositoryFrm_Error4, mtError, [mbOk], Self);
Exit;
end;
CanGo := False;
if LoadJSONFromFile(JSONFile, JSON) then
begin
if not IsDuplicatePackage(JSON, PackageFile) then
begin begin
if FSerializablePackages.AddPackageFromJSON(JSON) then JSON := '';
if FSerializablePackages.PackagesToJSON(JSON) then
begin begin
JSON := ''; if SaveJSONToFile(ExtractFilePath(FRepository.FPath) + cRemoteJSONFile, JSON) then
if FSerializablePackages.PackagesToJSON(JSON) then
begin begin
if SaveJSONToFile(ExtractFilePath(FRepository.FPath) + cRemoteJSONFile, JSON) then if LoadRepository(FRepository.FPath) then
begin begin
if LoadRepository(FRepository.FPath) then CanGo := True;
begin PopulatePackageTree;
CanGo := True;
PopulatePackageTree;
end;
end; end;
end; end;
end; end;
end; end;
end; end;
if not CanGo then
MessageDlgEx(rsCreateRepositoryFrm_Error4, mtError, [mbOk], Self)
else
MessageDlgEx(rsCreateRepositoryFrm_Info7, mtInformation, [mbOk], Self);
end; end;
if not CanGo then
MessageDlgEx(rsCreateRepositoryFrm_Error4, mtError, [mbOk], Self)
else
MessageDlgEx(rsCreateRepositoryFrm_Info7, mtInformation, [mbOk], Self);
end; end;
procedure TCreateRepositoryFrm.bAddClick(Sender: TObject); procedure TCreateRepositoryFrm.bAddClick(Sender: TObject);
@ -494,7 +467,7 @@ begin
if AddRepositoryPackageFrm.rbCreateNew.Checked then if AddRepositoryPackageFrm.rbCreateNew.Checked then
AddNewPackage AddNewPackage
else else
AddExistingPackage; AddExistingPackage(AddRepositoryPackageFrm.JSONFile, AddRepositoryPackageFrm.PackageFile);
end; end;
finally finally
AddRepositoryPackageFrm.Free; AddRepositoryPackageFrm.Free;
@ -503,8 +476,8 @@ end;
procedure TCreateRepositoryFrm.bOpenClick(Sender: TObject); procedure TCreateRepositoryFrm.bOpenClick(Sender: TObject);
begin begin
if OD.Execute then if ODRep.Execute then
if LoadRepository(OD.FileName) then if LoadRepository(ODRep.FileName) then
PopulatePackageTree; PopulatePackageTree;
end; end;
@ -531,6 +504,7 @@ begin
RepositoryDetailsFrm.edName.Text := FRepository.FName; RepositoryDetailsFrm.edName.Text := FRepository.FName;
RepositoryDetailsFrm.edAddress.Text := FRepository.FAddress; RepositoryDetailsFrm.edAddress.Text := FRepository.FAddress;
RepositoryDetailsFrm.mDescription.Text := FRepository.FDescription; RepositoryDetailsFrm.mDescription.Text := FRepository.FDescription;
RepositoryDetailsFrm.IsNew := False;
RepositoryDetailsFrm.ShowModal; RepositoryDetailsFrm.ShowModal;
if RepositoryDetailsFrm.ModalResult = mrOk then if RepositoryDetailsFrm.ModalResult = mrOk then
begin begin
@ -551,13 +525,9 @@ begin
FRepository.FName := RepositoryDetailsFrm.edName.Text; FRepository.FName := RepositoryDetailsFrm.edName.Text;
FRepository.FAddress := RepositoryDetailsFrm.edAddress.Text; FRepository.FAddress := RepositoryDetailsFrm.edAddress.Text;
FRepository.FDescription := RepositoryDetailsFrm.mDescription.Text; FRepository.FDescription := RepositoryDetailsFrm.mDescription.Text;
if SaveRepository(FRepository.FPath, False) then if SaveRepository(FRepository.FPath) then
begin
if RepositoryDetailsFrm.Address <> '' then
Options.RemoteRepository.Add(RepositoryDetailsFrm.Address);
if LoadRepository(FRepository.FPath) then if LoadRepository(FRepository.FPath) then
PopulatePackageTree; PopulatePackageTree;
end;
end; end;
finally finally
RepositoryDetailsFrm.Free; RepositoryDetailsFrm.Free;
@ -655,42 +625,18 @@ begin
end; end;
end; end;
function TCreateRepositoryFrm.SaveRepository(const AFileName: String; function TCreateRepositoryFrm.SaveRepository(const AFileName: String): Boolean;
const AIsNew: Boolean): Boolean;
var var
FS: TFileStream; FS: TFileStream;
FHandle: THandle;
begin begin
Result := False; Result := False;
if (AIsNew) and (not IsDirectoryEmpty(ExtractFilePath(AFileName))) then
begin
if MessageDlgEx(Format(rsCreateRepositoryFrm_Info1, [ExtractFilePath(AFileName)]), mtConfirmation, [mbYes, mbNo], Self) = mrNo then
Exit;
end;
if not DirectoryIsWritable(ExtractFilePath(AFileName)) then
begin
MessageDlgEx(Format(rsCreateRepositoryFrm_Info1, [ExtractFilePath(AFileName)]), mtConfirmation, [mbOk], Self);
Exit;
end;
FS := TFileStream.Create(AFileName, fmCreate or fmOpenWrite or fmShareDenyWrite); FS := TFileStream.Create(AFileName, fmCreate or fmOpenWrite or fmShareDenyWrite);
try try
try try
FS.WriteAnsiString(FRepository.FName); FS.WriteAnsiString(FRepository.FName);
FS.WriteAnsiString(FRepository.FAddress); FS.WriteAnsiString(FRepository.FAddress);
FS.WriteAnsiString(FRepository.FDescription); FS.WriteAnsiString(FRepository.FDescription);
if AIsNew then Result := True;
begin
FHandle := FileCreate(ExtractFilePath(AFileName) + cRemoteJSONFile);
if fHandle <> THandle(-1) then
begin
Result := True;
FileClose(FHandle);
end;
end
else
Result := True;
except except
on E: Exception do on E: Exception do
MessageDlgEx(Format(rsCreateRepositoryFrm_Error3, [AFileName, E.Message]), mtError, [mbOk], Self); MessageDlgEx(Format(rsCreateRepositoryFrm_Error3, [AFileName, E.Message]), mtError, [mbOk], Self);
@ -711,6 +657,7 @@ var
begin begin
FVSTPackages.Clear; FVSTPackages.Clear;
FVSTPackages.NodeDataSize := SizeOf(TData);
//add repository(DataType = 0) //add repository(DataType = 0)
RootNode := FVSTPackages.AddChild(nil); RootNode := FVSTPackages.AddChild(nil);
@ -901,6 +848,7 @@ begin
Exit; Exit;
FVSTDetails.Clear; FVSTDetails.Clear;
FVSTDetails.NodeDataSize := SizeOf(TData);
Data := FVSTPackages.GetNodeData(Node); Data := FVSTPackages.GetNodeData(Node);
case Data^.FDataType of case Data^.FDataType of
0: begin 0: begin
@ -1023,6 +971,7 @@ var
begin begin
if TextType <> ttNormal then if TextType <> ttNormal then
Exit; Exit;
PackageNode := FVSTPackages.GetFirstSelected; PackageNode := FVSTPackages.GetFirstSelected;
if PackageNode = nil then if PackageNode = nil then
Exit; Exit;
@ -1143,7 +1092,7 @@ procedure TCreateRepositoryFrm.VSTDetailsFreeNode(Sender: TBaseVirtualTree;
var var
Data: PData; Data: PData;
begin begin
Data := FVSTPackages.GetNodeData(Node); Data := FVSTDetails.GetNodeData(Node);
Finalize(Data^); Finalize(Data^);
end; end;

29
components/onlinepackagemanager/opkman_repositorydetailsfrm.lfm
View File

@ -50,15 +50,15 @@ object RepositoryDetailsFrm: TRepositoryDetailsFrm
end end
object lbName: TLabel object lbName: TLabel
Left = 19 Left = 19
Height = 15 Height = 21
Top = 13 Top = 13
Width = 89 Width = 108
Caption = 'Repository name' Caption = 'Repository name'
ParentColor = False ParentColor = False
end end
object edName: TEdit object edName: TEdit
Left = 19 Left = 19
Height = 23 Height = 31
Top = 31 Top = 31
Width = 357 Width = 357
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
@ -68,15 +68,15 @@ object RepositoryDetailsFrm: TRepositoryDetailsFrm
end end
object lbAddress: TLabel object lbAddress: TLabel
Left = 19 Left = 19
Height = 15 Height = 21
Top = 69 Top = 69
Width = 99 Width = 125
Caption = 'Repository address' Caption = 'Repository address'
ParentColor = False ParentColor = False
end end
object edAddress: TEdit object edAddress: TEdit
Left = 18 Left = 18
Height = 23 Height = 31
Top = 87 Top = 87
Width = 358 Width = 358
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
@ -87,9 +87,9 @@ object RepositoryDetailsFrm: TRepositoryDetailsFrm
end end
object lbDescription: TLabel object lbDescription: TLabel
Left = 19 Left = 19
Height = 15 Height = 21
Top = 130 Top = 130
Width = 118 Width = 146
Caption = 'Repository description' Caption = 'Repository description'
ParentColor = False ParentColor = False
end end
@ -104,10 +104,10 @@ object RepositoryDetailsFrm: TRepositoryDetailsFrm
TabOrder = 2 TabOrder = 2
end end
object lbOF2: TLabel object lbOF2: TLabel
Left = 380 Left = 377
Height = 15 Height = 21
Top = 36 Top = 36
Width = 5 Width = 8
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Caption = '*' Caption = '*'
Font.Color = clRed Font.Color = clRed
@ -115,4 +115,11 @@ object RepositoryDetailsFrm: TRepositoryDetailsFrm
ParentColor = False ParentColor = False
ParentFont = False ParentFont = False
end end
object SDRep: TSaveDialog
DefaultExt = '.opmrep'
Filter = '*.opmrep|*.opmrep'
Options = [ofOverwritePrompt, ofEnableSizing, ofViewDetail]
left = 16
top = 264
end
end end

53
components/onlinepackagemanager/opkman_repositorydetailsfrm.pas
View File

@ -6,7 +6,7 @@ interface
uses uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls; StdCtrls, LazFileUtils;
type type
@ -23,21 +23,26 @@ type
lbOF2: TLabel; lbOF2: TLabel;
mDescription: TMemo; mDescription: TMemo;
pnButtons: TPanel; pnButtons: TPanel;
SDRep: TSaveDialog;
procedure bOkClick(Sender: TObject); procedure bOkClick(Sender: TObject);
procedure edAddressChange(Sender: TObject); procedure edAddressChange(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
private private
FAddress: String; FFileName: string;
function IsDuplicateRepository(const AAddress: String): Boolean; FIsNew: boolean;
function IsDuplicateRepository(const AAddress: string): boolean;
public public
property Address: String read FAddress; property FileName: string read FFileName;
property IsNew: boolean read FIsNew write FIsNew;
end; end;
var var
RepositoryDetailsFrm: TRepositoryDetailsFrm; RepositoryDetailsFrm: TRepositoryDetailsFrm;
implementation implementation
uses opkman_const, opkman_common, opkman_options; uses opkman_const, opkman_common, opkman_options;
{$R *.lfm} {$R *.lfm}
{ TRepositoryDetailsFrm } { TRepositoryDetailsFrm }
@ -55,12 +60,11 @@ begin
bOk.Hint := rsRepositoryDetailsFrm_bOk_Hint; bOk.Hint := rsRepositoryDetailsFrm_bOk_Hint;
bCancel.Caption := rsRepositoryDetailsFrm_bCancel_Caption; bCancel.Caption := rsRepositoryDetailsFrm_bCancel_Caption;
bCancel.Hint := rsRepositoryDetailsFrm_bCancel_Hint; bCancel.Hint := rsRepositoryDetailsFrm_bCancel_Hint;
FAddress := '';
end; end;
function TRepositoryDetailsFrm.IsDuplicateRepository(const AAddress: String): Boolean; function TRepositoryDetailsFrm.IsDuplicateRepository(const AAddress: string): boolean;
var var
I: Integer; I: integer;
begin begin
Result := False; Result := False;
for I := 0 to Options.RemoteRepository.Count - 1 do for I := 0 to Options.RemoteRepository.Count - 1 do
@ -74,21 +78,43 @@ begin
end; end;
procedure TRepositoryDetailsFrm.bOkClick(Sender: TObject); procedure TRepositoryDetailsFrm.bOkClick(Sender: TObject);
var
Address: String;
begin begin
if Trim(edName.Text) = '' then if Trim(edName.Text) = '' then
begin begin
MessageDlgEx(rsRepositoryDetailsFrm_Info1, mtInformation, [mbOk], Self); MessageDlgEx(rsRepositoryDetailsFrm_Info1, mtInformation, [mbOK], Self);
edName.SetFocus; edName.SetFocus;
Exit; Exit;
end; end;
if (FIsNew) then
begin
if SDRep.Execute then
begin
if (not IsDirectoryEmpty(ExtractFilePath(SDRep.FileName))) then
if MessageDlgEx(Format(rsCreateRepositoryFrm_Info1, [ExtractFilePath(SDRep.FileName)]), mtConfirmation, [mbYes, mbNo], Self) = mrNo then
Exit;
if not DirectoryIsWritable(ExtractFilePath(SDRep.FileName)) then
begin
MessageDlgEx(Format(rsCreateRepositoryFrm_Info1, [ExtractFilePath(SDRep.FileName)]), mtConfirmation, [mbOK], Self);
Exit;
end;
FFileName := SDRep.FileName;
end
else
Exit;
end;
if Trim(edAddress.Text) <> '' then if Trim(edAddress.Text) <> '' then
begin begin
FAddress := Trim(edAddress.Text); Address := Trim(edAddress.Text);
if FAddress[Length(FAddress)] <> '/' then if Address[Length(Address)] <> '/' then
FAddress := FAddress + '/'; Address := Address + '/';
if IsDuplicateRepository(FAddress) then if not IsDuplicateRepository(Address) then
FAddress := ''; Options.RemoteRepository.Add(Address);
end; end;
ModalResult := mrOk; ModalResult := mrOk;
end; end;
@ -98,4 +124,3 @@ begin
end; end;
end. end.