unit uDAMemDataset;

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

{$I DataAbstract.inc}

interface
{.$DEFINE MEMDATASET_DEBUG}
uses
  {$IFDEF MSWINDOWS}Windows,{$ENDIF}
  Classes, DB, uDAExpressionEvaluator;

type
  PBookmarkData = ^TBookmarkData;
  TBookmarkData = Pointer;
  PRecInfo = ^TRecInfo;
  TRecInfo = packed record
    Bookmark: TBookmarkData;
    BookmarkFlag: TBookmarkFlag;
  end;

  TOffsetArray = array of Cardinal;
  PBLOBRecord = ^TBLOBRecord;
  TBLOBRecord = packed record
    size: Cardinal;
    Data: WideChar;
  end;

  TDAMemDatasetCompare = function(p1, p2: pointer): Integer of object;

  TDAMemoryDataset = class(TDataset)
  private
    FRecordsList: TList;
    FDataList: TList;
    FRecordPos: integer;
    FActive: Boolean;
    FOffsets: TOffsetArray;
    FDataSizeArray:TOffsetArray;
    FCalculatedOffset: Cardinal; // not used = FDatasetBufferSize
    FDatasetBufferSize: Cardinal;
    FNativeRecordSize: Cardinal;
    FBookMarkOffset: Cardinal; // = FNativeRecordSize
    FNullMaskSize: Cardinal;
    FMasterDataLink: TMasterDataLink;
    FFilterBuffer: PChar;
    FIndexFieldNames: string;
    FIndexFieldNameList: TList;
    FSortDescMode: Boolean;
    FSortCaseInsensitive: Boolean;
    FDataTypeArray: array of TFieldType;
    FStoreStringsAsReference: boolean;
    FExpressionEvaluator: TDAExpressionEvaluator;
    FExpressionBuffer: Pchar;
    {$IFDEF MSWINDOWS}
    FSortLocale: LCID;
    {$ENDIF MSWINDOWS}
    procedure CalculateOffsets;
    procedure ClearRecords;
    procedure ClearRecord(Buffer: PChar; AReInitRecord: Boolean);
    procedure ClearField(FieldBuffer: pointer; ADataType: TFieldType); overload;
    procedure ClearField(Buffer: pointer; AField: TField); overload;
    function IsReferencedField(ADataType: TFieldType):Boolean;
    function GetNullMask(Buffer: PChar; const Index: Integer): boolean;
    function IntGetBookmark(ARecNo: Integer): TBookmarkData;
    function IntFindRecordID(Bookmark: TBookmarkData): Integer;
    function GetActiveRecBuf(var RecBuf: PChar): Boolean;
//    function IntFindFieldData(Buffer: Pointer; Field: TField): Pointer;
    procedure InternalSetFieldData(Field: TField; Buffer: Pointer);
    procedure IntAssignRecord(Source, Dest: Pchar);
    function IntAllocRecordBuffer(const ANative: Boolean): PChar;
    procedure IntFreeRecordBuffer(var Buffer: PChar{$IFDEF MEMDATASET_DEBUG};const ANative: Boolean=true{$ENDIF});
    procedure SetBlobData(Field: TField; Buffer: PChar; Value: Pointer);
    function GetMasterFields: string;
    procedure SetDataSource(const Value: TDataSource);
    procedure SetMasterFields(const Value: string);
    function GetIndexFieldNames: string;
    procedure SetIndexFieldNames(const Value: string);
    function InternalGetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
    procedure DoSort;
    procedure QuickSort(L, R: Integer; SCompare: TDAMemDatasetCompare);
    function Compare(i1, i2: pointer): Integer;
    function CompareValues(buf1, buf2: pointer; aDataType: TFieldType): integer;
    function CompareValues2(buf1: pointer; aValue:variant; aDataType: TFieldType;aSortCaseInsensitive, aPartialKey :Boolean): boolean;
    procedure DoFilterRecords;
    function FilterRecord(buf: pointer; AUseEvent: Boolean):Boolean;
    procedure InitIndexFieldNamesList(AFieldNames: string);
    procedure SetStoreStringAsReference(const Value: Boolean);
    procedure EEGetValue(Sender: TDAExpressionEvaluator; const aIdentifier: string; out aValue: Variant);
    function GetVarValueFromBuffer(Buffer: pointer; Field: TField):variant;
    function IsActiveFilter: Boolean;
  protected
    // for IDAMemDatasetBatchAdding
    procedure SetNullMask(Buffer: PChar; const Index: Integer; const Value: boolean);
    function IntFindFieldData(Buffer: Pointer; Field: TField): Pointer;
    function IntCreateBuffer(const ANative: Boolean): Pchar;
    function MakeBlobFromString(Blob:String):pointer;
    procedure IntInsertBuffer(Buffer: Pointer);
    function GetFieldOffset(const aFieldNo:integer):cardinal;
    procedure SetAnsiString(NativeBuf: Pointer; Field: TField; const Value: Ansistring);
    procedure SetWideString(NativeBuf: Pointer; Field: TField; const Value: Widestring);
    procedure ProcessFilter;
  protected
    procedure DuplicateBuffer(Source, Dest: PChar);
    procedure RecordToBuffer(RecNo: integer; Buffer: PChar);
    property MasterDataLink: TMasterDataLink read FMasterDataLink;
    procedure MasterChanged(Sender: TObject); virtual;
    procedure MasterDisabled(Sender: TObject); virtual;
    function LocateRecord(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions; SyncCursor: Boolean): Boolean;
  protected // tdataset
    procedure DoOnNewRecord; override;
    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    procedure InternalClose; override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalOpen; override;
    function IsCursorOpen: Boolean; override;
    function AllocRecordBuffer: PChar; override;
    procedure FreeRecordBuffer(var Buffer: PChar); override;
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
    function GetRecordSize: Word; override;
    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
    procedure InternalDelete; override;
    procedure InternalFirst; override;
    procedure InternalGotoBookmark(Bookmark: Pointer); override;
    procedure InternalInitRecord(Buffer: PChar); override;
    procedure InternalLast; override;
    procedure InternalPost; override;
    procedure InternalSetToRecord(Buffer: PChar); override;
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
    procedure SetFieldData(Field: TField; Buffer: Pointer); overload; override;
    function GetRecordCount: Integer; override;
    function GetRecNo: Integer; override;
    procedure SetRecNo(Value: Integer); override;
    procedure OpenCursor(InfoQuery: Boolean); override;
    procedure DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean); override;
    function GetDataSource: TDataSource; override;
    procedure SetFiltered(Value: Boolean); override;
    procedure SetFilterOptions(Value: TFilterOptions); override;
    procedure SetFilterText(const Value: string); override;
    procedure SetOnFilterRecord(const Value: TFilterRecordEvent); override;
    procedure DoAfterOpen; override;
  public //from TDataset         `
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
    procedure GetDetailLinkFields(MasterFields, DetailFields: TList); {$IFNDEF FPC}override;{$ENDIF}
    function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; override;
    function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
    function BookmarkValid(Bookmark: TBookmark): Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SortOnFields(const FieldNames: string = ''; CaseInsensitive: Boolean = True; Descending: Boolean = False);
    {$IFDEF MSWINDOWS}
    property SortLocale: LCID read FSortLocale write FSortLocale;
    {$ENDIF MSWINDOWS}
    property StoreStringAsReference: Boolean read FStoreStringsAsReference write SetStoreStringAsReference;
  published
    property Active;
    property FieldDefs;
    property OnFilterRecord;
    property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
    property MasterFields: string read GetMasterFields write SetMasterFields;
    property MasterSource: TDataSource read GetDataSource write SetDataSource;
  end;

  TDABlobStream = class(TMemoryStream)
  private
    FField: TBlobField;
    FDataSet: TDAMemoryDataset;
    FBuffer: PChar;
    FMode: TBlobStreamMode;
    FOpened: Boolean;
    FModified: Boolean;
    FPosition: Longint;
    FCached: Boolean;
    function GetBlobSize: Longint;
    function GetBLOBRecordFromRecord(Field: TField): PBLOBRecord;
    function GetBLOBRecordFromBuffer(Buffer: Pchar; Field: TField): PBLOBRecord;
  public
    constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    procedure Truncate;
  end;

