{ rxmemds unit

  Copyright (C) 2005-2017 Lagunov Aleksey alexs75@yandex.ru and Lazarus team
  original conception from rx library for Delphi (c)

  This library is free software; you can redistribute it and/or modify it
  under the terms of the GNU Library General Public License as published by
  the Free Software Foundation; either version 2 of the License, or (at your
  option) any later version with the following modification:

  As a special exception, the copyright holders of this library give you
  permission to link this library with independent modules to produce an
  executable, regardless of the license terms of these independent modules,and
  to copy and distribute the resulting executable under terms of your choice,
  provided that you also meet, for each linked independent module, the terms
  and conditions of the license of that module. An independent module is a
  module which is not derived from or based on this library. If you modify
  this library, you may extend this exception to your version of the library,
  but you are not obligated to do so. If you do not wish to do so, delete this
  exception statement from your version.

  This program is distributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
  for more details.

  You should have received a copy of the GNU Library General Public License
  along with this library; if not, write to the Free Software Foundation,
  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}

unit rxmemds;


{$I rx.inc}

interface


uses SysUtils, Classes, DB, ex_rx_datapacket, bufdataset_parser;

{ TRxMemoryData }

type
  TMemBlobData = string;
  TMemBlobArray = array[0..256] of TMemBlobData;
  PMemBlobArray = ^TMemBlobArray;
  TMemoryRecord = class;
  TLoadMode = (lmCopy, lmAppend);
  TCompareRecords = function (Item1, Item2: TMemoryRecord): Integer of object;

  TRxMemoryData = class(TDataSet)
  private
    FRecordPos: Integer;
    FRecordSize: Integer;
    FBookmarkOfs: Integer;
    FBlobOfs: Integer;
    FRecBufSize: Integer;
    FOffsets: PWordArray;
    FLastID: Integer;
    FAutoInc: Longint;
    FActive: Boolean;
    FRecords: TList;
    FIndexList: TList;
    FCaseInsensitiveSort: Boolean;
    FDescendingSort: Boolean;

    FFileName: string;
    FFileStream     : TFileStream;
    FDatasetReader  : TRxDataPacketReader;
    FPacketRecords: Integer;
    FFilterBuffer   : pchar;
    FNullmaskSize   : byte;
    FBRecordCount   : integer;
    FParser         : TBufDatasetParser;
    function  IntAllocRecordBuffer: PChar;
    procedure IntLoadFielddefsFromFile;
    procedure IntLoadRecordsFromFile;
    procedure SetPacketRecords(const AValue: Integer);

    function AddRecord: TMemoryRecord;
    procedure CopyRecord(RecordData, Buffer: PChar);
    function InsertRecord(Index: Integer): TMemoryRecord;
    function FindRecordID(ID: Integer): TMemoryRecord;
    procedure CreateIndexList(const FieldNames: string);
    procedure FreeIndexList;
    procedure QuickSort(L, R: Integer; Compare: TCompareRecords);
    procedure Sort;
    function CalcRecordSize: Integer;
    function FindFieldData(Buffer: Pointer; Field: TField): Pointer;overload;
    function FindFieldData(Buffer: Pointer; FieldNo:Integer): Pointer;overload;
    function GetMemoryRecord(Index: Integer): TMemoryRecord;
    function GetCapacity: Integer;
    function RecordFilter: Boolean;
    procedure SetCapacity(Value: Integer);
    procedure ClearRecords;
    procedure InitBufferPointers(GetProps: Boolean);
    procedure ParseFilter(const AFilter: string);
  protected
    procedure AssignMemoryRecord(Rec: TMemoryRecord; Buffer: PChar);
    function GetActiveRecBuf(var RecBuf: PChar): Boolean; virtual;
    procedure InitFieldDefsFromFields;
    procedure RecordToBuffer(Rec: TMemoryRecord; Buffer: PChar);
    procedure SetMemoryRecordData(Buffer: PChar; Pos: Integer); virtual;
    procedure SetAutoIncFields(Buffer: PChar); virtual;
    function CompareRecords(Item1, Item2: TMemoryRecord): Integer; virtual;
    function GetBlobData(Field: TField; Buffer: PChar): TMemBlobData;
    procedure SetBlobData(Field: TField; Buffer: PChar; Value: TMemBlobData);
    function AllocRecordBuffer: PChar; override;
    procedure FreeRecordBuffer(var Buffer: PChar); override;
    function BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean;
    function CurrToBCD(const Curr: Currency; BCD: Pointer;
      Precision, Decimals: Integer): Boolean;
    procedure InternalInitRecord(Buffer: PChar); override;
    procedure ClearCalcFields(Buffer: PChar); override;
    function GetRecord(Buffer: PChar; GetMode: TGetMode;
      DoCheck: Boolean): TGetResult; override;
    function GetRecordSize: Word; override;
    procedure SetFiltered(Value: Boolean); override;
    procedure SetOnFilterRecord(const Value: TFilterRecordEvent); override;
    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
    procedure CloseBlob(Field: TField); override;
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
    {$IFDEF NoAutomatedBookmark}
    procedure InternalGotoBookmark(ABookmark: TBookmark); override;
    {$ELSE}
    procedure InternalGotoBookmark(ABookmark: Pointer); override;
    {$ENDIF}
    procedure InternalSetToRecord(Buffer: PChar); override;
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
    function GetIsIndexField(Field: TField): Boolean; override;
    procedure InternalFirst; override;
    procedure InternalLast; override;
    procedure InitRecord(Buffer: PChar); override;
    procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
    procedure InternalDelete; override;
    procedure InternalPost; override;
    procedure InternalClose; override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalOpen; override;
    procedure OpenCursor(InfoQuery: Boolean); override;
    function IsCursorOpen: Boolean; override;
    function GetRecordCount: Integer; override;
    function GetRecNo: Integer; override;
    procedure SetRecNo(Value: Integer); override;
    property Records[Index: Integer]: TMemoryRecord read GetMemoryRecord;
    function GetAnyRecField(SrcRecNo:integer; AField:TField):variant;
    procedure SetFilterText(const Value: String); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function BookmarkValid(ABookmark: TBookmark): Boolean; override;
    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
    function GetCurrentRecord(Buffer: PChar): Boolean; override;
    function IsSequenced: Boolean; override;
    function Locate(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions): Boolean; override;
    procedure SortOnFields(const FieldNames: string;
      CaseInsensitive: Boolean = True; Descending: Boolean = False);
    procedure SortOnFieldsEx(const FieldNames: string;
      CaseInsensitive: Boolean = True; Asc: array of boolean);
    procedure EmptyTable;
    procedure CloseOpen;
    procedure CopyStructure(Source: TDataSet);
    function LoadFromDataSet(Source: TDataSet; ARecordCount: Integer;
      Mode: TLoadMode): Integer;
    function SaveToDataSet(Dest: TDataSet; ARecordCount: Integer): Integer;
    procedure AppendRecord(const Values: array of const);
    procedure MoveUp;
    procedure MoveDown;
    procedure ExchangeRec(ARecNo1, ARecNo2: Integer);

    procedure SetDatasetPacket(AReader : TRxDataPacketReader);
    procedure GetDatasetPacket(AWriter : TRxDataPacketReader);
    procedure LoadFromStream(AStream : TStream; Format: TRxDataPacketFormat = dfBinary);
    procedure SaveToStream(AStream : TStream; Format: TRxDataPacketFormat = dfBinary);
    procedure LoadFromFile(AFileName: string = ''; Format: TRxDataPacketFormat = dfAny);
    procedure SaveToFile(AFileName: string = ''; Format: TRxDataPacketFormat = dfAny);
  published
    property Capacity: Integer read GetCapacity write SetCapacity default 0;
    property Active;
    property AutoCalcFields;
    property Filtered;
    property FieldDefs;
//    property ObjectView default False;
    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnFilterRecord;
    property OnNewRecord;
    property OnPostError;

    property FileName : string read FFileName write FFileName;
    property PacketRecords : Integer read FPacketRecords write SetPacketRecords default 10;
  end;

