A very crude ADO RecordSet wrapper for a TDataSet with basic navigation

ADORecordSet.pas

unit ADORecordSet;

interface

uses
  Winapi.Windows, Winapi.ActiveX, Winapi.ADOInt,
  System.Classes, System.SysUtils, System.Win.ComObj, System.Variants,
  Data.DB;

type
  TDummyProperties = class(TAutoIntfObject, _Collection, Properties)
  private
    { _Collection }
    function Get_Count: Integer; safecall;
    function _NewEnum: IUnknown; safecall;
    procedure Refresh; safecall;
    { Properties }
    function Get_Item(Index: OleVariant): Property_; safecall;
  end;

  TADOField = class(TAutoIntfObject, _ADO, Field20, Field)
  private
    FField: TField;
    FTypeLib: ITypeLib;
    { _ADO }
    function Get_Properties: Properties; safecall;
    { Field20 }
    function Get_ActualSize: ADO_LONGPTR; safecall;
    function Get_Attributes: Integer; safecall;
    function Get_DefinedSize: ADO_LONGPTR; safecall;
    function Get_Name: WideString; safecall;
    function Get_Type_: DataTypeEnum; safecall;
    function Get_Value: OleVariant; safecall;
    procedure Set_Value(pvar: OleVariant); safecall;
    function Get_Precision: Byte; safecall;
    function Get_NumericScale: Byte; safecall;
    procedure AppendChunk(Data: OleVariant); safecall;
    function GetChunk(Length: Integer): OleVariant; safecall;
    function Get_OriginalValue: OleVariant; safecall;
    function Get_UnderlyingValue: OleVariant; safecall;
    function Get_DataFormat: IUnknown; safecall;
    procedure _Set_DataFormat(const ppiDF: IUnknown); safecall;
    procedure Set_Precision(pbPrecision: Byte); safecall;
    procedure Set_NumericScale(pbNumericScale: Byte); safecall;
    procedure Set_Type_(pDataType: DataTypeEnum); safecall;
    procedure Set_DefinedSize(pl: ADO_LONGPTR); safecall;
    procedure Set_Attributes(pl: Integer); safecall;
    { Field }
    function Get_Status: Integer; safecall;
  public
    constructor Create(const TypeLib: ITypeLib; const DispIntf: TGUID; Field: TField);
  end;

  TADOFields = class(TAutoIntfObject, IEnumVariant, _Collection, Fields15, Fields20, Fields)
  private
    FCurIndex: Integer;
    FFields: TFields;
    FFieldList: TInterfaceList;
    FTypeLib: ITypeLib;
    { IEnumVariant }
    function Next(celt: LongWord; var rgvar : OleVariant; out pceltFetched: LongWord): HResult; stdcall;
    function Skip(celt: LongWord): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out Enum: IEnumVariant): HResult; stdcall;
    { _Collection }
    function Get_Count: Integer; safecall;
    function _NewEnum: IUnknown; safecall;
    procedure Refresh; safecall;
    { Fields15 }
    function Get_Item(Index: OleVariant): Field; safecall;
    { Fields20 }
    procedure _Append(const Name: WideString; Type_: DataTypeEnum; DefinedSize: ADO_LONGPTR;
      Attrib: FieldAttributeEnum); safecall;
    procedure Delete(Index: OleVariant); safecall;
    { Fields }
    procedure Append(const Name: WideString; Type_: DataTypeEnum; DefinedSize: ADO_LONGPTR;
      Attrib: FieldAttributeEnum; FieldValue: OleVariant); safecall;
    procedure Update; safecall;
    procedure Resync(ResyncValues: ResyncEnum); safecall;
    procedure CancelUpdate; safecall;
  public
    constructor Create(const TypeLib: ITypeLib; const DispIntf: TGUID; Fields: TFields);
    destructor Destroy; override;
  end;

  TDataSetOwnership = (dsoReference, dsoOwned);

  TADORecordSet = class(TAutoIntfObject, _ADO, RecordSet15, RecordSet20, RecordSet21, RecordSet)
  private
    FBOF: Boolean;
    FDataSet: TDataSet;
    FEOF: Boolean;
    FFields: Fields;
    FOwnership: TDataSetOwnership;
    FTypeLib: ITypeLib;
    function GetRecordSetInfo: string;
    { _ADO }
    function Get_Properties: Properties; safecall;
    { RecordSet15 }
    function Get_AbsolutePosition: PositionEnum_Param; safecall;
    procedure Set_AbsolutePosition(pl: PositionEnum_Param); safecall;
    procedure _Set_ActiveConnection(const pvar: IDispatch); safecall;
    procedure Set_ActiveConnection(pvar: OleVariant); safecall;
    function Get_ActiveConnection: OleVariant; safecall;
    function Get_BOF: WordBool; safecall;
    function Get_Bookmark: OleVariant; safecall;
    procedure Set_Bookmark(pvBookmark: OleVariant); safecall;
    function Get_CacheSize: Integer; safecall;
    procedure Set_CacheSize(pl: Integer); safecall;
    function Get_CursorType: CursorTypeEnum; safecall;
    procedure Set_CursorType(plCursorType: CursorTypeEnum); safecall;
    function Get_EOF: WordBool; safecall;
    function Get_Fields: Fields; safecall;
    function Get_LockType: LockTypeEnum; safecall;
    procedure Set_LockType(plLockType: LockTypeEnum); safecall;
    function Get_MaxRecords: ADO_LONGPTR; safecall;
    procedure Set_MaxRecords(plMaxRecords: ADO_LONGPTR); safecall;
    function Get_RecordCount: ADO_LONGPTR; safecall;
    procedure _Set_Source(const pvSource: IDispatch); safecall;
    procedure Set_Source(const pvSource: WideString); safecall;
    function Get_Source: OleVariant; safecall;
    procedure AddNew(FieldList: OleVariant; Values: OleVariant); safecall;
    procedure CancelUpdate; safecall;
    procedure Close; safecall;
    procedure Delete(AffectRecords: AffectEnum); safecall;
    function GetRows(Rows: Integer; Start: OleVariant; Fields: OleVariant): OleVariant; safecall;
    procedure Move(NumRecords: ADO_LONGPTR; Start: OleVariant); safecall;
    procedure MoveNext; safecall;
    procedure MovePrevious; safecall;
    procedure MoveFirst; safecall;
    procedure MoveLast; safecall;
    procedure Open(Source: OleVariant; ActiveConnection: OleVariant; CursorType: CursorTypeEnum;
      LockType: LockTypeEnum; Options: Integer); safecall;
    procedure Requery(Options: Integer); safecall;
    procedure _xResync(AffectRecords: AffectEnum); safecall;
    procedure Update(Fields: OleVariant; Values: OleVariant); safecall;
    function Get_AbsolutePage: PositionEnum_Param; safecall;
    procedure Set_AbsolutePage(pl: PositionEnum_Param); safecall;
    function Get_EditMode: EditModeEnum; safecall;
    function Get_Filter: OleVariant; safecall;
    procedure Set_Filter(Criteria: OleVariant); safecall;
    function Get_PageCount: ADO_LONGPTR; safecall;
    function Get_PageSize: Integer; safecall;
    procedure Set_PageSize(pl: Integer); safecall;
    function Get_Sort: WideString; safecall;
    procedure Set_Sort(const Criteria: WideString); safecall;
    function Get_Status: Integer; safecall;
    function Get_State: Integer; safecall;
    function _xClone: _Recordset; safecall;
    procedure UpdateBatch(AffectRecords: AffectEnum); safecall;
    procedure CancelBatch(AffectRecords: AffectEnum); safecall;
    function Get_CursorLocation: CursorLocationEnum; safecall;
    procedure Set_CursorLocation(plCursorLoc: CursorLocationEnum); safecall;
    function NextRecordset(out RecordsAffected: OleVariant): _Recordset; safecall;
    function Supports(CursorOptions: CursorOptionEnum): WordBool; safecall;
    function Get_Collect(Index: OleVariant): OleVariant; safecall;
    procedure Set_Collect(Index: OleVariant; pvar: OleVariant); safecall;
    function Get_MarshalOptions: MarshalOptionsEnum; safecall;
    procedure Set_MarshalOptions(peMarshal: MarshalOptionsEnum); safecall;
    procedure Find(const Criteria: WideString; SkipRecords: ADO_LONGPTR;
      SearchDirection: SearchDirectionEnum; Start: OleVariant); safecall;
    { RecordSet20 }
    procedure Cancel; safecall;
    function Get_DataSource: IUnknown; safecall;
    procedure _Set_DataSource(const ppunkDataSource: IUnknown); safecall;
    procedure _xSave(const FileName: WideString; PersistFormat: PersistFormatEnum); safecall;
    function Get_ActiveCommand: IDispatch; safecall;
    procedure Set_StayInSync(pbStayInSync: WordBool); safecall;
    function Get_StayInSync: WordBool; safecall;
    function GetString(StringFormat: StringFormatEnum; NumRows: Integer;
                       const ColumnDelimeter: WideString; const RowDelimeter: WideString;
      const NullExpr: WideString): WideString; safecall;
    function Get_DataMember: WideString; safecall;
    procedure Set_DataMember(const pbstrDataMember: WideString); safecall;
    function CompareBookmarks(Bookmark1: OleVariant; Bookmark2: OleVariant): CompareEnum; safecall;
    function Clone(LockType: LockTypeEnum): _Recordset; safecall;
    procedure Resync(AffectRecords: AffectEnum; ResyncValues: ResyncEnum); safecall;
    { RecordSet21 }
    procedure Seek(KeyValues: OleVariant; SeekOption: SeekEnum); safecall;
    procedure Set_Index(const pbstrIndex: WideString); safecall;
    function Get_Index: WideString; safecall;
    { RecordSet }
    procedure Save(Destination: OleVariant; PersistFormat: PersistFormatEnum); safecall;
  public
    constructor Create(const TypeLib: ITypeLib; const DispIntf: TGUID; DataSet: TDataSet;
      Ownership: TDataSetOwnership = dsoReference);
    destructor Destroy; override;
  end;

