
//////////////////////////////////////////////////
//  SQL Server Data Access Components
//  Copyright © 1998-2007 Core Lab. All right reserved.
//  MSAccess
//////////////////////////////////////////////////

{$IFNDEF CLR}

{$I Sdac.inc}

unit MSAccess;
{$ENDIF}

{ $R MSAccess.res}

interface

uses
{$IFDEF CLR}
  Variants, System.XML, System.Text, 
{$ELSE}
  CLRClasses, CRXml,
{$ENDIF}
  Classes, MemDS, DBAccess, MemData, CRAccess, OLEDBAccess, SysUtils, DB, CRParser,
  OLEDBC, OLEDBIntf, MSConsts, MemUtils, DASQLMonitor, Windows, DAConsts, Win32Timer;

{$I SdacVer.inc}

const
  ftMSXML = 50;
  
{ TMSParam }
const
  /// WAR Need to sync with EdMSParams.FieldTypesWithSize on change
  FieldTypesWithSize: set of TFieldType = [ftString, ftFixedChar, {ftMemo - BLOB, }ftBytes, ftVarBytes, ftWideString];

type
  TMSParam = class (TDAParam)
  private
    FOLEDBType: DBTYPE;
  protected
    function GetSize: integer; override;
    procedure SetSize(Value: integer); override;

    procedure SetAsString(Value: string); override;
    procedure SetAsWideString(Value: WideString); override;
    procedure SetAsVariant(const Value: Variant); override;

    procedure CreateObject; override;

    function IsObjectDataType: boolean; overload;
    property ParamObject;
    property OLEDBType: DBTYPE read FOLEDBType write FOLEDBType;
  public
    constructor Create(Collection: TCollection); override;

    procedure AssignFieldValue(Field: TField; const Value: Variant); override;

    property AsString: string read GetAsString write SetAsString;
    property AsWideString: WideString read GetAsWideString write SetAsWideString;

  end;

{ TMSParams }
  TMSParams = class (TDAParams)
  private
    function GetItem(Index: Integer): TMSParam;
    procedure SetItem(Index: Integer; Value: TMSParam);

  public
    constructor Create(Owner: TPersistent);

    procedure Assign(Source: TPersistent); override;

    function ParamByName(const Value: string): TMSParam;
    function FindParam(const Value: string): TMSParam;
    property Items[Index: integer]: TMSParam read GetItem write SetItem; default;

  end;

{ TMSConnection }

  TMSConnection = class;
  TMSConnectionOptions = class (TDAConnectionOptions)
  protected
    FQuotedIdentifier: boolean;
    FLanguage: string;
    FEncrypt: boolean;
    FPersistSecurityInfo: boolean;
    FAutoTranslate: boolean;
    FNetworkLibrary: string;
    FApplicationName: string;
    FWorkstationID: string;
    FPacketSize: integer;
    FNumericType: TDANumericType;
    FProvider: TOLEDBProvider;
    FInitialFileName: string;
    FMultipleActiveResultSets: boolean;
    //FMaxDatabaseSize: integer;
    FFailoverPartner: string;

    procedure SetQuotedIdentifier(const Value: boolean);
    procedure SetLanguage(const Value: string);
    procedure SetEncrypt(const Value: boolean);
    procedure SetPersistSecurityInfo(const Value: boolean);
    procedure SetAutoTranslate(const Value: boolean);
    procedure SetNetworkLibrary(const Value: string);
    procedure SetApplicationName(const Value: string);
    procedure SetWorkstationID(const Value: string);
    procedure SetPacketSize(const Value: integer);
    procedure SetNumericType(Value: TDANumericType);
    procedure SetProvider(const Value: TOLEDBProvider);
    procedure SetInitialFileName(const Value: string);
    procedure SetMultipleActiveResultSets(const Value: boolean);
    //procedure SetMaxDatabaseFile(const Value: integer);
    procedure SetFailoverPartner(const Value: string);

  protected
    procedure AssignTo(Dest: TPersistent); override;

  public
    constructor Create(Owner: TMSConnection);

  published
    property QuotedIdentifier: boolean read FQuotedIdentifier write SetQuotedIdentifier default True;
    property Language: string read FLanguage write SetLanguage;
    property Encrypt: boolean read FEncrypt write SetEncrypt default False;
    property PersistSecurityInfo: boolean read FPersistSecurityInfo write SetPersistSecurityInfo default False;
    property AutoTranslate: boolean read FAutoTranslate write SetAutoTranslate default True;
    property NetworkLibrary: string read FNetworkLibrary write SetNetworkLibrary;
    property ApplicationName: string read FApplicationName write SetApplicationName;
    property WorkstationID: string read FWorkstationID write SetWorkstationID;
    property PacketSize: integer read FPacketSize write SetPacketSize default 4096;
    property NumericType: TDANumericType read FNumericType write SetNumericType default ntFloat;
    property Provider: TOLEDBProvider read FProvider write SetProvider default prAuto;
    property InitialFileName: string read FInitialFileName write SetInitialFileName;
    property MultipleActiveResultSets: boolean read FMultipleActiveResultSets write SetMultipleActiveResultSets default False;
    //property MaxDatabaseSize: integer read FMaxDatabaseSize write SetMaxDatabaseFile default 128;
    property FailoverPartner: string read FFailoverPartner write SetFailoverPartner;
    property KeepDesignConnected;
    property DisconnectedMode;
    property LocalFailover;
  end;

  TMSConnectionInfoMessageEvent = procedure (Sender: TObject; E: EMSError) of object;
  TMSSQL = class;

  TMSConnection = class (TCustomDAConnection)
  protected
    FLoginPrompt: boolean;
    FLockLoginPrompt: boolean;
    
    FDatabase: string;
    FIsolationLevel: TIsolationLevel;
    FAuthentication: TMSAuthentication;

    FConnectionTimeout: integer;
    // FMultipleConnections: boolean;
    FOptions: TMSConnectionOptions;

    FMSSQL: TMSSQL;

    FOnInfoMessage: TMSConnectionInfoMessageEvent;

    function GetIConnectionClass: TCRConnectionClass; override;
    function GetICommandClass: TCRCommandClass; override;
    function GetIRecordSetClass: TCRRecordSetClass; override;

    procedure CreateIConnection; override;
    procedure SetIConnection(Value: TCRConnection); override;
    procedure SetOptions(Value: TMSConnectionOptions);

    function GetOLEDBConnection: TOLEDBConnection;

    function SQLMonitorClass: TClass; override;
    function ConnectDialogClass: TConnectDialogClass; override;

    procedure AssignTo(Dest: TPersistent); override;

    procedure SetDatabase(Value: string);

    procedure SetIsolationLevel(const Value: TIsolationLevel);
    // procedure SetMultipleConnections(const Value: boolean);

    procedure SetAuthentication(const Value: TMSAuthentication);
    procedure SetConnectionTimeout(const Value: integer);
    function NeedPrompt: boolean; override;

    function IsFatalError(E: EDAError): boolean; override;
    procedure DoError(E: Exception; var Fail, Reconnect, Reexecute: boolean; ReconnectAttempt: integer;
      var ConnLostCause: TConnLostCause); override;   
    procedure DoInfoMessage(E: EMSError);
    function IsKeyViolation(E: EDAError): boolean; override;

    procedure Check(const Status: HRESULT; Sender: TObject);
    procedure CheckInactive;

  { Transaction control }
    procedure InternalStartTransaction; override;
    
    function CommitOnDisconnect: boolean; override;

    function GetConnectString: string; override;
    procedure SetConnectString(Value: string); override;
    function GetClientVersion: string;
    function GetServerVersion: string;


    function CreateOptions: TDAConnectionOptions; override;

    function IConnection: TOLEDBConnection;
    function IsCaseSensitive: boolean; override;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;

    function CreateDataSet: TCustomDADataSet; override;
    function CreateSQL: TCustomDASQL; override;

    procedure ChangePassword(NewPassword: string);
    function ExecSQL(Text: string; const Params: array of variant): variant; override;

    procedure GetTableNames(List: TStrings); override;
    procedure GetDatabaseNames(List: TStrings); override;
    procedure GetStoredProcNames(List: TStrings); overload; override;
    procedure GetStoredProcNames(List: TStrings; System: boolean); reintroduce; overload;

    property ClientVersion: string read GetClientVersion;
    property ServerVersion: string read GetServerVersion;

  published
    property Database: string read FDatabase write SetDatabase;
    property IsolationLevel: TIsolationLevel read FIsolationLevel write SetIsolationLevel default ilReadCommitted;
    property Authentication: TMSAuthentication read FAuthentication write SetAuthentication default auServer;
    property ConnectionTimeout: integer read FConnectionTimeout write SetConnectionTimeout default 15;
    // property MultipleConnections: boolean read FMultipleConnections write SetMultipleConnections; {without default!}

    property Options: TMSConnectionOptions read FOptions write SetOptions;
    
    property PoolingOptions;
    property Pooling;

    property Username;
    property Password;
    property Server;
    property Connected stored IsConnectedStored;

    property AfterConnect;
    property BeforeConnect;
    property AfterDisconnect;
    property BeforeDisconnect;
    property OnLogin;
    property OnError;
    property ConnectDialog;
    property LoginPrompt;
    property ConnectString;

    property OnInfoMessage: TMSConnectionInfoMessageEvent read FOnInfoMessage write FOnInfoMessage;
    property OnConnectionLost;
  end;

{ TCustomMSDataSet }

  TMSDataSetOptions = class (TDADataSetOptions)
  private
    FEnableBCD: boolean;
    FUniqueRecords: boolean;
    FCursorUpdate: boolean;
    FQueryIdentity: boolean;
    FCheckRowVersion: boolean;
    FDMLRefresh: boolean;
    FAutoRefresh: boolean;
    FAutoRefreshInterval: integer;
    FSmartRefresh: boolean;
    FDefaultValues: boolean;
    FNonBlocking: boolean;

    procedure SetEnableBCD(Value: boolean);
    procedure SetUniqueRecords(Value: boolean);
    procedure SetCursorUpdate(Value: boolean);
    function GetAllFieldsEditable: boolean;
    procedure SetAllFieldsEditable(const Value: boolean);
    procedure SetAutoRefresh(Value: boolean);
    procedure SetAutoRefreshInterval(Value: integer);
    //procedure SetSmartRefresh(Value: boolean);
    procedure SetNonBlocking(Value: boolean);
  protected
    procedure AssignTo(Dest: TPersistent); override;

  public
    constructor Create(Owner: TCustomDADataSet);

  published
    property AllFieldsEditable: boolean read GetAllFieldsEditable write SetAllFieldsEditable stored False;
    property EnableBCD: boolean read FEnableBCD write SetEnableBCD default False;
    property UniqueRecords: boolean read FUniqueRecords write SetUniqueRecords default False;
    property CursorUpdate: boolean read FCursorUpdate write SetCursorUpdate default True;
    property QueryIdentity: boolean read FQueryIdentity write FQueryIdentity default True;
    property CheckRowVersion: boolean read FCheckRowVersion write FCheckRowVersion default False;
    property FullRefresh default False;
    property DMLRefresh: boolean read FDMLRefresh write FDMLRefresh default False;
    property AutoRefresh: boolean read FAutoRefresh write SetAutoRefresh default False;
    property AutoRefreshInterval: integer read FAutoRefreshInterval write SetAutoRefreshInterval default 60; /// Seconds dac6.txt
    //property SmartRefresh: boolean read FSmartRefresh write SetSmartRefresh default False;
    property DefaultValues: boolean read FDefaultValues write FDefaultValues default False;
    property NonBlocking: boolean read FNonBlocking write SetNonBlocking default False;

    property LongStrings;
    property RequiredFields default False;
    property StrictUpdate;
    property NumberRange;
    property ReturnParams;
    property TrimFixedChar;
    property TrimVarChar;
    property QueryRecCount;
    property AutoPrepare;
    property RemoveOnRefresh;
    property FlatBuffers;
    property QuoteNames;
    property DetailDelay;
  {$IFDEF HAVE_COMPRESS}
    property CompressBlobMode;
  {$ENDIF}
    property LocalMasterDetail;
    property CacheCalcFields;
    property UpdateBatchSize;
    property UpdateAllFields;
  end;

  TCustomMSDataSet = class;
  TMSUpdateExecuteEvent = procedure (Sender: TCustomMSDataSet;
    StatementTypes: TStatementTypes; Params: TMSParams) of object;

  TMSSQLGenerator = class (TDASQLGenerator)
  protected
    function AssembleSB(const StatementType: TStatementType): string; override;
    function GetActualFieldNameEx(FieldDesc: TCRFieldDesc; TableInfo: TCRTableInfo): string; overload; override;
    procedure GenerateInsertSQL(
      const KeyAndDataFields: TKeyAndDataFields;
      const ModifiedFieldsOnly: boolean;
      const Index: integer = -1); override;
    procedure GenerateUpdateSQL(
      const KeyAndDataFields: TKeyAndDataFields;
      const ModifiedFieldsOnly: boolean;
      const Index: integer = -1); override;
    procedure GenerateRefreshSQLSelectPart(const KeyAndDataFields: TKeyAndDataFields); override;
    procedure GenerateRefreshSQL(
      const KeyAndDataFields: TKeyAndDataFields;
      const ModifiedFieldsOnly: boolean); override;
    function GetActualFieldName(FldDesc: TCRFieldDesc; IsRefresh: boolean): string; override;
    procedure AddFieldToCondition(SB: StringBuilder; FieldDesc: TCRFieldDesc;
      const StatementType: TStatementType;
      const ModifiedFieldsOnly: boolean;
      const Index: integer = -1); override;

    procedure GenerateConditions(SB: StringBuilder; const StatementType: TStatementType;
      const ModifiedFieldsOnly: boolean;
      const KeyAndDataFields: TKeyAndDataFields;
      const Index: integer = -1); override;
  end;

  TMSUpdateSQL = class;

  TCustomMSDataSet = class (TCustomDADataSet)
  private
    function GetConnection: TMSConnection;
    procedure SetConnection(Value: TMSConnection);
    procedure SetCursorType(const Value: TMSCursorType);
    procedure SetCommandTimeout(const Value: integer);

    function GetUpdateObject: TMSUpdateSQL;
    procedure SetUpdateObject(Value: TMSUpdateSQL);
  protected
  { IProviderSupport }
    function PSGetKeyFields: string; override;

  protected
    FIRecordSet: TOLEDBRecordSet;
    FICommand: TOLEDBCommand;

    FLockInitFieldDefs: boolean; //Used to prevent multiple calls to OLE DB Execute on FieldDefs.Update in DT generators

    FBeforeUpdateExecute: TMSUpdateExecuteEvent;
    FAfterUpdateExecute: TMSUpdateExecuteEvent;

    FIsAnyFieldDescCanBeModified: boolean;
    FTimestampField: TField;

    FOptions: TMSDataSetOptions;
    FCursorType: TMSCursorType;

    FCommandTimeout: integer;

    FIsInInitFieldDefs: boolean;
    FUseParamType: boolean;

    FCanOpenNext: boolean;

    FAutoRefreshTimer: TWin32Timer;
    
  { Smart Refresh}
  {$IFNDEF STD} 
    FRefreshServiceBroker: TComponent;
    FRefreshQueue: string;
    FRefreshService: string;
    FAfterSmartRefresh: TDataSetNotifyEvent;
    FNeedSmartRefresh: boolean;
  {$ENDIF}

    procedure AutoRefreshTimer(Sender: TObject);
    
    function QuoteName(const AName: string): string; overload; override;
    function QuoteName(const AName: string; const LeftQuote, RightQuote: string): string; reintroduce; overload;

    function GetParams: TMSParams;
    procedure SetParams(Value: TMSParams);

    procedure CreateIRecordSet; override;
    procedure SetIRecordSet(Value: TData); override;
    procedure SetNumericType;

    procedure CreateCommand; override;

    function CreateOptions: TDADataSetOptions; override;
    procedure SetOptions(Value: TMSDataSetOptions);

    procedure AssignTo(Dest: TPersistent); override;

    procedure BeginConnection(NoConnectCheck: boolean = True); override;
    procedure EndConnection; override;

  { Smart Refresh}
  {$IFDEF SMART_REFRESH}
  {$IFNDEF STD}
    procedure RegisterNotification;
    procedure UnregisterNotification;
  {$ENDIF}
  {$ENDIF}
    
  { Open/Close }
    procedure SetActive(Value: Boolean); override;
    procedure DataReopen; override;
    procedure InternalExecute; override;
    procedure InternalOpen; override;
    procedure InternalClose; override;
    procedure OpenCursor(InfoQuery: boolean); override;
    procedure GetFieldsInfo;
    function GetRecCount: longint; override;
    function GetRecordCount: integer; override;
    procedure DoCursorTypeChanged; // Callback from internal level. Called if CursorType or ReadOnly is changed on OLEDB execute
    procedure SetFetchAll(Value: boolean); override;
    procedure UpdateExecute(const StatementTypes: TStatementTypes); override;

    procedure CheckInactive; override;

  { Fields }
    procedure InitFieldDefs; override;
    procedure InternalInitFieldDefs; override;
    function GetFieldType(DataType: word): TFieldType; override;
    function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
  {$IFDEF USE_FTAUTOINC}
    function GetFieldType(FieldDesc: TFieldDesc): TFieldType; override;
  {$ENDIF}
    procedure SetNumberRange(FieldDef: TFieldDef); override;
    procedure DetectIdentityField; override;

  { Edit }
    procedure CreateSQLGenerator; override;
    procedure SetReadOnly(Value: boolean); override;
    procedure InternalBeforeEdit; override;
    procedure GetKeyAndDataFields(
      out KeyAndDataFields: TKeyAndDataFields;
      const ForceUseAllKeyFields: boolean); override;

    procedure InternalRefreshRecord; override;
    procedure CheckUpdateQuery(const StatementType: TStatementType); override;
    function UseParamType: boolean; override; //This function indicates ParamType using in PerformSQL
    function PerformSQL(const SQL: string; const StatementTypes: TStatementTypes): boolean; override;

    procedure InternalCreateProcCall(Name: string; NeedDescribe: boolean);
    
  { RefreshQuick}
    function IsRefreshQuickField(FieldDesc: TFieldDesc): boolean; override;
    procedure SaveMaxRefreshQuickValue(FieldDesc: TFieldDesc; const Value: variant); override;

    function GetCanModify: boolean; override;

    function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: boolean): TGetResult; override;

    function NeedReturnParams: boolean; override;

    procedure AssignFieldValue(Param: TDAParam; Field: TField; Old: boolean); override;
  { Smart Refresh}
  {$IFNDEF STD}
    procedure DoSmartRefresh;
  {$ENDIF}
    
  { Navigation }
    procedure InternalSetToRecord(Buffer: TRecordBuffer); override;

    procedure DoAfterExecute(Result: boolean); override;

  { Before / After UpdateExecute }
    function AssignedBeforeUpdateExecute: boolean; override;
    procedure DoBeforeUpdateExecute(Sender: TDataSet; StatementTypes: TStatementTypes;
      Params: TDAParams); override;
    function AssignedAfterUpdateExecute: boolean; override;
    procedure DoAfterUpdateExecute(Sender: TDataSet; StatementTypes: TStatementTypes;
      Params: TDAParams); override;

  { SQL Modifications }
    function SQLAddWhere(SQLText, Condition: string): string; override;
    function SQLDeleteWhere(SQLText: string): string; override;
    function SQLGetWhere(SQLText: string): string; override;
    function SQLSetOrderBy(SQLText: string; Fields: string): string; override;
    function SQLGetOrderBy(SQLText: string): string; override;

(*    procedure SetBeforeFetch(Value: TBeforeFetchEvent); override;
    procedure SetAfterFetch(Value: TAfterFetchEvent); override;*)

    procedure SetRefreshOptions(Value: TRefreshOptions); override;

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

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

  { Open/Close }
    function Fetched: boolean; override;
    procedure UnPrepare; override;
    function OpenNext: boolean; // Open next rowset in statement. if rowset not returne theh OpenNext return False. If statement has error, then raised exception
    procedure BreakExec;
    procedure RefreshQuick(const CheckDeleted: boolean);

    function FindParam(const Value: string): TMSParam;
    function ParamByName(const Value: string): TMSParam;

  { Edit}
    procedure CreateProcCall(Name: string);
    
    procedure Post; override;
    procedure Cancel; override;

  { SQL Modify }
    property Connection: TMSConnection read GetConnection write SetConnection;

    property Options: TMSDataSetOptions read FOptions write SetOptions;

  { Edit }
    property Params: TMSParams read GetParams write SetParams stored False;

    property CursorType: TMSCursorType read FCursorType write SetCursorType default ctDefaultResultSet;
    property CommandTimeout: integer read FCommandTimeout write SetCommandTimeout default 0;

    property BeforeUpdateExecute: TMSUpdateExecuteEvent read FBeforeUpdateExecute write FBeforeUpdateExecute;
    property AfterUpdateExecute: TMSUpdateExecuteEvent read FAfterUpdateExecute write FAfterUpdateExecute;
    property BeforeFetch;
    property AfterFetch;

    property FetchAll: boolean read FFetchAll write SetFetchAll default True;

    property UpdateObject: TMSUpdateSQL read GetUpdateObject write SetUpdateObject;    
  end;

{ TMSUpdateSQL }

  TMSUpdateSQL = class (TCustomDAUpdateSQL)
  protected
    function DataSetClass: TCustomDADataSetClass; override;
    function SQLClass: TCustomDASQLClass; override;
  end;

{ TMSQuery }

  TMSQuery = class (TCustomMSDataSet)
  protected
    procedure SetIRecordSet(Value: TData); override;

  published
    property SQLInsert;
    property SQLDelete;
    property SQLUpdate;
    property SQLRefresh;

    property Connection;
    property ParamCheck;
    property SQL;
    property Debug;
    property Macros;
    property Params;
    property FetchRows;
    property ReadOnly;
    property UniDirectional;
    property CachedUpdates;

    property AfterExecute;
    property BeforeUpdateExecute;
    property AfterUpdateExecute;
    property OnUpdateError;
    property OnUpdateRecord;

    property UpdateObject;
    property RefreshOptions;

    property AutoCalcFields;
    property Filtered;
    property Filter;
    property FilterOptions;

    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnFilterRecord;
    property OnNewRecord;
    property OnPostError;
  {$IFNDEF VER4}
    property AfterRefresh;
    property BeforeRefresh;
  {$ENDIF}

    property Options;
    property FilterSQL;

    property MasterSource;
    property MasterFields;
    property DetailFields;

    property UpdatingTable;

    property FetchAll;
    property CursorType;
    property CommandTimeout;

    property IndexFieldNames;
    property Active; /// CR DAC 13049
    property BeforeFetch;
    property AfterFetch;  
  end;

