paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 04:37:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix SQLDBReschSchema component editor

Browse Source 
git-svn-id: trunk@60616 -
This commit is contained in:
michael 2019-03-07 13:44:11 +00:00
parent 56dc7877d1
commit 25b20abb61
9 changed files with 350 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -1748,6 +1748,8 @@ components/fpweb/frmsqldbrestdispatchini.lfm svneol=native#text/plain
components/fpweb/frmsqldbrestdispatchini.pp svneol=native#text/plain
components/fpweb/frmsqldbrestselectconn.lfm svneol=native#text/plain
components/fpweb/frmsqldbrestselectconn.pp svneol=native#text/plain
components/fpweb/frmsqldbrestselecttables.lfm svneol=native#text/plain
components/fpweb/frmsqldbrestselecttables.pp svneol=native#text/plain
components/fpweb/images/HTMLForm.png -text svneol=unset#image/png
components/fpweb/images/HTMLList.png -text svneol=unset#image/png
components/fpweb/images/button.png -text svneol=unset#image/png

29
components/fpweb/frmsqldbrestselectconn.lfm
View File

@ -1,17 +1,17 @@
object SelectRestConnectionForm: TSelectRestConnectionForm
Left = 528
Height = 262
Height = 285
Top = 379
Width = 615
Width = 612
Caption = 'Select connection'
ClientHeight = 262
ClientWidth = 615
ClientHeight = 285
ClientWidth = 612
LCLVersion = '2.1.0.0'
object BPSelect: TButtonPanel
Left = 6
Height = 42
Top = 214
Width = 603
Top = 237
Width = 600
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
HelpButton.Name = 'HelpButton'
@ -23,7 +23,7 @@ object SelectRestConnectionForm: TSelectRestConnectionForm
TabOrder = 0
ShowButtons = [pbOK, pbCancel]
end
object RGConnnection: TRadioGroup
object RGConnection: TRadioGroup
Left = 16
Height = 191
Top = 8
@ -42,7 +42,7 @@ object SelectRestConnectionForm: TSelectRestConnectionForm
end
object CGFieldOPtions: TCheckGroup
Left = 336
Height = 191
Height = 214
Top = 8
Width = 257
Anchors = [akTop, akLeft, akBottom]
@ -56,7 +56,7 @@ object SelectRestConnectionForm: TSelectRestConnectionForm
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 173
ClientHeight = 196
ClientWidth = 255
Items.Strings = (
'Allow Filter'
@ -71,4 +71,15 @@ object SelectRestConnectionForm: TSelectRestConnectionForm
06000000020202020202
}
end
object CBAllTables: TCheckBox
Left = 16
Height = 22
Top = 207
Width = 117
Anchors = [akLeft, akBottom]
Caption = 'Expose all tables'
Checked = True
State = cbChecked
TabOrder = 3
end
end

60
components/fpweb/frmsqldbrestselectconn.pp
View File