{ TMemBlobStream }

  TMemBlobStream = class(TStream)
  private
    FField: TBlobField;
    FDataSet: TRxMemoryData;
    FBuffer: PChar;
    FMode: TBlobStreamMode;
    FOpened: Boolean;
    FModified: Boolean;
    FPosition: Longint;
    FCached: Boolean;
    function GetBlobSize: Longint;
    function GetBlobFromRecord(Field: TField): TMemBlobData;
  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;

{ TMemoryRecord }

  TMemoryRecord = class(TPersistent)
  private
    FMemoryData: TRxMemoryData;
    FID: Integer;
    FData: Pointer;
    FBlobs: PMemBlobArray;
    function GetIndex: Integer;
    procedure SetMemoryData(Value: TRxMemoryData; UpdateParent: Boolean);
  protected
    procedure SetIndex(Value: Integer); virtual;
  public
    constructor Create(MemoryData: TRxMemoryData); virtual;
    constructor CreateEx(MemoryData: TRxMemoryData; UpdateParent: Boolean); virtual;
    destructor Destroy; override;
    property MemoryData: TRxMemoryData read FMemoryData;
    property ID: Integer read FID write FID;
    property Index: Integer read GetIndex write SetIndex;
    property Data: Pointer read FData;
  end;


implementation


uses CustApp, rxdconst, LazUTF8, rxdbutils, dbconst, Variants, math, LResources;

const
  ftBlobTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle,
    ftDBaseOle, ftTypedBinary, ftOraBlob, ftOraClob];

  ftSupported = [ftString, ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat,
    ftCurrency, ftDate, ftTime, ftDateTime, ftAutoInc, ftBCD, ftBytes,
    ftVarBytes, ftADT, ftFixedChar, ftWideString, ftLargeint, ftVariant, ftGuid] +
    ftBlobTypes;

  fkStoredFields = [fkData];

  GuidSize = 38;

{ Utility routines }

procedure FinalizeBlobFields(BlobArray:PMemBlobArray; BlobFieldCount:integer);
var
  i:integer;
begin
  for i:=0 to BlobFieldCount-1 do
    BlobArray^[i]:='';
end;

function CompareFields(Data1, Data2: Pointer; FieldType: TFieldType;
  CaseInsensitive: Boolean): Integer;
begin
  Result := 0;
  case FieldType of
    ftString:
      if CaseInsensitive then
        Result := UTF8CompareText(PChar(Data1), PChar(Data2))
      else
        Result := UTF8CompareStr(PChar(Data1), PChar(Data2));
    ftSmallint:
      if SmallInt(Data1^) > SmallInt(Data2^) then Result := 1
      else if SmallInt(Data1^) < SmallInt(Data2^) then Result := -1;
    ftInteger, ftDate, ftTime, ftAutoInc:
      if Longint(Data1^) > Longint(Data2^) then Result := 1
      else if Longint(Data1^) < Longint(Data2^) then Result := -1;
    ftWord:
      if Word(Data1^) > Word(Data2^) then Result := 1
      else if Word(Data1^) < Word(Data2^) then Result := -1;
    ftBoolean:
      if WordBool(Data1^) and not WordBool(Data2^) then Result := 1
      else if not WordBool(Data1^) and WordBool(Data2^) then Result := -1;
    ftFloat, ftCurrency:
      if Double(Data1^) > Double(Data2^) then Result := 1
      else if Double(Data1^) < Double(Data2^) then Result := -1;
    ftDateTime:
      if TDateTime(Data1^) > TDateTime(Data2^) then Result := 1
      else if TDateTime(Data1^) < TDateTime(Data2^) then Result := -1;
    ftFixedChar:
      if CaseInsensitive then
        Result := UTF8CompareText(PChar(Data1), PChar(Data2))
      else
        Result := UTF8CompareStr(PChar(Data1), PChar(Data2));
    ftWideString:
      if CaseInsensitive then
        Result := UTF8CompareText(WideCharToString(PWideChar(Data1)),
          WideCharToString(PWideChar(Data2)))
      else
        Result := UTF8CompareStr(WideCharToString(PWideChar(Data1)),
          WideCharToString(PWideChar(Data2)));
    ftLargeint: 
      if Int64(Data1^) > Int64(Data2^) then Result := 1
      else if Int64(Data1^) < Int64(Data2^) then Result := -1;
    ftVariant:
      Result := 0;
    ftGuid:
      Result := UTF8CompareText(PChar(Data1), PChar(Data2));
  end;
end;

function CalcFieldLen(FieldType: TFieldType; Size: Word): Word;
begin
  if not (FieldType in ftSupported) then
    Result := 0
  else
  if (FieldType in ftBlobTypes) then
    Result := SizeOf(Longint)
  else
  begin
    Result := Size;
    case FieldType of
      ftString: Inc(Result);
      ftSmallint: Result := SizeOf(SmallInt);
      ftInteger: Result := SizeOf(Longint);
      ftWord: Result := SizeOf(Word);
      ftBoolean: Result := SizeOf(WordBool);
      ftFloat: Result := SizeOf(Double);
      ftCurrency: Result := SizeOf(Double);
      ftBCD: Result := 34;
      ftDate, ftTime: Result := SizeOf(Longint);
      ftDateTime: Result := SizeOf(TDateTime);
      ftBytes: Result := Size;
      ftVarBytes: Result := Size + 2;
      ftAutoInc: Result := SizeOf(Longint);
      ftADT: Result := 0;
      ftFixedChar: Inc(Result);
      ftWideString: Result := (Result + 1) * 2;
      ftLargeint: Result := SizeOf(Int64);
      ftVariant: Result := SizeOf(Variant);
      ftGuid: Result := GuidSize + 1;
    end;
  end;
end;

procedure CalcDataSize(FieldDef: TFieldDef; var DataSize: Integer);
var
  I: Integer;
begin
  with FieldDef do begin
    if (DataType in ftSupported - ftBlobTypes) then
      Inc(DataSize, CalcFieldLen(DataType, Size) + 1);
{$IFDEF ENABLE_Child_Defs}
    for I := 0 to ChildDefs.Count - 1 do
      CalcDataSize(ChildDefs[I], DataSize);
{$ENDIF}
  end;
end;

procedure Error(const Msg: string);
begin
  DatabaseError(Msg);
end;

procedure ErrorFmt(const Msg: string; const Args: array of const);
begin
  DatabaseErrorFmt(Msg, Args);
end;

type
  TBookmarkData = Integer;
  PMemBookmarkInfo = ^TMemBookmarkInfo;
  TMemBookmarkInfo = packed record
    BookmarkData: TBookmarkData;
    BookmarkFlag: TBookmarkFlag;
  end;

{ TMemoryRecord }

constructor TMemoryRecord.Create(MemoryData: TRxMemoryData);
begin
  CreateEx(MemoryData, True);
end;

constructor TMemoryRecord.CreateEx(MemoryData: TRxMemoryData;
  UpdateParent: Boolean);
begin
  inherited Create;
  SetMemoryData(MemoryData, UpdateParent);
end;

destructor TMemoryRecord.Destroy;
begin
  SetMemoryData(nil, True);
  inherited Destroy;
end;

function TMemoryRecord.GetIndex: Integer;
begin
  if FMemoryData <> nil then Result := FMemoryData.FRecords.IndexOf(Self)
  else Result := -1;
end;

procedure TMemoryRecord.SetMemoryData(Value: TRxMemoryData; UpdateParent: Boolean);
var
  I: Integer;
  DataSize: Integer;