implementation

type
  PBookmark = ^TBookmark;

// copied from Data.Win.ADODB
const
  DataTypeValues: array[TFieldType] of TOleEnum = (
    adEmpty, adVarChar, adSmallint, adInteger, adUnsignedSmallint, // 0..4
    adBoolean, adDouble, adDouble, adCurrency, adDate, adDate, adDate, // 5..11
    adBinary, adVarBinary, adInteger, adLongVarBinary, adLongVarChar, adLongVarBinary, adLongVarBinary, // 12..18
    adLongVarBinary, adLongVarBinary, adLongVarBinary, adEmpty, adChar, adVarWChar, // 19..24
    adBigInt, adEmpty, adEmpty, adEmpty, adEmpty, adEmpty, adEmpty, // 25..31
    adVariant, adIUnknown, adIDispatch, adGuid, adEmpty, adCurrency, // 32..37
    adWChar, adLongVarWChar, adEmpty, adEmpty, // 38..41
    adUnsignedBigInt, adTinyInt, adUnsignedTinyInt, adDouble, adEmpty, adEmpty, adEmpty, // 42..48
    adEmpty, adEmpty, adEmpty); // 49..51

procedure NotImplemented;
begin
  raise Exception.Create('Not Implemented');
end;

{ TDummyProperties private: _Collection }