@ -5,7 +5,8 @@ unit frmsqldbrestselectconn;
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ButtonPanel, ExtCtrls, sqldbrestschema, sqldbrestbridge;
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ButtonPanel, ExtCtrls,
StdCtrls, sqldbrestschema, sqldbrestbridge;
type
@ -14,19 +15,23 @@ type
TSelectRestConnectionForm = class(TForm)
BPSelect: TButtonPanel;
CGFieldOPtions: TCheckGroup;
RGConnnection: TRadioGroup;
CBAllTables: TCheckBox;
RGConnection: TRadioGroup;
private
FShowOptions: Boolean;
procedure SetShowOptions(AValue: Boolean);
public
Procedure Init(aList : TSQLDBRestConnectionList);
Procedure Init(aList : TSQLDBRestConnectionList); overload;
Procedure Init(aList : TStrings); overload;
Property ShowOptions : Boolean Read FShowOptions Write SetShowOptions;
Function SelectedConnection : TSQLDBRestConnection;
Function SelectedOptions : TRestFieldOptions;
Function AllTables : Boolean;
end;
Function SelectRestConnection(aList : TSQLDBRestConnectionList) : TSQLDBRestConnection;
Function SelectRestConnection(aList : TSQLDBRestConnectionList; out aOptions: TRestFieldOptions) : TSQLDBRestConnection;
Function SelectRestConnection(aList : TStrings; out aOptions: TRestFieldOptions; Out aAllTables : Boolean) : TSQLDBRestConnection;
Function SelectRestConnection(aList : TSQLDBRestConnectionList; out aOptions: TRestFieldOptions; Out aAllTables : Boolean) : TSQLDBRestConnection;
var
SelectRestConnectionForm: TSelectRestConnectionForm;
@ -35,7 +40,25 @@ implementation
{$R *.lfm}
Function DoSelectRestConnection(aList : TSQLDBRestConnectionList; withOpts : Boolean; out aOptions: TRestFieldOptions) : TSQLDBRestConnection;
Function SelectRestConnection(aList : TStrings; out aOptions: TRestFieldOptions; Out aAllTables : Boolean) : TSQLDBRestConnection;
begin
Result:=Nil;
if Alist.Count<>0 then
With TSelectRestConnectionForm.Create(Application) do
try
Init(aList);
ShowOptions:=True;
if ShowModal=mrOK then
begin
Result:=SelectedConnection;
aOptions:=SelectedOptions;
aAllTables:=AllTables;
end;
finally
Free;
end;
end;
Function DoSelectRestConnection(aList : TSQLDBRestConnectionList; withOpts : Boolean; out aOptions: TRestFieldOptions; Out aAllTables : Boolean) : TSQLDBRestConnection;
begin
Result:=Nil;
@ -49,25 +72,27 @@ begin
Result:=SelectedConnection;
if WithOpts then
aOptions:=SelectedOptions;
aAllTables:=AllTables;
end;
finally
Free;
end;
end;
Function SelectRestConnection(aList : TSQLDBRestConnectionList; out aOptions: TRestFieldOptions) : TSQLDBRestConnection;
Function SelectRestConnection(aList : TSQLDBRestConnectionList; out aOptions: TRestFieldOptions; Out aAllTables : Boolean) : TSQLDBRestConnection;
begin
Result:=DoSelectRestConnection(alIst,True,aOptions);
Result:=DoSelectRestConnection(alIst,True,aOptions,aAllTables);
end;
Function SelectRestConnection(aList : TSQLDBRestConnectionList) : TSQLDBRestConnection;
Var
aOptions: TRestFieldOptions;
B : Boolean;
begin
Result:=DoSelectRestConnection(alIst,False,aOptions);
Result:=DoSelectRestConnection(alIst,False,aOptions,B);
end;
@ -77,6 +102,11 @@ procedure TSelectRestConnectionForm.SetShowOptions(AValue: Boolean);
begin
if FShowOptions=AValue then Exit;
FShowOptions:=AValue;
if Not FShowOptions then
begin
CGFieldOptions.Visible:=False;
RGConnection.Width:=CGFieldOptions.Left+CGFieldOptions.Width;
end;
end;
procedure TSelectRestConnectionForm.Init(aList: TSQLDBRestConnectionList);
@ -86,12 +116,17 @@ Var
begin
For I:=0 to aList.Count-1 do
RGConnnection.Items.AddObject(aList[I].Name,aList[i]);
RGConnection.Items.AddObject(aList[I].Name,aList[i]);
end;
procedure TSelectRestConnectionForm.Init(aList: TStrings);
begin
RGConnection.Items.Assign(aList);
end;
function TSelectRestConnectionForm.SelectedConnection: TSQLDBRestConnection;
begin
With RGConnnection do
With RGConnection do
if ItemIndex=-1 then
Result:=Nil
else
@ -116,5 +151,10 @@ begin
Add(5,foRequired);
end;
function TSelectRestConnectionForm.AllTables: Boolean;
begin
Result:=CBAllTables.Checked;
end;
end.