begin
  if FMemoryData <> Value then
  begin
    if FMemoryData <> nil then
    begin
      FMemoryData.FRecords.Remove(Self);
      if FMemoryData.BlobFieldCount > 0 then
      begin
        FinalizeBlobFields(FBlobs, FMemoryData.BlobFieldCount);
        Freemem(FBlobs, FMemoryData.BlobFieldCount * SizeOf(TMemBlobData));
      end;
      FBlobs:=nil;
      ReallocMem(FData, 0);
      FMemoryData := nil;
    end;
    if Value <> nil then
    begin
      if UpdateParent then
      begin
        Value.FRecords.Add(Self);
        Inc(Value.FLastID);
        FID := Value.FLastID;
      end;
      FMemoryData := Value;
      if Value.BlobFieldCount > 0 then
      begin
        GetMem(FBlobs, Value.BlobFieldCount * SizeOf(TMemBlobData));
        FillChar(FBlobs^, Value.BlobFieldCount * SizeOf(Pointer), 0);
        FinalizeBlobFields(FBlobs, Value.BlobFieldCount);
//        Initialize(PMemBlobArray(FBlobs)^[0]);//, Value.BlobFieldCount);
      end;
      DataSize := 0;
      for I := 0 to Value.FieldDefs.Count - 1 do
        CalcDataSize(Value.FieldDefs[I], DataSize);
      ReallocMem(FData, DataSize);
      FillChar(FData^, DataSize, 0);
    end;
  end;
end;

procedure TMemoryRecord.SetIndex(Value: Integer);
var
  CurIndex: Integer;
begin
  CurIndex := GetIndex;
  if (CurIndex >= 0) and (CurIndex <> Value) then
    FMemoryData.FRecords.Move(CurIndex, Value);
end;

{ TRxMemoryData }

constructor TRxMemoryData.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FParser := nil;
  FRecordPos := -1;
  FLastID := Low(Integer);
  FAutoInc := 1;
  FRecords := TList.Create;
end;

destructor TRxMemoryData.Destroy;
begin
  inherited Destroy;
  FreeIndexList;
  ClearRecords;
  FRecords.Free;
  ReallocMem(FOffsets, 0);
  if Assigned(FParser) then FreeAndNil(FParser);
end;

{ Records Management }

function TRxMemoryData.GetCapacity: Integer;
begin
  if FRecords <> nil then Result := FRecords.Capacity
  else Result := 0;
end;

procedure TRxMemoryData.SetCapacity(Value: Integer);
begin
  if FRecords <> nil then FRecords.Capacity := Value;
end;

function TRxMemoryData.AddRecord: TMemoryRecord;
begin
  Result := TMemoryRecord.Create(Self);
end;

function TRxMemoryData.FindRecordID(ID: Integer): TMemoryRecord;
var
  I: Integer;
begin
  for I := 0 to FRecords.Count - 1 do begin
    Result := TMemoryRecord(FRecords[I]);
    if Result.ID = ID then Exit;
  end;
  Result := nil;
end;

function TRxMemoryData.InsertRecord(Index: Integer): TMemoryRecord;
begin
  Result := AddRecord;
  Result.Index := Index;
end;

function TRxMemoryData.GetMemoryRecord(Index: Integer): TMemoryRecord;
begin
  Result := TMemoryRecord(FRecords[Index]);
end;

{ Field Management }

function TRxMemoryData.BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean;
begin
  Move(BCD^, Curr, SizeOf(Currency));
  Result := True;
end;

function TRxMemoryData.CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  Decimals: Integer): Boolean;
begin
  Move(Curr, BCD^, SizeOf(Currency));
  Result := True;
end;

procedure TRxMemoryData.InitFieldDefsFromFields;
var
  I: Integer;
  Offset: Word;
  FD:TFieldDef;
begin
  if FieldDefs.Count = 0 then
  begin
    for I := 0 to FieldCount - 1 do
    begin
      with Fields[I] do
        if (FieldKind in fkStoredFields) and not (DataType in ftSupported) then
          ErrorFmt(SUnknownFieldType, [DisplayName]);
    end;
    FreeIndexList;
  end;
  Offset := 0;
  { Create FieldDefs from persistent fields if needed }
  if FieldDefs.Count = 0 then
    for I := 0 to FieldCount - 1 do
    begin
      FD:=FieldDefs.AddFieldDef;
//      FD.DisplayName:=Fields[I].DisplayName;
      FD.Name:=Fields[I].FieldName;
      FD.Size:=Fields[I].Size;
      FD.DataType:=Fields[I].DataType;
      if Fields[I].Required then
         FD.Attributes:= FD.Attributes + [faRequired];
      if Fields[I] is TFloatField then
        FD.Precision:=TFloatField(Fields[I]).Precision;
    end;
  { Calculate fields offsets }
  ReallocMem(FOffsets, FieldDefs.Count * SizeOf(Word));
  for I := 0 to FieldDefs.Count - 1 do
  begin
    FOffsets^[I] := Offset;
    with FieldDefs[I] do
    begin
      if (DataType in ftSupported - ftBlobTypes) then
        Inc(Offset, CalcFieldLen(DataType, Size) + 1);
    end;
  end;
end;

function TRxMemoryData.FindFieldData(Buffer: Pointer; Field: TField): Pointer;
var
  Index: Integer;
begin
{.$IFDEF TEST_RXMDS}
  Index := FieldDefs.IndexOf(Field.FieldName);
//
  if Index <> Field.FieldNo - 1 then
     raise exception.Create('Index <> Field.FieldNo - 1');
{.$ENDIF}
//  Index := Field.FieldNo - 1;
//
  Result:=FindFieldData(Buffer, Index);
end;

function TRxMemoryData.FindFieldData(Buffer: Pointer; FieldNo: Integer): Pointer;
begin
  Result := nil;
  if (FieldNo >= 0) and (Buffer <> nil) and (FieldDefs[FieldNo].DataType in ftSupported - ftBlobTypes) then
    Result := Pointer(PtrInt(PChar(Buffer)) + FOffsets^[FieldNo]);
end;

{ Buffer Manipulation }

function TRxMemoryData.CalcRecordSize: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to FieldDefs.Count - 1 do
    CalcDataSize(FieldDefs[I], Result);
end;

procedure TRxMemoryData.InitBufferPointers(GetProps: Boolean);
begin
  if GetProps then FRecordSize := CalcRecordSize;
  FBookmarkOfs := FRecordSize + CalcFieldsSize;
  FBlobOfs := FBookmarkOfs + SizeOf(TMemBookmarkInfo);
  FRecBufSize := FBlobOfs + BlobFieldCount * SizeOf(TMemBlobData);//Pointer);
end;

procedure TRxMemoryData.ParseFilter(const AFilter: string);
begin
  // parser created?
  if Length(AFilter) > 0 then
  begin
    if (FParser = nil) and IsCursorOpen then
    begin
      FParser := TBufDatasetParser.Create(Self);
    end;
    // is there a parser now?
    if FParser <> nil then
    begin
      // set options
      FParser.PartialMatch := not (foNoPartialCompare in FilterOptions);
      FParser.CaseInsensitive := foCaseInsensitive in FilterOptions;
      // parse expression
      FParser.ParseExpression(AFilter);
    end;
  end;
end;

procedure TRxMemoryData.ClearRecords;
begin
  while FRecords.Count > 0 do TObject(FRecords.Last).Free;
  FLastID := Low(Integer);
  FRecordPos := -1;
end;

function TRxMemoryData.AllocRecordBuffer: PChar;
begin
  Result := StrAlloc(FRecBufSize);
  InternalInitRecord(Result);
{  FillChar(Result^, FRecBufSize, 0);
  if BlobFieldCount > 0 then
  begin
//    Initialize(PMemBlobArray(Result + FBlobOfs)^[0]);//, BlobFieldCount);
//    FillChar(PMemBlobArray(Result + FBlobOfs)^, BlobFieldCount * SizeOf(Pointer),0);//, BlobFieldCount);
    FinalizeBlobFields(PMemBlobArray(Result + FBlobOfs), BlobFieldCount);

  end;}
end;

procedure TRxMemoryData.FreeRecordBuffer(var Buffer: PChar);
var
  n:integer;
  FieldPtr:PChar;
