lazarus/components/sqldbrest/design/sqldbschemaedittools.pp

unit sqldbschemaedittools;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, sqldbrestschema, sqldbrestbridge, sqldb, controls, forms;

Const
   // Index in imagelist.
  idxConnection        = 0;
  idxConnectionAdd     = 1;
  idxConnectionDelete  = 2;
  idxConnectionEdit    = 3;
  idxConnectionExpose  = 4;
  idxConnectionRefresh = 5;
  idxTable             = 6;
  idxTableAdd          = 7;
  idxTableDelete       = 8;
  idxTableEdit         = 9;
  idxField             = 10;
  idxFields            = 11;
  idxFieldAdd          = 12;
  idxFieldDelete       = 13;
  idxFieldEdit         = 14;
  idxKeyField          = 15;
  idxConnectionsHide   = 16;
  idxConnectionsShow   = 17;
  idxTableInfo         = 18;


Type
  TOnGetSQLConnection = Procedure (Sender : TObject; aConnName : String; Out aConn : TSQLConnection) of object;

  { TBaseEditFrame }

  TBaseEditFrame = Class(TFrame)
  private
    FConnections: TSQLDBRestConnectionList;
    FFrameData: TObject;
    FMinFieldOptions: TRestFieldOptions;
    Procedure DoSetFrameData(aData : TObject);
  Protected
    Procedure SetFrameData(aData : TObject); virtual; abstract;
    Function CanGetSQLConnection : Boolean;
    Function GetSQLConnection(Const aName : String) : TSQLConnection;
    Function ExecuteSelect(const aConnection : String; aSQL : String) : TSQLQuery;
    procedure SetConnections(AValue: TSQLDBRestConnectionList); virtual;
  Public
    Function Modified : Boolean; virtual; abstract;
    Procedure SaveData; virtual; abstract;
    Function FrameCaption : String; virtual; abstract;
    // Must be set !
    Property FrameData : TObject Read FFrameData Write DoSetFrameData;
    Property Connections : TSQLDBRestConnectionList Read FConnections Write SetConnections;
    Property MinFieldOptions : TRestFieldOptions Read FMinFieldOptions Write FMinFieldOptions;
  end;

  { TStringsDragObject }

  TStringsDragObject = Class(TDragObjectEx)
  private
    FItems: Tstrings; // to keep the items in.
    procedure SetItems(const AValue: Tstrings);
  Public
    Constructor Create(AControl : TControl); override;
    Destructor Destroy; override;
    // Objects contain TMySQLDBRestConnection instance
    Property Items : TStrings Read FItems Write SetItems;
  end;

  TMySQLDBRestResource = class(TSQLDBRestResource)
  end;

  { TMySQLDBRestSchema }

  TMySQLDBRestSchema = Class(TSQLDBRestSchema)
  Protected
    Function CreateResourceList: TSQLDBRestResourceList; override;
  end;
  { TMySQLDBRestConnection }

  TMySQLDBRestConnection = Class(TSQLDBRestConnection)
  private
    FMyConnection: TSQLConnection;
    FMyTransaction : TSQLTransaction;
    function getMyConnection: TSQLConnection;
  Public
    Destructor Destroy; override;
    Procedure CreateConnection;
    Property MyConnection : TSQLConnection read getMyConnection Write FMyConnection;
  end;

{$r *.lfm}

Resourcestring
  SSchema = 'Schema';
  SFields = 'Fields';
  SField = 'Field';
  SResource = 'Resource';
  SEdit = 'Edit';
  SPropTableName  = 'Table name: %s';
  SPropConnection = 'Connection: %s';
  SErrNoConnection = 'Cannot execute SQL: no connection available';
  SSQLValidatesOK = 'SQL Statement validates OK!';
  SNameForResource =  'Give a name for the new resource';
  SNewResource = 'New resource';
  SNameForField =  'Give a name for the new field for resource %s';
  SNewField = 'New field';
  SErrDuplicateResource = 'Duplicate resource name: %s';
  SErrDuplicateField = 'Duplicate field name: %s';
  SDeleteResourceCaption = 'Delete resource';
  SDeleteResourceMsg = 'Delete resource %s ?%sThis action cannot be undone';
  SDeleteFieldCaption = 'Delete Field';
  SDeleteFieldMsg = 'Delete field %s from resource %s ?%sThis action cannot be undone';
  SYesDelete = 'Yes, delete';
  SNoDoNotDelete = 'No, do not delete';
  SUnknownObject = 'Unknown';
  SEditObject = '%s %s';
  SSelectResource = 'Select a resource';
  SResetFields = 'Reset fields';
  SResetFieldsPrompt = 'There are already fields defined for this resource. %sThis action will remove the existing fields. %sAre '
    +'you sure you want to reset the field list ?';
  SYesResetFields = 'Reset fields';
  SDoNotResetFields = 'Do not reset fields';
  STableNameChanged = 'The table name changed, and a default SQL statement is used.%sDo you want to regenerate the field list '
    +'based on the current table name ?';
  SEditObjectFields = 'Fields of resource %s';
  SErrConnectingTo = 'Error connecting to connection %s : %s';
  SErrShowingTablesConnectingTo = 'Error connecting to connection %s trying to show the table list: %s';

