
//////////////////////////////////////////////////
//  DB Access Components
//  Copyright © 1998-2007 Core Lab. All right reserved.
//  Memory Data Set
//  Created:            01.02.98
//////////////////////////////////////////////////

{$IFNDEF CLR}

{$I Dac.inc}

unit MemDS;
{$ENDIF}
interface
uses
{$IFDEF CLR}
  DB, SysUtils, Classes, MemData, MemUtils{$IFDEF BDE_SHARED}, DBTables{$ENDIF}, Variants,
  System.Runtime.InteropServices, System.Text, System.IO, System.XML;
{$ELSE}
  DB, SysUtils, Classes, MemData, MemUtils{$IFDEF BDE_SHARED}, DBTables{$ENDIF}
  {$IFDEF VER6P}, Variants{$ENDIF}, CRXml, CLRClasses;
{$ENDIF}

const
  uaDefault = 10; // TUpdateAction

type

{ TMemDataSet }

{$IFDEF VER4}

{$IFNDEF BDE_SHARED}
  TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied); // uaDefault
{$ENDIF}

{$ENDIF}

  TUpdateRecordTypes = set of (rtModified, rtInserted, rtDeleted, rtUnmodified);
  TUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
    UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction) of object;
  TUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
    var UpdateAction: TUpdateAction) of object;

{$IFDEF CLR}
  PRecInfo = packed record
  private
    Ptr: IntPtr;

    function GetRecordNumber: longint;
    procedure SetRecordNumber(const Value: longint);
    function GetUpdateStatus: TUpdateStatus;
    procedure SetUpdateStatus(const Value: TUpdateStatus);
    function GetBookmarkFlag: TBookmarkFlag;
    procedure SetBookmarkFlag(const Value: TBookmarkFlag);
    function GetRefComplexFields: boolean;
    procedure SetRefComplexFields(const Value: boolean);

  public
    property RecordNumber: longint read GetRecordNumber write SetRecordNumber;
    property UpdateStatus: TUpdateStatus read GetUpdateStatus write SetUpdateStatus;
    property BookmarkFlag: TBookmarkFlag read GetBookmarkFlag write SetBookmarkFlag;
    property RefComplexFields: boolean read GetRefComplexFields write SetRefComplexFields;

    class operator Implicit(AValue: IntPtr): PRecInfo;
    class operator Implicit(AValue: integer): PRecInfo;
  end;
{$ELSE}
  TRecordBuffer = PChar;
  TValueBuffer = pointer;
  PRecInfo = ^TRecInfo;
{$ENDIF}
  TRecInfo = packed record
    RecordNumber: longint;
    UpdateStatus: TUpdateStatus;
    BookmarkFlag: TBookmarkFlag;
    RefComplexFields: boolean;
  end;

//  TBlobData = string;

  TCalcFieldDescMapping = record
    FieldDesc: TFieldDesc;
    Field: TField;
  end;

  TMemDataSet = class(TDataSet)
  private
    FOldRecBuf: TRecordBuffer;
    FFilterBuffer: TRecordBuffer;
    FCachedUpdates: boolean;
    FLocalUpdate: boolean;
    //FInDeferredPost: boolean; to protected
    FInInserting: boolean;
    FInEditing: boolean;
    FIndexFieldNames: string;
    FCalcFieldsMapping: array of TCalcFieldDescMapping;

    FOnUpdateError: TUpdateErrorEvent;
    FOnUpdateRecord: TUpdateRecordEvent;

    //Renamed LocateRecord (CBuilder5 bug - overloaded methods in different sections):
    function InternalLocateRecord(KeyFields: TDAList; const KeyValues: variant;
      Options: TLocateExOptions; SavePos: boolean): boolean; overload;

    {function GetBlobData(Field:TField; Buffer: PChar):TBlobData;
    procedure SetBlobData(Field:TField; Buffer: PChar; Value:TBlobData);
    procedure ClearBlobCache(Buffer: PChar);}

    procedure SetCachedUpdates(Value: boolean);
    function GetUpdatesPending: boolean;
    function GetPrepared: boolean;
    procedure SetPrepared(Value: boolean);
    function GetUpdateRecordSet: TUpdateRecordTypes;
    procedure SetUpdateRecordSet(Value: TUpdateRecordTypes);
    procedure SetIndexFieldNames(Value: string);

  protected
    Data: TData;  // FIRecordSet

    FBookmarkOfs: longint;
    FRecInfoOfs: longint;
{$IFNDEF CLR}
{$IFNDEF VER10P}
    FWideStringOfs: longint;
{$ENDIF}    
{$ENDIF}
    FRecBufSize: longint;
    FInCacheProcessing: boolean;
    FInDeferredPost: boolean;  // private
    NewCacheRecBuf: TRecordBuffer;
    OldCacheRecBuf: TRecordBuffer;
    OldDeferredPostBuf: TRecordBuffer;
    FParentDataSet: TMemDataSet;
    FLastParentPos: integer;
    FLocalConstraints: boolean;
    FNumberRange: boolean;
    FNeedAddRef: boolean;
    FCacheCalcFields: boolean;
    FCreateCalcFieldDescs: boolean;

    procedure CreateIRecordSet; virtual;
    procedure FreeIRecordSet;
    procedure SetIRecordSet(Value: TData{TRecordSet}); virtual;

  { Open/Close DataSet }
    procedure OpenCursor(InfoQuery: boolean); override;
    procedure CloseCursor; override;

    procedure InternalOpen; override;
    procedure InternalClose; override;
    function IsCursorOpen: boolean; override;
    procedure DataReopen; virtual;
    procedure InternalRefresh; override;
    procedure CheckFieldCompatibility(Field: TField; FieldDef: TFieldDef); override;
    procedure DoAfterOpen; override;

  { Field Management }
    procedure InternalInitFieldDefs; override;
    procedure CreateFieldDefs; virtual;
    procedure ClearCalcFields(Buffer: TRecordBuffer); override;

    function GetObjectFieldDefName(Parent: TFieldDef; Index: integer; ObjType: TObjectType):string; virtual;
    function GetFielDefSize(FieldType: TFieldType; FieldDesc: TFieldDesc): integer; virtual;
    procedure GetObjectTypeNames(Fields: TFields);
    function GetFieldType(DataType: word): TFieldType; overload; virtual;
    function GetFieldType(FieldDesc: TFieldDesc): TFieldType; overload; virtual;
    procedure SetFieldData(Field: TField; Buffer: TValueBuffer); override;
    procedure SetFieldData(Field: TField; Buffer: TValueBuffer; NativeFormat: Boolean); override;
    procedure DataConvert(Field: TField; Source, Dest: TValueBuffer; ToNative: Boolean); override; //TODO
    function GetSparseArrays: boolean;
    procedure SetSparseArrays(Value: boolean);

    procedure SetNumberRange(FieldDef: TFieldDef); virtual;

  { Buffer/Record Management }
    function AllocRecordBuffer: TRecordBuffer; override;
    procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
    procedure CopyRecordBuffer(SrcBuffer: IntPtr; DstBuffer: IntPtr);

    procedure InitRecord(Buffer: TRecordBuffer); override;
    procedure InternalInitRecord(Buffer: TRecordBuffer); override;

    function GetOldRecord: TRecordBuffer;
    function GetActiveRecBuf(var RecBuf: TRecordBuffer): boolean;
    function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: boolean): TGetResult; override;

    procedure BlockReadNext; override;
    procedure SetBlockReadSize(Value: integer); override;
    procedure FreeRefBuffers;
    procedure FreeRefComplexFields(Buffer: TRecordBuffer; WithBlob: boolean = True);

  { Bookmarks }
    procedure GetBookmarkData(Buffer: TRecordBuffer; {$IFDEF CLR}var{$ENDIF} Bookmark: TBookmark); override;
    procedure SetBookmarkData(Buffer: TRecordBuffer; {$IFDEF CLR}const{$ENDIF} Bookmark: TBookmark); override;
    function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
    procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
    //function GetBookmarkStr: TBookmarkStr; override;

  { Navigation }
    procedure InternalFirst; override;
    procedure InternalLast; override;
    procedure InternalGotoBookmark({$IFDEF CLR}const{$ENDIF} Bookmark: TBookmark); override;
    procedure InternalSetToRecord(Buffer: TRecordBuffer); override;

  { Editing }
    procedure InternalAddRecord(Buffer: IntPtr; Append: boolean); override;
    procedure InternalInsert; override;
    procedure InternalDelete; override;
    procedure InternalEdit; override;

    procedure InternalPost; override;
    procedure InternalCancel; override;

    procedure InternalDeferredPost; virtual;

    function PerformAppend: boolean; virtual;
    function PerformDelete: boolean; virtual;
    function PerformUpdate: boolean; virtual;

    procedure DoPerformAppend;
    procedure DoPerformDelete;
    procedure DoPerformUpdate;
    procedure DoGetCachedFields;
    procedure DoGetCachedBuffer(Buffer: IntPtr; Source: IntPtr = nil);

    procedure SetDefaultExpressionValue(Field: TField); virtual;
    procedure DoOnNewRecord; override;

  { Filter/Find/Locate }
    procedure ActivateFilters;
    procedure DeactivateFilters;
    function RecordFilter(RecBuf: IntPtr): boolean;
    procedure SetFilterData(const Text: string; Options:TFilterOptions);

    procedure SetFiltered(Value: boolean); override;
    procedure SetFilterOptions(Value: TFilterOptions); override;
    procedure SetFilterText(const Value: string); override;
    procedure SetOnFilterRecord(const Value: TFilterRecordEvent); override;

    procedure CopyFieldValue(const Value: variant; out ValuePtr: IntPtr; out ValueType: integer; FieldDesc: TFieldDesc); virtual;
    function LocateRecord(const KeyFields: string; const KeyValues: variant;
      Options: TLocateExOptions; SavePos: boolean): boolean; overload;
    function LocateRecord(const KeyFields: array of TField; const KeyValues: variant;
      Options: TLocateExOptions; SavePos: boolean): boolean; overload;
    function FindRecord(Restart, GoForward: boolean): boolean; override;

  { CachedUpdates }
    function BatchUpdate: boolean; virtual;
    function CanFlushBatch: boolean; virtual;
    procedure FlushBatch; virtual;

    procedure CheckCachedUpdateMode;

    procedure DoApplyRecord(UpdateKind: TUpdateRecKind; var Action: TUpdateRecAction; LastItem: boolean);

  { Blobs }
    //Renamed GetBlob (CBuilder5 bug - overloaded methods in different sections):
    function InternalGetBlob(FieldDesc: TFieldDesc): TBlob;
    function InternalSetBlob(FieldDesc: TFieldDesc; Blob: TBlob): boolean;
    function SetBlob(Field: TField; Blob: TBlob): boolean;
    procedure CloseBlob(Field: TField); override;

  { Misc }
    function GetRecordCount: integer; override;
    function GetRecordSize: word; override;

    function GetRecNo: integer; override;
    procedure SetRecNo(Value: integer); override;

    procedure InternalHandleException; override;

    procedure AssignTo(Dest: TPersistent); override;

  {$IFDEF CLR}
    procedure DataEvent(Event: TDataEvent; Info: TObject); override;
  {$ELSE}
    procedure DataEvent(Event: TDataEvent; Info: longint); override;
  {$ENDIF}

    function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; override;

  { XML }
    procedure WriteFieldXMLDataType(Field: TField; FieldDesc: TFieldDesc; const FieldAlias: string;
      XMLWriter: XMLTextWriter); virtual;
    procedure WriteFieldXMLAttributeType(Field: TField; FieldDesc: TFieldDesc; const FieldAlias: string;
      XMLWriter: XMLTextWriter); virtual;
    function GetFieldXMLValue(Field: TField; FieldDesc: TFieldDesc): string; virtual;

  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    procedure Prepare; virtual;
    procedure UnPrepare; virtual;
    procedure CheckPrepared;

  { Fields }
    function GetFieldDescNo(Field: TField): integer;
    function GetFieldDesc(const Field: TField): TFieldDesc; overload; virtual;
    function GetFieldData(Field: TField; Buffer: TValueBuffer): boolean; overload; override;
    //function Translate(const Src: string; var Dest: string; ToOem: boolean): integer; override;

    function GetFieldData(FieldNo: integer; Buffer: TValueBuffer): boolean; overload; override;
    function GetFieldData(Field: TField; Buffer: TValueBuffer; NativeFormat: Boolean): Boolean; override;

    function GetBlob(const FieldName: string): TBlob; overload;
    function GetBlob(Field: TField): TBlob; overload;

  { Edit }
    procedure Cancel; override;
    procedure DeferredPost;

  { Bookmarks }
  {$IFDEF CLR} // TDataSet bug
    function GetBookmark: TBookmark; override;
    procedure FreeBookmark(var Bookmark: TBookmark); override;
  {$ENDIF}
    function BookmarkValid({$IFDEF CLR}const{$ENDIF} Bookmark: TBookmark): boolean; override;
    function CompareBookmarks({$IFDEF CLR}const{$ENDIF} Bookmark1, Bookmark2: TBookmark): integer; override;

    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;

    function Locate(const KeyFields: string; const KeyValues: variant;
      Options: TLocateOptions): boolean; overload; override;
    function Locate(const KeyFields: array of TField; const KeyValues: variant;
      Options: TLocateOptions): boolean; reintroduce; overload; 
    function LocateEx(const KeyFields: string; const KeyValues: variant;
      Options: TLocateExOptions): boolean; overload;
    function LocateEx(const KeyFields: array of TField; const KeyValues: variant;
      Options: TLocateExOptions): boolean; overload;
    function Lookup(const KeyFields: string; const KeyValues: variant;
      const ResultFields: string): variant; override;

  { CachedUpdates }
    function UpdateStatus: TUpdateStatus; override;
    function UpdateResult: TUpdateAction;
    procedure ApplyUpdates; virtual;
    procedure CommitUpdates;
    procedure CancelUpdates;
    procedure RestoreUpdates;
    procedure RevertRecord;

  { XML }
    procedure SaveToXML(Destination: TStream); overload;
    procedure SaveToXML(const FileName: string); overload;
    
    function IsSequenced: boolean; override;

    property Prepared: boolean read GetPrepared write SetPrepared;
    property CachedUpdates: boolean read FCachedUpdates write SetCachedUpdates default False;
    property UpdatesPending: boolean read GetUpdatesPending;
    property LocalUpdate: boolean read FLocalUpdate write FLocalUpdate default False;
    property UpdateRecordTypes: TUpdateRecordTypes read GetUpdateRecordSet write SetUpdateRecordSet;
    property SparseArrays: boolean read GetSparseArrays write SetSparseArrays;

  // obsolete
    property LocalConstraints: boolean read FLocalConstraints write FLocalConstraints default True;

    property OnUpdateError: TUpdateErrorEvent read FOnUpdateError write FOnUpdateError;
    property OnUpdateRecord: TUpdateRecordEvent read FOnUpdateRecord write FOnUpdateRecord;
    property IndexFieldNames: string read FIndexFieldNames write SetIndexFieldNames;
  end;

{ TBlobStream }

  TBlobStream = class(TStream)
  protected
    FField: TBlobField;
    FDataSet: TMemDataSet;
    FBuffer: TRecordBuffer;
    FMode: TBlobStreamMode;
    FFieldNo: integer;
    FOpened: boolean;
    FModified: boolean;
    FPosition: longint;
    function GetBlobSize: Longint;

  protected
  {$IFDEF CLR}
    procedure SetSize(NewSize: Int64); override;
  {$ELSE}
    procedure SetSize(NewSize: Longint); override;
  {$ENDIF}
  public
    constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
    destructor Destroy; override;
  {$IFDEF CLR}
    function Read(var Buffer: TBytes; Offset, Count: Longint): Longint; override;
    function Write(const Buffer: TBytes; Offset, Count: Longint): Longint; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
  {$ELSE}
    function Read(var Buffer; Count: longint): longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
  {$ENDIF}
    procedure Truncate;
  end;

  TMemDSUtils = class
  public
    class function SetBlob(Obj: TMemDataSet; Field: TField; Blob: TBlob): boolean;
    class function GetBlob(Obj: TMemDataSet; FieldDesc: TFieldDesc): TBlob;
  end;

  function GetFieldType(DataType: word): TFieldType;
  function GetDataType(FieldType: TFieldType): word;

  function ChangeDecimalSeparator(const Value: string; OldSeparator, NewSeparator: string): string;

  function XMLEncode(const AStr: String): String;

implementation