begin
  //correctly release field memory for complex types
  for n:=0 to FieldDefs.Count-1 do
    if FieldDefs.Items[n].DataType = ftVariant then
    begin
      FieldPtr:=FindFieldData(Buffer, n);
      if FieldPtr <> nil then
      begin
        PBoolean(FieldPtr)^:=False;
        Inc(FieldPtr);
        Finalize( PVariant(FieldPtr)^ );
      end;
    end;

  if BlobFieldCount > 0 then
    FinalizeBlobFields(PMemBlobArray(Buffer + FBlobOfs), BlobFieldCount);

  StrDispose(Buffer);
  Buffer := nil;
end;

procedure TRxMemoryData.ClearCalcFields(Buffer: PChar);
begin
  FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
end;

procedure TRxMemoryData.InternalInitRecord(Buffer: PChar);
var
  I: Integer;
begin
  FillChar(Buffer^, FBlobOfs, 0);
  FillChar(PByteArray(Buffer + FBlobOfs)^, BlobFieldCount * SizeOf(Pointer), 0);
  for I := 0 to BlobFieldCount - 1 do
  begin
    PMemBlobArray(Buffer + FBlobOfs)^[I] := '';
  end;
end;

procedure TRxMemoryData.InitRecord(Buffer: PChar);
begin
  inherited InitRecord(Buffer);
  with PMemBookmarkInfo(Buffer + FBookmarkOfs)^ do
  begin
    BookmarkData := Low(Integer);
    BookmarkFlag := bfInserted;
  end;
end;

procedure TRxMemoryData.CopyRecord(RecordData, Buffer:PChar);
var
  n, FieldSize:Integer;
  FieldPtr, BufPtr:PChar;
  DataType:TFieldType;
begin
  for n:=0 to FieldDefs.Count-1 do
  begin
    FieldPtr:=FindFieldData(RecordData, n);
    BufPtr:=FindFieldData(Buffer, n);
    if FieldPtr = nil then Continue;

    PBoolean(BufPtr)^:=PBoolean(FieldPtr)^;
    Inc(FieldPtr);
    Inc(BufPtr);

    DataType:=FieldDefs.Items[n].DataType;
    if DataType = ftVariant then
    begin
      PVariant(BufPtr)^:=PVariant(FieldPtr)^;
    end
    else
    begin
      FieldSize:=FieldDefs.Items[n].Size;
      Move( FieldPtr^, BufPtr^, CalcFieldLen(DataType, FieldSize) );
    end;
  end;
end;

function TRxMemoryData.GetCurrentRecord(Buffer: PChar): Boolean;
begin
  Result := False;
  if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then
  begin
    UpdateCursorPos;
    if (FRecordPos >= 0) and (FRecordPos < RecordCount) then
    begin
      //Move(Records[FRecordPos].Data^, Buffer^, FRecordSize);
      CopyRecord(Records[FRecordPos].Data, Buffer);

      Result := True;
    end;
  end;
end;

procedure TRxMemoryData.RecordToBuffer(Rec: TMemoryRecord; Buffer: PChar);
var
  I: Integer;
begin
  //Move(Rec.Data^, Buffer^, FRecordSize);
  CopyRecord(Rec.Data, Buffer);
  with PMemBookmarkInfo(Buffer + FBookmarkOfs)^ do
  begin
    BookmarkData := Rec.ID;
    BookmarkFlag := bfCurrent;
  end;
  for I := 0 to BlobFieldCount - 1 do
    PMemBlobArray(Buffer + FBlobOfs)^[I] := PMemBlobArray(Rec.FBlobs)^[I];
  GetCalcFields(Buffer);
end;

