SynVirtualDataSet.pas

/// DB VCL read-only virtual dataset
// - this unit is a part of the freeware Synopse framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynVirtualDataSet;

{
    This file is part of Synopse framework.

    Synopse framework. Copyright (C) 2016 Arnaud Bouchez
      Synopse Informatique - http://synopse.info

  *** BEGIN LICENSE BLOCK *****
  Version: MPL 1.1/GPL 2.0/LGPL 2.1

  The contents of this file are subject to the Mozilla Public License Version
  1.1 (the "License"); you may not use this file except in compliance with
  the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  for the specific language governing rights and limitations under the License.

  The Original Code is Synopse mORMot framework.

  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (C) 2016
  the Initial Developer. All Rights Reserved.

  Contributor(s):
  - Alfred Glaenzer (alf)
  - Esteban Martin (EMartin)
  - mingda
  - Murat Ak

  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
  use your version of this file under the terms of the MPL, indicate your
  decision by deleting the provisions above and replace them with the notice
  and other provisions required by the GPL or the LGPL. If you do not delete
  the provisions above, a recipient may use your version of this file under
  the terms of any one of the MPL, the GPL or the LGPL.

  ***** END LICENSE BLOCK *****

  Version 1.18
  - first public release, corresponding to Synopse mORMot Framework 1.18


}