{ TMSTable }

  TCustomMSTable = class (TCustomMSDataSet)
  protected
  { IProviderSupport }
    function PSGetTableName: string; override;
    procedure PSSetParams(AParams: DB.TParams); override;
  {$IFDEF VER5P}
    procedure PSSetCommandText(const CommandText: string); override;
  {$ENDIF}

  protected
    FTableName: string;
    FOrderFields: string;

    procedure SetTableName(const Value: string);

    procedure SetOrderFields(Value: string);
    procedure AssignTo(Dest: TPersistent); override;

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

  public
  { Open/Close }
    procedure Prepare; override;
    procedure PrepareSQL;
    procedure Execute; override;

    property TableName: string read FTableName write SetTableName;
    property OrderFields: string read FOrderFields write SetOrderFields;
  end;
  
  TMSTable = class (TCustomMSTable)
  published
    property TableName;
    property OrderFields;
    property MasterFields;
    property DetailFields;
    property MasterSource;
    property ReadOnly;

    property Connection;

    property Debug;
    property FetchRows;
    property UniDirectional;
    property CachedUpdates;

    property OnUpdateError;
    property OnUpdateRecord;

    property UpdateObject;
    property RefreshOptions;

    property Active;
    property AutoCalcFields;
    property Filtered;
    property Filter;
    property FilterOptions;

    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnFilterRecord;
    property OnNewRecord;
    property OnPostError;
  {$IFNDEF VER4}
    property AfterRefresh;
    property BeforeRefresh;
  {$ENDIF}
    property Options;
    property FilterSQL;

    property FetchAll;
    property CursorType;
    property CommandTimeout;

    property IndexFieldNames;
    
    property BeforeFetch;
    property AfterFetch;  
  end;
  
{ TMSStoredProc }

  TCustomMSStoredProc = class (TCustomMSDataSet)
  protected
  { IProviderSupport }
  {$IFDEF VER5P}
    procedure PSSetCommandText(const CommandText: string); override;
  {$ENDIF}

  protected
    FStoredProcName: string;
    FIsInPrepare: boolean;

    procedure SetIRecordSet(Value: TData); override;
    procedure SetStoredProcName(const Value: string);
    procedure AssignTo(Dest: TPersistent); override;

    procedure BeforeOpenCursor(InfoQuery: boolean); override;
    procedure BeforeExecute; override;
    procedure CreateFieldDefs; override;

  public
    procedure ExecProc; // for BDE compatibility

    procedure Prepare; override;
    procedure PrepareSQL;

    property UpdatingTable;
    property StoredProcName: string read FStoredProcName write SetStoredProcName;
  end;

  TMSStoredProc = class(TCustomMSStoredProc)
  published
    property StoredProcName;

    property SQLInsert;
    property SQLDelete;
    property SQLUpdate;
    property SQLRefresh;

    property Connection;
    property ParamCheck stored False;
    property SQL;
    property Debug;
    property Params;
    property FetchRows;
    property ReadOnly;
    property UniDirectional;
    property CachedUpdates;

    property AfterExecute;
    property BeforeUpdateExecute;
    property AfterUpdateExecute;
    property OnUpdateError;
    property OnUpdateRecord;

    property Options;
    property UpdateObject;
    property RefreshOptions;

    property Active;
    property AutoCalcFields;
    property Filtered;
    property Filter;
    property FilterOptions;
    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnFilterRecord;
    property OnNewRecord;
    property OnPostError;
  {$IFNDEF VER4}
    property AfterRefresh;
    property BeforeRefresh;
  {$ENDIF}

    property UpdatingTable;

    property FetchAll;
    property CursorType;
    property CommandTimeout;
  end;
  
{ TMSSQL }

  TMSSQL = class (TCustomDASQL)
  private
    function GetConnection: TMSConnection;
    procedure SetConnection(Value: TMSConnection);

    function GetParams: TMSParams;
    procedure SetParams(Value: TMSParams);

  protected
    FICommand: TOLEDBCommand;
    FCommandTimeout: integer;
    FNonBlocking: boolean;

    function GetPermitPrepare: boolean;
    procedure SetPermitPrepare(Value: boolean);

    procedure CreateICommand; override;
    procedure SetICommand(Value: TCRCommand); override;
    procedure InternalPrepare; override;
    procedure InternalExecute(Iters: integer); override;
    procedure AssignTo(Dest: TPersistent); override;

    function ParseSQL(const SQL: string; Params: TDAParams; RenamePrefix: string = ''): string; override;
    function CreateParser(const Text: string): TParser; override;
    procedure AssembleSQL; override;
    function CreateParamsObject: TDAParams; override;
    procedure CreateParams; override;
    procedure WriteParams(WriteValue: boolean = True); override;
    procedure ReadParams; override;

    procedure SetCommandTimeout(const Value: integer);
    procedure SetNonBlocking(const Value: boolean);
  public
    constructor Create(Owner: TComponent); override;
    procedure Execute(Iters: integer); override;
    procedure BreakExec;

    procedure CreateProcCall(Name: string);
  published
    function FindParam(const Value: string): TMSParam;
    function ParamByName(const Value: string): TMSParam;

    property Connection: TMSConnection read GetConnection write SetConnection;
    property Params: TMSParams read GetParams write SetParams stored False;

    property ParamCheck;
    property SQL;
    property Macros;
    property Debug;

    property AfterExecute;
    property CommandTimeout: integer read FCommandTimeout write SetCommandTimeout;
    property NonBlocking: boolean read FNonBlocking write SetNonBlocking default False;

    property PermitPrepare: boolean write SetPermitPrepare stored False;

  end;

{ TMSMetadata }

  TMSObjectType = (otDatabases, 
    otColumnPrivileges, otColumns, 
    otForeignKeys, otPrimaryKeys, 
    otIndexes,
    otServerTypes,
    otSchemata, otStatistics,
    otStoredProcs, otStoredProcParams, 
    otAliases, otTables, otSynonyms, otSystemTables, otViews, otGlobalTempTables, otLocalTempTables, otSystemViews, 
    otAliasesInfo, otTablesInfo, otSynonymsInfo, otSystemTablesInfo, otViewsInfo, otGlobalTempTablesInfo, otLocalTempTablesInfo, otExternalTablesInfo, otSystemViewsInfo, 
    otTableConstraints, otTablePrivileges,
    otLinkedServers,
    otAssemblies,
    otAssemblyDependencies,
    otUserTypes,
    otXMLCollections);

  TMSMetadata = class (TCustomMSDataSet)
  protected
    FObjectType: TMSObjectType;

    FDatabaseName: string;
    FSchemaName: string;
    FTableName: string;
    FStoredProcName: string;
    FColumnName: string;
    FIndexName: string;
    FConstraintName: string;
    FLinkedServer: string;
    FAssemblyName: string;
    FAssemblyID: integer;
    FReferencedAssemblyID: integer;
    FUDTName: string;
    FSchemaCollectionName: string;
    FTargetNamespaceURI: string;

    procedure SetDatabaseName(Value: string);
    procedure SetSchemaName(Value: string);
    procedure SetObjectType(Value: TMSObjectType);
    procedure SetTableName(Value: string);
    procedure SetStoredProcName(Value: string);
    procedure SetColumnName(Value: string);
    procedure SetIndexName(Value: string);
    procedure SetConstraintName(Value: string);
    procedure SetLinkedServer(Value: string);
    procedure SetAssemblyName(Value: string);
    procedure SetAssemblyID(Value: integer);
    procedure SetReferencedAssemblyID(Value: integer);
    procedure SetUDTName(Value: string);
    procedure SetSchemaCollectionName(Value: string);
    procedure SetTargetNamespaceURI(Value: string);

    function RequestIRowset: IRowset;
    procedure InternalExecute; override;
    procedure OpenCursor(InfoQuery: boolean); override;

  public
    constructor Create(Owner: TComponent); override;

  published
    property ObjectType: TMSObjectType read FObjectType write SetObjectType default otDatabases;

    property DatabaseName: string read FDatabaseName write SetDatabaseName;
    property SchemaName: string read FSchemaName write SetSchemaName;
    property TableName: string read FTableName write SetTableName;
    property StoredProcName: string read FStoredProcName write SetStoredProcName;
    property ColumnName: string read FColumnName write SetColumnName;
    property IndexName: string read FIndexName write SetIndexName;
    property ConstraintName: string read FConstraintName write SetConstraintName;

    property LinkedServer: string read FLinkedServer write SetLinkedServer;
    property AssemblyName: string read FAssemblyName write SetAssemblyName;
    property AssemblyID: integer read FAssemblyID write SetAssemblyID default 0;
    property ReferencedAssemblyID: integer read FReferencedAssemblyID write SetReferencedAssemblyID default 0;
    property UDTName: string read FUDTName write SetUDTName;
    property SchemaCollectionName: string read FSchemaCollectionName write SetSchemaCollectionName;
    property TargetNamespaceURI: string read FTargetNamespaceURI write SetTargetNamespaceURI;

    property Active;
    property Connection;
  end;

  TMSSchemaCollection = record
    Name: string;
    CatalogName: string;
    SchemaName: string;
  end;

  TMSXMLField = class(TField)
  protected
    FTyped: boolean;
    FSchemaCollection: TMSSchemaCollection;
    procedure GetText(var Text: string; DisplayText: Boolean); override;
    procedure SetSchemaCollection(Name, CatalogName, SchemaName: string);

    function GetBlobSize: Integer; 
    // function GetModified: Boolean;
    // procedure SetModified(Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;

    // Copied from TBlobField
    // procedure Assign(Source: TPersistent); override;
    procedure Clear; override;
    class function IsBlob: Boolean; override;
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure SaveToStream(Stream: TStream);
    procedure SetFieldType(Value: TFieldType); override;
    property BlobSize: Integer read GetBlobSize;
    // property Modified: Boolean read GetModified write SetModified;
    property Value: string read GetAsString write SetAsString;

    property XML: string read GetAsString write SetAsString;
    property Typed: boolean read FTyped;
    property SchemaCollection: TMSSchemaCollection read FSchemaCollection;
  published
    // property Transliterate: Boolean read FTransliterate write FTransliterate default True;
    // property Size default 0;
  end;

{ TMSDataSource }

  TMSDataSource = class(TCRDataSource)
  end;

  TMSAccessUtils = class
  public
    class procedure GetKeyAndDataFields(
      Obj: TCustomMSDataSet;
      out KeyAndDataFields: TKeyAndDataFields;
      const ForceUseAllKeyFields: boolean);
    class procedure SetDesigning(Obj: TCustomMSDataSet; Value: Boolean; SetChildren: Boolean = True);
    class procedure SetLockLoginPromt(Obj: TMSConnection; Value: Boolean);

    class function FIConnection(Obj: TMSConnection): TOLEDBConnection;
    class function FIRecordSet(Obj: TCustomMSDataSet): TOLEDBRecordSet;

    class function GetOLEDBSQL(Obj: TCustomMSDataSet): string; overload;
    class function GetOLEDBSQL(Obj: TMSSQL): string; overload;

    class function FIDBCreateSession(Obj: TOLEDBConnection): IDBCreateSession;

    class procedure DoError(Obj: TMSConnection; E: Exception; var Fail: boolean);
  end;

  procedure GetServerList(List: TStrings);
  procedure GetDatabasesList(const Connection: TMSconnection; List: TStrings);
  procedure GetTablesList(const Connection: TMSconnection; List: TStrings);

  function IsLargeDataTypeUsed(const Field: TField): boolean; overload;

  function TableNamesFromList(List: TStrings): string;
  procedure TableNamesToList(Value: string; List: TStrings);

var
  DefConnectDialogClassProc: function: TClass = nil;
  CurrentProjectOutputDir: string;
  __UseUpdateOptimization: boolean;


implementation

{ $DEFINE SMART_REFRESH}

uses
{$IFDEF CLR}
  System.Runtime.InteropServices, System.Reflection,
{$ENDIF}
{$IFDEF VER7P}
  StrUtils,
{$ENDIF}
{$IFDEF VER6P}
{$IFNDEF CLR}
  Variants,
{$ENDIF}
{$ELSE}
  comobj,
{$ENDIF}
  DBCommon, DBConsts, MSParser, Registry, ActiveX, MSSQLMonitor, Math, DBMonitorIntf,
  MSConnectionPool, CRConnectionPool,
{$IFDEF SMART_REFRESH}
{$IFNDEF STD}
  MSServiceBroker,
{$ENDIF}
{$ENDIF}
  Messages;

{$IFDEF SMART_REFRESH}
{$IFNDEF STD}
const
  sSdacService = '__SdacNotificationService';
  sSdacQueue = '__SdacNotificationQueue';

type
  TMSRefreshServiceBroker = class(TMSServiceBroker)
  private
    FDataSet: TCustomMSDataSet;
    FErrorCount: integer;
  protected
    procedure OnThreadEvent(Sender: TObject; Event: TObject; var Cancel: boolean); override;
    procedure OnThreadMessage(Sender: TObject; Event: TObject); override;
  public
    procedure Start; override;
  end;
  
{ TMSRefreshServiceBroker }

procedure TMSRefreshServiceBroker.OnThreadEvent(Sender: TObject; Event: TObject; var Cancel: boolean);

  procedure CheckQNError(Source, Info: string);
  begin
    if Source = 'statement' then begin
      if Info = 'query' then
        DatabaseError(SInvalidQNStatement)
      else
        if Info = 'invalid' then
          DatabaseError(SStatementNotSupported)
        else
          if Info = 'set options' then
            DatabaseError(SInvalidQNSetOptions)
          else
            if Info = 'isolation' then
              DatabaseError(SInvalidQNIsolation)
            else
              if Info = 'query template limit' then
                DatabaseError(STemplateLimit);
    end
    else
      if Source = 'timeout' then
        DatabaseError(SSubscriptionTimedOut)
      else
        if Source = 'object' then begin
          if Info = 'drop' then
            DatabaseError(SQNObjectDropped)
          else
            if Info = 'alter' then
              DatabaseError(SQNObjectAltered)
        end
        else
          if Source = 'system' then begin
            if Info = 'restart' then
              DatabaseError(SSQLServerStarted)
            else
              if Info = 'error' then
                DatabaseError(SSQLInternalError)
              else
                if Info = 'resource' then
                  DatabaseError(SSubscriptionRemoved)
          end;
  end;

begin
  inherited;

  if TMSServiceBrokerMsg(Event).MessageProperties.QNMessage <> GetComponentName(FDataSet) then
    Cancel := True
  else
    try
      // Check Query Notification Error
      CheckQNError(TMSServiceBrokerMsg(Event).MessageProperties.QNSource, TMSServiceBrokerMsg(Event).MessageProperties.QNInfo);
    except
      if FErrorCount >= 1 then begin
        // FDataSet.UnregisterNotification
        raise;
      end
        else
          Inc(FErrorCount);
      Cancel := True;
    end;
end;

procedure TMSRefreshServiceBroker.OnThreadMessage(Sender: TObject; Event: TObject);
begin
  Event.Free;
  FDataSet.DoSmartRefresh;
end;

procedure TMSRefreshServiceBroker.Start;
begin
  FErrorCount := 0;
  inherited;
end;
{$ENDIF}
{$ENDIF}

{$IFNDEF VER6P}
const
  varShortInt = $0010; { vt_i1          }
  varWord     = $0012; { vt_ui2         }
  varLongWord = $0013; { vt_ui4         }
  varInt64    = $0014; { vt_i8          }
{$ENDIF}

function IsLargeDataTypeUsed(const Field: TField): boolean; overload;
begin
  Result :=
    (Field is TBlobField) or
    ((Field is TMemoField) and (TMemoField(Field).BlobSize > MaxNonBlobFieldLen));
end;

function IsLargeDataTypeUsed(const Param: TParam): boolean; overload;
begin
  Result :=
       (Param.DataType = ftBlob)
    or (Param.DataType = ftMemo)
  {$IFDEF VER10P}
    or (Param.DataType = ftWideMemo)
  {$ENDIF};
end;

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

procedure TableNamesToList(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 := UnbracketIfPossible(Trim(St));
      if St <> '' then
        List.Add(St);
      St := '';
    end
    else
      St := St + Value[i];

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

function GetFieldType(DataType: word): TFieldType;
begin
  case DataType of
    dtInt64:
      Result := ftLargeInt;
    dtWord:
      Result := ftWord;
    dtBoolean:
      Result := ftBoolean;
    dtCurrency:
      Result := ftCurrency;
    dtBytes:
      Result := ftBytes;
    dtVarBytes:
      Result := ftVarBytes;
    dtMSXML:
      Result := TFieldType(ftMSXML);
  {$IFDEF VER5P}
{    dtVariant:
      Result := ftVariant;}
{    dtIUnknown:
      Result := ftInterface;}
  {$ENDIF}
  else
    Result := MemDS.GetFieldType(DataType);
  end;
end;

function GetDataType(FieldType: TFieldType): word;
begin
  if Integer(FieldType) = ftMSXML then
    Result := dtMSXML
  else
    Result := MemDS.GetDataType(FieldType);
end;

function SetWhere(SQL: string; Condition: string): string;
begin
  Result := _SetWhere(SQL, Condition, TMSParser, True, lxSELECT, lxWHERE);
end;

function AddWhere(SQL: string; Condition: string): string;
begin
  Result := _AddWhere(SQL, Condition, TMSParser, False, lxSELECT, lxWHERE);
end;

function DeleteWhere(SQL: string): string;
begin
  Result := SetWhere(SQL, '');
end;

function GetWhere(SQL: string): string;
begin
  Result := _GetWhere(SQL, TMSParser, False, lxSELECT, lxWHERE);
end;

function SetOrderBy(SQL: string; Fields: string): string;
begin
  Result := _SetOrderBy(SQL, Fields, TMSParser, lxSELECT, lxORDER, lxBY);
end;

function GetOrderBy(SQL: string): string;
begin
  Result := _GetOrderBy(SQL, TMSParser, lxSELECT, lxORDER, lxBY);
end;

procedure GetServerList(List: TStrings);
  procedure GetServerListByReg;
  var
    Reg: TRegistry;
    i: integer;
    Value: string;
    sl: tstringlist;
  begin
    Reg := TRegistry.Create;
    sl := TStringList.Create;
    try
      Reg.RootKey := HKEY_Local_Machine;
      if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\MSSQLServer\Client\ConnectTo') then begin
        Reg.GetValueNames(sl);

        // Delete non-server occurences
        for i := sl.Count - 1 downto 0 do begin
          Value := Reg.ReadString(sl[i]);
          if Pos(',', Value) = 0 then
            sl.Delete(i);
        end;

        sl.Sort;
        List.AddStrings(sl);
      end;
    finally
      Reg.Free;
      sl.Free;
    end;
  end;

  procedure GetServerListByOleDBEnum;
  var
    SourcesRowset: ISourcesRowset;
    Rowset: IRowset;
    ds: TCustomMSDataset;
    iu: IUnknown;
  begin
    if CoCreateInstance(CLSID_SQLOLEDB_ENUMERATOR, 
                                 nil,
                                 CLSCTX_INPROC_SERVER, 
                                 IID_ISourcesRowset, 
                                 SourcesRowset) <> S_OK then
      Exit;
        
    if SourcesRowset.GetSourcesRowset(nil, IID_IRowset, 0, nil, iu) <> S_OK then
      Exit;

    Rowset := IRowset(iu);
    ds := TCustomMSDataSet.Create(nil);
    try
      TDBAccessUtils.SetLockDebug(ds, True); // To prevent AV on TCustomDADataSet.OpenCursor -> UsedConnection.SQLMonitorClass
      ds.FIRecordSet.SetIRowset(Rowset, False);
      ds.Open;

      while not ds.Eof do begin
        List.Add(ds.Fields[0].AsString);
        ds.Next;
      end;
    finally
      ds.Free;
    end;
  end;

begin
  List.Clear;
  GetServerListByOleDBEnum;
  GetServerListByReg;
end;

procedure GetDatabasesList(const Connection: TMSconnection; List: TStrings);
begin
  if Connection = nil then
    Exit;

  Connection.GetDatabaseNames(List);
end;

procedure GetTablesList(const Connection: TMSconnection; List: TStrings);
begin
  if Connection = nil then
    Exit;

  Connection.GetTableNames(List);
end;

{ TMSParam }

constructor TMSParam.Create(Collection: TCollection);
begin
  inherited Create(Collection);

  Bound := True;
end;

procedure TMSParam.SetAsString(Value: string);
begin
  if not (DataType in [ftBytes, ftVarBytes]) then
    inherited
  else
    Self.Value := Value;
end;

procedure TMSParam.SetAsWideString(Value: WideString);
begin
  if not (DataType in [ftBytes, ftVarBytes]) then
    inherited
  else
    Self.Value := Value;
end;

function TMSParam.GetSize: integer;
begin
  if DataType in FieldTypesWithSize then begin
    if inherited GetSize > 0 then
      Result := inherited GetSize
    else
      if (DataType in [ftBytes, ftVarBytes]) and VarIsArray(Value) then
      {$IFDEF CLR}
        Result := VarArrayHighBound(Value, 1) - VarArrayLowBound(Value, 1) + 1
      {$ELSE}
        Result := TVarData(Value).VArray.Bounds[0].ElementCount
      {$ENDIF}
      else
      Result := Length(GetAsString);
  end
  else
    Result := 0;
end;

procedure TMSParam.SetSize(Value: integer);
begin
  if DataType in FieldTypesWithSize then
    inherited;
end;

procedure TMSParam.SetAsVariant(const Value: Variant);
var
  l, lold: integer;
begin
  inherited;
  if (DataType in FieldTypesWithSize) and not (VarIsNull(Value) or VarIsEmpty(Value)) then begin
    lold := inherited GetSize;
    if lold > 0 then begin
    {$IFDEF CLR}
      if VarType(Value) = varArray + varByte then
        l := Length(TBytes(Value))
      else
    {$ENDIF}
        l := Length(Value);
      if l > lold then
        inherited SetSize(l);
    end;
  end;
  Bound := True;
end;

procedure TMSParam.CreateObject;
begin
  Assert(FParamObject = nil);
  if (DataType in [ftBlob, ftMemo{$IFDEF VER10P}, ftWideMemo{$ENDIF}]) or (DataType = TFieldType(ftMSXML)) then
  {$IFDEF HAVE_COMPRESS}
    FParamObject := TCompressedBlob.Create;
  {$ELSE}
    FParamObject := {$IFDEF CLR}CoreLab.Dac.MemData.{$ENDIF}TBlob.Create;
  {$ENDIF}
end;

function TMSParam.IsObjectDataType: boolean;
begin
  Result := inherited IsObjectDataType;
end;

procedure TMSParam.AssignFieldValue(Field: TField; const Value: Variant);
var
  FieldDesc: TOLEDBFieldDesc;
begin
  inherited AssignFieldValue(Field, Value);

  if IsClass(Field.DataSet, TCustomMSDataSet) then begin
    FieldDesc := TOLEDBFieldDesc(TCustomDADataSet(Field.DataSet).GetFieldDesc(Field));
    OLEDBType := FieldDesc.OLEDBType;
  end;
end;

{ TMSParams }

constructor TMSParams.Create(Owner: TPersistent);
begin
  inherited Create(TMSParam);

  FOwner := Owner;
  FNeedsUpdateItem := True;  
end;

procedure TMSParams.Assign(Source: TPersistent); 
var
  i: integer;
begin
  inherited;

  if Source is TMSParams then
    for i := 0 to Count - 1 do
      TMSParams(Source)[i].Assign(Items[i]);
end;
    
function TMSParams.GetItem(Index: Integer): TMSParam;
begin
  Result := inherited Items[Index] as TMSParam;
end;

procedure TMSParams.SetItem(Index: Integer; Value: TMSParam);
begin
  inherited SetItem(Index, Value);
end;

function TMSParams.ParamByName(const Value: string): TMSParam;
begin
  Result := TMSParam(inherited ParamByName(GetParamNameWODog(Value)));
end;

function TMSParams.FindParam(const Value: string): TMSParam;
begin
  Result := TMSParam(inherited FindParam(GetParamNameWODog(Value)));
end;

{ TMSConnectionOptions }

procedure TMSConnectionOptions.AssignTo(Dest: TPersistent);
begin
  inherited;

  if Dest is TMSConnectionOptions then begin
    TMSConnectionOptions(Dest).QuotedIdentifier := QuotedIdentifier;
    TMSConnectionOptions(Dest).Language := Language;
    TMSConnectionOptions(Dest).Encrypt := Encrypt;
    TMSConnectionOptions(Dest).PersistSecurityInfo := PersistSecurityInfo;
    TMSConnectionOptions(Dest).AutoTranslate := AutoTranslate;
    TMSConnectionOptions(Dest).NetworkLibrary := NetworkLibrary;
    TMSConnectionOptions(Dest).PacketSize := PacketSize;
    TMSConnectionOptions(Dest).ApplicationName := ApplicationName;
    TMSConnectionOptions(Dest).WorkstationID := WorkstationID;
    TMSConnectionOptions(Dest).Provider := Provider;
    TMSConnectionOptions(Dest).FailoverPartner := FailoverPartner;
  end;
end;

constructor TMSConnectionOptions.Create(Owner: TMSConnection);
begin
  inherited Create(Owner);
  
  FQuotedIdentifier := True;
  FPacketSize := DefaultPacketSize;
  FAutoTranslate := True;
  FProvider := prAuto;
  //FMaxDatabaseSize := 128;
  FFailoverPartner := '';
end;

procedure TMSConnectionOptions.SetEncrypt(const Value: boolean);
begin
  if FEncrypt <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FEncrypt := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prEncrypt, Value);
  end;
