Componentes.Terceros.RemObjects/official/5.0.23.613/Data Abstract for Delphi/Source/uDAADODataTable.pas

unit uDAADODataTable;

{----------------------------------------------------------------------------}
{ Data Abstract Library - Core Library                                       }
{                                                                            }
{ compiler: Delphi 6 and up                                                  }
{ platform: Win32                                                            }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the Data Abstract              }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I DataAbstract.inc}

interface

uses Classes, DB, uDAInterfaces, uDADataTable, ADODB;

type
  { TDAADODataset }
  TDAADODataset = class(TADODataset, IDADataTableDataset)
  protected
    function GetDataTable: TDADataTable; safecall;
    procedure InternalRefresh; override;
    procedure InternalInitFieldDefs; override;
  end;

  { TDAADODataTable }
  TDAADODataTable = class(TDADataTable)
  private
    fADODataset: TDAADODataset;
  protected
    function GetDatasetClass: TDatasetClass; override;
    procedure CreateInternalFields(aDataset: TDataset; someFieldDefinitions: TDAFieldCollection); override;
    procedure DoAfterCloseDataset; override;
    procedure DoSort(const FieldNames: array of string; const Directions: array of TDASortDirection); override;

    procedure SetMasterSource(const Value: TDADataSource); override;
    function GetMasterSource: TDADataSource; override;
    procedure SetDetailsFields(const Value: string); override;
    procedure SetMasterFields(const Value: string); override;
    function GetDetailFields: string; override;
    function GetMasterFields: string; override;

    function GetFilter: string; override;
    function GetFiltered: boolean; override;
    procedure SetFilter(const Value: string); override;
    procedure SetFiltered(const Value: boolean); override;
  public
    constructor Create(aOwner: TComponent); override;
    procedure EnableConstraints; override; safecall;
    procedure DisableConstraints; override; safecall; 
  end;

implementation

uses
  ADOInt, Variants, SysUtils;

{ TDAADODataTable }

constructor TDAADODataTable.Create(aOwner: TComponent);
begin
  inherited;

  fADODataset := TDAADODataset(Dataset);
end;

procedure TDAADODataTable.CreateInternalFields(aDataset: TDataset;
  someFieldDefinitions: TDAFieldCollection);
var
  i, n: Integer;
  lDataType: DataTypeEnum;
  TmpRecordset: _Recordset;

begin
  inherited;

  { this loop should be obsolete now with fix to #1674. Keeping for backward compatibilty. mh. }
  with fADODataset do begin
    for i := 0 to Fields.Count - 1 do begin
      if (Fields[i].FieldKind = fkInternalCalc) then begin
        Fields[i].FieldKind := fkCalculated;
        with Fields[i] do begin
          FieldDefs.Add(FieldName, DataType, Size, Required);
        end;
      end;
    end;
  end;

  fADODataset.CursorLocation := clUseClient;
  fADODataset.CursorType := ctDynamic;
  fADODataset.CreateDataSet;

  if (fADODataset.FieldCount > 0) then begin
    TmpRecordset := CoRecordset.Create;
    for n := 0 to fADODataset.RecordSet.Fields.Count - 1 do begin
      with fADODataset.RecordSet.Fields.Item[n] do begin
        lDataType := Type_;
        if (lDataType = adVarChar)
          then lDataType := adVarWChar;
        TmpRecordSet.Fields.Append(Name, lDataType, DefinedSize, Attributes);
      end;
    end;
    TmpRecordset.Open(EmptyParam, EmptyParam, adOpenUnspecified, adLockUnspecified, 0);
    fADODataset.Recordset := TmpRecordset;
    fADODataset.Open;
  end;
end;

function TDAADODataTable.GetDatasetClass: TDatasetClass;
begin
  result := TDAADODataset;
end;

procedure TDAADODataTable.DoSort(const FieldNames: array of string; const Directions: array of TDASortDirection);
const
  DirectionStr: array[TDASortDirection] of string = ('ASC', 'DESC');
var
  i: integer;
  sortexp: string;
begin
  with fADODataSet do begin

    if (Length(FieldNames) = 0) then
      Sort := ''

    else begin
      sortexp := '';
      for i := 0 to Length(FieldNames) - 1 do
        sortexp := sortexp + FieldNames[i] + ' ' + DirectionStr[Directions[i]] + ', ';

      Sort := Copy(sortexp, 1, Length(sortexp) - 2);
    end;
  end;
end;

function TDAADODataTable.GetDetailFields: string;
begin
  result := fADODataset.IndexFieldNames
end;

function TDAADODataTable.GetMasterFields: string;
begin
  result := fADODataset.MasterFields
end;

function TDAADODataTable.GetMasterSource: TDADataSource;
begin
  result := TDADataSource(fADODataset.DataSource)
end;

procedure TDAADODataTable.SetDetailsFields(const Value: string);
begin
  fADODataset.IndexFieldNames := Value
end;

procedure TDAADODataTable.SetMasterFields(const Value: string);
begin
  inherited;
  fADODataset.MasterFields := Value
end;

procedure TDAADODataTable.SetMasterSource(const Value: TDADataSource);
begin
  inherited;
  fADODataset.DataSource := Value
end;

function TDAADODataTable.GetFilter: string;
begin
  result := fADODataset.Filter
end;

function TDAADODataTable.GetFiltered: boolean;
begin
  result := fADODataset.Filtered
end;

procedure TDAADODataTable.SetFilter(const Value: string);
begin
  fADODataset.Filter := Value
end;

procedure TDAADODataTable.SetFiltered(const Value: boolean);
begin
  fADODataset.Filtered := Value
end;

procedure TDAADODataTable.DoAfterCloseDataset;
begin
  inherited;

  // These checks prevent the error "the provider does not support the necessary interface for index functionality"
  // that occourrs when the data table is being closed

  with fADODataset do begin
    if (IndexName<>'')
      then fADODataset.IndexName := '';

    if (IndexDefs.Count>0)
      then IndexDefs.Clear;
  end;
end;

procedure TDAADODataTable.DisableConstraints;
var
  i: Integer;
begin
  for i := fADODataset.Fields.Count -1 downto 0 do
  begin
    fADODataset.Fields[i].Required := False;
  end;
end;

procedure TDAADODataTable.EnableConstraints;
var
  i: Integer;
begin
  for i := fADODataset.Fields.Count -1 downto 0 do
  begin
    if i <> 0 then
      fADODataset.Fields[i].Required := Fields[i -1].Required;
  end;
end;

{ TDAADODataset }

function TDAADODataset.GetDataTable: TDADataTable;
begin
  result := TDADataTable(Owner);
end;

procedure TDAADODataset.InternalInitFieldDefs;
begin
  inherited;
end;

procedure TDAADODataset.InternalRefresh;
begin
  // Does nothing
end;

end.