uses
{$IFDEF VER6P}
  DateUtils,FmtBcd,
{$ENDIF}
  DBConsts, DAConsts, Math{$IFDEF MSWINDOWS}, Windows{$ENDIF};

const
{$IFDEF VER4}
  DataTypeMap: array [TFieldType] of word = (
    // ftUnknown, ftString, ftSmallint, ftInteger, ftWord
    dtUnknown, dtString, dtInt16, dtInteger, dtUInt16,
    // ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
    dtBoolean, dtFloat, dtCurrency, dtBCD, dtDate, dtTime, dtDateTime,
    // ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
    dtBytes, dtVarBytes, dtInteger, dtBlob, dtMemo, 0, 0,
    // ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,
    0, 0, 0, 0, dtString, dtWideString,
    // ftLargeint, ftADT, ftArray, ftReference, ftDataSet
    dtInt64, dtObject, dtArray, dtReference, dtTable);
{$ENDIF}
{$IFDEF VER5}
  DataTypeMap: array [TFieldType] of word = (
    // ftUnknown, ftString, ftSmallint, ftInteger, ftWord
    dtUnknown, dtString, dtInt16, dtInteger, dtUInt16,
    // ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
    dtBoolean, dtFloat, dtCurrency, dtBCD, dtDate, dtTime, dtDateTime,
    // ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
    dtBytes, dtVarBytes, dtInteger, dtBlob, dtMemo, 0, 0,
    // ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,
    0, 0, 0, 0, dtString, dtWideString,
    // ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,
    dtInt64, dtObject, dtArray, dtReference, dtTable, 0, 0,
    // ftVariant, ftInterface, ftIDispatch, ftGuid
    dtVariant, 0, 0, dtGuid);
{$ENDIF}
{$IFDEF VER6P}
{$IFNDEF VER10P}
  DataTypeMap: array [TFieldType] of word = (
    // ftUnknown, ftString, ftSmallint, ftInteger, ftWord
    dtUnknown, dtString, dtInt16, dtInteger, dtUInt16,
    // ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
    dtBoolean, dtFloat, dtCurrency, dtBCD, dtDate, dtTime, dtDateTime,
    // ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
    dtBytes, dtVarBytes, dtInteger, dtBlob, dtMemo, 0, 0,
    // ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,
    0, 0, 0, 0, dtString, dtWideString,
    // ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,
    dtInt64, dtObject, dtArray, dtReference, dtTable, 0, 0,
    // ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd
    dtVariant, 0, 0, dtGuid, 0, dtFmtBCD);
{$ENDIF}
{$ENDIF}

{$IFDEF VER10P}
  DataTypeMap: array [TFieldType] of word = (
    // ftUnknown, ftString, ftSmallint, ftInteger, ftWord
    dtUnknown, dtString, dtInt16, dtInteger, dtUInt16,
    // ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
    dtBoolean, dtFloat, dtCurrency, dtBCD, dtDate, dtTime, dtDateTime,
    // ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
    dtBytes, dtVarBytes, dtInteger, dtBlob, dtMemo, 0, 0,
    // ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,
    0, 0, 0, 0, dtString, dtWideString,
    // ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,
    dtInt64, dtObject, dtArray, dtReference, dtTable, 0, 0,
    // ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, ftFixedWideChar
    dtVariant, 0, 0, dtGuid, 0, dtFmtBCD, dtWideString,
    // ftWideMemo, ftOraTimeStamp, ftOraInterval
    dtWideMemo, 0, 0);
{$ENDIF}

function GetFieldType(DataType: word): TFieldType;
begin
  case DataType of
    dtUnknown:
      Result := ftUnknown;
    dtString:
      Result := ftString;
    dtWideString:
      Result := ftWideString;
    dtInt8:
      Result := ftSmallint;
    dtInt16:
      Result := ftSmallint;
    dtWord:
      Result := ftWord;
    dtInteger:
      Result := ftInteger;
    dtUInt32:
      Result := ftLargeInt;
    dtLargeint:
      Result := ftLargeInt;
    dtFloat:
      Result := ftFloat;
    dtDate:
      Result := ftDate;
    dtTime:
      Result := ftTime;
    dtDateTime:
      Result := ftDateTime;
    dtMemo:
      Result := ftMemo;
    dtWideMemo:
      Result := {$IFDEF VER10P}ftWideMemo;{$ELSE}ftMemo;{$ENDIF}
    dtBlob:
      Result := ftBlob;
    dtObject:
      Result := ftADT;
    dtReference:
      Result := ftReference;
    dtArray:
      Result := ftArray;
    dtTable:
      Result := ftDataSet;
    dtBoolean:
      Result := ftBoolean;
  {$IFDEF VER5P}
    dtVariant:
      Result := ftVariant;
  {$ENDIF}
    dtExtString:
      Result := ftString;
    dtExtWideString:
      Result := ftWideString;
    dtBytes:
      Result := ftBytes;
    dtVarBytes:
      Result := ftVarBytes;
    dtExtVarBytes:
      Result := ftVarBytes;
    dtBCD:
      Result := ftBCD;
  {$IFDEF VER6P}
    dtFmtBCD:
      Result := ftFMTBcd;
  {$ENDIF}
    dtGuid:
      Result := ftGuid;
    dtCurrency:
      Result := ftCurrency;
  else
    Assert(False, SUnknownDataType);
    Result := ftUnknown;
  end;
end;

function GetDataType(FieldType: TFieldType): word;
begin
  Result := DataTypeMap[FieldType];
end;

{$IFDEF CLR}
{ PRecInfo }

function PRecInfo.GetRecordNumber: longint;
begin
  Result := Marshal.ReadInt32(Ptr);
end;

procedure PRecInfo.SetRecordNumber(const Value: longint);
begin
  Marshal.WriteInt32(Ptr, Value);
end;

function PRecInfo.GetUpdateStatus: TUpdateStatus;
begin
  Result := TUpdateStatus(Marshal.ReadByte(Ptr, sizeof(longint)));
end;

procedure PRecInfo.SetUpdateStatus(const Value: TUpdateStatus);
begin
  Marshal.WriteByte(Ptr, sizeof(longint), byte(Value));
end;

function PRecInfo.GetBookmarkFlag: TBookmarkFlag;
begin
  Result := TBookmarkFlag(Marshal.ReadByte(Ptr, sizeof(integer) + sizeof(TUpdateStatus)));
end;

procedure PRecInfo.SetBookmarkFlag(const Value: TBookmarkFlag);
begin
  Marshal.WriteByte(Ptr, sizeof(integer) + sizeof(TUpdateStatus), byte(Value));
end;

function PRecInfo.GetRefComplexFields: boolean;
begin
  Result := boolean(Marshal.ReadByte(Ptr, sizeof(integer) + sizeof(TUpdateStatus)
   + sizeof(TBookmarkFlag)));
end;

procedure PRecInfo.SetRefComplexFields(const Value: boolean);
begin
  Marshal.WriteByte(Ptr, sizeof(integer) + sizeof(TUpdateStatus)
   + sizeof(TBookmarkFlag), byte(Value));
end;

class operator PRecInfo.Implicit(AValue: IntPtr): PRecInfo;
begin
  Result.Ptr := AValue;
end;

class operator PRecInfo.Implicit(AValue: integer): PRecInfo;
begin
  Result.Ptr := IntPtr(AValue);
end;
{$ENDIF}

{ TMemDataSet }

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

  FLocalConstraints := True;
  FCreateCalcFieldDescs := True;

  CreateIRecordSet;
end;

destructor TMemDataSet.Destroy;
begin
  inherited;

  UnPrepare;

  FreeIRecordSet;
end;

procedure TMemDataSet.CreateIRecordSet;
begin
  SetIRecordSet(TMemData.Create);
end;

procedure TMemDataSet.FreeIRecordSet;
begin
  Data.Free;
end;

procedure TMemDataSet.SetIRecordSet(Value: TData);
begin
  Data := Value;

  if Data <> nil then begin
    Data.CachedUpdates := FCachedUpdates;
    Data.OnAppend := DoPerformAppend;
    Data.OnDelete := DoPerformDelete;
    Data.OnUpdate := DoPerformUpdate;
    Data.OnApplyRecord := DoApplyRecord;
    if FCreateCalcFieldDescs then begin
      TMemData(Data).OnGetCachedFields := DoGetCachedFields;
      TMemData(Data).OnGetCachedBuffer := DoGetCachedBuffer;
    end;  
  end;
end;

{ Open/Close DataSet }

procedure TMemDataSet.Prepare;
begin
  if not Prepared then begin
    Data.Prepare;
    CreateFieldDefs;
  end;
end;

procedure TMemDataSet.UnPrepare;
begin
  if Active then
    Close;

  Data.UnPrepare;

  if not (csDestroying in ComponentState) then // This line may be called after destroing FieldDefs. For details see TMemDataSet.Destroy
    FieldDefs.Updated := False;
end;

procedure TMemDataSet.CheckPrepared;
begin
  if not Prepared then
    DatabaseError(SDataSetIsNotPrepared);
end;

procedure TMemDataSet.InternalOpen;
var
  Field: TField;
  i: integer;
begin
  Data.Open;

  CreateFieldDefs;

  // Update FieldDefs once to avoid multiple Update calls when working with FieldDefsList
  // (Perfomance optimization)
//  FieldDefs.Updated := False;
//  FieldDefs.Update;

  if DefaultFields then
    CreateFields
  else // Setting actual size
    for i := 0 to FieldDefs.Count - 1 do
      if FieldDefs[i].DataType = ftString then begin
        Field := FindField(FieldDefs[i].Name);
        if (Field <> nil) and (Field.FieldKind = fkData) then begin
          CheckFieldCompatibility(Field, FieldDefs[i]);
          Field.Size := FieldDefs[i].Size;
        end;
      end;

  // Set number specific
  if FNumberRange then
    for i := 0 to FieldDefs.Count - 1 do
      SetNumberRange(FieldDefs[i]);

  BindFields(True);

  if (Data.Fields.Count > 0) and (Data.Fields[Data.Fields.Count - 1].FieldDescKind = fdkCached) then
    TMemData(Data).UpdateCachedBuffer(nil, nil);

  if ObjectView then
    GetObjectTypeNames(Fields);

  if (Data is TMemData) and (TMemData(Data).IndexFields.Count > 0) then
    TMemData(Data).SortItems;

  BookmarkSize := SizeOf(TRecBookmark);

  //FBlobCacheOfs := Data.RecordSize + CalcFieldsSize;
  if not FCreateCalcFieldDescs then
    FRecInfoOfs := Data.RecordSize + CalcFieldsSize
  else
    if FCacheCalcFields then
      FRecInfoOfs := Data.RecordSize
    else
      FRecInfoOfs := Data.RecordSize + Data.CalcRecordSize; //FBlobCacheOfs + BlobFieldCount * SizeOf(Pointer);

  FBookmarkOfs := FRecInfoOfs + SizeOf(TRecInfo);
  FRecBufSize := FBookmarkOfs + BookmarkSize;

{$IFNDEF CLR}
{$IFNDEF VER10P}
  if not FCreateCalcFieldDescs then begin
    FWideStringOfs := FRecBufSize;

    if CalcFieldsSize > 0 then
      for i := 0 to Fields.Count - 1 do
        if (Fields[i].DataType = ftWideString) and (Fields[i].FieldKind in [fkCalculated, fkLookUp]) then
          FRecBufSize := FRecBufSize + (Fields[i].Size + 1) * sizeof(WideChar);
  end;
{$ENDIF}
{$ENDIF}

  FInCacheProcessing := False;

  if Filtered then begin
    ActivateFilters;
    Data.FilterUpdated;
  end;
end;

function TMemDataSet.IsCursorOpen: boolean;
begin
  Result := Data.Active;
end;

procedure TMemDataSet.InternalClose;
begin
  BindFields(False);
  if DefaultFields then
    DestroyFields;

  Data.Close;
end;

procedure TMemDataSet.OpenCursor(InfoQuery: boolean);
begin
  inherited;

  if not InfoQuery then begin
    if FOldRecBuf <> nil then begin
      FreeRecordBuffer(FOldRecBuf);
      FOldRecBuf := nil;
    end;

    FOldRecBuf := AllocRecordBuffer;
  end;
  //DataEvent(deDataSetChange, 0); // Notify nested datasets // DEBUG
end;

procedure TMemDataSet.CloseCursor;
var
  Buffer: IntPtr;
  RecInfo: PRecInfo;
begin
// free complex fields if call Close in dsInsert or dsEdit mode
// TDataSet.Close doesn't call Cancel
  if Data.HasComplexFields then begin
    if FInInserting then begin
      Buffer := ActiveBuffer;
      RecInfo := PRecInfo(integer(Buffer) + FRecInfoOfs);
      if RecInfo.RefComplexFields then begin
        Data.FreeComplexFields(Buffer, True);
        RecInfo.RefComplexFields := False;
      end;
    end;
    if FInEditing then begin
      Buffer := ActiveBuffer;
      RecInfo := PRecInfo(integer(Buffer) + FRecInfoOfs);
      if RecInfo.RefComplexFields then begin
        Data.FreeComplexFields(Buffer, False); // Blobs isn't created
        RecInfo.RefComplexFields := False;
      end;
    end;

    if FInInserting then
      Data.FreeComplexFields(ActiveBuffer, True);
    if FInEditing then
      Data.FreeComplexFields(ActiveBuffer, False); // Blobs isn't created

    FInInserting := False;
    FInEditing := False;
  end;

  if FOldRecBuf <> nil then begin
    FreeRecordBuffer(FOldRecBuf);
    FOldRecBuf := nil;
  end;

  try
    inherited;
  finally
    FParentDataSet := nil;
  end;
end;

procedure TMemDataSet.DataReopen;
begin
  Data.Reopen;
end;

procedure TMemDataSet.InternalRefresh;
begin
  FreeRefBuffers;
  //ClearBuffers; /// CR11512
  DataReopen;
  if (Data is TMemData) and (TMemData(Data).IndexFields.Count > 0) then
    TMemData(Data).SortItems;
end;

procedure TMemDataSet.CheckFieldCompatibility(Field: TField; FieldDef: TFieldDef);
begin
  with Field do
  begin
  {$IFDEF VER6P}
    if (DataType <= ftFMTBcd) and (FieldDef.DataType <= ftFMTBcd) then
  {$ELSE}
    if (DataType <= ftGuid) and (FieldDef.DataType <= ftGuid) then
  {$ENDIF}
      inherited CheckFieldCompatibility(Field, FieldDef)
    else
      if DataType <> FieldDef.DataType then
        DatabaseErrorFmt(SFieldTypeMismatch, [DisplayName,
          FieldTypeNames[DataType], FieldTypeNames[FieldDef.DataType]], Self);
  end;
end;

procedure TMemDataSet.DoAfterOpen;
var
  i: integer;
begin
  inherited;

  for i := 0 to NestedDataSets.Count - 1 do
    with TDataSet(NestedDataSets[i]) do
      if Active then
        DataEvent(deParentScroll, {$IFDEF CLR}nil{$ELSE}0{$ENDIF});
end;

procedure TMemDataSet.FreeRefBuffers;
var
  i: integer;
begin
  if FNeedAddRef then
    for i := 0 to BufferCount do
      FreeRefComplexFields(Buffers[i]);
  FreeRefComplexFields(TempBuffer);
end;

procedure TMemDataSet.FreeRefComplexFields(Buffer: TRecordBuffer; WithBlob: boolean);
var
  RecInfo: PRecInfo;
begin
  RecInfo := PRecInfo(integer(Buffer) + FRecInfoOfs);
  if RecInfo.RefComplexFields then begin
    Data.FreeComplexFields(Buffer, WithBlob);
    RecInfo.RefComplexFields := False;
  end;
end;

{ Field Management }

procedure TMemDataSet.InternalInitFieldDefs;
var
  CheckDefs: boolean;
  i: integer;
  OldFieldNames: array of string;
  OldFieldCount: integer;

begin
  // can't CreateFieldDefs if FieldDefs.Update(InitFieldDefs)
  if not Data.Active then begin
    OldFieldCount := Data.Fields.Count;
    CheckDefs := (FieldDefs <> nil) and not FieldDefs.Updated;
    if CheckDefs then begin
      SetLength(OldFieldNames, OldFieldCount);
      for i := 0 to OldFieldCount - 1 do
        OldFieldNames[i] := Data.Fields[i].Name;
    end;

    Data.InitFields;

    if OldFieldCount <> Data.Fields.Count then
      FieldDefs.Updated := False
    else
      if CheckDefs then
        for i := 0 to OldFieldCount - 1 do
          if OldFieldNames[i] <> Data.Fields[i].Name then begin
            FieldDefs.Updated := False;
            Break;
          end;

    CreateFieldDefs;
  end;