function TDummyProperties.Get_Count: Integer;
begin
  Result := 0;
end;

function TDummyProperties._NewEnum: IUnknown;
begin
  NotImplemented;
end;

procedure TDummyProperties.Refresh;
begin
  NotImplemented;
end;

function TDummyProperties.Get_Item(Index: OleVariant): Property_;
begin
  NotImplemented;
end;

{ TADOField private: _ADO }

function TADOField.Get_Properties: Properties;
begin
  Result := TDummyProperties.Create(FTypeLib, Properties);
end;

{ TADOField private: Field20 }

function TADOField.Get_ActualSize: ADO_LONGPTR;
begin
  Result := FField.Size;
end;

function TADOField.Get_Attributes: Integer;
begin
  Result := 0;
end;

function TADOField.Get_DefinedSize: ADO_LONGPTR;
begin
  Result := FField.DataSize;
end;

function TADOField.Get_Name: WideString;
begin
  Result := FField.FieldName;
end;

function TADOField.Get_Type_: DataTypeEnum;
begin
  Result := DataTypeValues[FField.DataType];
end;

function TADOField.Get_Value: OleVariant;
begin
  Result := FField.Value;
end;

procedure TADOField.Set_Value(pvar: OleVariant);
begin
  NotImplemented;
end;

function TADOField.Get_Precision: Byte;
begin
  if FField is TFloatField then
    Result := TFloatField(FField).Precision
  else if FField is TSingleField then
    Result := TSingleField(FField).Precision
  else if FField is TExtendedField then
    Result := TExtendedField(FField).Precision
  else if FField is TBCDField then
    Result := TBCDField(FField).Precision
  else if FField is TFMTBCDField then
    Result := TFMTBCDField(FField).Precision
  else
    Result := 0;