implementation
uses
  uROClasses, uROBinaryHelpers,
  Variants, SysUtils,{$IFDEF FPC}dbconst,{$ELSE}DBConsts,{$ENDIF}
  {$IFNDEF FPC}Forms, SqlTimSt,{$ENDIF} FMTBcd;

{$IFDEF MEMDATASET_DEBUG}
var
  memdataset_buff_cnt,
  memdataset_buff_cnt_native,
  memdataset_buff_cnt_notnative: cardinal;
{$ENDIF}

const
  guidsize = 38; { Length(GuidString) }

resourcestring
  SNoDetailFilter = 'Filter property cannot be used for detail tables';
  SNoFilterOptions = 'FilterOptions are not supported';
const
  ft_Inline = [ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat,
               ftCurrency, ftDate, ftTime, ftDateTime, ftAutoInc,
               ftLargeint, ftTimeStamp, ftBCD, {$IFDEF DELPHI6UP}ftFMTBCD, {$ENDIF}ftGuid];
  ft_BlobTypes = [ftBlob, ftMemo,{$IFDEF DELPHI10UP}ftWideMemo,{$ENDIF DELPHI10UP} ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftOraBlob, ftOraClob];
  ft_Strings = [ftString, ftWideString, ftFixedChar];
  ft_Supported = ft_Inline + ft_BlobTypes + ft_Strings;
  ft_UnSupported = [ftADT, ftArray, ftReference, ftDataSet, ftBytes, ftVarBytes] + [ftVariant];

function CreateBlobRecord(ASize: cardinal = 0; AInit: Boolean = False): PBlobRecord;
begin
  GetMem(Result, ASize + SizeOf(TBLOBRecord));
  FillChar(Result^, sizeof(TBLOBRecord), 0);
  Result.size:=ASize;
  if AInit then FillChar(Result.Data, Asize, 0);
end;

procedure FreeBlobRecord(buf: Pointer);
begin
  if buf = nil then Exit;
  FreeMem(buf);
end;

{ TDAMemoryDataset }

function TDAMemoryDataset.AllocRecordBuffer: PChar;
begin
  Result := IntAllocRecordBuffer(False);
end;

procedure TDAMemoryDataset.CalculateOffsets;
var
  i: integer;
  lField: TField;
  llen: cardinal;
begin
  SetLength(FOffsets, FieldCount + 1);
  SetLength(FDataSizeArray,FieldCount);
  SetLength(FDataTypeArray,FieldCount);
  // FOffsets[FieldCount+1] = BookMarkOffset
  FNullMaskSize := (FieldCount + 7) div 8;
  FOffsets[0] := FNullMaskSize;
  for i := 0 to FieldCount - 1 do begin
    lField := Fields[i];
    FDataTypeArray[i]:=lField.DataType;
    if IsReferencedField(lField.DataType) then
      llen := sizeof(Pointer)
    else if lField.DataType = ftWideString then
      lLen := (lField.Size + 1) * Sizeof(WideChar)
    else
      llen := lField.DataSize;
    FDataSizeArray[i] := llen;  
    FOffsets[i + 1] := FOffsets[i] + llen;
  end;
  FNativeRecordSize := FOffsets[FieldCount];
  FBookMarkOffset := FNativeRecordSize;
  FCalculatedOffset := FBookMarkOffset + SizeOf(TRecInfo);
  FDatasetBufferSize := FCalculatedOffset;
end;

procedure TDAMemoryDataset.ClearField(FieldBuffer: pointer; ADataType: TFieldType);
begin
  case ADataType of
    ftString: begin
      PAnsiString(FieldBuffer)^ := '';
      PPointer(FieldBuffer)^ := nil;
    end;
    ftWideString: begin
      PWideString(FieldBuffer)^ := '';
      PPointer(FieldBuffer)^ := nil;
    end;
  else
    if ADataType in ft_BlobTypes then  begin
      FreeBlobRecord(PPointer(FieldBuffer)^);
      PPointer(FieldBuffer)^ := nil;
    end;
  end;
end;

procedure TDAMemoryDataset.ClearField(Buffer: pointer; AField: TField);
begin
  if GetNullMask(Buffer, AField.Index) then Exit;
  if IsReferencedField(AField.DataType) then
    ClearField(IntFindFieldData(Buffer, AField), AField.DataType);
  SetNullMask(Buffer, AField.Index, True);
end;

procedure TDAMemoryDataset.ClearRecord(Buffer: PChar; AReInitRecord: Boolean);
var
  i: integer;
begin
  for i := 0 to FieldCount - 1 do begin
    if IsReferencedField(FDataTypeArray[i]) then
      ClearField((Buffer + FOffsets[i]), FDataTypeArray[i]);
  end;
  if AReInitRecord then
    // set NullMask
    for i := 0 to FNullMaskSize - 1 do
      Buffer[i] := #$FF; // all fields is null
end;

procedure TDAMemoryDataset.ClearRecords;
var
  i,j: integer;
  buf: pchar;
begin
  for i := FRecordsList.Count - 1 downto 0 do begin
    buf := FRecordsList.List[i];
    for j := 0 to FieldCount - 1 do
      if IsReferencedField(FDataTypeArray[j]) then
        ClearField((Buf + FOffsets[j]), FDataTypeArray[j]);
    FreeMem(Buf);
  end;
  FRecordsList.Clear;
  FDataList.Clear;
end;

constructor TDAMemoryDataset.Create(AOwner: TComponent);
begin
  inherited;
  FRecordsList := TList.Create;
  FDataList := TList.Create;
  FMasterDataLink := TMasterDataLink.Create(Self);
  FMasterDataLink.OnMasterChange := MasterChanged;
  FMasterDataLink.OnMasterDisable := MasterDisabled;
  FIndexFieldNameList := TList.Create;
  {$IFDEF MSWINDOWS}
  FSortLocale := LOCALE_USER_DEFAULT;
  {$ENDIF MSWINDOWS}
  FStoreStringsAsReference:=False;
  FExpressionEvaluator:= TDAStdExpressionEvaluator.Create;
  FExpressionEvaluator.OnGetValue := EEGetValue;
end;

function TDAMemoryDataset.CreateBlobStream(Field: TField;
  Mode: TBlobStreamMode): TStream;
begin
  Result := TDABlobStream.Create(TBlobField(Field), Mode);
end;

destructor TDAMemoryDataset.Destroy;
begin
  inherited;
  FExpressionEvaluator.Free;
  FIndexFieldNameList.Free;
  FMasterDataLink.Free;
  FDataList.Free;
  FRecordsList.Free;
end;

procedure TDAMemoryDataset.DuplicateBuffer(Source, Dest: PChar);
var
  i: integer;
  p, p2: PBlobRecord;
begin
  for I := 0 to FieldCount - 1 do
    if (not GetNullMask(Dest, i)) and
      IsReferencedField(FDataTypeArray[i]) and
      (PPointer(Dest + FOffsets[i])^ <> nil) then
      ClearField(Dest + FOffsets[i], FDataTypeArray[i]);

  Move(pointer(Source)^, pointer(Dest)^, FNullMaskSize);

  for I := 0 to FieldCount - 1 do begin
    if (not GetNullMask(Source, i)) then begin
      if not IsReferencedField(FDataTypeArray[i]) then begin
        Move(pointer(Source + FOffsets[i])^, pointer(Dest + FOffsets[i])^, FDataSizeArray[i])
      end
      else begin
        case FDataTypeArray[i] of
          ftString: PAnsiString(Dest + FOffsets[i])^ := PAnsiString(Source + FOffsets[i])^;
          ftWideString: PWideString(Dest + FOffsets[i])^ := PWideString(Source + FOffsets[i])^;
        else
          if FDataTypeArray[i] in ft_BlobTypes then begin
            p := PPointer(Source + FOffsets[i])^;
            p2 := CreateBlobRecord(PBlobRecord(p)^.size);
            Move(pointer(p)^, pointer(p2)^, p^.size + SizeOf(TBlobRecord));
            PPointer(Dest + FOffsets[i])^ := p2;
          end;
        end;
      end;
    end;
  end;
