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.