
//////////////////////////////////////////////////
//  DB Access Components
//  Copyright © 1998-2014 Devart. All right reserved.
//  Core Access
//  Created:            01.07.00
//////////////////////////////////////////////////

{$IFNDEF CLR}

{$I Dac.inc}

unit CRAccess;
{$ENDIF}
interface

uses
  Classes, SysUtils,
{$IFDEF VER6P}
  Types,
  Variants,
{$IFNDEF FPC}
  FMTBcd,
  SqlTimSt,
{$ENDIF}
{$ENDIF}
{$IFDEF CLR}
  System.Runtime.InteropServices, Borland.Vcl.TypInfo, System.Text,
{$ELSE}
  CLRClasses,
{$ENDIF}
{$IFDEF UNIX}
  unix,
{$ENDIF}
{$IFNDEF LITE}
  CRVio, {$IFDEF MSWINDOWS}MTSCall,{$ENDIF}
{$ENDIF}
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
{$IFNDEF LITE}
  CRDataTypeMap, CREncryption,
{$ENDIF}
  CRTypes, CRParser, MemData, MemUtils;

const
// Props
  prUsername           = 1;  // char*
  prPassword           = 2;  // char*
  prServer             = 4;  // char*
  prConnectionTimeout  = 5;  // integer
  prAutoCommit         = 6;  // bool
  prSQL                = 10; // char*
  prScanParams         = 11; // bool
  prSQLType            = 12; // integer
  prRowsProcessed      = 13; // integer

  prUniDirectional     = 20; // bool
  prFetchRows          = 21; // integer
  prFetchAll           = 22; // bool
  prRowsFetched        = 23; // integer
  prExecuting          = 24; // bool
  prLongStrings        = 25; // bool
  prFlatBuffers        = 27; // bool
  prConvertEOL         = 28; // bool
  prIndexFieldNames    = 29; // char*
{$IFDEF HAVE_COMPRESS}
  prCompressBlobMode   = 30; // TCompressBlobMode
{$ENDIF}
  prDisconnectedMode   = 31; // bool
  prDisableParamScan   = 32; // bool
  prStoredProcIsQuery  = 33; // bool    TODO: Remove
  prQuoteNames         = 34; // bool

  prIsolationLevel     = 35; // TCRIsolationLevel
  prTransactionReadOnly= 37; // bool
  prDatabase           = 38; // string
  prPort               = 39; // integer
  prMaxStringSize      = 40; // integer
  prEnableBCD          = 41; // bool
{$IFDEF VER6P}
{$IFNDEF FPC}
  prEnableFmtBCD       = 42; // bool
{$ENDIF}
{$ENDIF}
  prCanReadParams      = 43; // boolean
  prReadOnly           = 44; // boolean
  prIsStoredProc       = 45; // boolean
  prIsSelectParams     = 46; // boolean   // for MySQL stored proc
  prLockFetchAll       = 47; // boolean;
  prDefaultSortType    = 48; // TSortType
  prLastInsertId       = 49; // int64
  prFieldsAsString     = 50; // boolean
  prExtendedFieldsInfo = 51; // boolean
  prDefaultValues      = 52; // boolean
  prFieldsOrigin       = 53; // boolean
  prUseDescribeParams  = 54; // boolean
  prRoAfterUpdate      = 55; // boolean
  prEncryptedFields    = 56; // string
  prHttpUrl            = 57; // string
  prHttpUsername       = 58; // string
  prHttpPassword       = 59; // string
  prProxyHostname      = 60; // string
  prProxyPort          = 61; // integer
  prProxyUsername      = 62; // string
  prProxyPassword      = 63; // string
  prIPVersion          = 64; // TCRIPVersion
  prFullRefresh        = 65; // boolean
  prSetFieldsReadOnly  = 66; // boolean
  prKeyFields          = 67; // string
  prUpdatingTable      = 68; // string
  prKeySequence        = 69; // string
  prPrefetchedFields   = 70; // string
  prLiveBlockOnSmartFetch = 71; // boolean
  prDisableFetchOnOpening = 72; // boolean
  prKeepRowCount       = 73; // integer

type
  TCRConnection   = class;
  TCRTransaction  = class;
  TCRCommand      = class;
  TCRRecordSet    = class;
  TParamDesc      = class;
  TParamDescs     = class;
  TCRTablesInfo   = class;
  TSQLInfo        = class;
  TCRCursor       = class;
{$IFNDEF LITE}
{$IFDEF MSWINDOWS}
  TMTSTransaction = class;
{$ENDIF}
{$ENDIF}
  TCRMetaData     = class;
  TCRLoaderColumn = class;
  TCRLoader       = class;
  TCRAlerter      = class;

  TCRConnectionClass = class of TCRConnection;
  TCRTransactionClass = class of TCRTransaction;
  TCRCommandClass = class of TCRCommand;
  TCRRecordSetClass = class of TCRRecordSet;
  TParamDescClass = class of TParamDesc;
  TTableInfoClass = class of TCRTableInfo;
  TSQLInfoClass = class of TSQLInfo;
  TCRMetaDataClass = class of TCRMetaData;
  TCRLoaderColumnClass = class of TCRLoaderColumn;
  TCRLoaderClass = class of TCRLoader;
  TCRAlerterClass = class of TCRAlerter;

  TCommandType = (ctUnknown, ctStatement, ctCursor);

  TCursorState = (
    csInactive, // default state (TCRRecordSet.InternalOpen, TCustomDASQL.SQLChanged)
    csOpen, // ODAC only: OCI73 TOCICommand.InternalOpen
    csParsed, // ODAC only: OCI73 - statement parsed
    csPrepared, // statement prepared
    csBound, // ODAC only: parameters bound
    csExecuteFetchAll, // ODAC only:
    csExecuting, // ODAC only(?): statement is executing (TCRCommand.Execute)
    csExecuted, // statement successfully executed
    csFetching, // setted on first TCRRecordSet.Fetch
    csFetchingAll, // ODAC, IbDAC specific. Setted on the FetchAll start
    csFetched // fetch finished or canceled
  );

  TErrorProc = procedure (E: Exception; var Fail, Reconnect: boolean; {$IFNDEF LITE}var Reexecute: boolean; {$ENDIF}
    ReconnectAttempt: integer{$IFNDEF LITE}; var ConnLostCause: TConnLostCause{$ENDIF}) of object;
  TReconnectProc = procedure of object;
  TBoolProc = procedure (Value: boolean) of object;
  TBeforeFetchProc = procedure (var Cancel: boolean) of object;
  TAfterFetchProc = procedure of object;
  TDataChangeProc = procedure of object;
  TReadParamsProc = procedure of object;
  TGetSQLProc = function: string of object;
  TGetDBKeyListProc = function (const TableName, IndexName: string): string of object;
  TFillExtFieldsInfoProc = procedure of object;

  EFailOver = class(Exception)
  public
    FConnLostCause: TConnLostCause;

    constructor Create(ConnLostCause: TConnLostCause);
  end;

{$IFNDEF LITE}
  // Smart fetch
  TSmartFetchState = (sfNone, sfMetaInfo, sfKeyOnly, sfDataByKey);

  ESmartFetchError = class(Exception);
{$ENDIF}

{ TCRConnection }

  TCRConnection = class
  private
    FOnError: TErrorProc;
    FOnReconnectError: TReconnectProc;
    FOnReconnectSuccess: TReconnectProc;
    FConnectionTime: Longword;
    FSQLinfo: TSQLInfo;
  {$IFNDEF LITE}
    FDataTypeMap: TCRMapRules;
  {$ENDIF}

    function GetSQLInfo: TSQLInfo;

  protected
    FInternalTransaction: TCRTransaction;
    FConnected: boolean;
    FNativeConnection: boolean;
    FUsername: string;
    FPassword: string;
    FServer: string;
    FAutoCommit: boolean;
    FConvertEOL: boolean;
    FIsValid: boolean;
    FPool: TObject;
    FPoolVersion: integer;
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FComponent: TObject;
    FDisconnectedMode: boolean;
    FEnableBCD: boolean;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    FEnableFMTBCD: boolean;
  {$ENDIF}
  {$ENDIF}

    FInProcessError: boolean;
    FReconnected: boolean;
    FDefaultSortType: TSortType;

  {$IFNDEF LITE}
    FIOHandler: TCRIOHandler;
    FHttpOptions: THttpOptions;
  {$ENDIF}

    function CreateSQLInfo: TSQLInfo; virtual;
  {$IFNDEF LITE}
    function CreateDataTypeMap: TCRMapRules; virtual;

  {$IFDEF MSWINDOWS}
    procedure Enlist(MTSTransaction: TMTSTransaction); virtual;
    procedure UnEnlist(MTSTransaction: TMTSTransaction); virtual;
  {$ENDIF}
  {$ENDIF}
    procedure DoError(E: Exception; var Fail: boolean); virtual;
    property AutoCommit: boolean read FAutoCommit write FAutoCommit;
    property EnableBCD: boolean read FEnableBCD write FEnableBCD;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    property EnableFMTBCD: boolean read FEnableFMTBCD write FEnableFMTBCD;
  {$ENDIF}
  {$ENDIF}

  public
    constructor Create; virtual;
    destructor Destroy; override;

    function GetCommandClass: TCRCommandClass; virtual; abstract;
    function GetTransactionClass: TCRTransactionClass; virtual; abstract;

    procedure Connect(const ConnectString: string); virtual;
    procedure Disconnect; virtual; abstract;
    procedure Assign(Source: TCRConnection); virtual;
    procedure AssignConnect(Source: TCRConnection); virtual; abstract;
    procedure Ping; virtual; abstract;

    function GetConnected: boolean;
    procedure SetConnected(Value: boolean);

    function GetInternalTransaction: TCRTransaction;
    procedure SetUsername(const Value: string); virtual;
    procedure SetPassword(const Value: string); virtual;
    procedure SetServer(const Value: string); virtual;
    function GetUsername: string;
    function GetPassword: string;
    function GetServer: string;

    function CheckIsValid: boolean; virtual; abstract;
  {$IFNDEF LITE}
    procedure ReturnToPool; virtual;
  {$ENDIF}

    function GetServerVersion: string; virtual; abstract;
    function GetServerVersionFull: string; virtual; abstract;
    function GetClientVersion: string; virtual; abstract;

    function CanChangeDatabase: boolean; virtual;

    function SetProp(Prop: integer; const Value: variant): boolean; virtual;
    function GetProp(Prop: integer; out Value: variant): boolean; virtual;

    property OnError: TErrorProc read FOnError write FOnError;
    property OnReconnectError: TReconnectProc read FOnReconnectError write FOnReconnectError;
    property OnReconnectSuccess: TReconnectProc read FOnReconnectSuccess write FOnReconnectSuccess;

    property ConnectionTime: Longword read FConnectionTime; 
    property IsValid: boolean read FIsValid write FIsValid;
    property Pool: TObject read FPool write FPool;
    property PoolVersion: integer read FPoolVersion write FPoolVersion;
    property Component: TObject read FComponent write FComponent; // Is needed for failover
    property DisconnectedMode: boolean read FDisconnectedMode write FDisconnectedMode;
    property NativeConnection: boolean read FNativeConnection;
  {$IFNDEF LITE}
    property IOHandler: TCRIOHandler read FIOHandler write FIOHandler;
    property DataTypeMap: TCRMapRules read FDataTypeMap;
  {$ENDIF}
    property SQLInfo: TSQLInfo read GetSQLInfo;
  end;

{ TCRCommand }

  TColumnInfo = class
  public
    Name: string;
    Table: string;
    TableIndex: Integer;
    Expr: string; // expression
    Alias: string;
    Used: boolean; // is ColumnInfo used by another Field
    Described: boolean;
    Required: boolean;
  end;

  TColumnsInfo = class(TDAObjectList)
  private
    function GetItem(Index: integer): TColumnInfo;
  public
    property Items[Index: Integer]: TColumnInfo read GetItem; default;
  end;

  TCRCommand = class
  private
    FSQLInfo: TSQLInfo;
    function GetSQLInfo: TSQLInfo;
    
  protected
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FComponent: TObject;
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FConnection: TCRConnection;
    FCommandType: TCommandType;
    FSQL: string;
    FUserSQL: string;
    FParams: TParamDescs;
    FAutoCommit: boolean;
    FAfterExecute: TBoolProc;
    FExecuting: boolean;
    FScanParams: boolean;
    FDisableParamScan: boolean;
    FQuoteNames: boolean;
  {$IFDEF HAVE_COMPRESS}
    FCompressBlob: TCompressBlobMode;
  {$ENDIF}
    FEnableBCD: boolean;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    FEnableFMTBCD: boolean;
  {$ENDIF}
  {$ENDIF}
    FReadParams: TReadParamsProc;

    function CreateSQLInfo: TSQLInfo; virtual;
    procedure ParseSQLParam(ParsedSQL: StringBuilder; Parser: TSQLParser; Params: TParamDescs; LeftQuote, RightQuote: Char; const RenamePrefix: string); virtual;

    property Executing: boolean read FExecuting write FExecuting;
    property EnableBCD: boolean read FEnableBCD write FEnableBCD;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    property EnableFMTBCD: boolean read FEnableFMTBCD write FEnableFMTBCD;
  {$ENDIF}
  {$ENDIF}

  public
    constructor Create; virtual;
    destructor Destroy; override;

    class function GetTableInfoClass: TTableInfoClass; virtual;
    class function GetSQLInfoClass: TSQLInfoClass; virtual;
    class function GetParserClass: TSQLParserClass; virtual;
  {$IFNDEF LITE}
    class function GetMapRulesClass: TCRMapRulesClass; virtual;
  {$ENDIF}

    procedure Prepare; virtual;
    procedure Unprepare; virtual;
    function GetPrepared: boolean; virtual; abstract;

    procedure Execute(Iters: integer = 1); virtual; {$IFNDEF AUTOTEST}abstract;{$ENDIF}
    procedure Close; virtual; //TODO abstract;

    procedure SetConnection(Value: TCRConnection); virtual;
    function GetConnection: TCRConnection;
    procedure SetTransaction(Value: TCRTransaction); virtual;
    function GetTransaction: TCRTransaction; virtual;
    function GetCursorState: TCursorState; virtual; abstract;
    procedure SetCursorState(Value: TCursorState); virtual; abstract;

    procedure SetSQL(const Value: string); virtual;
    function ParseSQL(const SQL: string; Params: TParamDescs; ReplaceAll: boolean = True; const RenamePrefix: string = ''): string; overload; virtual;
    procedure ParseSQL(ReplaceAll: boolean = True); overload;
    function CreateProcCall(const Name: string; NeedDescribe: boolean; IsQuery: boolean): string; virtual; abstract;
    function ForceCreateSPParams: boolean; virtual;

  { Params }
    function GetParamDescType: TParamDescClass; virtual;
    procedure ClearParams;
    function AddParam: TParamDesc; virtual;
    procedure DeleteParam(Index: integer);
    function GetParamCount: integer;
    function GetParam(Index: integer): TParamDesc;
    function FindParam(Name: string): TParamDesc;

    function GetCursor: TCRCursor; virtual;
    procedure SetCursor(Value: TCRCursor); virtual;

    function SetProp(Prop: integer; const Value: variant): boolean; virtual;
    function GetProp(Prop: integer; out Value: variant): boolean; virtual;

    procedure BreakExec; virtual;

    property CommandType: TCommandType read FCommandType write FCommandType;
    property SQL: string read FSQL write SetSQL;
    property Component: TObject read FComponent write FComponent; // Is needed for failover
    property AfterExecute: TBoolProc read FAfterExecute write FAfterExecute;
    property ReadParams: TReadParamsProc read FReadParams write FReadParams; // for SDAC
    property Params: TParamDescs read FParams write FParams;
    property SQLInfo: TSQLInfo read GetSQLInfo;
  end;

{ $IFNDEF LITE}

{ TCRTableInfo }

  TCRTableInfo = class(TObject)
  protected
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FOwner: TCRTablesInfo;
    FIndex: Integer;
    FTableName: string;
    FTableAlias: string;
    FIsView: boolean;
    procedure SetTableName(const Value: string);
    procedure SetTableAlias(const Value: string);
    function GetTableNameFull: string; virtual;
    procedure SetTableNameFull(const Value: string); virtual;
  public
    constructor Create(Owner: TCRTablesInfo); virtual;

    property TableName: string read FTableName write SetTableName;
    property TableAlias: string read FTableAlias write SetTableAlias;
    property TableNameFull: string read GetTableNameFull write SetTableNameFull;
    property IsView: boolean read FIsView write FIsView;
    property Index: Integer read FIndex write FIndex;
  end;

  TCRTablesInfo = class
  private
    function GetItem(Index: Integer): TCRTableInfo;
    procedure SetItem(Index: Integer; const Value: TCRTableInfo);
  protected
    FCaseSensitive: boolean;
    FList: array of TCRTableInfo;
    FUpdateCount: Integer;
    FTableInfoClass: TTableInfoClass;
    FTableNameList: TStringList;
    FTableAliasList: TStringList;
    procedure InternalAdd(TableInfo: TCRTableInfo);
    procedure Changed;
    procedure TableNameChanged;
    procedure TableAliasChanged;
    function GetCount: Integer;
    procedure SetCaseSensitive(Value: boolean);
  public
    constructor Create(TableInfoClass: TTableInfoClass);
    destructor Destroy; override;
    function Add: TCRTableInfo;
    procedure Clear;
    procedure BeginUpdate; virtual;
    procedure EndUpdate; virtual;
    function FindByName(const TableName: string): TCRTableInfo;
    function IndexOf(TableInfo: TCRTableInfo): Integer;
    function IndexByName(const TableName: string): Integer;
    function IndexByAlias(const TableAlias: string): Integer;
    function FindByNameAndAlias(const TableName, TableAlias: string): TCRTableInfo;
    property Items[Index: Integer]: TCRTableInfo read GetItem write SetItem; default;
    property Count: Integer read GetCount;
    property TableInfoClass: TTableInfoClass read FTableInfoClass;
    property CaseSensitive: boolean read FCaseSensitive write SetCaseSensitive;
  end;
{ $ENDIF}

  TIdentCase = (icUpper, icLower, icMixed, icMixedCaseSensitive);

  TSQLObjectInfo = record
    Name: string;
    Schema: string;
    Catalog: string;
    DBLink: string;
    Synonym: string;
    Flag: byte;
  end;

  TSQLObjectsInfo = array of TSQLObjectInfo;

{ TSQLInfo }

  TSQLInfo = class
  private
    FParserClass: TSQLParserClass;
  protected
    procedure ParseExtColumnName(Parser: TSQLParser; var Code: integer; var Str: string); virtual;
    function FirstCharQuotesNeed(Ch: Char; IdCase: TIdentCase): boolean; virtual;
    function NextCharQuotesNeed(Ch: Char; IdCase: TIdentCase): boolean; virtual;
    function HasAsLexem: boolean; virtual;
    function HasOnlyLexem: boolean; virtual;
    procedure ParseExtTableInfo(Parser: TSQLParser; var CodeLexem: integer; var StLex: string; var Name: string); virtual;
  public
    constructor Create(ParserClass: TSQLParserClass); virtual;

    function LeftQuote: Char; virtual;
    function RightQuote: Char; virtual;
    function IdentCase: TIdentCase; virtual;
    function ParamQuoteAllowed: boolean; virtual;
    function ProcedureOverloadSeparator: Char; virtual;

    function Quote(const Value: string): string; overload;
    function Quote(const Value: string; const LeftQ: Char; const RightQ: Char): string; overload; virtual;
    function UnQuote(const Value: string): string; virtual;
    function IsQuoted(const Value: string): boolean; virtual;
    function QuotesNeeded(const Value: string): boolean; virtual;
    function QuoteIfNeed(const Value: string): string;
    function NormalizeName(const Value: string; QuoteNames: boolean = False; UnQuoteNames: boolean = False): string; overload; virtual;
    function NormalizeName(const Value: string; const LeftQ: Char; const RightQ: Char; QuoteNames: boolean = False; UnQuoteNames: boolean = False): string; overload; virtual;
    function ToStringConst(const Value: string): string;

    procedure SplitObjectName(const Name: string; var Info: TSQLObjectInfo); virtual;
    procedure ParseTablesInfo(const SQL: string; TablesInfo: TCRTablesInfo); virtual;
    procedure ParseColumnsInfo(const SQL: string; ColumnsInfo: TColumnsInfo); virtual;

    function NamesFromList(List: TStrings): string; virtual;
    procedure NamesToList(Value: string; List: TStrings); virtual;
  end;

{ TCRFieldDesc}

  TCRFieldDesc = class (TFieldDesc)
  private
    // Data Type Mapping
    FDBLength: Integer;
    FDBScale: Integer;
  {$IFNDEF LITE}
    FIsPrefetched: boolean;

    FDBType: Word;
    FMapRule: TCRMapRule;
    FMapLength: Integer;
    FMapScale: Integer;
    FOnDemandConverter: TOnDemandConverter;
    FEncryptor: TEncryptionMethod;
    FDecryptor: TDecryptionMethod;
    FEncryptState: Integer;
  {$ENDIF}

  {$IFDEF ODBC_DRIVER}
    FDataPtr: IntPtr;
    FIndicatorPtr: IntPtr;
    FLengthPtr: IntPtr;
  {$ENDIF}
  protected
    FIsNational: boolean;
    FTableInfo: TCRTableInfo;
    FActualNameQuoted: array[boolean] of string; // cache for [QuoteNames]
    FDefaultExpr: string;

  {$IFNDEF LITE}
    function GetMappedDataType: Word; override;
  {$ENDIF}
  public
    constructor Create(RecordSetClass: TRecordSetClass); override;

    procedure Assign(FieldDesc: TFieldDesc); override;
    function ActualNameQuoted(SQLInfo: TSQLInfo; QuoteNames: boolean): string; virtual;

    property IsNational: boolean read FIsNational;

    property TableInfo: TCRTableInfo read FTableInfo write FTableInfo;
    property DefaultExpr: string read FDefaultExpr write FDefaultExpr;

    property DBLength: Integer read FDBLength write FDBLength;
    property DBScale: Integer read FDBScale write FDBScale;
  {$IFNDEF LITE}
    property IsPrefetched: boolean read FIsPrefetched write FIsPrefetched;

    property DBType: Word read FDBType write FDBType;
    property MapRule: TCRMapRule read FMapRule write FMapRule;
    property MapLength: Integer read FMapLength write FMapLength;
    property MapScale: Integer read FMapScale write FMapScale;
    property OnDemandConverter: TOnDemandConverter read FOnDemandConverter write FOnDemandConverter;

    property Encryptor: TEncryptionMethod read FEncryptor write FEncryptor;
    property Decryptor: TDecryptionMethod read FDecryptor write FDecryptor;
    property EncryptState: Integer read FEncryptState write FEncryptState;
  {$ENDIF}
  {$IFDEF ODBC_DRIVER}
    property DataPtr: IntPtr read FDataPtr write FDataPtr;
    property IndicatorPtr: IntPtr read FIndicatorPtr write FIndicatorPtr;
    property LengthPtr: IntPtr read FLengthPtr write FLengthPtr;
  {$ENDIF}
  end;

  TFieldDescArray = array of TCRFieldDesc;
  TKeyAndDataFields = record
    KeyFieldDescs: TFieldDescArray;
    DataFieldDescs: TFieldDescArray;
  end;