end;

procedure TDAMemoryDataset.EEGetValue(Sender: TDAExpressionEvaluator; const aIdentifier: string; out aValue: Variant);
begin
  aValue:= GetVarValueFromBuffer(FExpressionBuffer, FieldByName(aIdentifier));
end;

procedure TDAMemoryDataset.ProcessFilter;
begin
  CheckBrowseMode;
  DoFilterRecords;
end;


function TDAMemoryDataset.FilterRecord(buf: pointer; AUseEvent: Boolean): Boolean;
begin
  FExpressionBuffer:=buf;
  Result:= FExpressionEvaluator.Evaluate(Filter);
  if Result and AUseEvent and Assigned(OnFilterRecord) then OnFilterRecord(Self, Result);
end;

procedure TDAMemoryDataset.FreeRecordBuffer(var Buffer: PChar);
begin
  IntFreeRecordBuffer(Buffer{$IFDEF MEMDATASET_DEBUG}, False{$ENDIF});
end;

function TDAMemoryDataset.GetActiveRecBuf(var RecBuf: PChar): Boolean;
begin
  case State of
    dsBrowse:
      if IsEmpty then
        RecBuf := nil
      else
        RecBuf := ActiveBuffer;
    dsEdit, dsInsert, dsNewValue: RecBuf := ActiveBuffer;
    dsCalcFields: RecBuf := CalcBuffer;
    dsFilter: RecBuf := FFilterBuffer;
  else
    RecBuf := nil;
  end;
  Result := RecBuf <> nil;
end;

procedure TDAMemoryDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  Move(PRecInfo(Buffer + FBookMarkOffset).Bookmark, Data^, SizeOf(TBookmarkData));
end;

function TDAMemoryDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
  Result := PRecInfo(Buffer + FBookMarkOffset).BookmarkFlag;
end;

function TDAMemoryDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
  RecBuf, Data: PChar;
  //  VarData           : Variant;
  Len: integer;
begin
  Result := False;
  if not GetActiveRecBuf(RecBuf) then Exit;
  Data := intFindFieldData(RecBuf, Field);
  if Data <> nil then begin
    Result := GetNullMask(RecBuf, Field.Index) = False;
    if Result and (Buffer <> nil) then begin
      {if Field.DataType = ftVariant then
        begin
          VarData := PVariant(Data)^;
          PVariant(Buffer)^ := VarData;
        end
        else}
      if not IsReferencedField(Field.DataType) then begin
        Move(Data^, Buffer^, FDataSizeArray[Field.Index])
      end else begin
        case Field.DataType of
          ftString: begin
            len := Length(PAnsiString(Data)^);
            if Len > Field.Size then Len := Field.Size;
            Move(pointer(PAnsiString(Data)^)^, buffer^, len);
            PAnsiChar(buffer)[Len] := #0;
          end;
          ftWideString: begin
            len := Length(PWideString(Data)^);
            if Len > Field.Size then Len := Field.Size;
            Move(pointer(PWideString(Data)^)^, buffer^, len * sizeOf(WideChar));
            PWideChar(buffer)[Len] := #0;
          end;
        else
          if Field.DataType in ft_BlobTypes then DatabaseError('GetFieldData: BlobType');
        end;
      end;
    end;
  end;
end;

function TDAMemoryDataset.GetRecNo: Integer;
begin
  UpdateCursorPos;
  if (FRecordPos = -1) and (RecordCount > 0) then
    Result := 1
  else
    Result := FRecordPos + 1;
end;

function TDAMemoryDataset.InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
begin
  if Buffer = nil then begin
    Result := grError;
    Exit;
  end;

  Result := grOk;
  case GetMode of
    gmCurrent:
      if (FRecordPos < 0) or (FRecordPos >= RecordCount) then Result := grError;
    gmPrior:
      if FRecordPos <= 0 then begin
        Result := grBOF;
        FRecordPos := -1;
      end
      else
        Dec(FRecordPos);
    gmNext:
      if FRecordPos >= RecordCount - 1 then
        Result := grEOF
      else
        Inc(FRecordPos);
  end;
  if Result = grOk then begin
    RecordToBuffer(FRecordPos, Buffer);
    GetCalcFields(Buffer);
  end
  else if (Result = grError) and DoCheck then
    DatabaseError('No data found');
end;

function TDAMemoryDataset.GetRecordCount: Integer;
begin
  Result := FDataList.Count;
end;

function TDAMemoryDataset.GetRecordSize: Word;
begin
  Result := FDatasetBufferSize;
end;

function TDAMemoryDataset.GetVarValueFromBuffer(Buffer: pointer;
  Field: TField): variant;
var
  buf: pchar;
  p: pointer;
begin
  buf := IntFindFieldData(Buffer,Field);
  case Field.DataType of
    ftString,ftFixedChar: begin
      if FStoreStringsAsReference then
        Result:=PAnsistring(Buf)^
      else
        Result:= Ansistring(PAnsiChar(Buf));
    end;
    ftWideString: begin
      if FStoreStringsAsReference then
        Result:=PWidestring(Buf)^
      else
        Result := WideString(PWideChar(Buf))
    end;
    ftSmallint: Result:= PSmallint(buf)^;
    ftInteger, ftDate, ftTime, ftAutoInc: Result := PInteger(buf)^;
    ftWord: Result := PWord(buf)^;
    ftBoolean: Result := PWordBool(buf)^;
    ftFloat, ftCurrency, ftDateTime: Result := PDouble(Buf)^;
    ftBcd{$IFDEF DELPHI6UP}, ftFMTBCD{$ENDIF}: Result := BCDToVariant(PBcd(buf)^);
    ftLargeint: Result := PInt64(Buf)^;
    {$IFNDEF FPC}
    ftTimeStamp: Result := VarSQLTimeStampCreate(PSQLTimeStamp(Buf)^);
    {$ENDIF FPC}
    ftGuid: Result:= AnsiString(PChar(Buf));
  else
    Result := VarArrayCreate([0,PBLOBRecord(buf)^.size-1],varByte);
    p := VarArrayLock(Result);
    try
      move(PBLOBRecord(buf)^.Data, p^,PBLOBRecord(buf)^.size);
    finally
      VarArrayUnlock(Result);
    end;
  end;
end;

//  ft_BlobTypes = [ftBlob, ftMemo,{$IFDEF DELPHI10UP}ftWideMemo,{$ENDIF DELPHI10UP} ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftOraBlob, ftOraClob];


function TDAMemoryDataset.IntAllocRecordBuffer(const ANative: Boolean): PChar;
begin
{$IFDEF MEMDATASET_DEBUG}
  inc(memdataset_buff_cnt);
{$ENDIF}
  if ANative then begin
    GetMem(Result, FNativeRecordSize);
    FillChar(Result^, FNullMaskSize, $FF);
    FillChar((Result+FNullMaskSize)^, FNativeRecordSize-FNullMaskSize, 0);
{$IFDEF MEMDATASET_DEBUG}
  inc(memdataset_buff_cnt_native);
{$ENDIF}
  end
  else begin
    GetMem(Result, FDatasetBufferSize);
    FillChar(Result^, FNullMaskSize, $FF);
    FillChar((Result+FNullMaskSize)^, FDatasetBufferSize-FNullMaskSize, 0);
{$IFDEF MEMDATASET_DEBUG}
  inc(memdataset_buff_cnt_notnative);
{$ENDIF}
  end;
{$IFDEF MEMDATASET_DEBUG}
  OutputDebugString(Pchar('memdataset:IntAllocRecordBuffer  =$'+ IntToHex(cardinal(Result),8)+ ' | native='+BoolToStr(ANative,True)));
{$ENDIF}
end;