end;

function TMemDataSet.GetFieldType(DataType: word): TFieldType;
begin
  Result := {$IFDEF CLR}CoreLab.Dac.{$ENDIF}MemDS.GetFieldType(DataType);
end;

function TMemDataSet.GetFieldType(FieldDesc: TFieldDesc): TFieldType;
begin
  Result := GetFieldType(FieldDesc.DataType);
end;

function TMemDataSet.GetObjectFieldDefName(Parent: TFieldDef; Index: integer; ObjType: TObjectType):string;
begin
  Result := IntToStr(Index);
end;

function TMemDataSet.GetFielDefSize(FieldType: TFieldType; FieldDesc: TFieldDesc): integer;
begin
  Result := 0;
  case FieldType of
    ftString, ftWideString{$IFDEF VER5P},ftGuid{$ENDIF}: begin
      Result := FieldDesc.Length;
      if Result = 0 then
        Result := 1;  // For SELECT NULL FROM ...
    end;
    ftBytes, ftVarBytes:
      Result := FieldDesc.Length;
  end;
end;

procedure TMemDataSet.CreateFieldDefs;

  function GetFieldName(ParentFieldName, FieldName: string; Index: integer): string;
  var
    NewFieldName: string;
  begin
    if Index = 0 then
      NewFieldName := FieldName
    else
      NewFieldName := FieldName + '_' + IntToStr(Index);

    if (FieldDefs.IndexOf(ParentFieldName + '.' + NewFieldName) <> -1) then
      Result := GetFieldName(ParentFieldName, FieldName, Index + 1)
    else
      Result := NewFieldName;
  end;

  procedure CreateObjectFields(ObjType: TObjectType; Parent: TFieldDef);
  var
    i: integer;
    FieldDef: TFieldDef;
    FieldType: TFieldType;
    aSize: word;
    Item,CountItem: integer;
    FieldName: string;
  begin
    if (ObjType.DataType = dtObject) or SparseArrays then
      CountItem := 1
    else begin
      CountItem := ObjType.Size;
      if CountItem > MaxArrayItem then // Restriction of array length
        CountItem := MaxArrayItem;
    end;

    for i := 0 to ObjType.AttributeCount - 1 do begin
      for Item := 0 to CountItem - 1 do begin
        with ObjType.Attributes[i] do begin
          FieldType := GetFieldType(DataType);

          aSize := 0;
          case FieldType of
            ftString:
              aSize := Length;
          end;

          FieldDef := TFieldDef.Create(Parent.ChildDefs);
          if ObjType.DataType = dtObject then
            FieldName := Name
          else
            FieldName := GetObjectFieldDefName(Parent, Item, ObjType);
          FieldDef.Name := GetFieldName(Parent.Name, FieldName, 0);

          FieldDef.DataType := FieldType;
          FieldDef.Size := aSize;
          FieldDef.Required := False;
          if DB.faReadonly in Parent.Attributes then
            FieldDef.Attributes := FieldDef.Attributes + [DB.faReadonly];

          if FieldType in [ftADT,ftArray] then
            CreateObjectFields(ObjectType, FieldDef);
        end;
      end;
    end;
  end;

var
  FieldType: TFieldType;
  aSize: word;
  i: integer;
  FieldDef: TFieldDef;
begin
  if FieldDefs.Updated then Exit;
  FieldDefs.BeginUpdate;
  try
    FieldDefs.Clear;
    for i := 0 to Data.FieldCount - 1 do
      with Data.Fields[i] do
        if not HiddenObject and (FieldDescKind = fdkData) and (not HasParent or ParentField.HiddenObject) then begin
        // FieldNo 1..
          FieldType := GetFieldType(Data.Fields[i]);
          aSize := GetFielDefSize(FieldType, Data.Fields[i]);
          if FieldType <> ftUnknown then begin
            FieldDef := TFieldDef.Create(FieldDefs, Name, FieldType, aSize,
              Required and FLocalConstraints, i + 1);

            if ReadOnly then
              FieldDef.Attributes := FieldDef.Attributes + [DB.faReadonly];

            if FieldType in [ftFloat, ftInteger] then
              FieldDef.Precision := Length
            else
            if FieldType in [ftBCD{$IFDEF VER6P}, ftFMTBCD{$ENDIF}] then begin
              FieldDef.Precision := Length;
              FieldDef.Size := Scale;
            end
            else
              if FieldType in [ftADT, ftArray] then
                CreateObjectFields(ObjectType, FieldDef);

            if Hidden then
              FieldDef.Attributes := FieldDef.Attributes + [DB.faHiddenCol];
          {$IFDEF VER5P}
            if Fixed then
              FieldDef.Attributes := FieldDef.Attributes + [DB.faFixed];
          {$ENDIF}
          end;
        end;
  finally
    FieldDefs.EndUpdate;
  end;
  FieldDefList.Update;
  FieldDefs.Updated := True;
end;

procedure TMemDataSet.GetObjectTypeNames(Fields: TFields);
var
  i: integer;
  ObjectField: TObjectField;
begin
  for i := 0 to Fields.Count - 1 do
    if Fields[i] is TObjectField then begin
      ObjectField := TObjectField(Fields[i]);

      ObjectField.ObjectType := Data.Fields[Fields[i].FieldNo - 1].ObjectType.Name;

      with ObjectField do
        if DataType in [ftADT, ftArray] then begin
          if (DataType = ftArray) and SparseArrays and
           (Fields[0].DataType = ftADT)
          then
            GetObjectTypeNames(TObjectField(Fields[0]).Fields)
          else
            GetObjectTypeNames(Fields);
        end;
    end
end;

function TMemDataSet.GetFieldDescNo(Field: TField): integer;
var
  FieldDesc: TFieldDesc;
begin
  FieldDesc := GetFieldDesc(Field);
  if FieldDesc <> nil then
    Result := FieldDesc.FieldNo
  else
    raise Exception.Create(Format(SFieldNotFound, [Field.FieldName]));
end;

function TMemDataSet.GetFieldDesc(const Field: TField): TFieldDesc;
var
  FieldDesc: TFieldDesc;
  i: integer;
  Found: boolean;
begin
  Assert(Data <> nil, 'FIRecordSet must be setted to this time');
  Assert(Field <> nil, 'Field cannot be nil');
  Assert((Field.DataSet = Self) or (Field.DataSet = nil {CR 22356}), 'Wrong DataSet');
  {if Field.DataSet <> Self then
    for i := 0 to Data.FieldCount - 1 do
      if AnsiLowerCase(Field.FieldName) = AnsiLowerCase(Data.Fields[i].Name) then begin /// Field.FieldName must be equal with FieldDesc.Name
        Result := Data.Fields[i];
        Exit;
      end;}

  Result := nil;
  if Field.FieldNo > 0 then
    Result := TFieldDesc(Data.Fields[Field.FieldNo - 1])
  else
  begin
    if DefaultFields and (Fields.Count = Data.Fields.Count {just in case; should be moved to Assert}) then begin
      i := Fields.IndexOf(Field);
      Result := Data.Fields[i];
    end
    else
      for i := 0 to Data.FieldCount - 1 do begin
        FieldDesc := Data.Fields[i];
        Found := AnsiLowerCase(Field.FieldName) = AnsiLowerCase(FieldDesc.Name); /// Field.FieldName must be equal with FieldDesc.Name
        if (Field.FieldKind <> fkData) then begin
          if FieldDesc.FieldDescKind = fdkData then
            Found := False
          else
          if not Found then
            Found := AnsiLowerCase(Field.FieldName) = AnsiLowerCase(FieldDesc.ActualName);
        end;
        if Found then begin
          Result := FieldDesc;
          Break;
        end;
      end;
  end;
  // Assert(AnsiLowerCase(Field.FieldName) = AnsiLowerCase(Result.Name), Format('Field.FieldName <> FieldDesc.Name' + LineSeparator + '"%s" <> "%s"' + LineSeparator, [Field.FieldName, Result.Name]));
end;

function TMemDataSet.GetFieldData(Field: TField; Buffer: TValueBuffer): boolean;
var
  IsBlank: boolean;
  RecBuf: TRecordBuffer;
  FieldBuf: IntPtr;
{$IFNDEF CLR}
{$IFNDEF VER10P}
  DataOffset: LongInt;
{$ENDIF}  
{$ENDIF}
  i: integer;
  FieldDesc: TFieldDesc;
begin
  Result := False;
  if not GetActiveRecBuf(RecBuf) then
    Exit;

  with Field do
    if FieldNo > 0 then begin
      Data.GetField(FieldNo, RecBuf, Buffer, IsBlank);
      Result := not IsBlank;
    end
    else
      if State in  [dsBrowse, dsEdit, dsInsert, dsCalcFields, dsFilter, dsBlockRead] then
        if FCreateCalcFieldDescs then begin
          FieldDesc := nil;
          for i := 0 to Length(FCalcFieldsMapping) - 1 do
            if FCalcFieldsMapping[i].Field = Field then begin
              FieldDesc := FCalcFieldsMapping[i].FieldDesc;
              break;
            end;
          if FieldDesc <> nil then
            Data.GetField(FieldDesc.FieldNo, RecBuf, Buffer, IsBlank)
          else
            Data.GetField(GetFieldDescNo(Field), RecBuf, Buffer, IsBlank);
          Result := not IsBlank;
        end
        else begin
          FieldBuf := IntPtr(integer(RecBuf) + RecordSize + Offset);
          Result := Boolean(Marshal.ReadByte(FieldBuf));
          if Result and (Buffer <> nil) then
          {$IFNDEF CLR}
          {$IFNDEF VER10P}
            if Field.DataType = ftWideString then begin
              DataOffset := Integer(IntPtr(Integer(FieldBuf) + 1)^);
              CopyBuffer(IntPtr(Integer(RecBuf) + FWideStringOfs + DataOffset), Buffer, (Size + 1) * SizeOf(WideChar));
            end
            else
          {$ENDIF}
          {$ENDIF}
              CopyBuffer(IntPtr(integer(FieldBuf) + 1), Buffer, DataSize);
        end;
end;

function TMemDataSet.GetFieldData(FieldNo: integer; Buffer: TValueBuffer): boolean;
var
  IsBlank: boolean;
  RecBuf: TRecordBuffer;
begin
//if BlockReadSize > 0 then

  Result := GetActiveRecBuf(RecBuf);
  if Result then begin
    Data.GetField(FieldNo, RecBuf, Buffer, IsBlank);
    Result := not IsBlank;
  end
end;

procedure TMemDataSet.SetFieldData(Field: TField; Buffer: TValueBuffer);
var
  RecBuf: TRecordBuffer;
  FieldBuf: IntPtr;
{$IFNDEF CLR}
{$IFNDEF VER10P}
  DataOffset, WideStringSize: integer;
{$ENDIF}
{$ENDIF}
  FieldDesc: TFieldDesc;
  i: integer;
begin
  with Field do begin
    if not (State in dsWriteModes) then
      DatabaseError(SNotEditing);
    GetActiveRecBuf(RecBuf);
    if FieldNo > 0 then begin
      if State = dsCalcFields then
        DatabaseError(SNotEditing);
      if ReadOnly and not (State in [dsSetKey, dsFilter]) then
        DatabaseErrorFmt(SFieldReadOnly, [DisplayName]);
      Validate(Buffer);
      if FieldKind <> fkInternalCalc then begin
        Data.PutField(FieldNo, RecBuf, Buffer);
      end;
    end
    else
      if FCreateCalcFieldDescs then begin
        FieldDesc := nil;
        for i := 0 to Length(FCalcFieldsMapping) - 1 do
          if FCalcFieldsMapping[i].Field = Field then begin
            FieldDesc := FCalcFieldsMapping[i].FieldDesc;
            break;
          end;
        if FieldDesc <> nil then
          Data.PutField(FieldDesc.FieldNo, RecBuf, Buffer)
        else
          Data.PutField(GetFieldDescNo(Field), RecBuf, Buffer);
      end
      else begin
        FieldBuf := IntPtr(integer(RecBuf) + RecordSize + Offset);
        Marshal.WriteByte(FieldBuf, Integer(Integer(Buffer) <> 0) );
        if Integer(Buffer) <> 0 then
        {$IFNDEF CLR}
        {$IFNDEF VER10P}
          if Field.DataType = ftWideString then begin
            WideStringSize := Length(WideString(Buffer^)) * Sizeof(WideChar);
            DataOffset := Integer(IntPtr(integer(FieldBuf) + 1)^);

            CopyBuffer(Pointer(Buffer^), IntPtr(Integer(RecBuf) + FWideStringOfs + DataOffset), WideStringSize);
            Marshal.WriteInt16(IntPtr(Integer(RecBuf) + FWideStringOfs + DataOffset + WideStringSize), 0);
          end
          else
        {$ENDIF}
        {$ENDIF}
            CopyBuffer(Buffer, IntPtr(integer(FieldBuf) + 1), DataSize);
      end;

    if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
    {$IFDEF CLR}
      DataEvent(deFieldChange, Field);
    {$ELSE}
      DataEvent(deFieldChange, longint(Field));
    {$ENDIF}
  end;
end;

function TMemDataSet.GetFieldData(Field: TField; Buffer: TValueBuffer;
  NativeFormat: Boolean): Boolean;
{$IFNDEF CLR}
{$IFNDEF VER10P}
var
  Temp: PWideChar;
{$ENDIF}
{$ENDIF}
begin
  if (Field.DataType = ftWideString) and (Buffer <> nil) then begin
  {$IFDEF CLR}
    Result := inherited GetFieldData(Field, Buffer, True);
  {$ELSE}
    {$IFDEF VER10P}
      Result := inherited GetFieldData(Field, Buffer, True);
    {$ELSE}
      { Cannot copy direct - may be conflict with Delphi string manager
      SetLength(WideString(Buffer^), Field.Size * sizeof(WideChar));
      Result := inherited GetFieldData(Field, PWideChar(WideString(Buffer^)), True);}
      GetMem(Temp, (Field.Size + 1 {#0} + 8) * sizeof(WideChar));//+ 8 for numbers
      try
        Result := inherited GetFieldData(Field, Temp, True);
        if Result then
          WideString(Buffer^) := Temp
        else
          WideString(Buffer^) := '';
      finally
        FreeMem(Temp);
      end;
    {$ENDIF}
  {$ENDIF}
  end
  else
    Result := inherited GetFieldData(Field, Buffer, NativeFormat);
end;

procedure TMemDataSet.SetFieldData(Field: TField; Buffer: TValueBuffer; NativeFormat: Boolean);
begin
  if Field is TWideStringField then begin
    //Assert(Buffer <> nil);
    inherited SetFieldData(Field, Buffer, True);
  end
  else
    inherited SetFieldData(Field, Buffer, NativeFormat);
end;

function TMemDataSet.GetStateFieldValue(State: TDataSetState; Field: TField): Variant;
begin
  if ((Self.State = dsInsert) and (State = dsOldValue)) or (State = dsInsert) then
    Result := NULL
  else
    Result := inherited GetStateFieldValue(State, Field);
end;

procedure TMemDataSet.DataConvert(Field: TField; Source, Dest: TValueBuffer; ToNative: Boolean);
{$IFDEF CLR}
var
  TimeStamp: TTimeStamp;
  TempDouble: Double;
{$ENDIF}
begin
  case Field.DataType of
  {$IFDEF CLR}
    ftDate:
      if ToNative then
      begin
        TimeStamp := DateTimeToTimeStamp(
          BitConverter.Int64BitsToDouble(Marshal.ReadInt64(Source)));
        Marshal.WriteInt32(Dest, TimeStamp.Date);
      end
      else
      begin
        TimeStamp.Time := 0;
        TimeStamp.Date := Marshal.ReadInt32(Source);
        Marshal.WriteInt64(Dest,
          BitConverter.DoubleToInt64Bits(MemUtils.TimeStampToDateTime(TimeStamp)));
      end;
    ftTime:
      if ToNative then
      begin
        TimeStamp := DateTimeToTimeStamp(
          BitConverter.Int64BitsToDouble(Marshal.ReadInt64(Source)));
        Marshal.WriteInt32(Dest, TimeStamp.Time);
      end
      else
      begin
        TimeStamp.Time := Marshal.ReadInt32(Source);
        TimeStamp.Date := DateDelta;
        Marshal.WriteInt64(Dest,
          BitConverter.DoubleToInt64Bits(MemUtils.TimeStampToDateTime(TimeStamp)));
      end;
    ftDateTime:
      if ToNative then
      begin
        TempDouble := TimeStampToMSecs(DateTimeToTimeStamp(
          BitConverter.Int64BitsToDouble(Marshal.ReadInt64(Source))));
        Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(TempDouble));
      end
      else
      begin
        TimeStamp := MSecsToTimeStamp(
          Trunc(BitConverter.Int64BitsToDouble(Marshal.ReadInt64(Source))));
        Marshal.WriteInt64(Dest,
          BitConverter.DoubleToInt64Bits(MemUtils.TimeStampToDateTime(TimeStamp)));
      end;
{$ENDIF}
    ftBCD:
      Marshal.WriteInt64(Dest, Marshal.ReadInt64(Source));
  else
    inherited DataConvert(Field, Source, Dest, ToNative);
  end;
end;

function TMemDataSet.GetSparseArrays: boolean;
begin
  Result := inherited SparseArrays;
end;

procedure TMemDataSet.SetSparseArrays(Value: boolean);
begin
  if SparseArrays <> Value then begin
    UnPrepare;

    inherited SparseArrays := Value;

    if Data <> nil then
      Data.SparseArrays := Value;
  end;
end;

function TMemDataSet.InternalGetBlob(FieldDesc: TFieldDesc): TBlob;
var
  RecBuf: TRecordBuffer;
  Ptr: IntPtr;
  IsBlank: boolean;
begin
  Ptr := Marshal.AllocHGlobal(sizeof(IntPtr));
  try
    if GetActiveRecBuf(RecBuf) then begin
      if not Data.IsBlobFieldType(FieldDesc.DataType) then
        DatabaseError(SNeedBlobType);

      Data.GetField(FieldDesc.FieldNo, RecBuf, Ptr, IsBlank);
      Result := TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(Ptr)));
    end
    else
      Result := nil;
  finally
    Marshal.FreeHGlobal(Ptr);
  end;