end;

procedure TMSConnectionOptions.SetPersistSecurityInfo(const Value: boolean);
begin
  if FPersistSecurityInfo <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FPersistSecurityInfo := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prPersistSecurityInfo, Value);
  end;
end;

procedure TMSConnectionOptions.SetAutoTranslate(const Value: boolean);
begin
  if FAutoTranslate <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FAutoTranslate := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prAutoTranslate, Value);
  end;
end;

procedure TMSConnectionOptions.SetLanguage(const Value: string);
begin
  if FLanguage <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FLanguage := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prLanguage, Value);
  end;
end;

procedure TMSConnectionOptions.SetNetworkLibrary(
  const Value: string);
begin
  if FNetworkLibrary <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FNetworkLibrary := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prNetworkLibrary, Value);
  end;
end;

procedure TMSConnectionOptions.SetApplicationName(
  const Value: string);
begin
  if FApplicationName <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FApplicationName := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prApplicationName, Value);
  end;
end;

procedure TMSConnectionOptions.SetWorkstationID(
  const Value: string);
begin
  if FWorkstationID <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FWorkstationID := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prWorkstationID, Value);
  end;
end;

procedure TMSConnectionOptions.SetPacketSize(const Value: integer);
begin
  if FPacketSize <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FPacketSize := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prPacketSize, Value);
  end;
end;

procedure TMSConnectionOptions.SetProvider(const Value: TOLEDBProvider);
begin
  if FProvider <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FProvider := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prProvider, Integer(Value));
    if (Value = prCompact) and (TMSConnection(FOwner).Database = DefaultSDACDatabase) then
      TMSConnection(FOwner).Database := ''
    else
      if (Value <> prCompact) and (TMSConnection(FOwner).Database = '') then
        TMSConnection(FOwner).Database := DefaultSDACDatabase;
  end;
end;

procedure TMSConnectionOptions.SetNumericType(Value: TDANumericType);
begin
  if FNumericType <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FNumericType := Value;
  end;
end;

procedure TMSConnectionOptions.SetQuotedIdentifier(const Value: boolean);
begin
  if FQuotedIdentifier <> Value then begin
    // CheckInactive is not need

    FQuotedIdentifier := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prQuotedIdentifier, Value);
  end;
end;

procedure TMSConnectionOptions.SetInitialFileName(const Value: string);
begin
  if FInitialFileName <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FInitialFileName := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prInitialFileName, Value);
  end;
end;

procedure TMSConnectionOptions.SetMultipleActiveResultSets(const Value: boolean);
begin
  if FMultipleActiveResultSets <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FMultipleActiveResultSets := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prMARS, Value);
  end;
end;

(*procedure TMSConnectionOptions.SetMaxDatabaseFile(const Value: integer);
begin
  if FMaxDatabaseSize <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FMaxDatabaseSize := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prMaxDatabaseSize, Value);
  end;
end;*)

procedure TMSConnectionOptions.SetFailoverPartner(const Value: string);
begin
  if FFailoverPartner <> Value then begin
    TMSConnection(FOwner).CheckInactive;
    FFailoverPartner := Value;
    if TMSConnection(FOwner).IConnection <> nil then
      TMSConnection(FOwner).IConnection.SetProp(prFailoverPartner, Value);
  end;
end;

{ TMSConnection }

constructor TMSConnection.Create(Owner: TComponent);
begin
  inherited;

  FLockLoginPrompt := False;

  Database := DefaultSDACDatabase;
  IsolationLevel := ilReadCommitted;
  Authentication := auServer;
  // MultipleConnections := True;

  ConnectionTimeout := DefaultConnectionTimeout;
  FOptions := inherited Options as TMSConnectionOptions;
end;

destructor TMSConnection.Destroy;
begin
  FMSSQL.Free;
  
  inherited;
end;

function TMSConnection.CreateOptions: TDAConnectionOptions;
begin
  Result := TMSConnectionOptions.Create(Self);
end;

function TMSConnection.IConnection: TOLEDBConnection;
begin
  Result := TOLEDBConnection(FIConnection);
end;

function TMSConnection.IsCaseSensitive: boolean;
begin
  Result := False;
end;

procedure TMSConnection.Check(const Status: HRESULT; Sender: TObject);
begin
  Assert(FIConnection <> nil);
  TOLEDBConnection(FIConnection).Check(Status, Sender);
end;

procedure TMSConnection.CheckInactive;
begin
  if Connected then
    if ([csUpdating, csDesigning] * ComponentState) <> [] then
      Close
    else
      DatabaseError(SConnectionOpen, Self);
end;

procedure TMSConnection.InternalStartTransaction;
begin
  inherited;
  
  if {Assigned(OnConnectionLost) and}
    ((TOLEDBCOnnection(FIConnection).DBMSPrimaryVer <= 8) or (TOLEDBCOnnection(FIConnection).ProviderPrimaryVer <= 8))and
    not (Options.Provider = prCompact) then begin
    FTransactionID := '';
    ExecSQL(SCheckConnection, []);
  end;
  FTransactionID := 'Local';
end;


function TMSConnection.CommitOnDisconnect: boolean;
begin
  Result := False;
end;

function TMSConnection.GetConnectString: string;

  procedure AddParam(const ParamName: string; const Value: string; const DefValue: string);
  begin
    if Value <> DefValue then begin
      if Result <> '' then
        Result := Result + ';';
      Result := Result + ParamName + '=' + Value;
    end;
  end;

begin
  Result := '';

  /// list of supported parameters must be syncronized with SetConnectString (ProcessParam and set param to default)
  if Options.FProvider <> prAuto then
    AddParam('Provider', GetProviderName(Options.FProvider), '');
  AddParam('User ID', UserName, '');
  AddParam('Password', Password, '');
  if Options.Provider <> prCompact then begin
    AddParam('Data Source', Server, '');
    AddParam('Initial Catalog', Database, DefaultSDACDatabase);
  end
  else
    AddParam('Data Source', '"' + Database + '"', '');
  AddParam('Connect Timeout', IntToStr(ConnectionTimeout), IntToStr(DefaultConnectionTimeout));
  AddParam('Use Encryption for Data', BoolToStr(Options.Encrypt, True), 'False');
  AddParam('Persist Security Info', BoolToStr(Options.PersistSecurityInfo, True), 'False');
  AddParam('Auto Translate', BoolToStr(Options.AutoTranslate, True), 'True');
  AddParam('Packet Size', IntToStr(Options.PacketSize), IntToStr(DefaultPacketSize));
  AddParam('Application Name', Options.ApplicationName, '');
  AddParam('Workstation ID', Options.WorkstationID, '');
  AddParam('Current Language', Options.Language, '');
  AddParam('Network Library', Options.NetworkLibrary, '');
  if Options.InitialFileName <> '' then
    AddParam('AttachDBFileName', Options.InitialFileName, '');
  AddParam('MultipleActiveResultSets', BoolToStr(Options.MultipleActiveResultSets, True), 'False');
  //AddParam('Max Database Size', IntToStr(Options.MaxDatabaseSize), '128');
  if Options.FailoverPartner <> '' then
    AddParam('Failover Partner', Options.FailoverPartner, '');

  if Authentication = auWindows then
    Result := Result + ';Integrated Security=SSPI';

{  if Password <> '' then
    Result := Result + ';Persist Security Info=True';}

end;

procedure TMSConnection.SetConnectString(Value: string);
var
  IntegratedSecuritySSPI: boolean;

  procedure ParseIniString;
    procedure ProcessParam(const paramName, paramValue: string);
      function Recognized(const Args: array of string): boolean;
      var
        i: integer;
      begin
        Result := False;
        for i := 0 to Length(Args) - 1 do begin
          Result := SameText(paramName, Args[i]);
          if Result then
            Break;
        end;
      end;

    var
      s: string;
    
    begin
      /// list of supported parameters must be syncronized with GetConnectString and dbxsda.ParseIniString
      if Recognized(['Provider']) then begin
        s := UpperCase(paramValue);
        if (s <> SSQLOLEDB) and (s <> SSQLNativeClient) and (s <> SSQLEverywhere) then
          raise Exception.CreateFmt(SBadParamValue, [paramName, paramValue]);
        Options.Provider := GetProvider(s);
      end
      else
      if Recognized(['User ID', 'UID', 'Username']) then
        UserName := paramValue
      else
      if Recognized(['Password', 'PWD']) then
        Password := paramValue
      else
      if Recognized(['Data Source', 'Server']) then begin
        if Options.Provider <> prCompact then
          Server := paramValue
        else
          Database := paramValue;
      end
      else
      if Recognized(['Initial Catalog', 'Database']) then
        Database := paramValue
      else
      if Recognized(['Connect Timeout', 'ConnectTimeout', 'Timeout']) then
        ConnectionTimeout := StrToInt(paramValue)
      else
      if Recognized(['Use Encryption for Data', 'Encryption', 'Encrypt']) then
        Options.Encrypt := {$IFDEF VER6}MemUtils.{$ENDIF}StrToBool(paramValue)
      else
      if Recognized(['PersistSecurityInfo', 'Persist Security Info']) then
        Options.PersistSecurityInfo := {$IFDEF VER6}MemUtils.{$ENDIF}StrToBool(paramValue)
      else
      if Recognized(['AutoTranslate', 'Auto Translate']) then
        Options.AutoTranslate := {$IFDEF VER6}MemUtils.{$ENDIF}StrToBool(paramValue)
      else
      if Recognized(['Packet Size', 'PacketSize']) then
        Options.PacketSize := StrToInt(paramValue)
      else
      if Recognized(['Current Language', 'Language']) then
        Options.Language := paramValue
      else
      if Recognized(['Network Library', 'Network', 'NetworkLibrary', 'NetLibrary']) then
        Options.NetworkLibrary := paramValue
      else
      if Recognized(['ApplicationName', 'Application Name', 'AppName']) then
        Options.ApplicationName := paramValue
      else
      if Recognized(['WorkstationID', 'Workstation ID', 'WSID']) then
        Options.WorkstationID := paramValue
      else
      if Recognized(['Integrated Security', 'Trusted_Connection']) then begin
        if paramValue = 'SSPI' then
          IntegratedSecuritySSPI := True
        else
          if not TryStrToBool(paramValue, IntegratedSecuritySSPI) then
            raise Exception.CreateFmt(SBadParamValue, [paramName, paramValue]);
      end
      else
      if Recognized(['AttachDBFileName', 'InitialFileName', 'InitFileName']) then
        Options.InitialFileName := paramValue
      else
      if Recognized(['MultipleActiveResultSets', 'Multiple Active Result Sets', 'MARS Connection', 'MARS']) then
        Options.MultipleActiveResultSets := {$IFDEF VER6}MemUtils.{$ENDIF}StrToBool(paramValue)
      else
      //if Recognized(['Max Database Size']) then
      //  Options.MaxDatabaseSize := StrToInt(paramValue)
      //else
      if Recognized(['Failover Partner', 'Failover_Partner']) then
        Options.FailoverPartner := paramValue
      else
      if Recognized([
        'Persist Security Info',
        'Use Procedure for Prepare',
        'Asynchronous Connection',
        'Client Failover',
        'Tag with column collation when possible']) then
        // ignored
      else
        raise Exception.CreateFmt(SParamNameUnknown, [paramName]);
    end;

  var
    i, l: integer;
    cs: string;
    inString, inValue, allowSpaces: boolean;
    newIndex, startIndex: integer;
    paramName, paramValue: string;
    csLength: integer;

  begin
    cs := Trim(Value);

    // parse connection string
    startIndex := 1;
    paramName := '';
    paramValue := '';

    csLength := Length(cs);

    while startIndex < csLength do begin
      // look for param name
      newIndex := PosEx('=', cs, startIndex);
      if newIndex > 0 then begin
        paramName := Trim(Copy(cs, startIndex, newIndex - startIndex));
        if paramName = '' then
          raise Exception.Create(SParamNameMissing);
      end;

      // look for param value
      inString := False;
      inValue := False;     // Shows that we are parsing non-quoted value. Must be single word.
      allowSpaces := True;  // Brought in to avoid two-word non-quoted values.

      for i := newIndex + 1 to csLength do begin
        if cs[i] = '"' then
          inString := not inString
        else
          if not inString then begin
            if cs[i] = ';' then begin
              paramValue := Trim(Copy(cs, newIndex + 1, i - newIndex - 1));
              break;
            end
            else
              if cs[i] <= ' ' then begin
                if inValue then
                // no more spaces are allowed
                  allowSpaces := False;
              end
            else
              // check whether char is valid for non-quoted param value
              case cs[i] of
                '!'..'/', '\', '_', '@', '0'..'9', 'a'..'z', 'A'..'Z':
                begin
                  inValue := True;
                  if not allowSpaces then
                    raise Exception.Create(SInvalidChar);
                end
                else
                  raise Exception.Create(SInvalidChar);
              end;
          end;

        if i = csLength then
          paramValue := Trim(Copy(cs, newIndex + 1, i - newIndex));
      end;

      if paramValue = '' then
        raise Exception.Create(SParamValueMissing);

      l := Length(paramValue);
      if (l >= 2) and (paramValue[1] = '"') and (paramValue[l] = '"') then
        paramValue := Trim(Copy(paramValue, 2, l - 2));

      ProcessParam(paramName, paramValue);

      startIndex := i + 1;
    end;
  end;

var
  OldCS: string;

begin
  OldCS := ConnectString;
  try
    UserName := '';
    Password := '';
    Server := '';
    Database := DefaultSDACDatabase;
    // bug in editor - ConnectionTimeout is not returned;
    // ConnectionTimeout := DefaultConnectionTimeout;
    Options.Encrypt := False;
    Options.PersistSecurityInfo := False;
    Options.AutoTranslate := True;
    Options.PacketSize := DefaultPacketSize;
    Options.Language := '';
    Options.NetworkLibrary := '';
    Options.Provider := prAuto;
    Options.InitialFileName := '';
    Options.MultipleActiveResultSets := False;
    Authentication := auServer;
    //Options.MaxDatabaseSize := 128;
    Options.FailoverPartner := '';

    IntegratedSecuritySSPI := False;
    ParseIniString;

    if IntegratedSecuritySSPI then
      Authentication := auWindows;
  except
    ConnectString := OldCS;
    raise;
  end;
end;
  
procedure TMSConnection.CreateIConnection;
var
  CRConnection: TCRConnection;
begin
  if FIConnection <> nil then
    Exit;

  CRConnection := GetOLEDBConnection;
  SetIConnection(CRConnection);
end;

procedure TMSConnection.SetIConnection(Value: TCRConnection);
begin
  inherited;

  FIConnection := Value as TOLEDBConnection;

  Database := FDatabase; // To prevent empty value
  if FIConnection <> nil then
    TOLEDBConnection(FIConnection).OnInfoMessage := DoInfoMessage;
end;

function TMSConnection.GetIConnectionClass: TCRConnectionClass;
begin
  Result := TOLEDBConnection;
end;

function TMSConnection.GetICommandClass: TCRCommandClass;
begin
  Result := TOLEDBCommand;
end;

function TMSConnection.GetIRecordSetClass: TCRRecordSetClass;
begin
  Result := TOLEDBRecordSet;
end;

procedure TMSConnection.SetOptions(Value: TMSConnectionOptions);
begin
  FOptions.Assign(Value);
end;

function TMSConnection.GetOLEDBConnection: TOLEDBConnection;
var
  ConnectionParameters: TMSConnectionParameters;
begin
  if Pooling then begin
    ConnectionParameters := TMSConnectionParameters.Create;
    try
      ConnectionParameters.MinPoolSize := PoolingOptions.MinPoolSize;
      ConnectionParameters.MaxPoolSize := PoolingOptions.MaxPoolSize;
      ConnectionParameters.ConnectionLifeTime := PoolingOptions.ConnectionLifetime;
      ConnectionParameters.Validate := PoolingOptions.Validate;
      ConnectionParameters.Username := Username;
      ConnectionParameters.Server := Server;
      ConnectionParameters.Password := Password;

      ConnectionParameters.Database := Database;
      ConnectionParameters.IsolationLevel := IsolationLevel;
      ConnectionParameters.Authentication := Authentication;

      ConnectionParameters.QuotedIdentifier := Options.QuotedIdentifier;
      ConnectionParameters.Language := Options.Language;
      ConnectionParameters.Encrypt := Options.Encrypt;
      ConnectionParameters.PersistSecurityInfo := Options.PersistSecurityInfo;
      ConnectionParameters.AutoTranslate := Options.AutoTranslate;
      ConnectionParameters.NetworkLibrary := Options.NetworkLibrary;
      ConnectionParameters.ApplicationName := Options.ApplicationName;
      ConnectionParameters.WorkstationID := Options.WorkstationID;
      ConnectionParameters.PacketSize := Options.PacketSize;
      ConnectionParameters.Provider := Options.FProvider;
      Result := TMSConnectionPoolManager.GetConnection(ConnectionParameters) as TOLEDBConnection;
    finally
      ConnectionParameters.Free;
    end;
  end
  else
  begin
    Result := TOLEDBConnection.Create;
    Result.SetProp(prDatabase, FDatabase);
    Result.SetProp(prIsolationLevel, Integer(FIsolationLevel));
    Result.SetProp(prAuthentication, Integer(FAuthentication));
    Result.SetProp(prConnectionTimeout, FConnectionTimeout);

    if FOptions <> nil then begin
      Result.SetProp(prQuotedIdentifier, FOptions.FQuotedIdentifier);
      Result.SetProp(prLanguage, FOptions.FLanguage);
      Result.SetProp(prEncrypt, FOptions.FEncrypt);
      Result.SetProp(prPersistSecurityInfo, FOptions.FPersistSecurityInfo);
      Result.SetProp(prAutoTranslate, FOptions.FAutoTranslate);
      Result.SetProp(prNetworkLibrary, FOptions.FNetworkLibrary);
      Result.SetProp(prApplicationName, FOptions.FApplicationName);
      Result.SetProp(prWorkstationID, FOptions.FWorkstationID);
      Result.SetProp(prPacketSize, FOptions.FPacketSize);
      Result.SetProp(prProvider, Integer(FOptions.FProvider));
      Result.SetProp(prInitialFileName, FOptions.FInitialFileName);
      Result.SetProp(prMARS, FOptions.FMultipleActiveResultSets);
      //Result.SetProp(prMaxDatabaseSize, FOptions.FMaxDatabaseSize);
      Result.SetProp(prFailoverPartner, FOptions.FFailoverPartner);
    end;

    // FIConnection.SetProp(prMultipleConnections, @FMultipleConnections);
  end;

  if FIConnection <> nil then
    Result.Assign(FIConnection as TOLEDBConnection);
end;

procedure TMSConnection.AssignTo(Dest: TPersistent);
begin
  inherited AssignTo(Dest);

  if Dest is TMSConnection then begin
    TMSConnection(Dest).Database := Database;
    TMSConnection(Dest).IsolationLevel := IsolationLevel;
    TMSConnection(Dest).Authentication := Authentication;
  end;
end;

procedure TMSConnection.SetDatabase(Value: string);
begin
  if (Value <> Database) and (Options <> nil) and (Options.Provider = prCompact) then
    Disconnect;

  if Value = '' then
    if (Options <> nil) and (Options.Provider = prCompact) then
      Value := ''
    else
      Value := DefaultSDACDatabase;

  if Value <> Database then begin
    FDatabase := Value;
    
    if (Options <> nil) and (Options.Provider = prCompact) and
      (csDesigning in ComponentState) and (Value <> '') and (Value[1] = '.') and (CurrentProjectOutputDir <> '') then
      Value := IncludeTrailingBackslash(CurrentProjectOutputDir) + Value;
      
    if FIConnection <> nil then
      FIConnection.SetProp(prDatabase, Value);
  end;
end;

function TMSConnection.CreateDataSet: TCustomDADataSet;
begin
  Result := TCustomMSDataSet.Create(nil);
  TCustomMSDataSet(Result).SetDesigning(csDesigning in ComponentState);
  Result.Connection := Self;
end;

function TMSConnection.CreateSQL: TCustomDASQL;
begin
  Result := TMSSQL.Create(nil);
  TMSSQL(Result).SetDesigning(csDesigning in ComponentState);
  Result.Connection := Self;
end;

function TMSConnection.GetClientVersion: string;
begin
  Connect;
  Assert(FIConnection <> nil);
  Result := IConnection.ProviderVer;
end;

function TMSConnection.GetServerVersion: string;
begin
  Connect;
  Assert(FIConnection <> nil);
  Result := IConnection.DBMSVer;
end;

procedure TMSConnection.ChangePassword(NewPassword: string);
var
  OldConnected: boolean;
  OldPassword: string;
  OldLoginPrompt: boolean;