{ TCRRecordSet }

  TCRRecordSet = class (TMemData)
  protected
    FCommand: TCRCommand;
    FTmpFields: TFieldDescs;
    FUniDirectional: boolean;
    FFetchRows: integer;
    FOriginalFetchRows: integer;
    FFetchAll: boolean;
    FOriginalFetchAll: boolean;
    FLockFetchAll: boolean;

    FNoData: boolean;
    FLongStrings: boolean;
    FFlatBuffers: boolean;
    FExtendedFieldsInfo: boolean;
    FDefaultValues: boolean;
    FFieldsOrigin: boolean;
    FReadOnly: boolean;
    FFullRefresh: boolean;
    FSetFieldsReadOnly: boolean;
    FKeyFields: string;
    FUpdatingTable: string;
    FFetchBuffer: IntPtr;
    FFetchBufferSize: integer;

    FAfterExecFetch: TBoolProc;
    FAfterFetchAll: TBoolProc;
    FOnBeforeFetch: TBeforeFetchProc;
    FOnAfterFetch: TAfterFetchProc;
    FOnDataChanged: TDataChangeProc;
    FWaitForFetchBreak: boolean;
    FFetchToOuterBuffer: boolean;
    FDisableFetchOnOpening: boolean;

  {$IFNDEF LITE}
    FEncryptStateOffset: Integer;
    FFetchStateOffset: Integer;
    FItemPtrOffset: Integer;

    FDataTypeMap: TCRMapRules;
    FEncryptor: TCREncryptor;
    FEncryptedFields: string;

    FBaseSQL: string;
    FSmartFetchState: TSmartFetchState;
    FGetKeyValuesSQL: TGetSQLProc;
    FGetDataValuesSQL: TGetSQLProc;
    FPrefetchedFields: string;
    FLiveBlockOnSmartFetch: boolean;
    FDataFieldsWasSynchronized: boolean;
    FFetchedBlocks: TList;
  {$ENDIF}

    FTablesInfo: TCRTablesInfo;
    FUpdTableIsArtificial: boolean;
    FUpdatingTableInfoIdx: integer;
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FIdentityField: TCRFieldDesc;
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FKeyGeneratorField: TCRFieldDesc;
    FGetDBKeyList: TGetDBKeyListProc;
    FFillExtFieldsInfo: TFillExtFieldsInfoProc;

    FCachedKeyFieldDescs: array[Boolean] of TFieldDescArray;
    FKeyFieldDescsIsCached: array[Boolean] of Boolean;
    FCachedDataFieldDescs: array[Boolean] of TFieldDescArray;
    FDataFieldDescsIsCached: array[Boolean] of Boolean;

    procedure CreateCommand; virtual; abstract;
    procedure FreeCommand;
    procedure SetCommand(Value: TCRCommand); virtual;
  {$IFNDEF LITE}
    procedure InitRecordSize; override;

  { Data Type Map }
    function CreateDataTypeMap: TCRMapRules;

  { Encryption }
    procedure InitEncryption;
    procedure DecryptBuffer(Item: PItemHeader);
    function FieldIsEncrypted(const FieldName: string): boolean;
    function GetDataTypeName(Field: TCRFieldDesc): string;
    function GetEncryptStateSize: Integer;
  {$ENDIF}

    function NeedConvertEOL: boolean; override;

  { Fields}
    procedure ClearCachedKeyFieldDescs;
    function CanUseAllKeyFields: boolean; virtual;
    function IdentityFieldIsData: boolean; virtual;
    procedure FillFieldDescs(out FieldDescs: TFieldDescArray;
      const FieldNames: string; CheckFields: boolean);
    procedure FillKeyFieldDescs(out KeyFieldDescs: TFieldDescArray;
      ForceUseAllKeyFields: boolean); virtual;
    procedure FillDataFieldDescs(out DataFieldDescs: TFieldDescArray;
      ForceUseAllKeyFields: boolean); virtual;

  { Open/Close }
    function NeedInitFieldsOnPrepare: boolean; virtual;
    procedure InternalPrepare; override;
    procedure InternalUnPrepare; override;
    procedure InternalOpen(DisableInitFields: boolean = False); override;
    procedure InternalClose; override;

  { Fetch }
    procedure AllocFetchBuffer; virtual;
    procedure FreeFetchBuffer; virtual;
    procedure FetchBlock(Block: PBlockHeader; FetchBack: boolean; out RowsObtained: Integer); virtual;
    procedure ProcessFetchedBlock(Block: PBlockHeader; FetchBack: boolean); virtual;
    procedure ProcessNoResult(FetchBack: boolean); virtual;
    function ProcessFetchedException(E: Exception): boolean; virtual;
    function FetchingAccessible(FetchBack: boolean): boolean; virtual;
    function InternalFetch(FetchBack: boolean = False): boolean; virtual;

    procedure InitBlock(Block: PBlockHeader); virtual;
    procedure ClearBlock(Block: PBlockHeader);
    procedure CreateBlockStruct(Block: PBlockHeader; RowsObtained: Integer; FetchBack: boolean = False{$IFNDEF LITE}; StandAloneBlock: Boolean = False{$ENDIF});
    function CanFetchBack: boolean; virtual; // Return True, if BlockMan is store only one block of records
    procedure InitFetchedBlock(Block: PBlockHeader; RowsObtained: Integer; FetchBack: boolean); virtual;
    procedure DoBeforeFetch(out Cancel: boolean); virtual;
    procedure DoAfterFetch; virtual;

    function NeedInitFieldsOnFetch: boolean; virtual;
    function NeedUnPrepareAfterFetch: boolean; virtual;

  {$IFNDEF LITE}
  { Smart Fetch }
    function GetFetchStateSize: Integer;
    function GetItemPtrSize: Integer;
    procedure CheckFetched(RecBuf: IntPtr; Field: TFieldDesc); override;

    procedure SyncKeyFields(KeyFields, OriginFields: TFieldDescs);
    procedure SyncDataFields(DataFields, OriginFields: TFieldDescs);
    function GetSmartFetchSQL(SmartFetchState: TSmartFetchState): string;
    function GetSmartFetchMetaInfoSQL(const BaseSQL: string): string; virtual;

    procedure FetchDataByKey(Block: PBlockHeader);
    function GetFieldValuesForSmartFetch(Field: TFieldDesc): Variant;
    procedure SyncWithCurrentBlock(NewBlock: PBlockHeader);
    function GetFetched(RecBuf: IntPtr): boolean;
    procedure SetFetched(RecBuf: IntPtr; Value: boolean);
    function GetItemFromRefBuf(RecBuf: IntPtr): PItemHeader;
    procedure WriteItemPtrIntoRecBuf(RecBuf: IntPtr; Item: PItemHeader);
  {$ENDIF}

  { Items/Data }
   // procedure PrepareData; override;

  { TablesInfo }
    function GetTableInfoClass: TTableInfoClass;
    function GetUpdatingTableInfo: TCRTableInfo;

  { Sorting }
    procedure SetSortDefaults(SortColumn: TSortColumn); override;

    function GetComponent: TObject;
    procedure SetComponent(Value: TObject);
  public
    constructor Create; virtual;
    destructor Destroy; override;

  { Fields}
    function GetFieldDescType: TFieldDescClass; override;
    procedure CheckFieldDescs;
  {$IFNDEF LITE}
    procedure InitFields; override;
    function IsEqualDataTypes(Field: TFieldDesc; MapRule: TCRMapRule): boolean; overload;
  {$IFDEF ODBC_DRIVER}
    function IsEqualDataTypes(Param: TParamDesc; MapRule: TCRMapRule): boolean; overload;
  {$ENDIF}
  {$ENDIF}

  { Open/Close }
    procedure Prepare; override;
    procedure UnPrepare; override;
    procedure Disconnect; virtual;

    procedure ExecCommand; virtual; // Execute command
    procedure CloseCommand; // Close command

  { Fields }
  {$IFNDEF LITE}
    procedure SetNull(Field: TFieldDesc; RecBuf: IntPtr; Value: boolean); override;
    function GetNull(Field: TFieldDesc; RecBuf: IntPtr): boolean; override;
  {$ENDIF}
    function GetMappedFieldBuf(RecBuf: IntPtr; FieldDesc: TFieldDesc; out DataType: Word; out FieldLength: Integer; out HasParent: boolean; out IsFixed: boolean; out IsBlank, NativeBuffer: boolean): IntPtr; override;
    procedure GetFieldData(Field: TFieldDesc; FieldBuf: IntPtr; Dest: IntPtr; NeedConvert: boolean); override;
    procedure PutFieldData(Field: TFieldDesc; FieldBuf: IntPtr; Source: IntPtr; NeedConvert: boolean; IsDatabaseValue: boolean = False); override;
  {$IFNDEF FPC}{$IFNDEF VER10P}{$IFNDEF CLR}{$IFNDEF LITE}
    function GetSourcePtr(Field: TFieldDesc; Source: IntPtr): IntPtr; override;
  {$ENDIF}{$ENDIF}{$ENDIF}{$ENDIF}

    procedure InitUpdatingTableIdx;
    procedure ClearCachedFieldDescs;
    procedure GetKeyFieldDescs(out KeyFieldDescs: TFieldDescArray; ForceUseAllFields: boolean = False);
    procedure GetDataFieldDescs(out DataFieldDescs: TFieldDescArray; ForceUseAllFields: boolean = False);
    procedure GetKeyAndDataFields(out KeyAndDataFields: TKeyAndDataFields; ForceUseAllFields: boolean);
    procedure DetectIdentityField; virtual;
    procedure DetectKeyGeneratorField; virtual;
    procedure ClearKeyGeneratorField;
    procedure SetFieldsReadOnly;
    procedure SetIdentityField(Value: TCRFieldDesc);

  { Records }
    procedure InitRecord(RecBuf: IntPtr); override;
    procedure PutRecord(RecBuf: IntPtr); override;
    procedure GetNextRecord(RecBuf: IntPtr); override;
    procedure GetPriorRecord(RecBuf: IntPtr); override;

  { Fetch }
    function Fetch(FetchBack: boolean = False): boolean; override;
    procedure ExecFetch(DisableInitFields: boolean); virtual;
    procedure FetchAll; virtual;
    procedure BreakFetch; virtual;// Breaks fetch. Can be called from other thread or in non-blocking mode 
    function CanDisconnect: boolean; virtual;
    property FetchToOuterBuffer: boolean read FFetchToOuterBuffer write FFetchToOuterBuffer;

    function RowsReturn: boolean; virtual;

    function GetCommand: TCRCommand;
    procedure SetConnection(Value: TCRConnection); virtual;
    procedure SetTransaction(Value: TCRTransaction); virtual;
    procedure SetSQL(const Value: string); virtual;

    function SetProp(Prop: integer; const Value: variant): boolean; virtual;
    function GetProp(Prop: integer; out Value: variant): boolean; virtual;

  { Filter }
    function IsCaseSensitive: boolean; virtual;
    procedure FilterUpdated; override;

  {$IFNDEF LITE}
  { Data Type Map }
    function GetMapRule(Field: TCRFieldDesc): TCRMapRule; overload;
    function GetMapRule(const FieldName: string; DBType: Word; DBLength, DBScale: Integer): TCRMapRule; overload; virtual;
    function GetMapFetchConverter(DBType: Word; DBLength, DBScale: Integer): TFetchConverter; overload;
    function GetMapFetchConverter(const FieldName: string; DBType: Word; DBLength, DBScale: Integer): TFetchConverter; overload;
    function GetMapOnDemandConverter(Field: TCRFieldDesc; out MapRule: TCRMapRule): TOnDemandConverter; overload;
    function GetMapOnDemandConverter(DataType: Word; DBType: Word; DBLength, DBScale: Integer; out MapRule: TCRMapRule): TOnDemandConverter; overload;
    function GetMapOnDemandConverter(const FieldName: string; DataType: Word; DBType: Word; DBLength, DBScale: Integer; out MapRule: TCRMapRule): TOnDemandConverter; overload; virtual;

  { Encryption }
    function GetEncrypted(Field: TFieldDesc; RecBuf: IntPtr): boolean;
    procedure SetEncrypted(Field: TFieldDesc; RecBuf: IntPtr; Value: boolean);
    function IsEncryptableDataType(DataType: Word): boolean; virtual;
    function GetDecryptDataType(DataType: Word): Word; virtual;

  { Smart fetch }
    procedure AddRef(RecBuf: IntPtr); override;
    procedure ReleaseRef(RecBuf: IntPtr); override;

    property DataTypeMap: TCRMapRules read FDataTypeMap;
    property Encryptor: TCREncryptor read FEncryptor write FEncryptor;
    property SmartFetchState: TSmartFetchState read FSmartFetchState write FSmartFetchState;
    property GetKeyValuesSQL: TGetSQLProc read FGetKeyValuesSQL write FGetKeyValuesSQL;
    property GetDataValuesSQL: TGetSQLProc read FGetDataValuesSQL write FGetDataValuesSQL;
  {$ENDIF}

    property AfterExecFetch: TBoolProc read FAfterExecFetch write FAfterExecFetch;
    property AfterFetchAll: TBoolProc read FAfterFetchAll write FAfterFetchAll;
    property OnBeforeFetch: TBeforeFetchProc read FOnBeforeFetch write FOnBeforeFetch;
    property OnAfterFetch: TAfterFetchProc read FOnAfterFetch write FOnAfterFetch;
    property OnDataChanged: TDataChangeProc read FOnDataChanged write FOnDataChanged;

  { Sorting }
    procedure SortItems; override;

  { TablesInfo }
    property TablesInfo: TCRTablesInfo read FTablesInfo;
    property IdentityField: TCRFieldDesc read FIdentityField;
    property KeyGeneratorField: TCRFieldDesc read FKeyGeneratorField;
    property UpdatingTableInfoIdx: integer read FUpdatingTableInfoIdx;
    property UpdatingTableInfo: TCRTableInfo read GetUpdatingTableInfo;
    property UpdTableIsArtificial: boolean read FUpdTableIsArtificial;
    property GetDBKeyList: TGetDBKeyListProc read FGetDBKeyList write FGetDBKeyList;
    property FillExtFieldsInfo: TFillExtFieldsInfoProc read FFillExtFieldsInfo write FFillExtFieldsInfo;

    property Component: TObject read GetComponent write SetComponent;
  end;

{ TParamDesc }

  TParamDirection = (pdUnknown, pdInput, pdOutput, pdInputOutput, pdResult);

  TParamDesc = class
  private
  protected
    FName: string;
    FDataType: word;
    FSubDataType: word;
    FParamType: TParamDirection;

    FSize: integer;
    FData: variant; // pointer;
    FIsNull: boolean;
    FIsBound: boolean;
    FConvertEOL: boolean;
    FNational: boolean;

  {$IFNDEF LITE}
    FEncryptor: TEncryptionMethod;
    FEncryptedBlob: TBlob;
  {$ENDIF}

  {$IFDEF ODBC_DRIVER}
    FMapRule: TCRMapRule;
    FOnDemandConverter: TOnDemandConverter;
  {$ENDIF}

    property Name: string read FName write FName;
    property DataType: word read FDataType write FDataType;
    property SubDataType: word read FSubDataType write FSubDataType;
    property ParamType: TParamDirection read FParamType write FParamType;
    property Size: integer read FSize write FSize;

  {$IFNDEF LITE}
    function EncryptValue(DataType: Word; const Value: Variant): Variant;
    function EncryptObject(DataType: Word; const Value: TSharedObject): TSharedObject;
  {$ENDIF}

  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure Clear; virtual;

    function GetName: string;
    procedure SetName(Value: string);

    function GetDataType: word;
    procedure SetDataType(Value: word); virtual;

    function GetSubDataType: word;
    procedure SetSubDataType(Value: word); virtual;

    function GetParamType: TParamDirection;
    procedure SetParamType(Value: TParamDirection); virtual;

    function GetSize: integer;
    procedure SetSize(Value: integer); virtual;

    function GetValue: variant; virtual;
    procedure SetValue(const Value: variant); virtual;

    function GetObject: TSharedObject; virtual;
    procedure SetObject(Value: TSharedObject); virtual;

    function GetNull: boolean; virtual;
    procedure SetNull(const Value: boolean); virtual;

    function GetIsBound: boolean;
    procedure SetIsBound(Value: boolean); virtual;

    function GetNational: boolean; virtual;
    procedure SetNational(Value: boolean); virtual;

    procedure SetConvertEOL(const Value: boolean);
  {$IFNDEF LITE}
    procedure SetEncryptor(const Value: TEncryptionMethod);
  {$ENDIF}

  {$IFDEF ODBC_DRIVER}
    property MapRule: TCRMapRule read FMapRule write FMapRule;
    property OnDemandConverter: TOnDemandConverter read FOnDemandConverter write FOnDemandConverter;
  {$ENDIF}

    property Value: variant read FData write SetValue;
  end;

{ TParamDescs }

  TParamDescs = class (TDAObjectList)
  private
    function GetItems(Index: integer): TParamDesc;

  public
    function FindParam(Name: string): TParamDesc;
    function ParamByName(Name: string): TParamDesc;

    property Items[Index: integer]: TParamDesc read GetItems; default;
  end;

{ TCRConnections }

  TCRConnections = class(TDAList)
  private
    function GetItems(Index: integer): TCRConnection;
  public
    property Items[Index: integer]: TCRConnection read GetItems; default;
  end;

{ TCRTransaction }

  TCRErrorProc = procedure (E: Exception; var Fail: boolean) of object;

  TCRIsolationLevel = (ilReadCommitted, ilReadUnCommitted, ilRepeatableRead, ilIsolated, ilSnapshot, ilCustom);
  TCRTransactionAction = (taCommit, taRollback);

  TCRTransaction = class
  protected
    FActive: boolean;
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FComponent: TObject;
    FOnError: TCRErrorProc;
    FConnections: TCRConnections;
    FIsolationLevel: TCRIsolationLevel;
    FReadOnly: boolean;
    FNativeTransaction: boolean;

  public
    constructor Create; virtual;
    destructor Destroy; override;
    
    procedure CheckInactive;
    procedure CheckActive;

    function AddConnection(Connection: TCRConnection): boolean; virtual;
    function RemoveConnection(Connection: TCRConnection): boolean; virtual;

    function SetProp(Prop: integer; const Value: variant): boolean; virtual;
    function GetProp(Prop: integer; var Value: variant): boolean; virtual;

    // return transaction state w/o server query
    function GetInTransaction: boolean; virtual;
    // In ODAC executes query to detect actual transaction state.
    // If CanActivate = True, transaction start and transaction end on server side can be detected.
    // If CanActivate = False, only transaction end can be detected.
    function DetectInTransaction(CanActivate: boolean): boolean; virtual;
    procedure AssignConnect(Source: TCRTransaction); virtual;

    procedure StartTransaction; virtual;
    procedure Commit; virtual;
    procedure Rollback; virtual;

    procedure CommitRetaining; virtual;
    procedure RollbackRetaining; virtual;
    procedure Savepoint(const Name: string); virtual;
    procedure ReleaseSavepoint(const Name: string); virtual;
    procedure RollbackToSavepoint(const Name: string); virtual;

    procedure Reset; virtual;
    function CanRestoreAfterFailover: boolean; virtual;

    property Component: TObject read FComponent write FComponent; // Is needed for failover    
    property OnError: TCRErrorProc read FOnError write FOnError;
  end;

{$IFDEF MSWINDOWS}
{$IFNDEF LITE}
  TMTSTransaction = class(TCRTransaction)
  private
    FMTSGC: ICRTransactionDispenserSC;
    FMTSTrans: ICRTransactionSC;

  protected
    procedure StartMTSTransaction; virtual;
    procedure CompleteMTSTransaction(Commit: boolean); virtual;

    procedure EnlistLink(Connection: TCRConnection); virtual;
    procedure UnEnlistLink(Connection: TCRConnection); virtual;
  public
    destructor Destroy; override;

    function AddConnection(Connection: TCRConnection): boolean; override;
    function RemoveConnection(Connection: TCRConnection): boolean; override;

    procedure StartTransaction; override;
    procedure Commit; override;
    procedure Rollback; override;

    procedure Savepoint(const Name: string); override;
    procedure ReleaseSavepoint(const Name: string); override;
    procedure RollbackToSavepoint(const Name: string); override;

    property MTSTransaction: ICRTransactionSC read FMTSTrans;
  end;
{$ENDIF}
{$ENDIF}

{ TCRMetaData }

{$IFDEF LITE}
  {$DEFINE DBX_METADATA}
{$ENDIF}

  TDataHelper = class
  private
    FData: TData;
    FRecBuf: IntPtr;

    procedure FreeBuffer;
    function GetFieldValue(Index: integer): variant;
    procedure SetFieldValue(Index: integer; const Value: variant);

  public
    constructor Create(Data: TData);
    destructor Destroy; override;

    procedure AllocBuffer;
    procedure InitRecord;
    procedure AppendRecord;
    function NextRecord: boolean;

    property FieldValues[Index: integer]: variant read GetFieldValue write SetFieldValue;
  end;

  TBooleanArray = array of boolean;

  TCRMetaData = class
  protected
    FMemData: TMemData;
    FMemDataHelper: TDataHelper;
    FRecordSet: TCRRecordSet;
    FRecordSetHelper: TDataHelper;
    FOperator: string;

    function CreateRecordSet: TCRRecordSet; virtual; abstract;
    procedure AddField(const AName: string; AType: integer; ALength: integer = -1);
    procedure CopyRecord(const SourceIndices, DestIndices: array of integer);
    function ParseTypes(const ObjectTypes: string; AllTypes: array of string): TBooleanArray; overload;
    procedure ParseTypes(const ObjectTypes: string; {out}TypesList: TStringList); overload;
    procedure AddWhere(var WhereClause: string; const Name, Value: string; AddEmpty: boolean = False);

    function InternalGetMetaData(const MetaDataKind: string; Restrictions: TStrings): TData; overload; virtual;

    procedure CreateMetaDataKindsFields; virtual;
    procedure InternalGetMetaDataKindsList(List: TStringList); overload; virtual;
    function GetMetaDataKinds: TData; virtual;
    procedure CreateRestrictionsFields; virtual;
    procedure InternalGetRestrictionsList(List: TStringList; const MetaDataKind: string); overload; virtual;
    function GetRestrictions(Restrictions: TStrings): TData; virtual;
    procedure CreateTablesFields; virtual;
    function GetTables(Restrictions: TStrings): TData; virtual; abstract;
    procedure CreateColumnsFields; virtual;
    function GetColumns(Restrictions: TStrings): TData; virtual; abstract;
    procedure CreateProceduresFields; virtual;
    function GetProcedures(Restrictions: TStrings): TData; virtual; abstract;
    procedure CreateProcedureParametersFields; virtual;
    function GetProcedureParameters(Restrictions: TStrings): TData; virtual; abstract;
    procedure CreateIndexesFields; virtual;
    function GetIndexes(Restrictions: TStrings): TData; virtual; abstract;
    procedure CreateIndexColumnsFields; virtual;
    function GetIndexColumns(Restrictions: TStrings): TData; virtual; abstract;
    procedure CreateConstraintsFields; virtual;
    function GetConstraints(Restrictions: TStrings): TData; virtual; abstract;

    function GetDatabases(Restrictions: TStrings): TData; virtual;
    procedure CreateDatabasesFields; virtual;
    function GetDataTypes(Restrictions: TStrings): TData; virtual;
    function GetUsers(Restrictions: TStrings): TData; virtual;
    function GetRoles(Restrictions: TStrings): TData; virtual;
    function GetUDTs(Restrictions: TStrings): TData; virtual;
    function GetPackages(Restrictions: TStrings): TData; virtual;
  {$IFDEF DBX_METADATA}
    procedure CreateObjectListFields; virtual;
  {$ENDIF}

  public
    constructor Create; virtual;
    destructor Destroy; override;

    function GetMetaData(Connection: TCRConnection; Transaction: TCRTransaction;
      const MetaDataKind: string; Restrictions: TStrings): TData; virtual;

    procedure GetMetaDataKindsList(List: TStrings);
    procedure GetRestrictionsList(List: TStrings; const MetaDataKind: string);
  end;

{ TCRCursor }

  TCRCursor = class (TSharedObject)
  public
    function CanFetch: boolean; virtual; abstract;
  end;

{ TCRLoader }

  TCRLoaderColumn = class
  private
    FName: string;
    FDataType: word;
    FSubDataType: word;
    FSize: integer;
    FDataSize: integer;
    FPrecision: integer;
    FScale: integer;
  public
    constructor Create; virtual;

    procedure UpdateDataType(Value: word); virtual;

    property Name: string read FName write FName;
    property DataType: word read FDataType write FDataType;
    property SubDataType: word read FSubDataType write FSubDataType;
    property Size: integer read FSize write FSize;
    property DataSize: integer read FDataSize write FDataSize;
    property Precision: integer read FPrecision write FPrecision;
    property Scale: integer read FScale write FScale;
  end;

  TCRLoaderColumns = class(TDAObjectList)
  private
    function GetColumn(Index: integer): TCRLoaderColumn;
    procedure SetColumn(Index: integer; Value: TCRLoaderColumn);
  public
    function GetColumnIndexByName(Name: string): Integer;
    function FindColumnByName(Name: string): TCRLoaderColumn;
    function GetColumnByName(Name: string): TCRLoaderColumn;

    property Items[Index: integer]: TCRLoaderColumn read GetColumn write SetColumn; default;
  end;

  TCRLoader = class
  protected
    FConnection: TCRConnection;
    FTransaction: TCRTransaction;
    FTableName: string;
    FColumns: TCRLoaderColumns;
    FLastRow: integer;
    FLoadedRows: integer;
    FSkipReadOnlyFieldDescs: boolean;
    FObjectReleaseNeeded: boolean;
    FQuoteNames: boolean;

    class function GetRecordSetClass: TCRRecordSetClass; virtual;
    procedure SetConnection(Value: TCRConnection); virtual;
    procedure SetTransaction(Value: TCRTransaction); virtual;
    procedure CheckTableName;
    procedure FillColumn(Column: TCRLoaderColumn; FieldDesc: TFieldDesc); virtual;

    procedure DoPrepare; virtual;
    procedure DoPutColumnData(Col: integer; Row: integer; const Value: variant); virtual;
    procedure DoAddObjectRef(const Value: variant);
    procedure DoReleaseObjectRef(const Value: variant);
    function IsPutColumnDataAllowed: boolean; virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    function SetProp(Prop: integer; const Value: variant): boolean; virtual;
    function GetProp(Prop: integer; var Value: variant): boolean; virtual;

    class function GetColumnClass: TCRLoaderColumnClass; virtual;
    procedure Prepare; overload; virtual;
    procedure Prepare(RecordCount: integer); overload; virtual;
    procedure Reset; virtual;
    procedure DoLoad; virtual;
    procedure Finish; virtual;
    procedure PutColumnData(Col: integer; Row: integer; const Value: variant); virtual;
    procedure CreateColumns;
    procedure DiscardRow;

    property Connection: TCRConnection read FConnection write SetConnection;
    property Transaction: TCRTransaction read FTransaction write SetTransaction;
    property TableName: string read FTableName write FTableName;
    property Columns: TCRLoaderColumns read FColumns;
    property QuoteNames: Boolean read FQuoteNames write FQuoteNames;
  end;

{ TCRSimpleLoader }

  TCRSimpleLoader = class (TCRLoader)
  protected
    FCommand: TCRCommand;

    procedure CreateCommand; virtual; abstract;

    procedure DoLoadRow; virtual;
    procedure DoPrepare; override;
    procedure DoPutColumnData(Col: integer; Row: integer; const Value: variant); override;
    procedure DoAfterLoadRow;
    function IsPutColumnDataAllowed: boolean; override;
  public
    constructor Create; override;
    destructor Destroy; override;

    procedure Reset; override;
    procedure PutColumnData(Col: integer; Row: integer; const Value: variant); override;
    procedure DoLoad; override;
    procedure Finish; override;
  end;

{ TCRAlerter }

  TCRAlerterEventCallback = procedure(const EventName, Message: string) of object;
  TCRAlerterErrorCallback = procedure(E: Exception) of object;

  TCRAlerter = class
  protected
    FConnection: TCRConnection;
    FTransaction: TCRTransaction;
    FEventNames: TStrings;
    FActive: boolean;
    FOnEvent: TCRAlerterEventCallback;
    FOnError: TCRAlerterErrorCallback;

    procedure SetConnection(Value: TCRConnection); virtual;
    procedure SetTransaction(Value: TCRTransaction); virtual;

  public
    constructor Create; virtual;
    destructor Destroy; override;

    function SetProp(Prop: integer; const Value: variant): boolean; virtual;
    function GetProp(Prop: integer; var Value: variant): boolean; virtual;

    procedure SendEvent(const EventName, Message: string); virtual; abstract;
    procedure Start; virtual; abstract;
    procedure Stop; virtual; abstract;
    function IsActive: boolean; virtual;

    property Connection: TCRConnection read FConnection write SetConnection;
    property Transaction: TCRTransaction read FTransaction write SetTransaction;
    property EventNames: TStrings read FEventNames;
    property OnEvent: TCRAlerterEventCallback read FOnEvent write FOnEvent;
    property OnError: TCRAlerterErrorCallback read FOnError write FOnError;
  end;

{$IFDEF UNIX}
function GetTickCount: Cardinal;
{$ENDIF}
function GetTickInterval(StartTickCount, FinishTickCount: Cardinal): Cardinal;
function GenerateTableName(const FieldDesc: TFieldDesc): string;

var
  DefaultSQLInfo: TSQLInfo = nil;
  MacroChar: Char = '&';
{$IFDEF AUTOTEST}
  __ServerExecuteCount: integer;
  __ServerPrepareCount: integer;
  __SwapConnectionCount: integer;
{$ENDIF}

implementation

uses
{$IFDEF VER6P}
  RTLConsts,
{$ELSE}
  Consts,
{$ENDIF}
{$IFDEF MSWINDOWS}
  {$IFNDEF LITE}ComObj,{$ENDIF}
{$ENDIF}
{$IFNDEF LITE}
  CRConnectionPool,
{$ENDIF}
  CRFunctions, DAConsts;

{ TCRAccess }

{$IFDEF UNIX}
function GetTickCount: Cardinal;
var
  tv: timeval;
begin
  fpgettimeofday(@tv, nil);
  {$RANGECHECKS OFF}
  Result := int64(tv.tv_sec) * 1000 + tv.tv_usec div 1000;
end;
{$ENDIF}

function GetTickInterval(StartTickCount, FinishTickCount: Cardinal): Cardinal;
begin
  // each 49.7 days ticks are reseted, so we should take it into attention
  // and use GetTickInterval for avoiding the out of range error
  if FinishTickCount >= StartTickCount then
    Result := FinishTickCount - StartTickCount
  else
    Result := Longword($FFFFFFFF) - StartTickCount + FinishTickCount + 1;
end;

function GenerateTableName(const FieldDesc: TFieldDesc): string;
begin
  if TCRFieldDesc(FieldDesc).TableInfo <> nil then
    Result := TCRFieldDesc(FieldDesc).TableInfo.TableName
  else
    Result := '';
end;

function ExtractFieldName(const Fields: string; var Pos: Integer): string;
var
  I: Integer;
begin
  I := Pos;
  while (I <= Length(Fields)) and (Fields[I] <> ';') do Inc(I);
  Result := Trim(Copy(Fields, Pos, I - Pos));
  if (I <= Length(Fields)) and (Fields[I] = ';') then Inc(I);
  Pos := I;
end;

{ EFailOver }