{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

interface

uses
  SysUtils,
  Classes,
  Contnrs,
  {$ifndef DELPHI5OROLDER}
  Variants,
  {$endif}
  SynCommons,
  SynDBDataSet, // for AddBcd()
  DB;


type
  {$ifndef UNICODE} // defined as TRecordBuffer = PByte in newer DB.pas
  TRecordBuffer = PChar;
  {$endif}

  /// read-only virtual TDataSet able to access any content
  TSynVirtualDataSet = class(TDataSet)
  protected
    fCurrentRow: integer;
    fIsCursorOpen: boolean;

    // TDataSet overridden methods
    function AllocRecordBuffer: TRecordBuffer; override;
    procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
    procedure InternalInitRecord(Buffer: TRecordBuffer); override;
    function GetCanModify: Boolean; override;
    procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
    function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
    function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    function GetRecordSize: Word; override;
    procedure InternalClose; override;
    procedure InternalFirst; override;
    procedure InternalGotoBookmark(Bookmark: Pointer); override;
    procedure InternalHandleException; override;
    procedure InternalLast; override;
    procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
    function IsCursorOpen: Boolean; override;
    procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
    procedure SetRecNo(Value: Integer); override;
    function GetRecNo: Integer; override;

    // classses should override all those following methods:
    // - to read the data e.g. into memory:
    procedure InternalOpen; override;
    // - to initialize FieldDefs:
    // procedure InternalInitFieldDefs; override;
    // - to return row count:
    // function GetRecordCount: Integer; override;
    // - result should point to Int64,Double,Blob,UTF8 data (if ResultLen<>nil)
    function GetRowFieldData(Field: TField; RowIndex: integer; out ResultLen: Integer;
      OnlyCheckNull: boolean): Pointer; virtual; abstract;
  public
    /// this overridden constructor will compute an unique Name property
    constructor Create(Owner: TComponent); override;
    /// get BLOB column data for the current active row
    // - handle ftBlob,ftMemo,ftWideMemo via GetRowFieldData()
    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
    /// get BLOB column data for a given row (may not the active row)
    // - handle ftBlob,ftMemo,ftWideMemo via GetRowFieldData()
    function GetBlobStream(Field: TField; RowIndex: integer): TStream;
    /// get column data for the current active row
    // - handle ftBoolean,ftInteger,ftLargeint,ftFloat,ftDate,ftTime,ftDateTime,
    // ftString,ftWideString kind of fields via GetRowFieldData()
    {$ifdef ISDELPHIXE3}
    {$ifdef ISDELPHIXE4}
    function GetFieldData(Field: TField; var Buffer: TValueBuffer): Boolean; override;
    {$else}
    function GetFieldData(Field: TField; Buffer: TValueBuffer): Boolean; override;
    {$endif}
    {$else}
    function GetFieldData(Field: TField; Buffer: pointer): Boolean; override;
    {$endif}
    {$ifndef UNICODE}
    function GetFieldData(Field: TField; Buffer: pointer; NativeFormat: Boolean): Boolean; override;
    {$endif}
  published
    property Active;
    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnFilterRecord;
    property OnNewRecord;
    property OnPostError;
  end;

  /// read-only virtual TDataSet able to access a dynamic array of TDocVariant
  // - could be used e.g. from the result of TMongoCollection.FindDocs() to
  // avoid most temporary conversion into JSON or TClientDataSet buffers
  TDocVariantArrayDataSet = class(TSynVirtualDataSet)
  protected
    fValues: TVariantDynArray;
    fColumns: array of record
      Name: RawUTF8;
      FieldType: TSQLDBFieldType;
    end;
    fTemp64: Int64;
    fTempUTF8: RawUTF8;
    fTempBlob: RawByteString;
    procedure InternalInitFieldDefs; override;
    function GetRecordCount: Integer; override;
    function GetRowFieldData(Field: TField; RowIndex: integer;
      out ResultLen: Integer; OnlyCheckNull: boolean): Pointer; override;
  public
    /// initialize the virtual TDataSet from a dynamic array of TDocVariant
    // - you can set the expected column names and types matching the results
    // document layout - if no column information is specified, the first
    // TDocVariant will be used as reference
    constructor Create(Owner: TComponent; const Data: TVariantDynArray;
      const ColumnNames: array of RawUTF8; const ColumnTypes: array of TSQLDBFieldType); reintroduce;
  end;

const
  /// map the VCL string type, depending on the Delphi compiler version
  {$ifdef UNICODE}
  ftDefaultVCLString = ftWideString;
  {$else}
  ftDefaultVCLString = ftString;
  {$endif}

  /// map the best ft*Memo type available, depending on the Delphi compiler version
  {$ifdef ISDELPHI2007ANDUP}
  ftDefaultMemo = ftWideMemo;
  {$else}
  ftDefaultMemo = ftMemo;
  {$endif}

/// export all rows of a TDataSet into JSON
// - will work for any kind of TDataSet
function DataSetToJSON(Data: TDataSet): RawUTF8;

/// convert a dynamic array of TDocVariant result into a VCL DataSet
// - this function is just a wrapper around TDocVariantArrayDataSet.Create()
// - the TDataSet will be opened once created
function ToDataSet(aOwner: TComponent; const Data: TVariantDynArray;
  const ColumnNames: array of RawUTF8; const ColumnTypes: array of TSQLDBFieldType): TDocVariantArrayDataSet; overload;


implementation

var
  GlobalDataSetCount: integer;

type
  /// define how a single row is identified
  // - for TSynVirtualDataSet, it is just the row index (starting at 0)
  TRecInfoIdentifier = integer;

  PRecInfoIdentifier = ^TRecInfoIdentifier;

  /// pointer to an internal structure used to identify a row position
  PRecInfo = ^TRecInfo;

  /// internal structure used to identify a row position
  TRecInfo = record
    /// define how a single row is identified
    RowIndentifier: TRecInfoIdentifier;
    /// any associated bookmark
    Bookmark: TRecInfoIdentifier;
    /// any associated bookmark flag
    BookmarkFlag: TBookmarkFlag;
  end;


{ TSynVirtualDataSet }

function TSynVirtualDataSet.AllocRecordBuffer: TRecordBuffer;
begin
  result := AllocMem(sizeof(TRecInfo));
end;

procedure TSynVirtualDataSet.FreeRecordBuffer(var Buffer: TRecordBuffer);
begin
  FreeMem(Buffer);
  Buffer := nil;
end;

procedure TSynVirtualDataSet.GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
  PRecInfoIdentifier(Data)^ := PRecInfo(Buffer)^.Bookmark;
end;

function TSynVirtualDataSet.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
begin
  result := PRecInfo(Buffer)^.BookmarkFlag;
end;

function TSynVirtualDataSet.GetCanModify: Boolean;
begin
  result := false; // we define a READ-ONLY TDataSet
end;

procedure DateTimeToNative(DataType: TFieldType; Data: TDateTime; var Output);
  {$ifdef HASINLINE}inline;{$endif}
var TimeStamp: TTimeStamp;
    result: TDateTimeRec absolute Output;
begin
  TimeStamp := DateTimeToTimeStamp(Data);
  case DataType of
    ftDate: result.Date := TimeStamp.Date;
    ftTime: result.Time := TimeStamp.Time;
    else    result.DateTime := TimeStampToMSecs(TimeStamp);
  end;
end;

{$ifndef UNICODE}
function TSynVirtualDataSet.GetFieldData(Field: TField; Buffer: Pointer;
  NativeFormat: Boolean): Boolean;
begin
  if Field.DataType in [ftWideString] then
    NativeFormat := true; // to force Buffer as PWideString
  Result := inherited GetFieldData(Field, Buffer, NativeFormat);
end;
{$endif}

{$ifdef ISDELPHIXE3}
{$ifdef ISDELPHIXE4}
function TSynVirtualDataSet.GetFieldData(Field: TField; var Buffer: TValueBuffer): Boolean;
{$else}
function TSynVirtualDataSet.GetFieldData(Field: TField; Buffer: TValueBuffer): Boolean;
{$endif}
{$else}
function TSynVirtualDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
{$endif}
var Data, Dest: pointer;
    RowIndex, DataLen, MaxLen: integer;
    Temp: RawByteString;
    OnlyTestForNull: boolean;
begin
  result := false;
  OnlyTestForNull := (Buffer=nil);
  RowIndex := PRecInfo(ActiveBuffer).RowIndentifier;
  Data := GetRowFieldData(Field,RowIndex,DataLen,OnlyTestForNull);
  if Data=nil then // on success, points to Int64,Double,Blob,UTF8
    exit;
  result := true;
  if OnlyTestForNull then
    exit;
  Dest := pointer(Buffer); // works also if Buffer is [var] TValueBuffer
  case Field.DataType of
  ftBoolean:
    PWORDBOOL(Dest)^ := PBoolean(Data)^;
  ftInteger:
    PInteger(Dest)^ := PInteger(Data)^;
  ftLargeint, ftFloat:
    PInt64(Dest)^ := PInt64(Data)^;
  ftDate,ftTime,ftDateTime:
    DateTimeToNative(Field.DataType,PDateTime(Data)^,Dest^);
  ftString: begin
    if DataLen<>0 then begin
      CurrentAnsiConvert.UTF8BufferToAnsi(Data,DataLen,Temp);
      DataLen := length(Temp);
      MaxLen := Field.DataSize-1; // without trailing #0
      if DataLen>MaxLen then
        DataLen := MaxLen;
      move(pointer(Temp)^,Dest^,DataLen);
    end;
    PAnsiChar(Dest)[DataLen] := #0;
  end;
  ftWideString: begin
    {$ifdef ISDELPHI2007ANDUP} // here Dest = PWideChar[] of DataSize bytes
    if DataLen=0 then
      PWideChar(Dest)^ := #0 else
      UTF8ToWideChar(Dest,Data,(Field.DataSize-2)shr 1,DataLen);
    {$else}          // here Dest is PWideString
    UTF8ToWideString(Data,DataLen,WideString(Dest^));
    {$endif}
  end;
  // ftBlob,ftMemo,ftWideMemo should be retrieved by CreateBlobStream()
  else raise EDatabaseError.CreateFmt('%s.GetFieldData DataType=%d',
         [ClassName,ord(Field.DataType)]);
  end;
end;

function TSynVirtualDataSet.GetBlobStream(Field: TField; RowIndex: integer): TStream;
var Data: pointer;
    DataLen: integer;
begin
  Data := GetRowFieldData(Field,RowIndex,DataLen,false);
  if Data=nil then // should point to Blob or UTF8 data
    result := nil else
    case Field.DataType of
    ftBlob:
      result := TSynMemoryStream.Create(Data,DataLen);
    ftMemo, ftString:
      result := TRawByteStringStream.Create(CurrentAnsiConvert.UTF8BufferToAnsi(Data,DataLen));
    {$ifdef ISDELPHI2007ANDUP} ftWideMemo, {$endif} ftWideString:
      result := TRawByteStringStream.Create(Utf8DecodeToRawUnicode(Data,DataLen));
    else raise EDatabaseError.CreateFmt('%s.CreateBlobStream DataType=%d',
      [ClassName,ord(Field.DataType)]);
    end;
end;

function TSynVirtualDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
begin
  if Mode<>bmRead then
    raise EDatabaseError.CreateFmt('%s BLOB should be ReadOnly',[ClassName]);
  result := GetBlobStream(Field,PRecInfo(ActiveBuffer).RowIndentifier);
  if result=nil then
    result := TSynMemoryStream.Create; // null BLOB returns a void TStream
end;

function TSynVirtualDataSet.GetRecNo: Integer;
begin
  result := fCurrentRow+1;
end;

function TSynVirtualDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
begin
  result := grOK;
  case GetMode of
    gmPrior:
      if fCurrentRow>0 then
        dec(fCurrentRow) else
        result := grBOF;
    gmCurrent:
      if fCurrentRow<0 then
        result := grBOF else
      if fCurrentRow>=GetRecordCount then
        result := grEOF;
    gmNext:
      if fCurrentRow<GetRecordCount-1 then
        inc(fCurrentRow) else
        result := grEOF;
  end;
  if result=grOK then
    with PRecInfo(Buffer)^ do begin
      RowIndentifier := fCurrentRow;
      BookmarkFlag := bfCurrent;
      Bookmark := fCurrentRow;
    end;
end;

function TSynVirtualDataSet.GetRecordSize: Word;
begin
  result := SizeOf(TRecInfoIdentifier); // excluding Bookmark information
end;

procedure TSynVirtualDataSet.InternalClose;
begin
  BindFields(false);
  {$ifdef ISDELPHIXE7}
  if not(lcPersistent in Fields.LifeCycles) then
  {$else}
  if DefaultFields then
  {$endif}
    DestroyFields;
  fIsCursorOpen := False;
end;

procedure TSynVirtualDataSet.InternalFirst;
begin
  fCurrentRow := -1;
end;

procedure TSynVirtualDataSet.InternalGotoBookmark(Bookmark: Pointer);
begin
  fCurrentRow := PRecInfoIdentifier(Bookmark)^;
end;

procedure TSynVirtualDataSet.InternalHandleException;
begin
  if Assigned(Classes.ApplicationHandleException) then
    Classes.ApplicationHandleException(ExceptObject) else
    SysUtils.ShowException(ExceptObject,ExceptAddr);
end;

procedure TSynVirtualDataSet.InternalInitRecord(Buffer: TRecordBuffer);
begin
  fillchar(Buffer^,sizeof(TRecInfo),0);
end;

procedure TSynVirtualDataSet.InternalLast;
begin
  fCurrentRow := GetRecordCount;
end;

procedure TSynVirtualDataSet.InternalOpen;
begin
  BookmarkSize := SizeOf(TRecInfo)-sizeof(TRecInfoIdentifier);
  InternalInitFieldDefs;
  {$ifdef ISDELPHIXE7}
  if not(lcPersistent in Fields.LifeCycles) then
  {$else}
  if DefaultFields then
  {$endif}
    CreateFields;
  BindFields(true);
  fCurrentRow := -1;
  fIsCursorOpen := True;
end;

procedure TSynVirtualDataSet.InternalSetToRecord(Buffer: TRecordBuffer);
begin
  fCurrentRow := PRecInfo(Buffer).RowIndentifier;
end;

function TSynVirtualDataSet.IsCursorOpen: Boolean;
begin
  result := fIsCursorOpen;
end;

procedure TSynVirtualDataSet.SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
  PRecInfo(Buffer)^.Bookmark := PRecInfoIdentifier(Data)^;
end;

procedure TSynVirtualDataSet.SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag);
begin
  PRecInfo(Buffer)^.BookmarkFlag := Value;