end;

function TMemDataSet.GetBlob(const FieldName: string): TBlob;
var
  FieldDesc: TFieldDesc;
begin
  FieldDesc := Data.FieldByName(FieldName);
  Result := InternalGetBlob(FieldDesc);
end;

function TMemDataSet.GetBlob(Field: TField): TBlob;
var
  FieldDesc: TFieldDesc;
begin
  if Field <> nil then begin
    FieldDesc := GetFieldDesc(Field);
    if FieldDesc = nil then
      raise Exception.Create(Format(SFieldNotFound, [Field.FieldName]));
    Result := InternalGetBlob(FieldDesc);
  end
  else
    Result := nil;
end;

function TMemDataSet.InternalSetBlob(FieldDesc: TFieldDesc; Blob: TBlob): boolean;
var
  OldBlob: TBlob;
  RecBuf: TRecordBuffer;
begin
  Assert(FieldDesc <> nil);
  Assert(Blob <> nil);
  OldBlob := InternalGetBlob(FieldDesc);
  Assert(OldBlob <> nil);
  Result := Blob.ClassType = OldBlob.ClassType;
  if GetActiveRecBuf(RecBuf) then begin
    if not Data.IsBlobFieldType(FieldDesc.DataType) then
      DatabaseError(SNeedBlobType);

    Assert((Blob.RefCount = 1) and (OldBlob.RefCount = 1));
    OldBlob.Free;
    Blob.AddRef;
    Marshal.WriteIntPtr(RecBuf, FieldDesc.Offset, Blob.GCHandle);
  end
  else
    Result := False;
end;

function TMemDataSet.SetBlob(Field: TField; Blob: TBlob): boolean;
var
  FieldDesc: TFieldDesc;
begin
  if Field <> nil then begin
    FieldDesc := GetFieldDesc(Field);
    if FieldDesc = nil then
      raise Exception.Create(Format(SFieldNotFound, [Field.FieldName]));
    Result := InternalSetBlob(FieldDesc, Blob);
  end
  else
    Result := False;
end;

procedure TMemDataSet.SetNumberRange(FieldDef: TFieldDef);
var
  Field: TField;
  FieldDesc: TFieldDesc;
begin
  if FieldDef.DataType in [ftInteger, ftFloat] then begin
    Field := FindField(FieldDef.Name);
    if Field <> nil then begin
      CheckFieldCompatibility(Field, FieldDef);
      FieldDesc := Data.FindField(FieldDef.Name);
      if FieldDef.DataType = ftInteger then begin
        Assert(Field is TIntegerField);
        TIntegerField(Field).MaxValue := Round(IntPower(10, FieldDesc.Length)) - 1;
        TIntegerField(Field).MinValue := -TIntegerField(Field).MaxValue;
      end
      else
        if (FieldDesc.Length > 0) and (FieldDesc.Length <= 15) then begin
          Assert(Field is TFloatField);
          TFloatField(Field).Precision := FieldDesc.Length;
          TFloatField(Field).MaxValue :=
            IntPower(10, FieldDesc.Length - FieldDesc.Scale) -
            IntPower(10, - FieldDesc.Scale);
          TFloatField(Field).MinValue := - TFloatField(Field).MaxValue;
        end;
    end;
  end;
end;

{function TMemDataSet.Translate(const Src: string; var Dest: string; boolean): integer;
begin
  inherited Translate(Src, Dest, ToOem);
  Result := StrLen(Src);
{  if ToOem then
    AnsiToNativeBuf(Locale, Src, Dest, Result)
  else
    NativeToAnsiBuf(Locale, Src, Dest, Result);
  if Src <> Dest then
    Dest[Result] := #0;
end;}

{ Buffer/Record Management }

function TMemDataSet.AllocRecordBuffer: TRecordBuffer;
begin
  Result := Marshal.AllocHGlobal(FRecBufSize);
  PRecInfo(integer(Result) + FRecInfoOfs).RefComplexFields := False;
end;

procedure TMemDataSet.FreeRecordBuffer(var Buffer: TRecordBuffer);
begin
  FreeRefComplexFields(Buffer);
  Marshal.FreeHGlobal(Buffer);
  Buffer := nil;
end;

procedure TMemDataSet.CopyRecordBuffer(SrcBuffer: IntPtr; DstBuffer: IntPtr);
begin
  Data.FreeComplexFields(DstBuffer, False);
  CopyBuffer(SrcBuffer, DstBuffer, FRecBufSize);
  PRecInfo(integer(DstBuffer) + FRecInfoOfs).RefComplexFields := True;
  Data.CreateComplexFields(DstBuffer, False);  //copy complex fields
  Data.CopyComplexFields(SrcBuffer, DstBuffer, False);
end;

function TMemDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
var
{$IFDEF CLR}
  RecInfo: IntPtr;
{$ELSE}
  RecInfo: PRecInfo;
{$ENDIF}
begin
  FreeRefComplexFields(Buffer);
  case GetMode of
    gmCurrent:
      Data.GetRecord(Buffer);
    gmNext:
      Data.GetNextRecord(Buffer);
    gmPrior:
      Data.GetPriorRecord(Buffer);
  end;
  if Data.BOF then
    Result := grBOF
  else
    if Data.EOF then
      Result := grEOF
    else begin
    {$IFDEF CLR}
      RecInfo := IntPtr(Integer(Buffer) + FRecInfoOfs);
      Marshal.WriteInt32(RecInfo, Data.RecordNo); //RecordNumber
      Marshal.WriteInt16(RecInfo, sizeof(longint), (byte(bfCurrent) shl 8) or byte(Data.GetUpdateStatus)); //UpdateStatus
      if FNeedAddRef then begin
        Marshal.WriteByte(RecInfo, sizeof(integer) + sizeof(TUpdateStatus)
          + sizeof(TBookmarkFlag), byte(True)); //RefComplexFields
        Data.AddRefComplexFields(Buffer);
      end;
    {$ELSE}
      RecInfo := PRecInfo(Integer(Buffer) + FRecInfoOfs);
      RecInfo.RecordNumber := Data.RecordNo;
      RecInfo.UpdateStatus := TUpdateStatus(Data.GetUpdateStatus);
      RecInfo.BookmarkFlag := bfCurrent;
      if FNeedAddRef then begin
        RecInfo.RefComplexFields := True;
        Data.AddRefComplexFields(Buffer);
      end;
    {$ENDIF}

      //ClearBlobCache(Buffer);
      if not FCacheCalcFields then
        GetCalcFields(Buffer);
      //SetBookmarkFlag(Buffer, bfCurrent);
      Data.GetBookmark(PRecBookmark(Integer(Buffer) + FBookmarkOfs));

      Result := grOK;
    end;
end;

procedure TMemDataSet.InternalInitRecord(Buffer: TRecordBuffer);
begin
  //FInDeferredPost := False; moved to InternalInsert
  //FInInserting := True;
  FreeRefComplexFields(Buffer);
  Data.InitRecord(Buffer);
  if Data.HasComplexFields then
    Data.CreateComplexFields(Buffer, True);
end;

procedure TMemDataSet.InitRecord(Buffer: TRecordBuffer);
var
  RecInfo: PRecInfo;
begin
  inherited InitRecord(Buffer);
  //ClearBlobCache(Buffer);
  RecInfo := PRecInfo(integer(Buffer) + FRecInfoOfs);
  RecInfo.RecordNumber := 0;
  RecInfo.UpdateStatus := TUpdateStatus(usInserted);
  RecInfo.BookMarkFlag := bfInserted;
  Data.InitRecord(FOldRecBuf);  // clear OldRecBuf
end;

function TMemDataSet.GetActiveRecBuf(var RecBuf: TRecordBuffer): boolean;
begin
  case State of
    dsBlockRead:
      if IsEmpty then
        RecBuf := nil
      else
        RecBuf := ActiveBuffer;
    dsBrowse:
      if FInCacheProcessing then
        RecBuf := NewCacheRecBuf
      else
        if IsEmpty then
          RecBuf := nil
        else
          RecBuf := ActiveBuffer;
    dsEdit,dsInsert:
      RecBuf := ActiveBuffer;
    dsCalcFields:
      RecBuf := CalcBuffer;
    dsFilter:
      RecBuf := FFilterBuffer;
    dsNewValue:
      if FInCacheProcessing then
        RecBuf := NewCacheRecBuf
      else
        RecBuf := ActiveBuffer;
    dsOldValue:
      if FInDeferredPost then
        RecBuf := OldDeferredPostBuf
      else
      if FInCacheProcessing then
        RecBuf := OldCacheRecBuf
      else
        RecBuf := GetOldRecord;
//    dsSetKey: RecBuf := PChar(FKeyBuffer) + SizeOf(TKeyBuffer);
  else
    RecBuf := nil;
  end;
  Result := RecBuf <> nil;
end;

function TMemDataSet.GetOldRecord: TRecordBuffer;
begin
  UpdateCursorPos;
  Data.GetOldRecord(FOldRecBuf);
  Result := FOldRecBuf;
end;

procedure TMemDataSet.ClearCalcFields(Buffer: TRecordBuffer);
var
  i: integer;
{$IFNDEF CLR}
{$IFNDEF VER10P}
  DataOffset: integer;
{$ENDIF}
{$ENDIF}
begin
  if FCreateCalcFieldDescs then begin
    for i := 0 to Data.Fields.Count - 1 do
      if Data.Fields[i].FieldDescKind <> fdkData then
        Data.SetNull(i + 1, Buffer, True);
  end
  else begin
    FillChar(IntPtr(integer(Buffer) + RecordSize), CalcFieldsSize, 0);

  {$IFNDEF CLR}
  {$IFNDEF VER10P}
    DataOffset := 0;
    for i := 0 to Fields.Count - 1 do
      if (Fields[i].DataType = ftWideString) and (Fields[i].FieldKind in [fkCalculated, fkLookUp]) then begin
        Marshal.WriteInt32(Pointer(Integer(Buffer) + RecordSize + Fields[i].Offset + 1), DataOffset);
        DataOffset := DataOffset + (Fields[i].Size + 1) * sizeof(WideChar);
      end;
    FillChar(IntPtr(integer(Buffer) + FWideStringOfs), DataOffset, 0);
  {$ENDIF}
  {$ENDIF}
  end;
end;

// WAR don't support BlockRead

procedure TMemDataSet.SetBlockReadSize(Value: Integer);
begin
  if Value <> BlockReadSize then
    if (Value > 0) or (Value < -1) then begin
      UpdateCursorPos;
      inherited;
    end
    else
      inherited;
end;

procedure TMemDataSet.BlockReadNext;
begin
  inherited;
end;

{ Bookmarks }

function TMemDataSet.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
begin
  Result := PRecInfo(integer(Buffer) + FRecInfoOfs).BookmarkFlag;
end;

procedure TMemDataSet.SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag);
begin
  PRecInfo(integer(Buffer) + FRecInfoOfs).BookmarkFlag := Value
end;

// Data - pointer to bookmark
procedure TMemDataSet.GetBookmarkData(Buffer: TRecordBuffer;
  {$IFDEF CLR}var{$ENDIF} Bookmark: TBookmark);
begin
  CopyBuffer(IntPtr(integer(Buffer) + FBookmarkOfs), Bookmark, BookmarkSize);
end;

procedure TMemDataSet.SetBookmarkData(Buffer: TRecordBuffer;
  {$IFDEF CLR}const{$ENDIF} Bookmark: TBookmark);
begin
  CopyBuffer(Bookmark, IntPtr(integer(Buffer) + FBookmarkOfs), BookmarkSize);
end;

procedure TMemDataSet.InternalGotoBookmark({$IFDEF CLR}const{$ENDIF} Bookmark: TBookmark);
begin
  Data.SetToBookMark(PRecBookmark(Bookmark));
end;

{function TMemDataSet.GetBookmarkStr: TBookmarkStr;
begin
  if State in [dsFilter] then begin
    SetLength(Result, BookmarkSize);
    Data.GetBookmark(Pointer(Result));
  end
  else
    Result := inherited GetBookmarkStr;
end;}

function ChangeDecimalSeparator(const Value: string; OldSeparator, NewSeparator: string): string;
begin
  if OldSeparator <> NewSeparator then
    Result := StringReplace(Value, OldSeparator, NewSeparator, [rfReplaceAll])
  else
    Result := Value;
end;

function XMLEncode(const AStr: String): String;
var
  sb: StringBuilder;