function TRxMemoryData.GetRecord(Buffer: PChar; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
var
  Accept: Boolean;
begin
  Result := grOk;
  Accept := True;
  case GetMode of
    gmPrior:
      if FRecordPos <= 0 then begin
        Result := grBOF;
        FRecordPos := -1;
      end
      else begin
        repeat
          Dec(FRecordPos);
          if Filtered then Accept := RecordFilter;
        until Accept or (FRecordPos < 0);
        if not Accept then begin
          Result := grBOF;
          FRecordPos := -1;
        end;
      end;
    gmCurrent:
      if (FRecordPos < 0) or (FRecordPos >= RecordCount) then
        Result := grError
      else if Filtered then begin
        if not RecordFilter then Result := grError;
      end;
    gmNext:
      if FRecordPos >= RecordCount - 1 then Result := grEOF
      else begin
        repeat
          Inc(FRecordPos);
          if Filtered then Accept := RecordFilter;
        until Accept or (FRecordPos > RecordCount - 1);
        if not Accept then begin
          Result := grEOF;
          FRecordPos := RecordCount - 1;
        end;
      end;
  end;
  if Result = grOk then RecordToBuffer(Records[FRecordPos], Buffer)
  else if (Result = grError) and DoCheck then Error(SMemNoRecords);
end;

function TRxMemoryData.GetRecordSize: Word;
begin
  Result := FRecordSize;
end;

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

{$IFDEF FIX_BUG_FieldNo}
function GetFieldNo(DS:TDataSet; Field:TField):integer;
var
  i:integer;
begin
  for i:=0 to DS.FieldDefs.Count-1 do
    if DS.FieldDefs[i].Name = Field.FieldName then
    begin
      Result:=i+1;
      exit;
    end;
  Result:=0;
end;
{$ENDIF}

function TRxMemoryData.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
  RecBuf, Data: PChar;
  VarData: Variant;
begin
  Result := False;
  if not GetActiveRecBuf(RecBuf) then Exit;
{$IFDEF FIX_BUG_FieldNo}
  if GetFieldNo(Self, Field) > 0 then
{$ELSE}
  if Field.FieldNo > 0 then
{$ENDIF}
  begin
    Data := FindFieldData(RecBuf, Field);
    if Data <> nil then begin
      Result := Boolean(Data[0]);
      Inc(Data);
      if Field.DataType in [ftString, ftFixedChar, ftWideString, ftGuid] then
        Result := Result and (StrLen(Data) > 0);
      if Result and (Buffer <> nil) then
        if Field.DataType = ftVariant then
        begin
          VarData := PVariant(Data)^;
          PVariant(Buffer)^ := VarData;
        end
        else
          Move(Data^, Buffer^, CalcFieldLen(Field.DataType, Field.Size));
    end;
  end
  else
  begin
    if State in [dsBrowse, dsEdit, dsInsert, dsCalcFields] then
    begin
      Inc(RecBuf, FRecordSize + Field.Offset);
      Result := Boolean(RecBuf[0]);
      if Result and (Buffer <> nil) then
        Move(RecBuf[1], Buffer^, Field.DataSize);
    end;
  end;
end;

procedure TRxMemoryData.SetFieldData(Field: TField; Buffer: Pointer);
var
  RecBuf, Data: PChar;
  VarData: Variant;
  PBl:PBoolean;
begin
  if not (State in dsWriteModes) then ErrorFmt(SNotEditing, [Name]);
  GetActiveRecBuf(RecBuf);
  with Field do
  begin
{$IFDEF FIX_BUG_FieldNo}
    if GetFieldNo(Self, Field) > 0 then
{$ELSE}
    if Field.FieldNo > 0 then
{$ENDIF}
    begin
      if State in [dsCalcFields, dsFilter] then ErrorFmt(SNotEditing, [Name]);
      if ReadOnly and not (State in [dsSetKey, dsFilter]) then
        ErrorFmt(SFieldReadOnly, [DisplayName]);
      Validate(Buffer);
      if FieldKind <> fkInternalCalc then
      begin
        Data := FindFieldData(RecBuf, Field);
        if Data <> nil then
        begin
          if DataType = ftVariant then
          begin
            if (Buffer = nil) or VarIsNull(PVariant(Buffer)^) or VarIsEmpty(PVariant(Buffer)^) or
               VarIsEmptyParam(PVariant(Buffer)^) then
              FillChar(Data^, CalcFieldLen(DataType, Size), 0)
            else
            begin
              Boolean(Data[0]):=True;
              Inc(Data);
              PVariant(Data)^ := PVariant(Buffer)^;
            end;
          end
          else
          begin
            PBl:=Pointer(Data);
//            Boolean(Data^{[0]}) := Assigned(Buffer);//LongBool(Buffer);
//            Pbl^:=Assigned(Buffer);
            PBoolean(Pointer(Data))^:= Assigned(Buffer);
            Inc(Data);
            if Assigned(Buffer) then
              Move(Buffer^, Data^, CalcFieldLen(DataType, Size))
            else
              FillChar(Data^, CalcFieldLen(DataType, Size), 0);
          end;
        end;
      end;
    end else {fkCalculated, fkLookup}
    begin
      Inc(RecBuf, FRecordSize + Offset);
      Boolean(RecBuf[0]) := LongBool(Buffer);
      if Boolean(RecBuf[0]) then Move(Buffer^, RecBuf[1], DataSize);
    end;
    if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
      DataEvent(deFieldChange, ptrint(Field));
  end;
end;

{ Filter }

procedure TRxMemoryData.SetFiltered(Value: Boolean);
begin
  if Active then
  begin
    CheckBrowseMode;
    if Filtered <> Value then
    begin
      inherited SetFiltered(Value);
      First;
    end;
  end
  else
    inherited SetFiltered(Value);
end;

procedure TRxMemoryData.SetOnFilterRecord(const Value: TFilterRecordEvent);
begin
  if Active then
  begin
    CheckBrowseMode;
    inherited SetOnFilterRecord(Value);
    if Filtered then First;
  end
  else
  inherited SetOnFilterRecord(Value);
end;

function TRxMemoryData.RecordFilter: Boolean;
var
  SaveState: TDataSetState;
  RecBuf: PChar;
begin
  Result := True;
  if Assigned(OnFilterRecord) then
  begin
    if (FRecordPos >= 0) and (FRecordPos < RecordCount) then
    begin
      SaveState := SetTempState(dsFilter);
      try
        RecordToBuffer(Records[FRecordPos], TempBuffer);
        OnFilterRecord(Self, Result);
      except
        CustomApplication.HandleException(Self);
      end;

      if Result and (Length(Filter) > 0) then
      begin
        if GetActiveRecBuf(RecBuf) then
          Result := Boolean((FParser.ExtractFromBuffer(RecBuf))^);
      end;

      RestoreState(SaveState);
    end
    else
      Result := False;
  end;
end;

{ Blobs }

function TRxMemoryData.GetBlobData(Field: TField; Buffer: PChar): TMemBlobData;
begin
  Result := PMemBlobArray(Buffer + FBlobOfs)^[Field.Offset];
end;

procedure TRxMemoryData.SetBlobData(Field: TField; Buffer: PChar;
  Value: TMemBlobData);
begin
  if (Buffer = ActiveBuffer) then begin
    if State = dsFilter then Error(SNotEditing);
    PMemBlobArray(Buffer + FBlobOfs)^[Field.Offset] := Value;
  end;
end;

procedure TRxMemoryData.CloseBlob(Field: TField);
begin
  if (FRecordPos >= 0) and (FRecordPos < FRecords.Count) and
    (State = dsEdit) then
    PMemBlobArray(ActiveBuffer + FBlobOfs)^[Field.Offset] :=
      PMemBlobArray(Records[FRecordPos].FBlobs)^[Field.Offset]
  else PMemBlobArray(ActiveBuffer + FBlobOfs)^[Field.Offset] := '';
end;

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

{ Bookmarks }

function TRxMemoryData.BookmarkValid(ABookmark: TBookmark): Boolean;
begin
  {$IFDEF NoAutomatedBookmark}
  Result := FActive and (TBookmarkData(ABookmark^) > Low(Integer)) and
    (TBookmarkData(ABookmark^) <= FLastID);
  {$ELSE}
  Result := FActive and Assigned(ABookmark) and (TBookmarkData(pointer(ABookmark)^) > Low(Integer)) and
    (TBookmarkData(pointer(ABookmark)^) <= FLastID);
  {$ENDIF}
end;

function TRxMemoryData.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): 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
  {$IFDEF NoAutomatedBookmark}
  else
  if TBookmarkData(Bookmark1^) > TBookmarkData(Bookmark2^) then
  {$ELSE}
  else
  if TBookmarkData(pointer(Bookmark1)^) > TBookmarkData(pointer(Bookmark2)^) then
  {$ENDIF}
    Result := 1
  {$IFDEF NoAutomatedBookmark}
  else
  if TBookmarkData(Bookmark1^) < TBookmarkData(Bookmark2^) then
  {$ELSE}
  else
  if TBookmarkData(pointer(Bookmark1)^) < TBookmarkData(pointer(Bookmark2)^) then
  {$ENDIF}
    Result := -1
  else Result := 0;
end;

procedure TRxMemoryData.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  Move(PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkData, Data^,
    SizeOf(TBookmarkData));
end;

procedure TRxMemoryData.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  Move(Data^, PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkData,
    SizeOf(TBookmarkData));
end;

function TRxMemoryData.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
  Result := PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkFlag;
end;

procedure TRxMemoryData.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
  PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkFlag := Value;
end;

{$IFDEF NoAutomatedBookmark}
procedure TRxMemoryData.InternalGotoBookmark(ABookmark: TBookmark);
{$ELSE}
procedure TRxMemoryData.InternalGotoBookmark(ABookmark: Pointer);
{$ENDIF}
var
  Rec: TMemoryRecord;
  SavePos: Integer;
  Accept: Boolean;
begin
  Rec := FindRecordID(TBookmarkData(ABookmark^));
  if Rec <> nil then
  begin
    Accept := True;
    SavePos := FRecordPos;
    try
      FRecordPos := Rec.Index;
      if Filtered then Accept := RecordFilter;
    finally
      if not Accept then FRecordPos := SavePos;
    end;
  end;
end;

{ Navigation }

procedure TRxMemoryData.InternalSetToRecord(Buffer: PChar);
begin
  InternalGotoBookmark(@PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkData);
end;

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

procedure TRxMemoryData.InternalLast;
begin
  FRecordPos := FRecords.Count;
end;

{ Data Manipulation }

procedure TRxMemoryData.AssignMemoryRecord(Rec: TMemoryRecord; Buffer: PChar);
var
  I: Integer;
begin
  //Move(Buffer^, Rec.Data^, FRecordSize);
  CopyRecord(Buffer, PChar(Rec.Data));

  for I := 0 to BlobFieldCount - 1 do
    PMemBlobArray(Rec.FBlobs)^[I] := PMemBlobArray(Buffer + FBlobOfs)^[I];
end;

procedure TRxMemoryData.SetMemoryRecordData(Buffer: PChar; Pos: Integer);
var
  Rec: TMemoryRecord;
begin
  if State = dsFilter then Error(SNotEditing);
  Rec := Records[Pos];
  AssignMemoryRecord(Rec, Buffer);
end;

procedure TRxMemoryData.SetAutoIncFields(Buffer: PChar);
var
  I, Count: Integer;
  Data: PChar;
begin
  Count := 0;
  for I := 0 to FieldCount - 1 do
    if (Fields[I].FieldKind in fkStoredFields) and
      (Fields[I].DataType = ftAutoInc) then
    begin
      Data := FindFieldData(Buffer, Fields[I]);
      if Data <> nil then begin
        Boolean(Data[0]) := True;
        Inc(Data);
        Move(FAutoInc, Data^, SizeOf(Longint));
        Inc(Count);
      end;
    end;
  if Count > 0 then Inc(FAutoInc);
end;

procedure TRxMemoryData.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
var
  RecPos: Integer;
  Rec: TMemoryRecord;
begin
  if DoAppend then
  begin
    Rec := AddRecord;
    FRecordPos := FRecords.Count - 1;
  end
  else
  begin
    if FRecordPos = -1 then
      RecPos := 0
    else
      RecPos := FRecordPos;
    Rec := InsertRecord(RecPos);
    FRecordPos := RecPos;
  end;
  SetAutoIncFields(Buffer);
  SetMemoryRecordData(Buffer, Rec.Index);