end;

function TADOField.Get_NumericScale: Byte;
begin
  if FField.DataType in [ftBCD, ftFMTBcd] then
    Result := FField.Size
  else
    Result := 0;
end;

procedure TADOField.AppendChunk(Data: OleVariant);
begin
  NotImplemented;
end;

function TADOField.GetChunk(Length: Integer): OleVariant;
begin
  NotImplemented;
end;

function TADOField.Get_OriginalValue: OleVariant;
begin
  Result := FField.Value;
end;

function TADOField.Get_UnderlyingValue: OleVariant;
begin
  Result := FField.Value;
end;

function TADOField.Get_DataFormat: IUnknown;
begin
  NotImplemented;
end;

procedure TADOField._Set_DataFormat(const ppiDF: IInterface);
begin
  NotImplemented;
end;

procedure TADOField.Set_Precision(pbPrecision: Byte);
begin
  NotImplemented;
end;

procedure TADOField.Set_NumericScale(pbNumericScale: Byte);
begin
  NotImplemented;
end;

procedure TADOField.Set_Type_(pDataType: DataTypeEnum);
begin
  NotImplemented;
end;

procedure TADOField.Set_DefinedSize(pl: ADO_LONGPTR);
begin
  NotImplemented;
end;

procedure TADOField.Set_Attributes(pl: Integer);
begin
  NotImplemented;
end;

{ TADOField private: Field }

function TADOField.Get_Status: Integer;
begin
  Result := 0;
end;

{ TADOField public }

constructor TADOField.Create(const TypeLib: ITypeLib; const DispIntf: TGUID; Field: TField);
begin
  inherited Create(TypeLib, DispIntf);
  FTypeLib := TypeLib;
  FField := Field;
end;

{ TADOFields private: IEnumVariant }

function TADOFields.Next(celt: LongWord; var rgvar: OleVariant; out pceltFetched: LongWord): HResult;
begin
  if celt = 1 then
  begin
    if FCurIndex + 1 > FFields.Count then
    begin
      FCurIndex := 0;
      Result := S_FALSE;
    end
    else
    begin
      rgvar := Get_Item(FCurIndex);
      if @pceltFetched <> nil then
        pceltFetched := celt;
      Inc(FCurIndex);
      Result := S_OK;
    end;
  end
  else
    Result := E_NOTIMPL;
end;

function TADOFields.Skip(celt: LongWord): HResult;
begin
  Inc(FCurIndex, celt);
  if FCurIndex >= FFields.Count then
  begin
    FCurIndex := FFields.Count - 1;
    Result := S_FALSE;
  end
  else
    Result := S_OK;
end;

function TADOFields.Reset: HResult;
begin
  FCurIndex := 0;
  Result := S_OK;
end;

function TADOFields.Clone(out Enum: IEnumVariant): HResult;
begin
  Enum := TADOFields.Create(FTypeLib, Fields, FFields);
  Result := S_OK;
end;

{ TADOFields private: _Collection }

function TADOFields.Get_Count: Integer;
begin
  Result := FFields.Count;
end;

function TADOFields._NewEnum: IUnknown;
begin
  Result := Self;
end;

procedure TADOFields.Refresh;
begin
  NotImplemented;
end;

{ TADOFields private: Fields15 }

function TADOFields.Get_Item(Index: OleVariant): Field;
var
  I: Integer;
begin
  if not Assigned(FFieldList) then
  begin
    FFieldList := TInterfaceList.Create;
    for I := 0 to FFields.Count - 1 do
      FFieldList.Add(TADOField.Create(FTypeLib, Field, FFields[I]));
  end;

  if VarIsStr(Index) then
    I := FFields.FieldByName(Index).FieldNo
  else
    I := Index;
  Result := FFieldList[I] as Field;
end;

{ TADOFields private: Fields20 }