procedure TDAMemoryDataset.IntAssignRecord(Source, Dest: Pchar);
begin
  if State = dsFilter then DatabaseError(SNotEditing);
  DuplicateBuffer(Source, Dest);
end;

function TDAMemoryDataset.IntCreateBuffer(const ANative: Boolean): Pchar;
begin
  Result := IntAllocRecordBuffer(ANative);
end;

procedure TDAMemoryDataset.InternalAddRecord(Buffer: Pointer; Append: Boolean);
var
  RecPos: Integer;
  Rec: PChar;
begin
  Rec := IntCreateBuffer(True);
  FRecordsList.Add(Rec);
  if Append then
    RecPos := FDataList.Add(Rec)
  else begin
    if FRecordPos = -1 then
      RecPos := 0
    else
      RecPos := FRecordPos;
    FDataList.Insert(RecNo, Rec);
  end;
  FRecordPos := RecPos;
  //  SetAutoIncFields(Buffer);
  IntAssignRecord(Buffer, Rec);
end;

procedure TDAMemoryDataset.InternalClose;
begin
  FIndexFieldNameList.Clear;
  ClearRecords;
  BindFields(False);
  if DefaultFields then DestroyFields;
  SetLength(FDataTypeArray,0);
  SetLength(FOffsets, 0);
  SetLength(FDataSizeArray,0);
  FActive := False;
end;

procedure TDAMemoryDataset.InternalDelete;
var
  Buf: Pchar;
begin
  Buf := FDataList[FRecordPos];
  FRecordsList.Remove(Buf);
  FDataList.Delete(FRecordPos);
  IntFreeRecordBuffer(Buf{$IFDEF MEMDATASET_DEBUG}, True{$ENDIF});
  if FRecordPos >= RecordCount then Dec(FRecordPos);
end;

procedure TDAMemoryDataset.InternalFirst;
begin
  FRecordPos := -1;
end;

procedure TDAMemoryDataset.InternalGotoBookmark(Bookmark: Pointer);
var
  RecNo: Integer;
begin
  RecNo := IntFindRecordID(TBookMarkData(PPointer(Bookmark)^));
  if RecNo <> -1 then
    FRecordPos := RecNo
  else
    DatabaseError('Bookmark not found');
end;

procedure TDAMemoryDataset.InternalHandleException;
begin
 {$IFDEF FPC}
   inherited;
 {$ELSE}
   Application.HandleException(Self);
 {$ENDIF}
end;

procedure TDAMemoryDataset.InternalInitFieldDefs;
begin
  //  inherited InternalInitFieldDefs;
end;

procedure TDAMemoryDataset.InternalInitRecord(Buffer: PChar);
begin

  ClearRecord(Buffer, True);
end;

procedure TDAMemoryDataset.InternalLast;
begin

  FRecordPos := RecordCount;
end;

procedure TDAMemoryDataset.InternalOpen;
begin
  BookmarkSize := SizeOf(TBookmarkData);
  FieldDefs.Update;
  if DefaultFields then CreateFields;
  BindFields(True);
  InitIndexFieldNamesList(FIndexFieldNames);
  CalculateOffsets;
  DoFilterRecords;
  InternalFirst;
end;

procedure TDAMemoryDataset.InternalPost;
var
  RecPos: Integer;
  Rec: PChar;
begin
{$IFDEF DELPHI6UP}
  inherited InternalPost;
{$ENDIF}
  if State = dsEdit then
    IntAssignRecord(ActiveBuffer, FDataList[FRecordPos])
  else begin
    //    if State in [dsInsert] then SetAutoIncFields(ActiveBuffer);
    Rec := IntCreateBuffer(True);
    FRecordsList.Add(Rec);
    IntAssignRecord(ActiveBuffer, Rec);
    if not IsActiveFilter or FilterRecord(Rec, True) then
      if FRecordPos >= FRecordsList.Count then begin
        FDataList.Add(Rec);
        FRecordPos := RecordCount - 1;
      end
      else begin
        if FRecordPos = -1 then
          RecPos := 0
        else
          RecPos := FRecordPos;
        FDataList.Insert(RecPos, Rec);
        FRecordPos := RecPos;
      end;
  end;
end;

procedure TDAMemoryDataset.InternalSetFieldData(Field: TField; Buffer: Pointer);
var
  RecBuf, Data: Pchar;
begin
  GetActiveRecBuf(RecBuf);
  with Field do begin
    Data := IntFindFieldData(RecBuf, Field);
    if Data <> nil then begin
      {
      if DataType = ftVariant then begin
        if Buffer <> nil then
          VarData := PVariant(Buffer)^
        else
          VarData := EmptyParam;
        PVariant(Data)^ := VarData;
      end else
      }
      if not IsReferencedField(DataType) then begin
        if Buffer <> nil then begin
          Move(Buffer^, Data^, FDataSizeArray[Field.Index]);
          SetNullMask(RecBuf, Index, False);
        end
        else
          SetNullMask(RecBuf, Index, True);
      end
      else begin
        if Buffer <> nil then begin
          if DataType = ftString then begin
            PAnsiString(Data)^ := PAnsiChar(buffer);
            SetNullMask(RecBuf, Index, False);
          end
          else if DataType = ftWideString then begin
            PWideString(Data)^ := PWideChar(buffer);
            SetNullMask(RecBuf, Index, False);
          end;
        end
        else
          SetNullMask(RecBuf, Index, True);
      end;
    end;
  end;
end;

procedure TDAMemoryDataset.InternalSetToRecord(Buffer: PChar);
begin
  InternalGotoBookmark(@PRecInfo(Buffer + FBookMarkOffset).Bookmark);
end;

function TDAMemoryDataset.IntFindFieldData(Buffer: Pointer;
  Field: TField): Pointer;
begin
  Result := nil;
  if (Buffer <> nil) and (Field.DataType in ft_Supported) then
    Result := (PChar(Buffer) + FOffsets[Field.Index]);
end;

function TDAMemoryDataset.IntFindRecordID(Bookmark: TBookmarkData): Integer;
begin
  Result := FDataList.IndexOf(Bookmark);
end;

function TDAMemoryDataset.IntGetBookmark(ARecNo: Integer): TBookmarkData;
begin
  Result := TBookmarkData(FDataList[ARecNo]);
end;

function TDAMemoryDataset.IsActiveFilter: Boolean;
begin
  Result := Filtered and (Filter <> '');
end;

function TDAMemoryDataset.IsCursorOpen: Boolean;
begin
  Result := FActive;
end;

function TDAMemoryDataset.IsReferencedField(ADataType: TFieldType): Boolean;
begin
  Result:= (FStoreStringsAsReference and (ADataType in ft_Strings)) or
           (ADataType in ft_BlobTypes);
end;

procedure TDAMemoryDataset.OpenCursor(InfoQuery: Boolean);
begin
  if not InfoQuery then begin
    if FieldCount > 0 then FieldDefs.Clear;
    InitFieldDefsFromFields;
  end;
  FActive := True;
  inherited OpenCursor(InfoQuery);
end;

function TDAMemoryDataset.GetNullMask(Buffer: PChar; const Index: Integer): boolean;
begin
  Result := (ord(Buffer[Index shr 3]) shr (Index and 7)) and 1 = 1;
end;

procedure TDAMemoryDataset.RecordToBuffer(RecNo: integer; Buffer: PChar);
begin
  with PRecInfo(Buffer + FBookMarkOffset)^ do begin
    Bookmark := IntGetBookmark(RecNo);
    BookmarkFlag := bfCurrent;
  end;
  DuplicateBuffer(FDataList[RecNo], Buffer);
end;

procedure TDAMemoryDataset.SetAnsiString(NativeBuf: Pointer; Field: TField;
  const Value: Ansistring);
var
  len: integer;
