Devart Forums

Code: Select all

ALTER TABLE dept ADD SocProprio CHAR(8) ASCII NOT NULL DEFAULT 'AD04221';
ALTER TABLE emp ADD SocProprio CHAR(8) ASCII NOT NULL DEFAULT 'AD04221';
create view view_dept as select * from dept where SocProprio = 'AD04221';
create view view_emp as select * from emp where SocProprio = 'AD04221';

Code: Select all

unit lcmyQuery;

interface

uses
	variants,	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, db,
	MyAccess, System.UITypes;

	const courSOCIETE = 'SOCIETE_';
type
  TTriRecordEvent = procedure(DataSet: TDataSet; var Orderby:String) of object;
	TlcmyQuery = class(TmyQuery)
	protected
    function GetFieldName(TableName,FieldName: string):Boolean;
	public

		procedure Refresh; overload;
    procedure MysqlTableToVue(_Societe :String);

end;

procedure Register;

implementation

Uses DBAccess, CRFunctions, AnsiStrings;

procedure TlcmyQuery.Refresh;
begin
    if not active then
      open()
    else
  	  inherited Refresh;
end;

//Traitement sur la requête, remplace les tables par les vues de la sociétée
//courante.
procedure TlcmyQuery.MysqlTableToVue(_Societe :String);

  var i,j,ipos :Integer;
      bModif:Boolean;
      sSql: TStringList;

    procedure splitString(subStr:string);
    var iss : Integer;
    begin
      iss := 0;
      while  iss < sSql.Count do
      begin
        ipos := AnsiPos(Format(' %s ',[subStr]),' '+UpperCase(Trim(sSql[iss])+' ')); // si fin de ligne
        if iPos = 1 then
          sSql[iss] := '/*VUE*/'+ sSql[iss]+' '
        else if iPos > 1 then
        begin
          sSql.Insert(iss+1,'/*VUE*/'+Copy(sSql[iss],ipos,Length(sSql[iss]))+' ');
          sSql[iss] := Copy(sSql[iss],1,ipos -1);
        end;
        inc(iss);
      end;
    end;
  begin
    bModif := False;
    if (pos('/* SET @SocProprio = ',Sql.Text) <> 0) then exit;
    if not Prepared then
      Prepare();
    sSql := TStringList.Create();
    try
      sSql.AddStrings(SQL);
      splitString('FROM');
      splitString('JOIN');
      for j := 0 to sSql.Count -1 do
      begin
        if AnsiStartsText('/*VUE*/', AnsiString(sSql[j])) then
          for i := 0 to TablesInfo.Count -1 do
            if GetFieldName(TablesInfo[i].TableName,'SocProprio') then
            begin
               bModif := True;
               sSql[j] := StringReplace(sSql[j],' '+TablesInfo[i].TableName+' ',' view_'+TablesInfo[i].TableName+' ',[rfReplaceAll, rfIgnoreCase]);
               sSql[j] := StringReplace(sSql[j],'`'+TablesInfo[i].TableName+'`','`view_'+TablesInfo[i].TableName+'`',[rfReplaceAll, rfIgnoreCase]);
           end;
      end;
      if bModif then
      begin
        ssql.insert(0,'/* SET @SocProprio = "'+ _Societe +'"; */ ');
        SQL.Text := sSql.Text;
      end;
      if not Prepared then
        Prepare();
    finally
      sSql.Free;
    end;
  end;


function TlcmyQuery.GetFieldName(TableName,FieldName: string):Boolean;
var
  MetaData: TDAMetaData;
begin
  Result := False;
  MetaData := Connection.CreateMetaData;
  try
    MetaData.MetaDataKind := 'columns';
    MetaData.Restrictions.Add('SCOPE=LOCAL');
    MetaData.Restrictions.Add('TABLE_NAME=' + TableName);
    MetaData.Open;
    while not (MetaData.Eof or result) do
    begin
     result := (AnsiStrIComp(PChar(VarToStr(MetaData.FieldByName('COLUMN_NAME').Value)),PChar(FieldName))= 0);
      MetaData.Next;
    end;
  finally
    MetaData.Free;
  end;
end;

procedure Register;
begin
	RegisterComponents('lcAccèsBD', [TlcmyQuery]);
end;

end.

Code: Select all

program Project16;

uses
  {$IFDEF DEBUG}
  MyDacVcl,
  {$ENDIF}

  Vcl.Forms,
  Unit22 in 'Unit22.pas' {Form22};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm22, Form22);
  Application.Run;
end.

Code: Select all