procedure TADOFields._Append(const Name: WideString; Type_: DataTypeEnum; DefinedSize: ADO_LONGPTR;
  Attrib: FieldAttributeEnum);
begin
  NotImplemented;
end;

procedure TADOFields.Delete(Index: OleVariant);
begin
  NotImplemented;
end;

{ TADOFields private: Fields }

procedure TADOFields.Append(const Name: WideString; Type_: DataTypeEnum; DefinedSize: ADO_LONGPTR;
  Attrib: FieldAttributeEnum; FieldValue: OleVariant);
begin
  NotImplemented;
end;

procedure TADOFields.Update;
begin
  NotImplemented;
end;

procedure TADOFields.Resync(ResyncValues: ResyncEnum);
begin
  NotImplemented;
end;

procedure TADOFields.CancelUpdate;
begin
  NotImplemented;
end;

{ TADOFields public }

constructor TADOFields.Create(const TypeLib: ITypeLib; const DispIntf: TGUID; Fields: TFields);
begin
  inherited Create(TypeLib, DispIntf);
  FTypeLib := TypeLib;
  FFields := Fields;
  FFieldList := nil;
end;

destructor TADOFields.Destroy;
begin
  FFieldList.Free;
  FTypeLib := nil;
  inherited Destroy;
end;

{ TADORecordSet private: _ADO }

function TADORecordSet.Get_Properties: Properties;
begin
  Result := TDummyProperties.Create(FTypeLib, Properties);
end;

{ TADORecordSet private: RecordSet15 }

function TADORecordSet.Get_AbsolutePosition: PositionEnum_Param;
begin
  if FBOF then
  begin
    if FEOF then
      Result := adPosUnknown
    else
      Result := adPosBOF;
  end
  else
  begin
    if FEOF then
      Result := adPosEOF
    else
      Result := FDataSet.RecNo;
  end;
end;

procedure TADORecordSet.Set_AbsolutePosition(pl: PositionEnum_Param);
begin
  case pl of
    adPosBOF:
      begin
        FDataSet.First;
        FBOF := True;
      end;
    adPosEOF:
      begin
        FDataSet.Last;
        FEOF := True;
      end;
    else
      begin
        FDataSet.RecNo := pl;
        FBOF := FDataSet.RecordCount = 0;
        FEOF := FDataSet.RecordCount = 0;
      end;
  end;
end;

procedure TADORecordSet._Set_ActiveConnection(const pvar: IDispatch);
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_ActiveConnection(pvar: OleVariant);
begin
  NotImplemented;
end;

function TADORecordSet.Get_ActiveConnection: OleVariant;
begin
  NotImplemented;
end;

function TADORecordSet.Get_BOF: WordBool;
begin
  Result := FBOF;
end;

function TADORecordSet.Get_Bookmark: OleVariant;
begin
  Result := FDataSet.RecNo;
end;

procedure TADORecordSet.Set_Bookmark(pvBookmark: OleVariant);
begin
  FDataSet.RecNo := pvBookmark;
  FBOF := FDataSet.RecordCount = 0;
  FEOF := FDataSet.RecordCount = 0;
end;

function TADORecordSet.Get_CacheSize: Integer;
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_CacheSize(pl: Integer);
begin
  NotImplemented;
end;

function TADORecordSet.Get_CursorType: CursorTypeEnum;
begin
  Result := adOpenDynamic;
end;

procedure TADORecordSet.Set_CursorType(plCursorType: CursorTypeEnum);
begin
  NotImplemented;
end;

function TADORecordSet.Get_EOF: WordBool;
begin
  Result := FEOF;
end;

function TADORecordSet.Get_Fields: Fields;
begin
  if not Assigned(FFields) then
    FFields := TADOFields.Create(FTypeLib, Fields, FDataSet.Fields);
  Result := FFields;
end;

function TADORecordSet.Get_LockType: LockTypeEnum;
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_LockType(plLockType: LockTypeEnum);
begin
  NotImplemented;
end;

function TADORecordSet.Get_MaxRecords: ADO_LONGPTR;
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_MaxRecords(plMaxRecords: ADO_LONGPTR);
begin
  NotImplemented;
end;

function TADORecordSet.Get_RecordCount: ADO_LONGPTR;
begin
  Result := FDataSet.RecordCount;
end;