constructor EFailOver.Create(ConnLostCause: TConnLostCause);
begin
  FConnLostCause := ConnLostCause;
  inherited Create(''{$IFDEF FPC}+#0{$ENDIF});
end;

{ TCRConnection }

constructor TCRConnection.Create;
begin
  inherited;

  FConnected := False;
  FNativeConnection := True;
  FIsValid := True;
  FInternalTransaction := GetTransactionClass.Create;
  FInternalTransaction.AddConnection(Self);
  FSQLinfo := nil;
{$IFNDEF LITE}
  FHttpOptions := THttpOptions.Create;
  FDataTypeMap := CreateDataTypeMap;
{$ENDIF}
end;

destructor TCRConnection.Destroy;
begin
  Disconnect;
  FInternalTransaction.Free;
  FSQLinfo.Free;
{$IFNDEF LITE}
  FHttpOptions.Free;
  FDataTypeMap.Free;
{$ENDIF}

  inherited;
end;

procedure TCRConnection.Connect(const ConnectString: string);
begin
  FConnectionTime := GetTickCount;
  FIsValid := True;
end;

procedure TCRConnection.Assign(Source: TCRConnection);
begin
  FServer := Source.FServer;
  FUsername := Source.FUsername;
  FPassword := Source.FPassword;
  FEnableBCD := Source.FEnableBCD;
{$IFDEF VER6P}
{$IFNDEF FPC}
  FEnableFMTBCD := Source.FEnableFMTBCD;
{$ENDIF}
{$ENDIF}
  FOnError := Source.FOnError;
{$IFNDEF LITE}
  FIOHandler := Source.FIOHandler;
{$ENDIF}
end;

function TCRConnection.GetSQLInfo: TSQLInfo;
begin
  if FSQLInfo = nil then
    FSQLInfo := CreateSQLInfo;
  Result := FSQLInfo;
end;

function TCRConnection.CreateSQLInfo: TSQLInfo;
begin
  Result := GetCommandClass.GetSQLInfoClass.Create(GetCommandClass.GetParserClass);
end;

{$IFNDEF LITE}
function TCRConnection.CreateDataTypeMap: TCRMapRules;
begin
  Result := GetCommandClass.GetMapRulesClass.Create;
end;
{$ENDIF}

procedure TCRConnection.DoError(E: Exception; var Fail: boolean);
var
  Reconnect: boolean;
  Attempt: integer;
  OldConnectionTimeout: variant;
{$IFNDEF LITE}
  Reexecute: boolean;
  ConnLostCause: TConnLostCause;
{$ENDIF}
begin
  Attempt := 0;
  while not FInProcessError do begin
    Reconnect := Attempt > 0;
  {$IFNDEF LITE}
    Reexecute := False;
  {$ENDIF}
    if Assigned(OnError) then begin
      FInProcessError := True;
      try
      {$IFNDEF LITE}
        ConnLostCause := clUnknown;
      {$ENDIF}
        OnError(E, Fail, Reconnect{$IFNDEF LITE}, Reexecute{$ENDIF}, Attempt{$IFNDEF LITE}, ConnLostCause{$ENDIF});
      finally
        FInProcessError := False;
      end;
    end;

    if Reconnect then begin
      FReconnected := False;
      try
        FInProcessError := True;
        if Attempt = 0 then begin
          try
            GetProp(prConnectionTimeout, OldConnectionTimeout);
            SetProp(prConnectionTimeout, 1);
            Disconnect;
          finally
            SetProp(prConnectionTimeout, OldConnectionTimeout);
          end;
        end;
      except // don't raise exception
      end;
      try
        Connect('');
        if Assigned(FOnReconnectSuccess) then
          FOnReconnectSuccess;
        FReconnected := True;
      except // don't raise exception
      end;
      FInProcessError := False;

    {$IFNDEF LITE}
      if FReconnected and Reexecute then
        raise EFailOver.Create(ConnLostCause); //Failover
    {$ENDIF}

      inc(Attempt);
    end;

    if not Reconnect and (Attempt > 0) then
      if not FReconnected and Assigned(OnReconnectError) then begin
        FInProcessError := True;
        FConnected := True; // to bypass "Value <> GetConnected" check in TCustomDAConnection.SetConnected
        try
          OnReconnectError;
        except // don't raise exception
        end;
        FConnected := False;
        FInProcessError := False;
      end;
    
    if not Reconnect or FReconnected then
      break;
  end;
end;

function TCRConnection.GetConnected: boolean;
begin
  Result := FConnected;
end;

procedure TCRConnection.SetConnected(Value: boolean);
begin
  if Value then
    Connect('')
  else
    Disconnect;
end;

function TCRConnection.GetInternalTransaction: TCRTransaction;
begin
  Result := FInternalTransaction;
end;

procedure TCRConnection.SetUsername(const Value: string);
begin
  FUsername := Value;
end;

procedure TCRConnection.SetPassword(const Value: string);
begin
  FPassword := Value;
end;

procedure TCRConnection.SetServer(const Value: string);
begin
  FServer := Value;
end;

function TCRConnection.GetUsername: string;
begin
  Result := FUsername;
end;

function TCRConnection.GetPassword: string;
begin
  Result := FPassword;
end;

function TCRConnection.GetServer: string;
begin
  Result := FServer;
end;

{$IFDEF MSWINDOWS}
{$IFNDEF LITE}
procedure TCRConnection.Enlist(MTSTransaction: TMTSTransaction);
begin
  raise Exception.Create('MS DTC transactions not supported');
end;

procedure TCRConnection.UnEnlist(MTSTransaction: TMTSTransaction);
begin
  raise Exception.Create('MS DTC transactions not supported');
end;
{$ENDIF}
{$ENDIF}

{$IFNDEF LITE}
procedure TCRConnection.ReturnToPool;
begin
  Assert(FPool <> nil);
  FOnError := nil;
  Component := nil;
  TCRConnectionPool(FPool).PutConnection(Self);
end;
{$ENDIF}

function TCRConnection.CanChangeDatabase: boolean;
begin
  Result := True;
end;

function TCRConnection.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prConnectionTimeout: ;
    prAutoCommit:
      FAutoCommit := Value;
    prConvertEOL:
      FConvertEOL := Value;
    prDisconnectedMode:
      FDisconnectedMode := Boolean(Value);
    prDefaultSortType:
      FDefaultSortType := TSortType(Value);
    prDatabase: ;
    prPort: ;
    prEnableBCD:
      FEnableBCD := Value;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    prEnableFmtBCD:
      FEnableFMTBCD := Value;
  {$ENDIF}
  {$ENDIF}
  {$IFNDEF LITE}
    prHttpUrl:
      FHttpOptions.Url := Value;
    prHttpUsername:
      FHttpOptions.Username := Value;
    prHttpPassword:
      FHttpOptions.Password := Value;
    prProxyHostname:
      FHttpOptions.ProxyOptions.Hostname := Value;
    prProxyPort:
      FHttpOptions.ProxyOptions.Port := integer(Value);
    prProxyUsername:
      FHttpOptions.ProxyOptions.Username := Value;
    prProxyPassword:
      FHttpOptions.ProxyOptions.Password := Value;
  {$ENDIF}
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

function TCRConnection.GetProp(Prop: integer; out Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prUsername: // used in Oracle dbExpress driver (TOraSQLMetaData.getProcedureParams)
                // to detect if schema name need to be included in procedure name
      Value := FUsername;
    prConnectionTimeout:
      Value := 0;
    prAutoCommit:
      Value := FAutoCommit;
    prMaxStringSize:
      Value := 0;
    prLastInsertId:
      Value := 0;
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

{ TColumnsInfo }

function TColumnsInfo.GetItem(Index: integer): TColumnInfo;
begin
  Result := TColumnInfo(inherited Items[Index]);
end;

{ TCRCommand }

constructor TCRCommand.Create;
begin
  inherited;

  FParams:= TParamDescs.Create;
  FScanParams := True;
  FSQLInfo := nil;
end;

destructor TCRCommand.Destroy;
begin
  FParams.Free;
  FSQLInfo.Free;

  inherited;
end;

procedure TCRCommand.Prepare;
begin
  SetCursorState(csPrepared);
end;

procedure TCRCommand.Unprepare;
begin
  SetCursorState(csInactive);
end;

{$IFDEF AUTOTEST}
procedure TCRCommand.Execute(Iters: integer = 1);
begin
  Inc(__ServerExecuteCount);
end;
{$ENDIF}

procedure TCRCommand.Close;
begin

end;

procedure TCRCommand.SetConnection(Value: TCRConnection);
begin
  FConnection := Value;
end;

function TCRCommand.GetConnection: TCRConnection;
begin
  Result := FConnection;
end;

procedure TCRCommand.SetTransaction(Value: TCRTransaction);
begin
  // should be overloaded for Multiple Transactions databases
end;

function TCRCommand.GetTransaction: TCRTransaction;
begin
  // should be overloaded for Multiple Transactions databases
  Result := nil;
end;

procedure TCRCommand.SetSQL(const Value: string);
begin
  // Parameters must be recreated on Change SQL
  // for Value = FUserSQL parameters must be recreated also
  FUserSQL := Value;
  if FDisableParamScan then
    FSQL := Value
  else
    FSQL := ParseSQL(Value, FParams);
end;

class function TCRCommand.GetTableInfoClass: TTableInfoClass;
begin
  Result := TCRTableInfo;
end;

class function TCRCommand.GetSQLInfoClass: TSQLInfoClass;
begin
  Result := TSQLInfo;
end;

class function TCRCommand.GetParserClass: TSQLParserClass;
begin
  Assert(False);
  Result := TSQLParser;
end;

{$IFNDEF LITE}
class function TCRCommand.GetMapRulesClass: TCRMapRulesClass;
begin
  Result := TCRMapRules;
end;
{$ENDIF}

function TCRCommand.GetSQLInfo: TSQLInfo;
begin
  if FConnection <> nil then
    Result := FConnection.SQLInfo
  else begin
    if FSQLInfo = nil then
      FSQLInfo := CreateSQLInfo;
    Result := FSQLInfo;
  end;
end;

function TCRCommand.CreateSQLInfo: TSQLInfo;
begin
  Result := GetSQLInfoClass.Create(Self.GetParserClass);
end;

procedure TCRCommand.ParseSQLParam(ParsedSQL: StringBuilder; Parser: TSQLParser; Params: TParamDescs; LeftQuote, RightQuote: Char; const RenamePrefix: string);
var
  Code: integer;
  St: string;
  DogPresent: boolean;
  l: integer;
  ParamName: string;
begin
  Code := Parser.GetNext(St);
  DogPresent := St = '@';
  if DogPresent then
    Code := Parser.GetNext(St); // Omit '@' in ParamName for BDE compatibility

  if ((Params <> nil) or (RenamePrefix <> '')) and ((Code = lcIdent) or (Code = lcNumber) or (Parser.KeywordLexems.IndexOf(St) <> -1)) // and (St <> '=')
  then begin
    if DogPresent then
      ParamName := '@' + St
    else
      ParamName := St;

    l := Length(ParamName);
    // remove quotes
    if (ParamName[1] = LeftQuote) and (ParamName[l] = RightQuote) then
      ParamName := Copy(ParamName, 2, l - 2);
    if Params <> nil then begin
      AddParam.SetName(ParamName);
      ParsedSQL.Append('?');
    end
    else
      ParsedSQL.Append(RenamePrefix + ParamName);
  end
  else begin // Labels in SQL Server, MySQL syntax and PL SQL Blocks (a := b).
    ParsedSQL.Append(':');
    if DogPresent then
      ParsedSQL.Append('@');
    ParsedSQL.Append(St);
  end;
end;

function TCRCommand.ParseSQL(const SQL: string; Params: TParamDescs; ReplaceAll: boolean = True; const RenamePrefix: string = ''): string;
var
  ParsedSQL: StringBuilder;
  Parser: TSQLParser;
  StartPos: integer;
  LeftQuote, RightQuote: Char;
begin
  if Params <> nil then
    Params.Clear;

  if Pos(':', SQL) = 0 then begin
    Result := SQL;
    Exit;
  end;

  LeftQuote := SQLInfo.LeftQuote;
  RightQuote := SQLInfo.RightQuote;

  ParsedSQL := StringBuilder.Create(Length(SQL) + Length(SQL) div 2);
  try
    Parser := GetParserClass.Create(SQL);
    try
      Parser.OmitBlank := False;
      Parser.OmitComment := True;
      Parser.QuotedString := True;
      Parser.DecSeparator := '.';
      Parser.ToBegin;
      StartPos := Parser.CurrPos;
      while Parser.ToLexem(':') do begin
        ParsedSQL.Append(Copy(SQL, StartPos + 1, Parser.CurrPos - StartPos - 1));
        ParseSQLParam(ParsedSQL, Parser, Params, LeftQuote, RightQuote, RenamePrefix);

        StartPos := Parser.CurrPos;
      end;
      ParsedSQL.Append(Copy(SQL, StartPos + 1, Parser.CurrPos - StartPos));
    finally
      Parser.Free;
    end;

    Result := ParsedSQL.ToString;
  finally
    ParsedSQL.Free;
  end;
end;

procedure TCRCommand.ParseSQL(ReplaceAll: boolean = True);
begin
  FSQL := ParseSQL(FUserSQL, FParams, ReplaceAll);
end;

function TCRCommand.ForceCreateSPParams: boolean;
begin
  Result := False;
end;

{ Params }

function TCRCommand.GetParamDescType: TParamDescClass;
begin
  Result := TParamDesc;
end;

procedure TCRCommand.ClearParams;
begin
  FParams.Clear;
end;

function TCRCommand.AddParam: TParamDesc;
begin
  Result := GetParamDescType.Create;
  FParams.Add(Result);
end;

procedure TCRCommand.DeleteParam(Index: integer);
begin
  FParams.Delete(Index);
end;

function TCRCommand.GetParamCount: integer;
begin
  Result := FParams.Count;
end;

function TCRCommand.GetParam(Index: integer): TParamDesc;
begin
  Result := FParams[Index];
end;

function TCRCommand.FindParam(Name: string): TParamDesc;
begin
  Result := FParams.FindParam(Name);
end;

function TCRCommand.GetCursor: TCRCursor;
begin
  Result := nil;
end;

procedure TCRCommand.SetCursor(Value: TCRCursor);
begin
  raise Exception.Create(SOperationNotSupported);
end;

function TCRCommand.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prAutoCommit:
      FAutoCommit := Value;
  {$IFDEF HAVE_COMPRESS}
    prCompressBlobMode:
      FCompressBlob := TCompressBlobMode(Integer(Value));
  {$ENDIF}
    prScanParams:
      if FScanParams <> Boolean(Value) then begin
        FScanParams := Boolean(Value);
        if FScanParams and (FUserSQL <> '') then
          ParseSQL;
      end;
    prDisableParamScan:
      FDisableParamScan := Value;
    prQuoteNames:
      FQuoteNames := Value;
    prStoredProcIsQuery:  //TODO: Remove
      ;
    prCanReadParams:
      ;
    prEnableBCD:
      FEnableBCD := Value;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    prEnableFmtBCD:
      FEnableFMTBCD := Value;
  {$ENDIF}
  {$ENDIF}
    prIsStoredProc:
      ;
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

function TCRCommand.GetProp(Prop: integer; out Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prExecuting:
      Value := FExecuting;
    prCanReadParams:
      Value := True;
    prIsSelectParams:
      Value := False;
    prUseDescribeParams:
      Value := False;
    prScanParams:
      Value := FScanParams;
    prQuoteNames:
      Value := FQuoteNames;
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

procedure TCRCommand.BreakExec;
begin
end;

{ $IFNDEF LITE}
{ TCRTableInfo }

constructor TCRTableInfo.Create(Owner: TCRTablesInfo);
begin
  inherited Create;
  FOwner := Owner;
  FIndex := -1;
end;

procedure TCRTableInfo.SetTableName(const Value: string);
begin
  FTableName := Value;
  if FOwner <> nil then
    FOwner.TableNameChanged;
end;

procedure TCRTableInfo.SetTableAlias(const Value: string);
begin
  FTableAlias := Value;
  if FOwner <> nil then
    FOwner.TableAliasChanged;
end;

function TCRTableInfo.GetTableNameFull: string;
begin
  Result := FTableName;
end;

procedure TCRTableInfo.SetTableNameFull(const Value: string);
begin
end;

{ TCRTablesInfo }

constructor TCRTablesInfo.Create(TableInfoClass: TTableInfoClass);
begin
  inherited Create;
  FTableInfoClass := TableInfoClass;
  FTableNameList := TStringList.Create;
  FTableAliasList := TStringList.Create;
{$IFDEF VER6P}
  FTableNameList.CaseSensitive := False;
  FTableAliasList.CaseSensitive := False;
{$ENDIF}
  FUpdateCount := 0;
end;

destructor TCRTablesInfo.Destroy;
begin
  Clear;
  FTableNameList.Free;
  FTableAliasList.Free;
  inherited Destroy;
end;

procedure TCRTablesInfo.InternalAdd(TableInfo: TCRTableInfo);
var
  c: integer;
begin
  c := Count;
  SetLength(FList, c + 1);
  FList[c] := TableInfo;
  TableInfo.Index := c;
end;

function TCRTablesInfo.Add: TCRTableInfo;
begin
  Result := FTableInfoClass.Create(Self);
  InternalAdd(Result);
end;

procedure TCRTablesInfo.Clear;
var
  i: Integer;
begin
  if Count > 0 then begin
    for i := 0 to Count - 1 do
      FList[i].Free;
    SetLength(FList, 0);
    Changed;
  end;
end;

procedure TCRTablesInfo.Changed;
begin
  TableNameChanged;
  TableAliasChanged;
end;

procedure TCRTablesInfo.TableNameChanged;
var
  i: Integer;
begin
  if FUpdateCount = 0 then begin
    FTableNameList.Clear;
    FTableNameList.Sorted := False;
    for i := 0 to Count - 1 do
      FTableNameList.AddObject(FList[i].TableName, FList[i]);
    FTableNameList.Sorted := True;
  end;
end;

procedure TCRTablesInfo.TableAliasChanged;
var
  i: Integer;
begin
  if FUpdateCount = 0 then begin
    FTableAliasList.Clear;
    FTableAliasList.Sorted := False;
    for i := 0 to Count - 1 do
      FTableAliasList.AddObject(FList[i].TableAlias, FList[i]);
    FTableAliasList.Sorted := True;
  end;
end;

function TCRTablesInfo.GetCount: Integer;
begin
  Result := Length(FList);
end;

procedure TCRTablesInfo.SetCaseSensitive(Value: boolean);
begin
  FCaseSensitive := Value;
{$IFDEF VER6P}
  FTableNameList.CaseSensitive := Value;
  FTableAliasList.CaseSensitive := Value;
{$ENDIF}
end;

procedure TCRTablesInfo.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TCRTablesInfo.EndUpdate;
begin
  Dec(FUpdateCount);
  Changed;
end;

function TCRTablesInfo.FindByName(const TableName: string): TCRTableInfo;
var
  Index: integer;
begin
  Index := IndexByName(TableName);
  if Index = -1 then
    Result := nil
  else
    Result := FList[Index];
end;

function TCRTablesInfo.IndexOf(TableInfo: TCRTableInfo): Integer;
begin
  Result := 0;
  while (Result < Count) and (FList[Result] <> TableInfo) do
    Inc(Result);
  if Result = Count then
    Result := -1;
end;

function TCRTablesInfo.IndexByName(const TableName: string): Integer;
var
  i: integer;
begin
  if FUpdateCount = 0 then begin
    Result := FTableNameList.IndexOf(TableName);
    if Result <> -1 then
      Result := TCRTableInfo(FTableNameList.Objects[Result]).Index;
  end
  else
  begin
    Result := -1;
    for i := 0 to Count - 1 do
      if FCaseSensitive and (FList[i].TableName = TableName) or
        not FCaseSensitive and SameText(FList[i].TableName, TableName)
      then begin
        Result := i;
        Break;
      end;
  end;
end;

function TCRTablesInfo.IndexByAlias(const TableAlias: string): Integer;
var
  i: integer;
begin
  if FUpdateCount = 0 then begin
    Result := FTableAliasList.IndexOf(TableAlias);
    if Result <> -1 then
      Result := TCRTableInfo(FTableAliasList.Objects[Result]).Index;
  end
  else
  begin
    Result := -1;
    for i := 0 to Count - 1 do
      if FCaseSensitive and (FList[i].TableAlias = TableAlias) or
        not FCaseSensitive and SameText(FList[i].TableAlias, TableAlias)
      then begin
        Result := i;
        Break;
      end;
  end;
end;

function TCRTablesInfo.FindByNameAndAlias(const TableName, TableAlias: string): TCRTableInfo;
var
  i: integer;
begin
  Result := nil;

  for i := 0 to Count - 1 do
    if (FCaseSensitive and (FList[i].TableName = TableName) and (FList[i].TableAlias = TableAlias)) or
      (not FCaseSensitive and SameText(FList[i].TableName, TableName) and SameText(FList[i].TableAlias, TableAlias))
    then begin
      Result := FList[i];
      Break;
    end;
end;

function TCRTablesInfo.GetItem(Index: Integer): TCRTableInfo;
begin
  if (Index < 0) or (Index >= Count) then
    raise Exception.CreateFmt(SListIndexError, [Index]);

  Result := FList[Index];
end;

procedure TCRTablesInfo.SetItem(Index: Integer; const Value: TCRTableInfo);
begin
  if (Index >= 0) and (Index < Count) then
    if Value <> FList[Index] then
      FList[Index] := Value;
end;

{ TSQLInfo }

constructor TSQLInfo.Create(ParserClass: TSQLParserClass);
begin
  inherited Create;
  FParserClass := ParserClass;
end;

function TSQLInfo.LeftQuote: Char;
begin
  Result := '"';
end;

function TSQLInfo.RightQuote: Char;
begin
  Result := '"';
end;

function TSQLInfo.IdentCase: TIdentCase;
begin
  Result := icMixed;
end;

function TSQLInfo.ParamQuoteAllowed: boolean;
begin
  Result := true;
end;

function TSQLInfo.ProcedureOverloadSeparator: Char;
begin
  Result := ':';
end;

function TSQLInfo.IsQuoted(const Value: string): boolean;
var
  l: integer;
begin
  l := Length(Value);
  if (l <= 1) then
    Result := False
  else
    Result :=  (Value[1] = LeftQuote) and (Value[l] = RightQuote);
end;

function TSQLInfo.Quote(const Value: string): string;
begin
  Result := Quote(Value, LeftQuote, RightQuote);
end;

function TSQLInfo.Quote(const Value: string; const LeftQ: Char; const RightQ: Char): string;
begin
  if not IsQuoted(Value) then
    Result := LeftQ + Value + RightQ
  else
    Result := Value;
end;

function TSQLInfo.UnQuote(const Value: string): string;
begin
  if IsQuoted(Value) then
    Result := Copy(Value, 2, length(Value) - 2)
  else
    Result := Value;
end;

function TSQLInfo.QuotesNeeded(const Value: string): boolean;
var
  i: integer;
  IdCase: TIdentCase;
begin
  Result := False;
  if Value = '' then
    Exit;

  IdCase := IdentCase;

  Result := FirstCharQuotesNeed(Value[1], IdCase);

  i := 2;
  while not Result and (i <= Length(Value)) do begin
    Result := NextCharQuotesNeed(Value[i], IdCase);
    Inc(i);  
  end;
end;

function TSQLInfo.QuoteIfNeed(const Value: string): string;
begin
  if QuotesNeeded(Value) then
    Result := Quote(Value)
  else
    Result := Value;
end;

function TSQLInfo.NormalizeName(const Value: string; QuoteNames: boolean = False; UnQuoteNames: boolean = False): string;
begin
  Result := NormalizeName(Value, LeftQuote, RightQuote, QuoteNames, UnQuoteNames);
end;

function TSQLInfo.NormalizeName(const Value: string; const LeftQ: Char; const RightQ: Char; QuoteNames: boolean = False; UnQuoteNames: boolean = False): string;
var
  i: integer;
begin
  if Value = '' then begin
    Result := '';
    Exit;
  end;

  if Value[1] = LeftQ then begin
    i := Pos(RightQ + '.', Value);
    if i > 0 then
      Inc(i);
  end
  else begin
    i := Pos('.', Value);
  end;

  if i <> 0 then
    Result := NormalizeName(Copy(Value, 1, i - 1), LeftQ, RightQ, QuoteNames, UnQuoteNames) + '.' +
      NormalizeName(Copy(Value, i + 1, Length(Value) - i), LeftQ, RightQ, QuoteNames, UnQuoteNames)
  else begin
    Result := Value;
    if not QuoteNames then begin
      case IdentCase of
        icUpper:
          if not IsQuoted(Result) then
            Result := AnsiUpperCase(Result);
        icLower:
          if not IsQuoted(Result) then
            Result := AnsiLowerCase(Result);
      end;
    end;

    if not UnQuoteNames and (QuoteNames or QuotesNeeded(Result)) then
      Result := Quote(Result, LeftQ, RightQ)
    else
      Result := UnQuote(Result);
  end;
end;

function TSQLInfo.ToStringConst(const Value: string): string;
begin
  Result := '''' + StringReplace(Value, '''', '''''', [rfReplaceAll]) + '''';
end;

procedure TSQLInfo.SplitObjectName(const Name: string; var Info: TSQLObjectInfo);
var
  Str: string;
  i, FirstIdx, Len, ParamIdx: integer;
  InQuote: boolean;
  Lq, Rq: Char;
begin
  Info.Name := '';
  Info.Schema := '';
  Info.Catalog := '';
  Info.DBLink := '';

  Len := Length(Name);
  FirstIdx := Len;
  ParamIdx := 1;
  InQuote := False;
  Lq := LeftQuote;
  Rq := RightQuote;

  for i := Len downto 0 do begin
    if i > 0 then begin
      if not InQuote then begin
        if Name[i] = Rq then
          InQuote := True;
      end
      else
        if Name[i] = Lq then
          InQuote := False;
    end;

    if (i = 0) or (not InQuote and (Name[i] = '.')) then begin
      Str := Copy(Name, i + 1, FirstIdx - i);
      case ParamIdx of
        1: Info.Name := Str;
        2: Info.Schema := Str;
        3: Info.Catalog := Str;
      end;
      Inc(ParamIdx);
      FirstIdx := i - 1;
    end;
  end;
end;

procedure TSQLInfo.ParseTablesInfo(const SQL: string; TablesInfo: TCRTablesInfo);

  // find close bracket and skip all inside
  procedure ToEndBracket(Parser: TSQLParser; var CodeLexem: integer; var StLex: string);
  var
    BracketCount: integer;
  begin
    BracketCount := 1;
    repeat
      CodeLexem := Parser.GetNext(StLex);

      if StLex = '(' then
        Inc(BracketCount)
      else
      if StLex = ')' then
        Dec(BracketCount);
    until (BracketCount = 0) or (CodeLexem = lcEnd);
  end;

  procedure ParseTableName(Parser: TSQLParser; var CodeLexem: integer; var StLex: string; InBrackets: boolean);
  var
    Name, Alias: string;
    TableInfo: TCRTableInfo;
  begin
    repeat
      // exit on WHERE and other clause lexems
      if not InBrackets and Parser.IsClauseLexem(CodeLexem) then
        exit
      // bypass end bracket
      else if StLex = ')' then
        exit
      // bypass join
      else if CodeLexem in [lxJOIN, lxINNER, lxLEFT, lxRIGHT, lxFULL, lxOUTER] then
        CodeLexem := Parser.GetNext(StLex)
      // bypass comma
      else if StLex = ',' then
        CodeLexem := Parser.GetNext(StLex)
      //parse table name
      else begin
        // parse brackets recursive
        if StLex = '(' then begin
          CodeLexem := Parser.GetNext(StLex);

          if CodeLexem <> lxSELECT then
            ParseTableName(Parser, CodeLexem, StLex, True)
          else // skip subquery
            ToEndBracket(Parser, CodeLexem, StLex);

          if CodeLexem = lcEnd then
            Exit;

          // skip end bracket  
          if (StLex = ')') then
            CodeLexem := Parser.GetNext(StLex);
        end
        else begin
          Name := '';

          // PostgreSQL can containt ONLY lexeme before table name, skip it
          if HasOnlyLexem then
            if CodeLexem = lxONLY then
              CodeLexem := Parser.GetNext(StLex);

          while (CodeLexem = lcIdent) or (CodeLexem >= lxSQLFirst) or (StLex = '.') do begin
              Name := Name + StLex;
              if StLex <> '.' then begin
                CodeLexem := Parser.GetNext(StLex);
                if StLex = '.' then
                  Name := Name + StLex
                else
                  break;
              end;
              CodeLexem := Parser.GetNext(StLex);
          end;

          if Name <> '' then begin
            if HasAsLexem then
              if CodeLexem = lxAS then
                CodeLexem := Parser.GetNext(StLex);

            // Oracle extended table info
            ParseExtTableInfo(Parser, CodeLexem, StLex, Name);

            if (CodeLexem = lcIdent) or (CodeLexem >= lxSQLFirst) and
              (CodeLexem <> lxJOIN) and (CodeLexem <> lxINNER) and
              (CodeLexem <> lxLEFT) and (CodeLexem <> lxRIGHT) and
              (CodeLexem <> lxFULL) and (CodeLexem <> lxON) and
              not Parser.IsClauseLexem(CodeLexem)
            then begin
              Alias := StLex;
              CodeLexem := Parser.GetNext(StLex);
            end
            else
              Alias := '';

            if StLex <> '(' then begin // skip stored functions
              Name := NormalizeName(Name);
              Alias := NormalizeName(Alias);
              TableInfo := TablesInfo.FindByNameAndAlias(Name, Alias);
              if TableInfo = nil then begin
                TableInfo := TablesInfo.Add;
                TableInfo.TableName := Name;
                TableInfo.TableAlias := Alias;
              end;
            end;
          end;
        end;

        if CodeLexem = lcEnd then
          Exit;

        // bypass subqueries, function calls, ON clause of join
        repeat
          if StLex = '(' then begin
            ToEndBracket(Parser, CodeLexem, StLex);
            if CodeLexem <> lcEnd then
              CodeLexem := Parser.GetNext(StLex);
          end;

          if CodeLexem in [lxJOIN, lxINNER, lxLEFT, lxRIGHT, lxFULL] then begin
            CodeLexem := Parser.GetNext(StLex);
            break;
          end
          else if StLex = ',' then begin
            CodeLexem := Parser.GetNext(StLex);
            break;
          end  
          else if StLex = ')' then
            exit
          else if not InBrackets and Parser.IsClauseLexem(CodeLexem) then
            Exit;
          
          CodeLexem := Parser.GetNext(StLex);
        until (CodeLexem = lcEnd);
      end;
    until CodeLexem = lcEnd;
  end;

var
  Parser: TSQLParser;
  StLex: string;
  CodeLexem: integer;
begin
  Assert(FParserClass <> nil);
  Parser := FParserClass.Create(SQL);
  TablesInfo.BeginUpdate;
  Parser.OmitBlank := True;
  Parser.OmitComment := True;
  try
    if Parser.ToLexem(lxSELECT) <> lcEnd then begin
      CodeLexem := Parser.ToLexem(lxFROM, True);
      if CodeLexem <> lcEnd then begin
        CodeLexem := Parser.GetNext(StLex);
        ParseTableName(Parser, CodeLexem, StLex, False);
      end;
    end;
  finally
    TablesInfo.EndUpdate;
    Parser.Free;
  end;
end;

procedure TSQLInfo.ParseColumnsInfo(const SQL: string; ColumnsInfo: TColumnsInfo);
var
  Info: TColumnInfo;
  Parser: TSQLParser;
  Str, PrevStr: string;
  PrevCode, Code: integer;
  Name, Alias, Table, Expr: string;
  IsExpr: boolean;
  BracketCount: integer;
begin
  Assert(FParserClass <> nil);
  Parser := FParserClass.Create(SQL);
  Parser.QuotedString := True;
  try
    Parser.OmitComment := True;
    if Parser.ToLexem(lxSELECT) = lxSELECT then begin
      PrevStr := '';
      BracketCount := 0;
      while True do begin
        Code := Parser.GetNext(Str);

        if Parser.IsSelectModifier(Code) then
          Continue;

        IsExpr := False;
        Name := '';
        Table := '';
        Alias := '';
        Expr := '';

        if (Code = lcIdent) or (Code >= lxSQLFirst) and (Code <> lxFROM)
          or (Str = '*')
        then begin
          Name := Str;
          Code := Parser.GetNext(Str);
          if Str = '.' then begin
            Code := Parser.GetNext(Str);
            if (Code = lcIdent) or (Code >= lxSQLFirst) or (Str = '*') then begin
              Table := Name;
              Name := Str;
              Code := Parser.GetNext(Str);
              if Str = '.' then begin
                Code := Parser.GetNext(Str);
                if (Code = lcIdent) or (Code >= lxSQLFirst) or (Str = '*') then begin
                  Table := Table + '.' + Name;
                  Name := Str;
                  Code := Parser.GetNext(Str);
                  if Str = '.' then begin
                    Code := Parser.GetNext(Str);
                    if (Code = lcIdent) or (Code >= lxSQLFirst) or (Str = '*') then begin
                      Table := Table + '.' + Name;
                      Name := Str;
                      Code := Parser.GetNext(Str);
                    end;
                  end;
                end;
              end;
            end;
          end;

          ParseExtColumnName(Parser, Code, Str);

          if Code = lxAS then
            Parser.GetNext(Str);

          if (Code = lcIdent) or (Code >= lxSQLFirst) and (Code <> lxFROM) then begin
            Alias := Str;
            Code := Parser.GetNext(Str);
          end;
        end;

        PrevCode := lcEnd;
        while True do begin
          if (Code = lcEnd) or
            (((Str = ',') or (Code = lxFROM)) and (BracketCount = 0))
          then
            Break;

          if not IsExpr then begin
            if Table = '' then
              Expr := Name
            else
              Expr := Table + '.' + Name;
            Alias := '';
            IsExpr := True;
          end
          else
          if Alias <> '' then begin
            Expr := Expr + Alias;
            Alias := '';
          end;

          if Str = '(' then
            Inc(BracketCount)
          else
          if Str = ')' then
            Dec(BracketCount);

          if BracketCount = 0 then begin
            if Code = lxAS then begin
              Code := Parser.GetNext(Str);
              continue;
            end;

            if ((Code = lcIdent) or (Code >= lxSQLFirst)) and
              ((PrevCode = lcIdent) or (PrevCode = lcNumber) or (PrevCode = lcString)
              or (PrevCode >= lxSQLFirst) or (PrevStr = ')'))
            then
              Alias := Str
            else
              Expr := Expr + Str;
          end;

          PrevCode := Code;
          PrevStr := Str;
          Code := Parser.GetNext(Str);
        end;

        if not IsExpr and (Table = '') and Parser.IsFunctionOrConst(Name) then begin
          IsExpr := True;
          Expr := Name;
        end;

        Info := TColumnInfo.Create;
        if not IsExpr then begin
          Info.Name := NormalizeName(Name, False, True);
          Info.Table := NormalizeName(Table, False, True);
        end
        else
          Info.Expr := Expr;
        Info.TableIndex := -1;
        Info.Alias := NormalizeName(Alias, False, True);
        ColumnsInfo.Add(Info);

        if (Code = lcEnd) or (Code = lxFROM) then
          Break;
      end;
    end;
  finally
    Parser.Free;
  end;
end;

procedure TSQLInfo.ParseExtColumnName(Parser: TSQLParser; var Code: integer; var Str: string);
begin
end;

function TSQLInfo.FirstCharQuotesNeed(Ch: Char; IdCase: TIdentCase): boolean;
begin
  case IdCase of
    icUpper:
      case Ch of
        'A'..'Z': Result := False;
      else
        Result := True;
      end;
    icLower:
      case Ch of
        'a'..'z': Result := False;
      else
        Result := True;
      end;
  else
    case Ch of
      'a'..'z', 'A'..'Z': Result := False;
    else
      Result := True;
    end;
  end;
end;

function TSQLInfo.NextCharQuotesNeed(Ch: Char; IdCase: TIdentCase): boolean;
begin
  case IdCase of
    icUpper:
      case Ch of
        'A'..'Z', '_', '0'..'9', '$': Result := False;
      else
        Result := True;
      end;
    icLower:
      case Ch of
        'a'..'z', '_', '0'..'9', '$': Result := False;
      else
        Result := True;
      end;
  else
    case Ch of
      'a'..'z', 'A'..'Z', '_', '0'..'9', '$': Result := False;
    else
      Result := True;
    end;
  end;
end;

function TSQLInfo.HasAsLexem: boolean;
begin
  Result := True
end;

function TSQLInfo.HasOnlyLexem: boolean;
begin
  Result := False;
end;

procedure TSQLInfo.ParseExtTableInfo(Parser: TSQLParser; var CodeLexem: integer; var StLex: string; var Name: string);
begin
  // Dummy
end;

function TSQLInfo.NamesFromList(List: TStrings): string;
var
  i: integer;
begin
  for i := 0 to List.Count - 1 do begin
    if i > 0 then
      Result := Result + ';';
    Result := Result + List[i];
  end;
end;

procedure TSQLInfo.NamesToList(Value: string; List: TStrings);
var
  St: string;
  i: integer;
begin
  Value := Trim(Value);
  List.Clear;

  St := '';
  for i := 1 to Length(Value) do
    if (Value[i] = ',') or (Value[i] = ';') then begin
      St := Trim(St);
      if St <> '' then
        List.Add(St);
      St := '';
    end
    else
      St := St + Value[i];

  St := Trim(St);
  if St <> '' then
    List.Add(St);
end;

{ TCRFieldDesc }

constructor TCRFieldDesc.Create;
begin
  inherited;

{$IFNDEF LITE}
  FDBType := 0;
  FDBLength := 0;
  FDBScale := 0;
  FMapRule := nil;
  FMapLength := -1;
  FMapScale := -1;
  FOnDemandConverter := nil;
  FEncryptState := -1;
{$ENDIF}
end;

{$IFNDEF LITE}
function TCRFieldDesc.GetMappedDataType: Word;
begin
  if FOnDemandConverter <> nil then
    Result := FOnDemandConverter.DestDataType
  else
    Result := DataType;
end;
{$ENDIF}

function TCRFieldDesc.ActualNameQuoted(SQLInfo: TSQLInfo; QuoteNames: boolean): string;
begin
  if FActualNameQuoted[QuoteNames] <> '' then
    Result := FActualNameQuoted[QuoteNames]
  else
  begin
    if QuoteNames or SQLInfo.QuotesNeeded(ActualName) then
      Result := SQLInfo.Quote(ActualName)
    else
      Result := ActualName;
    FActualNameQuoted[QuoteNames] := Result;
  end;
end;

procedure TCRFieldDesc.Assign(FieldDesc: TFieldDesc);
begin
  inherited;

{$IFNDEF LITE}
  Assert(FieldDesc is TCRFieldDesc);

  DBType := TCRFieldDesc(FieldDesc).DBType;
  DBLength := TCRFieldDesc(FieldDesc).DBLength;
  DBScale := TCRFieldDesc(FieldDesc).DBScale;
  MapRule := TCRFieldDesc(FieldDesc).MapRule;
  MapLength := TCRFieldDesc(FieldDesc).MapLength;
  MapScale := TCRFieldDesc(FieldDesc).MapScale;
  OnDemandConverter := TCRFieldDesc(FieldDesc).OnDemandConverter;
{$ENDIF}
end;

{ $ENDIF}

{ TCRRecordSet }

constructor TCRRecordSet.Create;
begin
  inherited;

  FAfterExecFetch := nil;
  FAfterFetchAll := nil;

  CreateCommand;
  FTablesInfo := TCRTablesInfo.Create(GetTableInfoClass);
{$IFNDEF LITE}
  FDataTypeMap := CreateDataTypeMap;

  FGetKeyValuesSQL := nil;
  FGetDataValuesSQL := nil;
  FLiveBlockOnSmartFetch := True;
  FFetchedBlocks := TList.Create;
  FTmpFields := TFieldDescs.Create;
{$ENDIF}

  FLongStrings := True;
  FFlatBuffers := True;
end;

destructor TCRRecordSet.Destroy;
begin
  FreeCommand;
  FreeFetchBuffer;

{$IFNDEF LITE}
  FDataTypeMap.Free;
  FFetchedBlocks.Free;
  FTmpFields.Free;
{$ENDIF}
  FTablesInfo.Free;

  inherited;
end;

procedure TCRRecordSet.FreeCommand;
begin
  FCommand.Free;
  SetCommand(nil);
end;

procedure TCRRecordSet.SetCommand(Value: TCRCommand);
begin
  FCommand := Value;
end;

function TCRRecordSet.CanFetchBack: boolean; 
begin
  Result := False;
end;
    
{ Open/Close }

function TCRRecordSet.NeedInitFieldsOnPrepare: boolean;
begin
  Result := FCommand.CommandType = ctCursor;
end;

procedure TCRRecordSet.InternalPrepare;
begin
  FCommand.Prepare;
end;

procedure TCRRecordSet.InternalUnPrepare;
begin
  FCommand.UnPrepare;
end;

procedure TCRRecordSet.InternalOpen(DisableInitFields: boolean = False);
begin
  try
    FNoData := False;

    inherited;

    FEOF := False;

  {$IFNDEF LITE}
    if FSmartFetchState <> sfNone then begin
      Assert(not Prepared);
      FSmartFetchState := sfMetaInfo;
      FOriginalFetchRows := FFetchRows;
      FOriginalFetchAll := FFetchAll;
      FBaseSQL := FCommand.FSQL;
      try
        FFetchAll := True;
        FCommand.FSQL := GetSmartFetchSQL(sfMetaInfo);
        if FCommand.FSQL = '' then
          raise ESmartFetchError.Create(SOnlySelectAllowed);
        CheckFieldDescs;

        FSmartFetchState := sfKeyOnly;
        FCommand.FSQL := GetSmartFetchSQL(sfKeyOnly);
        ExecFetch(False);

        FSmartFetchState := sfDataByKey;
      finally
        FCommand.FSQL := FBaseSQL;
      end;
    end
    else
  {$ENDIF}
      ExecFetch(DisableInitFields);

  except
    if not Prepared then
      InternalUnprepare;

    if FCommand.GetCursorState = csExecuted then
      FCommand.SetCursorState(csInactive);

    raise;
  end
end;

procedure TCRRecordSet.InternalClose;
begin
  FNoData := False;
  FreeFetchBuffer;

{$IFNDEF LITE}
  if FSmartFetchState <> sfNone then begin
    FFetchRows := FOriginalFetchRows;
    FFetchAll := FOriginalFetchAll;
    FSmartFetchState := sfMetaInfo;
    FFetchedBlocks.Clear;
  end;
{$ENDIF}
end;

procedure TCRRecordSet.Prepare;
begin
  if not Prepared then begin

    inherited;

    if NeedInitFieldsOnPrepare then
      try
        InitFields;
        Prepared := True;
      except
        Prepared := False;
        InternalUnPrepare;
        raise;
      end;
  end;
end;

procedure TCRRecordSet.Unprepare;
begin
  try
    inherited;
  finally
    FTablesInfo.Clear;
  end;
end;

procedure TCRRecordSet.Disconnect;
begin
  InternalUnprepare; //Remove all links to DB but not close Data
  Prepared := False; //Set recordset unprepared in case of disconnect mode and
                     //explicit disconnection this will prevent from wrong Prepare state
end;

procedure TCRRecordSet.ExecCommand;
begin
  FCommand.Execute;
  FWaitForFetchBreak := False;
end;

function TCRRecordSet.GetMappedFieldBuf(RecBuf: IntPtr; FieldDesc: TFieldDesc; out DataType: Word; out FieldLength: Integer; out HasParent: boolean; out IsFixed: boolean; out IsBlank, NativeBuffer: boolean): IntPtr;
var
  FieldBuf: IntPtr;
begin
  DataType := FieldDesc.MappedDataType;
  FieldLength := FieldDesc.Length;
  HasParent := FieldDesc.HasParent;
  IsFixed := FieldDesc.Fixed;

  if not FieldDesc.HasParent then begin
    NativeBuffer := True;
    IsBlank := GetNull(FieldDesc, RecBuf);
    if IsBlank then
      Result := nil
    else begin
      FieldBuf := PtrOffset(RecBuf, FieldDesc.Offset);
    {$IFNDEF LITE}
      if TCRFieldDesc(FieldDesc).OnDemandConverter <> nil then begin
        FieldLength := TCRFieldDesc(FieldDesc).MapLength;
        Result := Marshal.AllocHGlobal(GetBufferSize(DataType, FieldLength));
        try
        GetFieldData(FieldDesc, FieldBuf, Result, True);
        except
          Marshal.FreeHGlobal(Result);
          raise;
        end;
        HasParent := False;
        IsFixed := False;
        NativeBuffer := False;
      end
      else
    {$ENDIF}
        Result := FieldBuf;
    end;
  end
  else
    GetChildField(FieldDesc, RecBuf, Result, IsBlank, NativeBuffer);
end;

procedure TCRRecordSet.CloseCommand;
begin
  FCommand.Close;
  FCommand.SetCursorState(csInactive);
  FCommand.CommandType := ctUnknown;
end;

{$IFNDEF LITE}
procedure TCRRecordSet.SetNull(Field: TFieldDesc; RecBuf: IntPtr; Value: boolean);
begin
  inherited;
  SetEncrypted(Field, RecBuf, not Value);
end;

function TCRRecordSet.GetNull(Field: TFieldDesc; RecBuf: IntPtr): boolean;
begin
  CheckFetched(RecBuf, Field);
  Result := inherited GetNull(Field, RecBuf);
end;

procedure TCRRecordSet.CheckFetched(RecBuf: IntPtr; Field: TFieldDesc);
var
  Item: PItemHeader;
begin
  if FSmartFetchState = sfDataByKey then
    if ((Field = nil) or not TCRFieldDesc(Field).IsPrefetched) and not GetFetched(RecBuf) then begin
      Item := GetItemFromRefBuf(RecBuf);
      if IntPtr(Item) = nil then
        Exit;

      if not GetFetched(PtrOffset(Item, SizeOf(TItemHeader))) then
        FetchDataByKey(Item.Block);

      if Item.Flag = flFree then begin
        SetFetched(RecBuf, True);
        WriteItemPtrIntoRecBuf(RecBuf, nil);
        raise ESmartFetchError.Create(SRecordNotFound);
      end;

      if Item.RefCount > 0 then begin
        FreeComplexFields(RecBuf, True);
        BlockMan.GetRecord(Item, RecBuf);
        AddRefComplexFields(RecBuf);
      end
      else
        BlockMan.GetRecord(Item, RecBuf);
    end;
end;
{$ENDIF}

procedure TCRRecordSet.GetFieldData(Field: TFieldDesc; FieldBuf: IntPtr; Dest: IntPtr; NeedConvert: boolean);
{$IFNDEF LITE}
var
  Buf: IntPtr;
  Status: TConvertStatus;
  Value: Variant;
{$ENDIF}
begin
{$IFNDEF LITE}
  Assert(Field is TCRFieldDesc);

  if NeedConvert and (TCRFieldDesc(Field).OnDemandConverter <> nil) then begin
    case Field.DataType of
      dtDateTime: begin
        Buf := Marshal.AllocHGlobal(8);
        GetDateFromBuf(FieldBuf, Buf, Field.HasParent, dfMSecs);
      end;
      dtDate: begin
        Buf := Marshal.AllocHGlobal(4);
        GetDateFromBuf(FieldBuf, Buf, Field.HasParent, dfDate);
      end;
      dtTime: begin
        Buf := Marshal.AllocHGlobal(4);
        GetDateFromBuf(FieldBuf, Buf, Field.HasParent, dfTime);
      end;
      else
        Buf := FieldBuf;
    end;

    try
      try
        Status := TCRFieldDesc(Field).OnDemandConverter.GetDataConverter(FStringHeap, Buf, Field.Length, Field.Scale, Dest, TCRFieldDesc(Field).MapLength, TCRFieldDesc(Field).MapScale, TCRFieldDesc(Field).MapRule.IgnoreErrors);
        if (Status <> csSuccess) and not TCRFieldDesc(Field).MapRule.IgnoreErrors then begin
          GetDataAsVariant(FieldBuf, Field.DataType, Field.SubDataType, Field.Length, Field.HasParent, Field.Fixed, Value);
          raise EDataMappingError.CreateFmt(ConvertStatusErrors[Status], [VarToStr(Value)]);
        end;
      except
        on E: Exception do begin
        {$IFNDEF CLR}
          raise ExceptClass(E.ClassType).Create('Field: ' + Field.Name +  #13#10 + E.Message);
        {$ELSE}
          raise;
        {$ENDIF}
        end;
      end;
    finally
      if Buf <> FieldBuf then
        Marshal.FreeHGlobal(Buf);
    end;
  end
  else
{$ENDIF}
    inherited;
end;

procedure TCRRecordSet.PutFieldData(Field: TFieldDesc; FieldBuf: IntPtr; Source: IntPtr; NeedConvert: boolean; IsDatabaseValue: boolean = False);
{$IFNDEF LITE}
var
  Buf: IntPtr;
  Status: TConvertStatus;
  Value: Variant;
{$ENDIF}
begin
{$IFNDEF LITE}
  Assert(Field is TCRFieldDesc);

  if NeedConvert and (TCRFieldDesc(Field).OnDemandConverter <> nil) then begin
    case Field.DataType of
      dtDateTime: begin
        Buf := Marshal.AllocHGlobal(8);
      end;
      dtDate: begin
        Buf := Marshal.AllocHGlobal(4);
      end;
      dtTime: begin
        Buf := Marshal.AllocHGlobal(4);
      end;
      dtBlob, dtMemo, dtWideMemo: begin
        TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(FieldBuf))).EnableRollback;
        Buf := FieldBuf;
      end
      else
        Buf := FieldBuf;
    end;

    try
      try
        Status := TCRFieldDesc(Field).OnDemandConverter.PutDataConverter(FStringHeap, Source, TCRFieldDesc(Field).MapLength, TCRFieldDesc(Field).MapScale, Buf, Field.Length, Field.Scale, TCRFieldDesc(Field).MapRule.IgnoreErrors);
        if (Status <> csSuccess) and not TCRFieldDesc(Field).MapRule.IgnoreErrors then begin
          GetDataAsVariant(FieldBuf, Field.DataType, Field.SubDataType, Field.Length, Field.HasParent, Field.Fixed, Value);
          raise EDataMappingError.CreateFmt(ConvertStatusErrors[Status], [VarToStr(Value)]);
        end;
      except
        on E: Exception do begin
        {$IFNDEF CLR}
          raise ExceptClass(E.ClassType).Create('Field: ' + Field.Name +  #13#10 + E.Message);
        {$ELSE}
          raise;
        {$ENDIF}
        end;
      end;

      case Field.DataType of
        dtDateTime:
          PutDateToBuf(FieldBuf, Buf, Field.HasParent, dfMSecs);
        dtDate:
          PutDateToBuf(FieldBuf, Buf, Field.HasParent, dfDate);
        dtTime:
          PutDateToBuf(FieldBuf, Buf, Field.HasParent, dfTime);
      end;
    finally
      if Buf <> FieldBuf then
        Marshal.FreeHGlobal(Buf);
    end;
  end
  else
{$ENDIF}
    inherited;
end;

{$IFNDEF FPC}{$IFNDEF VER10P}{$IFNDEF CLR}{$IFNDEF LITE}
function TCRRecordSet.GetSourcePtr(Field: TFieldDesc; Source: IntPtr): IntPtr;
begin
  Assert(Field is TCRFieldDesc);

  if (Source <> nil) and (Pointer(Source^) <> nil) and
     (((TCRFieldDesc(Field).OnDemandConverter = nil) and (Field.DataType in [dtWideString, dtExtWideString])) or
      ((TCRFieldDesc(Field).OnDemandConverter <> nil) and (TCRFieldDesc(Field).MapRule <> nil) and (TCRMapRule(TCRFieldDesc(Field).MapRule).DataType in [dtWideString, dtExtWideString])))
  then
    Result := Pointer(Source^)
  else
    Result := Source;
end;
{$ENDIF}{$ENDIF}{$ENDIF}{$ENDIF}

{$IFNDEF LITE}
procedure TCRRecordSet.SyncKeyFields(KeyFields, OriginFields: TFieldDescs);
var
  KeyField, OriginField: TCRFieldDesc;
  i: integer;
begin
  if KeyFields.Count = 0 then
    raise ESmartFetchError.Create(SNoKeyFields);

  for i := 0 to OriginFields.Count - 1 do begin
    OriginField := TCRFieldDesc(OriginFields[i]);
    OriginField.IsPrefetched := False;
    OriginField.ActualFieldNo := -1;
  end;

  for i := 0 to KeyFields.Count - 1 do begin
    KeyField := TCRFieldDesc(KeyFields[i]);
    OriginField := TCRFieldDesc(OriginFields.FindField(KeyField.Name));

    if OriginField <> nil then begin
      if (OriginField.DBType <> KeyField.DBType) or
        (OriginField.FDBLength <> KeyField.FDBLength) or
        (OriginField.FDBScale <> KeyField.FDBScale) or
        (OriginField.DataType <> KeyField.DataType) or
        (OriginField.ActualName <> KeyField.ActualName) then
        raise ESmartFetchError.Create(SFieldsNotCorresponding);

      OriginField.IsPrefetched := True;
      OriginField.ActualFieldNo := KeyField.ActualFieldNo;
    end
    else
      raise ESmartFetchError.Create(SNoKeyFields);
  end;
end;

procedure TCRRecordSet.SyncDataFields(DataFields, OriginFields: TFieldDescs);
var
  DataField, OriginField: TCRFieldDesc;
  i: integer;
begin
  if DataFields.Count <> OriginFields.Count then
    raise ESmartFetchError.Create(SFieldsNotCorresponding);

  for i := 0 to OriginFields.Count - 1 do begin
    DataField := TCRFieldDesc(DataFields[i]);
    OriginField := TCRFieldDesc(OriginFields[i]);

    if (OriginField.DBType <> DataField.DBType) or
      (OriginField.FDBLength <> DataField.FDBLength) or
      (OriginField.FDBScale <> DataField.FDBScale) or
      (OriginField.DataType <> DataField.DataType) or
      (OriginField.ActualName <> DataField.ActualName) then
      raise ESmartFetchError.Create(SFieldsNotCorresponding);

    OriginField.ActualFieldNo := DataField.ActualFieldNo;
  end;
end;
{$ENDIF}

procedure TCRRecordSet.ClearCachedKeyFieldDescs;
begin
  SetLength(FCachedKeyFieldDescs[False], 0);
  SetLength(FCachedKeyFieldDescs[True], 0);
  FKeyFieldDescsIsCached[False] := False;
  FKeyFieldDescsIsCached[True] := False;
end;

procedure TCRRecordSet.ClearCachedFieldDescs;
begin
  ClearCachedKeyFieldDescs;

  SetLength(FCachedDataFieldDescs[False], 0);
  SetLength(FCachedDataFieldDescs[True], 0);
  FDataFieldDescsIsCached[False] := False;
  FDataFieldDescsIsCached[True] := False;

  FUpdatingTableInfoIdx := -1;
  FIdentityField := nil;
end;

procedure TCRRecordSet.InitUpdatingTableIdx;
var
  NormalizedName: string;
  TableInfo: TCRTableInfo;
  i: integer;
begin
  NormalizedName := FCommand.SQLInfo.NormalizeName(FUpdatingTable);

  FUpdTableIsArtificial := False;
  if FTablesInfo.Count = 0 then begin
    if NormalizedName <> '' then begin
      TableInfo := FTablesInfo.Add;
      TableInfo.TableName := NormalizedName;
      FUpdatingTableInfoIdx := 0;
      FUpdTableIsArtificial := True;
    end
    else
      FUpdatingTableInfoIdx := -1;
  end
  else
  if NormalizedName = '' then // Select default updating table
    FUpdatingTableInfoIdx := 0
  else begin
    i := FTablesInfo.IndexByName(NormalizedName);
    if i = -1 then
      i := FTablesInfo.IndexByAlias(NormalizedName);

    if i = - 1 then
      raise Exception.CreateFmt(SBadUpdatingTable, [NormalizedName]);

    FUpdatingTableInfoIdx := i;
  end;
end;

procedure TCRRecordSet.GetKeyFieldDescs(out KeyFieldDescs: TFieldDescArray;
  ForceUseAllFields: boolean = False);
var
  UseAllKeyFields: boolean;
begin
// ForceUseAllFields parameter is used to generate condition for full refresh
// When ForceUseAllFields is True GetKeyFieldsDesc should return KeyFields from
// all tables (not only updating). If there is no possibility do this (ODAC, IBDAC)
// CanUseAllKeyFields function should return False

  UseAllKeyFields := ForceUseAllFields and CanUseAllKeyFields;
  if FKeyFieldDescsIsCached[UseAllKeyFields] then
    KeyFieldDescs := FCachedKeyFieldDescs[UseAllKeyFields]
  else begin
    FillKeyFieldDescs(KeyFieldDescs, UseAllKeyFields);
    FCachedKeyFieldDescs[UseAllKeyFields] := KeyFieldDescs;
    FKeyFieldDescsIsCached[UseAllKeyFields] := True;
  end;
end;

procedure TCRRecordSet.GetDataFieldDescs(out DataFieldDescs: TFieldDescArray;
  ForceUseAllFields: boolean = False);
begin
  if FDataFieldDescsIsCached[ForceUseAllFields] then
    DataFieldDescs := FCachedDataFieldDescs[ForceUseAllFields]
  else begin
    FillDataFieldDescs(DataFieldDescs, ForceUseAllFields);
    FCachedDataFieldDescs[ForceUseAllFields] := DataFieldDescs;
    FDataFieldDescsIsCached[ForceUseAllFields] := True;
  end;
end;

procedure TCRRecordSet.GetKeyAndDataFields(out KeyAndDataFields: TKeyAndDataFields;
  ForceUseAllFields: boolean);
begin
  GetKeyFieldDescs(KeyAndDataFields.KeyFieldDescs, ForceUseAllFields);
  GetDataFieldDescs(KeyAndDataFields.DataFieldDescs, ForceUseAllFields);
end;

function TCRRecordSet.CanUseAllKeyFields: boolean;
begin
  Result := False;
end;

function TCRRecordSet.IdentityFieldIsData: boolean;
begin
  Result := False;
end;

procedure TCRRecordSet.FillFieldDescs(out FieldDescs: TFieldDescArray;
  const FieldNames: string; CheckFields: boolean);
var
  Pos: integer;
  FieldName: string;
  FieldDesc: TCRFieldDesc;
begin
  SetLength(FieldDescs, 0);

  Pos := 1;
  while Pos <= Length(FieldNames) do begin
    FieldName := ExtractFieldName(FieldNames, Pos);
    FieldName := FCommand.SQLInfo.NormalizeName(FieldName, False, True);
    if FieldName <> '' then begin
      FieldDesc := TCRFieldDesc(FindField(FieldName));
      if FieldDesc <> nil then begin
        SetLength(FieldDescs, Length(FieldDescs) + 1);
        FieldDescs[High(FieldDescs)] := FieldDesc;
      end
      else
        if CheckFields then
          raise Exception.CreateFmt(SFieldNotFound, [FieldName]);
    end;
  end;
end;

procedure TCRRecordSet.FillKeyFieldDescs(out KeyFieldDescs: TFieldDescArray;
  ForceUseAllKeyFields: boolean);
begin
  if FKeyFields <> '' then
    FillFieldDescs(KeyFieldDescs, FKeyFields, True)
  else
  if FIdentityField <> nil then begin
    SetLength(KeyFieldDescs, 1);
    KeyFieldDescs[0] := FIdentityField;
  end
  else
  if UpdatingTableInfo <> nil then begin // Read key fields info from server
    Assert(Assigned(GetDBKeyList));
    FillFieldDescs(KeyFieldDescs, GetDBKeyList(UpdatingTableInfo.TableName, ''), False);
  end;
end;

procedure TCRRecordSet.FillDataFieldDescs(out DataFieldDescs: TFieldDescArray;
  ForceUseAllKeyFields: boolean);

  function CheckField(FieldDesc: TCRFieldDesc): boolean;
  begin
    Result := False;

    if FieldDesc.HasParent or (FieldDesc.FieldDescKind <> fdkData) or
      ((FieldDesc = FIdentityField) and not IdentityFieldIsData)
    then
      Exit;

    if not ForceUseAllKeyFields and
      ((FieldDesc.TableInfo = nil) or (FieldDesc.TableInfo <> UpdatingTableInfo))
    then
      Exit;

    Result := not FieldDesc.ReadOnly;
  end;

  procedure AddFieldDesc(FieldDesc: TCRFieldDesc);
  begin
    SetLength(DataFieldDescs, Length(DataFieldDescs) + 1);
    DataFieldDescs[High(DataFieldDescs)] := FieldDesc;
  end;

var
  i: integer;
  FieldDesc, RootFieldDesc: TCRFieldDesc;
begin
  SetLength(DataFieldDescs, 0);

  for i := 0 to FFields.Count - 1 do begin
    FieldDesc := TCRFieldDesc(FFields[i]);
    // add standard fields if they is found in the dataset
    if FieldDesc.ParentField = nil then begin
      if (FieldDesc.Updateable or (FieldDesc.DataType = dtTable)) and CheckField(FieldDesc) then
        AddFieldDesc(FieldDesc);
    end
    // add object fields
    else begin
      // find root field
      RootFieldDesc := TCRFieldDesc(FieldDesc.ParentField);
      while RootFieldDesc.ParentField <> nil do
        RootFieldDesc := TCRFieldDesc(RootFieldDesc.ParentField);

      // check if root field was added (it is always last)
      if (High(DataFieldDescs) <> -1) and
         (DataFieldDescs[High(DataFieldDescs)] = RootFieldDesc)
      then
        continue;

      // if root has not been added and child field is found in the dataset
      // then add root field to the field list
      if FieldDesc.Updateable and CheckField(RootFieldDesc) then
        AddFieldDesc(RootFieldDesc);
    end;
  end;
end;

function TCRRecordSet.GetUpdatingTableInfo: TCRTableInfo;
begin
  if FUpdatingTableInfoIdx > - 1 then
    Result := FTablesInfo[FUpdatingTableInfoIdx]
  else
    Result := nil;
end;

procedure TCRRecordSet.DetectIdentityField;
var
  UpdTableInfo: TCRTableInfo;
  FieldDesc: TCRFieldDesc;
  i: integer;
begin
  FIdentityField := nil;
  UpdTableInfo := UpdatingTableInfo;
  if UpdTableInfo = nil then
    Exit;

  for i := 0 to FFields.Count - 1 do begin
    FieldDesc := TCRFieldDesc(FFields[i]);
    if (FieldDesc.FieldDescKind = fdkData) and FieldDesc.IsAutoIncrement and
      (FieldDesc.TableInfo = UpdTableInfo) then begin
      FIdentityField := FieldDesc;
      Exit;
    end;
  end;
end;

procedure TCRRecordSet.DetectKeyGeneratorField;
var
  FieldName: string;
  Pos: integer;
begin
  if FKeyFields <> '' then begin
    Pos := 1;
    FieldName := ExtractFieldName(FKeyFields, Pos);
    FieldName := FCommand.SQLInfo.NormalizeName(FieldName, False, True);
    FKeyGeneratorField := TCRFieldDesc(FindField(FieldName));
  end
  else
    ClearKeyGeneratorField;
end;

procedure TCRRecordSet.ClearKeyGeneratorField;
begin
  FKeyGeneratorField := nil;
end;

procedure TCRRecordSet.SetFieldsReadOnly;
var
  FieldDesc: TCRFieldDesc;
  i: integer;
begin
  for i := 0 to FFields.Count - 1 do begin
    FieldDesc := TCRFieldDesc(FFields[i]);
    if FieldDesc.FieldDescKind <> fdkData then
      continue;

    if FSetFieldsReadOnly then begin
      if (FieldDesc.TableInfo = nil) or (FieldDesc.TableInfo <> UpdatingTableInfo) then
        FieldDesc.ReadOnly := True;
    end
    else begin
      FieldDesc.ReadOnly := False;
      if (FieldDesc.TableInfo = nil) or (FieldDesc.TableInfo <> UpdatingTableInfo) then
        FieldDesc.Required := False;
    end;
  end;
end;

procedure TCRRecordSet.SetIdentityField(Value: TCRFieldDesc);
begin
  FIdentityField := Value;
end;

{$IFNDEF LITE}
function TCRRecordSet.GetFetchStateSize: Integer;
begin
  if FSmartFetchState = sfNone then
    Result := 0
  else
    Result := SizeOf(byte);
end;

function TCRRecordSet.GetItemPtrSize: Integer;
begin
  if FSmartFetchState = sfNone then
    Result := 0
  else
    Result := SizeOf(IntPtr);
end;

function TCRRecordSet.GetFetched(RecBuf: IntPtr): boolean;
begin
  if FSmartFetchState <> sfNone then
    Result := boolean(Marshal.ReadByte(RecBuf, FFetchStateOffset))
  else
    Result := True;
end;

procedure TCRRecordSet.SetFetched(RecBuf: IntPtr; Value: boolean);
begin
  if FSmartFetchState <> sfNone then
    Marshal.WriteByte(RecBuf, FFetchStateOffset, byte(Value));
end;

function TCRRecordSet.GetItemFromRefBuf(RecBuf: IntPtr): PItemHeader;
begin
  if (FSmartFetchState <> sfNone) and (RecBuf <> nil) then
    Result := Marshal.ReadIntPtr(RecBuf, FItemPtrOffset)
  else
    Result := nil;
end;

procedure TCRRecordSet.WriteItemPtrIntoRecBuf(RecBuf: IntPtr; Item: PItemHeader);
begin
  if FSmartFetchState <> sfNone then
    Marshal.WriteIntPtr(RecBuf, FItemPtrOffset, Item);
end;

procedure TCRRecordSet.AddRef(RecBuf: IntPtr);
var
  Item: PItemHeader;
begin
  if (FSmartFetchState <> sfNone) and FLiveBlockOnSmartFetch then begin
    Item := GetItemFromRefBuf(RecBuf);
    if IntPtr(Item) <> nil then begin
      Item.RefCount := Item.RefCount + 1;
      Item.Block.RefCount := Item.Block.RefCount + 1;
    end;
  end;
end;

procedure TCRRecordSet.ReleaseRef(RecBuf: IntPtr);
var
  Item: PItemHeader;
begin
  if (FSmartFetchState <> sfNone) and FLiveBlockOnSmartFetch then begin
    Item := GetItemFromRefBuf(RecBuf);
    if IntPtr(Item) <> nil then begin
      Assert(Item.RefCount > 0);
      Item.RefCount := Item.RefCount - 1;
      Item.Block.RefCount := Item.Block.RefCount - 1;
    end;
  end;
end;

function TCRRecordSet.GetFieldValuesForSmartFetch(Field: TFieldDesc): Variant;
var
  Block: PBlockHeader;
  Item: PItemHeader;
  Value: variant;
  i, k: integer;
begin
  Block := PBlockHeader(FFetchedBlocks[0]);
  if Block.UsedItems = 0 then
    raise ESmartFetchError.Create(SNoDataToFetch);

  Result := VarArrayCreate([0, Block.UsedItems - 1], varVariant);
  Item := PtrOffset(Block, SizeOf(TBlockHeader));
  k := 0;
  for i := 0 to Block.ItemCount - 1 do begin
    if Item.Flag = flUsed then begin
      GetFieldAsVariant(Field, PtrOffset(Item, SizeOf(TItemHeader)), Value);
      Result[k] := Value;
      Inc(k);
    end;
    Item := PtrOffset(Item, SizeOf(TItemHeader) + RecordSize);
  end;
end;

procedure TCRRecordSet.FetchDataByKey(Block: PBlockHeader);
var
  FetchedBlock: PBlockHeader;
  Item: PItemHeader;
  i, j: integer;
begin
  if not FLiveBlockOnSmartFetch then
    FFetchedBlocks.Clear
  else
    for j := FFetchedBlocks.Count - 1 downto 0 do begin
      FetchedBlock := PBlockHeader(FFetchedBlocks[j]);
      if FetchedBlock.RefCount = 0 then begin
        ClearBlock(FetchedBlock);
        Item := PtrOffset(FetchedBlock, SizeOf(TBlockHeader));
        for i := 1 to FetchedBlock.ItemCount do begin
          SetFetched(PtrOffset(Item, SizeOf(TItemHeader)), False);
          Item := PtrOffset(Item, SizeOf(TItemHeader) + RecordSize);
        end;
        FFetchedBlocks.Delete(j);
      end;
    end;

  CloseCommand;
  FBaseSQL := FCommand.FSQL;
  try
    FFetchedBlocks.Insert(0, Block);
    FCommand.FSQL := GetSmartFetchSQL(sfDataByKey);
    ExecFetch(False);
  finally
    FCommand.FSQL := FBaseSQL;
  end;
end;
{$ENDIF}

function TCRRecordSet.NeedInitFieldsOnFetch: boolean;
begin
  Result := False;
end;

procedure TCRRecordSet.CheckFieldDescs;
{$IFNDEF LITE}
var
  FOldFields: TFieldDescs;
{$ENDIF}
begin
{$IFNDEF LITE}
  case FSmartFetchState of
    sfNone:
      InitFields;

    sfMetaInfo: begin
      FDataFieldsWasSynchronized := False;
      InitFields;
      if Assigned(FillExtFieldsInfo) then
        FillExtFieldsInfo;
    end;

    sfKeyOnly: begin
      FOldFields := FFields;
      try
        FFields := FTmpFields;
        CreateFieldDescs;
        SyncKeyFields(FTmpFields, FOldFields);
      finally
        FFields := FOldFields;
        FTmpFields.Clear;
      end;
    end;

    sfDataByKey: begin
      if not FDataFieldsWasSynchronized then begin
        FOldFields := FFields;
        try
          FFields := FTmpFields;
          CreateFieldDescs;
          SyncDataFields(FTmpFields, FOldFields);
        finally
          FFields := FOldFields;
          FTmpFields.Clear;
        end;

        FDataFieldsWasSynchronized := True;
      end;
    end;
  else
    Assert(False);
  end;
{$ELSE}
  InitFields;
{$ENDIF}
end;

procedure TCRRecordSet.ExecFetch(DisableInitFields: boolean);
begin
  ExecCommand;
  if not DisableInitFields and
    (not Prepared or (FFields.Count = 0) or NeedInitFieldsOnFetch)
  then
    CheckFieldDescs;

{$IFNDEF LITE}
  if (FSmartFetchState <> sfNone) or not FDisableFetchOnOpening then
{$ENDIF}
    if FFetchAll then
      FetchAll
    else
      Fetch;
end;

procedure TCRRecordSet.BreakFetch; // Breaks fetch. Can be called from other thread or in non-blocking mode
begin
  FWaitForFetchBreak := True;
end;

procedure TCRRecordSet.AllocFetchBuffer;
begin
end;

procedure TCRRecordSet.FreeFetchBuffer;
begin
  if FFetchBuffer <> nil then begin
    Marshal.FreeHGlobal(FFetchBuffer);
    FFetchBuffer := nil;
  end;
  FFetchBufferSize := 0;
end;

procedure TCRRecordSet.FetchBlock(Block: PBlockHeader; FetchBack: boolean; out RowsObtained: Integer);
begin
  RowsObtained := 0;
end;

procedure TCRRecordSet.ProcessFetchedBlock(Block: PBlockHeader; FetchBack: boolean);
begin
end;

procedure TCRRecordSet.ProcessNoResult(FetchBack: boolean);
begin
  FreeFetchBuffer;
end;

function TCRRecordSet.ProcessFetchedException(E: Exception): boolean;
begin
  Result := False;
end;

function TCRRecordSet.FetchingAccessible(FetchBack: boolean): boolean;
begin
  Result := True;
end;

function TCRRecordSet.InternalFetch(FetchBack: boolean): boolean;
var
  pHBlock: PBlockHeader;
  RowsObtained: Integer;
  NewBlock{$IFNDEF LITE}, StandAloneBlock{$ENDIF}: Boolean;
  OldFirstItem: IntPtr;
  OldLastItem: IntPtr;
begin
  Result := False;

  if FCommand.GetCursorState < csFetching then
    FCommand.SetCursorState(csFetching);

{$IFNDEF LITE}
  StandAloneBlock := FSmartFetchState = sfDataByKey;
{$ENDIF}

  if not FetchingAccessible(FetchBack) then begin
  {$IFNDEF LITE}
    if StandAloneBlock then
      SyncWithCurrentBlock(nil);
  {$ENDIF}
    Exit;
  end;

  if not FFetchToOuterBuffer then begin
    NewBlock := (IntPtr(BlockMan.FirstBlock) = nil) or (not FUniDirectional and not CanFetchBack) {$IFNDEF LITE}or StandAloneBlock{$ENDIF};
    if NewBlock then begin
      BlockMan.AllocBlock(pHBlock, FFetchRows{$IFNDEF LITE}, StandAloneBlock{$ENDIF});
      if IntPtr(FFetchBuffer) = nil then
        AllocFetchBuffer;
    end
    else begin
      phBlock := BlockMan.FirstBlock; // overwrite data in unidirectional or scrollable mode
      ClearBlock(phBlock);
    end;
    InitBlock(phBlock);
  end
  else
    phBlock := nil;

  OldFirstItem := FirstItem;
  OldLastItem := LastItem;
  try
    FetchBlock(pHBlock, FetchBack, RowsObtained);
    Result := RowsObtained > 0;

    if Result then begin
      CreateBlockStruct(pHBlock, RowsObtained, FetchBack{$IFNDEF LITE}, StandAloneBlock{$ENDIF});
    {$IFNDEF LITE}
      if StandAloneBlock then begin
        SyncWithCurrentBlock(pHBlock);
        ClearBlock(pHBlock);
        BlockMan.FreeBlock(pHBlock, StandAloneBlock);
      end;
    {$ENDIF}

      ProcessFetchedBlock(pHBlock, FetchBack);

      if FCommand.GetCursorState in [csFetched, csInactive] then
        FreeFetchBuffer;
    end
    else begin
    {$IFNDEF LITE}
      if StandAloneBlock then
        SyncWithCurrentBlock(nil);
    {$ENDIF}

      ClearBlock(pHBlock);
      BlockMan.FreeBlock(pHBlock{$IFNDEF LITE}, StandAloneBlock{$ENDIF});
      ProcessNoResult(FetchBack);
    end;

  except
    on E: Exception do begin
      ClearBlock(pHBlock);
      // BlockMan.FirstBlock = nil means that dataset was closed after some
      // fatal error and all blocks are already freed
      if IntPtr(BlockMan.FirstBlock) <> nil then begin
        BlockMan.FreeBlock(pHBlock{$IFNDEF LITE}, StandAloneBlock{$ENDIF});
        // restore first and last items
        FirstItem := OldFirstItem;
        LastItem := OldLastItem;
        if IntPtr(FirstItem) <> nil then
          FirstItem.Prev := nil;
        if IntPtr(LastItem) <> nil then
          LastItem.Next := nil;
      end;

      if not ProcessFetchedException(E) then
        raise;
    end;
  end;
end;

function TCRRecordSet.Fetch(FetchBack: boolean = False): boolean;
var
  Cancel: boolean;
  OldCommandType: TCommandType;
begin
  Result := False;

  if not (FCommand.GetCursorState in [csFetched, csInactive]) then begin
    DoBeforeFetch(Cancel);
    if Cancel then
      Exit;
    try
      try
        Result := InternalFetch(FetchBack);
      except
        if FetchBack then
          FBOF := True
        else
          FEOF := True;
        raise;
      end;
    finally
      DoAfterFetch;
    end;
  end;

  if FCommand.GetCursorState = csFetched then
    if NeedUnPrepareAfterFetch then begin
      OldCommandType := FCommand.CommandType;
      InternalUnPrepare;
      // We need to save old CommandType to save old FieldDescs on Refresh
      FCommand.CommandType := OldCommandType;
      Prepared := False;
    end;
end;

function TCRRecordSet.NeedUnPrepareAfterFetch: boolean;
begin
  Result := False;
end;

{ Fields }

function TCRRecordSet.NeedConvertEOL: boolean;
begin
  if (FCommand = nil) or (FCommand.FConnection = nil) then
    Result := False
  else
    Result := FCommand.FConnection.FConvertEOL;
end;

function TCRRecordSet.GetFieldDescType: TFieldDescClass;
begin
  Result := TCRFieldDesc;
end;

{$IFNDEF LITE}
function TCRRecordSet.IsEqualDataTypes(Field: TFieldDesc; MapRule: TCRMapRule): boolean;
begin
  if Field.DataType = MapRule.DataType then
    if Field.DataType in [dtString, dtExtString, dtWideString, dtExtWideString, dtBytes, dtVarBytes, dtExtVarBytes] then
      Result := ((MapRule.FieldLength = -1) or (MapRule.FieldLength = Field.Length))
    else if Field.DataType in [dtBCD {$IFDEF VER6P}{$IFNDEF FPC},dtFMTBcd{$ENDIF}{$ENDIF}] then
      Result := ((MapRule.FieldLength = -1) or (MapRule.FieldLength = Field.Length)) and
                ((MapRule.FieldScale  = -1) or (MapRule.FieldScale = Field.Scale))
    else
      Result := True
  else
    Result := False;
end;

{$IFDEF ODBC_DRIVER}
function TCRRecordSet.IsEqualDataTypes(Param: TParamDesc; MapRule: TCRMapRule): boolean;
begin
  if Param.DataType = MapRule.DataType then
    if Param.DataType in [dtString, dtExtString, dtWideString, dtExtWideString, dtBytes, dtVarBytes, dtExtVarBytes] then
      Result := ((MapRule.FieldLength = -1) or (MapRule.FieldLength = Param.GetSize))
    else if Param.DataType in [dtBCD {$IFDEF VER6P}{$IFNDEF FPC},dtFMTBcd{$ENDIF}{$ENDIF}] then
      Result := ((MapRule.FieldLength = -1) or (MapRule.FieldLength = Param.GetSize))
    else
      Result := True
  else
    Result := False;
end;
{$ENDIF}

function TCRRecordSet.GetDataTypeName(Field: TCRFieldDesc): string;
var
  DBTypeInfo: TDBTypeInfo;
begin
  DBTypeInfo := DBTypeInfos.FindTypeInfo(Field.DBType);
  if DBTypeInfo <> nil then
    Result := DBTypeInfo.Name
  else
    Result := IntToStr(Field.DataType);
end;

procedure TCRRecordSet.InitRecordSize;
var
  Align: integer;
begin
  InitEncryption;

  FEncryptStateOffset := FDataSize + GetIndicatorSize;
  FFetchStateOffset := FEncryptStateOffset + GetEncryptStateSize;
  FItemPtrOffset := FFetchStateOffset + GetFetchStateSize;

  FRecordSize := FDataSize + GetIndicatorSize + GetEncryptStateSize + GetFetchStateSize + GetItemPtrSize;
  Align := FRecordSize and 1;
  FRecordSize := FRecordSize + Align; // align 2
end;

procedure TCRRecordSet.InitFields;
var
  i: integer;
  FieldDesc: TCRFieldDesc;
  OnDemandConverter: TOnDemandConverter;
  MapRule: TCRMapRule;
begin
  inherited;

  // Data Type Mapping Init
  if FDataTypeMap.Enabled then
    for i := 0 to FFields.Count - 1 do begin
      FieldDesc := FFields[i] as TCRFieldDesc;
      FieldDesc.MapRule := nil;
      FieldDesc.OnDemandConverter := nil;

      OnDemandConverter := GetMapOnDemandConverter(FieldDesc, MapRule);

      if (MapRule <> nil) and (not IsEqualDataTypes(FieldDesc, MapRule)) then
        if OnDemandConverter <> nil then begin
          FieldDesc.MapRule := MapRule;
          FieldDesc.OnDemandConverter := OnDemandConverter;

          if MapRule.FieldLength > -1 then
            FieldDesc.MapLength := MapRule.FieldLength
          else if Assigned(OnDemandConverter.CalcLength) then begin
            FieldDesc.MapLength := FieldDesc.Length;
            FieldDesc.MapLength := OnDemandConverter.CalcLength(FieldDesc.MapLength);
          end
          else if OnDemandConverter.DestDataType in [dtString, dtExtString, dtWideString, dtExtWideString, dtBytes, dtVarBytes, dtExtVarBytes] then
            FieldDesc.MapLength := 20
          else
            FieldDesc.MapLength := FieldDesc.Length;

          if MapRule.FieldScale > -1 then
            FieldDesc.MapScale := MapRule.FieldScale
          else if Assigned(OnDemandConverter.CalcScale) then begin
            FieldDesc.MapScale := FieldDesc.Scale;
            FieldDesc.MapScale := OnDemandConverter.CalcScale(FieldDesc.MapScale);
          end
          else
            FieldDesc.MapScale := FieldDesc.Scale;
        end
        // to raise exception at DA level
        else if OnDemandConverter = nil then
          FieldDesc.MapRule := MapRule;
    end;
end;

procedure TCRRecordSet.InitEncryption;
var
  i, k: integer;
  sl: TStrings;
  FieldDesc: TCRFieldDesc;
begin
  if (FEncryptor <> nil) and (FEncryptedFields <> '') then begin
    sl := TStringList.Create;
    try
      FCommand.SQLInfo.NamesToList(FEncryptedFields, sl);

      k := 0;
      for i := 0 to FFields.Count - 1 do begin
        FieldDesc := FFields[i] as TCRFieldDesc;
        if (sl.IndexOf(FieldDesc.Name) > -1) or (sl.IndexOf(FieldDesc.ActualName) > -1) then begin
          if (FieldDesc.FieldDescKind = fdkCalculated) or
             FieldDesc.HasParent or
             not IsEncryptableDataType(FieldDesc.DataType)
          then
            raise Exception.CreateFmt(SEncryptionNotSupported, [GetDataTypeName(FieldDesc)]);

          FieldDesc.Encryptor := TCREncryptorUtils.Encryptor(FEncryptor);
          FieldDesc.Decryptor := TCREncryptorUtils.Decryptor(FEncryptor);
          FieldDesc.EncryptState := ((k shr 3) shl 8) or (1 shl (k mod 8));
          Inc(k);
        end;
      end;
    finally
      sl.Free;
    end;
  end;
end;

function TCRRecordSet.IsEncryptableDataType(DataType: Word): boolean;
begin
  Result := DataType in [dtString, dtExtString, dtWideString, dtExtWideString,
    {dtBytes,} dtVarBytes, dtExtVarBytes, dtBlob, dtMemo, dtWideMemo];
end;

function TCRRecordSet.GetDecryptDataType(DataType: Word): Word;
begin
  Result := DataType;
end;

function TCRRecordSet.GetEncryptStateSize: Integer;
var
  i, k: integer;
begin
  k := 0;
  for i := 0 to FFields.Count - 1 do
    if Assigned(TCRFieldDesc(FFields[i]).Decryptor) then
      Inc(k);

  if k > 0 then
    Result := (k - 1) shr 3 + 1
  else
    Result := 0;
end;

function TCRRecordSet.GetEncrypted(Field: TFieldDesc; RecBuf: IntPtr): boolean;
var
  EncryptState: Integer;
  EncryptBuf: IntPtr;
  EncryptBitMask, CurrentEncryptState: Byte;
begin
  EncryptState := (Field as TCRFieldDesc).EncryptState;
  if EncryptState >= 0 then begin
    EncryptBuf := PtrOffset(RecBuf, FEncryptStateOffset);
    EncryptBitMask := Byte(ShortInt(EncryptState));
    CurrentEncryptState := Marshal.ReadByte(EncryptBuf, EncryptState shr 8);
    Result := CurrentEncryptState and EncryptBitMask <> 0;
  end
  else
    Result := False;
end;

procedure TCRRecordSet.SetEncrypted(Field: TFieldDesc; RecBuf: IntPtr; Value: boolean);
var
  EncryptState: Integer;
  EncryptBuf: IntPtr;
  EncryptBitMask, CurrentEncryptState: Byte;
begin
  EncryptState := (Field as TCRFieldDesc).EncryptState;
  if EncryptState >= 0 then begin
    EncryptBuf := PtrOffset(RecBuf, FEncryptStateOffset);
    EncryptBitMask := Byte(ShortInt(EncryptState));
    CurrentEncryptState := Marshal.ReadByte(EncryptBuf, EncryptState shr 8);
    if Value then
      CurrentEncryptState := CurrentEncryptState or EncryptBitMask
    else
      CurrentEncryptState := CurrentEncryptState and not EncryptBitMask;
    Marshal.WriteByte(EncryptBuf, EncryptState shr 8, CurrentEncryptState);
  end;
end;

procedure TCRRecordSet.DecryptBuffer(Item: PItemHeader);
var
  RecBuf, ValueBuf: IntPtr;
  FieldDesc: TCRFieldDesc;
  DataType, CryptType: Word;
  DataLen: Cardinal;
  Blob: TBlob;
  s: AnsiString;
  ws: WideString;
  DecryptedWithoutError: boolean;
  i: integer;
begin
  Assert(Assigned(FEncryptor));

  RecBuf := PtrOffset(Item, SizeOf(TItemHeader));
  FillChar(PtrOffset(RecBuf, FEncryptStateOffset), GetEncryptStateSize, 0);
  for i := 0 to FFields.Count - 1 do begin
    FieldDesc := FFields[i] as TCRFieldDesc;
    if (not Assigned(FieldDesc.Decryptor)) or GetNull(FieldDesc, RecBuf) then
      continue;

    DataType := GetDecryptDataType(FieldDesc.DataType);
    ValueBuf := PtrOffset(RecBuf, FieldDesc.Offset);
    DataLen := FieldDesc.Length;

    case DataType of
      dtString: begin
        CryptType := dtString;
      end;
      dtExtString: begin
        ValueBuf := Marshal.ReadIntPtr(ValueBuf);
        CryptType := dtString;
      end;
      dtWideString: begin
        CryptType := dtWideString;
      end;
      dtExtWideString: begin
        ValueBuf := Marshal.ReadIntPtr(ValueBuf);
        CryptType := dtWideString;
      end;
      dtBytes: begin
        CryptType := dtBytes;
      end;
      dtVarBytes: begin
        DataLen := Word(Marshal.ReadInt16(ValueBuf));
        ValueBuf := PtrOffset(ValueBuf, SizeOf(Word));
        CryptType := dtBytes;
      end;
      dtExtVarBytes: begin
        ValueBuf := Marshal.ReadIntPtr(ValueBuf);
        DataLen := Word(Marshal.ReadInt16(ValueBuf));
        ValueBuf := PtrOffset(ValueBuf, SizeOf(Word));
        CryptType := dtBytes;
      end;
      dtMemo, dtWideMemo: begin
        Blob := TBlob(InternalGetObject(FieldDesc, RecBuf));
        if Blob.IsUnicode then begin
          ws := Blob.AsWideString;
          DataLen := Length(ws);
          if DataLen > 0 then
            ValueBuf := Marshal.StringToHGlobalUni(ws)
          else
            ValueBuf := nil;
          CryptType := dtWideString;
        end
        else begin
          s := Blob.AsAnsiString;
          DataLen := LengthA(s);
          if DataLen > 0 then
            ValueBuf := Marshal.StringToHGlobalAnsi(s)
          else
            ValueBuf := nil;
          CryptType := dtString;
        end;
      end;
      dtBlob: begin
        Blob := TBlob(InternalGetObject(FieldDesc, RecBuf));
        ValueBuf := Blob.GCHandle;
        DataLen := GetBlobSize(FieldDesc, RecBuf);
        CryptType := dtBlob;
      end;
    else
      raise Exception.CreateFmt(SEncryptionNotSupported, [GetDataTypeName(FieldDesc)]);
    end;

    if DataLen > 0 then begin
      DecryptedWithoutError := FieldDesc.Decryptor(ValueBuf, CryptType, DataLen);

      case DataType of
        dtString, dtExtString: begin
          Marshal.WriteByte(ValueBuf, DataLen, Byte(#0));
        end;
        dtWideString, dtExtWideString: begin
          Marshal.WriteInt16(ValueBuf, DataLen, Word(#0));
        end;
        dtVarBytes, dtExtVarBytes:
          Marshal.WriteInt16(PtrOffset(ValueBuf, - SizeOf(Word)), SmallInt(Word(DataLen)));
        dtMemo, dtWideMemo: begin
          Blob := TBlob(InternalGetObject(FieldDesc, RecBuf));
          if Blob.IsUnicode then begin
            Marshal.WriteInt16(ValueBuf, DataLen, Word(#0));
            ws := Marshal.PtrToStringUni(ValueBuf, DataLen div SizeOf(WideChar));
            Marshal.FreeCoTaskMem(ValueBuf);
            Blob.AsWideString := ws;
          end
          else begin
            Marshal.WriteByte(ValueBuf, DataLen, Byte(#0));
            s := Marshal.PtrToStringAnsi(ValueBuf, DataLen);
            Marshal.FreeCoTaskMem(ValueBuf);
            Blob.AsAnsiString := s;
          end;
          Blob.Commit;
        end;
        dtBlob: begin
          if DataLen = 0 then begin
            Blob := TBlob(InternalGetObject(FieldDesc, RecBuf));
            Blob.Clear;
          end;
        end;
      end;

      if not DecryptedWithoutError and (DataLen = 0) then
        SetNull(FieldDesc, RecBuf, True)
      else
        SetEncrypted(FieldDesc, RecBuf, DecryptedWithoutError);
    end;
  end;
end;
{$ENDIF}

procedure TCRRecordSet.InitFetchedBlock(Block: PBlockHeader; RowsObtained: Integer; FetchBack: boolean);
begin
  if Filtered and not FFetchAll then begin
    if FetchBack then
      InitFetchedItems(PtrOffset(Block, SizeOf(TBlockHeader) + (RowsObtained - 1) * (SizeOf(TItemHeader) + RecordSize)), FNoData, FetchBack)
    else
      InitFetchedItems(PtrOffset(Block, SizeOf(TBlockHeader)), FNoData, FetchBack);
  end
  else
    if not (FetchBack or FNoData) then
      Inc(FRecordCount, RowsObtained);
end;

procedure TCRRecordSet.CreateBlockStruct(Block: PBlockHeader; RowsObtained: Integer; FetchBack: boolean = False{$IFNDEF LITE}; StandAloneBlock: Boolean = False{$ENDIF});
var
  Item, FirstBlockItem, LastBlockItem{$IFNDEF LITE}, NextItem{$ENDIF}: PItemHeader;
  ItemSize: integer;
  i: integer;
begin
  Assert(not FFetchToOuterBuffer);

  // Create Items
  ItemSize := RecordSize + SizeOf(TItemHeader);
  FirstBlockItem := PtrOffset(Block, SizeOf(TBlockHeader));
  LastBlockItem := PtrOffset(Block, SizeOf(TBlockHeader) + (RowsObtained - 1) * ItemSize);
  Item := FirstBlockItem;

  for i := 1 to RowsObtained do begin
    Item.Block := Block;
    Item.Flag := flUsed;
    Item.Rollback := nil;
    Item.Status := isUnmodified;
    Item.UpdateResult := urNone;
    Item.FilterResult := fsNotChecked;
    Item.RefCount := 0;
  {$IFNDEF LITE}
    SetFetched(PtrOffset(Item, SizeOf(TItemHeader)), False);
    WriteItemPtrIntoRecBuf(PtrOffset(Item, SizeOf(TItemHeader)), Item);
  {$ENDIF}
    Item := PtrOffset(Item, ItemSize);
  end;

  // Free items
  for i := RowsObtained + 1 to Block.ItemCount do begin
    Item.Prev := nil;
    Item.Next := BlockMan.FirstFree;
    Item.Block := Block;
    Item.Flag := flFree;
    Item.Rollback := nil;
    Item.Status := isUnmodified;
    Item.UpdateResult := urNone;

    if {$IFNDEF LITE}not StandAloneBlock{$ELSE}True{$ENDIF} then begin
      if IntPtr(BlockMan.FirstFree) <> nil then
        BlockMan.FirstFree.Prev := Item;
      BlockMan.FirstFree := Item;
    end;

    // Free complex fields
    if HasComplexFields then
      FreeComplexFields(PtrOffset(Item, SizeOf(TItemHeader)), True);

    Item := PtrOffset(Item, ItemSize);
  end;
  Block.UsedItems := RowsObtained;

  // Init items
{$IFNDEF LITE}
  if StandAloneBlock then begin
    Item := FirstBlockItem;
    for i := 1 to RowsObtained - 1 do begin
      NextItem := PtrOffset(Item, ItemSize);
      NextItem.Prev := Item;
      Item.Next := NextItem;
      Item := NextItem;
    end;
    FirstBlockItem.Prev := nil;
    LastBlockItem.Next := nil;
  end
  else
{$ENDIF}
  begin
    if FetchBack then begin
      Item := LastBlockItem;
      if IntPtr(LastItem) = nil then
        LastItem := Item;
      for i := RowsObtained downto 1 do begin
        Item.Prev := nil;
        Item.Next := FirstItem;

        if IntPtr(FirstItem) <> nil then begin
          FirstItem.Prev := Item;
          Item.Order := FirstItem.Order - 1;
        end
        else
          Item.Order := FRecordCount;

        FirstItem := Item;
        Item := PtrOffset(Item, - ItemSize);
      end;
    end
    else begin
      Item := FirstBlockItem;
      if IntPtr(FirstItem) = nil then
        FirstItem := Item;
      for i := 1 to RowsObtained do begin
        Item.Prev := LastItem;
        Item.Next := nil;

        if IntPtr(LastItem) <> nil then begin
          LastItem.Next := Item;
          Item.Order := LastItem.Order + 1;
        end
        else
          Item.Order := 1;

        LastItem := Item;
        Item := PtrOffset(Item, ItemSize);
      end;
    end;

    FirstItem.Prev := nil;
    LastItem.Next := nil;

    UpdateCachedBuffer(FirstBlockItem, LastBlockItem);
    InitFetchedBlock(Block, RowsObtained, FetchBack);

    if Block.ItemCount > RowsObtained then
      if not FetchBack then
        FNoData := True;
  end;

{$IFNDEF LITE}
  // Decrypt items
  if FEncryptor <> nil then begin
    Item := FirstBlockItem;
    for i := 1 to RowsObtained do begin
      DecryptBuffer(Item);
      Item := Item.Next;
    end;
  end;
{$ENDIF}
end;

procedure TCRRecordSet.InitBlock(Block: PBlockHeader);
var
  i, j: integer;
  Item: PItemHeader;
  FieldDesc: TFieldDesc;
begin
  if HasComplexFields then begin
    Item := PtrOffset(Block, SizeOf(TBlockHeader) + SizeOf(TItemHeader));

    for i := 1 to Block.ItemCount do begin
      for j := 0 to FFields.Count - 1 do begin
        FieldDesc := FFields[j];
        if FieldDesc.IsComplex and not FieldDesc.HasParent and (FieldDesc.FieldDescKind <> fdkCalculated) then
          Marshal.WriteIntPtr(Item, FieldDesc.Offset, nil);
      end;

      Item := PtrOffset(Item, SizeOf(TItemHeader) + RecordSize);
    end;
  end;
end;

procedure TCRRecordSet.ClearBlock(Block: PBlockHeader);
var
  Item: PItemHeader;
  i: integer;
begin
  if HasComplexFields then begin
    Item := PtrOffset(Block, SizeOf(TBlockHeader) + SizeOf(TItemHeader));
    for i := 1 to Block.ItemCount do begin
      // this condition doesn't allow to free Complex fields in ODAC
      //if Item.Flag <> flFree then
      FreeComplexFields(Item, True);
      Item := PtrOffset(Item, SizeOf(TItemHeader) + RecordSize);
    end;
  end;
end;

{$IFNDEF LITE}
procedure TCRRecordSet.SyncWithCurrentBlock(NewBlock: PBlockHeader);
var
  Item, CurItem, NewItem: PItemHeader;
  CurRecBuf, NewRecBuf: IntPtr;
  i, j, k: integer;
  ItemFound: boolean;
  ItemsToDelete: array of PItemHeader;
  ItemsIsFound: TBooleanArray;
  KeyFieldDescs: TFieldDescArray;
begin
  CurItem := PtrOffset(IntPtr(FFetchedBlocks[0]), SizeOf(TBlockHeader));
  NewItem := PtrOffset(NewBlock, SizeOf(TBlockHeader));
  SetLength(ItemsToDelete, 0);

  if IntPtr(NewBlock) <> nil then begin
    SetLength(ItemsIsFound, NewBlock.ItemCount);
  {$IFNDEF CLR}
    FillChar(ItemsIsFound, NewBlock.ItemCount, 0);
  {$ENDIF}
    GetKeyFieldDescs(KeyFieldDescs);
  end;

  for i := 1 to PBlockHeader(FFetchedBlocks[0]).ItemCount do begin
    if CurItem.Flag = flUsed then begin
      ItemFound := False;
      if IntPtr(NewBlock) <> nil then begin
        CurRecBuf := PtrOffset(CurItem, SizeOf(TItemHeader));
        Item := NewItem;
        for j := 0 to NewBlock.UsedItems - 1 do begin
          if not ItemsIsFound[j] then begin
            NewRecBuf := PtrOffset(Item, SizeOf(TItemHeader));
            ItemFound := True;
            for k := 0 to High(KeyFieldDescs) do
              if CompareFields(CurRecBuf, NewRecBuf, KeyFieldDescs[k], []) <> 0 then begin
                ItemFound := False;
                Break;
              end;

            if ItemFound then begin
              ItemsIsFound[j] := True;
              Break;
            end;
          end;
          Item := Item.Next;
        end;

        if ItemFound then begin
          FreeComplexFields(CurRecBuf, True);
          BlockMan.CopyRecord(Item, CurItem);
          AddRefComplexFields(PtrOffset(Item, SizeOf(TItemHeader)));
          SetFetched(CurRecBuf, True); // need because CopyRecord rewrite this state
          WriteItemPtrIntoRecBuf(CurRecBuf, CurItem); // need because CopyRecord rewrite this Ptr

          CurItem.Flag := flUsed;
          CurItem.Rollback := nil;
          CurItem.Status := isUnmodified;
          CurItem.UpdateResult := urNone;
          CurItem.FilterResult := fsNotChecked;
        end;
      end;

      if not ItemFound then begin
        SetLength(ItemsToDelete, Length(ItemsToDelete) + 1);
        ItemsToDelete[High(ItemsToDelete)] := CurItem;
      end;
    end;

    CurItem := PtrOffset(CurItem, SizeOf(TItemHeader) + RecordSize);
  end;

  for i := 0 to High(ItemsToDelete) do begin
    CurItem := ItemsToDelete[i];
    if IntPtr(CurItem.Next) = nil then
      NewItem := CurItem.Prev
    else
      NewItem := CurItem.Next;

    DeleteItem(CurItem);
    Dec(FRecordCount);
    ReorderItems(NewItem, roDelete);
  end;
end;
{$ENDIF}

procedure TCRRecordSet.DoBeforeFetch(out Cancel: boolean);
begin
  Cancel := FWaitForFetchBreak;

  if Assigned(FOnBeforeFetch) then
    FOnBeforeFetch(Cancel);

  if Cancel then begin
    // reset cursor state for FetchAll
    if (FCommand.GetCursorState = csFetchingAll) then
      FCommand.SetCursorState(csFetching);
  end;
end;

procedure TCRRecordSet.DoAfterFetch;
begin
  if Assigned(FOnAfterFetch) then
    FOnAfterFetch;
end;

procedure TCRRecordSet.SortItems;
begin
  if Length(IndexFields) = 0 then
    Exit;
  FetchAll;

  inherited SortItems;
end;

{ Records }

procedure TCRRecordSet.InitRecord(RecBuf: IntPtr);
begin
  inherited;
{$IFNDEF LITE}
  SetFetched(RecBuf, True);
{$ENDIF}
end;

procedure TCRRecordSet.PutRecord(RecBuf: IntPtr);
begin
  inherited;
{$IFNDEF LITE}
  WriteItemPtrIntoRecBuf(RecBuf, CurrentItem);
{$ENDIF}
end;

procedure TCRRecordSet.GetNextRecord(RecBuf: IntPtr);
var
  Found: boolean;
  Item: PItemHeader;
begin
  if not EOF then begin
    if IntPtr(FirstItem) = nil then begin
      if not Fetch then begin
        FEOF := True;
        Exit;
      end
      else
        CurrentItem := FirstItem;
    end
    else
      if IntPtr(CurrentItem) = nil then
        CurrentItem := FirstItem
      else
        CurrentItem := CurrentItem.Next;

    repeat
      if IntPtr(CurrentItem) = nil then begin
        Item := LastItem;

        if not Fetch then begin
          FEOF := True;
          Exit;
        end
        else begin
          if FUniDirectional or CanFetchBack then begin
            FirstItem.Prev := nil;  // remove cycle link
            LastItem.Next := nil;
          end;
          if (IntPtr(Item.Next) = nil) or FUniDirectional then
            CurrentItem := FirstItem
          else
            CurrentItem := Item.Next;
        end
      end;

      Found := not OmitRecord(CurrentItem);
      if not Found then
        CurrentItem := CurrentItem.Next;
    until Found;

    FBOF := False;
    FEOF := False;
    if RecBuf <> nil then
      GetRecord(RecBuf);
  end;
end;

procedure TCRRecordSet.GetPriorRecord(RecBuf: IntPtr);
var
  Found: boolean;
  Item: PItemHeader;
begin
  if FUniDirectional then begin
    FBOF := True;
    CurrentItem := nil;
  end
  else
    if not CanFetchBack then
      inherited
    else
      if not BOF then begin
        if IntPtr(LastItem) = nil then begin
          if not Fetch(True){FetchBack!} then begin
            FBOF := True;
            Exit;
          end
          else
            CurrentItem := LastItem;
        end
        else
          if IntPtr(CurrentItem) = nil then
            CurrentItem := LastItem
          else
            CurrentItem := CurrentItem.Prev;

        repeat
          if IntPtr(CurrentItem) = nil then begin
            Item := FirstItem;

            if not Fetch(True){FetchBack!} then begin
              FBOF := True;
              Exit;
            end
            else begin
              FirstItem.Prev := nil;  // remove cycle link
              LastItem.Next := nil;
              if IntPtr(Item.Prev) = nil then
                CurrentItem := LastItem
              else
                CurrentItem := Item.Prev;
            end;
          end;

          Found := not OmitRecord(CurrentItem);
          if not Found then
            CurrentItem := CurrentItem.Prev;
        until Found;

        FBOF := False;
        FEOF := False;
        if RecBuf <> nil then
          GetRecord(RecBuf);
      end;
end;

{ Fetch }

procedure TCRRecordSet.FetchAll;
begin
  while Fetch do;
end;

function TCRRecordSet.CanDisconnect: boolean;
var
  CursorState: TCursorState;
begin
  Assert(FCommand <> nil);
  CursorState := FCommand.GetCursorState;
  Result := (CursorState = csInactive) or (CursorState = csFetched);
end;

function TCRRecordSet.RowsReturn: boolean;
begin
  Result := FCommand.CommandType = ctCursor;
end;

function TCRRecordSet.GetCommand: TCRCommand;
begin
  Result := FCommand;
end;

procedure TCRRecordSet.SetConnection(Value: TCRConnection);
begin
  FCommand.SetConnection(Value);
end;

procedure TCRRecordSet.SetTransaction(Value: TCRTransaction);
begin
  FCommand.SetTransaction(Value);
end;

procedure TCRRecordSet.SetSQL(const Value: string);
begin
  FCommand.SetSQL(Value);
end;

function TCRRecordSet.GetProp(Prop: integer; out Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prFetchAll:
      Value := FFetchAll;
    prExtendedFieldsInfo:
      Value := FExtendedFieldsInfo;
    prDefaultValues:
      Value := FDefaultValues;
    prFieldsOrigin:
      Value := FFieldsOrigin;
    prReadOnly:
      Value := FReadOnly;
    prFullRefresh:
      Value := FFullRefresh;
    prSetFieldsReadOnly:
      Value := FSetFieldsReadOnly;
    prKeyFields:
      Value := FKeyFields;
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

function TCRRecordSet.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prUniDirectional: begin
      FUniDirectional := Value;
      if FUniDirectional then
        FFetchAll := False;
    end;
    prFetchRows:
      FFetchRows := Value;
    prFetchAll:
      if not FLockFetchAll then
        FFetchAll := Value and not FUniDirectional;
    prLockFetchAll:
      FLockFetchAll := Value;
    prLongStrings:
      FLongStrings := Value;
    prFlatBuffers:
      FFlatBuffers := Value;
    prIndexFieldNames:
      SetIndexFieldNames(Value);
  {$IFDEF HAVE_COMPRESS}
    prCompressBlobMode:
      FCommand.FCompressBlob := TCompressBlobMode(Integer(Value));
  {$ENDIF}
    prReadOnly:
      FReadOnly := Value;
    prExtendedFieldsInfo:
      FExtendedFieldsInfo := Value;
    prDefaultValues:
      FDefaultValues := Value;
    prFieldsOrigin:
      FFieldsOrigin := Value;
    prRoAfterUpdate:
      ;
    prFullRefresh:
      FFullRefresh := Value;
    prSetFieldsReadOnly:
      FSetFieldsReadOnly := Value;
    prKeyFields: begin
      FKeyFields := Value;
      ClearCachedKeyFieldDescs;
    end;
    prUpdatingTable: begin
      FUpdatingTable := Value;
      ClearCachedFieldDescs;
      if Active then begin
        InitUpdatingTableIdx;
        DetectIdentityField;
      end;
    end;
  {$IFNDEF LITE}
    prEncryptedFields:
      FEncryptedFields := Value;
    prPrefetchedFields:
      FPrefetchedFields := Value;
    prLiveBlockOnSmartFetch:
      FLiveBlockOnSmartFetch := Value;
    prDisableFetchOnOpening:
      FDisableFetchOnOpening := Value;
  {$ENDIF}
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

procedure TCRRecordSet.SetComponent(Value: TObject);
begin
  FCommand.Component := Value;
end;

function TCRRecordSet.GetComponent: TObject;
begin
  Result := FCommand.Component;
end;

function TCRRecordSet.IsCaseSensitive: boolean;
begin
  Result := True;
end;

procedure TCRRecordSet.FilterUpdated;
var
  NotFetched: boolean;
begin
  NotFetched := (FCommand.GetCursorState < csFetched) and (FCommand.GetCursorState <> csInactive);
  inherited FilterUpdated;
  FEOF := FEOF and not NotFetched;
end;

{$IFNDEF LITE}
function TCRRecordSet.FieldIsEncrypted(const FieldName: string): boolean;
var
  sl: TStrings;
begin
  Result := False;

  if (FEncryptor = nil) or (FEncryptedFields = '') then
    Exit;

  sl := TStringList.Create;
  try
    FCommand.SQLInfo.NamesToList(FEncryptedFields, sl);
    Result := sl.IndexOf(FieldName) > -1;
  finally
    sl.Free;
  end;
end;

{ Data Type Map }

function TCRRecordSet.CreateDataTypeMap: TCRMapRules;
begin
  Result := FCommand.GetMapRulesClass.Create;
end;

function TCRRecordSet.GetMapRule(Field: TCRFieldDesc): TCRMapRule;
begin
  Result := GetMapRule(Field.Name, Field.DBType, Field.DBLength, Field.DBScale);
end;

function TCRRecordSet.GetMapRule(const FieldName: string; DBType: Word; DBLength, DBScale: Integer): TCRMapRule;
begin
  Result := FDataTypeMap.DetectFieldNameMapRule(FieldName, DBType, DBLength, DBScale);
  if (Result = nil) and (FCommand.FConnection <> nil) then
    Result := FCommand.FConnection.DataTypeMap.DetectFieldNameMapRule(FieldName, DBType, DBLength, DBScale);
  if (Result = nil) then
    Result := FDataTypeMap.DetectDBTypeMapRule(DBType, DBLength, DBScale);
  if (Result = nil) and (FCommand.FConnection <> nil) then
    Result := FCommand.FConnection.DataTypeMap.DetectDBTypeMapRule(DBType, DBLength, DBScale);
end;

function TCRRecordSet.GetMapFetchConverter(DBType: Word; DBLength, DBScale: Integer): TFetchConverter;
begin
  Result := GetMapFetchConverter('', DBType, DBLength, DBScale);
end;

function TCRRecordSet.GetMapFetchConverter(const FieldName: string; DBType: Word; DBLength, DBScale: Integer): TFetchConverter;
var
  Rule: TCRMapRule;
begin
  if FieldIsEncrypted(FieldName) then begin
    Result := nil;
    Exit;
  end;

  Rule := GetMapRule(FieldName, DBType, DBLength, DBScale);

  if Rule <> nil then
    Result := FDataTypeMap.GetConverterManager.DetectFetchConverter(DBType, DBLength, DBScale, Rule.DataType)
  else
    Result := nil;
end;

function TCRRecordSet.GetMapOnDemandConverter(Field: TCRFieldDesc; out MapRule: TCRMapRule): TOnDemandConverter;
begin
  Result := GetMapOnDemandConverter(Field.Name, Field.DataType, Field.DBType, Field.DBLength, Field.DBScale, MapRule);
end;

function TCRRecordSet.GetMapOnDemandConverter(DataType: Word; DBType: Word; DBLength, DBScale: Integer; out MapRule: TCRMapRule): TOnDemandConverter;
begin
  Result := GetMapOnDemandConverter('', DataType, DBType, DBLength, DBScale, MapRule);
end;

function TCRRecordSet.GetMapOnDemandConverter(const FieldName: string; DataType: Word; DBType: Word; DBLength, DBScale: Integer; out MapRule: TCRMapRule): TOnDemandConverter;
begin
  MapRule := GetMapRule(FieldName, DBType, DBLength, DBScale);

  if MapRule <> nil then
    if (MapRule.DataType <> DataType) or
       ((MapRule.FieldLength <> -1) and (MapRule.FieldLength <> DBLength)) or
       ((MapRule.FieldScale <> -1)  and (MapRule.FieldScale <> DBScale))
    then
      Result := FDataTypeMap.GetConverterManager.DetectOnDemandConverter(DataType, MapRule.DataType)
    else begin
      MapRule := nil;
      Result := nil;
    end
  else
    Result := nil;
end;
{$ENDIF}

function TCRRecordSet.GetTableInfoClass: TTableInfoClass;
begin
  Result := FCommand.GetTableInfoClass;
end;

procedure TCRRecordSet.SetSortDefaults(SortColumn: TSortColumn);
begin
  inherited;

  if FCommand.FConnection <> nil then
    SortColumn.SortType := FCommand.FConnection.FDefaultSortType;
end;

{$IFNDEF LITE}

{ Smart Fetch }

function TCRRecordSet.GetSmartFetchSQL(SmartFetchState: TSmartFetchState): string;

  function GenerateFieldsList(const FieldDescs: TFieldDescArray): string;
  var
    i: integer;
  begin
    Result := '';
    for i := 0 to High(FieldDescs) do
      if FieldDescs[i].TableInfo <> nil then
        Result := Result + FieldDescs[i].TableInfo.TableName + '.' + FieldDescs[i].Name + ','
      else
        Result := Result + FieldDescs[i].Name + ',';
    Delete(Result, Length(Result), 1);
  end;

var
  _SQLText, FieldsSQL: string;
  SelectPos, FromPos, ValuesCount: integer;
  i, j: integer;
  Values: Variant;
  KeyFieldDescs: TFieldDescArray;
  FinSQLSB: StringBuilder;
begin
  _SQLText := AnsiUpperCase(FBaseSQL);
  SelectPos := Pos('SELECT', _SQLText);
  FromPos := Pos('FROM', _SQLText);

  if (SelectPos <> 0) and (FromPos <> 0) and (SelectPos < FromPos) then begin
    case SmartFetchState of
      sfMetaInfo:
        Result := GetSmartFetchMetaInfoSQL(FBaseSQL);

      sfKeyOnly: begin
        if Assigned(FGetKeyValuesSQL) then
          Result := FGetKeyValuesSQL
        else
          Result := '';

        if Result = '' then begin
          GetKeyFieldDescs(KeyFieldDescs);
          if Length(KeyFieldDescs) = 0 then
            raise ESmartFetchError.Create(SNoKeyFields);
          FieldsSQL := GenerateFieldsList(KeyFieldDescs);

          if FPrefetchedFields <> '' then begin
            FillFieldDescs(KeyFieldDescs, FPrefetchedFields, True);
            FieldsSQL := FieldsSQL + ',' + GenerateFieldsList(KeyFieldDescs);
          end;

          Result := Copy(FBaseSQL, 1, SelectPos + 5) + ' ' + FieldsSQL + ' ' + Copy(FBaseSQL, FromPos, Length(FBaseSQL) - FromPos + 1);
        end;
      end;

      sfDataByKey: begin
        if Assigned(FGetDataValuesSQL) then
          _SQLText := FGetDataValuesSQL
        else
          _SQLText := '';
        if _SQLText = '' then
          _SQLText := FBaseSQL;

        FinSQLSB := StringBuilder.Create(1024);
        try
          FieldsSQL := '';
          GetKeyFieldDescs(KeyFieldDescs);
          Values := VarArrayCreate([0, High(KeyFieldDescs)], varVariant);
          for i := 0 to High(KeyFieldDescs) do
            Values[i] := GetFieldValuesForSmartFetch(KeyFieldDescs[i]);

          ValuesCount := VarArrayHighBound(Values[0], 1) + 1;
          if Length(KeyFieldDescs) = 1 then begin
            FinSQLSB.Append('(');
            if KeyFieldDescs[0].TableInfo <> nil then
              if KeyFieldDescs[0].TableInfo.TableAlias <> '' then
                FinSQLSB.Append(KeyFieldDescs[0].TableInfo.TableAlias + '.')
              else
                FinSQLSB.Append(KeyFieldDescs[0].TableInfo.TableName + '.');
            FinSQLSB.Append(KeyFieldDescs[0].Name  + ' IN (');

            for j := 0 to ValuesCount - 1 do begin
              if j > 0 then
                FinSQLSB.Append(',');
              FinSQLSB.Append('''' + VarToStr(Values[0][j]) + '''');
            end;
            FinSQLSB.Append('))');
          end
          else begin
            FinSQLSB.Append('(');
            for j := 0 to ValuesCount - 1 do begin
              if j > 0 then
                FinSQLSB.Append(' OR ');
              FinSQLSB.Append('(');
              for i := 0 to High(KeyFieldDescs) do begin
                if i > 0 then
                  FinSQLSB.Append(' AND ');
                FinSQLSB.Append('(');
                if KeyFieldDescs[i].TableInfo <> nil then
                  if KeyFieldDescs[0].TableInfo.TableAlias <> '' then
                    FinSQLSB.Append(KeyFieldDescs[i].TableInfo.TableAlias + '.')
                  else
                    FinSQLSB.Append(KeyFieldDescs[i].TableInfo.TableName + '.');
                FinSQLSB.Append(KeyFieldDescs[i].Name + ' = ''' + VarToStr(Values[i][j]) + ''')');
              end;
              FinSQLSB.Append(')');
            end;
            FinSQLSB.Append(')');
          end;
          Result := _AddWhere(_SQLText, FinSQLSB.ToString, FCommand.GetParserClass, False, MacroChar);
          FFetchRows := ValuesCount + 1;
        finally
          FinSQLSB.Free;
        end;
      end;
    else
      Assert(False, SUnknownSmartFetchMode);
    end;
  end
  else
    Result := '';
end;

function TCRRecordSet.GetSmartFetchMetaInfoSQL(const BaseSQL: string): string;
begin
  Result := _AddWhere(BaseSQL, '1=0', FCommand.GetParserClass, False, MacroChar);
end;

{$ENDIF}

{ TParamDesc }

constructor TParamDesc.Create;
begin
  inherited;

  FDataType := dtUnknown;
  FIsBound := True;
end;

destructor TParamDesc.Destroy;
begin
{$IFNDEF LITE}
  FEncryptedBlob.Free;
{$ENDIF}

  inherited;
end;

{$IFNDEF LITE}
function TParamDesc.EncryptValue(DataType: Word; const Value: Variant): Variant;
var
  CryptType: Word;
  DataBuf: TValueArr;
  DataLen: cardinal;
  s: AnsiString;
  ws: WideString;
begin
  Assert(Assigned(FEncryptor));

  if not VarIsEmpty(Value) and not VarIsNull(Value) then begin
    case DataType of
      dtString, dtExtString: begin
        CryptType := dtString;
      {$IFNDEF CLR}
      {$IFNDEF NEXTGEN}
        if VarIsStr(Value) then begin
          DataBuf := TVarData(Value).VPointer;
          if DataBuf <> nil then
            DataLen := StrLen(PAnsiChar(DataBuf))
          else
            DataLen := 0;
        end
        else
      {$ENDIF}
      {$ENDIF}
        begin
          s := AnsiString(VarToStr(Value));
          DataBuf := {$IFDEF CLR}Encoding.Default.GetBytes(s){$ELSE}PAnsiChar(s){$ENDIF};
          DataLen := LengthA(s);
        end;
      end;
      dtWideString, dtExtWideString: begin
        CryptType := dtWideString;
      {$IFNDEF CLR}
        if VarIsStr(Value) then begin
          DataBuf := TVarData(Value).VPointer;
          if DataBuf <> nil then
            DataLen := StrLenW(PWideChar(DataBuf)) * SizeOf(WideChar)
          else
            DataLen := 0;
        end
        else
      {$ENDIF}
        begin
          ws := VarToWideStr(Value);
          DataBuf := {$IFDEF CLR}Encoding.Unicode.GetBytes(ws){$ELSE}Pointer(PWideChar(ws)){$ENDIF};
          DataLen := Length(ws) * SizeOf(WideChar);
        end;
      end;
      dtBytes, dtVarBytes, dtExtVarBytes: begin
        CryptType := dtBytes;
        if VarType(Value) = varArray + varByte then begin
        {$IFDEF CLR}
          DataBuf := Value;
          DataLen := Length(DataBuf);
        {$ELSE}
          DataBuf := TVarData(Value).VArray.Data;
          DataLen := TVarData(Value).VArray.Bounds[0].ElementCount;
        {$ENDIF}
        end
        else begin
          s := AnsiString(VarToStr(Value));
          DataLen := LengthA(s);
          DataBuf := {$IFDEF CLR}Encoding.Default.GetBytes(s){$ELSE}PAnsiChar(s){$ENDIF};
        end;
      end;
      dtBlob, dtMemo, dtWideMemo: begin
        CryptType := dtBytes;
        s := AnsiString(VarToStr(Value));
        DataBuf := {$IFDEF CLR}Encoding.Default.GetBytes(s){$ELSE}PAnsiChar(s){$ENDIF};
        DataLen := LengthA(s);
      end;
    else
      raise Exception.CreateFmt(SEncryptionNotSupported, [IntToStr(DataType)]);
    end;

    Result := Unassigned; // Delphi bug
    Result := FEncryptor(DataBuf, CryptType, DataLen);
    if DataLen = 0 then
      Result := Value;
  end
  else
    Result := Value;
end;

function TParamDesc.EncryptObject(DataType: Word; const Value: TSharedObject): TSharedObject;
var
  DataBuf: TValueArr;
  DataLen: cardinal;
  v: variant;
  b: TBytes;
  s: AnsiString;
  ws: WideString;
begin
  Assert(Assigned(FEncryptor));

  if Value <> nil then begin
    FEncryptedBlob.Free;
    FEncryptedBlob := TBlob(Value).Clone(False, False);

    case DataType of
      dtBlob: begin
        SetLength(b, 0);
        b := TBlob(Value).AsBytes;
        DataLen := Length(b);
        v := FEncryptor(TValueArr(b), dtBytes, DataLen);
        if DataLen > 0 then begin
          b := TBytes(v);
          FEncryptedBlob.AsBytes := b;
        end;
      end;
      dtMemo, dtWideMemo: begin
        if TBlob(Value).IsUnicode then begin
          ws := TBlob(Value).AsWideString;
          DataLen := Length(ws) * SizeOf(WideChar);
          if DataLen = 0 then
            DataBuf := nil
          else
            DataBuf := {$IFDEF CLR}Encoding.Unicode.GetBytes(ws){$ELSE}Pointer(PWideChar(ws)){$ENDIF};
          v := FEncryptor(DataBuf, dtWideString, DataLen);
          if DataLen > 0 then begin
            ws := WideString(v);
            FEncryptedBlob.AsWideString := ws;
          end;
        end
        else begin
          s := TBlob(Value).AsAnsiString;
          DataLen := LengthA(s);
          if DataLen = 0 then
            DataBuf := nil
          else
            DataBuf := {$IFDEF CLR}Encoding.Default.GetBytes(s){$ELSE}PAnsiChar(s){$ENDIF};
          v := FEncryptor(DataBuf, dtString, DataLen);
          if DataLen > 0 then begin
            s := AnsiString(v);
            FEncryptedBlob.AsAnsiString := s;
          end;
        end;
      end;
    else
      raise Exception.CreateFmt(SEncryptionNotSupported, [IntToStr(DataType)]);
    end;

    Result := FEncryptedBlob;
  end
  else
    Result := nil;
end;
{$ENDIF}

procedure TParamDesc.Clear;
begin
  FDataType := dtUnknown;
end;

function TParamDesc.GetName: string;
begin
  Result := FName;
end;

procedure TParamDesc.SetName(Value: string);
begin
  FName := Value;
end;

function TParamDesc.GetDataType: word;
begin
  Result := FDataType;
end;

procedure TParamDesc.SetDataType(Value: word);
begin
  FDataType := Value;
end;

function TParamDesc.GetSubDataType: word;
begin
  Result := FSubDataType;
end;

procedure TParamDesc.SetSubDataType(Value: word);
begin
  FSubDataType := Value;
end;

function TParamDesc.GetParamType: TParamDirection;
begin
  Result := FParamType;
end;

procedure TParamDesc.SetParamType(Value: TParamDirection);
begin
  FParamType := Value;
end;

function TParamDesc.GetSize: integer;
begin
  Result := FSize;
end;

procedure TParamDesc.SetSize(Value: integer);
begin
  FSize := Value;
end;

function TParamDesc.GetValue: variant;
begin
  Result := FData;
end;

procedure TParamDesc.SetValue(const Value: variant);
begin
{$IFNDEF VER6P}
  if TVarData(Value).VType = varByRef{$IFDEF FPC} or varVariant{$ENDIF} then
    SetObject(TVarData(Value).VPointer)
  else
{$ENDIF}
{$IFNDEF LITE}
  if Assigned(FEncryptor) then
    FData := EncryptValue(FDataType, Value)
  else
{$ENDIF}
    FData := Value;

  FIsNull := VarIsEmpty(FData) or VarIsNull(FData);
end;

function TParamDesc.GetNull: boolean;
begin
  Result := FIsNull;
end;

function TParamDesc.GetObject: TSharedObject;
begin
  if VarIsEmpty(FData) or VarIsNull(FData) then
    Result := nil
  else
  begin
  {$IFDEF CLR}
    Assert(FData is TSharedObject);
    Result := TSharedObject(FData);
  {$ELSE}
    Assert(TVarData(FData).VType = varByRef{$IFDEF FPC} or varVariant{$ENDIF});
    Result := TVarData(FData).VPointer;
  {$ENDIF}
  end;
end;

procedure TParamDesc.SetObject(Value: TSharedObject);
begin
{$IFDEF CLR}
  if Assigned(FEncryptor) then
    FData := Variant(EncryptObject(FDataType, Value))
  else
    FData := Variant(Value);
{$ELSE}
  FData := Unassigned;
  TVarData(FData).VType := varByRef{$IFDEF FPC} or varVariant{$ENDIF};
{$IFNDEF LITE}
  if Assigned(FEncryptor) then
    TVarData(FData).VPointer := EncryptObject(FDataType, Value)
  else
{$ENDIF}
    TVarData(FData).VPointer := Value;
{$ENDIF}
end;

procedure TParamDesc.SetNull(const Value: boolean);
begin
  FIsNull := Value;
{$IFDEF CLR}
  if not (FData is TSharedObject) then
{$ELSE}
  if TVarData(FData).VType <> varByRef{$IFDEF FPC} or varVariant{$ENDIF} then
{$ENDIF}
    FData := Unassigned;
end;

function TParamDesc.GetIsBound: boolean;
begin
  Result := FIsBound;
end;

procedure TParamDesc.SetIsBound(Value: boolean);
begin
  FIsBound := Value;
end;

function TParamDesc.GetNational: boolean;
begin
  Result := FNational;
end;

procedure TParamDesc.SetNational(Value: boolean);
begin
  FNational := Value;
end;

procedure TParamDesc.SetConvertEOL(const Value: boolean);
begin
  FConvertEOL := Value;
end;

{$IFNDEF LITE}
procedure TParamDesc.SetEncryptor(const Value: TEncryptionMethod);
begin
  FEncryptor := Value;
end;
{$ENDIF}

{ TParamDescs }

function TParamDescs.FindParam(Name: string): TParamDesc;
var
  i: integer;
begin
  Result := nil;

  for i := 0 to Count - 1 do
    if (Items[i] <> nil) then
      if SameText(TParamDesc(Items[i]).FName, Name) then begin
        Result := Items[i];
        break;
      end;
end;

function TParamDescs.ParamByName(Name: string): TParamDesc;
begin
  Result := FindParam(Name);

  if Result = nil then
    Assert(False);
    //raise Exception.Create(Format(SParamNotFound, [Name]));
end;

function TParamDescs.GetItems(Index: integer): TParamDesc;
begin
  Result := TParamDesc(inherited Items[Index]);
end;

{ TCRConnections }

function TCRConnections.GetItems(Index: integer): TCRConnection;
begin
  Result := TCRConnection(inherited Items[Index]);
end;

{ TCRTransaction }

constructor TCRTransaction.Create;
begin
  inherited;

  FConnections := TCRConnections.Create;
  FNativeTransaction := True;
end;

destructor TCRTransaction.Destroy;
begin
  // Transaction is closed by component layer.
  // Destructor of derived class can free resouces that are need to close transaction
  // before calling inherited.
  // CloseTransaction;

  FConnections.Free;

  inherited;
end;

procedure TCRTransaction.CheckInactive;
begin
  if GetInTransaction then
    raise Exception.Create(SInTransaction);
end;

procedure TCRTransaction.CheckActive;
begin
  if not GetInTransaction then
    raise Exception.Create(SNotInTransaction);
end;

function TCRTransaction.AddConnection(Connection: TCRConnection): boolean;
begin
  if FConnections.IndexOf(Connection) = -1 then begin
    FConnections.Add(Connection);
    Result := True;
  end
  else
    Result := False;
end;

function TCRTransaction.RemoveConnection(Connection: TCRConnection): boolean;
begin
  if FConnections.IndexOf(Connection) >= 0 then begin
    FConnections.Remove(Connection);
    Result := True;
  end
  else
    Result := False;
end;

function TCRTransaction.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prIsolationLevel:
      FIsolationLevel := TCRIsolationLevel(Value);
    prTransactionReadOnly:
      FReadOnly := Value;
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

function TCRTransaction.GetProp(Prop: integer; var Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prIsolationLevel:
      Value := Variant(FIsolationLevel);
    prTransactionReadOnly:
      Value := FReadOnly;
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;  
end;

procedure TCRTransaction.StartTransaction;
begin
  Assert(False);
end;

procedure TCRTransaction.Commit;
begin
  Assert(False);
end;

procedure TCRTransaction.Rollback;
begin
  Assert(False);
end;

procedure TCRTransaction.CommitRetaining;
begin
  raise Exception.Create(SOperationNotSupported);
end;

procedure TCRTransaction.RollbackRetaining;
begin
  raise Exception.Create(SOperationNotSupported);
end;

procedure TCRTransaction.Savepoint(const Name: string);
begin
  raise Exception.Create(SOperationNotSupported);
end;

procedure TCRTransaction.ReleaseSavepoint(const Name: string);
begin
  raise Exception.Create(SOperationNotSupported);
end;

procedure TCRTransaction.RollbackToSavepoint(const Name: string);
begin
  raise Exception.Create(SOperationNotSupported);
end;

function TCRTransaction.GetInTransaction: boolean;
begin
  Result := FActive;
end;

function TCRTransaction.DetectInTransaction(CanActivate: boolean): boolean;
begin
  Result := GetInTransaction;
end;

procedure TCRTransaction.AssignConnect(Source: TCRTransaction);
begin
  FActive := Source.FActive;
  if FActive then
    FNativeTransaction := False;
end;

procedure TCRTransaction.Reset;
begin
  FActive := False;
end;

function TCRTransaction.CanRestoreAfterFailover: boolean;
begin
  Result := False;
end;

{ TMTSTransaction }

{$IFNDEF LITE}
{$IFDEF MSWINDOWS}

destructor TMTSTransaction.Destroy;
begin
  FMTSGC := nil;

  inherited;
end;

procedure TMTSTransaction.StartMTSTransaction;
var
  MTSIsolationLevel: integer;
  MTSFlags: integer;
  MTSTransaction: ICRTransaction;
  MTSOptions: ICRTransactionOptions;
{$IFDEF CLR}
  hGuid: IntPtr;
  aGuid: array of byte;
  i: integer;
const
  GuidSize = 16;
{$ENDIF}
begin
{$IFDEF FPC}
  raise Exception.Create(SFPCNotSupported);
{$ENDIF}

  InitMSDTC;

  if FMTSGC = nil then begin
  {$IFDEF CLR}
    hGuid := Marshal.AllocHGlobal(GuidSize);
    try
      aGuid := StringToGUID(IID_ITransactionDispenser).ToByteArray;
      for i := 0 to GuidSize - 1 do
        Marshal.WriteByte(hGuid, i, aGuid[i]);
      OleCheck(DtcGetTransactionManagerEx(nil, nil, hGuid, 0, nil, FMTSGC));
    finally
      Marshal.FreeHGlobal(hGuid);
    end;
  {$ELSE}
    OleCheck(DtcGetTransactionManagerEx(nil, nil, IID_ITransactionDispenser, 0, nil, FMTSGC));
  {$ENDIF}
  end;

  case FIsolationLevel of
    ilReadUnCommitted:
      MTSIsolationLevel := ISOLATIONLEVEL_READUNCOMMITTED;
    ilReadCommitted:
      MTSIsolationLevel := ISOLATIONLEVEL_READCOMMITTED;
    ilRepeatableRead:
      MTSIsolationLevel := ISOLATIONLEVEL_REPEATABLEREAD;
    ilIsolated:
      MTSIsolationLevel := ISOLATIONLEVEL_SERIALIZABLE;
  else
    raise Exception.Create(SIsolationLevelNotSupportedWithMTS);
  end;
  MTSFlags := 0;
  MTSOptions := nil; 

  FMTSGC.BeginTransaction(nil, MTSIsolationLevel, MTSFlags, MTSOptions, MTSTransaction);
  FMTSTrans := ICRTransactionSC(MTSTransaction);
end;

procedure TMTSTransaction.CompleteMTSTransaction(Commit: boolean);
var
  i: integer;
begin
  Assert(FMTSTrans <> nil);
  FActive := False;
  try
    if Commit then
      FMTSTrans.Commit(False, 0, 0)
    else
      FMTSTrans.Abort(nil, False, False);
  finally
    FMTSTrans := nil;
  end;

  for i := 0 to FConnections.Count - 1 do //needunenlist 
    UnEnlistLink(FConnections[i]);  
end;

procedure TMTSTransaction.EnlistLink(Connection: TCRConnection);
begin
  Connection.Enlist(Self);
end;

procedure TMTSTransaction.UnEnlistLink(Connection: TCRConnection);
begin
  Connection.UnEnlist(Self);
end;

function TMTSTransaction.AddConnection(Connection: TCRConnection): boolean;
begin
  Result := inherited AddConnection(Connection);
  if Result and FActive then
    EnlistLink(Connection);
end;

function TMTSTransaction.RemoveConnection(Connection: TCRConnection): boolean;
begin
  Result := inherited RemoveConnection(Connection);
  if Result and FActive then
    UnEnlistLink(Connection);
end;

procedure TMTSTransaction.StartTransaction;
var
  i: integer;
begin
  CheckInactive;

  for i := 0 to FConnections.Count - 1 do
    if not FConnections[i].GetConnected then
      raise Exception.Create(SConnectionInTransactionNotActive);

  StartMTSTransaction;

  FActive := True;
  try
    for i := 0 to FConnections.Count - 1 do
      EnlistLink(FConnections[i]);
  except
    Rollback;
    raise;
  end;
end;

procedure TMTSTransaction.Commit;
begin
  CheckActive;
  CompleteMTSTransaction(True);
end;

procedure TMTSTransaction.Rollback;
begin
  CheckActive;
  CompleteMTSTransaction(False);
end;

procedure TMTSTransaction.Savepoint(const Name: string);
var
  i: integer;
begin
  for i := 0 to FConnections.Count - 1 do begin
    FConnections[i].FInternalTransaction.Savepoint(Name);
  end;
end;

procedure TMTSTransaction.ReleaseSavepoint(const Name: string);
var
  i: integer;
begin
  for i := 0 to FConnections.Count - 1 do begin
    FConnections[i].FInternalTransaction.ReleaseSavepoint(Name);
  end;
end;

procedure TMTSTransaction.RollbackToSavepoint(const Name: string);
var
  i: integer;
begin
  for i := 0 to FConnections.Count - 1 do begin
    FConnections[i].FInternalTransaction.RollbackToSavepoint(Name);
  end;
end;

{$ENDIF}
{$ENDIF}

{ TCRMetaData }

constructor TCRMetaData.Create;
begin
  inherited;

  FMemData := TMemData.Create;
  FMemData.AutoInitFields := False;
  FRecordSet := CreateRecordSet;
{$IFNDEF LITE}
  FRecordSet.DataTypeMap.Enabled := False;
{$ENDIF}
  FRecordSet.SetProp(prFetchAll, True);
  FRecordSet.SetProp(prFlatBuffers, False);

  FMemDataHelper := TDataHelper.Create(FMemData);
  FRecordSetHelper := TDataHelper.Create(FRecordSet);

  FOperator := '=';
end;

destructor TCRMetaData.Destroy;
begin
  FMemDataHelper.Free;
  FRecordSetHelper.Free;
  FRecordSet.Free;
  FMemData.Free;

  inherited;
end;

function TCRMetaData.GetMetaData(Connection: TCRConnection; Transaction: TCRTransaction;
  const MetaDataKind: string; Restrictions: TStrings): TData;
begin
  FRecordSet.SetConnection(Connection);
  FRecordSet.SetTransaction(Transaction);
  Result := InternalGetMetaData(LowerCase(Trim(MetaDataKind)), Restrictions);
end;

function TCRMetaData.InternalGetMetaData(const MetaDataKind: string; Restrictions: TStrings): TData;
begin
  // kinds required for all products
  if (MetaDataKind = '') or (MetaDataKind = 'metadatakinds') then
    Result := GetMetaDataKinds
  else
  if MetaDataKind = 'restrictions' then
    Result := GetRestrictions(Restrictions)
  else
  if MetaDataKind = 'tables' then
    Result := GetTables(Restrictions)
  else
  if MetaDataKind = 'columns' then
    Result := GetColumns(Restrictions)
  else
  if MetaDataKind = 'procedures' then
    Result := GetProcedures(Restrictions)
  else
  if MetaDataKind = 'procedureparameters' then
    Result := GetProcedureParameters(Restrictions)
  else
  if MetaDataKind = 'indexes' then
    Result := GetIndexes(Restrictions)
  else
  if MetaDataKind = 'indexcolumns' then
    Result := GetIndexColumns(Restrictions)
  else
  if MetaDataKind = 'constraints' then
    Result := GetConstraints(Restrictions)

  // the following kinds are reqiured for DBXpress only
  else
  if MetaDataKind = 'databases' then
    Result := GetDatabases(Restrictions)
  else
  if MetaDataKind = 'datatypes' then
    Result := GetDatatypes(Restrictions)
  else
  if MetaDataKind = 'users' then
    Result := GetUsers(Restrictions)
  else
  if MetaDataKind = 'roles' then
    Result := GetRoles(Restrictions)
  else
  if MetaDataKind = 'userdefinedtypes' then
    Result := GetUDTs(Restrictions)
  else
  if MetaDataKind = 'packages' then
    Result := GetPackages(Restrictions)
  else
    raise Exception.Create(SUnsupportedMetaDataKind);
end;

procedure TCRMetaData.GetMetaDataKindsList(List: TStrings);
var
  StrList: TStringList;
begin
  StrList := TStringList.Create;
  try
    InternalGetMetaDataKindsList(StrList);
    List.Assign(StrList);
  finally
    StrList.Free;
  end;
end;

procedure TCRMetaData.GetRestrictionsList(List: TStrings; const MetaDataKind: string);
var
  StrList: TStringList;
begin
  StrList := TStringList.Create;
  try
    InternalGetRestrictionsList(StrList, LowerCase(Trim(MetaDataKind)));
    List.Assign(StrList);
  finally
    StrList.Free;
  end;
end;

procedure TCRMetaData.AddField(const AName: string; AType: integer; ALength: integer = -1);
var
  Field: TFieldDesc;
  Size: integer;
begin
  Field := TFieldDesc.Create(TRecordSetClass(FRecordSet.ClassType));
  Field.Name := AName;
  Field.ActualName := Field.Name;
  Field.DataType := AType;
  case AType of
    dtInt8, dtUInt8: Size := SizeOf(Byte);
    dtInt16, dtUInt16: Size := SizeOf(Word);
    dtInt32: Size := SizeOf(Integer);
    dtInt64: Size := SizeOf(Int64);
    dtFloat: Size := SizeOf(Double);
    dtBoolean: Size := SizeOf(Boolean);
    dtDateTime: Size := SizeOf(TDateTime);
    dtString: Size := ALength + 1;
    dtWideString: Size := (ALength + 1) * 2;
  else
    Size := SizeOf(IntPtr);
  end;
  Field.Size := Size;
  if ALength > 0 then
    Field.Length := ALength;

  Field.FieldNo := FMemData.Fields.Add(Field) + 1;
end;

procedure TCRMetaData.CopyRecord(const SourceIndices, DestIndices: array of integer);
var
  i: integer;
begin
  for i := 0 to High(SourceIndices) do
    FMemDataHelper.FieldValues[DestIndices[i]] := FRecordSetHelper.FieldValues[SourceIndices[i]];

{$IFDEF DBX_METADATA}
  FMemDataHelper.FieldValues[1] := FRecordSet.RecordNo;
{$ENDIF}
end;

function TCRMetaData.ParseTypes(const ObjectTypes: string; AllTypes: array of string): TBooleanArray;
var
  TypeName, RestTypes: string;
  i, p: integer;
begin
  SetLength(Result, High(AllTypes) + 1);

  if ObjectTypes <> '' then begin
    for i := 0 to High(AllTypes) do
      Result[i] := False;
    RestTypes := ObjectTypes;
    repeat
      p := Pos(',', RestTypes);
      if p > 0 then
        TypeName := Copy(RestTypes, 1, p - 1)
      else
        TypeName := RestTypes;
      TypeName := AnsiUpperCase(Trim(TypeName));
      for i := 0 to High(AllTypes) do
        if TypeName = AnsiUpperCase(AllTypes[i]) then begin
          Result[i] := True;
          break;
        end;
      RestTypes := Copy(RestTypes, p + 1, Length(RestTypes) - p);
    until p = 0;
  end
  else
    for i := 0 to High(AllTypes) do
      Result[i] := True;
end;

procedure TCRMetaData.ParseTypes(const ObjectTypes: string; TypesList: TStringList);
var
  Types, S: string;
  p: integer;
begin
  TypesList.Clear;
  TypesList.Sorted := True;
  TypesList.Duplicates := dupIgnore;
  Types := ObjectTypes;
  repeat
    p := Pos(',', Types);
    if p > 0 then begin
      S := Trim(Copy(Types, 1, p - 1));
      Types := Copy(Types, p + 1, MaxInt);
    end
    else
      S := Trim(Types);
    if S <> '' then
      TypesList.Add(AnsiUpperCase(S));
  until p = 0;

  if TypesList.Count = 0 then
    TypesList.Add('');
end;

procedure TCRMetaData.AddWhere(var WhereClause: string; const Name, Value: string;
  AddEmpty: boolean = False);
var
  NormValue: string;
begin
  if AddEmpty or (Value <> '') then begin
    NormValue := FRecordSet.GetCommand.SQLInfo.NormalizeName(Value, False, True);
    if AddEmpty or (NormValue <> '') then begin
      if WhereClause <> '' then
        WhereClause := WhereClause + ' AND ';
      if Value <> '' then
        WhereClause := WhereClause + Name + ' ' + FOperator + ' ' + AnsiQuotedStr(NormValue, '''')
      else
        WhereClause := WhereClause + Name + ' IS NULL';
    end;
  end;
end;

procedure TCRMetaData.CreateMetaDataKindsFields;
begin
  FMemData.Fields.Clear;
  AddField('METADATA_NAME', dtString, 50);
  FMemData.InitFields;
end;

procedure TCRMetaData.InternalGetMetaDataKindsList(List: TStringList);
begin
  List.Clear;
  List.Sorted := False;
  List.Add('MetaDataKinds');
  List.Add('Restrictions');
  List.Add('Tables');
  List.Add('Columns');
  List.Add('Procedures');
  List.Add('ProcedureParameters');
  List.Add('Indexes');
  List.Add('IndexColumns');
  List.Add('Constraints');
  List.Sorted := True;
end;

function TCRMetaData.GetMetaDataKinds: TData;
var
  List: TStringList;
  i: integer;
begin
  List := TStringList.Create;
  try
    GetMetaDataKindsList(List);
    CreateMetaDataKindsFields;
    FMemData.Open;
    Result := FMemData;
    FMemDataHelper.AllocBuffer;
    for i := 0 to List.Count - 1 do begin
      FMemDataHelper.InitRecord;
      FMemDataHelper.FieldValues[1] := List[i];
      FMemDataHelper.AppendRecord;
    end;
    FMemData.SetToBegin;
  finally
    List.Free;
  end;
end;

procedure TCRMetaData.CreateRestrictionsFields;
begin
  FMemData.Fields.Clear;
  AddField('METADATA_NAME', dtString, 50);
  AddField('RESTRICTION_NAME', dtString, 50);
  FMemData.InitFields;
end;

procedure TCRMetaData.InternalGetRestrictionsList(List: TStringList; const MetaDataKind: string);
begin
  List.Clear;

  if MetaDataKind = 'restrictions' then begin
    List.Add('METADATA_NAME');
  end
  else
  if MetaDataKind = 'tables' then begin
    List.Add('TABLE_CATALOG');
    List.Add('TABLE_SCHEMA');
    List.Add('TABLE_NAME');
    List.Add('TABLE_TYPE');
  end
  else
  if MetaDataKind = 'columns' then begin
    List.Add('TABLE_CATALOG');
    List.Add('TABLE_SCHEMA');
    List.Add('TABLE_NAME');
    List.Add('COLUMN_NAME');
  end
  else
  if MetaDataKind = 'procedures' then begin
    List.Add('PROCEDURE_CATALOG');
    List.Add('PROCEDURE_SCHEMA');
    List.Add('PROCEDURE_NAME');
    List.Add('PROCEDURE_TYPE');
  end
  else
  if MetaDataKind = 'procedureparameters' then begin
    List.Add('PROCEDURE_CATALOG');
    List.Add('PROCEDURE_SCHEMA');
    List.Add('PROCEDURE_NAME');
    List.Add('PARAMETER_NAME');
  end
  else
  if MetaDataKind = 'indexes' then begin
    List.Add('TABLE_CATALOG');
    List.Add('TABLE_SCHEMA');
    List.Add('TABLE_NAME');
    List.Add('INDEX_NAME');
  end
  else
  if MetaDataKind = 'indexcolumns' then begin
    List.Add('TABLE_CATALOG');
    List.Add('TABLE_SCHEMA');
    List.Add('TABLE_NAME');
    List.Add('INDEX_NAME');
  end
  else
  if MetaDataKind = 'constraints' then begin
    List.Add('TABLE_CATALOG');
    List.Add('TABLE_SCHEMA');
    List.Add('TABLE_NAME');
    List.Add('CONSTRAINT_NAME');
    List.Add('CONSTRAINT_TYPE');
  end;
end;

function TCRMetaData.GetRestrictions(Restrictions: TStrings): TData;
var
  MetaInfoName: string;
  MetaDataKinds, RestrList: TStringList;
  i, j: integer;
begin
  MetaInfoName := LowerCase(Trim(Restrictions.Values['METAINFO_NAME']));
  CreateRestrictionsFields;
  FMemData.Open;
  FMemDataHelper.AllocBuffer;

  RestrList := TStringList.Create;
  try
    if MetaInfoName <> '' then begin
      GetRestrictionsList(RestrList, MetaInfoName);
      for j := 0 to RestrList.Count - 1 do begin
        FMemDataHelper.InitRecord;
        FMemDataHelper.FieldValues[1] := MetaInfoName;
        FMemDataHelper.FieldValues[2] := RestrList[j];
        FMemDataHelper.AppendRecord;
      end;
    end
    else begin
      MetaDataKinds := TStringList.Create;
      try
        GetMetaDataKindsList(MetaDataKinds);
        for i := 0 to MetaDataKinds.Count - 1 do begin
          GetRestrictionsList(RestrList, LowerCase(MetaDataKinds[i]));

          for j := 0 to RestrList.Count - 1 do begin
            FMemDataHelper.InitRecord;
            FMemDataHelper.FieldValues[1] := MetaDataKinds[i];
            FMemDataHelper.FieldValues[2] := RestrList[j];
            FMemDataHelper.AppendRecord;
          end;
        end;
      finally
        MetaDataKinds.Free;
      end;
    end;
  finally
    RestrList.Free;
  end;

  FMemData.SetToBegin;
  Result := FMemData;
end;

procedure TCRMetaData.CreateTablesFields;
begin
  FMemData.Fields.Clear;
{$IFDEF DBX_METADATA}
  AddField('RECNO', dtInt32);
  AddField('CATALOG_NAME', dtString, 100);
  AddField('SCHEMA_NAME', dtString, 100);
{$ELSE}
  AddField('TABLE_CATALOG', dtString, 100);
  AddField('TABLE_SCHEMA', dtString, 100);
{$ENDIF}
  AddField('TABLE_NAME', dtString, 100);
{$IFNDEF DBX_METADATA}
  AddField('TABLE_TYPE', dtString, 50);
{$ELSE}
  AddField('TABLE_TYPE', dtInt32);
{$ENDIF}
  FMemData.InitFields;
end;

procedure TCRMetaData.CreateColumnsFields;
begin
  FMemData.Fields.Clear;
{$IFDEF DBX_METADATA}
  AddField('RECNO', dtInt32);
  AddField('CATALOG_NAME', dtString, 100);
  AddField('SCHEMA_NAME', dtString, 100);
{$ELSE}
  AddField('TABLE_CATALOG', dtString, 100);
  AddField('TABLE_SCHEMA', dtString, 100);
{$ENDIF}
  AddField('TABLE_NAME', dtString, 100);
  AddField('COLUMN_NAME', dtString, 100);
{$IFNDEF DBX_METADATA}
  AddField('POSITION', dtInt32);
  AddField('DATA_TYPE', dtString, 50);
  AddField('DATA_LENGTH', dtInt32);
  AddField('DATA_PRECISION', dtInt32);
  AddField('DATA_SCALE', dtInt32);
  AddField('NULLABLE', dtInt32);
  AddField('DEFAULT_VALUE', dtMemo);
{$ELSE}
  AddField('COLUMN_POSITION', dtInt32);
  AddField('COLUMN_TYPE', dtInt32);
  AddField('COLUMN_DATATYPE', dtInt32);
  AddField('COLUMN_TYPENAME', dtString, 50);
  AddField('COLUMN_SUBTYPE', dtInt32);
  AddField('COLUMN_LENGTH', dtInt32);
  AddField('COLUMN_PRECISION', dtInt32);
  AddField('COLUMN_SCALE', dtInt32);
  AddField('COLUMN_NULLABLE', dtInt32);
{$ENDIF}
  FMemData.InitFields;
end;

procedure TCRMetaData.CreateProceduresFields;
begin
  FMemData.Fields.Clear;
{$IFDEF DBX_METADATA}
  AddField('RECNO', dtInt32);
  AddField('CATALOG_NAME', dtString, 100);
  AddField('SCHEMA_NAME', dtString, 100);
  AddField('PROC_NAME', dtString, 100);
  AddField('PROC_TYPE', dtInt32);
  AddField('IN_PARAMS', dtInt32);
  AddField('OUT_PARAMS', dtInt32);
{$ELSE}
  AddField('PROCEDURE_CATALOG', dtString, 100);
  AddField('PROCEDURE_SCHEMA', dtString, 100);
  AddField('PROCEDURE_NAME', dtString, 100);
  AddField('PROCEDURE_TYPE', dtString, 50);
{$ENDIF}
  FMemData.InitFields;
end;

procedure TCRMetaData.CreateProcedureParametersFields;
begin
  FMemData.Fields.Clear;
{$IFDEF DBX_METADATA}
  AddField('RECNO', dtInt32);
  AddField('CATALOG_NAME', dtString, 100);
  AddField('SCHEMA_NAME', dtString, 100);
  AddField('PROC_NAME', dtString, 100);
  AddField('PARAM_NAME', dtString, 100);
  AddField('PARAM_POSITION', dtInt32);
  AddField('PARAM_TYPE', dtInt32);
  AddField('PARAM_DATATYPE', dtInt32);
  AddField('PARAM_TYPENAME', dtString, 50);
  AddField('PARAM_SUBTYPE', dtInt32);
  AddField('PARAM_LENGTH', dtInt32);
  AddField('PARAM_PRECISION', dtInt32);
  AddField('PARAM_SCALE', dtInt32);
  AddField('PARAM_NULLABLE', dtInt32);
{$ELSE}
  AddField('PROCEDURE_CATALOG', dtString, 100);
  AddField('PROCEDURE_SCHEMA', dtString, 100);
  AddField('PROCEDURE_NAME', dtString, 100);
  AddField('PARAMETER_NAME', dtString, 100);
  AddField('POSITION', dtInt32);
  AddField('DIRECTION', dtString, 10);
  AddField('DATA_TYPE', dtString, 50);
  AddField('DATA_LENGTH', dtInt32);
  AddField('DATA_PRECISION', dtInt32);
  AddField('DATA_SCALE', dtInt32);
{$ENDIF}
  FMemData.InitFields;
end;

procedure TCRMetaData.CreateIndexesFields;
begin
  FMemData.Fields.Clear;
  AddField('TABLE_CATALOG', dtString, 100);
  AddField('TABLE_SCHEMA', dtString, 100);
  AddField('TABLE_NAME', dtString, 100);
  AddField('INDEX_CATALOG', dtString, 100);
  AddField('INDEX_SCHEMA', dtString, 100);
  AddField('INDEX_NAME', dtString, 100);
  AddField('UNIQUE', dtInt32);
  FMemData.InitFields;
end;

procedure TCRMetaData.CreateIndexColumnsFields;
begin
  FMemData.Fields.Clear;
{$IFDEF DBX_METADATA}
  AddField('RECNO', dtInt32);
  AddField('CATALOG_NAME', dtString, 100);
  AddField('SCHEMA_NAME', dtString, 100);
  AddField('TABLE_NAME', dtString, 100);
{$ELSE}
  AddField('TABLE_CATALOG', dtString, 100);
  AddField('TABLE_SCHEMA', dtString, 100);
  AddField('TABLE_NAME', dtString, 100);
  AddField('INDEX_CATALOG', dtString, 100);
  AddField('INDEX_SCHEMA', dtString, 100);
{$ENDIF}
  AddField('INDEX_NAME', dtString, 100);
  AddField('COLUMN_NAME', dtString, 100);
  AddField('COLUMN_POSITION', dtInt32);
{$IFDEF DBX_METADATA}
  AddField('PKEY_NAME', dtString, 100);
  AddField('INDEX_TYPE', dtInt32);
  AddField('SORT_ORDER', dtString, 1);
  AddField('FILTER', dtString, 6);
{$ELSE}
  AddField('SORT_ORDER', dtString, 4);
{$ENDIF}
  FMemData.InitFields;
end;

procedure TCRMetaData.CreateConstraintsFields;
begin
  FMemData.Fields.Clear;
  AddField('TABLE_CATALOG', dtString, 100);
  AddField('TABLE_SCHEMA', dtString, 100);
  AddField('TABLE_NAME', dtString, 100);
  AddField('CONSTRAINT_NAME', dtString, 100);
  AddField('CONSTRAINT_TYPE', dtString, 100);
  AddField('INDEX_CATALOG', dtString, 100);
  AddField('INDEX_SCHEMA', dtString, 100);
  AddField('INDEX_NAME', dtString, 100);
  FMemData.InitFields;
end;

{$IFDEF DBX_METADATA}
procedure TCRMetaData.CreateObjectListFields;
begin
  FMemData.Fields.Clear;
  AddField('RECNO', dtInt32);
  AddField('CATALOG_NAME', dtString, 100);
  AddField('SCHEMA_NAME', dtString, 100);
  AddField('OBJECT_NAME', dtString, 100);
  FMemData.InitFields;
end;
{$ENDIF}

procedure TCRMetaData.CreateDatabasesFields;
begin
  FMemData.Fields.Clear;
  AddField('DATABASE_NAME', dtString, 100);
  FMemData.InitFields;
end;

function TCRMetaData.GetDatabases(Restrictions: TStrings): TData;
begin
  raise Exception.Create(SUnsupportedMetaDataKind);
{$IFDEF FPC}
  Result := nil;
{$ENDIF}
end;

function TCRMetaData.GetDataTypes(Restrictions: TStrings): TData;
begin
  raise Exception.Create(SUnsupportedMetaDataKind);
{$IFDEF FPC}
  Result := nil;
{$ENDIF}
end;

function TCRMetaData.GetUsers(Restrictions: TStrings): TData;
begin
  raise Exception.Create(SUnsupportedMetaDataKind);
{$IFDEF FPC}
  Result := nil;
{$ENDIF}
end;

function TCRMetaData.GetRoles(Restrictions: TStrings): TData;
begin
  raise Exception.Create(SUnsupportedMetaDataKind);
{$IFDEF FPC}
  Result := nil;
{$ENDIF}
end;

function TCRMetaData.GetUDTs(Restrictions: TStrings): TData;
begin
  raise Exception.Create(SUnsupportedMetaDataKind);
{$IFDEF FPC}
  Result := nil;
{$ENDIF}
end;

function TCRMetaData.GetPackages(Restrictions: TStrings): TData;
begin
  raise Exception.Create(SUnsupportedMetaDataKind);
{$IFDEF FPC}
  Result := nil;
{$ENDIF}
end;

{ TDataHelper }

constructor TDataHelper.Create(Data: TData);
begin
  inherited Create;

  FData := Data;
end;

destructor TDataHelper.Destroy;
begin
  FreeBuffer;

  inherited Destroy;
end;

procedure TDataHelper.AllocBuffer;
begin
  FreeBuffer;
  FData.AllocRecBuf(FRecBuf);
end;

procedure TDataHelper.FreeBuffer;
begin
  if FRecBuf <> nil then begin
    Marshal.FreeHGlobal(FRecBuf);
    FRecBuf := nil;
  end;
end;

procedure TDataHelper.InitRecord;
begin
  FData.InitRecord(FRecBuf);
  if FData.HasComplexFields then
    FData.CreateComplexFields(FRecBuf, True);
end;

procedure TDataHelper.AppendRecord;
begin
  FData.AppendRecord(FRecBuf);
end;

function TDataHelper.NextRecord: boolean;
begin
  FData.GetNextRecord(FRecBuf);
  Result := not FData.Eof;
end;

function TDataHelper.GetFieldValue(Index: integer): variant;
begin
  FData.GetFieldAsVariant(FData.Fields[Index - 1], FRecBuf, Result);
end;

procedure TDataHelper.SetFieldValue(Index: integer; const Value: variant);
begin
  FData.PutFieldAsVariant(FData.Fields[Index - 1], FRecBuf, Value);
end;

{ TCRLoaderColumn }

constructor TCRLoaderColumn.Create;
begin
  inherited;
end;

procedure TCRLoaderColumn.UpdateDataType(Value: word);
begin
  FDataType := Value;
end;

{ TCRLoaderColumns }

function TCRLoaderColumns.GetColumnIndexByName(Name: string): Integer;
var
  i: Integer;
  ColumnNameUpper: string;
begin
  Result := -1;

  ColumnNameUpper := AnsiUpperCase(Name);
  for i := 0 to Count - 1 do
    if AnsiUpperCase(Items[i].Name) = ColumnNameUpper then begin
      Result := i;
      Exit;
    end;
end;

function TCRLoaderColumns.FindColumnByName(Name: string): TCRLoaderColumn;
var
  ColumnIndex: integer;
begin
  ColumnIndex := GetColumnIndexByName(Name);
  if ColumnIndex <> -1 then
    Result := Items[ColumnIndex]
  else
    Result := nil;
end;


function TCRLoaderColumns.GetColumnByName(Name: string): TCRLoaderColumn;
var
  ColumnIndex: integer;
begin
  ColumnIndex := GetColumnIndexByName(Name);
  if ColumnIndex <> -1 then
    Result := Items[ColumnIndex]
  else
    raise Exception.Create('Invalid column name');
end;

function TCRLoaderColumns.GetColumn(Index: integer): TCRLoaderColumn;
begin
  Result := TCRLoaderColumn(inherited Items[Index]);
end;

procedure TCRLoaderColumns.SetColumn(Index: integer; Value: TCRLoaderColumn);
begin
  inherited Items[Index] := Value;
end;

{ TCRLoader }

constructor TCRLoader.Create;
begin
  inherited;

  FSkipReadOnlyFieldDescs := True;
  FColumns := TCRLoaderColumns.Create;
  FObjectReleaseNeeded := False;
end;

destructor TCRLoader.Destroy;
begin
  FColumns.Free;

  inherited;
end;

function TCRLoader.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prQuoteNames:
      FQuoteNames := Value;
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

function TCRLoader.GetProp(Prop: integer; var Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prQuoteNames:
      Value := FQuoteNames;
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

procedure TCRLoader.DoPutColumnData(Col: integer; Row: integer; const Value: variant);
begin
end;

procedure TCRLoader.DoAddObjectRef(const Value: variant);
var
  Obj: TSharedObject;
begin
  if (VarType(Value) = varSharedObject) then begin
    Obj := TSharedObject.FromVariant(Value);
    Obj.AddRef;
    FObjectReleaseNeeded := True;
  end;
end;

procedure TCRLoader.DoReleaseObjectRef(const Value: variant);
var
  Obj: TSharedObject;
begin
  if (VarType(Value) = varSharedObject) then begin
    Obj := TSharedObject.FromVariant(Value);
    Obj.Release;
  end;
end;

function TCRLoader.IsPutColumnDataAllowed: boolean;
begin
  Result := True;
end;

procedure TCRLoader.PutColumnData(Col: integer; Row: integer; const Value: variant);
begin
  if Col >= FColumns.Count then
    raise Exception.Create('Invalid column number');

  if (Row < FLastRow + 1) or (Row < 1) or (Row > FLastRow + 2) then
    raise Exception.Create('Invalid row number');

  if not IsPutColumnDataAllowed then
    raise Exception.Create('The PutColumnData method must be called from the OnPutData event only');

  FLastRow := Row - 1;

  DoPutColumnData(Col, Row, Value);
end;

procedure TCRLoader.CheckTableName;
begin
  if Trim(FTableName) = '' then
    raise Exception.Create(STableNameNotDefined);
end;

procedure TCRLoader.DoPrepare;
begin
end;

procedure TCRLoader.Prepare;
begin
  FObjectReleaseNeeded := False;

  CheckTableName;
  Reset;

  DoPrepare;
end;

procedure TCRLoader.Prepare(RecordCount: integer);
begin
  Prepare;
end;

procedure TCRLoader.Finish;
begin
end;

procedure TCRLoader.Reset;
begin
  FLastRow := -1;
  FLoadedRows := 0;
end;

procedure TCRLoader.DoLoad;
begin
end;

procedure TCRLoader.FillColumn(Column: TCRLoaderColumn; FieldDesc: TFieldDesc);
begin
  Column.Name := FieldDesc.Name;
  Column.DataType := FieldDesc.DataType;
  Column.SubDataType := FieldDesc.SubDataType;
  case FieldDesc.DataType of
    dtInt8, dtUInt8, dtSmallint, dtInteger, dtInt64, dtWord, dtLongword, dtUInt64,
    dtFloat, dtCurrency, dtSingle,
    dtBCD{$IFDEF VER6P}{$IFNDEF FPC}, dtFMTBcd{$ENDIF}{$ENDIF}: begin
      Column.Precision := FieldDesc.Length;
      Column.Scale := FieldDesc.Scale;
    end;
  else
    Column.Size := FieldDesc.Length;
    Column.DataSize := FieldDesc.Size;
  end;
end;

procedure TCRLoader.CreateColumns;
var
  RecordSet: TCRRecordSet;
  FieldDesc: TFieldDesc;
  Col: TCRLoaderColumn;
  i: integer;
begin
  CheckTableName;
  FColumns.Clear;
  RecordSet := GetRecordSetClass.Create;
  RecordSet.SetConnection(FConnection);
  RecordSet.SetTransaction(FTransaction);
  RecordSet.SetProp(prFetchAll, True);
  RecordSet.SetSQL('SELECT * FROM ' + FTableName + ' WHERE 1=0'); // CR-M15322
  try
    RecordSet.Open;
    for i := 0 to RecordSet.Fields.Count - 1 do begin
      FieldDesc := RecordSet.Fields[i];
      if not (FieldDesc.ReadOnly and FSkipReadOnlyFieldDescs) then begin
        Col := GetColumnClass.Create;
        FillColumn(Col, FieldDesc);
        FColumns.Add(Col);
      end;
    end;
    RecordSet.Close;
  finally
    RecordSet.Free;
  end;
end;

procedure TCRLoader.DiscardRow;
begin
  if FLastRow >= FLoadedRows then
    Dec(FLastRow);
end;

class function TCRLoader.GetColumnClass: TCRLoaderColumnClass;
begin
  Result := TCRLoaderColumn;
end;

class function TCRLoader.GetRecordSetClass: TCRRecordSetClass;
begin
  Assert(False);
  Result := TCRRecordSet;
end;

procedure TCRLoader.SetConnection(Value: TCRConnection);
begin
  FConnection := Value;
end;

procedure TCRLoader.SetTransaction(Value: TCRTransaction);
begin
  FTransaction := Value;
end;

{ TCRSimpleLoader }

constructor TCRSimpleLoader.Create;
begin
  inherited;

  CreateCommand;
  FCommand.SetProp(prDisableParamScan, True);
end;

destructor TCRSimpleLoader.Destroy;
begin
  FCommand.Free;

  inherited;
end;

procedure TCRSimpleLoader.Reset;
begin
  inherited;

  FCommand.Params.Clear;
end;

procedure TCRSimpleLoader.DoPrepare;
var
  i: integer;
  Col: TCRLoaderColumn;
  Param: TParamDesc;
  InsertSB: StringBuilder;
begin
  FCommand.Unprepare;
  FCommand.SetConnection(FConnection);
  InsertSB := StringBuilder.Create(1024);
  try
    InsertSB.Append('INSERT INTO ' + FCommand.SQLInfo.NormalizeName(FTableName) + '(');
    for i := 0 to Columns.Count - 1 do begin
      Col := Columns[i];
      if i > 0 then
        InsertSB.Append(',');
      InsertSB.Append(FCommand.SQLInfo.NormalizeName(Col.Name, QuoteNames));
    end;
    InsertSB.Append(') VALUES (');

    for i := 0 to Columns.Count - 1 do begin
      Col := Columns[i];
      if FCommand.Params.Count <= i then begin
        Param := FCommand.GetParamDescType.Create;
        Param.SetDataType(Col.DataType);
        Param.SetSize(Col.Size);
        Param.SetParamType(pdInput);
        FCommand.Params.Add(Param);
      end;

      if i > 0 then
        InsertSB.Append(',?')
      else
        InsertSB.Append('?');
    end;
    InsertSB.Append(')');

    FCommand.SetSQL(InsertSB.ToString);
  finally
    InsertSB.Free;
  end;
  FCommand.Prepare;
end;

function TCRSimpleLoader.IsPutColumnDataAllowed: boolean;
begin
  Result := FCommand.SQL <> '';
end;

procedure TCRSimpleLoader.DoPutColumnData(Col: integer; Row: integer; const Value: variant);
var
  Param: TParamDesc;
begin
  Param := FCommand.Params[Col];
  Param.SetValue(Value);
  DoAddObjectRef(Value);
end;

procedure TCRSimpleLoader.PutColumnData(Col, Row: integer; const Value: variant);
begin
  if (FLastRow <> -1) and (Row > FLastRow + 1) then
    DoLoadRow;

  inherited;
end;

procedure TCRSimpleLoader.DoAfterLoadRow;
var
  i: integer;
begin
  if FObjectReleaseNeeded then
    for i := 0 to FCommand.Params.Count - 1 do
      DoReleaseObjectRef(FCommand.Params[i].Value);
end;

procedure TCRSimpleLoader.DoLoad;
begin
  if FLastRow >= FLoadedRows then
    DoLoadRow;
end;

procedure TCRSimpleLoader.DoLoadRow;
begin
  FCommand.Execute;
  FLoadedRows := FLastRow + 1;

  DoAfterLoadRow;
end;

procedure TCRSimpleLoader.Finish;
begin
  FCommand.Unprepare;
  Reset;

  inherited;
end;

{ TCRAlerter }

constructor TCRAlerter.Create;
begin
  inherited;

  FEventNames := TStringList.Create;
end;

destructor TCRAlerter.Destroy;
begin
  FEventNames.Free;

  inherited;
end;

function TCRAlerter.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prAutoCommit:
      ;
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

function TCRAlerter.GetProp(Prop: integer; var Value: variant): boolean;
begin
  Assert(False, IntToStr(Prop));
  Result := False;
end;

function TCRAlerter.IsActive: boolean;
begin
  Result := FActive;
end;

procedure TCRAlerter.SetConnection(Value: TCRConnection);
begin
  FConnection := Value;
end;

procedure TCRAlerter.SetTransaction(Value: TCRTransaction);
begin
  FTransaction := Value;
end;

initialization
  DefaultSQLInfo := TSQLInfo.Create(nil);

finalization
  DefaultSQLInfo.Free;

end.