begin
  if FStoreStringsAsReference then
    PAnsiString(NativeBuf)^:=Value
  else begin
    len := Length(Value);
    if Len > Field.Size then len:= Field.Size;
    move(Pointer(Value)^,NativeBuf^,len);
    Pchar(NativeBuf)[len]:=#0;
  end;
end;

procedure TDAMemoryDataset.SetBlobData(Field: TField; Buffer: PChar;
  Value: Pointer);
begin
  PPointer(Buffer + FOffsets[Field.Index])^ := Value;
  SetNullMask(Buffer, Field.Index, False);
end;

procedure TDAMemoryDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  Move(Data^, PRecInfo(Buffer + FBookMarkOffset)^.Bookmark, SizeOf(TBookmarkData));
end;

procedure TDAMemoryDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
  PRecInfo(Buffer + FBookMarkOffset).BookmarkFlag := Value;
end;

procedure TDAMemoryDataset.SetFieldData(Field: TField; Buffer: Pointer);
begin
  if not (State in dsWriteModes) then DatabaseError(SNotEditing);
  with Field do begin
    if FieldNo > 0 then begin
      if State in [dsCalcFields, dsFilter] then DatabaseError(SNotEditing);
      if ReadOnly and not (State in [dsSetKey, dsFilter]) then DatabaseErrorFmt({$IFDEF FPC}SReadOnlyField{$ELSE}SFieldReadOnly{$ENDIF}, [DisplayName]);
      Validate(Buffer);
    end;
   if FieldKind <> fkInternalCalc then InternalSetFieldData(Field, Buffer);
   if not (State in [dsCalcFields, dsInternalCalc, dsFilter, dsNewValue]) then
     DataEvent(deFieldChange, Longint(Field));
  end;
end;

procedure TDAMemoryDataset.SetNullMask(Buffer: PChar; const Index: Integer; const Value: boolean);
var
  i: byte;
begin
  i := Index shr 3;
  if Value then
    Buffer[I] := Chr(ord(Buffer[I]) or (1 shl (Index and 7)))
  else
    Buffer[I] := Chr(ord(Buffer[I]) and not (1 shl (Index and 7)))
end;

procedure TDAMemoryDataset.SetOnFilterRecord(const Value: TFilterRecordEvent);
begin
  inherited;
  if Active and Filtered then First;
end;

procedure TDAMemoryDataset.SetRecNo(Value: Integer);
begin
  if (Value > 0) and (Value <= RecordCount) then begin
    FRecordPos := Value - 1;
    Resync([]);
  end;
end;

procedure TDAMemoryDataset.DataConvert(Field: TField; Source,
  Dest: Pointer; ToNative: Boolean);
{$IFNDEF DELPHI10UP}
var
  len: integer;
{$ENDIF DELPHI10UP}
begin
{$IFNDEF DELPHI10UP}
  if Field.DataType = ftWideString then begin
    if ToNative then begin
      len := Length(PWideString(Source)^);
      Move(PWideChar(Source^)^, PWideChar(Dest)^, len * SizeOf(WideChar));
      PWideChar(Dest)[Len] := #0;
    end
    else begin
      len := Length(PWideChar(Source));
      SetString(WideString(Dest^), PWideChar(Source), Len);
    end;
  end
  else
{$ENDIF DELPHI10UP}  
    inherited DataConvert(Field, Source, Dest, ToNative);
end;

function TDAMemoryDataset.GetDataSource: TDataSource;
begin
  Result := MasterDataLink.DataSource;
end;

function TDAMemoryDataset.GetMasterFields: string;
begin
  Result := MasterDataLink.FieldNames;
end;

{$IFDEF FPC}
const
  SCircularDataLink = 'Circular datalinks are not allowed';
{$ENDIF}
procedure TDAMemoryDataset.SetDataSource(const Value: TDataSource);
begin
  if IsLinkedTo(Value) then DatabaseError(SCircularDataLink, Self);
  if MasterDataLink.DataSource <> Value then DataEvent(dePropertyChange, 0);
  MasterDataLink.DataSource := Value;
end;

procedure TDAMemoryDataset.SetMasterFields(const Value: string);
begin
  if (Value <> '') and (Filter <> '') then DatabaseError(SNoDetailFilter, Self);
  if MasterDataLink.FieldNames <> Value then DataEvent(dePropertyChange, 0);
  MasterDataLink.FieldNames := Value;
end;

function TDAMemoryDataset.GetIndexFieldNames: string;
begin
  Result := FIndexFieldNames;
end;

procedure TDAMemoryDataset.SetIndexFieldNames(const Value: string);
begin
  if FIndexFieldNames <> Value then begin
    FIndexFieldNames := Value;
    if Active then begin
      InitIndexFieldNamesList(FIndexFieldNames);
      DoSort;
    end;
  end;
end;