end;

procedure TRxMemoryData.InternalDelete;
var
  Accept: Boolean;
begin
  Records[FRecordPos].Free;
  if FRecordPos >= FRecords.Count then Dec(FRecordPos);
  Accept := True;
  repeat
    if Filtered then Accept := RecordFilter;
    if not Accept then Dec(FRecordPos);
  until Accept or (FRecordPos < 0);
  if FRecords.Count = 0 then FLastID := Low(Integer);
end;

procedure TRxMemoryData.InternalPost;
var
  RecPos: Integer;
begin
  if State = dsEdit then
    SetMemoryRecordData(ActiveBuffer, FRecordPos)
  else begin
    if State in [dsInsert] then SetAutoIncFields(ActiveBuffer);
    if FRecordPos >= FRecords.Count then begin
      SetMemoryRecordData(ActiveBuffer, AddRecord.Index);
      FRecordPos := FRecords.Count - 1;
    end
    else begin
      if FRecordPos = -1 then RecPos := 0
      else RecPos := FRecordPos;
      SetMemoryRecordData(ActiveBuffer, InsertRecord(RecPos).Index);
      FRecordPos := RecPos;
    end;
  end;
end;

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

procedure TRxMemoryData.InternalOpen;
begin
  BookmarkSize := SizeOf(TBookmarkData);
  if DefaultFields then CreateFields;
  BindFields(True);
  InitBufferPointers(True);
  InternalFirst;
end;

procedure TRxMemoryData.InternalClose;
begin
  ClearRecords;
  FAutoInc := 1;
  BindFields(False);
  if DefaultFields then DestroyFields;
  FreeIndexList;
  FActive := False;
end;

procedure TRxMemoryData.InternalHandleException;
begin
  CustomApplication.HandleException(Self);
end;

procedure TRxMemoryData.InternalInitFieldDefs;
begin
end;

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

{ Informational }

function TRxMemoryData.GetRecordCount: Integer;
begin
  Result := FRecords.Count;
end;

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

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

function TRxMemoryData.GetAnyRecField(SrcRecNo: integer; AField: TField
  ): variant;
var
  Data1: PChar;
  I: Integer;
  Item:TMemoryRecord;
begin
  Item:=Records[SrcRecNo];
  Data1 := FindFieldData(Item.Data, AField);
  Inc(Data1);  //Skip null flag

  case AField.DataType of
    ftString:Result := PChar(Data1);
    ftSmallint:Result:=SmallInt(Data1^);
    ftInteger,
    ftDate,
    ftTime,
    ftAutoInc:Result:=Longint(Data1^);
    ftWord:Result:=Word(Data1^);
    ftBoolean:Result:=WordBool(Data1^);
    ftFloat, ftCurrency:Result:=PDouble(Data1)^;
    ftDateTime:Result:=PDateTime(Data1)^;
    ftFixedChar:Result:=PChar(Data1);
    ftWideString:Result:=PWideChar(Data1);
    ftLargeint:Result:=Int64(Data1^);
    ftVariant:
      begin
        Result := PVariant(Data1)^;
      end;
    ftGuid:Result:=PChar(Data1);
  else
    Result:=null;
  end;
end;

procedure TRxMemoryData.SetFilterText(const Value: String);
begin
  if Value = Filter then
    exit;
  // parse
  ParseFilter(Value);
  // call dataset method
  inherited;
  // refilter dataset if filtered
  if IsCursorOpen and Filtered then Resync([]);
end;

function TRxMemoryData.IsSequenced: Boolean;
begin
  Result := not Filtered;
end;