end;

procedure TSynVirtualDataSet.SetRecNo(Value: Integer);
begin
  CheckBrowseMode;
  if Value<>RecNo then begin
    dec(Value);
    if cardinal(Value)>=cardinal(GetRecordCount) then
      raise ERangeError.CreateFmt('%s.SetRecNo(%d) with Count=%d',
        [ClassName,Value+1,GetRecordCount]);
    DoBeforeScroll;
    fCurrentRow := Value;
    Resync([rmCenter]);
    DoAfterScroll;
  end;
end;

constructor TSynVirtualDataSet.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  inc(GlobalDataSetCount);
  Name := ClassName+IntToStr(GlobalDataSetCount); // force unique name
end;


function DataSetToJSON(Data: TDataSet): RawUTF8;
var W: TJSONWriter;
    f: integer;
    blob: TRawByteStringStream;
begin
  result := 'null';
  if Data=nil then
    exit;
  Data.First;
  if Data.Eof then
    exit;
  W := TJSONWriter.Create(nil,true,false);
  try
    // get col names and types
    SetLength(W.ColNames,Data.FieldCount);
    for f := 0 to high(W.ColNames) do
      StringToUTF8(Data.FieldDefs[f].Name,W.ColNames[f]);
    W.AddColumns;
    W.Add('[');
    repeat
      W.Add('{');
      for f := 0 to Data.FieldCount-1 do begin
        W.AddString(W.ColNames[f]);
        with Data.Fields[f] do
        if IsNull then
          W.AddShort('null') else
        case DataType of
        ftBoolean:
          W.Add(AsBoolean);
        ftSmallint, ftInteger, ftWord, ftAutoInc:
          W.Add(AsInteger);
        ftLargeint:
          W.Add(TLargeintField(Data.Fields[f]).AsLargeInt);
        ftFloat, ftCurrency: // TCurrencyField is sadly a TFloatField
          W.Add(AsFloat,TFloatField(Data.Fields[f]).Precision);
        ftBCD:
          W.AddCurr64(AsCurrency);
        ftFMTBcd:
          AddBcd(W,AsBCD);
        ftTimeStamp, ftDate, ftTime, ftDateTime: begin
          W.Add('"');
          W.AddDateTime(AsDateTime);
          W.Add('"');
        end;
        ftString, ftFixedChar, ftMemo: begin
          W.Add('"');
          W.AddAnsiString({$ifdef UNICODE}AsAnsiString{$else}AsString{$endif},
            twJSONEscape);
          W.Add('"');
        end;
        ftWideString: begin
          W.Add('"');
          W.AddJSONEscapeW(pointer(TWideStringField(Data.Fields[f]).Value));
          W.Add('"');
        end;
        ftVariant:
          W.AddVariant(AsVariant);
        ftBytes, ftVarBytes, ftBlob, ftGraphic, ftOraBlob, ftOraClob: begin
          blob := TRawByteStringStream.Create;
          try
            (Data.Fields[f] as TBlobField).SaveToStream(blob);
            W.WrBase64(pointer(blob.DataString),length(blob.DataString),true);
          finally
            blob.Free;
          end;
        end;
        {$ifdef ISDELPHI2007ANDUP}
        ftWideMemo, ftFixedWideChar: begin
          W.Add('"');
          W.AddJSONEscapeW(pointer(AsWideString));
          W.Add('"');
        end;
        {$endif}
        {$ifdef UNICODE}
        ftShortint, ftByte:
          W.Add(AsInteger);
        ftLongWord:
          W.AddU(TLongWordField(Data.Fields[f]).Value);
        ftExtended:
          W.Add(AsFloat,DOUBLE_PRECISION);
        ftSingle:
          W.Add(AsFloat,SINGLE_PRECISION);
        {$endif}
        else W.AddShort('null'); // unhandled field type
        end;
        W.Add(',');
      end;
      W.CancelLastComma;
      W.Add('}',',');
      Data.Next;
    until Data.Eof;
    W.CancelLastComma;
    W.Add(']');
    W.SetText(result);
  finally
    W.Free;
  end;