procedure TADORecordSet._Set_Source(const pvSource: IDispatch);
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_Source(const pvSource: WideString);
begin
  NotImplemented;
end;

function TADORecordSet.Get_Source: OleVariant;
begin
  NotImplemented;
end;

procedure TADORecordSet.AddNew(FieldList, Values: OleVariant);
begin
  NotImplemented;
end;

procedure TADORecordSet.CancelUpdate;
begin
  NotImplemented;
end;

procedure TADORecordSet.Close;
begin
  FDataSet.Close;
end;

procedure TADORecordSet.Delete(AffectRecords: AffectEnum);
begin
  NotImplemented;
end;

function TADORecordSet.GetRows(Rows: Integer; Start, Fields: OleVariant): OleVariant;
begin
  NotImplemented;
end;

procedure TADORecordSet.Move(NumRecords: ADO_LONGPTR; Start: OleVariant);
var
  MovedBy: Integer;
begin
  if VarIsOrdinal(Start) then
    case Start of
      adBookmarkFirst:
        FDataSet.First;
      adBookmarkLast:
        FDataSet.Last;
    end
  else if VarIsArray(Start) then
    Set_Bookmark(Start);

  MovedBy := FDataSet.MoveBy(NumRecords);
  if MovedBy = NumRecords then
  begin
    FBOF := False;
    FEOF := False;
  end
  else
  begin
    FEOF := FDataSet.EOF;
    FBOF := FDataSet.BOF;
  end;
end;

procedure TADORecordSet.MoveNext;
begin
  if FBOF then
    FDataSet.First
  else
    FDataSet.Next;
  FBOF := FDataSet.RecordCount = 0;
  FEOF := FDataSet.EOF;
end;

procedure TADORecordSet.MovePrevious;
begin
  if FEOF then
    FDataSet.Last
  else
    FDataSet.Prior;
  FEOF := FDataSet.RecordCount = 0;
  FBOF := FDataSet.BOF;
end;

procedure TADORecordSet.MoveFirst;
begin
  FDataSet.First;
  FBOF := FDataSet.RecordCount = 0;
  FEOF := FDataSet.RecordCount = 0;
end;

procedure TADORecordSet.MoveLast;
begin
  FDataSet.Last;
  FBOF := FDataSet.RecordCount = 0;
  FEOF := FDataSet.RecordCount = 0;
end;

procedure TADORecordSet.Open(Source, ActiveConnection: OleVariant; CursorType: CursorTypeEnum;
  LockType: LockTypeEnum; Options: Integer);
begin
  NotImplemented;
end;

function TADORecordSet.GetRecordSetInfo: string;
begin
  Result := Format('RecNo: %d, SpeciesNo: %d, CommonName: ''%s'', BOF: %s, EOF: %s',
    [FDataSet.RecNo, FDataSet.Fields[0].AsInteger, FDataSet.Fields[2].AsString, BoolToStr(FBOF, True),
    BoolToStr(FEOF, True)]);
end;

procedure TADORecordSet.Requery(Options: Integer);
begin
  NotImplemented;
end;

procedure TADORecordSet._xResync(AffectRecords: AffectEnum);
begin
  NotImplemented;
end;

procedure TADORecordSet._xSave(const FileName: WideString; PersistFormat: PersistFormatEnum);
begin
  NotImplemented;
end;

procedure TADORecordSet.Update(Fields, Values: OleVariant);
begin
  NotImplemented;
end;

function TADORecordSet.Get_AbsolutePage: PositionEnum_Param;
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_AbsolutePage(pl: PositionEnum_Param);
begin
  NotImplemented;
end;

function TADORecordSet.Get_EditMode: EditModeEnum;
begin
  NotImplemented;
end;

function TADORecordSet.Get_Filter: OleVariant;
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_Filter(Criteria: OleVariant);
begin
  NotImplemented;
end;

function TADORecordSet.Get_PageCount: ADO_LONGPTR;
begin
  NotImplemented;
end;

function TADORecordSet.Get_PageSize: Integer;
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_PageSize(pl: Integer);
begin
  NotImplemented;
end;

function TADORecordSet.Get_Sort: WideString;
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_Sort(const Criteria: WideString);
begin
  NotImplemented;
end;

function TADORecordSet.Get_Status: Integer;
begin
  Result := adRecOK;