begin
  OldConnected := Connected;
  OldPassword := Password;
  OldLoginPrompt := LoginPrompt;
  try
    if not Connected then
      CreateIConnection
    else
      Disconnect;
    LoginPrompt := False;
    Assert(FIConnection <> nil);
    FIConnection.SetProp(prOldPassword, Password);
    Password := NewPassword;
    try
      Connect;
    except
      Password := OldPassword;
      raise;
    end;
  finally
    Assert(FIConnection <> nil);
    FIConnection.SetProp(prOldPassword, '');
    LoginPrompt := OldLoginPrompt;
    if not OldConnected then
      Disconnect;
  end;
end;

function TMSConnection.ExecSQL(Text: string; const Params: array of variant): variant;
var
  i: integer;
  Param: TParam;
begin
  if FMSSQL = nil then
    FMSSQL := CreateSQL as TMSSQL;

  FMSSQL.SQL.Text := ''; // drop params from previous sql
  FMSSQL.SQL.Text := Text;

  for i := 0 to FMSSQL.ParamCount - 1 do
    if i <= High(Params) then
      FMSSQL.Params[i].Value := Params[i]
    else
      FMSSQL.Params[i].Value := Null;

  Param := FMSSQL.FindParam('Result');
  if Param <> nil then
    if Param.DataType = ftUnknown then
      Param.DataType := ftInteger;

  FMSSQL.Execute;

  if Param <> nil then
    Result := Param.Value
  else
    Result := Null;
end;

procedure TMSConnection.GetTableNames(List: TStrings);
var
  MDDS: TMSMetadata;

  procedure AddNamesToList;
  var
    NameFld: TStringField;
    SchemaFld: TStringField;
  begin
    MDDS.Open;

    NameFld := MDDS.FieldByName('TABLE_NAME') as TStringField;
    SchemaFld := nil;
    if Options.Provider <> prCompact then
      SchemaFld := MDDS.FieldByName('TABLE_SCHEMA') as TStringField;
    while not MDDS.Eof do begin
      if (SchemaFld <> nil) and (SchemaFld.Value <> '') then
        List.Add(SchemaFld.Value + '.' + NameFld.Value)
      else
        List.Add(NameFld.Value);
      MDDS.Next;
    end;
  end;

begin
  List.Clear;
  MDDS := nil;
  try
    MDDS := TMSMetadata.Create(nil);
    MDDS.Connection := Self;
    MDDS.DatabaseName := MDDS.Connection.Database;

    MDDS.ObjectType := otTables;
    AddNamesToList;

    if Options.Provider <> prCompact then begin
      MDDS.ObjectType := otViews;
      AddNamesToList;
    end;
    
    if List is TStringList then
      TStringList(List).Sort;
  finally
    MDDS.Free;
  end;
end;

procedure TMSConnection.GetDatabaseNames(List: TStrings);
var
  MDDS: TMSMetadata;
  NameFld: TStringField;
begin
  List.Clear;

  if Options.Provider = prCompact then
    Exit;
    
  MDDS := nil;
  try
    MDDS := TMSMetadata.Create(nil);
    MDDS.Connection := Self;
    MDDS.ObjectType := otDatabases;

    try
      MDDS.Open;
    except
      on E: EMSError do begin
        if E.ErrorCode = 4060 then  
          Database := '';
        raise;
      end;
    end;
       
    NameFld := MDDS.FieldByName('CATALOG_NAME') as TStringField;
    while not MDDS.Eof do begin
      List.Add(NameFld.Value);
      MDDS.Next
    end;

    if List is TStringList then
      TStringList(List).Sort;
  finally
    MDDS.Free;
  end;
end;

procedure TMSConnection.GetStoredProcNames(List: TStrings);
var
  MDDS: TMSMetadata;
  NameFld: TStringField;
begin
  List.Clear;

  if Options.Provider = prCompact then
    Exit;

  MDDS := nil;
  try
    MDDS := TMSMetadata.Create(nil);
    MDDS.Connection := Self;
    MDDS.ObjectType := otStoredProcs;

    try
      MDDS.Open;
    except
      on E: EMSError do begin
        if E.ErrorCode = 4060 then
          Database := '';
        raise;
      end;
    end;

    NameFld := MDDS.FieldByName('PROCEDURE_NAME') as TStringField;
    while not MDDS.Eof do begin
      List.Add(NameFld.Value);
      MDDS.Next
    end;

    if List is TStringList then
      TStringList(List).Sort;
  finally
    MDDS.Free;
  end;
end;

procedure TMSConnection.GetStoredProcNames(List: TStrings; System: boolean);
var
  Query: TMSQuery;
  NameFld: TStringField;
begin
  if System then
    GetStoredProcNames(List)
  else
  begin
    List.Clear;
    
    if Options.Provider = prCompact then
      Exit;

    Query := TMSQuery.Create(nil);
    try
      Query.Connection := Self;
      Query.SQL.Clear;
      Query.SQL.Add('SELECT name FROM sysobjects');
      Query.SQL.Add('WHERE OBJECTPROPERTY(id, N''IsProcedure'') = 1 or OBJECTPROPERTY(id, N''IsExtendedProc'') = 1');
      Query.SQL.Add('ORDER BY name');
      try
        Query.Open;
      except
        on E: EMSError do begin
          if E.ErrorCode = 4060 then
            Database := '';
          raise;
        end;
      end;

      NameFld := Query.FieldByName('name') as TStringField;
      while not Query.Eof do begin
        List.Add(NameFld.Value);
        Query.Next;
      end;
    finally
      Query.Free;
    end;
  end;
end;

function TMSConnection.SQLMonitorClass: TClass;
begin
  Result := TMSSQLMonitor;
end;

function TMSConnection.ConnectDialogClass: TConnectDialogClass; 
begin
  if Assigned(DefConnectDialogClassProc) then
    Result := TConnectDialogClass(DefConnectDialogClassProc)
  else
    Result := nil;
end;

procedure TMSConnection.SetIsolationLevel(const Value: TIsolationLevel);
begin
  if FIsolationLevel <> Value then begin
    FIsolationLevel := Value;
    if FIConnection <> nil then
      FIConnection.SetProp(prIsolationLevel, Integer(Value));
  end;
end;
{    
procedure TMSConnection.SetMultipleConnections(const Value: boolean);
begin
  if FMultipleConnections <> Value then begin
    FMultipleConnections := Value;
    Assert(TOLEDBConnection(FIConnection) <> nil);
    FIConnection.SetProp(prMultipleConnections, @Value);
  end;
end;}

procedure TMSConnection.SetAuthentication(const Value: TMSAuthentication);
begin
  if FAuthentication <> Value then begin
    Disconnect;
    FAuthentication := Value;
    if FIConnection <> nil then
      FIConnection.SetProp(prAuthentication, Integer(Value));
  end;
end;

procedure TMSConnection.SetConnectionTimeout(const Value: integer);
begin
  if FConnectionTimeout <> Value then begin
    FConnectionTimeout := Value;
    if FIConnection <> nil then
      FIConnection.SetProp(prConnectionTimeout, Value);
  end;
end;

function TMSConnection.NeedPrompt: boolean;
begin
  Result := False;
  if Authentication = auWindows then
    Exit;

  if Options.Provider = prCompact then
    Exit;

  Result := not FLockLoginPrompt and
    (LoginPrompt or (csDesigning in ComponentState) and
    ((Username = '') and (Password = ''))) and
    not ((csDesigning in ComponentState) and ((csReading in ComponentState) or FStreamedConnected))
end;

function TMSConnection.IsFatalError(E: EDAError): boolean;
begin
  if E is EMSError then
    with EMSError(E) do begin
      Result := SeverityClass >= 20; {fatal error}
      if not Result then
        Result :=
          ((SeverityClass = 16) and (State = 1) and (MSSQLErrorCode <= NE_MAX_NETERROR))  // Network Library
        or
          ((SeverityClass = 10) and (State = 1) and (MSSQLErrorCode = WSAECONNRESET)) // Win sockets
        or
          ((SeverityClass = 16) and (State = 1) and (MSSQLErrorCode = WSAECONNRESET)) // Win sockets
        or
          ((SeverityClass = 16) and (State = 1) and (MSSQLErrorCode = ERROR_PIPE_NOT_CONNECTED)) // Named pipes
        or
          ((SeverityClass = 16) and (State = 1) and (MSSQLErrorCode = ERROR_NETNAME_DELETED)); // Named pipes
    end
  else
    Result := inherited IsFatalError(E);
end;

procedure TMSConnection.DoError(E: Exception; var Fail, Reconnect, Reexecute: boolean;
  ReconnectAttempt: integer; var ConnLostCause: TConnLostCause);
var
  i: integer;
begin
  inherited;

  if Reconnect then
    for i := 0 to DataSetCount - 1 do begin // Check underfetched data
      Assert(DataSets[i] is TCustomMSDataSet);
      if TCustomMSDataSet(DataSets[i]).FIRecordSet.GetIRowset <> nil then begin
        Reconnect := False;
        Exit;
      end;
    end;
end;

procedure TMSConnection.DoInfoMessage(E: EMSError);
begin
  TMSSQLMonitorClass(SQLMonitorClass).InfoMessage(Self, E.Message);

  if Assigned(FOnInfoMessage) then
    FOnInfoMessage(Self, E);
end;

function TMSConnection.IsKeyViolation(E: EDAError): boolean;
begin
  if E is EMSError then
    Result := (E.ErrorCode = 2627{Violation of %ls constraint '%.*ls'. Cannot insert duplicate key in object '%.*ls'.})
  else
    Result := inherited IsKeyViolation(E);
end;

{TMSDataSetOptions}

constructor TMSDataSetOptions.Create(Owner: TCustomDADataSet);
begin
  inherited Create(Owner);

  LongStrings := True;
  RequiredFields := False;
  EnableBCD := False;
  UniqueRecords := False;
  CursorUpdate := True;
  QueryIdentity := True;
  CheckRowVersion := False;
  FullRefresh := False;
  DMLRefresh := False;
  FAutoRefresh := False;
  FAutoRefreshInterval := 60;
  FSmartRefresh := False;
  FDefaultValues := False;
  FNonBlocking := False;
end;

procedure TMSDataSetOptions.SetEnableBCD(Value: boolean);
begin
  if FEnableBCD <> Value then begin 
    TCustomMSDataSet(FOwner).CheckInactive;
    FEnableBCD := Value;
    TCustomMSDataSet(FOwner).SetNumericType;
  end;
end;

procedure TMSDataSetOptions.SetUniqueRecords(Value: boolean);
begin
  if FUniqueRecords <> Value then begin
    TCustomMSDataSet(FOwner).CheckInactive;
    TCustomMSDataSet(FOwner).FieldDefs.Updated := False;
    FUniqueRecords := Value;
    TCustomMSDataSet(FOwner).FIRecordSet.SetProp(prUniqueRecords, FUniqueRecords);
    TCustomMSDataSet(FOwner).FIRecordSet.SetProp(prRequestSQLObjects, FUniqueRecords or not FOwner.ReadOnly);
    FOwner.FieldDefs.Updated := False;
  end;
end;

procedure TMSDataSetOptions.SetCursorUpdate(Value: boolean);
begin
  if FCursorUpdate <> Value then begin
    TCustomMSDataSet(FOwner).CheckInactive;
    TCustomMSDataSet(FOwner).FieldDefs.Updated := False;
    FCursorUpdate := Value;
    TCustomMSDataSet(FOwner).FIRecordSet.SetProp(prCursorUpdate, FCursorUpdate);
  end;
end;

function TMSDataSetOptions.GetAllFieldsEditable: boolean;
begin
  Result := not SetFieldsReadOnly;
end;

procedure TMSDataSetOptions.SetAllFieldsEditable(const Value: boolean);
begin
  SetFieldsReadOnly := not Value;
end;

procedure TMSDataSetOptions.SetAutoRefresh(Value: boolean);
begin
  if FAutoRefresh <> Value then begin
    FAutoRefresh := Value;
    if not (csDesigning in FOwner.ComponentState) then
      TCustomMSDataSet(FOwner).FAutoRefreshTimer.Enabled := Value;
  end;
end;

procedure TMSDataSetOptions.SetAutoRefreshInterval(Value: integer);
begin
  if FAutoRefreshInterval <> Value then begin
    FAutoRefreshInterval := Value;
    TCustomMSDataSet(FOwner).FAutoRefreshTimer.Interval := Value * MSecsPerSec;
  end;
end;

(*procedure TMSDataSetOptions.SetSmartRefresh(Value: boolean);
begin
  if FSmartRefresh <> Value then begin
    TCustomMSDataSet(FOwner).CheckInactive;

    FSmartRefresh := Value;

    TCustomMSDataSet(FOwner).FIRecordSet.SetProp(prSmartRefresh, FSmartRefresh);
    if FSmartRefresh then
      TCustomMSDataSet(FOwner).FIRecordSet.SetProp(prSmartRefreshMsg, GetComponentName(FOwner));
  end;
end;*)

procedure TMSDataSetOptions.SetNonBlocking(Value: boolean);
begin
  if FNonBlocking <> Value then begin
    TCustomMSDataSet(FOwner).CheckInactive;
    FNonBlocking := Value;
    TCustomMSDataSet(FOwner).FIRecordSet.SetProp(prNonBlocking, FNonBlocking);
  end;
end;

procedure TMSDataSetOptions.AssignTo(Dest: TPersistent);
begin
  inherited;

  if Dest is TMSDataSetOptions then begin
    TMSDataSetOptions(Dest).LongStrings := LongStrings;
    TMSDataSetOptions(Dest).EnableBCD := EnableBCD;
    TMSDataSetOptions(Dest).UniqueRecords := UniqueRecords;
    TMSDataSetOptions(Dest).AllFieldsEditable := AllFieldsEditable;
    TMSDataSetOptions(Dest).CursorUpdate := CursorUpdate;
    TMSDataSetOptions(Dest).FullRefresh := FullRefresh;
    TMSDataSetOptions(Dest).DMLRefresh := DMLRefresh;
    TMSDataSetOptions(Dest).AutoRefresh := AutoRefresh;
    TMSDataSetOptions(Dest).AutoRefreshInterval := AutoRefreshInterval;
    //TMSDataSetOptions(Dest).SmartRefresh := SmartRefresh;
  end;
end;

{ TMSSQLGenerator }

function TMSSQLGenerator.GetActualFieldNameEx(FieldDesc: TCRFieldDesc; TableInfo: TCRTableInfo): string;
var
  p: integer;
begin
  Result := TOLEDBFieldDesc(FieldDesc).BaseColumnName;
  if (FieldDesc.TableInfo = TableInfo) or (FieldDesc.TableInfo.TableName = TableInfo.TableName) then begin
    p := Pos('.', Result);
    if p <> 0 then
      Result := Copy(Result, p + 1, MaxInt);{Delete table name from fieldname}
  end;
end;

function TMSSQLGenerator.AssembleSB(const StatementType: TStatementType): string;
begin
  if TCustomMSDataSet(FOwner).Options.DMLRefresh and (StatementType = stInsert) then
    Result :=
      FHeaderSB.ToString +
      FFldSB.ToString +
      FMiddleSB.ToString +
      FFldParamSB.ToString +
      FFooterSB.ToString +
      FCondSB.ToString
  else
    Result := inherited AssembleSB(StatementType);
end;

procedure TMSSQLGenerator.GenerateInsertSQL(
  const KeyAndDataFields: TKeyAndDataFields;
  const ModifiedFieldsOnly: boolean;
  const Index: integer = -1);
var
  Field, IdentityField: TField;
  FieldDesc: TCRFieldDesc;
  i: integer;
  ActualName: string;
  AIConnection: TOLEDBConnection;
  IsFirstParam: boolean;