implementation

{ TBaseEditFrame }

procedure TBaseEditFrame.SetConnections(AValue: TSQLDBRestConnectionList);
begin
  if FConnections=AValue then Exit;
  FConnections:=AValue;
end;

procedure TBaseEditFrame.DoSetFrameData(aData: TObject);
begin
  FFrameData:=aData;
  SetFrameData(FFrameData);
end;

function TBaseEditFrame.CanGetSQLConnection: Boolean;
begin
  Result:=Assigned(FConnections)
end;

function TBaseEditFrame.GetSQLConnection(const aName: String): TSQLConnection;

Var
  C : TSQLDBRestConnection;

begin
  Result:=nil;
  if Not CanGetSQLConnection then
    exit;
  if (aName<>'') then
    C:=Connections.FindConnection(aName)
  else if (Connections.Count=1) then
    C:=Connections[0];
  if C<>Nil then
    begin
    Result:=C.SingleConnection;
    if Result=Nil then
      begin
      Result:=TSQLConnector.Create(Self.Owner);
      Result.Transaction:=TSQLTransaction.Create(Self.Owner);
      Result.Transaction.DataBase:=Result;
      C.ConfigConnection(Result);
      C.SingleConnection:=Result;
      end;
    end;
end;

function TBaseEditFrame.ExecuteSelect(const aConnection: String; aSQL: String): TSQLQuery;

Var
  C : TSQLConnection;

begin
  C:=GetSQLConnection(aConnection);
  if C=Nil then
    Raise ESQLDatabaseError.Create(SErrNoConnection);
  Result:=TSQLQuery.Create(Self);
  try
    Result.SQLConnection:=C;
    if Result.Transaction=Nil then
      begin
      Result.Transaction:=TSQLTransaction.Create(C);
      Result.Transaction.DataBase:=C;
      end;
    Result.SQL.Text:=aSQL;
    Result.PacketRecords:=1;
    Result.ParseSQL:=True;
    Result.UniDirectional:=True;
    Result.Open;
  except
    Result.Free;
    Raise;
  end;
end;

{ TStringsDragObject }

procedure TStringsDragObject.SetItems(const AValue: Tstrings);
begin
  if FItems=AValue then exit;
  FItems.Assign(AValue);
end;

constructor TStringsDragObject.Create(AControl: TControl);
begin
  inherited Create(AControl);
  FItems:=TStringList.Create;
end;

destructor TStringsDragObject.Destroy;
begin
  FreeAndNil(FItems);
  inherited Destroy;
end;

{ TMySQLDBRestSchema }

function TMySQLDBRestSchema.CreateResourceList: TSQLDBRestResourceList;
begin
  Result:=TSQLDBRestResourceList.Create(Self,TMySQLDBRestResource);
end;

{ TMySQLDBRestConnection }

function TMySQLDBRestConnection.getMyConnection: TSQLConnection;

begin
  Result:=FMyConnection;
  if (FMyConnection=Nil) then
    Result:=SingleConnection;
end;

destructor TMySQLDBRestConnection.Destroy;
begin
  FreeAndNil(FMyTransaction);
  FreeAndNil(FMyConnection);
  inherited Destroy;
end;

procedure TMySQLDBRestConnection.CreateConnection;


begin
  FreeAndNil(FMyConnection);
  FMyConnection:=TSQLConnector.Create(Nil);
  FMyTransaction:=TSQLTransaction.Create(nil);
  FMyConnection.Transaction:=FMyTransaction;
  ConfigConnection(FMyConnection);
end;


end.