begin
  sb := StringBuilder.Create(AStr, Length(AStr));
  try
    sb.Replace('&', '&#x26;');
    sb.Replace('''', '&#x27;');
    sb.Replace('"', '&#x22;');
    sb.Replace('<', '&#x3c;');
    sb.Replace('>', '&#x3e;');
    Result := sb.ToString;
  finally
    sb.Free;
  end;
end;

procedure TMemDataSet.SaveToXML(const FileName: string);
var
  FileStream: TFileStream;
begin
  FileStream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToXML(FileStream);
  finally
    FileStream.Free;
  end;
end;

procedure TMemDataSet.SaveToXML(Destination: TStream);
var
  FieldAliases: TStringList;

  function IsValidFieldName(const FldName: string): boolean;
  var
    i: integer;
    ch: char;
  begin
    for i := 1 to Length(FldName) do begin
      ch := FldName[i];
      if not ((ch = '_') or (ch >= 'A') and (ch <= 'Z') or (ch >= 'a') and (ch <= 'z') or
        (i > 1) and (ch >= '0') and (ch <= '9'))
      then begin
        Result := False;
        Exit;
      end;
    end;
    Result := True;
  end;
  
  function FindFieldAlias(FldName: string): string;
  var
    i, p: integer;
    Attr: string;
    ActualName: string;
  begin
    Result := '';
    if FieldAliases <> nil then
      for i := 0 to FieldAliases.Count - 1 do begin
        Attr := FieldAliases[i];
        p := Pos('''=c', Attr);
        Assert(p <> 0);
        ActualName := Copy(Attr, 2, p - 2);
        if ActualName = FldName then begin
          Result := Copy(Attr, p + 2, Length(Attr) - p - 1);
          Break;
        end;
      end;
  end;

var
  OldActive: boolean;
  Bookmark: DB.TBookmark;
  DestWriter: StreamWriter;
  XMLWriter: XmlTextWriter;
  XML: string;
  FldName, FldAlias: string;
  i: integer;
  FieldDesc: TFieldDesc;
{$IFDEF VER8}
  DestStream: Stream;
{$ENDIF}
begin
  OldActive := Active;
  Bookmark := nil;
  FieldAliases := nil;
  DestWriter := nil;
  XmlWriter := nil;
{$IFDEF VER8}
  DestStream := nil;
{$ENDIF}
  try
    DisableControls;
    Active := True;
  {$IFDEF CLR}
  {$IFDEF VER9P}
  {$DEFINE OWNGETBOOKMARK}
  {$ENDIF}
  {$ENDIF}
  {$IFDEF OWNGETBOOKMARK}
    if BookmarkAvailable then
    begin
      Bookmark := Marshal.AllocHGlobal(BookmarkSize);
      GetBookmarkData(ActiveBuffer, Bookmark);
    end else
      Bookmark := nil;
  {$ELSE}
    Bookmark := GetBookmark;
  {$ENDIF}

    FieldAliases := TStringList.Create;

  {$IFDEF VER8}
    DestStream := TStreamToCLRStream.GetStream(Destination);
  {$ENDIF}
    DestWriter := StreamWriter.Create({$IFDEF VER8}DestStream{$ELSE}Destination{$ENDIF}, Encoding.Default);
    XmlWriter := XmlTextWriter.Create(DestWriter);

    XmlWriter.QuoteChar := '''';
    XmlWriter.Formatting := fmtIndented;
    XmlWriter.Indentation := 2;
    XmlWriter.IndentChar := ' ';

    // Header
    XmlWriter.WriteStartElement('xml');

    XmlWriter.WriteAttributeString('xmlns:s', 'uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882');
    XmlWriter.WriteAttributeString('xmlns:dt', 'uuid:C2F41010-65B3-11d1-A29F-00AA00C14882');
    XmlWriter.WriteAttributeString('xmlns:rs', 'urn:schemas-microsoft-com:rowset');
    XmlWriter.WriteAttributeString('xmlns:z', '#RowsetSchema');

    // Fields
    XmlWriter.WriteStartElement('s:Schema');
    XmlWriter.WriteAttributeString('id', 'RowsetSchema');

    XmlWriter.WriteStartElement('s:ElementType');
    XmlWriter.WriteAttributeString('name', 'row');
    XmlWriter.WriteAttributeString('content', 'eltOnly');
    XmlWriter.WriteAttributeString('rs:updatable', 'true');

    for i := 0 to Fields.Count - 1 do
      if not (Fields[i].FieldKind in [fkCalculated, fkLookup]) then begin
        FieldDesc := GetFieldDesc(Fields[i]);
        if FieldDesc <> nil then begin
          FldName := FieldDesc.Name;
          if not IsValidFieldName(FldName) then begin
            FldAlias := 'c' + IntToStr(FieldAliases.Count + 1);
            FieldAliases.Add(QuotedStr({$IFNDEF CLR}XMLEncode{$ENDIF}(UTF8Encode(FldName))) + '=' + FldAlias);
          end
          else
            FldAlias := '';
          XmlWriter.WriteStartElement('s:AttributeType');
          WriteFieldXMLAttributeType(Fields[i], FieldDesc, FldAlias, XmlWriter);
          XmlWriter.WriteStartElement('s:datatype');
          WriteFieldXMLDataType(Fields[i], FieldDesc, FldAlias, XmlWriter);
          XmlWriter.WriteEndElement; // s:datatype
          XmlWriter.WriteFullEndElement; // s:AttributeType
        end;
      end;

    XmlWriter.WriteStartElement('s:extends');
    XmlWriter.WriteAttributeString('type', 'rs:rowbase');
    XmlWriter.WriteEndElement; // s:extends
    XmlWriter.WriteFullEndElement; // s:ElementType
    XmlWriter.WriteFullEndElement; // s:Schema

    // Data
    XmlWriter.WriteStartElement('rs:data');

    First;
    while not EOF do begin
      XmlWriter.WriteStartElement('z:row');
      for i := 0 to Fields.Count - 1 do
        if not (Fields[i].FieldKind in [fkCalculated, fkLookup]) then begin
          if not Fields[i].IsNull then begin
            XML := GetFieldXMLValue(Fields[i], GetFieldDesc(Fields[i]));
            FldName := {$IFNDEF CLR}XMLEncode{$ENDIF}(UTF8Encode(Fields[i].FieldName));
            if not IsValidFieldName(FldName) then
              FldName := FindFieldAlias(FldName);
            XmlWriter.WriteAttributeString(FldName, XML);
          end;
        end;
      XmlWriter.WriteEndElement;
      Next;
    end;

    XmlWriter.WriteFullEndElement; // rs:data
    XmlWriter.WriteFullEndElement; // xml

    XmlWriter.Close;
  finally
    Active := OldActive;
    if OldActive and (Bookmark <> nil) then
      GotoBookmark(Bookmark);
    if Bookmark <> nil then
    {$IFDEF OWNGETBOOKMARK}
      Marshal.FreeHGlobal(Bookmark);
    {$ELSE}
      FreeBookmark(Bookmark);
    {$ENDIF}
    FieldAliases.Free;
    XmlWriter.Free;
    DestWriter.Free;
  {$IFDEF VER8}
    DestStream.Free;
  {$ENDIF}

    EnableControls;
  end;
end;

procedure TMemDataSet.WriteFieldXMLDataType(Field: TField; FieldDesc: TFieldDesc;
  const FieldAlias: string; XmlWriter: XMLTextWriter);
begin
  case FieldDesc.DataType of
    dtInt64: begin
      XmlWriter.WriteAttributeString('dt:type', 'i8');
      XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Size));
      XmlWriter.WriteAttributeString('rs:precision', '19');
    end;
    dtBlob, dtBytes, dtVarBytes, dtExtVarBytes: begin
      XmlWriter.WriteAttributeString('dt:type', 'bin.hex');
      if (FieldDesc.DataType = dtBlob) then
        XmlWriter.WriteAttributeString('dt:maxLength', '2147483647')
      else
        XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Length));
      if Field.IsBlob and not FieldDesc.Fixed then
        XmlWriter.WriteAttributeString('rs:long', 'true');
    end;
    dtBoolean: begin
      XmlWriter.WriteAttributeString('dt:type', 'boolean');
      XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Size));
    end;
    dtString, dtExtString, dtMemo, dtWideString, dtExtWideString, dtWideMemo: begin
      XmlWriter.WriteAttributeString('dt:type', 'string');
      if FieldDesc.DataType in [dtMemo, dtWideMemo] then
        XmlWriter.WriteAttributeString('dt:maxLength', '2147483647')
      else
        XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Length));
      if not (FieldDesc.DataType in [dtWideString, dtExtWideString, dtWideMemo]) then
        XmlWriter.WriteAttributeString('rs:dbtype', 'str');
      if Field.IsBlob and not FieldDesc.Fixed then
        XmlWriter.WriteAttributeString('rs:long', 'true');
    end;
    dtCurrency, dtBCD: begin
      XmlWriter.WriteAttributeString('dt:type', 'number');
      XmlWriter.WriteAttributeString('rs:dbtype', 'currency');
      XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Size));
      XmlWriter.WriteAttributeString('rs:precision', IntToStr(FieldDesc.Length));
    end;
    dtDateTime: begin
      XmlWriter.WriteAttributeString('dt:type', 'datetime');
      XmlWriter.WriteAttributeString('rs:dbtype', 'variantdate');
      XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Size));
      XmlWriter.WriteAttributeString('rs:scale', IntToStr(FieldDesc.Scale));
      XmlWriter.WriteAttributeString('rs:precision', IntToStr(FieldDesc.Length));
    end;
    dtDate: begin
      XmlWriter.WriteAttributeString('dt:type', 'date');
      XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Size));
      XmlWriter.WriteAttributeString('rs:scale', IntToStr(FieldDesc.Scale));
      XmlWriter.WriteAttributeString('rs:precision', IntToStr(FieldDesc.Length));
    end;
    dtTime: begin
      XmlWriter.WriteAttributeString('dt:type', 'time');
      XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Size));
      XmlWriter.WriteAttributeString('rs:scale', IntToStr(FieldDesc.Scale));
      XmlWriter.WriteAttributeString('rs:precision', IntToStr(FieldDesc.Length));
    end;
    dtFloat: begin
      if FieldDesc.Length <= 7 then begin
        XmlWriter.WriteAttributeString('dt:type', 'r4');
        XmlWriter.WriteAttributeString('dt:maxLength', '4');
      end
      else begin
        XmlWriter.WriteAttributeString('dt:type', 'float');
        XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Size));
      end;
      XmlWriter.WriteAttributeString('rs:precision', IntToStr(FieldDesc.Length));
    end;
  {$IFDEF VER5P}
    dtGuid: begin
      XmlWriter.WriteAttributeString('dt:type', 'uuid');
      XmlWriter.WriteAttributeString('dt:maxLength', '16');
    end;
  {$ENDIF}
    dtInt32: begin
      XmlWriter.WriteAttributeString('dt:type', 'int');
      XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Size));
      XmlWriter.WriteAttributeString('rs:precision', '10');
    end;
  {$IFDEF VER6P}
    dtFmtBCD: begin
      XmlWriter.WriteAttributeString('dt:type', 'number');
      XmlWriter.WriteAttributeString('rs:dbtype', 'numeric');
      XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Size));
      XmlWriter.WriteAttributeString('rs:scale', IntToStr(FieldDesc.Scale));
      XmlWriter.WriteAttributeString('rs:precision', IntToStr(FieldDesc.Length));
    end;
  {$ENDIF}
    dtInt16: begin
      XmlWriter.WriteAttributeString('dt:type', 'i2');
      XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Size));
      XmlWriter.WriteAttributeString('rs:precision', '5');
    end;
    dtInt8: begin
      XmlWriter.WriteAttributeString('dt:type', 'i1');
      XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Size));
      XmlWriter.WriteAttributeString('rs:precision', IntToStr(FieldDesc.Length));
    end;
    dtLongword: begin
      XmlWriter.WriteAttributeString('dt:type', 'ui4');
      XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Size));
      XmlWriter.WriteAttributeString('rs:precision', IntToStr(FieldDesc.Length));
    end;
    dtWord: begin
      XmlWriter.WriteAttributeString('dt:type', 'ui2');
      XmlWriter.WriteAttributeString('dt:maxLength', IntToStr(FieldDesc.Size));
      XmlWriter.WriteAttributeString('rs:precision', IntToStr(FieldDesc.Length));
    end;
    dtUnknown{$IFDEF VER5P}, dtVariant{$ENDIF}:
      XmlWriter.WriteAttributeString('dt:type', 'string')
    else
      DatabaseError(SDataTypeNotSupported, Self);
  end;

  if FieldDesc.Fixed and not (FieldDesc.DataType in [dtUnknown{$IFDEF VER5P}, dtVariant{$ENDIF}]) then
    XmlWriter.WriteAttributeString('rs:fixedlength', 'true');
    
  if Field.Required and not Field.ReadOnly then
    XmlWriter.WriteAttributeString('rs:maybenull', 'false');
end;

procedure TMemDataSet.WriteFieldXMLAttributeType(Field: TField; FieldDesc: TFieldDesc;
  const FieldAlias: string; XmlWriter: XMLTextWriter);
begin
  if FieldAlias = '' then
    XmlWriter.WriteAttributeString('name', {$IFNDEF CLR}XMLEncode{$ENDIF}(UTF8Encode(FieldDesc.Name)))
  else begin
    XmlWriter.WriteAttributeString('name', FieldAlias);
    XmlWriter.WriteAttributeString('rs:name',  {$IFNDEF CLR}XMLEncode{$ENDIF}(UTF8Encode(FieldDesc.Name)));
  end;

  XmlWriter.WriteAttributeString('rs:number',  IntToStr(FieldDesc.FieldNo));
  if not Field.Required and not Field.ReadOnly then /// Can't use FieldDesc.Required, see "Required and FLocalConstraints" line in TMemDataSet.CreateFieldDefs for details
    XmlWriter.WriteAttributeString('rs:nullable', 'true');
  if not Field.ReadOnly then
    XmlWriter.WriteAttributeString('rs:writeunknown', 'true');
  // XmlWriter.WriteAttributeString('rs:basecatalog', '');

  if FieldDesc.ActualName <> '' then
    XmlWriter.WriteAttributeString('rs:basecolumn', {$IFNDEF CLR}XMLEncode{$ENDIF}(UTF8Encode(FieldDesc.ActualName)));
  if FieldDesc.IsKey then
    XmlWriter.WriteAttributeString('rs:keycolumn', 'true');
  if Field.AutoGenerateValue = arAutoInc then
    XmlWriter.WriteAttributeString('rs:autoincrement', 'true');
end;

function TMemDataSet.GetFieldXMLValue(Field: TField; FieldDesc: TFieldDesc): string;
var
  Buffer: TBytes;
  Blob: TBlob;
  Piece: PPieceHeader;
{$IFDEF CLR}
  sb: StringBuilder;
  Bytes: TBytes;
{$ELSE}
  sbOffset: integer;
{$ENDIF}

  function EncodeXMLDateTime(Value: TDateTime): string;
  var
    Year, Month, Day, Hour, Minute, Second, MilliSecond: Word;
  begin
    DecodeDateTime(Value, Year, Month, Day, Hour, Minute, Second, MilliSecond);
    Result := StringReplace(Format('%4d%s%2d%s%2d', [Year, '-', Month, '-', Day]),
      ' ', '0', [rfReplaceAll]);
    Result := Result + 'T';
    Result := StringReplace(Result + Format('%2d%s%2d%s%2d', [Hour, ':', Minute, ':', Second]),
      ' ', '0', [rfReplaceAll]);
  end;

  function EncodeXMLTime(Value: TDateTime): string;
  var
    Hour, Minute, Second, MilliSecond: Word;
  begin
    DecodeTime(Value, Hour, Minute, Second, MilliSecond);
    Result := StringReplace(Format('%2d%s%2d%s%2d', [Hour, ':', Minute, ':', Second]),
      ' ', '0', [rfReplaceAll]);
  end;

begin
  Result := '';
  SetLength(Buffer, 0);
  case FieldDesc.DataType of
    dtBoolean:
      Result := BoolToStr(Field.AsBoolean, True);
    dtInt8, dtInt16, dtInt32, dtUInt16, dtUInt32, dtInt64:
      Result := Field.AsString;
    dtFloat:
      Result := ChangeDecimalSeparator(FloatToStr(Field.AsFloat), DecimalSeparator, '.');
    dtCurrency, dtBcd:
      Result := ChangeDecimalSeparator(CurrToStr(Field.Value), DecimalSeparator, '.');
    dtDate, dtDateTime:
      Result := EncodeXMLDateTime(Field.AsDateTime);
    dtTime:
      Result := EncodeXMLTime(Field.AsDateTime);
  {$IFDEF VER6P}
    dtFmtBCD:
      Result := BcdToStr(Field.AsBCD);
  {$ENDIF}
    dtBytes, dtVarBytes, dtExtVarBytes: begin
      Buffer := Field.Value;
      SetLength(Result, Length(Buffer) * 2);
    {$IFDEF CLR}
      Bytes := Encoding.Default.GetBytes(Result);
      BinToHex(Buffer, 0, Bytes, 0, Length(Buffer));
      Result := Encoding.Default.GetString(Bytes);
    {$ELSE}
      BinToHex(@Buffer[0], PChar(Result), Length(Buffer));
    {$ENDIF}
    end;
    dtBlob: begin
      Blob := InternalGetBlob(FieldDesc);
      SetLength(Result, Integer(Blob.Size) * 2);
      Piece := Blob.FirstPiece;
    {$IFDEF CLR}
      sb := StringBuilder.Create;
      try
        while IntPtr(Piece) <> nil do begin
          SetLength(Buffer, Piece.Used);
          Marshal.Copy(IntPtr(Integer(Piece) + sizeof(TPieceHeader)), Buffer, 0, Piece.Used);
          SetLength(Bytes, Length(Buffer) * 2);
          BinToHex(Buffer, 0, Bytes, 0, Length(Buffer));
          sb.Append(Encoding.Default.GetString(Bytes));
          Piece := Piece.Next;
        end;
        Result := sb.ToString;
      finally
        sb.Free;
      end;
    {$ELSE}
      sbOffset := 0;
      while Piece <> nil do begin
        BinToHex(IntPtr(Integer(Piece) + sizeof(TPieceHeader)),
          IntPtr(Integer(Result) + sbOffset), Piece.Used);
        sbOffset := sbOffset + Integer(Piece.Used);
        Piece := Piece.Next;
      end;
    {$ENDIF}
    end;
    else
      Result := Field.AsString;
  end;
  Result := {$IFNDEF CLR}XMLEncode{$ENDIF}(UTF8Encode(Result));
end;

{$IFDEF CLR} // TDataSet bug
var
  NativeDBBuffers: TDBBufferList;

function NativeBuffers: TDBBufferList;
begin
  if NativeDBBuffers <> nil then
    Result := NativeDBBuffers
  else
  begin
    Result := TDBBufferList.Create;
    NativeDBBuffers := Result; // fix d9 bug
  end;
end;

function TMemDataSet.GetBookmark: TBookmark;
begin
  if BookmarkAvailable then
  begin
    Result := NativeBuffers.AllocHGlobal(BookmarkSize);
    GetBookmarkData(ActiveBuffer, Result);
  end else
    Result := nil;
end;

procedure TMemDataSet.FreeBookmark(var Bookmark: TBookmark);
begin
  NativeBuffers.FreeHGlobal(Bookmark);
end;
{$ENDIF}

function TMemDataSet.BookmarkValid({$IFDEF CLR}const{$ENDIF} Bookmark: TBookmark): boolean;
begin
  Result := Data.BookmarkValid(PRecBookmark(Bookmark));
end;

function TMemDataSet.CompareBookmarks({$IFDEF CLR}const{$ENDIF} Bookmark1, Bookmark2: TBookmark): integer;
begin
  Result := Data.CompareBookmarks(PRecBookmark(Bookmark1), PRecBookmark(Bookmark2));
end;

{ Navigation }

procedure TMemDataSet.InternalSetToRecord(Buffer: TRecordBuffer);
begin
  InternalGotoBookmark(IntPtr(integer(Buffer) + FBookmarkOfs));
end;

procedure TMemDataSet.SetIndexFieldNames(Value: string);
begin
  if Active then
    CheckBrowseMode;
  TMemData(Data).SetIndexFieldNames(Value);
  if Active and (TMemData(Data).IndexFields.Count > 0) then
    Resync([]);
  FIndexFieldNames := Value;
end;

procedure TMemDataSet.InternalFirst;
begin
  Data.SetToBegin;
end;

procedure TMemDataSet.InternalLast;
begin
  Data.SetToEnd;
end;

{ Editing }

procedure TMemDataSet.InternalAddRecord(Buffer: IntPtr; Append: Boolean);
begin
  if Append then
    Data.AppendRecord(Buffer)
  else
    Data.InsertRecord(Buffer);
end;

procedure TMemDataSet.InternalInsert;
begin
  FInDeferredPost := False;
  if OldDeferredPostBuf <> nil then begin
    FreeRefComplexFields(OldDeferredPostBuf, False);
    Marshal.FreeHGlobal(OldDeferredPostBuf);
    OldDeferredPostBuf := nil;
  end;
  FInInserting := True;
end;

procedure TMemDataSet.InternalEdit;
begin
  FInDeferredPost := False;
  if OldDeferredPostBuf <> nil then begin
    FreeRefComplexFields(OldDeferredPostBuf, False);
    Marshal.FreeHGlobal(OldDeferredPostBuf);
    OldDeferredPostBuf := nil;
  end;
  FInEditing := True;

  FreeRefComplexFields(ActiveBuffer);
  Data.EditRecord(ActiveBuffer);
end;

procedure TMemDataSet.InternalDelete;
begin
  if not CanModify then DatabaseError(SDataSetReadOnly, Self);
  Data.DeleteRecord;

  // CR M8107
  FInInserting := False;
  FInEditing := False;
end;

procedure TMemDataSet.InternalPost;
var
  i: integer;
  Blob: TBlob;
  Field: TField;
  FieldDesc: TFieldDesc;
begin
{$IFDEF VER6P}
  inherited;
{$ENDIF}

  for i := 0 to FieldCount - 1 do begin
    Field := Fields[i];
    FieldDesc := GetFieldDesc(Field);
    if (FieldDesc <> nil) and Data.IsBlobFieldType(FieldDesc.DataType) then begin
      Blob := Data.GetObject(FieldDesc.FieldNo, ActiveBuffer) as TBlob;
      if Blob.Modified then
        TBlobField(Field).Modified := True;
    end;
  end;
  if State = dsEdit then begin
    Data.PostRecord(ActiveBuffer);
  end
  else
    Data.InsertRecord(ActiveBuffer);

  FInDeferredPost := False;
  if OldDeferredPostBuf <> nil then begin
    FreeRefComplexFields(OldDeferredPostBuf, False);
    Marshal.FreeHGlobal(OldDeferredPostBuf);
    OldDeferredPostBuf := nil;
  end;
  FInInserting := False;
  FInEditing := False;
end;

procedure TMemDataSet.Cancel;
var
  CancelBuf : IntPtr;
begin
  if ((State = dsEdit) or (State = dsInsert)) and (Data.HasComplexFields) then begin
    CancelBuf := AllocRecordBuffer;
    CopyBuffer(ActiveBuffer, CancelBuf, FRecBufSize);
    Data.AddRefComplexFields(CancelBuf);
  end
  else
    CancelBuf := nil;
 try
{$IFDEF D3}
  if State = dsInsert then
    if Data.HasComplexFields then
      Data.FreeComplexFields(ActiveBuffer, True);
{$ENDIF}


    inherited;
  finally
    if CancelBuf <> nil then begin
      Data.FreeComplexFields(CancelBuf, True);
      Marshal.FreeHGlobal(CancelBuf);
    end;
  end;
end;


procedure TMemDataSet.InternalCancel;
begin
  FInDeferredPost := False;
  if OldDeferredPostBuf <> nil then begin
    FreeRefComplexFields(OldDeferredPostBuf, False);
    Marshal.FreeHGlobal(OldDeferredPostBuf);
    OldDeferredPostBuf := nil;
  end;
  FInInserting := False;
  FInEditing := False;

  if State = dsEdit then
    Data.CancelRecord(ActiveBuffer);
{$IFNDEF D3}
  if State = dsInsert then
    if Data.HasComplexFields then
      Data.FreeComplexFields(ActiveBuffer, True);
{$ENDIF}
end;

procedure TMemDataSet.InternalDeferredPost;
begin
  if State = dsEdit then
    DoPerformUpdate
  else
    DoPerformAppend;
end;

procedure TMemDataSet.DeferredPost;
  procedure CheckRequiredFields;
  var
    I: Integer;
  begin
    for I := 0 to Fields.Count - 1 do
      with Fields[I] do
        if Required and not ReadOnly and (FieldKind = fkData) and IsNull then
        begin
          FocusControl;
          DatabaseErrorFmt(SFieldRequired, [DisplayName]);
        end;
  end;
begin
  if not CachedUpdates then begin
    UpdateRecord;
    case State of
      dsEdit, dsInsert:
        begin
        {$IFDEF CLR}
          DataEvent(deCheckBrowseMode, nil);
        {$ELSE}
          DataEvent(deCheckBrowseMode, 0);
        {$ENDIF}
          CheckRequiredFields;
          UpdateCursorPos;

          InternalDeferredPost;

          if OldDeferredPostBuf = nil then begin
            OldDeferredPostBuf := AllocRecordBuffer;
            Data.CreateComplexFields(OldDeferredPostBuf, False);
            PRecInfo(Integer(OldDeferredPostBuf) + FRecInfoOfs).RefComplexFields := True;//own complex fields
          end;
          CopyRecordBuffer(ActiveBuffer, OldDeferredPostBuf);
          FInDeferredPost := True;
        end;
    end;
  end;
end;

procedure TMemDataSet.SetDefaultExpressionValue(Field: TField);
begin
  Field.AsString := Field.DefaultExpression;
end;

procedure TMemDataSet.DoOnNewRecord;
var
  i: integer;
begin
  for i := 0 to FieldCount - 1 do
    if Fields[i].DefaultExpression <> '' then
      SetDefaultExpressionValue(Fields[i]);
  try
    inherited;
  except
    InternalCancel;
    raise;
  end;
end;

function TMemDataSet.PerformAppend: boolean;
begin
  Result := False;
end;

function TMemDataSet.PerformDelete: boolean;
begin
  Result := False;
end;

function TMemDataSet.PerformUpdate: boolean;
begin
  Result := False;
end;

procedure TMemDataSet.DoPerformAppend;
var
  OldModified: boolean;
begin
  OldModified := Modified;
  try
    if not FLocalUpdate then
      if not FInDeferredPost then   // WAR supports defer posting
        PerformAppend
      else
        DoPerformUpdate;
  finally
    SetModified(OldModified);
  end;
end;

procedure TMemDataSet.DoPerformDelete;
var
  OldModified: boolean;
begin
  OldModified := Modified;
  try
    if not FLocalUpdate then
      PerformDelete
  finally
    SetModified(OldModified);
  end;
end;

procedure TMemDataSet.DoPerformUpdate;
var
  OldModified: boolean;
begin
  OldModified := Modified;
  try
    if not FLocalUpdate then
      PerformUpdate
  finally
    SetModified(OldModified);
  end;
end;

{ Filter / Locate / Find }
procedure TMemDataSet.DoGetCachedFields;
var
  i: Integer;
  FieldDesc: TFieldDesc;
  CalcFieldCount: integer;
begin
  CalcFieldCount := 0;
  if not DefaultFields then begin
    for i := 0 to Fields.Count - 1 do
      case Fields[i].FieldKind of
        fkCalculated, fkLookup: begin
          FieldDesc := Data.GetFieldDescType.Create;
          try
            FieldDesc.ActualName := Fields[i].FullName;
            FieldDesc.Name := Fields[i].FullName;
            FieldDesc.FieldNo := Data.FieldCount + 1;
            FieldDesc.DataType := GetDataType(Fields[i].DataType);
            case Fields[i].DataType of
              ftWideString:
                FieldDesc.Size := (Fields[i].Size + 1) * SizeOf(WideChar);
              ftDate, ftTime:
                FieldDesc.Size := Fields[i].DataSize * 2;
              else
                FieldDesc.Size := Fields[i].DataSize;
            end;
            FieldDesc.Length := Fields[i].Size;
            if FCacheCalcFields then
              FieldDesc.FieldDescKind := fdkCached
            else
              FieldDesc.FieldDescKind := fdkCalculated;

            // FieldDescs with CachedField=True must be positioned after data FieldDescs
            Data.Fields.Add(FieldDesc);
            Inc(CalcFieldCount);
            SetLength(FCalcFieldsMapping, CalcFieldCount);
            FCalcFieldsMapping[CalcFieldCount - 1].Field := Fields[i];
            FCalcFieldsMapping[CalcFieldCount - 1].FieldDesc := FieldDesc;
          except
            FieldDesc.Free;
            raise;
          end;
        end;
      end;
  end;
end;

procedure TMemDataSet.DoGetCachedBuffer(Buffer: IntPtr; Source: IntPtr = nil);
var
  RecBuf: IntPtr;
begin
  if (CalcFieldsSize > 0) then begin
    RecBuf := Marshal.AllocHGlobal(Data.RecordSize + Data.CalcRecordSize + SizeOf(TRecInfo) + BookmarkSize);
    try
      if Source = nil then
        CopyBuffer(Buffer, RecBuf, Data.RecordSize)
      else
        CopyBuffer(Source, RecBuf, Data.RecordSize);

      GetCalcFields(RecBuf);
      CopyBuffer(RecBuf, Buffer, Data.RecordSize + Data.CalcRecordSize);
    finally
      Marshal.FreeHGlobal(RecBuf);
    end;
  end;
end;

procedure TMemDataSet.ActivateFilters;
begin
  DeactivateFilters;

  if Assigned(OnFilterRecord) then
    Data.FilterFunc := RecordFilter;
  if Trim(Filter) <> '' then
    Data.FilterText := Filter;
end;

procedure TMemDataSet.DeactivateFilters;
begin
  Data.FilterFunc := nil;
  Data.FilterText := '';
end;

function TMemDataSet.RecordFilter(RecBuf: IntPtr): boolean;
var
  Accept: boolean;
  SaveState: TDataSetState;
begin
  SaveState := SetTempState(dsFilter);
  FFilterBuffer := RecBuf;
  try
    Accept := True;
    OnFilterRecord(Self, Accept);
  except
    InternalHandleException;
  end;
  RestoreState(SaveState);
  Result := Accept;
end;

procedure TMemDataSet.SetFiltered(Value: boolean);
begin
  if Active then begin
    CheckBrowseMode;
    UpdateCursorPos;
  end;

  if Value <> Filtered then begin
    if Value then
      ActivateFilters
    else
      DeactivateFilters;

    inherited SetFiltered(Value);

    if Active then begin
      Data.FilterUpdated;
      Resync([]);
      First;
      //DoAfterScroll;
    end;
  end;
end;

procedure TMemDataSet.SetFilterData(const Text: string; Options: TFilterOptions);
begin
  if Active then begin
    CheckBrowseMode;
    UpdateCursorPos;
  end;

  if (Text <> Filter) or (Options <> FilterOptions) then begin
    Data.FilterCaseInsensitive := foCaseInsensitive in Options;
    Data.FilterNoPartialCompare := foNoPartialCompare in Options;

    if Filtered and (Trim(Text) <> '') then
      Data.FilterText := Text
    else
      Data.FilterText := '';

    inherited SetFilterText(Text);
    inherited SetFilterOptions(Options);

    if Active and Filtered then begin
      Data.FilterUpdated;
      Resync([]);
      First;
      //DoAfterScroll;
    end;
  end;
end;

procedure TMemDataSet.SetFilterOptions(Value: TFilterOptions);
begin
  SetFilterData(Filter, Value);
end;

procedure TMemDataSet.SetFilterText(const Value: string);
begin
  SetFilterData(Value, FilterOptions);
end;

procedure TMemDataSet.SetOnFilterRecord(const Value: TFilterRecordEvent);
begin
  if Active then begin
    CheckBrowseMode;
    UpdateCursorPos;
  end;

  inherited SetOnFilterRecord(Value);

  if Filtered and Assigned(OnFilterRecord) then
    Data.FilterFunc := RecordFilter
  else
    Data.FilterFunc := nil;

  if Active then begin
    Data.FilterUpdated;
    Resync([]);
    First;
  end;
end;

function TMemDataSet.FindRecord(Restart, GoForward: boolean): boolean;
begin
  CheckBrowseMode;
  DoBeforeScroll;
  SetFound(False);
  UpdateCursorPos;
  CursorPosChanged;
  if not Filtered then
    ActivateFilters;
  try
    if GoForward then begin
      if Restart then
        Data.SetToBegin;
      Data.GetNextRecord(nil);
    end
    else begin
      if Restart then
        Data.SetToEnd;
      Data.GetPriorRecord(nil);
    end;
  finally
    if not Filtered then
      DeactivateFilters;
  end;

  if not Data.BOF and not Data.EOF then begin
    Resync([rmExact, rmCenter]);
    SetFound(True);
  end;
  Result := Found;
  if Result then
    DoAfterScroll;
end;

// Allocate memory for Value (ValuePtr - must call FreeMem!) and copy Value to ValuePtr
procedure TMemDataSet.CopyFieldValue(const Value: variant; out ValuePtr: IntPtr;
  out ValueType: integer; FieldDesc: TFieldDesc); // Allocate memory for Value (ValuePtr - must call FreeMem!) and copy Value to ValuePtr
var
  BoolValue: boolean;
  s: string;
  l: integer;
  Temp: IntPtr;
  ws: WideString;
{$IFDEF CLR}
  Data: TBytes;
{$ENDIF}
{$IFDEF VER6P}
  i64: Int64;
  bcd: TBcd;
{$ENDIF}
begin
  case VarType(Value) of
    varEmpty,varNull:
      ValuePtr := nil;
    varString{$IFDEF CLR}, varChar{$ELSE}, varOleStr{$ENDIF}:
      case FieldDesc.DataType of
        dtBoolean: begin
          BoolValue := Value;
          ValuePtr := Marshal.AllocHGlobal(SizeOf(Boolean));
          Marshal.WriteByte(ValuePtr, integer(BoolValue));
          ValueType := dtBoolean;
        end;
        dtBytes, dtVarBytes, dtExtVarBytes: begin
          s := Value;
          l := Length(s);
          ValuePtr := Marshal.AllocHGlobal(l + SizeOf(Word));

          Temp := Marshal.StringToHGlobalAnsi(s);
          try
            CopyBuffer(Temp, IntPtr(integer(ValuePtr) + SizeOf(Word)), l);
          finally
            Marshal.FreeCoTaskMem(Temp);
          end;
          Marshal.WriteInt16(ValuePtr, l);
          ValueType := FieldDesc.DataType;
        end;
        dtWideString:
        begin
          ws := Value;
          l := (Length(ws) + 1) * SizeOf(WideChar);
          ValuePtr := Marshal.AllocHGlobal(l);
          CopyBufferUni(ws, ValuePtr, l);
          ValueType := dtWideString;
        end;
      else
        begin
          s := Value;
          l := Length(s) + 1;
          ValuePtr := Marshal.AllocHGlobal(l);
          CopyBufferAnsi(s, ValuePtr, l);
          ValueType := dtString;
        end;
      end;
  else
    ValueType := FieldDesc.DataType;
    case ValueType of
      dtInt32, dtInt8, dtInt16, dtUInt16: begin
        ValuePtr := Marshal.AllocHGlobal(SizeOf(integer));
        Marshal.WriteInt32(ValuePtr, Value);
      end;
      dtUInt32: begin
        ValuePtr := Marshal.AllocHGlobal(SizeOf(longword));
        Marshal.WriteInt32(ValuePtr, Value);
      end;
      dtBoolean: begin
        ValuePtr := Marshal.AllocHGlobal(SizeOf(Boolean));
        Marshal.WriteByte(ValuePtr, Integer(Boolean(Value)));
      end;
      dtInt64: begin
      {$IFDEF VER6P}
        ValuePtr := Marshal.AllocHGlobal(SizeOf(Int64));
        i64 := Value;
        Marshal.WriteInt64(ValuePtr, i64);
      {$ELSE}
        GetMem(ValuePtr, SizeOf(Int64));
        if TVarData(Value).VType = varDecimal then
          Int64(ValuePtr^) := TVarDataD6(Value).VInt64
        else
          Int64(ValuePtr^) := StrToInt64(Value);
      {$ENDIF}
      end;
      dtFloat, dtCurrency: begin
        ValuePtr := Marshal.AllocHGlobal(SizeOf(Int64));
        Marshal.WriteInt64(ValuePtr, BitConverter.DoubleToInt64Bits(Value));
      end;
      dtBCD: begin
        ValuePtr := Marshal.AllocHGlobal(SizeOf(Currency));
        Marshal.WriteInt64(ValuePtr, BitConverter.DoubleToInt64Bits(Value));
      end;
    {$IFDEF VER6P}
      dtFmtBCD: begin
        ValuePtr := Marshal.AllocHGlobal(SizeOfTBcd);
        bcd := VarToBcd(Value);
      {$IFDEF CLR}
        Data := TBcd.ToBytes(bcd);
        Marshal.Copy(Data, 0, ValuePtr, SizeOfTBcd);
      {$ELSE}
        PBcd(ValuePtr)^ := bcd;
      {$ENDIF}
      end;
    {$ENDIF}
      dtString, dtExtString: begin
        s := Value;
        l := Length(s) + 1;
        ValuePtr := Marshal.AllocHGlobal(l);
        CopyBufferAnsi(s, ValuePtr, l);
        ValueType := dtString;
      end;
      dtWideString, dtExtWideString: begin
        ws := Value;
        l := (Length(ws) + 1) * SizeOf(WideChar);
        ValuePtr := Marshal.AllocHGlobal(l);
        CopyBufferUni(ws, ValuePtr, l);
        ValueType := dtWideString;
      end;
      dtDateTime, dtDate, dtTime: begin
        ValuePtr := Marshal.AllocHGlobal(SizeOf(Int64));
        Marshal.WriteInt64(ValuePtr, BitConverter.DoubleToInt64Bits(TDateTime(Value)));
      end;
      dtBytes, dtVarBytes, dtExtVarBytes: begin
        Assert(VarType(Value) = varArray + varByte);
      {$IFDEF CLR}
        SetLength(Data, VarArrayHighBound(Value, 1) + 1);
        for l := 0 to High(Data) do
          Data[l] := VarArrayGet(Value, l);
        ValuePtr := Marshal.AllocHGlobal(Length(Data) + sizeof(word));
        Marshal.WriteInt16(ValuePtr, Length(Data));
        Marshal.Copy(Data, 0, IntPtr(integer(ValuePtr) + sizeof(word)), Length(Data));
      {$ELSE}
        GetMem(ValuePtr, TVarData(Value).VArray.Bounds[0].ElementCount + SizeOf(Word));
        Move(TVarData(Value).VArray.Data^, (PChar(ValuePtr) + SizeOf(Word))^, TVarData(Value).VArray.Bounds[0].ElementCount);
        Word(ValuePtr^) := TVarData(Value).VArray.Bounds[0].ElementCount;
      {$ENDIF}
      end;
    else
      raise EConvertError.Create(SCannotConvertType);
    end;
  end;
end;

function TMemDataSet.InternalLocateRecord(KeyFields: TDAList; const KeyValues: variant;
  Options: TLocateExOptions; SavePos: boolean): boolean;
var
  FieldDesc: TFieldDesc;
  RecBuf: TRecordBuffer;
  Values: array of IntPtr;
  Types: array of integer;
  i, FieldCount: integer;
  IndexedFieldCount: integer;
  Bookmark: PRecBookmark;
  Res: integer;
  CalcKeyFields: boolean;
  FirstRecNo, LastRecNo: Integer;

  procedure SetKeyFields;
  var
    i: integer;
    Index: integer;
    TmpValue: IntPtr;
    TmpType: integer;
    Value: variant;
  begin
    CalcKeyFields := False;
    FieldCount := KeyFields.Count;
    SetLength(Values, FieldCount);
    for i := 0 to FieldCount - 1 do begin
      Values[i] := nil; // Clear Values array to prevent AV in 'finally' section after Exception

      if TFieldDesc(KeyFields[i]).FieldDescKind = fdkCalculated then
        CalcKeyFields := True;
    end;

    SetLength(Types, FieldCount);
    for i := 0 to FieldCount - 1 do begin
      Value := Unassigned;
      if VarIsArray(KeyValues)
        and ((FieldCount > 1) or (VarArrayHighBound(KeyValues, 1) = 0)) then
        if i <= VarArrayHighBound(KeyValues, 1) then
          Value := KeyValues[i]
        else
          Value := Null
      else
        if i = 0 then
          Value := KeyValues
        else
          Value := Null;

      CopyFieldValue(Value, Values[i], Types[i], TFieldDesc(KeyFields[i]));
    end;


    IndexedFieldCount := 0;
    if not ((lxPartialKey in Options) or (lxPartialCompare in Options) or (lxNearest in Options))then      //lxPartialKey and lxPartialCompare incompatible with ordered locate
                                                                                                           //lxNearest can be partially supported in the next versions  
      for i := 0 to TMemData(Data).IndexFields.Count - 1 do begin
        //Check ordered locate posibility for current Index field
        if (not TMemData(Data).IndexFields[i].CaseSensitive) xor
          (lxCaseInsensitive in Options) then
          break;

        //First IndexFields should be in KeyFields if not then we can't use ordered Locate
        Index := KeyFields.IndexOf(TMemData(Data).IndexFields[i].FieldDesc);
        if (Index > -1) then begin
          if IndexedFieldCount <> Index then begin
            FieldDesc := TFieldDesc(KeyFields[IndexedFieldCount]);
            KeyFields[IndexedFieldCount] := KeyFields[Index];
            KeyFields[Index] := FieldDesc;

            TmpValue := Values[IndexedFieldCount];
            Values[IndexedFieldCount] := Values[Index];
            Values[Index] := TmpValue;

            TmpType := Types[IndexedFieldCount];
            Types[IndexedFieldCount] := Types[Index];
            Types[Index] := TmpType;
          end;
          inc(IndexedFieldCount);
        end
        else
          break;

      end;

  end;

  function GetGoldenSectionDir(ReadRecBuf: boolean): integer;
  var
    i: integer;
    FieldBlank: boolean;
    Dir: Integer;
  begin
    Result := 0;
    i := 0;
    if ReadRecBuf then
      Data.GetRecord(RecBuf);

    if CalcKeyFields then
      GetCalcFields(RecBuf);

    while (Result = 0) and (i < IndexedFieldCount) do begin
      FieldDesc := TFieldDesc(KeyFields[i]);

      FieldBlank := TMemData(Data).GetNull(FieldDesc.FieldNo, RecBuf);

      if TMemData(Data).IndexFields[i].DescendingOrder then
        Dir := -1
      else
        Dir := 1;

      if FieldBlank and (Values[i] = nil) then
        Result := 0
      else
      if FieldBlank and not (Values[i] = nil) then
        Result := 1
      else
      if not FieldBlank and (Values[i] = nil) then
        Result := -1
      else
        Result := TMemData(Data).CompareFieldValue(Values[i], Types[i], FieldDesc, RecBuf, Options);

      if Result <> 0 then
        Result := Result * Dir;
      Inc(i);
    end;
  end;

  function ExecGoldenSection: boolean;
  var
    First, Last, Current: Integer;
    Dir: Integer;
    
  begin
    Result := False;

    First := FirstRecNo;
    Last  := LastRecNo;

    Data.RecordNo := First;
    Dir := GetGoldenSectionDir(True);
    if Dir <= 0 then begin
      Result := Dir = 0;
      Exit;
    end;

    Data.RecordNo := Last;
    Dir := GetGoldenSectionDir(True);
    if Dir >= 0 then begin
      Result := Dir = 0;
      Exit;
    end;

    repeat
      Current := (Last + First) div 2;
      TMemData(Data).RecordNo := Current;
      Dir := GetGoldenSectionDir(True);
      if Dir < 0 then
        Last := Current
      else
      if Dir > 0 then
        First := Current
      else begin
        Result := True;
        Break;
      end;
    until  Last - First <= 1;
  end;

begin
  Result := False;
  if KeyFields.Count = 0 then
    Exit;

  CheckBrowseMode;
  CursorPosChanged;
  UpdateCursorPos;

  FieldCount := 0;

  RecBuf := TempBuffer;
  FreeRefComplexFields(RecBuf);

  Values := nil;
  Bookmark := Marshal.AllocHGlobal(sizeof(TRecBookmark));
  try
    SetKeyFields;
    Data.GetBookmark(Bookmark);

    //Set locate dimensions. This dimensions should be used for lxNearest ordered implementation
    FirstRecNo := 1;
    LastRecNo := Data.RecordCount;

    if (lxNext in Options) then begin//Search from current position
      if IndexedFieldCount > 0 then
        Data.GetNextRecord(RecBuf);  //Next RecNo in case of Ordered Search
      FirstRecNo := Data.RecordNo;
    end;

    if (lxUp in Options) then begin  //Search from current position downto first
      if IndexedFieldCount > 0 then
        Data.GetPriorRecord(RecBuf); //Prior RecNo in case of Ordered Search
      LastRecNo := Data.RecordNo;
    end;

    if IndexedFieldCount > 0 then begin
      TMemData(Data).PrepareRecNoCache;
      Result := ExecGoldenSection;

    //Find the first occurence of located data
    if Result then
        repeat

          if (lxUp in Options) then begin
            if Data.RecordNo >= LastRecNo then //top limit of first occurrence search
              break
            else begin
              Data.GetNextRecord(RecBuf);
              if Data.Eof or (GetGoldenSectionDir(False) <> 0) then begin
                if IndexedFieldCount >= FieldCount then  //we shouldn't restore correct position in case of mixed locate
                  Data.GetPriorRecord(RecBuf);   //Restore correct position
                break;
              end;
            end;
          end
          else
            if Data.RecordNo <= FirstRecNo then //bottom limit of first occurrence search
              break
            else begin
              Data.GetPriorRecord(RecBuf);
              if (GetGoldenSectionDir(False) <> 0) then begin
                if IndexedFieldCount >= FieldCount then  //we shouldn't restore correct position in case of mixed locate
                  Data.GetNextRecord(RecBuf);     //Restore correct position
                break;
              end;  
            end;

        until Data.Bof or Data.Eof;
    end;
    

    if (IndexedFieldCount = 0) or ((IndexedFieldCount < FieldCount) and Result) then begin

      if not((lxNext in Options) or (lxUp in Options)) and not (IndexedFieldCount > 0) then
        Data.SetToBegin;

      while True do begin
        if lxUp in Options then
          Data.GetPriorRecord(RecBuf)
        else
          Data.GetNextRecord(RecBuf);

        if CalcKeyFields then
          GetCalcFields(RecBuf);

        if not (Data.EOF or Data.BOF) then begin
          Result := True;
          i := 0;
          while Result and (i < FieldCount) do begin
            FieldDesc := TFieldDesc(KeyFields[i]);
            if (Values[i] = nil) or Data.GetNull(FieldDesc.FieldNo, RecBuf) then
              Result := (Values[i] = nil) and Data.GetNull(FieldDesc.FieldNo, RecBuf)
            else begin
              Res := TMemData(Data).CompareFieldValue(Values[i], Types[i], FieldDesc, RecBuf, Options);
              Result := (Res = 0) or (Res < 0) and (lxNearest in Options);
            end;
            Inc(i);
          end;

          if Result then
            break;
        end
        else begin
          Result := False;
          break;
        end;
      end;
    end;

    if (SavePos or not Result)
      and not (Data.Eof and Data.Bof {Empty Data}) then
      Data.SetToBookmark(Bookmark);
  finally
    Marshal.FreeHGlobal(Bookmark);
    for i := 0 to FieldCount - 1 do
      Marshal.FreeHGlobal(Values[i]);
  end;
end;

function TMemDataSet.LocateRecord(const KeyFields: string; const KeyValues: variant;
  Options: TLocateExOptions; SavePos: boolean): boolean;
var
  Fields: TDAList;
  FieldDesc: TFieldDesc;

  procedure ParseKeyFields;
  var
    St: string;
    i: integer;
  begin
    i := 1;
    while True do begin
      St := ExtractFieldName(KeyFields, i);
      if St <> '' then begin
        FieldDesc := Data.FieldByName(St);
        if FieldDesc <> nil then
          Fields.Add(FieldDesc);
      end
      else
        break;
    end;
  end;

begin
  Fields := TDAList.Create;
  try
    ParseKeyFields;
    Result := InternalLocateRecord(Fields, KeyValues, Options, SavePos);
  finally
    Fields.Free;
  end;
end;

function TMemDataSet.LocateRecord(const KeyFields: array of TField; const KeyValues: variant;
  Options: TLocateExOptions; SavePos: boolean): boolean;
var
  Fields: TDAList;
  i: integer;
begin
  Fields := TDAList.Create;
  try
    for i := 0 to Length(KeyFields) - 1 do begin
      if KeyFields[i] <> nil then
        Fields.Add(GetFieldDesc(KeyFields[i]));
    end;

    Result := InternalLocateRecord(Fields, KeyValues, Options, SavePos);
  finally
    Fields.Free;
  end;
end;

function LocateExOptions(Options: TLocateOptions): TLocateExOptions;
begin
  Result := [];
  if loCaseInsensitive in Options then
    Result := Result + [lxCaseInsensitive];

  if loPartialKey in Options then
    Result := Result + [lxPartialKey];
end;

function TMemDataSet.Locate(const KeyFields: array of TField; const KeyValues: variant;
  Options: TLocateOptions): boolean;
begin
  DoBeforeScroll;

  Result := LocateRecord(KeyFields, KeyValues, LocateExOptions(Options), False);

  if Result then begin
    Resync([{rmExact, rmCenter}]);
    DoAfterScroll;
  end;
end;

function TMemDataSet.Locate(const KeyFields: string;
  const KeyValues: variant; Options: TLocateOptions): boolean;
begin
  DoBeforeScroll;

  Result := LocateRecord(KeyFields, KeyValues, LocateExOptions(Options), False);

  if Result then begin
    Resync([{rmExact, rmCenter}]);
    DoAfterScroll;
  end;
end;

function TMemDataSet.LocateEx(const KeyFields: string;
  const KeyValues: variant; Options: TLocateExOptions): boolean;
begin
  DoBeforeScroll;

  Result := LocateRecord(KeyFields, KeyValues, Options, False);

  if Result then begin
    Resync([{rmExact, rmCenter}]);
    DoAfterScroll;
  end;
end;

function TMemDataSet.LocateEx(const KeyFields: array of TField;
  const KeyValues: variant; Options: TLocateExOptions): boolean;
begin
  DoBeforeScroll;

  Result := LocateRecord(KeyFields, KeyValues, Options, False);

  if Result then begin
    Resync([{rmExact, rmCenter}]);
    DoAfterScroll;
  end;
end;

function TMemDataSet.Lookup(const KeyFields: string; const KeyValues: variant;
  const ResultFields: string): variant;
begin
  Result := Null;
  if LocateRecord(KeyFields, KeyValues, [], True) then begin
    SetTempState(dsCalcFields);
    try
      CalculateFields(TempBuffer);
      Result := FieldValues[ResultFields];
    finally
      RestoreState(dsBrowse);
    end;
  end;
end;

{ CachedUpdates }

procedure TMemDataSet.CheckCachedUpdateMode;
begin
  if not CachedUpdates then
    DatabaseError(SNotCachedUpdate);
end;

function TMemDataSet.UpdateStatus: TUpdateStatus;
var
  RecBuf: TRecordBuffer;
begin
  if CachedUpdates and not IsEmpty then begin
    if State = dsCalcFields then
      RecBuf := CalcBuffer
    else
      RecBuf := ActiveBuffer;

    Result := PRecInfo(integer(RecBuf) + FRecInfoOfs).UpdateStatus;
  end
  else
    Result := usUnModified;
end;

function TMemDataSet.UpdateResult: TUpdateAction;
begin
  UpdateCursorPos;

  if Data.GetUpdateResult = urNone then
    Result := uaApplied
  else
    Result := TUpdateAction(Data.GetUpdateResult);
end;

procedure TMemDataSet.ApplyUpdates;
begin
  CheckActive;
  FreeRefBuffers;
  if State <> dsBrowse then
    Post;
  CheckCachedUpdateMode;
  UpdateCursorPos;

  NewCacheRecBuf := AllocRecordBuffer;
  OldCacheRecBuf := AllocRecordBuffer;
  FInCacheProcessing := True;
  try
    Data.SetCacheRecBuf(NewCacheRecBuf, OldCacheRecBuf);
    Data.ApplyUpdates;
  finally
    FInCacheProcessing := False;
    FreeRecordBuffer(NewCacheRecBuf);
    FreeRecordBuffer(OldCacheRecBuf);
    Resync([]);
  end;
end;

procedure TMemDataSet.CommitUpdates;
begin
  CheckActive;
  CheckCachedUpdateMode;
  FreeRefBuffers;
  UpdateCursorPos;

  NewCacheRecBuf := AllocRecordBuffer;
  OldCacheRecBuf := AllocRecordBuffer;
  FInCacheProcessing := True;
  try
    Data.SetCacheRecBuf(NewCacheRecBuf, OldCacheRecBuf);
    Data.CommitUpdates;
  finally
    FInCacheProcessing := False;
    FreeRecordBuffer(NewCacheRecBuf);
    FreeRecordBuffer(OldCacheRecBuf);
  end;
  Resync([]);
end;

procedure TMemDataSet.CancelUpdates;
begin
  CheckActive;
  FreeRefBuffers;
  Cancel;
  CheckCachedUpdateMode;
  UpdateCursorPos;
  Data.CancelUpdates;
  Resync([]);
end;

procedure TMemDataSet.RestoreUpdates;
begin
  CheckActive;
  FreeRefBuffers;
  Cancel;
  CheckCachedUpdateMode;
  UpdateCursorPos;
  Data.RestoreUpdates;
  Resync([]);
end;

procedure TMemDataSet.RevertRecord;
begin
  CheckActive;
  FreeRefComplexFields(ActiveBuffer);
  if State in dsEditModes then
    Cancel;
  CheckCachedUpdateMode;
  UpdateCursorPos;
  Data.RevertRecord;
  Resync([]);
end;

procedure TMemDataSet.DoApplyRecord(UpdateKind: TUpdateRecKind; var Action: TUpdateRecAction; LastItem: boolean);
var
  OldModified: boolean;
  UpdateAction: TUpdateAction;
begin
  OldModified := Modified;  // NewValue change Modified ??? or MemDS
  try
    UpdateAction := uaFail;
    try
      if Assigned(OnUpdateRecord) then begin
        OnUpdateRecord(Self, TUpdateKind(UpdateKind), UpdateAction);
        if UpdateAction in [uaAbort] then
          Abort;
      end;
      //else begin
      if not Assigned(OnUpdateRecord) or (UpdateAction = TUpdateAction(uaDefault)) then begin
        case UpdateKind of
          ukUpdate:
            PerformUpdate;
          ukInsert:
            PerformAppend;
          ukDelete:
            PerformDelete;
        end;

        if BatchUpdate then
          if CanFlushBatch or LastItem then
            // Should be flushed here because of Action parameter that should be returned
            // to TMemData.ApplyUpdates function
            FlushBatch
          else begin
            Action := urSuspended;
            Exit;
          end;

        UpdateAction := uaApplied;
      end;
    except
      on E: Exception do
        if IsClass(E, EDatabaseError) and Assigned(OnUpdateError) then begin
          OnUpdateError(Self, EDatabaseError(E), TUpdateKind(UpdateKind), UpdateAction);
          case UpdateAction of
            uaFail:
              raise;
            uaAbort:
              Abort;
          end;
        end
        else
          raise;
    end;
  finally
    SetModified(OldModified);
  end;
  Action := TUpdateRecAction(UpdateAction);
end;

function TMemDataSet.BatchUpdate: boolean;
begin
  Result := False;
end;

function TMemDataSet.CanFlushBatch: boolean;
begin
  Result := False;
end;

procedure TMemDataSet.FlushBatch;
begin
  Assert(False, 'Should be overridden');
end;

{ BLOB Support }

{function TMemDataSet.GetBlobData(Field:TField; Buffer: PChar):TBlobData;
begin
  Result := PBlobDataArray(Buffer + FBlobCacheOfs)[Field.Offset];
end;

procedure TMemDataSet.SetBlobData(Field:TField; Buffer: PChar; Value:TBlobData);
begin
  if Buffer = ActiveBuffer then
    PBlobDataArray(Buffer + FBlobCacheOfs)[Field.Offset] := Value;
end;

procedure TMemDataSet.ClearBlobCache(Buffer: PChar);
var
  i: integer;
begin
  for i := 0 to BlobFieldCount - 1 do
    PBlobDataArray(Buffer + FBlobCacheOfs)[i] := '';
end;}

procedure TMemDataSet.CloseBlob(Field: TField);
begin
end;

function TMemDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
begin
  Result := TBlobStream.Create(Field as TBlobField, Mode);
end;

{ Informational }

function TMemDataSet.IsSequenced: boolean;
begin
  Result := True;
end;

function TMemDataSet.GetRecordSize: word;
begin
  Result := word(Data.RecordSize);
end;

function TMemDataSet.GetRecordCount: integer;
begin
  if Active then
    Result := Data.RecordCount
  else
    Result := 0;
end;

function TMemDataSet.GetRecNo: integer;
var
  RecBuf: TRecordBuffer;
begin
  if GetActiveRecBuf(RecBuf) then
    Result := PRecInfo(integer(RecBuf) + FRecInfoOfs).RecordNumber
  else
    Result := 0;
end;

procedure TMemDataSet.SetRecNo(Value: integer);
begin
  CheckBrowseMode;
  DoBeforeScroll;
  Data.RecordNo := Value;
  Resync([{rmCenter}]);
  DoAfterScroll;
end;

{ More }

procedure TMemDataSet.InternalHandleException;
begin
{$IFDEF VER6P}
  if Assigned(Classes.ApplicationHandleException) then
    Classes.ApplicationHandleException(ExceptObject)
  else
    ShowException(ExceptObject, ExceptAddr)
{$ELSE}
  ApplicationHandleException(Self);
{$ENDIF}
end;

{$IFDEF CLR}
procedure TMemDataSet.DataEvent(Event: TDataEvent; Info: TObject);
{$ELSE}
procedure TMemDataSet.DataEvent(Event: TDataEvent; Info: longint);
{$ENDIF}
  procedure CheckIfParentScrolled;
  var
    ParentPosition, I: Integer;
  begin
    if FParentDataSet = nil then
      Exit;
    ParentPosition := 0;
    with FParentDataSet do
      if not IsEmpty then
        for I := 0 to BookmarkSize - 1 do
          ParentPosition := ParentPosition +
            Marshal.ReadByte(ActiveBuffer, FBookmarkOfs + I);
    if (FLastParentPos = 0) or (ParentPosition <> FLastParentPos) then
    begin
      First;
      FLastParentPos := ParentPosition;
    end else
    begin
      UpdateCursorPos;
      Resync([]);
    end;
  end;

begin
  if Event = deParentScroll then
    CheckIfParentScrolled;
  inherited DataEvent(Event, Info);
end;

procedure TMemDataSet.AssignTo(Dest: TPersistent);
begin
  if Dest is TMemDataSet then begin
    TMemDataSet(Dest).CachedUpdates := CachedUpdates;
    TMemDataSet(Dest).LocalConstraints := LocalConstraints;
    TMemDataSet(Dest).LocalUpdate := LocalUpdate;
  end
  else
    inherited;
end;

procedure TMemDataSet.SetCachedUpdates(Value: boolean);
begin
  if FCachedUpdates <> Value then begin
    CheckInactive;
    FCachedUpdates := Value;
    Data.CachedUpdates := FCachedUpdates;
  end;
end;

function TMemDataSet.GetUpdatesPending: boolean;
begin
  Result := Data.UpdatesPending;
end;

function TMemDataSet.GetPrepared: boolean;
begin
  Result := Data.Prepared;
end;

procedure TMemDataSet.SetPrepared(Value: boolean);
begin
  if Value then
    Prepare
  else
    UnPrepare;
end;

function TMemDataSet.GetUpdateRecordSet: TUpdateRecordTypes;
var
  ItemTypes: TItemTypes;
begin
//  if Active then begin
    CheckCachedUpdateMode;
    ItemTypes := Data.FilterItemTypes;

    Result := [];
    if isUnmodified in ItemTypes then
      Result := Result + [rtUnmodified];
    if isUpdated in ItemTypes then
      Result := Result + [rtModified];
    if isAppended in ItemTypes then
      Result := Result + [rtInserted];
    if isDeleted in ItemTypes then
      Result := Result + [rtDeleted];
{  end
  else
    Result := [];}
end;

procedure TMemDataSet.SetUpdateRecordSet(Value: TUpdateRecordTypes);
var
  ItemTypes: TItemTypes;
begin
  CheckCachedUpdateMode;

  //CheckBrowseMode;
  if Active then
    UpdateCursorPos;

  ItemTypes := [];
  if rtUnmodified in Value then
    ItemTypes := ItemTypes + [isUnmodified];
  if rtModified in Value then
    ItemTypes := ItemTypes + [isUpdated];
  if rtInserted in Value then
    ItemTypes := ItemTypes + [isAppended];
  if rtDeleted in Value then
    ItemTypes := ItemTypes + [isDeleted];

  Data.FilterItemTypes := ItemTypes;

 if Active then
   Resync([]);
end;

{ TBlobStream }

constructor TBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
begin
  inherited Create;

  FMode := Mode;
  FField := Field;
  FDataSet := FField.DataSet as TMemDataSet;
  FFieldNo := FField.FieldNo;
  if not FDataSet.GetActiveRecBuf(FBuffer) then
    Exit;
{  if FDataSet.State = dsFilter then
    DatabaseErrorFmt('SNoFieldAccess', [FField.DisplayName]);}
  if not FField.Modified then begin
    if Mode = bmRead then begin
{      FCached := FDataSet.FCacheBlobs and (FBuffer = FDataSet.ActiveBuffer) and
        (FField.IsNull or (FDataSet.GetBlobData(FField, FBuffer) <> ''));}
    end
    else begin
//      FDataSet.SetBlobData(FField, FBuffer, '');
      if FField.ReadOnly then
        DatabaseErrorFmt(SFieldReadOnly, [FField.DisplayName]);
      if not (FDataSet.State in [dsNewValue, dsEdit, dsInsert]) then
        DatabaseError(SNotEditing);
    end;
  end;
  FOpened := True;
  if Mode = bmWrite then
    Truncate;
end;

destructor TBlobStream.Destroy;
begin
  if FOpened then begin
    if FModified then
      FField.Modified := True;
  end;
  if FModified then
    //try
    {$IFDEF CLR}
      FDataSet.DataEvent(deFieldChange, FField);
    {$ELSE}
      FDataSet.DataEvent(deFieldChange, longint(FField));
    {$ENDIF}
    {except
      Application.HandleException(Self);
    end;}
end;

{$IFDEF CLR}
function TBlobStream.Read(var Buffer: TBytes; Offset, Count: Longint): Longint;
var
  Handle: IntPtr;
{$ELSE}
function TBlobStream.Read(var Buffer; Count: longint): longint;
{$ENDIF}
begin
  Result := 0;
  if FOpened then begin
    if Count > Size - FPosition then
      Result := Size - FPosition
    else
      Result := Count;
    if Result > 0 then begin
    {$IFDEF CLR}
      Handle := AllocGCHandle(Buffer, True);
      try
        Result := FDataSet.Data.ReadBlob(FFieldNo, FBuffer, FPosition, Count,
          GetAddrOfPinnedObject(Handle), FDataSet.State = dsOldValue{$IFDEF VER10P}, (FField is TWideMemoField){$ENDIF});
      finally
        FreeGCHandle(Handle);
      end;
    {$ELSE}
      Result := FDataSet.Data.ReadBlob(FFieldNo, FBuffer, FPosition, Count, @Buffer,
        (FDataSet.State = dsOldValue){$IFDEF VER10P}, (FField is TWideMemoField){$ENDIF});
    {$ENDIF}
      Inc(FPosition, Result);
    end;
  end;
end;

{$IFDEF CLR}
function TBlobStream.Write(const Buffer: TBytes; Offset, Count: Longint): Longint;
var
  Handle: IntPtr;
{$ELSE}
function TBlobStream.Write(const Buffer; Count: Longint): Longint;
{$ENDIF}
begin
  Result := 0;
  if FOpened then begin
  {$IFDEF CLR}
    Handle := AllocGCHandle(Buffer, True);
    try
      FDataSet.Data.WriteBlob(FFieldNo, FBuffer, FPosition, Count,
        GetAddrOfPinnedObject(Handle){$IFDEF VER10P}, FField is TWideMemoField{$ENDIF});
    finally
      FreeGCHandle(Handle);
    end;

  {$ELSE}
    FDataSet.Data.WriteBlob(FFieldNo, FBuffer, FPosition, Count, @Buffer
    {$IFDEF VER10P}, FField is TWideMemoField{$ENDIF});
  {$ENDIF}
    Inc(FPosition, Count);
    Result := Count;
    FModified := True;
{    FDataSet.SetBlobData(FField, FBuffer, '');}
  end;
end;

{$IFDEF CLR}
function TBlobStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
{$ELSE}
function TBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
{$ENDIF}
begin
  case Origin of
    soFromBeginning:
      FPosition := Offset;
    soFromCurrent:
      Inc(FPosition, Offset);
    soFromEnd:
      FPosition := GetBlobSize + Offset;
  end;
  Result := FPosition;
end;

procedure TBlobStream.Truncate;
begin
  if FOpened then begin
    FDataSet.Data.TruncateBlob(FFieldNo, FBuffer, FPosition
      {$IFDEF VER10P}, FField is TWideMemoField{$ENDIF});
    FModified := True;
//    FDataSet.SetBlobData(FField, FBuffer, '');
  end;
end;

function TBlobStream.GetBlobSize: longint;
begin
  Result := 0;
  if FOpened then
    Result := FDataSet.Data.GetBlobSize(FFieldNo, FBuffer, (FDataSet.State = dsOldValue)
    {$IFDEF VER10P}, FField is TWideMemoField{$ENDIF});
end;

{$IFDEF CLR}
procedure TBlobStream.SetSize(NewSize: Int64);
{$ELSE}
procedure TBlobStream.SetSize(NewSize: Longint);
{$ENDIF}
begin
  if FOpened then
    FDataSet.Data.SetBlobSize(FFieldNo, FBuffer, NewSize, (FDataSet.State = dsOldValue)
    {$IFDEF VER10P}, (FField is TWideMemoField){$ENDIF});
end;

class function TMemDSUtils.SetBlob(Obj: TMemDataSet; Field: TField; Blob: TBlob): boolean;
begin
  Result := Obj.SetBlob(Field, Blob);
end;

class function TMemDSUtils.GetBlob(Obj: TMemDataSet; FieldDesc: TFieldDesc): TBlob;
begin
  Result := Obj.InternalGetBlob(FieldDesc);
end;

end.