end;


{ TDocVariantArrayDataSet }

constructor TDocVariantArrayDataSet.Create(Owner: TComponent;
  const Data: TVariantDynArray; const ColumnNames: array of RawUTF8;
  const ColumnTypes: array of TSQLDBFieldType);
var n,ndx,j: integer;
    first: PDocVariantData;
begin
  fValues := Data;
  n := Length(ColumnNames);
  if n>0 then begin
    if n<>length(ColumnTypes) then
      raise ESynException.CreateUTF8('%.Create(ColumnNames<>ColumnTypes)',[self]);
    SetLength(fColumns,n);
    for ndx := 0 to n-1 do begin
      fColumns[ndx].Name := ColumnNames[ndx];
      fColumns[ndx].FieldType := ColumnTypes[ndx];
    end;
  end else
  if fValues<>nil then begin
    first := _Safe(fValues[0],dvObject);
    SetLength(fColumns,first^.Count);
    for ndx := 0 to first^.Count-1 do begin
      fColumns[ndx].Name := first^.Names[ndx];
      fColumns[ndx].FieldType := VariantTypeToSQLDBFieldType(first^.Values[ndx]);
      case fColumns[ndx].FieldType of
      SynCommons.ftNull:
        fColumns[ndx].FieldType := SynCommons.ftBlob;
      SynCommons.ftCurrency:
        fColumns[ndx].FieldType := SynCommons.ftDouble;
      SynCommons.ftInt64: // ensure type coherency of whole column
        for j := 1 to first^.Count-1 do
          if j>=Length(fValues) then // check objects are consistent
            break else
            with _Safe(fValues[j],dvObject)^ do
            if (ndx<Length(Names)) and IdemPropNameU(Names[ndx],fColumns[ndx].Name) then
            if VariantTypeToSQLDBFieldType(Values[ndx]) in
                [SynCommons.ftNull,SynCommons.ftDouble,SynCommons.ftCurrency] then begin
              fColumns[ndx].FieldType := SynCommons.ftDouble;
              break;
            end;
      end;
    end;
  end;
  inherited Create(Owner);