end;

function TADORecordSet.Get_State: Integer;
const
  States: array[Boolean] of Integer = (adStateClosed, adStateOpen);
begin
  Result := States[FDataSet.Active];
end;

function TADORecordSet._xClone: _Recordset;
begin
  NotImplemented;
end;

procedure TADORecordSet.UpdateBatch(AffectRecords: AffectEnum);
begin
  NotImplemented;
end;

procedure TADORecordSet.CancelBatch(AffectRecords: AffectEnum);
begin
  NotImplemented;
end;

function TADORecordSet.Get_CursorLocation: CursorLocationEnum;
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_CursorLocation(plCursorLoc: CursorLocationEnum);
begin
  NotImplemented;
end;

function TADORecordSet.NextRecordset(out RecordsAffected: OleVariant): _Recordset;
begin
  NotImplemented;
end;

function TADORecordSet.Supports(CursorOptions: CursorOptionEnum): WordBool;
begin
  Result := (CursorOptions = adMovePrevious) or (CursorOptions = adBookmark);
end;

function TADORecordSet.Get_Collect(Index: OleVariant): OleVariant;
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_Collect(Index, pvar: OleVariant);
begin
  NotImplemented;
end;

function TADORecordSet.Get_MarshalOptions: MarshalOptionsEnum;
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_MarshalOptions(peMarshal: MarshalOptionsEnum);
begin
  NotImplemented;
end;

procedure TADORecordSet.Find(const Criteria: WideString; SkipRecords: ADO_LONGPTR;
  SearchDirection: SearchDirectionEnum; Start: OleVariant);
begin
  NotImplemented;
end;

{ TADORecordSet private: RecordSet20 }

procedure TADORecordSet.Cancel;
begin
  NotImplemented;
end;

function TADORecordSet.Get_DataSource: IUnknown;
begin
  NotImplemented;
end;

procedure TADORecordSet.Save(Destination: OleVariant; PersistFormat: PersistFormatEnum);
begin
  NotImplemented;
end;

function TADORecordSet.Get_ActiveCommand: IDispatch;
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_StayInSync(pbStayInSync: WordBool);
begin
  NotImplemented;
end;

function TADORecordSet.Get_StayInSync: WordBool;
begin
  NotImplemented;
end;

function TADORecordSet.GetString(StringFormat: StringFormatEnum; NumRows: Integer;
  const ColumnDelimeter, RowDelimeter, NullExpr: WideString): WideString;
begin
  NotImplemented;
end;

function TADORecordSet.Get_DataMember: WideString;
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_DataMember(const pbstrDataMember: WideString);
begin
  NotImplemented;
end;

function TADORecordSet.CompareBookmarks(Bookmark1, Bookmark2: OleVariant): CompareEnum;
var
  Compare: Integer;
begin
  Compare := FDataSet.CompareBookmarks(Bookmark1, Bookmark2);
  if Compare = 0 then
    Result := adCompareEqual
  else if Compare > 0 then
    Result := adCompareGreaterThan
  else
    Result := adCompareLessThan;
end;

function TADORecordSet.Clone(LockType: LockTypeEnum): _Recordset;
begin
  NotImplemented;
end;

procedure TADORecordSet.Resync(AffectRecords: AffectEnum; ResyncValues: ResyncEnum);
begin
  NotImplemented;
end;

{ TADORecordSet private: RecordSet }

procedure TADORecordSet.Seek(KeyValues: OleVariant; SeekOption: SeekEnum);
begin
  NotImplemented;
end;

procedure TADORecordSet.Set_Index(const pbstrIndex: WideString);
begin
  NotImplemented;
end;

function TADORecordSet.Get_Index: WideString;
begin
  NotImplemented;
end;

procedure TADORecordSet._Set_DataSource(const ppunkDataSource: IInterface);
begin
  NotImplemented;
end;

{ TADORecordSet public }

constructor TADORecordSet.Create(const TypeLib: ITypeLib; const DispIntf: TGUID; DataSet: TDataSet;
  Ownership: TDataSetOwnership = dsoReference);
begin
  inherited Create(TypeLib, DispIntf);
  FTypeLib := TypeLib;
  FDataSet := DataSet;
  FDataSet.First;
  FOwnership := Ownership;
  FBOF := True;
  FEOF := FDataSet.RecordCount = 0;