45
components/fpweb/frmsqldbrestselecttables.lfm Normal file
View File

@ -0,0 +1,45 @@
object SQLDBRestSelectTablesForm: TSQLDBRestSelectTablesForm
Left = 507
Height = 240
Top = 314
Width = 320
Caption = 'Select tables to expose'
ClientHeight = 240
ClientWidth = 320
LCLVersion = '2.1.0.0'
object CBSelectAllNone: TCheckBox
Left = 8
Height = 22
Top = 8
Width = 108
Caption = 'Select all/None'
OnChange = CBSelectAllNoneChange
TabOrder = 0
end
object BPSelectTables: TButtonPanel
Left = 6
Height = 42
Top = 192
Width = 308
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
HelpButton.Name = 'HelpButton'
HelpButton.DefaultCaption = True
CloseButton.Name = 'CloseButton'
CloseButton.DefaultCaption = True
CancelButton.Name = 'CancelButton'
CancelButton.DefaultCaption = True
TabOrder = 1
ShowButtons = [pbOK, pbCancel]
end
object CLBTables: TCheckListBox
Left = 8
Height = 152
Top = 32
Width = 304
Anchors = [akTop, akLeft, akRight, akBottom]
ItemHeight = 0
TabOrder = 2
TopIndex = -1
end
end

85
components/fpweb/frmsqldbrestselecttables.pp Normal file
View File

@ -0,0 +1,85 @@
unit frmsqldbrestselecttables;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
ButtonPanel, CheckLst;
type
{ TSQLDBRestSelectTablesForm }
TSQLDBRestSelectTablesForm = class(TForm)
BPSelectTables: TButtonPanel;
CBSelectAllNone: TCheckBox;
CLBTables: TCheckListBox;
procedure CBSelectAllNoneChange(Sender: TObject);
private
procedure DoSelectAllNone(aSelect: Boolean);
function GetTables: Tstrings;
procedure SetTables(AValue: Tstrings);
public
Function GetSelectedTables(aList : Tstrings) : Integer;
Property Tables : Tstrings Read GetTables Write SetTables;
end;
var
SQLDBRestSelectTablesForm: TSQLDBRestSelectTablesForm;
implementation
{$R *.lfm}
{ TSQLDBRestSelectTablesForm }
procedure TSQLDBRestSelectTablesForm.CBSelectAllNoneChange(Sender: TObject);
begin
DoSelectAllNone(CBSelectAllNone.Checked);
end;
function TSQLDBRestSelectTablesForm.GetTables: Tstrings;
begin
Result:=CLBTables.Items;
end;
procedure TSQLDBRestSelectTablesForm.DoSelectAllNone(aSelect : Boolean);
Var
I : Integer;
begin
With CLBTables do
for I:=0 to Items.Count-1 do
Checked[i]:=aSelect;
end;
procedure TSQLDBRestSelectTablesForm.SetTables(AValue: Tstrings);
begin
CLBTables.Items.Assign(aValue);
CBSelectAllNone.Checked:=True;
DoSelectAllNone(True);
end;
function TSQLDBRestSelectTablesForm.GetSelectedTables(aList: Tstrings): Integer;
Var
I : Integer;
begin
aList.Clear;
Result:=0;
With CLBTables do
for I:=0 to Items.Count-1 do
if Checked[i] then
begin
aList.Add(Items[i]);
Inc(Result);
end;
end;
end.

6
components/fpweb/lazsqldbrest.lpk
View File