end;

function TDocVariantArrayDataSet.GetRecordCount: Integer;
begin
  result := length(fValues);
end;

function TDocVariantArrayDataSet.GetRowFieldData(Field: TField;
  RowIndex: integer; out ResultLen: Integer;
  OnlyCheckNull: boolean): Pointer;
var F,ndx: integer;
    wasString: Boolean;
begin
  result := nil;
  F := Field.Index;
  if (cardinal(RowIndex)<cardinal(length(fValues))) and
     (cardinal(F)<cardinal(length(fColumns))) and
     not (fColumns[F].FieldType in [ftNull,SynCommons.ftUnknown,SynCommons.ftCurrency]) then
    with _Safe(fValues[RowIndex])^ do
    if (Kind=dvObject) and (Count>0) then begin
      if IdemPropNameU(fColumns[F].Name,Names[F]) then
        ndx := F else // optimistic match
        ndx := GetValueIndex(fColumns[F].Name);
      if ndx>=0 then
        if VarIsEmptyOrNull(Values[ndx]) then
          exit else begin
          result := @fTemp64;
          if not OnlyCheckNull then
          case fColumns[F].FieldType of
          ftInt64:
            VariantToInt64(Values[ndx],fTemp64);
          ftDouble,SynCommons.ftDate:
            VariantToDouble(Values[ndx],PDouble(@fTemp64)^);
          ftUTF8: begin
            VariantToUTF8(Values[ndx],fTempUTF8,wasString);
            result := pointer(fTempUTF8);
            ResultLen := length(fTempUTF8);
          end;
          SynCommons.ftBlob: begin
            VariantToUTF8(Values[ndx],fTempUTF8,wasString);
            if Base64MagicCheckAndDecode(pointer(fTempUTF8),length(fTempUTF8),fTempBlob) then begin
              result := pointer(fTempBlob);
              ResultLen := length(fTempBlob);
            end;
          end;
          end;
        end;
    end;
end;

procedure TDocVariantArrayDataSet.InternalInitFieldDefs;
const TYPES: array[TSQLDBFieldType] of TFieldType = (
  // ftUnknown, ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob
  ftWideString,ftWideString,ftLargeint,ftFloat,ftFloat,ftDate,ftWideString,ftBlob);
var F,siz: integer;
begin
  FieldDefs.Clear;
  for F := 0 to high(fColumns) do begin
    if fColumns[F].FieldType=ftUTF8 then
      siz := 16 else
      siz := 0;
    FieldDefs.Add(UTF8ToString(fColumns[F].Name),TYPES[fColumns[F].FieldType],siz);
  end;
end;

function ToDataSet(aOwner: TComponent; const Data: TVariantDynArray;
  const ColumnNames: array of RawUTF8; const ColumnTypes: array of TSQLDBFieldType): TDocVariantArrayDataSet; overload;
begin
  result := TDocVariantArrayDataSet.Create(aOwner,Data,ColumnNames,ColumnTypes);
  result.Open;
end;

end.