{ DataSet locate routines }
function DataSetLocateThrough(DataSet: TDataSet; const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
var
  FieldCount: Integer;
  Fields: TList;

  function CompareField(Field: TField; Value: Variant): Boolean;
  var
    S,S1: string;

  begin
    if Field.DataType = ftString then
    begin
      S := Field.AsString;
      S1:=Value;
      if (loPartialKey in Options) then
        Delete(S, Length(S1) + 1, MaxInt);

      if (loCaseInsensitive in Options) then
        Result := UTF8CompareText(S, S1) = 0
      else
        Result := UTF8CompareStr(S, S1) = 0;
    end
    else Result := (Field.Value = Value);
  end;

  function CompareRecord: Boolean;
  var
    I: Integer;
  begin
    if FieldCount = 1 then
      Result := CompareField(TField(Fields.First), KeyValues)
    else begin
      Result := True;
      for I := 0 to FieldCount - 1 do
        Result := Result and CompareField(TField(Fields[I]), KeyValues[I]);
    end;
  end;
var
  Bookmark: TBookmark;
begin
  Result := False;
  with DataSet do begin
    CheckBrowseMode;
    if BOF and EOF then Exit;
  end;
  Fields := TList.Create;
  try
    DataSet.GetFieldList(Fields, KeyFields);
    FieldCount := Fields.Count;
    Result := CompareRecord;
    if Result then Exit;
    DataSet.DisableControls;
    try
      Bookmark := DataSet.GetBookmark;
      try
        with DataSet do begin
          First;
          while not EOF do begin
            Result := CompareRecord;
            if Result then Break;
            Next;
          end;
        end;
      finally
{$IFDEF NoAutomatedBookmark}
        if not Result and DataSet.BookmarkValid(PChar(Bookmark)) then
{$ELSE}
        if not Result and DataSet.BookmarkValid(Bookmark) then
{$ENDIF}
          DataSet.GotoBookmark(Bookmark);
      end;
    finally
      DataSet.FreeBookmark(Bookmark);
      DataSet.EnableControls;
    end;
  finally
    Fields.Free;
  end;
end;

function TRxMemoryData.Locate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
begin
  DoBeforeScroll;
  Result := DataSetLocateThrough(Self, KeyFields, KeyValues, Options);
  if Result then
  begin
    DataEvent(deDataSetChange, 0);
    DoAfterScroll;
  end;
end;

{ Table Manipulation }

procedure TRxMemoryData.EmptyTable;
begin
  if Active then
  begin
    CheckBrowseMode;
    ClearRecords;
    ClearBuffers;
    DataEvent(deDataSetChange, 0);
  end;
end;

procedure TRxMemoryData.CloseOpen;
begin
  Close;
  Open;
end;

procedure TRxMemoryData.CopyStructure(Source: TDataSet);

  procedure CheckDataTypes(FieldDefs: TFieldDefs);
  var
    I: Integer;
  begin
    for I := FieldDefs.Count - 1 downto 0 do begin
      if not (FieldDefs.Items[I].DataType in ftSupported) then
        FieldDefs.Items[I].Free
{$IFDEF ENABLE_Child_Defs}
      else CheckDataTypes(FieldDefs[I].ChildDefs);
{$ENDIF}
    end;
  end;

var
  I: Integer;
begin
  CheckInactive;
  for I := FieldCount - 1 downto 0 do Fields[I].Free;
  if (Source = nil) then Exit;
  Source.FieldDefs.Update;
//  FieldDefs.Assign(Source.FieldDefs);
//  FieldDefs := Source.FieldDefs;
  FieldDefs.Clear;
  for i:=0 to Source.FieldDefs.Count-1 do
    FieldDefs.Add(Source.FieldDefs[i].Name, Source.FieldDefs[i].DataType, Source.FieldDefs[i].Size, Source.FieldDefs[i].Required);
      
  CheckDataTypes(FieldDefs);
  CreateFields;
end;
(*
procedure AssignRecord(Source, Dest: TDataSet; ByName: Boolean);
var
  I: Integer;
  F, FSrc: TField;
begin
//  if not (Dest.State in dsEditModes) then DBError(SNotEditing);
  if ByName then begin
    for I := 0 to Source.FieldCount - 1 do begin
      F := Dest.FindField(Source.Fields[I].FieldName);
      if F <> nil then begin
        if (F.DataType = Source.Fields[I].DataType) and
          (F.DataSize = Source.Fields[I].DataSize) then
          F.Assign(Source.Fields[I])
        else F.AsString := Source.Fields[I].AsString;
      end;
    end;
  end
  else begin
    for I := 0 to Min(Source.FieldDefs.Count - 1, Dest.FieldDefs.Count - 1) do
    begin
      F := Dest.FindField(Dest.FieldDefs[I].Name);
      FSrc := Source.FindField(Source.FieldDefs[I].Name);
      if (F <> nil) and (FSrc <> nil) then begin
        if F.DataType = FSrc.DataType then F.Assign(FSrc)
        else F.AsString := FSrc.AsString;
      end;
    end;
  end;
end;
*)
function TRxMemoryData.LoadFromDataSet(Source: TDataSet; ARecordCount: Integer;
  Mode: TLoadMode): Integer;
var
  SourceActive: Boolean;
  MovedCount: Integer;
begin
  Result := 0;
  if Source = Self then Exit;
  SourceActive := Source.Active;
  Source.DisableControls;
  try
    DisableControls;
    try
      Filtered := False;
      with Source do begin
        Open;
        CheckBrowseMode;
        UpdateCursorPos;
      end;
      if Mode = lmCopy then begin
        Close;
        CopyStructure(Source);
      end;
      FreeIndexList;
      if not Active then Open;
      Resync([]);
      CheckBrowseMode;
      if ARecordCount > 0 then MovedCount := ARecordCount
      else begin
        Source.First;
        MovedCount := MaxInt;
      end;
      try
        while not Source.EOF do
        begin
          Append;
          AssignRecord(Source, Self, True);
          Post;
          Inc(Result);
          if Result >= MovedCount then Break;
          Source.Next;
        end;
      finally
        First;
      end;
    finally
      EnableControls;
    end;
  finally
    if not SourceActive then Source.Close;
    Source.EnableControls;
  end;
end;

function TRxMemoryData.SaveToDataSet(Dest: TDataSet; ARecordCount: Integer): Integer;
var
  MovedCount: Integer;
begin
  Result := 0;
  if Dest = Self then Exit;
  CheckBrowseMode;
  UpdateCursorPos;
  Dest.DisableControls;
  try
    DisableControls;
    try
      if not Dest.Active then Dest.Open
      else Dest.CheckBrowseMode;
      if ARecordCount > 0 then MovedCount := ARecordCount
      else
      begin
        First;
        MovedCount := MaxInt;
      end;
      try
        while not EOF do begin
          Dest.Append;
          AssignRecord(Self, Dest, True);
          Dest.Post;
          Inc(Result);
          if Result >= MovedCount then Break;
          Next;
        end;
      finally
        Dest.First;
      end;
    finally
      EnableControls;
    end;
  finally
    Dest.EnableControls;
  end;
end;

procedure TRxMemoryData.AppendRecord(const Values: array of const);
var
  I: Integer;
begin
  if State <> dsInsert then
    Append;
  for I := 0 to High(Values) do Fields[I].AssignValue(Values[I]);
  Post;
end;

procedure TRxMemoryData.MoveUp;
begin
  if (FRecords.Count > 1) and (FRecordPos > 0) then
    ExchangeRec(FRecordPos, FRecordPos + 1);
end;

procedure TRxMemoryData.MoveDown;
begin
  if (FRecords.Count > 1) and (FRecordPos < FRecords.Count - 1) then
    ExchangeRec(FRecordPos + 1, FRecordPos + 2);
end;

procedure TRxMemoryData.ExchangeRec(ARecNo1, ARecNo2: Integer);
begin
  CheckActive;
  CheckBrowseMode;
  if (ARecNo1 <> ARecNo2) and (ARecNo1 > 0) and (ARecNo2 > 0)
     and (ARecNo1 <= FRecords.Count) and (ARecNo2 <= FRecords.Count) then
  begin
    FRecords.Exchange(ARecNo1 - 1, ARecNo2 - 1);
    Resync([]);
  end;
end;

{ Index Related }

procedure TRxMemoryData.SortOnFields(const FieldNames: string;
  CaseInsensitive: Boolean = True; Descending: Boolean = False);
begin
  CreateIndexList(FieldNames);
  FCaseInsensitiveSort := CaseInsensitive;
  FDescendingSort := Descending;
  try
    Sort;
  except
    FreeIndexList;
    raise;
  end;
end;

procedure TRxMemoryData.SortOnFieldsEx(const FieldNames: string;
  CaseInsensitive: Boolean; Asc: array of boolean);
begin

end;

procedure TRxMemoryData.Sort;
var
  Pos: TBookmark;
begin
  if Active and (FRecords <> nil) and (FRecords.Count > 0) then
  begin
    Pos := GetBookmark;
    try
      QuickSort(0, FRecords.Count - 1, @CompareRecords);
      SetBufListSize(0);
      InitBufferPointers(False);
      try
        RecalcBufListSize;
//        SetBufListSize(BufferCount + 1);
      except
        SetState(dsInactive);
        CloseCursor;
        raise;
      end;
    finally
      GotoBookmark(Pos);
      FreeBookmark(Pos);
    end;
    Resync([]);
  end;
end;

procedure TRxMemoryData.QuickSort(L, R: Integer; Compare: TCompareRecords);
var
  I, J: Integer;
  P: TMemoryRecord;
begin
  repeat
    I := L;
    J := R;
    P := Records[(L + R) shr 1];
    repeat
      while Compare(Records[I], P) < 0 do Inc(I);
      while Compare(Records[J], P) > 0 do Dec(J);
      if I <= J then begin
        FRecords.Exchange(I, J);
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then QuickSort(L, J, Compare);
    L := I;
  until I >= R;
end;

function TRxMemoryData.CompareRecords(Item1, Item2: TMemoryRecord): Integer;
var
  Data1, Data2: PChar;
  F: TField;
  I: Integer;
begin
  Result := 0;
  if FIndexList <> nil then begin
    for I := 0 to FIndexList.Count - 1 do begin
      F := TField(FIndexList[I]);
      Data1 := FindFieldData(Item1.Data, F);
      if Data1 <> nil then begin
        Data2 := FindFieldData(Item2.Data, F);
        if Data2 <> nil then begin
          if Boolean(Data1[0]) and Boolean(Data2[0]) then begin
            Inc(Data1);
            Inc(Data2);
            Result := CompareFields(Data1, Data2, F.DataType,
              FCaseInsensitiveSort);
          end
          else if Boolean(Data1[0]) then Result := 1
          else if Boolean(Data2[0]) then Result := -1;
          if FDescendingSort then Result := -Result;
        end;
      end;
      if Result <> 0 then Exit;
    end;
  end;
  if (Result = 0) then begin
    if Item1.ID > Item2.ID then Result := 1
    else if Item1.ID < Item2.ID then Result := -1;
    if FDescendingSort then Result := -Result;
  end;
end;

function TRxMemoryData.GetIsIndexField(Field: TField): Boolean;
begin
  if FIndexList <> nil then
    Result := FIndexList.IndexOf(Field) >= 0
  else Result := False;
end;

procedure TRxMemoryData.CreateIndexList(const FieldNames: string);
var
  Pos: Integer;
  F: TField;
begin
  if FIndexList = nil then FIndexList := TList.Create
  else FIndexList.Clear;
  Pos := 1;
  while Pos <= Length(FieldNames) do begin
    F := FieldByName(ExtractFieldName(FieldNames, Pos));
    if (F.FieldKind = fkData) and
      (F.DataType in ftSupported - ftBlobTypes) then
      FIndexList.Add(F)
    else ErrorFmt(SFieldTypeMismatch, [F.DisplayName]);
  end;
end;

procedure TRxMemoryData.FreeIndexList;
begin
  FIndexList.Free;
  FIndexList := nil;
end;

function TRxMemoryData.IntAllocRecordBuffer: PChar;
begin
  // do nothing
end;

procedure TRxMemoryData.IntLoadFielddefsFromFile;
begin
  FDatasetReader.LoadFielddefs(FieldDefs);
  if DefaultFields then CreateFields;
end;

procedure TRxMemoryData.IntLoadRecordsFromFile;
var StoreState      : TDataSetState;
    AddRecordBuffer : boolean;
    ARowState       : TRowState;
    AUpdOrder       : integer;

begin
  FDatasetReader.InitLoadRecords;
  StoreState:=SetTempState(dsFilter);

  while FDatasetReader.GetCurrentRecord do
    begin
    ARowState := FDatasetReader.GetRecordRowState(AUpdOrder);

      FDatasetReader.RestoreRecord(self);
      inc(FBRecordCount);

      FDatasetReader.GotoNextRecord;
    end;

  RestoreState(StoreState);

  if assigned(FFileStream) then
    begin
    FreeAndNil(FFileStream);
    FreeAndNil(FDatasetReader);
    end;

end;

procedure TRxMemoryData.SetPacketRecords(const AValue: Integer);
begin
  if FPacketRecords=AValue then exit;
  FPacketRecords:=AValue;
end;

procedure TRxMemoryData.SetDatasetPacket(AReader: TRxDataPacketReader);
var
    StoreDSState   : TDataSetState;
    ARowState       : TRowState;
    AUpdOrder       : integer;
begin
  FDatasetReader := AReader;

  DisableControls;
    try
      Filtered := False;

      Close;       // must be inactive to do IntLoadFielddefsFromFile
      // load fields defs
      IntLoadFielddefsFromFile;

      FreeIndexList;

      if not Active then Open;
      Resync([]);                   // clears buffers if empty dataset
      CheckBrowseMode;

      FDatasetReader.InitLoadRecords;

      try
        while FDatasetReader.GetCurrentRecord do
        begin
          Append;

          ARowState := FDatasetReader.GetRecordRowState(AUpdOrder);       // added for binary export

          FDatasetReader.RestoreRecord(TRxMemoryData(Self));

          Post;

          FDatasetReader.GotoNextRecord;
          inc(FBRecordCount);

        end;
      finally
        First;
      end;

    finally
      EnableControls;
    end;

    if assigned(FFileStream) then
    begin
      FreeAndNil(FFileStream);
      FreeAndNil(FDatasetReader);
    end;

end;

procedure TRxMemoryData.GetDatasetPacket(AWriter: TRxDataPacketReader);
var
   StoreDSState   : TDataSetState;
begin

  CheckBrowseMode;
  UpdateCursorPos;

  FDatasetReader := AWriter;
  try
    DisableControls;
    try

      FDatasetReader.StoreFieldDefs(FieldDefs);

      First;
      while not EOF do
      begin
        // ** NOTE ** had to cast self to TRxMemoryData just save current values
        // otherwise the as string value in ex_rx_datapacket would not write.
        FDatasetReader.StoreRecord(TRxMemoryData(Self),[]);
        Next;
      end;

      FDatasetReader.FinalizeStoreRecords;
    finally
      EnableControls;
    end;
  finally
    FDatasetReader := nil;
  end;
end;

procedure TRxMemoryData.LoadFromStream(AStream: TStream;
  Format: TRxDataPacketFormat);
var APacketReaderReg : TRxDatapacketReaderRegistration;
    APacketReader : TRxDataPacketReader;
begin
  if GetRegisterDatapacketReader(AStream,format,APacketReaderReg) then
    APacketReader := APacketReaderReg.ReaderClass.create(AStream)
  else
    DatabaseError(SStreamNotRecognised);
  try
    SetDatasetPacket(APacketReader);
  finally
    APacketReader.Free;
  end;
end;

procedure TRxMemoryData.SaveToStream(AStream: TStream;
  Format: TRxDataPacketFormat);
var APacketReaderReg : TRxDatapacketReaderRegistration;
    APacketWriter : TRxDataPacketReader;
begin
  if GetRegisterDatapacketReader(Nil,format,APacketReaderReg) then
    APacketWriter := APacketReaderReg.ReaderClass.create(AStream)
  else
    DatabaseError(SNoReaderClassRegistered);
  try
    GetDatasetPacket(APacketWriter);
  finally
    APacketWriter.Free;
  end;
end;

procedure TRxMemoryData.LoadFromFile(AFileName: string;
  Format: TRxDataPacketFormat);
var AFileStream : TFileStream;
begin
  if AFileName='' then AFileName := FFileName;
  AFileStream := TFileStream.Create(AFileName,fmOpenRead);
  try
    LoadFromStream(AFileStream, Format);
  finally
    AFileStream.Free;
  end;
end;

procedure TRxMemoryData.SaveToFile(AFileName: string;
  Format: TRxDataPacketFormat);
var AFileStream : TFileStream;
begin
  if AFileName='' then AFileName := FFileName;
  AFileStream := TFileStream.Create(AFileName,fmCreate);
  try
    SaveToStream(AFileStream, Format);
  finally
    AFileStream.Free;
  end;
end;

{ TMemBlobStream }

constructor TMemBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
begin
  FMode := Mode;
  FField := Field;
  FDataSet := FField.DataSet as TRxMemoryData;
  if not FDataSet.GetActiveRecBuf(FBuffer) then Exit;
  if not FField.Modified and (Mode <> bmRead) then begin
    if FField.ReadOnly then ErrorFmt(SFieldReadOnly, [FField.DisplayName]);
    if not (FDataSet.State in [dsEdit, dsInsert]) then Error(SNotEditing);
    FCached := True;
  end
  else FCached := (FBuffer = FDataSet.ActiveBuffer);
  FOpened := True;
  if Mode = bmWrite then Truncate;
end;

destructor TMemBlobStream.Destroy;
begin
  if FOpened and FModified then FField.Modified := True;
  if FModified then
  try
    FDataSet.DataEvent(deFieldChange, ptrint(FField));
  except
    CustomApplication.HandleException(Self);
//    Application.HandleException(Self);
  end;
end;

function TMemBlobStream.GetBlobFromRecord(Field: TField): TMemBlobData;
var
  Rec: TMemoryRecord;
  Pos: Integer;
begin
  Result := '';
  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 begin
    Rec := FDataSet.Records[Pos];
    if Rec <> nil then 
      Result := PMemBlobArray(Rec.FBlobs)^[FField.Offset];
  end;
end;

function TMemBlobStream.Read(var Buffer; Count: Longint): Longint;
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 begin
        Move(PChar(FDataSet.GetBlobData(FField, FBuffer))[FPosition], Buffer,
          Result);
        Inc(FPosition, Result);
      end
      else begin
        Move(PChar(GetBlobFromRecord(FField))[FPosition], Buffer,
          Result);
        Inc(FPosition, Result);
      end;
    end;
  end;
end;

function TMemBlobStream.Write(const Buffer; Count: Longint): Longint;
var
  Temp: TMemBlobData;
begin
  Result := 0;
  if FOpened and FCached and (FMode <> bmRead) then begin
    Temp := FDataSet.GetBlobData(FField, FBuffer);
    if Length(Temp) < FPosition + Count then
      SetLength(Temp, FPosition + Count);
    Move(Buffer, PChar(Temp)[FPosition], Count);
    FDataSet.SetBlobData(FField, FBuffer, Temp);
    Inc(FPosition, Count);
    Result := Count;
    FModified := True;
  end;
end;

function TMemBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  case Origin of
    0: FPosition := Offset;
    1: Inc(FPosition, Offset);
    2: FPosition := GetBlobSize + Offset;
  end;
  Result := FPosition;
end;

procedure TMemBlobStream.Truncate;
begin
  if FOpened and FCached and (FMode <> bmRead) then begin
    FDataSet.SetBlobData(FField, FBuffer, '');
    FModified := True;
  end;
end;

function TMemBlobStream.GetBlobSize: Longint;
begin
  Result := 0;
  if FOpened then
    if FCached then
      Result := Length(FDataSet.GetBlobData(FField, FBuffer))
    else
      Result := Length(GetBlobFromRecord(FField))
end;

initialization
  RegisterPropertyToSkip(TRxMemoryData, 'OnFilterRecordEx', 'Old property', '');
end.