object Form22: TForm22
  Left = 0
  Top = 0
  Caption = 'Form22'
  ClientHeight = 590
  ClientWidth = 901
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 48
    Top = 32
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 632
    Top = 24
    Width = 75
    Height = 25
    Caption = 'Button2'
    TabOrder = 1
    OnClick = Button2Click
  end
  object DBGrid1: TDBGrid
    Left = 0
    Top = 400
    Width = 901
    Height = 190
    Align = alBottom
    DataSource = MyDataSource2
    TabOrder = 2
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'Tahoma'
    TitleFont.Style = []
  end
  object MyConnection1: TMyConnection
    Database = 'alphaprodb'
    Port = 3308
    Options.AllowImplicitConnect = False
    Options.NumericType = ntFmtBCD
    Username = 'AD04221'
    Connected = True
    LoginPrompt = False
    Left = 232
    Top = 64
    EncryptedPassword = '8DFF90FF8CFF9EFF93FF96FF9AFF'
  end
  object MyDataSource2: TMyDataSource
    DataSet = RqDetail
    Left = 480
    Top = 56
  end
  object DsBase: TMyDataSource
    DataSet = rqMaster
    Left = 144
    Top = 52
  end
  object rqMaster: TlcmyQuery
    Tag = 1
    Connection = MyConnection1
    SQL.Strings = (
      'select * from dept D where DeptNo = :dpt')
    BeforeOpen = rqMasterBeforeOpen
    Left = 147
    Top = 4
    ParamData = <
      item
        DataType = ftUnknown
        Name = 'dpt'
        Value = nil
      end>
    object rqMasterDEPTNO: TIntegerField
      FieldName = 'DEPTNO'
    end
    object rqMasterDNAME: TStringField
      FieldName = 'DNAME'
      Size = 14
    end
    object rqMasterLOC: TStringField
      FieldName = 'LOC'
      Size = 13
    end
  end
  object RqDetail: TlcmyQuery
    Tag = 106
    Connection = MyConnection1
    SQL.Strings = (
      'Select * from emp')
    BeforeOpen = rqMasterBeforeOpen
    MasterSource = DsBase
    MasterFields = 'DEPTNO'
    DetailFields = 'DEPTNO'
    Left = 232
    Top = 7
    ParamData = <
      item
        DataType = ftUnknown
        Name = 'DEPTNO'
        Value = nil
      end>
  end
end

Code: Select all

unit Unit22;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, strutils,dbaccess,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Buttons,
  Vcl.DBCtrls, Vcl.Grids, Vcl.DBGrids, Data.DB, MyAccess, MemDS, Vcl.StdCtrls, lcmyquery;

type
  TForm22 = class(TForm)
    MyConnection1: TMyConnection;
    MyDataSource2: TmyDataSource;
    Button1: TButton;
    DsBase: TmyDataSource;
    rqMaster: TlcmyQuery;
    RqDetail: TlcmyQuery;
    Button2: TButton;
    DBGrid1: TDBGrid;
    rqMasterDEPTNO: TIntegerField;
    rqMasterDNAME: TStringField;
    rqMasterLOC: TStringField;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure rqMasterBeforeOpen(DataSet: TDataSet);
  private

  public
    { Déclarations publiques }
  end;

var
  Form22: TForm22;

implementation

{$R *.dfm}

procedure TForm22.Button1Click(Sender: TObject);
begin
MyConnection1.Open;
RqMaster.Open();
RqDetail.Open();
RqMaster.Params[0].AsLargeInt := 20;
rqMaster.Refresh();
end;

procedure TForm22.Button2Click(Sender: TObject);
begin
//  RqDossier.DisableControls;
//  try
//    RqDossier.Connection.StartTransaction;
//    try
//      RqDossier.Refresh;
//      RqDossier.First();
//      while not RqDossier.eof do begin
//          RqDossier.Edit;
//          RqDossierbActif.AsBoolean := True;
//          RqDossier.Post;
//        RqDossier.Next;
//      end;
//      RqDossier.Connection.Commit;
//    except
//      RqDossier.Connection.Rollback;
//      raise;
//    end;
//
//  finally
//		rqdossier.EnableControls
//  end;

end;


procedure TForm22.rqMasterBeforeOpen(DataSet: TDataSet);
begin
  TlcMyQuery(dataset).MysqlTableToVue('AD04221');
end;

end.

Code: Select all

procedure TForm22.rqMasterBeforeOpen(DataSet: TDataSet);
begin
  TlcMyQuery(dataset).MysqlTableToVue('AD04221');
end;

Code: Select all

function TlcQuery.GetFinalSQL: string;
var Where, MasterName, DetailName: string;
    MasterPos,DetailPos: integer;
begin
  assert(MyDacversion <= '8.2.5', 'Verifier Bug Master-detail V8.2.5');
  if MyDacversion =  '8.2.5' then Begin
    if IsConnectedToMaster and not FOptions.LocalMasterDetail then begin
      MasterPos := 1;
      DetailPos := 1;
      Where := '';
      while True do begin
        MasterName := ExtractFieldName(FMasterFields, MasterPos);
        DetailName := ExtractFieldName(FDetailFields, DetailPos);
        if (MasterName <> '') and (DetailName <> '') then
          if IsMasterDatasetActive and MasterSource.DataSet.FieldByName(MasterName).IsNull then begin
            MasterSource.DataSet.Close;
            break;
          end
        else
          break;
      end;
    end;
  End;
  result := inherited;
end;