begin
  inherited;

  if FFldSB.Length = 0 then begin
    AIConnection := TMSAccessUtils.FIConnection(TMSConnection(FOwner.Connection));
    if (AIConnection <> nil) and (AIConnection.ProviderPrimaryVer <> 3) then begin
      Clear;
      FHeaderSB.Append('INSERT INTO ');
      FHeaderSB.Append(FTableInfo.NormalizeName(FTableInfo.TableNameFull, FOwner.Options.QuoteNames));
      FHeaderSB.Append(' DEFAULT VALUES');
    end
    else begin
      for i := 0 to High(KeyAndDataFields.DataFieldDescs) do begin
        FieldDesc := KeyAndDataFields.DataFieldDescs[i];
        Field := FOwner.GetField(FieldDesc);
        Assert(Field <> nil);
        if not Field.ReadOnly then begin
          ActualName := GetActualFieldName(FieldDesc, False);

          if FFldSB.Length > 0 then begin
            FFldSB.Append(', ');
            FFldParamSB.Append(', ');
          end;
          FFldSB.Append(ActualName);
          FFldParamSB.Append('DEFAULT');
        end;
      end;
    end;
  end;

  if TCustomMSDataSet(FOwner).CursorType = ctDefaultResultSet then begin
    { Getting Identity value }
    if TCustomMSDataSet(FOwner).Options.QueryIdentity and (TOLEDBConnection(TCustomMSDataSet(FOwner).Connection.IConnection).DBMSPrimaryVer <> 3) then begin
      IdentityField := TDBAccessUtils.GetIdentityField(FOwner);
      if IdentityField <> nil then begin
        // Warning - Identity param must be last in param list, see SetIdentityParam
        // Warning - If in 'INSERT ...' statement present sql_variant value then adding 'SET ...' fails statement
        // Warning - TOLEDBFieldDesc(GetFieldDescByField(FIdentityField)).BaseColumnName cannot be used (for example see gettting identity on INSERT into View)

        FFooterSB.Append(#$D#$A'SET ');
        TCustomMSDataSet(FOwner).FUseParamType := True;
        AddParam(FFooterSB, FOwner.GetFieldDesc(IdentityField), stInsert, ptInputOutput);

        if TOLEDBConnection(TCustomMSDataSet(FOwner).Connection.IConnection).DBMSPrimaryVer > 7 then
          FFooterSB.Append(' = SCOPE_IDENTITY()')
        else
          FFooterSB.Append(' = @@Identity');
      end;
    end;

    { DMLRefresh }
    if TCustomMSDataSet(FOwner).Options.DMLRefresh then begin
      IsFirstParam := True;
      for i := 0 to High(KeyAndDataFields.DataFieldDescs) do begin
        FieldDesc := KeyAndDataFields.DataFieldDescs[i];
        Field := FOwner.GetField(FieldDesc);
        Assert(Field <> nil);
        if not Field.ReadOnly then begin
          if not IsFirstParam then
            FFooterSB.Append(', ')
          else
            FFooterSB.Append(LineSeparator + 'SELECT ');
          IsFirstParam := False;
          TCustomMSDataSet(FOwner).FUseParamType := True;
          AddParam(FFooterSB, FieldDesc, stRefresh, ptInputOutput);
          FFooterSB.Append(' = ' + QuoteName(TOLEDBFieldDesc(FieldDesc).BaseColumnName));
        end;
      end;
      if not IsFirstParam then begin
        FFooterSB.Append(' FROM ' + FTableInfo.NormalizeName(FTableInfo.TableNameFull, FOwner.Options.QuoteNames) +
          LineSeparator + 'WHERE' + LineSeparator + '  ');
        GenerateConditions(FCondSB, stInsert, ModifiedFieldsOnly, KeyAndDataFields);
      end;
    end;
  end;
end;

procedure TMSSQLGenerator.GenerateUpdateSQL(
      const KeyAndDataFields: TKeyAndDataFields;
      const ModifiedFieldsOnly: boolean;
      const Index: integer = -1);
var
  Field: TField;
  FieldDesc: TCRFieldDesc;
  i: integer;
  IsFirstParam: boolean;
  OldCondSB: StringBuilder;
begin
  inherited;

  if TCustomMSDataSet(FOwner).CursorType = ctDefaultResultSet then begin
    { DMLRefresh }
    if (FFldSB.Length > 0) and TCustomMSDataSet(FOwner).Options.DMLRefresh then begin
      FFooterSB.Append(LineSeparator);
      FFooterSB.Append('SELECT ');
      IsFirstParam := True;
      for i := 0 to High(KeyAndDataFields.DataFieldDescs) do begin
        FieldDesc := KeyAndDataFields.DataFieldDescs[i];
        Field := FOwner.GetField(FieldDesc);
        if not Field.ReadOnly then begin
          if not IsFirstParam then
            FFooterSB.Append(', ');
          IsFirstParam := False;
          TCustomMSDataSet(FOwner).FUseParamType := True;
          AddParam(FFooterSB, FieldDesc, stRefresh, ptInputOutput);
          FFooterSB.Append(' = ' + QuoteName(TOLEDBFieldDesc(FieldDesc).BaseColumnName));
        end;
      end;
      FFooterSB.Append(' FROM ');
      FFooterSB.Append(FTableInfo.NormalizeName(FTableInfo.TableNameFull, FOwner.Options.QuoteNames));
      FFooterSB.Append(LineSeparator);
      FFooterSB.Append('WHERE');
      FFooterSB.Append(LineSeparator);
      FFooterSB.Append('  ');
      OldCondSB := FCondSB;
      try
        FCondSB := StringBuilder.Create;
        try
          GenerateConditions(FCondSB, stUpdate, ModifiedFieldsOnly, KeyAndDataFields);
          FFooterSB.Append(FCondSB.ToString);
        finally
          FCondSB.Free;
        end;
      finally
        FCondSB := OldCondSB;
      end;
    end;
  end;
end;

procedure TMSSQLGenerator.GenerateRefreshSQLSelectPart(const KeyAndDataFields: TKeyAndDataFields); 
var
  Field: TField;
  FieldDesc: TOLEDBFieldDesc;
  TableName: string;
  UseDataFields: boolean;
  FieldArrHigh: integer;
begin
  inherited;

  if TCustomMSDataSet(FOwner).FTimestampField <> nil then begin
    UseDataFields := Length(KeyAndDataFields.DataFieldDescs) + Length(KeyAndDataFields.DataFieldDescs) > 0;
    if UseDataFields then
      FieldArrHigh := Length(KeyAndDataFields.DataFieldDescs) + Length(KeyAndDataFields.DataFieldDescs) - 1
    else
      FieldArrHigh := High(KeyAndDataFields.KeyFieldDescs);

    if FieldArrHigh >= 0 then
      FFldSB.Append(', ');
    Field := TCustomMSDataSet(FOwner).FTimestampField;
    FieldDesc := TOLEDBFieldDesc(FOwner.GetFieldDesc(Field));
    TableName := GenerateTableName(FieldDesc.BaseCatalogName, FieldDesc.BaseSchemaName, FieldDesc.BaseTableName, TCustomMSDataSet(FOwner).Connection.Database);
    if TableName = '' then
      FFldSB.Append(QuoteName(FieldDesc.ActualName))
    else
      if FieldDesc.TableInfo.TableAlias <> '' then
        FFldSB.Append(FieldDesc.TableInfo.NormalizeName(FieldDesc.TableInfo.TableAlias, FOwner.Options.QuoteNames) +
          '.' + QuoteName(FieldDesc.BaseColumnName))
      else
        FFldSB.Append(FieldDesc.TableInfo.NormalizeName(FieldDesc.TableInfo.TableName, FOwner.Options.QuoteNames) +
          '.' + QuoteName(FieldDesc.BaseColumnName));

    if not (csDesigning in FOwner.ComponentState) then
      FFldSB.Append(' AS ' + GenerateIndexName(IntToStr(TCustomMSDataSet(FOwner).FIRecordSet.Fields.IndexOf(FieldDesc))));
  end;
end;

procedure TMSSQLGenerator.GenerateRefreshSQL(
      const KeyAndDataFields: TKeyAndDataFields;
      const ModifiedFieldsOnly: boolean);

  procedure GenerateSPFullRefreshSQL;
  var
    i: integer;
    Field: TField;
    FieldDesc: TOLEDBFieldDesc;
    TableName: string;
    TblNames: TStringList;
  begin
    TblNames := TStringList.Create;
    try
      // SELECT ... FROM ... WHERE ... {WITH NOLOCK}
      // Add SELECT section
      FHeaderSB.Append('SELECT ');
      for i := 0 to FOwner.Fields.Count - 1 do begin
        Field := FOwner.Fields[i];
        if Field.FieldKind = fkData then begin
          FieldDesc := TOLEDBFieldDesc(FOwner.GetFieldDesc(Field));

          TableName := GenerateTableName(FieldDesc.BaseCatalogName, FieldDesc.BaseSchemaName, FieldDesc.BaseTableName, TCustomMSDataSet(FOwner).Connection.Database);
          if TblNames.IndexOf(TableName) = - 1 then
            TblNames.Add(TableName);

          FHeaderSB.Append(TableName + '.' + FieldDesc.Name);
          if not (csDesigning in FOwner.ComponentState) then
            FHeaderSB.Append(' AS _' + IntToStr(TCustomMSDataSet(FOwner).FIRecordSet.Fields.IndexOf(FieldDesc)));
          FHeaderSB.Append(', ');
        end;
      end;
      FHeaderSB.Length := FHeaderSB.Length - 2;

      // Add FROM section
      FHeaderSB.Append(' FROM ');
      for i := 0 to TblNames.Count - 1 do
        FHeaderSB.Append(QuoteName(TblNames[i]) + ', '); // Table name without aliases
      FHeaderSB.Length := FHeaderSB.Length - 2;

      // Add WHERE section
      GenerateConditions(FCondSB, stRefresh, ModifiedFieldsOnly, (*False {Refresh does not need to testing changes applied by other users},*) KeyAndDataFields);
      if FCondSB.Length > 0 then
        FMiddleSB.Append(' WHERE ');
    finally
      TblNames.Free;
    end;
  end;

begin
  if (FOwner is TCustomMSStoredProc) and TCustomMSDataSet(FOwner).Options.FullRefresh then
    GenerateSPFullRefreshSQL
  else
  if TCustomMSDataSet(FOwner).Options.FullRefresh or (FOwner.ReadOnly and not TCustomMSDataSet(FOwner).Options.UniqueRecords) then begin
    GenerateConditions(FCondSB, stRefresh, ModifiedFieldsOnly, KeyAndDataFields);
    if FCondSB.Length = 0 then
      FHeaderSB.Append(FOwner.SQL.Text)
    else begin
      FHeaderSB.Append(AddWhere(FOwner.SQL.Text, FCondSB.ToString));
      FCondSB.Length := 0; // WHERE clause already added to FHeaderSB
    end;
  end
  else
    inherited;
end;

function TMSSQLGenerator.GetActualFieldName(FldDesc: TCRFieldDesc; IsRefresh: boolean): string;
var
  TablesInfo: TCRTablesInfo;
  TableInfo: TCRTableInfo;
  IsView: boolean;
  UpdatingTableIdx: integer;
begin
  if not (((FldDesc.TableInfo <> nil) and (FldDesc.TableInfo.IsView)) or IsRefresh) then begin
    Result := TOLEDBFieldDesc(FldDesc).BaseColumnName;
    if Result = '' then
      Result := FldDesc.ActualName;
    Result := QuoteName(Result);
    Exit;
  end;
  
  IsView := False;
  UpdatingTableIdx := TDBAccessUtils.GetUpdatingTableIdx(FOwner);
  TablesInfo := TDBAccessUtils.GetTablesInfo(FOwner);
  if (UpdatingTableIdx >= 0) and (UpdatingTableIdx < TablesInfo.Count) then begin
    TableInfo := TablesInfo[UpdatingTableIdx];
    if TableInfo <> nil then
      IsView := TableInfo.IsView;
  end;

  if (FldDesc.TableInfo <> nil) and (not IsView) then
    Result := inherited GetActualFieldName(FldDesc, IsRefresh)
  else
    Result := QuoteName(FldDesc.ActualName);
end;

procedure TMSSQLGenerator.AddFieldToCondition(SB: StringBuilder; FieldDesc: TCRFieldDesc;
      const StatementType: TStatementType;
      const ModifiedFieldsOnly: boolean;
      const Index: integer = -1);
var
  ActualName: string;
  IsIdentityField: boolean;
  Field: TField;
begin
  Assert(FieldDesc <> nil);

  if ModifiedFieldsOnly then begin
    Field := FOwner.GetField(FieldDesc);
    IsIdentityField := Field = TDBAccessUtils.GetIdentityField(FOwner);
    if (StatementType = stInsert) and IsIdentityField then begin // DMLRefresh ?
      ActualName := GetActualFieldName(FieldDesc, False);
      FCondSB.Append(ActualName);
      FCondSB.Append(' = ');
      if TOLEDBConnection(TCustomMSDataSet(FOwner).Connection.IConnection).DBMSPrimaryVer > 7 then
        FCondSB.Append('SCOPE_IDENTITY()')
      else
        FCondSB.Append('@@Identity');
      Exit;
    end;
  end;

  inherited;
end;

procedure TMSSQLGenerator.GenerateConditions(SB: StringBuilder;
      const StatementType: TStatementType;
      const ModifiedFieldsOnly: boolean;
      const KeyAndDataFields: TKeyAndDataFields;
      const Index: integer = -1);

  procedure GenerateCondForRQ;
  {SQL Server Books Online -> Accessing and Changing Relational Data ->
   Transact-SQL Syntax Elements -> Using Data Types -> Using Special Data:

   In SQL Server version 7.0 and SQL Server 2000, @@DBTS is only incremented for use
   in timestamp columns. If a table contains a timestamp column, every time a row is
   modified by an INSERT, UPDATE, or DELETE statement, the timestamp value in the row
   is set to the current @@DBTS value, and then @@DBTS is incremented by one...}
  var
    TimestampField: TField;
    MaxTimestamp: Int64;
    FieldDesc: TOLEDBFieldDesc;
  begin
    TimestampField := TCustomMSDataSet(FOwner).FTimestampField;
    if TimestampField = nil then
      DatabaseError(STimestampFieldRequired);

    FieldDesc := TOLEDBFieldDesc(FOwner.GetFieldDesc(TimestampField));
    MaxTimestamp := TOLEDBTableInfo(FieldDesc.TableInfo).MaxTimestamp;
    FCondSB.Append(GetActualFieldName(FOwner.GetFieldDesc(TimestampField) as TCRFieldDesc, True) + ' > ' + '0x' + IntToHex(MaxTimestamp, SizeOf(MaxTimestamp) * 2));
  end;

var
  i: integer;
  FldUsed: set of byte;
  TestChanges: boolean;
begin
  Assert(FOwner <> nil);
  Assert(FOwner.Connection <> nil);
  Assert(IsClass(FOwner.Connection, TMSConnection));

  FCondSB.Length := 0;

  if StatementType = stRefreshQuick then
    GenerateCondForRQ
  else
  begin
    TestChanges := (StatementType = stInsert) and TCustomMSDataSet(FOwner).Options.DMLRefresh and
      (TCustomMSDataSet(FOwner).CursorType = ctDefaultResultSet) and TCustomMSDataSet(FOwner).Options.CheckRowVersion;

    TestChanges := TestChanges or ((StatementType = stUpdate) and TCustomMSDataSet(FOwner).Options.DMLRefresh and
      (TCustomMSDataSet(FOwner).CursorType = ctDefaultResultSet) and TCustomMSDataSet(FOwner).Options.CheckRowVersion);

    if not TestChanges then
      inherited
    else
    begin
      if (TCustomMSDataSet(FOwner).FTimestampField <> nil) and not TCustomMSDataSet(FOwner).FTimestampField.IsNull then
        AddFieldToCondition(FCondSB, FOwner.GetFieldDesc(TCustomMSDataSet(FOwner).FTimestampField) as TCRFieldDesc, StatementType, ModifiedFieldsOnly, Index)
      else
      begin
        FldUsed := [];
        if Length(KeyAndDataFields.KeyFieldDescs) > 0 then
          for i := 0 to High(KeyAndDataFields.KeyFieldDescs) do begin
            AddFieldToCondition(FCondSB, KeyAndDataFields.KeyFieldDescs[i], StatementType, ModifiedFieldsOnly, Index);
            FldUsed := FldUsed + [KeyAndDataFields.KeyFieldDescs[i].FieldNo];
          end;

        if Length(KeyAndDataFields.DataFieldDescs) = 0 then
          DatabaseError(SNoKeyFields);
        for i := 0 to High(KeyAndDataFields.DataFieldDescs) do
          if not IsBlobDataType(KeyAndDataFields.DataFieldDescs[i].DataType) // not "text", "ntext", "image"
            and not (KeyAndDataFields.DataFieldDescs[i].FieldNo in FldUsed) then
            AddFieldToCondition(FCondSB, KeyAndDataFields.DataFieldDescs[i], StatementType, ModifiedFieldsOnly, Index);
      end;
    end;
  end;
end;

{ TCustomMSDataSet}

procedure TCustomMSDataSet.AutoRefreshTimer(Sender: TObject);
begin
  if State = dsBrowse then begin
    try
      if FTimestampField <> nil then
        RefreshQuick(True)
      else
        Refresh;
    except
      Options.AutoRefresh := False;
      raise;
    end;

    // Reset timer
    FAutoRefreshTimer.Enabled := False;
    FAutoRefreshTimer.Enabled := True;
  end;
end;

function TCustomMSDataSet.QuoteName(const AName: string): string;
begin
  Result := QuoteName(AName, FLeftQuote, FRightQuote);
end;

function TCustomMSDataSet.QuoteName(const AName: string; const LeftQuote, RightQuote: string): string;
begin
  if FOptions.QuoteNames and (AName <> '')
    and ((AName[1] <> LeftQuote) and (AName[Length(AName)] <> RightQuote)) then
    Result := Concat(LeftQuote, AName, RightQuote)
  else
    Result := BracketIfNeed(AName);
end;

function TCustomMSDataSet.GetParams: TMSParams;
begin
  Result := TMSParams(inherited Params);
end;

procedure TCustomMSDataSet.SetParams(Value: TMSParams);
begin
  inherited Params := Value;
end;

constructor TCustomMSDataSet.Create(Owner: TComponent);
begin
  inherited Create(Owner);

  FOptions := inherited Options as TMSDataSetOptions;

  FLeftQuote := OLEDBAccess.LeftQuote;
  FRightQuote := OLEDBAccess.RightQuote;

  FLockInitFieldDefs := False;
  CursorType := ctDefaultResultSet;

  FIdentityField := nil;

  FIsInInitFieldDefs := False;

  FCommandTimeout := 0;
  FetchAll := True;

  FAutoRefreshTimer := TWin32Timer.Create(nil);
  FAutoRefreshTimer.OnTimer := AutoRefreshTimer;
  FAutoRefreshTimer.Interval := Options.AutoRefreshInterval * MSecsPerSec;
  FAutoRefreshTimer.Enabled := Options.AutoRefresh;
  
{$IFNDEF STD}  
  FNeedSmartRefresh := False;
{$ENDIF}  
end;

destructor TCustomMSDataSet.Destroy;
begin
  if FAutoRefreshTimer <> nil then begin
    FAutoRefreshTimer.Enabled := False;
    FAutoRefreshTimer.Free;
  end;

  inherited;
end;

procedure TCustomMSDataSet.AssignTo(Dest: TPersistent);
begin
  inherited;

  if Dest is TCustomMSDataSet then begin
    TCustomMSDataSet(Dest).SQLInsert := SQLInsert;
    TCustomMSDataSet(Dest).SQLDelete := SQLDelete;
    TCustomMSDataSet(Dest).SQLUpdate := SQLUpdate;
    TCustomMSDataSet(Dest).SQLRefresh := SQLRefresh;
    TCustomMSDataSet(Dest).CursorType := CursorType;

    TCustomMSDataSet(Dest).Params.Assign(Params);
  end;
end;

{ Smart Refresh }
{$IFDEF SMART_REFRESH}
{$IFNDEF STD}
procedure TCustomMSDataSet.RegisterNotification;
var
  CreateDML: string;
  Guid: TGUID;

  function PrepareGuid(const Guid: string): string;
  var
    i: integer;
  begin
    Result := ''; //+++ StringBuilder 
    for i := 1 to Length(Guid) - 1 do
      case Guid[i] of
        '0'..'9', 'A'..'F', 'a'..'f':
          Result := Result + Guid[i];
      end;
  end;

begin
  Assert(FRefreshServiceBroker = nil);

  BeginConnection;

  if TOLEDBConnection(Connection.IConnection).DBMSPrimaryVer <= 8 then
    DatabaseError(SInvalidServerVersion);

{$IFDEF VER6P}
  if CreateGuid(Guid) <> 0 then
    RaiseLastOSError;
{$ELSE}
  if CoCreateGuid(Guid) <> 0 then
    RaiseLastWin32Error;
{$ENDIF}

  FRefreshQueue := sSdacQueue + PrepareGuid(GuidToString(Guid));
  FRefreshService := sSdacService + PrepareGuid(GuidToString(Guid));

  CreateDML := 'IF NOT EXISTS (SELECT * FROM sys.service_queues WHERE name = N''' + FRefreshQueue + ''') ' +
    'CREATE QUEUE ' + FRefreshQueue + ';' + LineSeparator;
  CreateDML := CreateDML + 'IF NOT EXISTS (SELECT * FROM sys.services WHERE name = N''' + FRefreshService + ''') ' +
    'CREATE SERVICE ' + FRefreshService + ' ON QUEUE ' + FRefreshQueue + ' ([http://schemas.microsoft.com/SQL/Notifications/PostQueryNotification])';
  Connection.ExecSQL(CreateDML, []);

  FIRecordSet.SetProp(prSmartRefreshService, FRefreshService);

  FRefreshServiceBroker := TMSRefreshServiceBroker.Create(nil);
  TMSRefreshServiceBroker(FRefreshServiceBroker).FDataSet := Self;
  TMSRefreshServiceBroker(FRefreshServiceBroker).Service := FRefreshService;
  TMSRefreshServiceBroker(FRefreshServiceBroker).Connection := Connection;
end;

procedure TCustomMSDataSet.UnregisterNotification;
var
  DropDML: string;
begin
  try
    TMSRefreshServiceBroker(FRefreshServiceBroker).Free;
    FRefreshServiceBroker := nil;
  finally
    try
      DropDML := 'IF EXISTS (SELECT * FROM sys.services WHERE name = N''' + FRefreshService + ''') ' +
        'DROP SERVICE ' + FRefreshService + ';' + LineSeparator;
      DropDML := DropDML + 'IF EXISTS (SELECT * FROM sys.service_queues WHERE name = N''' + FRefreshQueue + ''') ' +
        'DROP QUEUE ' + FRefreshQueue + ';';
      try
        Connection.ExecSQL(DropDML, []);
      except
        on E: EOLEDBError do; // silent
      end;
    finally
      EndConnection;
    end;
  end;
end;
{$ENDIF}
{$ENDIF}

{ Open/Close }

procedure TCustomMSDataSet.SetActive(Value: Boolean);
begin
  if Value <> Active then begin
    if Value then
      SetNumericType;

  {$IFDEF SMART_REFRESH}
  {$IFNDEF STD}
    if Active and FOptions.FSmartRefresh then
      UnregisterNotification;
  {$ENDIF}
  {$ENDIF}
  end;
    
  try
      
    inherited;

    if Value and (FIRecordSet.FetchExecutor <> nil) then
      FIRecordSet.FetchExecutor.Resume;

  except
    on E: EDAError do begin
      if (E.Message = SCursorTypeChanged) then
        Unprepare;
      raise;
    end;
  end;
end;

procedure TCustomMSDataSet.DataReopen; 
begin
  if FCursorType in ServerCursorTypes then
    ClearBuffers;
  inherited;
end;

procedure TCustomMSDataSet.InternalExecute;
begin
  SetNumericType;
  inherited;
  if TCRRecordSet(Data).CommandType = ctCursor then
    InternalInitFieldDefs
  else
    TCRRecordSet(Data).GetCommand.SetCursorState(csInactive); // To prevent blocking execute on second exec
end;

procedure TCustomMSDataSet.InternalOpen;
  function IsAnyFieldDescCanBeModified: boolean;
  var
    i: integer;
  begin
    Result := False;
    for i := 0 to FIRecordSet.Fields.Count - 1 do
      if not FIRecordSet.Fields[i].ReadOnly then begin
        Result := True;
        Break;
      end;
  end;

  procedure FillFieldsOrigin;
  var
    Field: TField;
    FieldDesc: TOLEDBFieldDesc;

    TableName: string;

    i: integer;
  begin
    /// downto to correct set FIdentityField
    for i := Fields.Count - 1 downto 0 do begin
      Field := Fields[i];

      if Field.FieldKind = fkData then begin
        FieldDesc := TOLEDBFieldDesc(GetFieldDesc(Field));

        if not (Self is TCustomMSTable) then begin
          TableName := GenerateTableName(FieldDesc.BaseCatalogName, FieldDesc.BaseSchemaName, FieldDesc.BaseTableName, Connection.Database);
          Field.Origin := TableName + '.' + BracketIfNeed(FieldDesc.BaseColumnName);
        end
        else
          Field.Origin := TCustomMSTable(Self).FTableName + '.' + Field.FieldName;

        if FieldDesc.IsAutoIncrement then begin
          if Options.SetFieldsReadOnly then
            Field.ReadOnly := True;

          Assert((FUpdatingTableInfoIdx >= - 1) and (FUpdatingTableInfoIdx < TablesInfo.Count));

          if (FUpdatingTableInfoIdx >= 0)
            and (FIRecordSet.TablesInfo.IndexByName(GenerateTableName(FieldDesc.BaseCatalogName, FieldDesc.BaseSchemaName, FieldDesc.BaseTableName, Connection.Database)) = FUpdatingTableInfoIdx) then
            FIdentityField := Field;
        {$IFDEF VER5P}
          Field.AutoGenerateValue := arAutoInc;
        {$ENDIF}
        end;

        if FieldDesc.IsTimestamp
          and (FUpdatingTableInfoIdx >= 0)
          and (FieldDesc.BaseTableName = FIRecordSet.TablesInfo[FUpdatingTableInfoIdx].TableName) then
          FTimestampField := Field;
      end;
      if Field.DataType = TFieldType(ftMSXML) then begin
        FieldDesc := TOLEDBFieldDesc(GetFieldDesc(Field));
        Assert(Field is TMSXMLField);
        TMSXMLField(Field).SetSchemaCollection(FieldDesc.XMLSchemaCollectionName,
          FieldDesc.XMLSchemaCollectionCatalogName, FieldDesc.XMLSchemaCollectionSchemaName);
      end;
    end;
  end;

var
  i: integer;
  FieldDesc: TFieldDesc;
begin
  try
  {$IFDEF SMART_REFRESH}
  {$IFNDEF STD}
    if FOptions.FSmartRefresh then
      RegisterNotification;
  {$ENDIF}
  {$ENDIF}
  finally

    if CachedUpdates and (FCursorType in ServerCursorTypes) then
      DatabaseError(SCUandServerCursors);

    inherited;
    //Assert(not FIRecordSet.NativeRowset or (Length(FSQLObjects) <> 0));

    FNeedAddRef := FCursorType in ServerCursorTypes;

    FCanOpenNext := not FICommand.IUnknownNextIsNull;

    if FIRecordSet.NativeRowset then begin
      FIsAnyFieldDescCanBeModified := IsAnyFieldDescCanBeModified;

      if Fields.Count > 0 then
        FillFieldsOrigin;
    end
    else
      FIsAnyFieldDescCanBeModified := False;

    // Set right precision for TFloatField
    for i := 0 to Fields.Count - 1 do
      if (Fields[i] is TFloatField)
        and (TFloatField(Fields[i]).Precision = 15 {Default})
        and (Fields[i].FieldKind = fkData) then begin
        FieldDesc := GetFieldDesc(Fields[i]);
        case FieldDesc.DataType of
          dtFloat, dtCurrency: // Precision cannot be greater then 15
            TFloatField(Fields[i]).Precision := FieldDesc.Length;
        end;
      end;
  end;
end;

procedure TCustomMSDataSet.InternalClose;
var
  LockClearMultipleResults: boolean;
  v: Variant;
begin
  inherited;

  FTimestampField := nil;

  if FIsInInitFieldDefs then begin
    FICommand.ClearIUnknown;
    FIRecordSet.GetProp(prLockClearMultipleResults, v);
    LockClearMultipleResults := v;
    if not LockClearMultipleResults then begin
      FICommand.ClearIMultipleResults;
      FICommand.ClearIUnknownNext;
      FCanOpenNext := True;
    end;
  end;
end;

procedure TCustomMSDataSet.OpenCursor(InfoQuery: boolean);
begin

  FIRecordSet.SetProp(prReadOnly, ReadOnly);

  if FIRecordSet.NativeRowset and (SQL.Count = 0) then
    DatabaseError(SEmptySQLStatement, Self);

  inherited;
  
  if Options.DefaultValues then
    GetFieldsInfo;

  if InfoQuery then begin
    TCRRecordSet(Data).GetCommand.SetCursorState(csInactive); // To prevent blocking excute on second exec
    TCRRecordSet(Data).CommandType := CRAccess.ctUnknown;
  end;
end;

procedure TCustomMSDataSet.GetFieldsInfo;
var
  MetaData: TMSMetadata;
  Field: TField;
  DefValue: string;
begin
  MetaData := TMSMetadata.Create(nil);
  try
    MetaData.Connection := Connection;
    MetaData.DatabaseName := Connection.Database;
    MetaData.ObjectType := otColumns;
    MetaData.TableName := TablesInfo[FUpdatingTableInfoIdx].TableName;
    MetaData.Open;
    while not MetaData.EOF do begin
      Field := FindField(MetaData.FieldByName('COLUMN_NAME').AsString);
      if (Field <> nil) and MetaData.FieldByName('COLUMN_HASDEFAULT').AsBoolean and not MetaData.FieldByName('COLUMN_DEFAULT').IsNull then begin
        DefValue := MetaData.FieldByName('COLUMN_DEFAULT').AsString;
        case Field.DataType of
          ftBoolean:
            Field.DefaultExpression := BoolToStr(DefValue <> '0', True);
          ftFloat, ftBCD{$IFDEF VER6P}, ftFMTBCD{$ENDIF}:
            Field.DefaultExpression := StringReplace(DefValue, '.', DecimalSeparator, [rfReplaceAll]);
          else
            Field.DefaultExpression := DefValue;
        end;
      end;
      MetaData.Next;
    end;
  finally
    MetaData.Free;
  end;
end;

procedure TCustomMSDataSet.InitFieldDefs;
begin
  FIsInInitFieldDefs := True;
  try
    inherited;
  finally
    FIsInInitFieldDefs := False;
  end;
end;

procedure TCustomMSDataSet.InternalInitFieldDefs;
begin
  if not FLockInitFieldDefs then
    inherited;
end;
    
function TCustomMSDataSet.GetFieldType(DataType: word): TFieldType;
begin
  Result := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.GetFieldType(DataType);
end;

function TCustomMSDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
begin
  if Integer(FieldType) = ftMSXML then
    Result := TMSXMLField
  else
    Result := inherited GetFieldClass(Fieldtype);
end;

{$IFDEF USE_FTAUTOINC}
function TCustomMSDataSet.GetFieldType(FieldDesc: TFieldDesc): TFieldType;
begin
  Result := inherited GetFieldType(FieldDesc);
  Assert(FieldDesc is TOLEDBFieldDesc);
  if (Result = ftInteger) and TOLEDBFieldDesc(FieldDesc).IsAutoIncrement then
    Result := ftAutoInc;
end;
{$ENDIF}

procedure TCustomMSDataSet.CreateIRecordSet;
begin
  inherited;

  if FIRecordSet = nil then
    SetIRecordSet(TOLEDBRecordSet.Create);
end;

procedure TCustomMSDataSet.SetIRecordSet(Value: TData);
begin
  inherited;

  FIRecordSet := TOLEDBRecordSet(Value);

  if FIRecordSet <> nil then begin
    FICommand := TOLEDBCommand(FIRecordSet.GetCommand);
    if FOptions <> nil then begin
      SetNumericType;
      FIRecordSet.SetProp(prUniqueRecords, FOptions.FUniqueRecords);
      FIRecordSet.SetProp(prCursorUpdate, FOptions.FCursorUpdate);
    end;

    FIRecordSet.SetProp(prEnableEmptyStrings, True);
    FIRecordSet.SetProp(prReadOnly, ReadOnly);
    FIRecordSet.SetProp(prCursorType, Integer(CursorType));
    FIRecordSet.SetProp(prCommandTimeout, CommandTimeout);
    FIRecordSet.SetProp(prRequestSQLObjects, True);

    FIRecordSet.SetProp(prRoAfterUpdate, roAfterUpdate in RefreshOptions);

    TOLEDBRecordSet(FIRecordSet).CursorTypeChanged := DoCursorTypeChanged;
  end
  else
    FICommand := nil;
end;

procedure TCustomMSDataSet.SetNumericType;
begin
  if (FIRecordSet <> nil) and (FOptions <> nil) then begin
    if FOptions.EnableBCD or (Connection = nil) or (Connection.Options = nil) then begin
      Assert(FIRecordSet <> nil);
      FIRecordSet.SetProp(prEnableBCD, FOptions.FEnableBCD);
    {$IFDEF VER6P}
      FIRecordSet.SetProp(prEnableFMTBCD, False);
    {$ENDIF}
    end
    else
      case Connection.Options.NumericType of
        ntFloat: begin
          FIRecordSet.SetProp(prEnableBCD, False);
        {$IFDEF VER6P}
          FIRecordSet.SetProp(prEnableFMTBCD, False);
        {$ENDIF}
        end;
        ntBCD: begin
          FIRecordSet.SetProp(prEnableBCD, True);
        {$IFDEF VER6P}
          FIRecordSet.SetProp(prEnableFMTBCD, False);
        {$ENDIF}
        end;
      {$IFDEF VER6P}
        ntFMTBCD: begin
          FIRecordSet.SetProp(prEnableBCD, True);
          FIRecordSet.SetProp(prEnableFMTBCD, True);
        end;
      {$ENDIF}
      end;
  end;
  if FieldDefs <> nil then
    FieldDefs.Updated := False;
end;

function TCustomMSDataSet.GetCanModify: boolean;
begin
  Assert(FIRecordSet <> nil, 'FIRecordSet must be setted to this time');

  Result := inherited GetCanModify or
    not (ReadOnly or UniDirectional) and
    (FIsAnyFieldDescCanBeModified or
    (SQLInsert.Count > 0) or
    (SQLUpdate.Count > 0) or
    (SQLDelete.Count > 0))
    and (FCursorType <> ctStatic);
end;
    
procedure TCustomMSDataSet.CreateCommand;
begin
  SetCommand(TMSSQL.Create(Self));
end;

function TCustomMSDataSet.CreateOptions: TDADataSetOptions;
begin
  Result := TMSDataSetOptions.Create(Self);
end;

function TCustomMSDataSet.GetConnection: TMSConnection;
begin
  Result := TMSConnection(inherited Connection);
end;

procedure TCustomMSDataSet.SetConnection(Value: TMSConnection);
begin
  inherited Connection := Value;
end;

function TCustomMSDataSet.PSGetKeyFields: string;
begin
  if FIRecordSet.NativeRowset then
    Result := inherited PSGetKeyFields
  else
    Result := '';
end;

procedure TCustomMSDataSet.CreateSQLGenerator;
begin
  SetSQLGenerator(TMSSQLGenerator.Create(Self));
end;

procedure TCustomMSDataSet.SetReadOnly(Value: boolean);
begin
  if ReadOnly <> Value then begin
    if CursorType in ServerCursorTypes then
      CheckInactive;
    FieldDefs.Updated := False;
    FIRecordSet.SetProp(prReadOnly, Value);
    FIRecordSet.SetProp(prRequestSQLObjects, FOptions.FUniqueRecords or not Value);
    inherited;
  end;
end;

procedure TCustomMSDataSet.InternalBeforeEdit; 
begin
  if roBeforeEdit in RefreshOptions then begin
    InternalRefreshRecord;
    if CursorType in ServerCursorTypes then
      Resync([]); // CR 9097
  end;

  inherited;
end;

procedure TCustomMSDataSet.UnPrepare;
var
  v: variant;
  LockClearMultipleResults: boolean;
begin
  Close;

  if FICommand <> nil then begin
    FICommand.ClearIUnknown;
    FIRecordSet.GetProp(prLockClearMultipleResults, v);
    LockClearMultipleResults := v;
    if not LockClearMultipleResults then begin
      FICommand.ClearIMultipleResults;
      FICommand.ClearIUnknownNext;
      FCanOpenNext := True;
    end;
  end;

  inherited;
end;

function TCustomMSDataSet.OpenNext: boolean; // Open next rowset in statement. if rowset is not provided then OpenNext return False. If statement has error, then raised exception
begin
  if Prepared then
    DatabaseError(SOpenNextPreparedSQL);

  Result := FCanOpenNext;
  if Result then
    BeginConnection;
  try
    FIRecordSet.SetProp(prLockClearMultipleResults, True);
    try
      Close;
      Unprepare;
    finally
      FIRecordSet.SetProp(prLockClearMultipleResults, False);
    end;

    if Result then begin
      FieldDefs.Updated := False;
      Open;
    end;
  finally
    if Result then
      EndConnection;
  end;
end;

function TCustomMSDataSet.FindParam(const Value: string): TMSParam;
begin
  Result := inherited FindParam(GetParamNameWODog(Value)) as TMSParam;
end;

function TCustomMSDataSet.ParamByName(const Value: string): TMSParam;
begin
  Result := inherited ParamByName(GetParamNameWODog(Value)) as TMSParam;
end;

procedure TCustomMSDataSet.CreateProcCall(Name: string);
begin
  InternalCreateProcCall(Name, True);
end;

procedure TCustomMSDataSet.Post;
begin
  inherited;

{$IFNDEF STD}
  if FNeedSmartRefresh then
    DoSmartRefresh;
{$ENDIF}    
end;

procedure TCustomMSDataSet.Cancel;
begin
  inherited;
  
{$IFNDEF STD}  
  if FNeedSmartRefresh then
    DoSmartRefresh;
{$ENDIF}    
end;

function TCustomMSDataSet.SQLAddWhere(SQLText, Condition: string): string;
begin
  Result := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.AddWhere(SQLText, Condition);
end;

function TCustomMSDataSet.SQLDeleteWhere(SQLText: string): string;
begin
  Result := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.DeleteWhere(SQLText);
end;

function TCustomMSDataSet.SQLGetWhere(SQLText: string): string;
begin
  Result := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.GetWhere(SQLText);
end;

function TCustomMSDataSet.SQLSetOrderBy(SQLText: string; Fields: string): string;
begin
  Result := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.SetOrderBy(SQLText, Fields);
end;

function TCustomMSDataSet.SQLGetOrderBy(SQLText: string): string;
begin
  Result := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.GetOrderBy(SQLText);
end;

(*procedure TCustomMSDataSet.SetBeforeFetch(Value: TBeforeFetchEvent);
begin
  inherited;
  FIRecordSet.SetProp(prBeforeFetch, Assigned(BeforeFetch));
end;

procedure TCustomMSDataSet.SetAfterFetch(Value: TAfterFetchEvent);
begin
  inherited;
  FIRecordSet.SetProp(prAfterFetch, Assigned(AfterFetch));
end;*)

procedure TCustomMSDataSet.SetRefreshOptions(Value: TRefreshOptions);
begin
  inherited SetRefreshOptions(Value);
  if FIRecordSet <> nil then
    FIRecordSet.SetProp(prRoAfterUpdate, roAfterUpdate in RefreshOptions);
end;

procedure TCustomMSDataSet.WriteFieldXMLDataType(Field: TField; FieldDesc: TFieldDesc;
  const FieldAlias: string; XMLWriter: XMLTextWriter);
begin
  inherited;

  if FieldDesc is TOLEDBFieldDesc then begin
    if TOLEDBFieldDesc(FieldDesc).IsAutoIncrement
      and not (Field.Required and not Field.ReadOnly) // Already writed in MemDS
    then
      XmlWriter.WriteAttributeString('rs:maybenull', 'false');
  end;
end;

procedure TCustomMSDataSet.WriteFieldXMLAttributeType(Field: TField; FieldDesc: TFieldDesc;
  const FieldAlias: string; XMLWriter: XMLTextWriter);
begin
  inherited;

  if FieldDesc is TOLEDBFieldDesc then begin
    if TOLEDBFieldDesc(FieldDesc).BaseCatalogName <> '' then
      XmlWriter.WriteAttributeString('rs:basecatalog', XMLEncode(TOLEDBFieldDesc(FieldDesc).BaseCatalogName));

    if TOLEDBFieldDesc(FieldDesc).BaseSchemaName <> '' then
      XmlWriter.WriteAttributeString('rs:baseschema', XMLEncode(TOLEDBFieldDesc(FieldDesc).BaseSchemaName));

    if TOLEDBFieldDesc(FieldDesc).IsTimestamp then
      XmlWriter.WriteAttributeString('rs:rowver', 'true');
  end;
end;

procedure TCustomMSDataSet.GetKeyAndDataFields(
      out KeyAndDataFields: TKeyAndDataFields;
      const ForceUseAllKeyFields: boolean);

  procedure ProcessField(FieldDesc: TOLEDBFieldDesc);
  begin
    if FieldDesc.IsKey or FieldDesc.IsAutoIncrement then begin
      SetLength(KeyAndDataFields.KeyFieldDescs, Length(KeyAndDataFields.KeyFieldDescs) + 1);
      KeyAndDataFields.KeyFieldDescs[High(KeyAndDataFields.KeyFieldDescs)] := FieldDesc;
    end;

    if not FieldDesc.ReadOnly then begin
      SetLength(KeyAndDataFields.DataFieldDescs, Length(KeyAndDataFields.DataFieldDescs) + 1);
      KeyAndDataFields.DataFieldDescs[High(KeyAndDataFields.DataFieldDescs)] := FieldDesc;
    end;
  end;

var
  ByTable: boolean;
  Field: TField;
  FieldDesc: TOLEDBFieldDesc;
  i: integer;
  IsNeedProcessField: boolean;

begin
  if (Length(FCachedKeyAndDataFields[ForceUseAllKeyFields].KeyFieldDescs) = 0) and (Length(FCachedKeyAndDataFields[ForceUseAllKeyFields].DataFieldDescs) = 0) then begin
      // Search fields

    SetLength(KeyAndDataFields.KeyFieldDescs, 0);
    SetLength(KeyAndDataFields.DataFieldDescs, 0);

    if (Fields.Count = 0) or (FIRecordSet.Fields.Count = 0) then
      Exit;

    ByTable := False;
    if FUpdatingTableInfoIdx >= 0 then
      if Self is TCustomMSTable then
        ByTable := True
      else
        if not ForceUseAllKeyFields or not Options.FullRefresh then
          ByTable := True;

    for i := 0 to Fields.Count - 1 do begin
      Field := Fields[i];
      if Field.FieldKind = fkData then begin
        FieldDesc := GetFieldDesc(Field) as TOLEDBFieldDesc;
        if ByTable then
          IsNeedProcessField := (Self is TCustomMSTable) or (FieldDesc.TableInfo = TablesInfo[FUpdatingTableInfoIdx])
        else
          IsNeedProcessField := True;
        if IsNeedProcessField then
          ProcessField(FieldDesc);
      end;
    end;

    // Cache result
    FCachedKeyAndDataFields[ForceUseAllKeyFields] := KeyAndDataFields;
  end
  else // Get fields from cache
    KeyAndDataFields := FCachedKeyAndDataFields[ForceUseAllKeyFields];
end;

procedure TCustomMSDataSet.BeginConnection(NoConnectCheck: boolean = True);
begin
   if FIRecordSet.NativeRowset then
     inherited;
end;

procedure TCustomMSDataSet.EndConnection; 
begin
  if FIRecordSet.NativeRowset then
    inherited;
end;

procedure TCustomMSDataSet.SetNumberRange(FieldDef: TFieldDef);
var
  Field: TField;
  FieldDesc: TOLEDBFieldDesc;
{$IFDEF VER6P}
  mv: Extended;
{$ENDIF}
  AIConnection: TOLEDBConnection;
  ServerVersion: integer;
begin
  AIConnection := TMSAccessUtils.FIConnection(Connection);
  ServerVersion := 0;
  if AIConnection <> nil then
    ServerVersion := AIConnection.ProviderPrimaryVer;
  Field := FindField(FieldDef.Name);
  if Field <> nil then begin
    FieldDesc := GetFieldDesc(Field) as TOLEDBFieldDesc;
    case FieldDesc.OLEDBType of
      DBTYPE_UI1:
      begin
        Assert(Field is TWordField);
        TWordField(Field).MinValue := 0;
        TWordField(Field).MaxValue := 255;
      end;
    else
      case FieldDesc.DataType of
        dtInt8:
        begin
          TIntegerField(Field).MinValue := -128;
          TIntegerField(Field).MaxValue := 127;
        end;
        dtInt16:
        begin
          if ServerVersion = 3 then begin
            TSmallIntField(Field).MinValue := -32768;
            TSmallIntField(Field).MaxValue := 32767;
          end
          else begin
            TIntegerField(Field).MinValue := -32768;
            TIntegerField(Field).MaxValue := 32767;
          end;
        end;
        dtInt32:
        begin
          TIntegerField(Field).MinValue := -2147483647;
          TIntegerField(Field).MaxValue := 2147483647;
        end;
        dtInt64:
        begin
          TLargeintField(Field).MinValue := -9223372036854775807;
          TLargeintField(Field).MaxValue := 9223372036854775807;
        end;
        dtWord:
        begin
          TWordField(Field).MinValue := 0;
          TWordField(Field).MaxValue := 65535;
        end;
        dtFloat:
        begin
          if FieldDesc.Scale = 255 then begin
            if FieldDesc.Length = 7 then begin
              TFloatField(Field).MinValue := -3.40E38;
              TFloatField(Field).MaxValue := 3.40E38;
            end
            else
            begin
              TFloatField(Field).MinValue := -1.79E308;
              TFloatField(Field).MaxValue := 1.79E308;
            end;
          end
          else
            if (FieldDesc.Length > 0) then begin
              TFloatField(Field).Precision := FieldDesc.Length;
              TFloatField(Field).MaxValue :=
                IntPower(10, FieldDesc.Length - FieldDesc.Scale) -
                IntPower(10, - Integer(FieldDesc.Scale));
              TFloatField(Field).MinValue := -TFloatField(Field).MaxValue;
            end;
        end;
        dtBCD:
        begin
          TBCDField(Field).Precision := FieldDesc.Length;
          if (FieldDesc.Length > 0) and (FieldDesc.Length <= 15) then begin
            TBCDField(Field).MaxValue :=
              IntPower(10, FieldDesc.Length - FieldDesc.Scale) -
              IntPower(10, - Integer(FieldDesc.Scale));
            TBCDField(Field).MinValue := -TBCDField(Field).MaxValue;
          end;
        end;
      {$IFDEF VER6P}
        dtFmtBCD:
        begin
          TFMTBCDField(Field).Precision := FieldDesc.Length;
          if (FieldDesc.Length > 0) and (FieldDesc.Length <= 15) then begin
            mv :=
              IntPower(10, FieldDesc.Length - FieldDesc.Scale) -
              IntPower(10, - Integer(FieldDesc.Scale));
            TFMTBCDField(Field).MaxValue := FloatToStr(mv);
            TFMTBCDField(Field).MinValue := FloatToStr(-mv);
          end;
        end;
      {$ENDIF}
        dtCurrency:
          if ServerVersion <> 3 then begin
            if FieldDesc.Length = 10 then begin
              TFloatField(Field).MinValue := -214748.3648 ;
              TFloatField(Field).MaxValue := 214748.3647;
            end
            else
              if FieldDesc.Length = 19 then begin
                TFloatField(Field).MinValue := -922337203685477.5808;
                TFloatField(Field).MaxValue := 922337203685477.5807;
              end;
          end
          else begin
            TCurrencyField(Field).MinValue := -922337203685477.5808;
            TCurrencyField(Field).MaxValue := 922337203685477.5807;
          end;
      end;
    end;
  end;
end;

procedure TCustomMSDataSet.DetectIdentityField;
var
  i: integer;
  Field: TField;
  FieldDesc: TOLEDBFieldDesc;
begin
  inherited;

  //Search Identity Field
  for i := FieldCount - 1 downto 0 do begin
    Field := Fields[i];

    if Field.FieldKind = fkData then begin
      FieldDesc := TOLEDBFieldDesc(GetFieldDesc(Field));

      if FieldDesc.IsAutoIncrement then begin

        Assert((FUpdatingTableInfoIdx >= - 1) and (FUpdatingTableInfoIdx < TablesInfo.Count));

        if (FUpdatingTableInfoIdx >= 0)
          and (FIRecordSet.TablesInfo.IndexByName(GenerateTableName(FieldDesc.BaseCatalogName, FieldDesc.BaseSchemaName, FieldDesc.BaseTableName, Connection.Database)) = FUpdatingTableInfoIdx) then
          FIdentityField := Field;
      end;
    end;
  end;
end;

procedure TCustomMSDataSet.SetOptions(Value: TMSDataSetOptions);
begin
  Options.Assign(Value);
end;

{
procedure TCustomMSDataSet.AssignFieldValue(Param: TParam; Field: TField; Old: boolean);
begin
  inherited;
  if Field.IsNull then
    Param.Clear;
end;
}

function TCustomMSDataSet.NeedReturnParams: boolean;
begin
  Result := inherited NeedReturnParams or FOptions.FDMLRefresh;
end;

procedure TCustomMSDataSet.AssignFieldValue(Param: TDAParam; Field: TField; Old: boolean);
var
  FieldDesc: TOLEDBFieldDesc;
begin
  if TDBAccessUtils.IsObjectDataType(Param, Field.DataType) then begin
    FieldDesc := TOLEDBFieldDesc(GetFieldDesc(Field));
    TMSParam(Param).OLEDBType := FieldDesc.OLEDBType;
  end;

  inherited AssignFieldValue(Param, Field, Old);
end;

function TCustomMSDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: boolean): TGetResult;
begin
  Result := grError;
  if (FCursorType = ctDynamic) and (BufferCount > 1) then
    DatabaseError(SBookmarksRequired)
  else
    Result := inherited GetRecord(Buffer, GetMode, DoCheck);
end;

procedure TCustomMSDataSet.InternalSetToRecord(Buffer: TRecordBuffer); 
begin
  inherited;
  
  if (FCursorType in ServerCursorTypes) and (GetBookmarkFlag(Buffer) <> bfInserted) then 
    GetRecord(Buffer, gmCurrent, True);
end;

procedure TCustomMSDataSet.DoAfterExecute(Result: boolean);
begin
  inherited;
{$IFDEF SMART_REFRESH}
{$IFNDEF STD}
  if (FRefreshServiceBroker <> nil) and (not TMSServiceBroker(FRefreshServiceBroker).Active) then
    TMSServiceBroker(FRefreshServiceBroker).Start;
{$ENDIF}
{$ENDIF}
end;

{ Smart Refresh}
{$IFNDEF STD}
procedure TCustomMSDataSet.DoSmartRefresh;
begin
  if State in [dsInsert,dsEdit] then
    FNeedSmartRefresh := True
  else begin
    Refresh;
    if Assigned(FAfterSmartRefresh) then
      FAfterSmartRefresh(Self);
    FNeedSmartRefresh := False;
  end;
end;
{$ENDIF}

{ Before / After UpdateExecute }

function TCustomMSDataSet.AssignedBeforeUpdateExecute: boolean;
begin
  Result := Assigned(FBeforeUpdateExecute);
end;

procedure TCustomMSDataSet.DoBeforeUpdateExecute(Sender: TDataSet; StatementTypes: TStatementTypes;
  Params: TDAParams);
begin
  if AssignedBeforeUpdateExecute then
    FBeforeUpdateExecute(Sender as TCustomMSDataSet, StatementTypes, Params as TMSParams);
end;

function TCustomMSDataSet.AssignedAfterUpdateExecute: boolean;
begin
  Result := Assigned(FAfterUpdateExecute);
end;

procedure TCustomMSDataSet.DoAfterUpdateExecute(Sender: TDataSet; StatementTypes: TStatementTypes;
  Params: TDAParams);
begin
  if AssignedAfterUpdateExecute then
    FAfterUpdateExecute(Sender as TCustomMSDataSet, StatementTypes, Params as TMSParams);
end;

function TCustomMSDataSet.GetRecCount: longint;
  function GetCount(const s: string): longint;
  var
    i: integer;
    OldParamCheck: boolean;
    UQ: TCustomMSDataSet;
    AIConnection: TOLEDBConnection;
  begin
    CheckUpdateQuery(stCustom);
    UQ := FUpdateQuery as TCustomMSDataSet;

    OldParamCheck := UQ.ParamCheck;
    try
      UQ.ParamCheck := ParamCheck;
      UQ.SQL.Text := s;
      if not ParamCheck then
        for i := 0 to Params.Count {without -1!} do
          UQ.Params.Add;

      if UQ.ParamCount > 0 then begin
        UQ.Params[0].DataType := ftLargeint;
        UQ.Params[0].ParamType := ptOutput;
      end;

      UQ.Macros.Assign(Macros);
      for i := 0 to Params.Count - 1 do
        UQ.Params[i + 1].Assign(Params[i]);

      AIConnection := TMSAccessUtils.FIConnection(Connection);
      if (AIConnection <> nil) and (AIConnection.ProviderPrimaryVer <> 3) then begin
        UQ.Execute;
        Result := UQ.Params[0].Value;
      end
      else begin
        UQ.Open;
        Result := UQ.Fields[0].Value;
      end;
    finally
      UQ.ParamCheck := OldParamCheck;
    end;
  end;

var
  Parser: TMSParser;
  SelectPos: integer;
  FromPos: integer;
  s: string;
  CountParamName: string;

begin
  if ((not FetchAll or Options.NonBlocking) and FOptions.QueryRecCount) // Server cursors or DefaultResultSet with FetchAll = False
    and not ((Params.Count > 0) and (Params[0].ParamType = ptResult)) then begin // Current SQL does not have RETURN parameter
    s := FinalSQL;
    s := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.SetOrderBy(s, '');
    Parser := TMSParser.Create(s);
    Parser.OmitBlank := False;
    Parser.OmitComment := True;
    try
      if Parser.ToLexem(lxSELECT) <> lcEnd then begin
        SelectPos := Parser.CurrPos;
        if Parser.ToLexem(lxFROM) <> lcEnd then begin
          FromPos := Parser.CurrPos;

          if Connection.Options.Provider <> prCompact then begin
            if ParamCheck then
              CountParamName := ':SDAC_COUNT'
            else
              CountParamName := '?';
            s := 'SET ' + CountParamName + ' = (' + Copy(s, 1, SelectPos) + ' COUNT(*)' + Copy(s, FromPos - 4 {length('FROM')}, MaxInt) + ')';
          end
          else begin
            CountParamName := 'SDAC_COUNT';
            s := Copy(s, 1, SelectPos) + ' COUNT(*) AS ' + CountParamName + ' ' + Copy(s, FromPos - 4 {length('FROM')}, MaxInt);
          end;  
        end;
      end;
    finally
      Parser.Free;
    end;

    if s <> '' then
      Result := GetCount(s)
    else
      Result := 0;
  end
  else
    Result := inherited GetRecCount;
end;

function TCustomMSDataSet.GetRecordCount: integer;
begin
  if (not FetchAll or Options.NonBlocking) and FOptions.QueryRecCount then // Server cursors or DefaultResultSet with FetchAll = False
    Result := FRecordCount
  else
    Result := inherited GetRecordCount;
end;

function TCustomMSDataSet.Fetched: boolean; 
begin
  if FCursorType in ServerCursorTypes then
    Result := False
  else
    Result := inherited Fetched;
end;

procedure TCustomMSDataSet.DoCursorTypeChanged;
var
  v: Variant;
begin
  // Does not need to read ReadOnly property (for changes to static cursor)
  //  FIRecordSet.GetProp(prReadOnly, @ReadOnly);

  FIRecordSet.GetProp(prCursorType, v);
  FCursorType := TMSCursorType(v);
  raise EDAError.Create(0, SCursorTypeChanged);
end;

procedure TCustomMSDataSet.SetFetchAll(Value: boolean);
begin
  if FetchAll <> Value then
    UnPrepare;

  inherited;
end;

procedure TCustomMSDataSet.UpdateExecute(const StatementTypes: TStatementTypes);
var
  UserSQL, ROnly: boolean;
  IdentityParamIdx: integer;
  UQParams: TDAParams;
  NewIdentityValue: variant;
  AIConnection: TOLEDBConnection;
begin
  IdentityParamIdx := - 1;
  UQParams := TDBAccessUtils.GetParams(FUpdateQuery);
  AIConnection := TMSAccessUtils.FIConnection(Connection);
  if stInsert in StatementTypes then begin
    if Assigned(UpdateObject) then
      UserSQL := UpdateObject.SQL[DB.ukInsert].Count > 0
    else
      UserSQL := FUpdateSQL[stInsert].Count > 0;

    if not UserSQL then begin // This is not custom user statement and last parameter is used for Identity
      if Options.QueryIdentity and (FIdentityField <> nil) and (CursorType = ctDefaultResultSet) then begin
        if (AIConnection <> nil) and (AIConnection.ProviderPrimaryVer = 3) then
          IdentityParamIdx := 0
        else begin
          IdentityParamIdx := UQParams.Count - 1;
          Assert(IdentityParamIdx >= 0);
          // UQParams[IdentityParamIdx].ParamType := ptInputOutput; - already setted by AddParam 
        end;
      end;
    end;
  end;

  inherited;

  if (IdentityParamIdx >= 0) and not NeedReturnParams then begin
    ROnly := FIdentityField.ReadOnly;
    if ROnly then begin
      SetTempState(State); // DisableControls
      FIdentityField.ReadOnly := False;
    end;
    if (AIConnection <> nil) and (AIConnection.ProviderPrimaryVer = 3) then begin
      TDBAccessUtils.GetSQL(FUpdateQuery).Text := 'SELECT @@IDENTITY';
      TDBAccessUtils.Open(FUpdateQuery);
      NewIdentityValue := TCustomMSDataSet(FUpdateQuery).Fields[IdentityParamIdx].Value;
    end
    else
      NewIdentityValue := UQParams[IdentityParamIdx].Value;
      
    FIdentityField.NewValue := NewIdentityValue;

    if ROnly then begin
      FIdentityField.ReadOnly := True;
      RestoreState(State);
    end
  end;
end;

procedure TCustomMSDataSet.InternalRefreshRecord;
var
  Bookmark: TBookmark;
begin
  case FCursorType of
    ctDefaultResultSet:
      inherited;
    ctStatic, ctKeySet:
    begin
      Bookmark := GetBookmark;
      try
        FIRecordSet.SetToBookmark(Bookmark); // ReFetch
      finally
        FreeBookmark(Bookmark);
      end;
      FRowsAffected := 1; // Must be always OK
    end;
    ctDynamic:
    begin
      if FIRecordSet.FetchToBookmarkValue then
        FRowsAffected := 1
      else
        FRowsAffected := 0;
    end;
  end;
end;

procedure TCustomMSDataSet.CheckUpdateQuery(const StatementType: TStatementType);
var
  UseMSSQL: boolean;
begin
  FUpdateQuery := FUpdateComponents[StatementType];
  if FUpdateQuery = nil then begin
    if not __UseUpdateOptimization then
      UseMSSQL := False
    else
      case StatementType of
        stInsert, stUpdate:
          UseMSSQL := not Options.DMLRefresh;
        stDelete:
          UseMSSQL := True;
        else
          UseMSSQL := False;
      end;
    if UseMSSQL and (Connection.Options.Provider = prCompact) then
      UseMSSQL := not (Options.QueryIdentity and (FIdentityField <> nil));
    if UseMSSQL then begin
      Assert(UsedConnection <> nil);
      FUpdateQuery := TMSSQL.Create(nil);
      TMSSQL(FUpdateQuery).Connection := TMSConnection(UsedConnection);
    end;
  end;
  FUpdateComponents[StatementType] := FUpdateQuery;

  inherited;

  Assert(FUpdateComponents[StatementType] = FUpdateQuery);

  if FUpdateQuery is TCustomMSDataSet then begin
    TCustomMSDataSet(FUpdateQuery).FetchAll := True;
    TCustomMSDataSet(FUpdateQuery).ReadOnly := True;
    TCustomMSDataSet(FUpdateQuery).Options.FlatBuffers := True;
    TCustomMSDataSet(FUpdateQuery).Options.NumberRange := False;
    TCustomMSDataSet(FUpdateQuery).Options.QueryRecCount := False;
    TCustomMSDataSet(FUpdateQuery).Options.QuoteNames := False;
    TCustomMSDataSet(FUpdateQuery).Options.UniqueRecords := False;
    TCustomMSDataSet(FUpdateQuery).Options.FullRefresh := Options.FullRefresh;

    TCustomMSDataSet(FUpdateQuery).FIRecordSet.SetProp(prRequestSQLObjects, False);
  end;
end;

function TCustomMSDataSet.UseParamType: boolean;
begin
  Result := FUseParamType;
end;

function TCustomMSDataSet.PerformSQL(const SQL: string; const StatementTypes: TStatementTypes): boolean;
begin
  try
    Result := inherited PerformSQL(SQL, StatementTypes);
  finally
    FUseParamType := False;
  end;
end;

function ConvertCRParamTypeToBDE(const Value: TParamDirection): TParamType;
begin
  case Value of
    pdInput:
      Result := ptInput;
    pdInputOutput:
      Result := ptInputOutput;
    pdResult:
      Result := ptResult;
    else
      Assert(False, 'Invalid value in ConvertCRParamTypeToBDE(const Value: TParamDirection): TParamType');
      Result := ptUnknown; // To prevent compiler warning
  end;
end;

procedure TCustomMSDataSet.InternalCreateProcCall(Name: string; NeedDescribe: boolean);
var
  i: integer;
  ParamDescs: TParamDescs;
  ParamDesc: CRAccess.TParamDesc;

  Param: TMSParam;
  ParamType: TParamType;
  IsNewParam: boolean;
  ft: TFieldType;

  ProcCallSQL: string;
{$IFDEF VER6P}
  EnableFmtBcd: variant;
{$ENDIF}
begin
  BeginConnection;
  try
    if not NeedDescribe then
      TMSSQL(FCommand).WriteParams(False);

  {$IFDEF VER6P}
    EnableFmtBcd := FIRecordSet.GetProp(prEnableFMTBCD, EnableFmtBcd);
  {$ENDIF}
    ProcCallSQL := FICommand.CreateProcCall(Name, NeedDescribe, True, Options.EnableBCD, {$IFDEF VER6P}Boolean(EnableFmtBcd){$ELSE}False{$ENDIF});

    if NeedDescribe then
      TMSSQL(FCommand).CreateParams;
      
    if NeedDescribe and (Params <> nil) then begin
      ParamDescs := TOLEDBCommand(FICommand).Params;
      for i := 0 to ParamDescs.Count - 1 do begin
        ParamDesc := ParamDescs[i];
        ParamType := ConvertCRParamTypeToBDE(ParamDesc.GetParamType);

        Param := Params.FindParam(ParamDesc.GetName);
        IsNewParam := Param = nil;
        if IsNewParam then
          Param := TMSParam.Create(Params, ParamType);

        Param.ParamType := ParamType;
        ft := GetFieldType(ParamDesc.GetDataType);
        if ft <> Param.DataType then
          Param.DataType := ft; // To prevent clearing Param.Value on set DataType
        Param.Name := ParamDesc.GetName;
        if IsNewParam then
          Param.Value := ParamDesc.GetValue;
        Param.Size := ParamDesc.GetSize;
      end;
      
      FICommand.SetProp(prDisableParamScan, True);
      try
        FCommand.SQL.Text := ProcCallSQL;
      finally
        FICommand.SetProp(prDisableParamScan, False);
      end;
    end;
  finally
    EndConnection;
  end;
end;

function TCustomMSDataSet.IsRefreshQuickField(FieldDesc: TFieldDesc): boolean;
begin
  Result := TOLEDBFieldDesc(FieldDesc).IsTimestamp;
end;

procedure TCustomMSDataSet.SaveMaxRefreshQuickValue(FieldDesc: TFieldDesc; const Value: variant);
var
  Field: TOLEDBFieldDesc;
  Val: Int64;
{$IFDEF CLR}
  Data: TBytes;
{$ENDIF}
begin
  Field := TOLEDBFieldDesc(FIRecordSet.FindField(FieldDesc.Name));
  if (Field <> nil) and Field.IsTimestamp and (Field.TableInfo <> nil) then begin
  {$IFDEF CLR}
    Data := TBytes(Value);
    System.Array.Reverse(Data, 0, SizeOf(Int64));
    Val := BitConverter.ToInt64(Data, 0);
  {$ELSE}
    Val := Int64(TVarData(Value).VArray.Data^);
    Reverse8(@Val);
  {$ENDIF}
    if {$IFDEF VER7P}UInt64{$ENDIF}(TOLEDBTableInfo(Field.TableInfo).MaxTimestamp) < {$IFDEF VER7P}UInt64{$ENDIF}(Val) then
      TOLEDBTableInfo(Field.TableInfo).MaxTimestamp := Val;
  end;
end;

{ TMSUpdateSQL }

function TMSUpdateSQL.DataSetClass: TCustomDADataSetClass;
begin
  Result := TCustomMSDataSet;
end;

function TMSUpdateSQL.SQLClass: TCustomDASQLClass;
begin
  Result := TMSSQL;
end;

{ TMSQuery }

procedure TMSQuery.SetIRecordSet(Value: TData);
begin
  inherited;

  FIRecordSet := TOLEDBRecordSet(Value);
end;

procedure TCustomMSDataSet.SetCursorType(const Value: TMSCursorType);
begin
  if FCursorType <> Value then begin
    CheckInactive;
    FieldDefs.Updated := False;
    FCursorType := Value;
    if FIRecordSet <> nil then 
      FIRecordSet.SetProp(prCursorType, Integer(CursorType));
  end;
end;

procedure TCustomMSDataSet.SetCommandTimeout(const Value: integer);
begin
  if FCommandTimeout <> Value then begin
    FCommandTimeout := Value;
    if FIRecordSet <> nil then
      FIRecordSet.SetProp(prCommandTimeout, FCommandTimeout);
  end;
end;

procedure TCustomMSDataSet.BreakExec;
begin
  Assert(FICommand <> nil);
  if FICommand.Executing then
    FICommand.BreakExec;
  FIRecordSet.BreakFetch;
end;

procedure TCustomMSDataSet.RefreshQuick(const CheckDeleted: boolean);
begin
  InternalRefreshQuick(CheckDeleted);
end;

procedure TCustomMSDataSet.CheckInactive;
begin
  inherited;
end;

function TCustomMSDataSet.GetUpdateObject: TMSUpdateSQL;
begin
  Result := TMSUpdateSQL(inherited UpdateObject);
end;

procedure TCustomMSDataSet.SetUpdateObject(Value: TMSUpdateSQL);
begin
  inherited UpdateObject := Value;
end;

{ TMSTable }

function TCustomMSTable.PSGetTableName: string;
begin
  Result := TableName;
end;

procedure TCustomMSTable.PSSetParams(AParams: DB.TParams);
var
  St: string;
  i: integer;
begin
  if (Params.Count <> AParams.Count) then begin
    SQL.Text := '';
    St := '';
    
    for i := 0 to AParams.count - 1 do begin
      if St <> '' then
        St := St + ' AND ';
      St := AParams[i].Name + ' = :' + AParams[i].Name;
    end;

    PrepareSQL;

    if St <> '' then
      AddWhere(St);
  end;

  inherited;
end;

{$IFDEF VER5P}

procedure TCustomMSTable.PSSetCommandText(const CommandText: string);
begin
  if CommandText <> '' then
    TableName := CommandText;
end;

{$ENDIF}

procedure TCustomMSTable.SetTableName(const Value: string);
begin
  if not (csReading in ComponentState) then
    Active := False;
  FTableName := UnbracketIfPossible(Trim(Value));

  SQL.Clear;
end;

procedure TCustomMSTable.SetOrderFields(Value: string);
var
  OldActive: boolean;
begin
  Value := Trim(Value);
  if Value <> FOrderFields then begin
    FOrderFields := Value;
    OldActive := Active;
    if not (csLoading in ComponentState) then
      SQL.Text := '';

    if OldActive then
      Open;
  end;
end;

procedure TCustomMSTable.PrepareSQL;
var
  St: string;
  MasterPos: integer;
  MasterName: string;
  Param: TDAParam;
begin
  //WAR TCustomMSStoredProc.PrepareSQL and TCustomMSTable.PrepareSQL is based on different principies and work in different ways
  if TableName = '' then
    DatabaseError(STableNameNotDefined);

  if SQL.Count = 0 then begin
    St := 'SELECT * FROM ' + BracketIfNeed(TableName);

    if OrderFields <> '' then
      St := St + ' ORDER BY ' + OrderFields;

    SQL.Text := St;
  end;

  // CR 8883
  // for TMSQuery second MD-way is more useful
  if (DataSource <> nil) and (FMasterFields <> '') and (FDetailFields <> '') and not DataSource.DataSet.Active// see TCustomDADataSet.GetFinalSQL
  then begin
    MasterPos := 1;
    while True do begin
      MasterName := ExtractFieldName(FMasterFields, MasterPos);
      if MasterName <> '' then begin
        Param := Params.FindParam(MasterName);
        if Param <> nil then
          Param.DataType := ftString;
      end
      else
        break;
    end;
  end;
end;

procedure TCustomMSTable.Prepare;
begin
  PrepareSQL;

  inherited;
end;

procedure TCustomMSTable.OpenCursor(InfoQuery: boolean);
begin
  PrepareSQL;

  inherited;
end;

procedure TCustomMSTable.Execute;
begin
  PrepareSQL;

  inherited;
end;

procedure TCustomMSTable.AssignTo(Dest: TPersistent);
begin
  inherited;

  if Dest is TCustomMSTable then begin
    TCustomMSTable(Dest).OrderFields := OrderFields;
    TCustomMSTable(Dest).TableName := TableName;
    TCustomMSTable(Dest).MasterSource := MasterSource;
    TCustomMSTable(Dest).MasterFields := MasterFields;
    TCustomMSTable(Dest).DetailFields := DetailFields;
  end;
end;

{ TCustomMSStoredProc }

{$IFDEF VER5P}

procedure TCustomMSStoredProc.PSSetCommandText(const CommandText: string);
begin
  if CommandText <> '' then
    StoredProcName := CommandText;
end;

{$ENDIF}

procedure TCustomMSStoredProc.SetIRecordSet(Value: TData);
begin
  inherited;

  if FICommand <> nil then
    FICommand.SetProp(prIsSProc, True);
end;

procedure TCustomMSStoredProc.SetStoredProcName(const Value: string);
begin
  if Value <> FStoredProcName then begin
    SQL.Text := '';

    FStoredProcName := Trim(Value);

    if (Connection <> nil) and Connection.Connected and (FStoredProcName <> '') then
      PrepareSQL;

    if FICommand <> nil then
      FICommand.SetProp(prIsSProc, True);
  end;
end;

procedure TCustomMSStoredProc.PrepareSQL;
begin
  //WAR TCustomMSStoredProc.PrepareSQL and TCustomMSTable.PrepareSQL is based on different principies and work in different ways
  
  if SQL.Text = '' then begin
    if StoredProcName = '' then
      DatabaseError(SStoredProcNotDefined);

    InternalCreateProcCall(StoredProcName, Params.Count = 0);
  end;
end;

procedure TCustomMSStoredProc.Prepare;
begin
  PrepareSQL;

  FIsInPrepare := True;
  try
    inherited;
  finally
    FIsInPrepare := False;
  end;
end;

procedure TCustomMSStoredProc.BeforeExecute;
begin
  if not Prepared then
    PrepareSQL;

  inherited;
end;

procedure TCustomMSStoredProc.BeforeOpenCursor(InfoQuery: boolean);
begin
  PrepareSQL;

  inherited;
end;

procedure TCustomMSStoredProc.CreateFieldDefs;
begin
  if not FIsInPrepare then
    inherited;
end;

procedure TCustomMSStoredProc.ExecProc;
begin
  Execute;
end;

procedure TCustomMSStoredProc.AssignTo(Dest:TPersistent);
var
  I: Integer;
  P: TMSParam;
begin
  inherited;
                     
  if Dest is TCustomMSStoredProc then begin
    TCustomMSStoredProc(Dest).StoredProcName := FStoredProcName;

    for I := 0 to Params.Count - 1 do begin
      P := TCustomMSStoredProc(Dest).FindParam(Params[I].Name);
      if (P <> nil) and (P.DataType = Params[I].DataType) then begin
        P.Assign(Params[I]);
      end;
    end;
  end;
end;

{ TMSMetadata }

constructor TMSMetadata.Create(Owner: TComponent); 
begin
  inherited;

  Debug := False;
  
  ReadOnly := True;
end;


procedure TMSMetadata.SetDatabaseName(Value: string);    
begin
  Active := False;
  FDatabaseName := Value;
end;

procedure TMSMetadata.SetSchemaName(Value: string);    
begin
  Active := False;
  FSchemaName := Value;
end;

procedure TMSMetadata.SetObjectType(Value: TMSObjectType);    
begin
  Active := False;
  FieldDefs.Updated := False;
  FObjectType := Value;
end;

procedure TMSMetadata.SetTableName(Value: string);    
begin
  Active := False;
  FTableName := Value;
end;

procedure TMSMetadata.SetStoredProcName(Value: string);    
begin
  Active := False;
  FStoredProcName := Value;
end;

procedure TMSMetadata.SetColumnName(Value: string);    
begin
  Active := False;
  FColumnName := Value;
end;

procedure TMSMetadata.SetIndexName(Value: string);    
begin
  Active := False;
  FIndexName := Value;
end;

procedure TMSMetadata.SetConstraintName(Value: string);    
begin
  Active := False;
  FConstraintName := Value;
end;

procedure TMSMetadata.SetLinkedServer(Value: string);
begin
  Active := False;
  FLinkedServer := Value;
end;

procedure TMSMetadata.SetAssemblyName(Value: string);
begin
  Active := False;
  FAssemblyName := Value;
end;

procedure TMSMetadata.SetAssemblyID(Value: integer);
begin
  Active := False;
  FAssemblyID := Value;
end;

procedure TMSMetadata.SetReferencedAssemblyID(Value: integer);
begin
  Active := False;
  FReferencedAssemblyID := Value;
end;

procedure TMSMetadata.SetUDTName(Value: string);
begin
  Active := False;
  FUDTName := Value;
end;

procedure TMSMetadata.SetSchemaCollectionName(Value: string);
begin
  Active := False;
  FSchemaCollectionName := Value;
end;

procedure TMSMetadata.SetTargetNamespaceURI(Value: string);
begin
  Active := False;
  FTargetNamespaceURI := Value;
end;

function TMSMetadata.RequestIRowset: IRowset;
  function GetTableType: string;
  begin
    case ObjectType of
      otAliases, otAliasesInfo: 
        Result := 'ALIAS';
      otTables, otTablesInfo: 
        Result := 'TABLE';
      otSynonyms, otSynonymsInfo: 
        Result := 'SYNONYM';
      otSystemTables, otSystemTablesInfo: 
        Result := 'SYSTEM TABLE';
      otViews, otViewsInfo: 
        Result := 'VIEW';
      otGlobalTempTables, otGlobalTempTablesInfo:
        Result := 'GLOBAL TEMPORARY';
      otLocalTempTables, otLocalTempTablesInfo: 
        Result := 'LOCAL TEMPORARY';
      otSystemViews, otSystemViewsInfo:
        Result := 'SYSTEM VIEW';
      otExternalTablesInfo:
        Result := 'EXTERNAL TABLE';
    end;
  end;

var
  Schema: TGUID;
  rgRestrictions: TRestrictions;
begin
  BeginConnection;
  try
    case ObjectType of
      otDatabases:
      begin
        SetLength(rgRestrictions, 1);
        Schema := DBSCHEMA_CATALOGS;
        rgRestrictions[0] := DatabaseName;
      end;
      otColumnPrivileges:
      begin
        SetLength(rgRestrictions, 6);
        Schema := DBSCHEMA_COLUMN_PRIVILEGES;
        rgRestrictions[0] := DatabaseName;
        rgRestrictions[1] := SchemaName;
        rgRestrictions[2] := TableName;
        rgRestrictions[4 - 1] := ColumnName;
      end;
      otColumns:
      begin
        SetLength(rgRestrictions, 4);
        Schema := DBSCHEMA_COLUMNS;
        if Connection.Options.Provider <> prCompact then begin
          rgRestrictions[0] := DatabaseName;
          rgRestrictions[1] := SchemaName;
        end;
        rgRestrictions[2] := TableName;
        rgRestrictions[4 - 1] := ColumnName;
      end;
      otForeignKeys:
      begin
        SetLength(rgRestrictions, 6);
        rgRestrictions[3] := DatabaseName;
        rgRestrictions[4] := SchemaName;
        rgRestrictions[5] := TableName;
        Schema := DBSCHEMA_FOREIGN_KEYS;
      end;
      otPrimaryKeys:
      begin
        if Connection.Options.Provider <> prCompact then begin
          SetLength(rgRestrictions, 3);
          rgRestrictions[0] := DatabaseName;
          rgRestrictions[1] := SchemaName;
          rgRestrictions[2] := TableName;
          Schema := DBSCHEMA_PRIMARY_KEYS;
        end
        else begin
          SetLength(rgRestrictions, 7);
          rgRestrictions[2] := ConstraintName;
          rgRestrictions[5] := TableName;
          // Other Restriction columns not supported
          Schema := DBSCHEMA_KEY_COLUMN_USAGE;
        end;
      end;
      otIndexes:
      begin
        SetLength(rgRestrictions, 5);
        if Connection.Options.Provider <> prCompact then begin
          rgRestrictions[0] := DatabaseName;
          rgRestrictions[1] := SchemaName;
        end;
        rgRestrictions[2] := IndexName;
        rgRestrictions[4] := TableName;
        Schema := DBSCHEMA_INDEXES;
      end;
      otServerTypes:
      begin
        SetLength(rgRestrictions, 0);
        Schema := DBSCHEMA_PROVIDER_TYPES;
      end;
      otSchemata:
      begin
        SetLength(rgRestrictions, 2);
        Schema := DBSCHEMA_SCHEMATA;
        rgRestrictions[0] := DatabaseName;
        rgRestrictions[1] := SchemaName;
      end;
      otStatistics:
      begin
        SetLength(rgRestrictions, 3);
        Schema := DBSCHEMA_STATISTICS;
        rgRestrictions[0] := DatabaseName;
        rgRestrictions[1] := SchemaName;
        rgRestrictions[2] := TableName;
      end;
      otStoredProcs:
      begin
        SetLength(rgRestrictions, 3);
        Schema := DBSCHEMA_PROCEDURES;
        rgRestrictions[0] := DatabaseName;
        rgRestrictions[1] := SchemaName;
        rgRestrictions[2] := StoredProcName;
      end;
      otStoredProcParams:
      begin
        SetLength(rgRestrictions, 3);
        Schema := DBSCHEMA_PROCEDURE_PARAMETERS;
        rgRestrictions[0] := DatabaseName;
        rgRestrictions[1] := SchemaName;
        rgRestrictions[2] := StoredProcName;
      end;
      otAliases, otTables, otSynonyms, otSystemTables, otViews, otGlobalTempTables, otLocalTempTables, otSystemViews,
      otAliasesInfo, otTablesInfo, otSynonymsInfo, otSystemTablesInfo, otViewsInfo, otGlobalTempTablesInfo, otLocalTempTablesInfo, otExternalTablesInfo, otSystemViewsInfo:
      begin
        SetLength(rgRestrictions, 4);

        if ObjectType in [otAliases, otTables, otSynonyms, otSystemTables, otViews, otGlobalTempTables, otLocalTempTables, otSystemViews] then
          Schema := DBSCHEMA_TABLES
        else
          Schema := DBSCHEMA_TABLES_INFO;
        if Connection.Options.Provider <> prCompact then begin
          rgRestrictions[0] := DatabaseName;
          rgRestrictions[1] := SchemaName;
        end;
        rgRestrictions[2] := TableName;
        rgRestrictions[3] := GetTableType;
      end;
      otTableConstraints:
      begin
        SetLength(rgRestrictions, 6);
        Schema := DBSCHEMA_TABLE_CONSTRAINTS;
        if Connection.Options.Provider <> prCompact then begin
          rgRestrictions[0] := DatabaseName;
          rgRestrictions[1] := SchemaName;
        end;
        rgRestrictions[2] := ConstraintName;
        rgRestrictions[5] := TableName;
      end;
      otTablePrivileges:
      begin
        SetLength(rgRestrictions, 3);
        Schema := DBSCHEMA_TABLE_PRIVILEGES;
        rgRestrictions[0] := DatabaseName;
        rgRestrictions[1] := SchemaName;
        rgRestrictions[2] := TableName;
      end;
      otLinkedServers: begin
        SetLength(rgRestrictions, CRESTRICTIONS_DBSCHEMA_LINKEDSERVERS{1});
        Schema := DBSCHEMA_LINKEDSERVERS;
        rgRestrictions[0] := LinkedServer;
      end;
      otAssemblies: begin
        SetLength(rgRestrictions, CRESTRICTIONS_DBSCHEMA_SQL_ASSEMBLIES{4});
        Schema := DBSCHEMA_SQL_ASSEMBLIES;
        rgRestrictions[0] := DatabaseName;
        rgRestrictions[1] := SchemaName;
        rgRestrictions[2] := AssemblyName;
        if AssemblyID <> 0 then
          rgRestrictions[3] := AssemblyID;
      end;
      otAssemblyDependencies: begin
        SetLength(rgRestrictions, CRESTRICTIONS_DBSCHEMA_SQL_ASSEMBLY_DEPENDENCIES{4});
        Schema := DBSCHEMA_SQL_ASSEMBLY_DEPENDENCIES;
        rgRestrictions[0] := DatabaseName;
        rgRestrictions[1] := SchemaName;
        if AssemblyID <> 0 then
          rgRestrictions[2] := AssemblyID;
        if ReferencedAssemblyID <> 0 then
          rgRestrictions[3] := ReferencedAssemblyID;
      end;
      otUserTypes: begin
        SetLength(rgRestrictions, CRESTRICTIONS_DBSCHEMA_SQL_USER_TYPES{3});
        Schema := DBSCHEMA_SQL_USER_TYPES;
        rgRestrictions[0] := DatabaseName;
        rgRestrictions[1] := SchemaName;
        rgRestrictions[2] := UDTName;
      end;
      otXMLCollections: begin
        SetLength(rgRestrictions, CRESTRICTIONS_DBSCHEMA_XML_COLLECTIONS{4});
        Schema := DBSCHEMA_XML_COLLECTIONS;
        rgRestrictions[0] := DatabaseName;
        rgRestrictions[1] := SchemaName;
        rgRestrictions[2] := SchemaCollectionName;
        rgRestrictions[3] := TargetNamespaceURI;
      end;
    end;

    Result := FIRecordSet.GetSchemaRowset(Schema, rgRestrictions);
  finally
    EndConnection;
  end;
end;

procedure TMSMetadata.InternalExecute;
var
  Rowset: IRowset;
begin
  Rowset := RequestIRowset;
  FIRecordSet.SetIRowset(Rowset, False);
  inherited;
end;

procedure TMSMetadata.OpenCursor(InfoQuery: boolean);
var
  Rowset: IRowset;
begin
  Rowset := RequestIRowset;
  FIRecordSet.SetIRowset(Rowset, False);
  inherited;
end;

{ TMSSQL }

constructor TMSSQL.Create(Owner: TComponent);
begin
  inherited;

  FAutoCommit := True;
  FCommandTimeout := 0;
  Macros.SetParserClass(TMSParser);
end;

function TMSSQL.GetPermitPrepare: boolean;
begin
  Result := False;
end;

procedure TMSSQL.SetPermitPrepare(Value: boolean);
begin
end;

procedure TMSSQL.CreateICommand;
begin
  inherited;

  if FICommand = nil then
    SetICommand(TOLEDBCommand.Create);
end;

procedure TMSSQL.SetICommand(Value: TCRCommand);
begin
  FICommand := TOLEDBCommand(Value);

  if FICommand <> nil then begin
    FICommand.SetProp(prCommandTimeout, CommandTimeout);
    FICommand.ReadParams := ReadParams;
  end;

  inherited;
end;

procedure TMSSQL.InternalPrepare; 
begin
  if SQL.Count = 0 then
    DatabaseError(SEmptySQLStatement, Self);
    
  WriteParams;

  inherited;
end;

procedure TMSSQL.InternalExecute(Iters: integer); 
begin
  inherited;
  FICommand.SetCursorState(csInactive); // To prevent blocking execute on second exec
end;

function TMSSQL.GetConnection: TMSConnection;
begin
  Result := TMSConnection(inherited Connection);
end;

procedure TMSSQL.SetConnection(Value: TMSConnection);
begin
  inherited Connection := Value;
end;

function TMSSQL.GetParams: TMSParams;
begin
  Result := TMSParams(inherited Params);
end;

procedure TMSSQL.SetParams(Value: TMSParams);
begin
  inherited Params := Value;
end;

procedure TMSSQL.AssignTo(Dest: TPersistent); 
begin
  inherited;

  if Dest is TMSSQL then begin
    TMSSQL(Dest).Params.Assign(Params);
    TMSSQL(Dest).NonBlocking := NonBlocking;
    TMSSQL(Dest).AfterExecute := AfterExecute;
  end;
end;

function TMSSQL.ParseSQL(const SQL: string; Params: TDAParams; RenamePrefix: string = ''): string;
begin
{$IFDEF CLR}
  if SQL.IndexOf(Char(':')) = -1 then
{$ELSE}
  if StrScan(PChar(SQL), ':') = nil then
{$ENDIF}
    Result := SQL // query without parameters
  else
    Result := inherited ParseSQL(SQL, Params, RenamePrefix);
end;

function TMSSQL.CreateParser(const Text: string): TParser;
begin
  Result := TMSParser.Create(Text);
end;

procedure TMSSQL.AssembleSQL;
begin
  if ParamCheck or (csDesigning in ComponentState) then
    inherited
  else begin
    FNativeSQL := SQL.Text;
    FNativeSQL := ParseSQL(nil);
    FICommand.SetSQL(FNativeSQL);
  end;
end;

function TMSSQL.CreateParamsObject: TDAParams;
begin
  Result := TMSParams.Create(Self);
end;

procedure TMSSQL.CreateParams;
var
  ParamDesc: TOLEDBParamDesc;
  i: integer;
begin
  Params.BeginUpdate;
  try
    Params.Clear;
    for i := 0 to FICommand.GetParamCount - 1 do begin
      ParamDesc := FICommand.GetParam(i);
      with Params.Add as TDAParam do begin
        Name := ParamDesc.GetName;
        DataType := GetFieldType(ParamDesc.GetDataType);
        ParamType := TParamType(ParamDesc.GetParamType);
      end;
    end;
  finally
    Params.EndUpdate;
  end;
end;

procedure TMSSQL.WriteParams(WriteValue: boolean = True);
var
  Param: TMSParam;
  ParamDesc: TOLEDBParamDesc;
  dt: word;

  procedure WriteParamValue;
  var
    Value: Variant;
  {$IFDEF CLR}
    Value1, Value2: TBytes;
  {$ELSE}
    Value1: Variant;
  {$ENDIF}
    i, l: integer;
    s: string;
    CurrentConnection: TMSConnection;
  begin
    if not Param.Bound then
      TOLEDBParamDesc(ParamDesc).SetUseDefaultValue(True);
    
    if Param.IsObjectDataType then begin
      ParamDesc.SetNull(Param.IsNull);
      ParamDesc.SetObject(Param.ParamObject);
      Exit;
    end;

    Value := Param.Value;
    if (Param.DataType = ftDate) and not (VarIsEmpty(Value) or VarIsNull(Value)) then
      Value := Int(Value); // drop time info

    // SQL Server Everywhere
    CurrentConnection := Connection;
    if (CurrentConnection = nil) and (FDataSet <> nil) then
      CurrentConnection := TMSConnection(FDataSet.Connection);
      
    Assert(CurrentConnection <> nil);

    if (CurrentConnection.Options.Provider = prCompact) and (Param.OLEDBType = DBTYPE_UI1) then
      ParamDesc.SetDataType(dtInt8);

    // Convert param values if need
    if (dt in [dtBytes, dtVarBytes, dtBlob])
      and (VarType(Value) <> varArray + varByte) then
      case VarType(Value) of
        varEmpty, varNull:;
        varShortInt {1 byte},
        varSmallint {2 bytes},
        varInteger {4 bytes},
        varInt64 {8 bytes},
        varByte {1 byte},
        varWord {2 bytes},
        varLongWord {4 bytes}: begin
          case VarType(Value) of
            varShortInt, varByte:
              l := 1;
            varSmallint, varWord:
              l := 2;
            varInteger, varLongWord:
              l := 4;
            varInt64:
              l := 8;
            else
            begin
              Assert(False);
              l := - 1;
            end;
          end;

          // reverse bytes order
        {$IFDEF CLR}
          Value1 := BitConverter.GetBytes(Int64(Value));
          //Assert(l = Length(Value1));
          SetLength(Value2, l);
          for i := 0 to l - 1 do
            Value2[i] := Value1[l - 1 - i];
          Value := Value2;
        {$ELSE}
          Value1 := VarArrayCreate([0, l - 1], varByte);

          for i := 0 to l - 1 do
            PChar(TVarData(Value1).VArray.Data)[i] := PChar(@TVarData(Value).VInteger)[l - 1 - i];
          Value := Unassigned;
          Value := Value1;
        {$ENDIF}
        end;
        varString{$IFDEF CLR}, varChar{$ENDIF}: begin
          s := Value;
          Value := Encoding.Default.GetBytes(s);
        end;
      end;
    ParamDesc.SetValue(Unassigned);
    ParamDesc.SetValue(Value);
  end;

var
  ft: TFieldType;
  i, l: integer;
begin
  for i := 0 to Params.Count - 1 do begin
    Param := Params[i] as TMSParam;
    if i < FICommand.GetParamCount then
      ParamDesc := TOLEDBParamDesc(FICommand.GetParam(i))
    else
      ParamDesc := TOLEDBParamDesc(FICommand.AddParam);
    ParamDesc.SetName(Param.Name);

    ft := Param.DataType;
    dt := GetDataType(ft);
    if dt = dtUnknown then
      case ft of
        {$IFDEF VER5P}
        ftGuid:
          dt := dtGuid;
        {$ENDIF}
        ftUnknown:
          dt := dtUnknown;
        ftBCD:
          dt := dtBCD;
        ftWideString:
          dt := dtWideString;
      else
        dt := dtString;
  //        Assert(False, Format('Invalid Param.DataType - %d', [Integer(ft)]));
      end;

    Assert(Param is TMSParam, 'Param must be TMSParam');
    l := TMSParam(Param).Size;
    ParamDesc.SetSize(l);

    ParamDesc.SetDataType(dt);
    ParamDesc.SetParamType(TParamDirection(Param.ParamType));
    ParamDesc.SetOLEDBType(Param.OLEDBType);

    if WriteValue then 
      WriteParamValue;
  end;
  while Params.Count < FICommand.GetParamCount do
    FICommand.DeleteParam(FICommand.GetParamCount - 1);
end;

procedure TMSSQL.ReadParams;
var
  v: Variant;
begin
  if FICommand.IUnknownIsNull and FICommand.IMultipleResultsIsNull then begin
    FICommand.GetProp(prCanReadParams, v);
    if Boolean(v) then begin
      inherited;
      FICommand.SetProp(prCanReadParams, False);
    end;
  end;
end;

function TMSSQL.FindParam(const Value: string): TMSParam;
begin
  Result := inherited FindParam(GetParamNameWODog(Value)) as TMSParam;
end;

function TMSSQL.ParamByName(const Value: string): TMSParam;
begin
  Result := inherited ParamByName(GetParamNameWODog(Value)) as TMSParam;
end;

procedure TMSSQL.SetCommandTimeout(const Value: integer);
begin
  if FCommandTimeout <> Value then begin
    FCommandTimeout := Value;
    if FICommand <> nil then
      FICommand.SetProp(prCommandTimeout, FCommandTimeout);
  end;
end;

procedure TMSSQL.SetNonBlocking(const Value: boolean);
begin
  if FNonBlocking <> Value then begin
    FNonBlocking := Value;
    if FICommand <> nil then
      FICommand.SetProp(prNonBlocking, FNonBlocking);
  end;
end;

procedure TMSSQL.Execute(Iters: integer);
begin
  if NonBlocking and Executing then
    DatabaseError(SAsynchExecuting);

  inherited Execute(Iters);
end;

procedure TMSSQL.BreakExec;
begin
  Assert(FICommand <> nil);
  FICommand.BreakExec;
end;

procedure TMSSQL.CreateProcCall(Name: string);
var
  NeedDescribe: boolean;
  ParamDescs: TParamDescs;
  ParamDesc: CRAccess.TParamDesc;
  
  Param: TMSParam;
  ParamType: TParamType;
  IsNewParam: boolean;
  ft: TFieldType;
  i: integer;

  ProcCallSQL: string;
begin
  BeginConnection;
  try
    NeedDescribe := Params.Count = 0;
    if NeedDescribe then begin
      ProcCallSQL := FICommand.CreateProcCall(Name, True, True, False, False);
      CreateParams;
    end
    else begin
      WriteParams(False);
      ProcCallSQL := FICommand.CreateProcCall(Name, False, True, False, False);
    end;
      
    if NeedDescribe and (Params <> nil) then begin
      ParamDescs := TOLEDBCommand(FICommand).Params;
      for i := 0 to ParamDescs.Count - 1 do begin
        ParamDesc := ParamDescs[i];
        ParamType := ConvertCRParamTypeToBDE(ParamDesc.GetParamType);

        Param := Params.FindParam(ParamDesc.GetName);
        IsNewParam := Param = nil;
        if IsNewParam then
          Param := TMSParam.Create(Params, ParamType);

        Param.ParamType := ParamType;
        ft := GetFieldType(ParamDesc.GetDataType);
        if ft <> Param.DataType then
          Param.DataType := ft; // To prevent clearing Param.Value on set DataType
        Param.Name := ParamDesc.GetName;
        if IsNewParam then
          Param.Value := ParamDesc.GetValue;
        Param.Size := ParamDesc.GetSize;
      end;
      
      FICommand.SetProp(prDisableParamScan, True);
      try
        SQL.Text := ProcCallSQL;
      finally
        FICommand.SetProp(prDisableParamScan, False);
      end;
    end;
  finally
    EndConnection;
  end;
end;

{ TMSXMLField }

constructor TMSXMLField.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  SetDataType(TFieldType(ftMSXML));
end;

procedure TMSXMLField.GetText(var Text: string; DisplayText: Boolean);
begin
  Text := '(xml)';
  if not GetIsNull then
    Text := AnsiUpperCase(Text);
end;

procedure TMSXMLField.SetSchemaCollection(Name, CatalogName, SchemaName: string);
begin
  FSchemaCollection.Name := Name;
  FSchemaCollection.CatalogName := CatalogName;
  FSchemaCollection.SchemaName := SchemaName;
  FTyped := (FSchemaCollection.Name <> '') or (FSchemaCollection.CatalogName <> '') or
    (FSchemaCollection.SchemaName <> '');
end;

function TMSXMLField.GetBlobSize: Integer;
begin
  with DataSet.CreateBlobStream(Self, bmRead) do
    try
      Result := Size;
    finally
      Free;
    end;
end;

procedure TMSXMLField.Clear;
begin
  DataSet.CreateBlobStream(Self, bmWrite).Free;
end;

class function TMSXMLField.IsBlob: Boolean;
begin
  Result := True;
end;

procedure TMSXMLField.LoadFromFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TMSXMLField.LoadFromStream(Stream: TStream);
begin
  with DataSet.CreateBlobStream(Self, bmWrite) do
  try
    CopyFrom(Stream, 0);
  finally
    Free;
  end;
end;

procedure TMSXMLField.SaveToFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TMSXMLField.SaveToStream(Stream: TStream);
var
  BlobStream: TStream;
begin
  BlobStream := DataSet.CreateBlobStream(Self, bmRead);
  try
    Stream.CopyFrom(BlobStream, 0);
  finally
    BlobStream.Free;
  end;
end;

procedure TMSXMLField.SetFieldType(Value: TFieldType);
begin
  SetDataType(Value);
end;

{ TMSAccessUtils }

class procedure TMSAccessUtils.GetKeyAndDataFields(
  Obj: TCustomMSDataSet;
  out KeyAndDataFields: TKeyAndDataFields;
  const ForceUseAllKeyFields: boolean);
begin
  Obj.GetKeyAndDataFields(KeyAndDataFields, ForceUseAllKeyFields);
end;

class procedure TMSAccessUtils.SetDesigning(Obj: TCustomMSDataSet; Value: Boolean; SetChildren: Boolean = True);
begin
  Obj.SetDesigning(Value, SetChildren);
end;

class procedure TMSAccessUtils.SetLockLoginPromt(Obj: TMSConnection; Value: Boolean);
begin
  Obj.FLockLoginPrompt := Value;
end;

class function TMSAccessUtils.FIConnection(Obj: TMSConnection): TOLEDBConnection;
begin
  Result := Obj.IConnection;
end;

class function TMSAccessUtils.FIRecordSet(Obj: TCustomMSDataSet): TOLEDBRecordSet;
begin
  Result := Obj.FIRecordSet;
end;

class function TMSAccessUtils.GetOLEDBSQL(Obj: TCustomMSDataSet): string;
begin
  Result := Obj.FICommand.SQL;
end;

class function TMSAccessUtils.GetOLEDBSQL(Obj: TMSSQL): string;
begin
  Result := Obj.FICommand.SQL;
end;

type
  _TOLEDBConnection = class(TOLEDBConnection);

class function TMSAccessUtils.FIDBCreateSession(Obj: TOLEDBConnection): IDBCreateSession;
begin
  Result := _TOLEDBConnection(Obj).FIDBCreateSession;
end;

class procedure TMSAccessUtils.DoError(Obj: TMSConnection; E: Exception; var Fail: boolean);
begin
  Assert(Obj.IConnection <> nil);
  _TOLEDBConnection(Obj.IConnection).DoError(E, Fail);
end;

initialization
  __UseUpdateOptimization := True;

  try
    TMSConnectionPoolManager.Clear;
  except
  end;

  if
  {$IFDEF CLR}
    CompareText(Assembly.GetCallingAssembly.GetName.Name, 'CoreLab.Sdac') = 0
  {$ELSE}
    not IsLibrary
  {$ENDIF}
  then
    Classes.RegisterClass(TMSXMLField);

finalization
    
end.