@ -10,7 +10,7 @@
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Files Count="4">
<Files Count="5">
<Item1>
<Filename Value="reglazsqldbrest.pp"/>
<HasRegisterProc Value="True"/>
@ -28,6 +28,10 @@
<Filename Value="reslazsqldbrest.pp"/>
<UnitName Value="reslazsqldbrest"/>
</Item4>
<Item5>
<Filename Value="frmsqldbrestselecttables.pp"/>
<UnitName Value="frmsqldbrestselecttables"/>
</Item5>
</Files>
<RequiredPkgs Count="5">
<Item1>

2
components/fpweb/lazsqldbrest.pas
View File

@ -9,7 +9,7 @@ interface
uses
reglazsqldbrest, frmsqldbrestdispatchini, frmsqldbrestselectconn,
reslazsqldbrest, LazarusPackageIntf;
reslazsqldbrest, frmsqldbrestselecttables, LazarusPackageIntf;
implementation

144
components/fpweb/reglazsqldbrest.pp
View File

@ -5,8 +5,7 @@ unit reglazsqldbrest;
interface
uses
Classes, SysUtils, PropEdits, ComponentEditors, ProjectIntf,
sqldbrestschema,
Classes, SysUtils, PropEdits, ComponentEditors, ProjectIntf, sqldb, sqldbrestschema,
sqldbrestcsv ,sqldbrestxml, sqldbrestcds, sqldbrestado,
sqldbrestio, sqldbrestauth, sqldbrestbridge, sqldbrestmodule;
@ -74,6 +73,10 @@ Type
{ TSQLDBRestSchemaComponentEditor }
TSQLDBRestSchemaComponentEditor = class(TComponentEditor)
private
procedure DoLoadSchemaFromConnection(S: TSQLDBRestSchema);
procedure FillSchema(S: TSQLDBRestSchema; Conn: TSQLDBRestConnection; Opts: TRestFieldOptions; AllTables: Boolean);
function GetTableList(aConn: TSQLConnection; aList: TStrings): Boolean;
public
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
@ -111,12 +114,13 @@ implementation
uses
// Lazarus
LResources, codecache, Forms, Dialogs, SrcEditorIntf, lazideintf, FormEditingIntf, codetoolmanager,
LResources, codecache, Controls, Forms, Dialogs, SrcEditorIntf, lazideintf, FormEditingIntf, codetoolmanager,
// FPC
sqldb, sqldbrestini,
sqldbrestini,
// This package
frmsqldbrestselectconn,
frmsqldbrestdispatchini,
frmsqldbrestselecttables,
reslazsqldbrest;
Var
@ -295,9 +299,10 @@ Var
C : TSQLDBRestConnection;
aSchema : TSQLDBRestSchema;
aOptions : TRestFieldOptions;
allTables : Boolean;
begin
C:=SelectRestConnection(D.Connections,aOptions);
C:=SelectRestConnection(D.Connections,aOptions,allTables);
if C=Nil then
exit;
aSchema:=D.ExposeConnection(Designer.LookupRoot,C,Nil,aOptions);
@ -315,7 +320,11 @@ begin
D:=Component as TSQLDBRestDispatcher;
Case Index of
0 :
begin
ExposeConnection(D);
Designer.Modified;
end;
1,2 :
begin
FN:=Component.Name+'.ini';
@ -324,7 +333,10 @@ begin
if Index=0 then
D.SaveToFile(FN,OI)
else
begin
D.LoadFromFile(FN,OI);
Designer.Modified;
end;
end;
end;
end;
@ -343,6 +355,111 @@ begin
Result:=3;
end;
Function TSQLDBRestSchemaComponentEditor.GetTableList(aConn : TSQLConnection; aList : TStrings) : Boolean;
Var
L : TStringList;
F : TSQLDBRestSelectTablesForm;
begin
Result:=False;
F:=Nil;
L:=TStringList.Create;
try
L.Sorted:=true;
aConn.GetTableNames(L,False);
if L.Count>0 then
begin
F:=TSQLDBRestSelectTablesForm.Create(Application);
F.Tables:=L;
Result:=F.ShowModal=mrOK;
if Result then
F.GetSelectedTables(aList);
end;
finally
L.Free;
F.Free;
end;
end;
procedure TSQLDBRestSchemaComponentEditor.FillSchema(S : TSQLDBRestSchema; Conn : TSQLDBRestConnection; Opts : TRestFieldOptions; AllTables : Boolean);
Var
SQLC : TSQLConnection;
T : TSQLTransaction;
sTables : TStrings;
aCount : Integer;
begin
T:=Nil;
sTables:=nil;
SQLC:=Conn.SingleConnection;
if SQLC=Nil then
SQLC:=TSQLConnector.Create(Nil);
try
if (SQLC.Transaction=Nil) then
begin
T:=TSQLTransaction.Create(SQLC);
SQLC.Transaction:=T;
Conn.ConfigConnection(SQLC);
end;
SQLC.Connected:=true;
if not AllTables then
begin
sTables:=TStringList.Create;
if not GetTableList(SQLC,sTables) then
exit;
end;
aCount:=S.Resources.Count;
S.PopulateResources(SQLC,sTables,Opts);
ShowMessage(Format(SAddedNTables,[S.Resources.Count-aCount]));
finally
T.Free;
if SQLC<>Conn.SingleConnection then
SQLC.Free;
end;
end;
procedure TSQLDBRestSchemaComponentEditor.DoLoadSchemaFromConnection(S : TSQLDBRestSchema);
Var
L : TStringList;
O : TComponent;
D : TSQLDBRestDispatcher;
I,J : Integer;
Opts : TRestFieldOptions;
Conn : TSQLDBRestConnection;
AllTables : Boolean;
begin
L:=TStringList.Create;
try
O:=S.Owner;
While O<>Nil do
begin
for I:=0 to O.ComponentCount-1 do
if O.Components[i] is TSQLDBRestDispatcher then
begin
D:=O.Components[i] as TSQLDBRestDispatcher;
For J:=0 To D.Connections.Count-1 do
L.AddObject(D.Name+'.'+D.Connections[J].Name,D.Connections[J]);
end;
O:=O.Owner;
end;
if L.Count=0 then
ShowMessage(SErrNoConnectionsFound)
else
begin
Conn:=SelectRestConnection(L,Opts,allTables);
if Conn<>Nil then
FillSchema(S,Conn,Opts,AllTables);
end;
finally
L.Free;
end;
end;
procedure TSQLDBRestSchemaComponentEditor.ExecuteVerb(Index: Integer);
Var
@ -359,7 +476,20 @@ begin
if Index=0 then
S.SaveToFile(FN)
else
begin
S.LoadFromFile(FN);
Designer.Modified;
end;
end;
2 :
begin
DoLoadSchemaFromConnection(S);
Designer.Modified;
end;
3 :
begin
S.Resources.Clear;
Designer.Modified;
end;
end;
end;
@ -369,12 +499,14 @@ begin
Case Index of
0 : Result:=SSaveSchemaToJSONFile;
1 : Result:=SLoadSchemaFromJSONFile;
2 : Result:=SLoadSchemaFromConnection;
3 : Result:=SClearSchema;
end;
end;
function TSQLDBRestSchemaComponentEditor.GetVerbCount: Integer;
begin
Result:=2;
Result:=4;
end;
function TSQLDBConnectionTypePropertyEditor.GetAttributes: TPropertyAttributes;

5
components/fpweb/reslazsqldbrest.pp
View File

@ -16,7 +16,10 @@ Resourcestring
SJSONFilesFilter = 'JSON Files|*.json|All files|%s';
SSaveSchemaToJSONFile = 'Save schema to JSON file';
SLoadSchemaFromJSONFile = 'Load schema from JSON file';
SLoadSchemaFromConnection = 'Load schema from connection';
SErrNoConnectionsFound = 'No connections found on form/frame or datamodule';
SAddedNTables = 'Added %d tables as resources';
SClearSchema = 'Clear schema';
implementation