mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 06:55:59 +02:00
Opkman: Private repositories. End implementation.
git-svn-id: trunk@55859 -
This commit is contained in:
balazs
parent
b6a1099f7e
commit
898593b5bf
@ -54,9 +54,9 @@ object AddRepositoryPackageFrm: TAddRepositoryPackageFrm
|
||||
LCLVersion = '1.9.0.0'
|
||||
object rbCreateNew: TRadioButton
|
||||
Left = 31
|
||||
Height = 19
|
||||
Height = 25
|
||||
Top = 24
|
||||
Width = 135
|
||||
Width = 168
|
||||
Caption = 'Create a new package'
|
||||
Checked = True
|
||||
TabOrder = 0
|
||||
@ -64,9 +64,9 @@ object AddRepositoryPackageFrm: TAddRepositoryPackageFrm
|
||||
end
|
||||
object rbAddExisting: TRadioButton
|
||||
Left = 31
|
||||
Height = 19
|
||||
Height = 25
|
||||
Top = 64
|
||||
Width = 180
|
||||
Width = 220
|
||||
Caption = 'Add existing package from file'
|
||||
TabOrder = 1
|
||||
end
|
||||
@ -78,23 +78,23 @@ object AddRepositoryPackageFrm: TAddRepositoryPackageFrm
|
||||
Align = alBottom
|
||||
BevelOuter = bvNone
|
||||
BorderStyle = bsSingle
|
||||
ClientHeight = 37
|
||||
ClientWidth = 455
|
||||
ClientHeight = 39
|
||||
ClientWidth = 457
|
||||
TabOrder = 2
|
||||
object bOk: TButton
|
||||
Left = 266
|
||||
Left = 268
|
||||
Height = 27
|
||||
Top = 4
|
||||
Width = 85
|
||||
Anchors = [akTop, akRight]
|
||||
Caption = 'OK'
|
||||
ModalResult = 1
|
||||
OnClick = bOkClick
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 0
|
||||
end
|
||||
object bCancel: TButton
|
||||
Left = 352
|
||||
Left = 354
|
||||
Height = 27
|
||||
Top = 4
|
||||
Width = 85
|
||||
@ -108,4 +108,10 @@ object AddRepositoryPackageFrm: TAddRepositoryPackageFrm
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
object ODPack: TOpenDialog
|
||||
DefaultExt = '.json'
|
||||
Filter = '*.json|*.json'
|
||||
left = 304
|
||||
top = 16
|
||||
end
|
||||
end
|
||||
|
||||
@ -15,21 +15,26 @@ type
|
||||
TAddRepositoryPackageFrm = class(TForm)
|
||||
bCancel: TButton;
|
||||
bOk: TButton;
|
||||
ODPack: TOpenDialog;
|
||||
pnButtons: TPanel;
|
||||
rbCreateNew: TRadioButton;
|
||||
rbAddExisting: TRadioButton;
|
||||
procedure bOkClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
|
||||
FJSONFile: String;
|
||||
FPackageFile: String;
|
||||
public
|
||||
|
||||
property JSONFile: String read FJSONFile;
|
||||
property PackageFile: String read FPackageFile;
|
||||
end;
|
||||
|
||||
var
|
||||
AddRepositoryPackageFrm: TAddRepositoryPackageFrm;
|
||||
|
||||
implementation
|
||||
uses opkman_const;
|
||||
|
||||
uses opkman_const, opkman_options, opkman_common;
|
||||
{$R *.lfm}
|
||||
|
||||
{ TAddRepositoryPackageFrm }
|
||||
@ -45,5 +50,26 @@ begin
|
||||
bCancel.Hint := rsAddRepositoryPackageFrm_bCancel_Hint;
|
||||
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.
|
||||
|
||||
|
||||
@ -440,7 +440,7 @@ resourcestring
|
||||
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_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_Info6 = 'Cannot locate package file: "%s"!';
|
||||
rsCreateRepositoryFrm_Info7 = 'Package successfully added to repository.';
|
||||
|
||||
@ -1,12 +1,12 @@
|
||||
object CreateRepositoryFrm: TCreateRepositoryFrm
|
||||
Left = 350
|
||||
Left = 286
|
||||
Height = 600
|
||||
Top = 250
|
||||
Width = 800
|
||||
Top = 116
|
||||
Width = 900
|
||||
BorderIcons = [biSystemMenu]
|
||||
Caption = 'CreateRepositoryFrm'
|
||||
ClientHeight = 600
|
||||
ClientWidth = 800
|
||||
ClientWidth = 900
|
||||
Constraints.MinHeight = 450
|
||||
Constraints.MinWidth = 650
|
||||
OnCreate = FormCreate
|
||||
@ -19,12 +19,12 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
|
||||
Left = 0
|
||||
Height = 41
|
||||
Top = 559
|
||||
Width = 800
|
||||
Width = 900
|
||||
Align = alBottom
|
||||
BevelOuter = bvNone
|
||||
BorderStyle = bsSingle
|
||||
ClientHeight = 37
|
||||
ClientWidth = 796
|
||||
ClientHeight = 39
|
||||
ClientWidth = 898
|
||||
TabOrder = 2
|
||||
OnResize = pnButtonsResize
|
||||
object bOpen: TButton
|
||||
@ -50,7 +50,7 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
|
||||
TabOrder = 0
|
||||
end
|
||||
object bCancel: TButton
|
||||
Left = 700
|
||||
Left = 802
|
||||
Height = 27
|
||||
Top = 4
|
||||
Width = 85
|
||||
@ -239,7 +239,7 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
|
||||
Left = 287
|
||||
Height = 559
|
||||
Top = 0
|
||||
Width = 513
|
||||
Width = 613
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
TabOrder = 1
|
||||
@ -258,7 +258,7 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
|
||||
Left = 287
|
||||
Height = 559
|
||||
Top = 0
|
||||
Width = 513
|
||||
Width = 613
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
Caption = 'No items to show'
|
||||
@ -273,19 +273,6 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
|
||||
TabOrder = 3
|
||||
Visible = False
|
||||
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
|
||||
left = 40
|
||||
top = 32
|
||||
@ -1132,12 +1119,6 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
|
||||
left = 85
|
||||
top = 32
|
||||
end
|
||||
object ODPack: TOpenDialog
|
||||
DefaultExt = '.json'
|
||||
Filter = '*.json|*.json'
|
||||
left = 139
|
||||
top = 84
|
||||
end
|
||||
object pm: TPopupMenu
|
||||
left = 139
|
||||
top = 37
|
||||
@ -1146,4 +1127,10 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
|
||||
OnClick = miRepDetailsClick
|
||||
end
|
||||
end
|
||||
object ODRep: TOpenDialog
|
||||
DefaultExt = '.opmrep'
|
||||
Filter = '*.opmrep|*.opmrep'
|
||||
left = 85
|
||||
top = 104
|
||||
end
|
||||
end
|
||||
|
||||
@ -58,14 +58,12 @@ type
|
||||
bCreate: TButton;
|
||||
imTree: TImageList;
|
||||
miRepDetails: TMenuItem;
|
||||
OD: TOpenDialog;
|
||||
ODPack: TOpenDialog;
|
||||
ODRep: TOpenDialog;
|
||||
pnButtons: TPanel;
|
||||
pnMessage: TPanel;
|
||||
pnPackages: TPanel;
|
||||
pnDetails: TPanel;
|
||||
pm: TPopupMenu;
|
||||
SD: TSaveDialog;
|
||||
spMain: TSplitter;
|
||||
tmWait: TTimer;
|
||||
procedure bAddClick(Sender: TObject);
|
||||
@ -86,10 +84,10 @@ type
|
||||
procedure EnableDisableButtons(const AEnable: Boolean);
|
||||
procedure ShowHideControls(const AType: Integer);
|
||||
function LoadRepository(const AFileName: String): Boolean;
|
||||
function SaveRepository(const AFileName: String; const AIsNew: Boolean): Boolean;
|
||||
function SaveRepository(const AFileName: String): Boolean;
|
||||
procedure PopulatePackageTree;
|
||||
procedure AddNewPackage;
|
||||
procedure AddExistingPackage;
|
||||
procedure AddExistingPackage(const AJSONFile, APackageFile: String);
|
||||
function GetDisplayString(const AStr: String): String;
|
||||
function LoadJSONFromFile(const AFileName: String; out AJSON: TJSONStringType): Boolean;
|
||||
function SaveJSONToFile(const AFileName: String; const AJSON: TJSONStringType): Boolean;
|
||||
@ -194,7 +192,7 @@ begin
|
||||
Colors.BorderColor := clBlack;
|
||||
with Header.Columns.Add do begin
|
||||
Position := 0;
|
||||
Width := 250;
|
||||
Width := 300;
|
||||
Text := rsCreateRepositoryFrm_VSTPackages_Column0;
|
||||
end;
|
||||
Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoVisible, hoAutoSpring];
|
||||
@ -231,7 +229,7 @@ begin
|
||||
Colors.BorderColor := clBlack;
|
||||
with Header.Columns.Add do begin
|
||||
Position := 0;
|
||||
Width := 150;
|
||||
Width := 200;
|
||||
Text := rsCreateRepositoryFrm_VSTDetails_Column0;
|
||||
end;
|
||||
with Header.Columns.Add do begin
|
||||
@ -253,32 +251,21 @@ begin
|
||||
end;
|
||||
|
||||
procedure TCreateRepositoryFrm.bCreateClick(Sender: TObject);
|
||||
label
|
||||
ShowFormAgain;
|
||||
var
|
||||
RepositoryDetailsFrm: TRepositoryDetailsFrm;
|
||||
begin
|
||||
RepositoryDetailsFrm := TRepositoryDetailsFrm.Create(Self);
|
||||
try
|
||||
ShowFormAgain:
|
||||
RepositoryDetailsFrm.IsNew := True;
|
||||
RepositoryDetailsFrm.ShowModal;
|
||||
if RepositoryDetailsFrm.ModalResult = mrOk then
|
||||
begin
|
||||
FRepository.FName := RepositoryDetailsFrm.edName.Text;
|
||||
FRepository.FAddress := RepositoryDetailsFrm.edAddress.Text;
|
||||
FRepository.FDescription := RepositoryDetailsFrm.mDescription.Text;
|
||||
if SD.Execute then
|
||||
begin
|
||||
if SaveRepository(SD.FileName, True) then
|
||||
begin
|
||||
if RepositoryDetailsFrm.Address <> '' then
|
||||
Options.RemoteRepository.Add(RepositoryDetailsFrm.Address);
|
||||
if LoadRepository(SD.FileName) then
|
||||
PopulatePackageTree;
|
||||
end
|
||||
else
|
||||
GoTo ShowFormAgain;
|
||||
end;
|
||||
if SaveRepository(RepositoryDetailsFrm.FileName) then
|
||||
if LoadRepository(RepositoryDetailsFrm.FileName) then
|
||||
PopulatePackageTree;
|
||||
end;
|
||||
finally
|
||||
RepositoryDetailsFrm.Free;
|
||||
@ -436,52 +423,38 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCreateRepositoryFrm.AddExistingPackage;
|
||||
procedure TCreateRepositoryFrm.AddExistingPackage(const AJSONFile,
|
||||
APackageFile: String);
|
||||
var
|
||||
PackageFile: String;
|
||||
JSONFile: String;
|
||||
JSON: TJSONStringType;
|
||||
CanGo: Boolean;
|
||||
begin
|
||||
ODPack.InitialDir := Options.LastPackagedirDst;
|
||||
if ODPack.Execute then
|
||||
CanGo := False;
|
||||
if LoadJSONFromFile(AJSONFile, JSON) then
|
||||
begin
|
||||
JSONFile := ODPack.FileName;
|
||||
PackageFile := ChangeFileExt(JSONFile, '.zip');
|
||||
if not FileExists(PackageFile) then
|
||||
if not IsDuplicatePackage(JSON, APackageFile) then
|
||||
begin
|
||||
MessageDlgEx(Format(rsCreateRepositoryFrm_Info5, [ExtractFileName(PackageFile)]), mtInformation, [mbOk], Self);
|
||||
MessageDlgEx(rsCreateRepositoryFrm_Error4, mtError, [mbOk], Self);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
CanGo := False;
|
||||
if LoadJSONFromFile(JSONFile, JSON) then
|
||||
begin
|
||||
if not IsDuplicatePackage(JSON, PackageFile) then
|
||||
if FSerializablePackages.AddPackageFromJSON(JSON) then
|
||||
begin
|
||||
if FSerializablePackages.AddPackageFromJSON(JSON) then
|
||||
JSON := '';
|
||||
if FSerializablePackages.PackagesToJSON(JSON) then
|
||||
begin
|
||||
JSON := '';
|
||||
if FSerializablePackages.PackagesToJSON(JSON) then
|
||||
if SaveJSONToFile(ExtractFilePath(FRepository.FPath) + cRemoteJSONFile, JSON) then
|
||||
begin
|
||||
if SaveJSONToFile(ExtractFilePath(FRepository.FPath) + cRemoteJSONFile, JSON) then
|
||||
if LoadRepository(FRepository.FPath) then
|
||||
begin
|
||||
if LoadRepository(FRepository.FPath) then
|
||||
begin
|
||||
CanGo := True;
|
||||
PopulatePackageTree;
|
||||
end;
|
||||
CanGo := True;
|
||||
PopulatePackageTree;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if not CanGo then
|
||||
MessageDlgEx(rsCreateRepositoryFrm_Error4, mtError, [mbOk], Self)
|
||||
else
|
||||
MessageDlgEx(rsCreateRepositoryFrm_Info7, mtInformation, [mbOk], Self);
|
||||
end;
|
||||
if not CanGo then
|
||||
MessageDlgEx(rsCreateRepositoryFrm_Error4, mtError, [mbOk], Self)
|
||||
else
|
||||
MessageDlgEx(rsCreateRepositoryFrm_Info7, mtInformation, [mbOk], Self);
|
||||
end;
|
||||
|
||||
procedure TCreateRepositoryFrm.bAddClick(Sender: TObject);
|
||||
@ -494,7 +467,7 @@ begin
|
||||
if AddRepositoryPackageFrm.rbCreateNew.Checked then
|
||||
AddNewPackage
|
||||
else
|
||||
AddExistingPackage;
|
||||
AddExistingPackage(AddRepositoryPackageFrm.JSONFile, AddRepositoryPackageFrm.PackageFile);
|
||||
end;
|
||||
finally
|
||||
AddRepositoryPackageFrm.Free;
|
||||
@ -503,8 +476,8 @@ end;
|
||||
|
||||
procedure TCreateRepositoryFrm.bOpenClick(Sender: TObject);
|
||||
begin
|
||||
if OD.Execute then
|
||||
if LoadRepository(OD.FileName) then
|
||||
if ODRep.Execute then
|
||||
if LoadRepository(ODRep.FileName) then
|
||||
PopulatePackageTree;
|
||||
end;
|
||||
|
||||
@ -531,6 +504,7 @@ begin
|
||||
RepositoryDetailsFrm.edName.Text := FRepository.FName;
|
||||
RepositoryDetailsFrm.edAddress.Text := FRepository.FAddress;
|
||||
RepositoryDetailsFrm.mDescription.Text := FRepository.FDescription;
|
||||
RepositoryDetailsFrm.IsNew := False;
|
||||
RepositoryDetailsFrm.ShowModal;
|
||||
if RepositoryDetailsFrm.ModalResult = mrOk then
|
||||
begin
|
||||
@ -551,13 +525,9 @@ begin
|
||||
FRepository.FName := RepositoryDetailsFrm.edName.Text;
|
||||
FRepository.FAddress := RepositoryDetailsFrm.edAddress.Text;
|
||||
FRepository.FDescription := RepositoryDetailsFrm.mDescription.Text;
|
||||
if SaveRepository(FRepository.FPath, False) then
|
||||
begin
|
||||
if RepositoryDetailsFrm.Address <> '' then
|
||||
Options.RemoteRepository.Add(RepositoryDetailsFrm.Address);
|
||||
if SaveRepository(FRepository.FPath) then
|
||||
if LoadRepository(FRepository.FPath) then
|
||||
PopulatePackageTree;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
RepositoryDetailsFrm.Free;
|
||||
@ -655,42 +625,18 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCreateRepositoryFrm.SaveRepository(const AFileName: String;
|
||||
const AIsNew: Boolean): Boolean;
|
||||
function TCreateRepositoryFrm.SaveRepository(const AFileName: String): Boolean;
|
||||
var
|
||||
FS: TFileStream;
|
||||
FHandle: THandle;
|
||||
begin
|
||||
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);
|
||||
try
|
||||
try
|
||||
FS.WriteAnsiString(FRepository.FName);
|
||||
FS.WriteAnsiString(FRepository.FAddress);
|
||||
FS.WriteAnsiString(FRepository.FDescription);
|
||||
if AIsNew then
|
||||
begin
|
||||
FHandle := FileCreate(ExtractFilePath(AFileName) + cRemoteJSONFile);
|
||||
if fHandle <> THandle(-1) then
|
||||
begin
|
||||
Result := True;
|
||||
FileClose(FHandle);
|
||||
end;
|
||||
end
|
||||
else
|
||||
Result := True;
|
||||
Result := True;
|
||||
except
|
||||
on E: Exception do
|
||||
MessageDlgEx(Format(rsCreateRepositoryFrm_Error3, [AFileName, E.Message]), mtError, [mbOk], Self);
|
||||
@ -711,6 +657,7 @@ var
|
||||
begin
|
||||
|
||||
FVSTPackages.Clear;
|
||||
FVSTPackages.NodeDataSize := SizeOf(TData);
|
||||
|
||||
//add repository(DataType = 0)
|
||||
RootNode := FVSTPackages.AddChild(nil);
|
||||
@ -901,6 +848,7 @@ begin
|
||||
Exit;
|
||||
|
||||
FVSTDetails.Clear;
|
||||
FVSTDetails.NodeDataSize := SizeOf(TData);
|
||||
Data := FVSTPackages.GetNodeData(Node);
|
||||
case Data^.FDataType of
|
||||
0: begin
|
||||
@ -1023,6 +971,7 @@ var
|
||||
begin
|
||||
if TextType <> ttNormal then
|
||||
Exit;
|
||||
|
||||
PackageNode := FVSTPackages.GetFirstSelected;
|
||||
if PackageNode = nil then
|
||||
Exit;
|
||||
@ -1143,7 +1092,7 @@ procedure TCreateRepositoryFrm.VSTDetailsFreeNode(Sender: TBaseVirtualTree;
|
||||
var
|
||||
Data: PData;
|
||||
begin
|
||||
Data := FVSTPackages.GetNodeData(Node);
|
||||
Data := FVSTDetails.GetNodeData(Node);
|
||||
Finalize(Data^);
|
||||
end;
|
||||
|
||||
|
||||
@ -50,15 +50,15 @@ object RepositoryDetailsFrm: TRepositoryDetailsFrm
|
||||
end
|
||||
object lbName: TLabel
|
||||
Left = 19
|
||||
Height = 15
|
||||
Height = 21
|
||||
Top = 13
|
||||
Width = 89
|
||||
Width = 108
|
||||
Caption = 'Repository name'
|
||||
ParentColor = False
|
||||
end
|
||||
object edName: TEdit
|
||||
Left = 19
|
||||
Height = 23
|
||||
Height = 31
|
||||
Top = 31
|
||||
Width = 357
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
@ -68,15 +68,15 @@ object RepositoryDetailsFrm: TRepositoryDetailsFrm
|
||||
end
|
||||
object lbAddress: TLabel
|
||||
Left = 19
|
||||
Height = 15
|
||||
Height = 21
|
||||
Top = 69
|
||||
Width = 99
|
||||
Width = 125
|
||||
Caption = 'Repository address'
|
||||
ParentColor = False
|
||||
end
|
||||
object edAddress: TEdit
|
||||
Left = 18
|
||||
Height = 23
|
||||
Height = 31
|
||||
Top = 87
|
||||
Width = 358
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
@ -87,9 +87,9 @@ object RepositoryDetailsFrm: TRepositoryDetailsFrm
|
||||
end
|
||||
object lbDescription: TLabel
|
||||
Left = 19
|
||||
Height = 15
|
||||
Height = 21
|
||||
Top = 130
|
||||
Width = 118
|
||||
Width = 146
|
||||
Caption = 'Repository description'
|
||||
ParentColor = False
|
||||
end
|
||||
@ -104,10 +104,10 @@ object RepositoryDetailsFrm: TRepositoryDetailsFrm
|
||||
TabOrder = 2
|
||||
end
|
||||
object lbOF2: TLabel
|
||||
Left = 380
|
||||
Height = 15
|
||||
Left = 377
|
||||
Height = 21
|
||||
Top = 36
|
||||
Width = 5
|
||||
Width = 8
|
||||
Anchors = [akTop, akRight]
|
||||
Caption = '*'
|
||||
Font.Color = clRed
|
||||
@ -115,4 +115,11 @@ object RepositoryDetailsFrm: TRepositoryDetailsFrm
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object SDRep: TSaveDialog
|
||||
DefaultExt = '.opmrep'
|
||||
Filter = '*.opmrep|*.opmrep'
|
||||
Options = [ofOverwritePrompt, ofEnableSizing, ofViewDetail]
|
||||
left = 16
|
||||
top = 264
|
||||
end
|
||||
end
|
||||
|
||||
@ -6,7 +6,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
StdCtrls;
|
||||
StdCtrls, LazFileUtils;
|
||||
|
||||
type
|
||||
|
||||
@ -23,21 +23,26 @@ type
|
||||
lbOF2: TLabel;
|
||||
mDescription: TMemo;
|
||||
pnButtons: TPanel;
|
||||
SDRep: TSaveDialog;
|
||||
procedure bOkClick(Sender: TObject);
|
||||
procedure edAddressChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
FAddress: String;
|
||||
function IsDuplicateRepository(const AAddress: String): Boolean;
|
||||
FFileName: string;
|
||||
FIsNew: boolean;
|
||||
function IsDuplicateRepository(const AAddress: string): boolean;
|
||||
public
|
||||
property Address: String read FAddress;
|
||||
property FileName: string read FFileName;
|
||||
property IsNew: boolean read FIsNew write FIsNew;
|
||||
end;
|
||||
|
||||
var
|
||||
RepositoryDetailsFrm: TRepositoryDetailsFrm;
|
||||
|
||||
implementation
|
||||
|
||||
uses opkman_const, opkman_common, opkman_options;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TRepositoryDetailsFrm }
|
||||
@ -55,12 +60,11 @@ begin
|
||||
bOk.Hint := rsRepositoryDetailsFrm_bOk_Hint;
|
||||
bCancel.Caption := rsRepositoryDetailsFrm_bCancel_Caption;
|
||||
bCancel.Hint := rsRepositoryDetailsFrm_bCancel_Hint;
|
||||
FAddress := '';
|
||||
end;
|
||||
|
||||
function TRepositoryDetailsFrm.IsDuplicateRepository(const AAddress: String): Boolean;
|
||||
function TRepositoryDetailsFrm.IsDuplicateRepository(const AAddress: string): boolean;
|
||||
var
|
||||
I: Integer;
|
||||
I: integer;
|
||||
begin
|
||||
Result := False;
|
||||
for I := 0 to Options.RemoteRepository.Count - 1 do
|
||||
@ -74,21 +78,43 @@ begin
|
||||
end;
|
||||
|
||||
procedure TRepositoryDetailsFrm.bOkClick(Sender: TObject);
|
||||
var
|
||||
Address: String;
|
||||
begin
|
||||
if Trim(edName.Text) = '' then
|
||||
begin
|
||||
MessageDlgEx(rsRepositoryDetailsFrm_Info1, mtInformation, [mbOk], Self);
|
||||
MessageDlgEx(rsRepositoryDetailsFrm_Info1, mtInformation, [mbOK], Self);
|
||||
edName.SetFocus;
|
||||
Exit;
|
||||
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
|
||||
begin
|
||||
FAddress := Trim(edAddress.Text);
|
||||
if FAddress[Length(FAddress)] <> '/' then
|
||||
FAddress := FAddress + '/';
|
||||
if IsDuplicateRepository(FAddress) then
|
||||
FAddress := '';
|
||||
Address := Trim(edAddress.Text);
|
||||
if Address[Length(Address)] <> '/' then
|
||||
Address := Address + '/';
|
||||
if not IsDuplicateRepository(Address) then
|
||||
Options.RemoteRepository.Add(Address);
|
||||
end;
|
||||
|
||||
ModalResult := mrOk;
|
||||
end;
|
||||
|
||||
@ -98,4 +124,3 @@ begin
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user