function TDAMemoryDataset.GetRecord(Buffer: PChar; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
var
  Accept: Boolean;
  SaveState: TDataSetState;
begin
  if Filtered and Assigned(OnFilterRecord) then begin
    FFilterBuffer := Buffer;
    SaveState := SetTempState(dsFilter);
    try
      Accept := True;
      repeat
        Result := InternalGetRecord(Buffer, GetMode, DoCheck);
        if Result = grOK then begin
          OnFilterRecord(Self, Accept);
          if not Accept and (GetMode = gmCurrent) then
            Result := grError;
        end;
      until Accept or (Result <> grOK);
    except
      ApplicationHandleException(Self);
      Result := grError;
    end;
    RestoreState(SaveState);
  end else
    Result := InternalGetRecord(Buffer, GetMode, DoCheck)
end;

procedure TDAMemoryDataset.SetFiltered(Value: Boolean);
begin
  if Active and (Value <> Filtered) then begin
    inherited;
    if (Filter <> '') then
      ProcessFilter
    else if Assigned(OnFilterRecord) then First;         
  end
  else
    inherited;
end;

procedure TDAMemoryDataset.SetFilterOptions(Value: TFilterOptions);
begin
  DatabaseError(SNoFilterOptions,Self);
  inherited;
end;

procedure TDAMemoryDataset.SetFilterText(const Value: string);
begin
  if Active and Filtered and (Value <> Filter) then begin
    inherited;
    ProcessFilter;
  end
  else
    inherited;
end;

procedure TDAMemoryDataset.DoSort;
var
  Pos: TBookmarkStr;
begin
  if Active and (FieldCount > 0) and (RecordCount <> 0) then begin
    Pos := Bookmark;
    try
      if (FIndexFieldNameList.Count = 0) and (FDataList.Count = FRecordsList.Count) then
        begin
          // nosort
          FDataList.Assign(FRecordsList);
        end
      else
        QuickSort(0, RecordCount - 1, Compare);
      SetBufListSize(0);
      try
        SetBufListSize(BufferCount + 1);
      except
        SetState(dsInactive);
        CloseCursor;
        raise;
      end;
    finally
      Bookmark := Pos;
    end;
    Resync([]);
  end;
end;

procedure TDAMemoryDataset.QuickSort(L, R: Integer; SCompare: TDAMemDatasetCompare);
var
  I, J: Integer;
  P: pointer;
begin
  repeat
    I := L;
    J := R;
    P := FDatalist[(L + R) shr 1];
    repeat
      while SCompare(FDatalist[I], P) < 0 do Inc(I);
      while SCompare(FDatalist[j], P) > 0 do Dec(J);
      if I <= J then begin
        FDataList.Exchange(I, J);
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then QuickSort(L, J, SCompare);
    L := I;
  until I >= R;
end;

function TDAMemoryDataset.Compare(i1, i2: pointer): Integer;
var
  buf1, buf2: PChar;
  i: integer;
  Field: TField;
  p1, p2: PChar;
begin
  buf1 := i1;
  buf2 := i2;
  Result := 0;
  if FIndexFieldNameList <> nil then
    for i := 0 to FIndexFieldNameList.Count - 1 do begin
      Field := FIndexFieldNameList[i];
      if not GetNullMask(buf1, Field.Index) then
        p1 := intFindFieldData(buf1, Field)
      else
        p1 := nil;
      if not GetNullMask(buf2, Field.Index) then
        p2 := intFindFieldData(buf2, Field)
      else
        p2 := nil;
      if (p1 <> nil) and (p2 <> nil) then begin
        Result := CompareValues(p1, p2, Field.DataType)
      end
      else
        if p1 <> nil then Result := 1
        else if p2 <> nil then Result := -1
        else continue;
      if FSortDescMode then Result := -Result;
      if Result <> 0 then Exit;
    end;
  if Result = 0 then begin
    Result :=FRecordsList.IndexOf(buf1) - FRecordsList.IndexOf(buf2);
    if FSortDescMode then Result := -Result;
  end;
end;

function WordBoolCompare(val1, val2: WordBool): integer;
begin
  if val2 and not val1 then Result := -1
  else if val1 and not val2 then Result := 1
  else Result := 0;
end;

function Int64Compare(val1, val2: Int64): integer;
begin
  if val1 > val2 then Result := 1
  else if val2 > val1 then Result := -1
  else Result := 0;
end;

function IntegerCompare(val1, val2: integer): integer;
begin
  if val1 > val2 then Result := 1
  else if val2 > val1 then Result := -1
  else Result := 0;
end;

function DoubleCompare(val1, val2: double): integer;
begin
  if val1 > val2 then Result := 1
  else if val2 > val1 then Result := -1
  else Result := 0;
end;

function TDAMemoryDataset.CompareValues(buf1, buf2: pointer;
  aDataType: TFieldType): integer;
var
  s1, s2: AnsiString;
begin
  Result := 0;
  case aDataType of
    ftString, ftFixedChar: begin
      if FStoreStringsAsReference then begin
        s1:=PAnsiString(Buf1)^;
        s2:=PAnsiString(Buf2)^;
      end
      else begin
        s1:=PAnsiChar(Buf1);
        s2:=PAnsiChar(Buf2);
      end;
      if FSortCaseInsensitive then
        Result := AnsiCompareText(s1,s2)
      else
        Result := AnsiCompareStr(s1,s2);
    end;
    ftWideString: begin
      if FStoreStringsAsReference then      
        Result:= ROWideCompare(PWideString(Buf1)^,PWideString(Buf2)^,FSortCaseInsensitive {$IFDEF MSWINDOWS},FSortLocale {$ENDIF MSWIN})
      else
        Result:= ROWideCompare(PWideChar(Buf1),PWideChar(Buf2),FSortCaseInsensitive {$IFDEF MSWINDOWS},FSortLocale {$ENDIF MSWIN});
    end;
    ftGuid: Result := StrLIComp(PChar(Buf1), Pchar(Buf2),guidsize);
    ftSmallint: Result := IntegerCompare(PSmallInt(buf1)^, PSmallInt(buf2)^);
    ftInteger, ftDate, ftTime, ftAutoInc: Result := IntegerCompare(PInteger(buf1)^, PInteger(buf2)^);
    ftWord: Result := IntegerCompare(PWord(buf1)^, PWord(buf2)^);
    ftBoolean: Result := WordBoolCompare(PWordBool(buf1)^, PWordBool(buf2)^);
    ftFloat, ftCurrency, ftDateTime: Result := DoubleCompare(PDouble(Buf1)^, PDouble(Buf2)^);
    ftBcd{$IFDEF DELPHI6UP}, ftFMTBCD{$ENDIF}: Result := BcdCompare(PBcd(buf1)^, PBcd(buf2)^);
    ftLargeint: Result := Int64Compare(PInt64(Buf1)^, PInt64(Buf2)^);
    {$IFNDEF FPC}
    ftTimeStamp: Result := DoubleCompare(SQLTimeStampToDateTime(PSQLTimeStamp(Buf1)^), SQLTimeStampToDateTime(PSQLTimeStamp(Buf2)^));
    {$ENDIF FPC}
  else
  end;
end;

procedure TDAMemoryDataset.SortOnFields(const FieldNames: string;
  CaseInsensitive, Descending: Boolean);
var
  s: string;
begin
  if Active then begin
    FSortCaseInsensitive := CaseInsensitive;
    FSortDescMode := Descending;
    s := FieldNames;
    if s = '' then s := FIndexFieldNames;
    InitIndexFieldNamesList(s);
    DoSort;
  end;
end;

procedure TDAMemoryDataset.SetStoreStringAsReference(const Value: Boolean);
begin
  CheckInactive;
  FStoreStringsAsReference := Value;
end;

procedure TDAMemoryDataset.SetWideString(NativeBuf: Pointer; Field: TField;
  const Value: Widestring);
var
  len: integer;
begin
  if FStoreStringsAsReference then
    PWideString(NativeBuf)^:=Value
  else begin
    len := Length(Value);
    if Len > Field.Size then len:= Field.Size;
    move(Pointer(Value)^,NativeBuf^,len*Sizeof(WideChar));
    PWideChar(NativeBuf)[len]:=#0;
  end;
end;

procedure TDAMemoryDataset.DoAfterOpen;
begin
  if not IsEmpty then SortOnFields();
  inherited;
end;

procedure TDAMemoryDataset.MasterChanged(Sender: TObject);
begin
  ProcessFilter;
end;

procedure TDAMemoryDataset.MasterDisabled(Sender: TObject);
begin
  DataEvent(dePropertyChange, 0);
  DoFilterRecords;
end;

procedure TDAMemoryDataset.GetDetailLinkFields(MasterFields,
  DetailFields: TList);
begin
  { TODO : GetDetailLinkFields }
  inherited;

end;

type
  TDAMasterStruct = packed record
    value: variant;
  end;

procedure TDAMemoryDataset.DoFilterRecords;
var
  i, j: integer;
  MasterArray: array of TDAMasterStruct;
  buf: pchar;
  flag: boolean;
  fld_cnt: integer;
  pos: TBookmarkData;
  str: string;
begin
  if (RecordCount > 0) and (FRecordPos<>-1) then
    pos := FDataList[FRecordPos]
  else
    pos := nil;
  FDataList.Clear;
  if (MasterSource = nil) or (MasterSource.DataSet = nil) or
    (not MasterSource.DataSet.Active) or (MasterDataLink.Fields.Count = 0) or
    (FIndexFieldNameList.Count = 0) then begin
    // not filtered!
    FDataList.Assign(FRecordsList);
  end
  else begin
    fld_cnt := MasterDataLink.Fields.Count;
    if FIndexFieldNameList.Count < fld_cnt then fld_cnt := FIndexFieldNameList.Count;
    SetLength(MasterArray, fld_cnt);
    for i := 0 to fld_cnt - 1 do
      MasterArray[i].value := TField(MasterDataLink.Fields[i]).Value;
    for i := 0 to FRecordsList.Count - 1 do begin
      flag := true;
      for j := 0 to fld_cnt - 1 do begin
        buf := IntFindFieldData(FRecordsList[i], TField(FIndexFieldNameList[j]));
        if (buf <> nil) then
          case TField(FIndexFieldNameList[j]).DataType of
            ftString: begin
              if FStoreStringsAsReference then
                flag := AnsiCompareText(PAnsistring(Buf)^, VarToStr(MasterArray[j].value)) = 0
              else
                flag := AnsiCompareText(PAnsiChar(Buf), VarToStr(MasterArray[j].value)) = 0
            end;
            ftWideString: begin
              if FStoreStringsAsReference then
                flag := ROWideCompare(PWidestring(Buf)^, VarToWideStr(MasterArray[j].value),True {$IFDEF MSWINDOWS}, FSortLocale {$ENDIF}) = 0
              else
                flag := ROWideCompare(PWideChar(Buf), VarToWideStr(MasterArray[j].value),True {$IFDEF MSWINDOWS}, FSortLocale {$ENDIF}) = 0
            end;
            ftSmallint: flag := PSmallint(buf)^ = MasterArray[j].value;
            ftInteger, ftDate, ftTime, ftAutoInc: Flag := PInteger(buf)^ = MasterArray[j].value;
            ftWord: flag := PWord(buf)^ = MasterArray[j].value;
            ftBoolean: flag := PWordBool(buf)^ = wordbool(MasterArray[j].value);
            ftFloat, ftCurrency, ftDateTime: flag := PDouble(Buf)^ = MasterArray[j].value;
            ftBcd{$IFDEF DELPHI6UP}, ftFMTBCD{$ENDIF}: flag := BcdCompare(PBcd(buf)^, VariantToBCD(MasterArray[j].value)) = 0;
            ftLargeint: flag := PInt64(Buf)^ = MasterArray[j].value;
            {$IFNDEF FPC}
            ftTimeStamp: flag := SQLTimeStampToDateTime(PSQLTimeStamp(Buf)^) = SQLTimeStampToDateTime(VarToSQLTimeStamp(MasterArray[j].value));
            {$ENDIF FPC}
            ftGuid: begin
              SetString(str,PChar(Buf),guidsize);
              flag := AnsiSameText(str, VarToStr(MasterArray[j].value));
            end;
          end
        else
          Flag := not VarIsNull(MasterArray[j].value);
        if not flag then Break;
      end;
      if flag then FDataList.Add(FRecordsList[i]);
    end;
  end;
  //==============================
  // apply filters
  if IsActiveFilter then
     for i := FDataList.Count-1 downto 0 do
       if not FilterRecord(FDataList[i], False) then FDataList.Delete(i);
  //==============================
  if Active then begin
    FRecordPos := FDataList.IndexOf(pos);
    if (FRecordPos = -1) and (RecordCount > 0) then FRecordPos := 0;
    Resync([]);
  end;
end;

{$IFDEF FPC}
const
  SFieldTypeMismatch = 'Type mismatch for field ''%s'', expecting: %s actual: %s';
{$ENDIF}

{$IFDEF DELPHI10UP}
{$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF DELPHI10UP}
procedure TDAMemoryDataset.InitIndexFieldNamesList(AFieldNames: string);
var
  pos1: integer;
  fld: TField;
begin
  FIndexFieldNameList.Clear;
  Pos1 := 1;
  while Pos1 <= Length(AFieldNames) do begin
    Fld := FieldByName(ExtractFieldName(AFieldNames, Pos1));
    if (Fld.FieldKind = fkData) and
      (Fld.DataType in ft_Supported - ft_BlobTypes) then
      FIndexFieldNameList.Add(Fld)
    else
      DatabaseErrorFmt(SFieldTypeMismatch, [Fld.DisplayName]);
  end;
end;
{$IFDEF DELPHI10UP}
{$WARN SYMBOL_DEPRECATED ON}
{$ENDIF DELPHI10UP}

function TDAMemoryDataset.MakeBlobFromString(Blob: String): pointer;
var
  s: integer;
begin
  s:= Length(blob);
  Result:=CreateBlobRecord(s);
  Move(Pointer(blob)^, PBlobRecord(Result)^.Data,s);
end;

procedure TDAMemoryDataset.IntInsertBuffer(Buffer: Pointer);
begin
  FRecordsList.Add(Buffer);
//  FDataList.Add(Buffer);
end;

function TDAMemoryDataset.GetFieldOffset(
  const aFieldNo: integer): cardinal;
begin
  if aFieldNo < FieldCount then
    Result:=FOffsets[aFieldNo]
  else
    Result:=0;  
end;

procedure TDAMemoryDataset.DoOnNewRecord;
var
  I: Integer;
begin
  if FMasterDataLink.Active and (FMasterDataLink.Fields.Count > 0) then
    for I := 0 to FMasterDataLink.Fields.Count - 1 do
      if FIndexFieldNameList.Count > i then
        TField(FIndexFieldNameList[I]).Assign(TField(FMasterDataLink.Fields[I]));
  inherited;
end;

function TDAMemoryDataset.Locate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
begin
  DoBeforeScroll;
  Result := LocateRecord(KeyFields, KeyValues, Options, True);
  if Result then
  begin
    Resync([rmExact, rmCenter]);
    DoAfterScroll;
  end;
end;

function TDAMemoryDataset.LocateRecord(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions;
  SyncCursor: Boolean): Boolean;
// TLocateOption = (loCaseInsensitive, loPartialKey);
var
  lBookmark: TBookmarkStr;
  lOffsets: array of cardinal;
  lDatatypes: array of TFieldType;
  lValues: array of variant;
  lFields : TList;
  i,j: integer;
  k: boolean;
  lCaseInsensitive, lPartialKey:Boolean;
  Buffer: Pchar;
begin
  Result := False;
  lBookmark:='';
  CheckBrowseMode;
  CursorPosChanged;
  Buffer:=TempBuffer;
  if IsEmpty then Exit;
  try
    lFields := TList.Create;
    try
      GetFieldList(lFields,KeyFields);
      if lFields.Count = 0 then Exit;
      lCaseInsensitive:= loCaseInsensitive in Options;
      lPartialKey:= loPartialKey in Options;
      SetLength(lOffsets,lFields.Count);
      SetLength(lDatatypes,lFields.Count);
      SetLength(lValues,lFields.Count);
      for i:=0 to lFields.Count-1 do begin
        lOffsets[i] := GetFieldOffset(TField(lFields[i]).Index);
        lDatatypes[i] := TField(lFields[i]).DataType;
        if lFields.Count = 1 then
          lValues[i]:= KeyValues
        else
          lValues[i]:= KeyValues[i];
      end;
      For i:= 0 to FDataList.Count - 1 do begin
        k:=False;
        For j:=0 to lFields.Count-1 do begin
          k:= CompareValues2(Pchar(FDataList[i])+lOffsets[j], lValues[j],lDatatypes[j], lCaseInsensitive, lPartialKey);
          if not k then Break;
        end;
        if k then begin
          RecordToBuffer(i, Buffer);
          SetLength(lBookmark, BookmarkSize);
          GetBookmarkData(Buffer, Pointer(lBookmark));
          Result:=True;
          Break;
        end;
      end;
    finally
      lFields.Free;
    end;
  finally
    if Result then
      if SyncCursor then begin
        Bookmark := lBookmark;
        if EOF or BOF then Result := False;
      end;
  end;
end;

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

function TDAMemoryDataset.CompareValues2(buf1: pointer; aValue: variant;
  aDataType: TFieldType; aSortCaseInsensitive, aPartialKey: Boolean): boolean;
var
  str, str1: string;
  wstr1: widestring;
begin
  Result := False;
  case aDataType of
    ftString, ftFixedChar: begin
      if FStoreStringsAsReference then
        str1:=PAnsiString(Buf1)^
      else
        str1 := PAnsiChar(Buf1);
      if aPartialKey then begin
        if aSortCaseInsensitive then
          Result := pos(AnsiUpperCase(VarToStr(aValue)), AnsiUpperCase(str1)) = 1
        else
          Result := pos(VarToStr(aValue), str1) = 1
      end else begin
        if aSortCaseInsensitive then
          Result := AnsiCompareText(str1, VarToStr(aValue))=0
        else
          Result := AnsiCompareStr(str1, VarToStr(aValue))=0;
      end;
    end;
    ftWideString: begin
      if FStoreStringsAsReference then
        wstr1:=PWideString(Buf1)^
      else
        wstr1:=PWideChar(Buf1);
      if aPartialKey then begin
        if aSortCaseInsensitive then
          Result := pos(WideUpperCase(VarToWideStr(aValue)), WideUpperCase(wstr1)) = 1
        else
          Result := pos(VarToWideStr(aValue), wstr1) = 1
      end else begin
        Result:= ROWideCompare(wstr1,VarToWideStr(aValue),aSortCaseInsensitive {$IFDEF MSWINDOWS},FSortLocale {$ENDIF MSWIN})=0;
      end;
    end;
    ftGuid: begin
      SetString(str, PAnsiChar(buf1), guidsize);
      if aPartialKey then begin
        Result := pos(AnsiUpperCase(VarToStr(aValue)), AnsiUpperCase(str)) = 1
      end else begin
        Result := AnsiCompareText(str, VarToStr(aValue))=0
      end;
    end;
    ftSmallint: Result := PSmallInt(buf1)^ =  aValue;
    ftInteger, ftDate, ftTime, ftAutoInc: Result := PInteger(buf1)^ = aValue;
    ftWord: Result := PWord(buf1)^ = aValue;
    ftBoolean: Result:= PWordBool(buf1)^ =  aValue;
    ftFloat, ftCurrency: Result := PDouble(Buf1)^ =  aValue;
    ftDateTime: Result := PDouble(Buf1)^ = TimeStampToMSecs(DateTimeToTimeStamp(aValue));
    ftBcd{$IFDEF DELPHI6UP}, ftFMTBCD{$ENDIF}: Result := BcdCompare(PBcd(buf1)^, VariantToBCD(aValue))=0;
    ftLargeint: Result := PInt64(Buf1)^ = aValue;
    {$IFNDEF FPC}
    ftTimeStamp: Result := SQLTimeStampToDateTime(PSQLTimeStamp(Buf1)^) = SQLTimeStampToDateTime(VarToSQLTimeStamp(aValue));
    {$ENDIF FPC}
  else
  end;
end;

procedure TDAMemoryDataset.IntFreeRecordBuffer(var Buffer: PChar{$IFDEF MEMDATASET_DEBUG};const ANative: Boolean=true{$ENDIF});
begin
{$IFDEF MEMDATASET_DEBUG}
  OutputDebugString(Pchar('memdataset:IntFreeRecordBuffer =$'+ IntToHex(cardinal(Buffer),8)));
  OutputDebugString(Pchar('                               =$'+ IntTostr(FRecordsList.IndexOf(PRecInfo(Buffer + FBookMarkOffset).Bookmark))));
  dec(memdataset_buff_cnt);
  if ANative then
    dec(memdataset_buff_cnt_native)
  else
    dec(memdataset_buff_cnt_notnative);
{$ENDIF}
  ClearRecord(Buffer, False);
  FreeMem(Buffer);
  Buffer := nil;
end;

function TDAMemoryDataset.CompareBookmarks(Bookmark1,
  Bookmark2: TBookmark): Integer;
var
  idx1, idx2: integer;
begin
  if (Bookmark1 = nil) and (BookMark2 = nil) then
    Result:=0
  else if (Bookmark1 <> nil) and (BookMark2 = nil) then
    Result := 1
  else if (Bookmark1 = nil) and (BookMark2 <> nil) then
    Result := -1
  else begin
    idx1 := IntFindRecordID(TBookMarkData(PPointer(Bookmark1)^));
    idx2 := IntFindRecordID(TBookMarkData(PPointer(Bookmark2)^));
    if idx1 > idx2 then
      Result := 1
    else if idx1 < idx2 then
      Result := -1
    else
      Result:=0;
  end;
end;

function TDAMemoryDataset.BookmarkValid(Bookmark: TBookmark): Boolean;
begin
  Result := IntFindRecordID(TBookMarkData(PPointer(Bookmark)^)) <> -1;
end;

{ TDABlobStream }

constructor TDABlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
begin
  inherited Create;
  FMode := Mode;
  FField := Field;
  FDataSet := FField.DataSet as TDAMemoryDataset;
  if not FDataSet.GetActiveRecBuf(FBuffer) then Exit;
  if not FField.Modified and (Mode <> bmRead) then begin
    if FField.ReadOnly then DatabaseErrorFmt({$IFDEF FPC}SReadOnlyField{$ELSE}SFieldReadOnly{$ENDIF}, [FField.DisplayName]);
    if not (FDataSet.State in [dsEdit, dsInsert]) then DatabaseError(SNotEditing);
    FCached := True;
  end
  else
    FCached := (FBuffer = FDataSet.ActiveBuffer);
  FOpened := True;
  if Mode = bmWrite then Truncate;
end;

destructor TDABlobStream.Destroy;
begin
  if FOpened and FModified then FField.Modified := True;
  if FModified then try
    FDataSet.DataEvent(deFieldChange, Longint(FField));
  except
    {$IFDEF FPC}
    if assigned(classes.ApplicationHandleException) then
      classes.ApplicationHandleException(self)
    else
      ShowException(ExceptObject,ExceptAddr);
    {$ELSE}
    Application.HandleException(Self);
    {$ENDIF}
  end;
  inherited Destroy;
end;

function TDABlobStream.GetBLOBRecordFromRecord(Field: TField): PBLOBRecord;
var
  Pos: Integer;
begin
  Result := nil;
  Pos := FDataSet.FRecordPos;
  if (Pos < 0) and (FDataSet.RecordCount > 0) then
    Pos := 0
  else if Pos >= FDataSet.RecordCount then
    Pos := FDataSet.RecordCount - 1;
  if (Pos >= 0) and (Pos < FDataSet.RecordCount) then
    Result := GetBLOBRecordFromBuffer(FDataSet.FRecordsList[Pos], Field);
end;

function TDABlobStream.GetBlobSize: Longint;
var
  rec: PBlobRecord;
begin
  Result := 0;
  if FOpened then begin
    if FCached then
      Rec := GetBLOBRecordFromBuffer(FBuffer, FField)
    else
      Rec := GetBLOBRecordFromRecord(FField);
    if rec <> nil then Result := rec.size;
  end;
end;

function TDABlobStream.GetBLOBRecordFromBuffer(Buffer: Pchar;
  Field: TField): PBLOBRecord;
begin
  Result := PPointer(FDataSet.IntFindFieldData(Buffer, Field))^;
end;

function TDABlobStream.Read(var Buffer; Count: Integer): Longint;
var
  rec: PBlobRecord;
begin
  Result := 0;
  if FOpened then begin
    if Count > Size - FPosition then
      Result := Size - FPosition
    else
      Result := Count;
    if Result > 0 then begin
      if FCached then
        rec := GetBLOBRecordFromBuffer(FBuffer, FField)
      else
        rec := GetBLOBRecordFromRecord(FField);
      if rec <> nil then begin
        Move(PChar(@Rec.Data)[FPosition], Buffer, Result);
        Inc(FPosition, Result);
      end;
    end;
  end;
end;

function TDABlobStream.Seek(Offset: Integer; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning: FPosition := Offset;
    soFromCurrent: Inc(FPosition, Offset);
    soFromEnd: FPosition := GetBlobSize + Offset;
  end;
  Result := FPosition;
end;

procedure TDABlobStream.Truncate;
begin
  if FOpened and FCached and (FMode <> bmRead) then begin
    FDataset.ClearField(FBuffer, FField);
    FModified := True;
  end;
end;

function TDABlobStream.Write(const Buffer; Count: Integer): Longint;
var
  Temp: PBLOBRecord;
begin
  Result := 0;
  if FOpened and FCached and (FMode <> bmRead) then begin
    Temp := GetBLOBRecordFromBuffer(FBuffer, FField);
    if temp = nil then begin
      temp := CreateBlobRecord(FPosition + Count);
    end
    else if Temp.size + SizeOf(TBLOBRecord) < Cardinal(FPosition + Count) then begin
      ReallocMem(temp, SizeOf(TBLOBRecord) + FPosition); // compact date before copying
      ReallocMem(temp, SizeOf(TBLOBRecord) + FPosition + Count);
      inc(Temp.size, Count);
    end;
    Move(Buffer, PChar(@Temp.Data)[FPosition], Count);
    FDataset.SetBlobData(FField, FBuffer, Temp);
    Inc(FPosition, Count);
    Result := Count;
    FModified := True;
  end;
end;

{$IFDEF MEMDATASET_DEBUG}
initialization
  memdataset_buff_cnt := 0;
  memdataset_buff_cnt_native := 0;
  memdataset_buff_cnt_notnative:= 0;
{$ENDIF}
end.