end;

destructor TADORecordSet.Destroy;
begin
  FFields := nil;
  FTypeLib := nil;
  if FOwnership = dsoOwned then
    FDataSet.Free;
  inherited Destroy;
end;

end.

Project1.dpr

program Project1;

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {Form1},
  ADORecordSet in 'ADORecordSet.pas';

{$R *.res}

begin
  ReportMemoryLeaksOnShutdown := True;
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Unit1.dfm

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 373
  ClientWidth = 574
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  DesignSize = (
    574
    373)
  PixelsPerInch = 96
  TextHeight = 13
  object DBNavigator1: TDBNavigator
    Left = 8
    Top = 8
    Width = 240
    Height = 25
    DataSource = DataSource1
    TabOrder = 0
  end
  object DBGrid1: TDBGrid
    Left = 8
    Top = 39
    Width = 553
    Height = 178
    Anchors = [akLeft, akTop, akRight, akBottom]
    DataSource = DataSource1
    TabOrder = 1
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'Tahoma'
    TitleFont.Style = []
  end
  object Button1: TButton
    Left = 264
    Top = 8
    Width = 105
    Height = 25
    Caption = 'Switch to ADO'
    TabOrder = 2
    OnClick = Button1Click
  end
  object DBMemo1: TDBMemo
    Left = 8
    Top = 223
    Width = 281
    Height = 138
    Anchors = [akLeft, akRight, akBottom]
    DataField = 'Notes'
    DataSource = DataSource1
    TabOrder = 3
  end
  object DBImage1: TDBImage
    Left = 295
    Top = 223
    Width = 266
    Height = 138
    Anchors = [akRight, akBottom]
    DataField = 'Graphic'
    DataSource = DataSource1
    TabOrder = 4
  end
  object ClientDataSet1: TClientDataSet
    Aggregates = <>
    Params = <>
    Left = 40
    Top = 16
  end
  object DataSource1: TDataSource
    DataSet = ClientDataSet1
    Left = 120
    Top = 16
  end
  object ADODataSet1: TADODataSet
    Parameters = <>
    Left = 40
    Top = 80
  end
  object DataSource2: TDataSource
    DataSet = ADODataSet1
    Left = 120
    Top = 80
  end
end

Unit1.pas

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, Winapi.ActiveX, Winapi.ADOInt,
  System.SysUtils, System.Variants, System.Classes, System.Win.ComObj,
  Data.DB, Datasnap.DBClient, Data.Win.ADODB,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.DBGrids, Vcl.ExtCtrls, Vcl.DBCtrls,
  Vcl.StdCtrls,
  ADORecordSet;

type
  TForm1 = class(TForm)
    ClientDataSet1: TClientDataSet;
    DataSource1: TDataSource;
    DBNavigator1: TDBNavigator;
    DBGrid1: TDBGrid;
    ADODataSet1: TADODataSet;
    DataSource2: TDataSource;
    Button1: TButton;
    DBMemo1: TDBMemo;
    DBImage1: TDBImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ClientDataSet1.LoadFromFile('C:\Program Files\Common Files\CodeGear Shared\Data\biolife.cds');
  Caption := 'CDS';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TypeLib: ITypeLib;
begin
  if DBNavigator1.DataSource = DataSource1 then
  begin
    OleCheck(LoadTypeLib('C:\Program Files\Common Files\System\ado\msado27.tlb', TypeLib));
    ClientDataSet1.First;
    ADODataSet1.Recordset := TADORecordSet.Create(TypeLib, RecordSet, ClientDataSet1);
    DBNavigator1.DataSource := DataSource2;
    DBGrid1.DataSource := DataSource2;
    DBMemo1.DataSource := DataSource2;
    DBImage1.DataSource := DataSource2;
    Caption := 'ADO';
    Button1.Caption := 'Switch to CDS';
  end
  else
  begin
    ClientDataSet1.First;
    DBNavigator1.DataSource := DataSource1;
    DBGrid1.DataSource := DataSource1;
    ADODataSet1.Recordset := nil;
    DBMemo1.DataSource := DataSource1;
    DBImage1.DataSource := DataSource1;
    Caption := 'CDS';
    Button1.Caption := 'Switch to ADO';
  end;
end;

end.