{ *********************************************************************** }
{                                                                         }
{ Delphi Visual Component Library                                         }
{                                                                         }
{ Copyright (c) 1999-2004 Borland Software Corporation                    }
{                                                                         }
{ *********************************************************************** }

unit Borland.Vcl.SqlExpr platform;

{$R-,T-,H+,X+}

interface

uses
  Windows, SysUtils, Variants, Classes, Contnrs, DB, DBCommon, DBXpress, SqlTimSt,
  System.Runtime.InteropServices, System.ComponentModel.Design.Serialization;

const

  SSelect         =   'select';               { Do not localize }
  SSelectStar     =   ' select * ';           { Do not localize }
  SSelectStarFrom =   ' select * from ';      { Do not localize }
  SSelectSpaces   =   ' select ';             { Do not localize }
  SWhere          =   ' where ';              { Do not localize }
  SAnd            =   ' and ';                { Do not localize }
  SOrderBy        =   ' order by ';           { Do not localize }
  SParam          =   '?';                    { Do not localize }
  DefaultCursor   =   0;
  HourGlassCursor =   -11;

{ Default Max BlobSize }

  DefaultMaxBlobSize = -1;   // values are in K; -1 means retrieve actual size

{ Default RowsetSize }

  DefaultRowsetSize = 20;

  TErrorMessageSize = 2048;

{ FieldType Mappings }

  FldTypeMap: TFieldMap = (
    fldUNKNOWN, fldZSTRING, fldINT16, fldINT32, fldUINT16, fldBOOL,
    fldFLOAT, fldFLOAT, fldBCD, fldDATE, fldTIME, fldTIMESTAMP, fldBYTES,
    fldVARBYTES, fldINT32, fldBLOB, fldBLOB, fldBLOB, fldBLOB, fldBLOB,
    fldBLOB, fldBLOB, fldCURSOR, fldZSTRING, fldZSTRING, fldINT64, fldADT,
    fldArray, fldREF, fldTABLE, fldBLOB, fldBLOB, fldUNKNOWN, fldUNKNOWN,
    fldUNKNOWN, fldZSTRING, fldDATETIME, fldFMTBCD);

  FldSubTypeMap: array[TFieldType] of Word = (
    0, 0, 0, 0, 0, 0, 0, fldstMONEY, 0, 0, 0, 0, 0, 0, fldstAUTOINC,
    fldstBINARY, fldstMEMO, fldstGRAPHIC, fldstFMTMEMO, fldstOLEOBJ,
    fldstDBSOLEOBJ, fldstTYPEDBINARY, 0, fldstFIXED, fldstUNICODE,
    0, 0, 0, 0, 0, fldstHBINARY, fldstHMEMO, 0, 0, 0, 0, 0, 0);

  DataTypeMap: array[0..MAXLOGFLDTYPES - 1] of TFieldType = (
    ftUnknown, ftString, ftDate, ftBlob, ftBoolean, ftSmallint,
    ftInteger, ftFloat, ftBCD, ftBytes, ftTime, ftDateTime,
    ftWord, ftInteger, ftUnknown, ftVarBytes, ftUnknown, ftCursor,
    ftLargeInt, ftLargeInt, ftADT, ftArray, ftReference, ftDataSet,
    ftTimeStamp, ftFMTBCD);

  BlobTypeMap: array[fldstMEMO..fldstBFILE] of TFieldType = (
    ftMemo, ftBlob, ftFmtMemo, ftParadoxOle, ftGraphic, ftDBaseOle,
    ftTypedBinary, ftBlob, ftBlob, ftBlob, ftBlob, ftOraClob, ftOraBlob,
    ftBlob, ftBlob);

type

{ Forward declarations }

  TSQLConnection = class;
  TCustomSQLDataSet = class;
  TSQLDataSet = class;
  TSQLQuery = class;
  TSQLStoredProc = class;
  TSQLTable = class;

  TLocaleCode = Integer;

  TSQLExceptionType = (exceptConnection, exceptCommand, exceptCursor, exceptMetaData, exceptUseLast);

  TSQLTraceFlag = (traceQPREPARE, traceQEXECUTE, traceERROR,
    traceSTMT, traceCONNECT, traceTRANSACT, traceBLOB, traceMISC, traceVENDOR,
    traceDATAIN, traceDATAOUT);

  TSQLTraceFlags = set of TSQLTraceFlag;

  SPParamDesc = class           	{ Stored Proc Descriptor }
    iParamNum       : Word;             { Field number (1..n) }
    szName          : string;           { Field name }
    iArgType        : TParamType;       { Field type }
    iDataType       : TFieldType;       { Field type }
    iUnits1         : SmallInt;         { Number of Chars, digits etc }
    iUnits2         : SmallInt;         { Decimal places etc. }
    iLen            : LongWord;         { Length in bytes  }
  end;

{ TSQLBlobStream }

  TSQLBlobStream = class(TMemoryStream)
  private
    FDataSet: TCustomSQLDataSet;
    FField: TBlobField;
    FFieldNo: Integer;
  public
    constructor Create(Field: TBlobField; Mode: TBlobStreamMode = bmRead);
    destructor Destroy; override;
    procedure ReadBlobData;
  end;

  TConnectionUserType = (eUserMonitor, eUserDataSet);

{ TSQLMonitor }

  SQLTRACEDesc = packed record             { trace callback info }
    [MarshalAs(UnmanagedType.ByValTStr, SizeConst = 1024)]
    pszTrace        : string;
    eTraceCat       : TRACECat;
    ClientData      : Integer;
    uTotalMsgLen    : Word;
  end;

  TTraceEvent = procedure(Sender: TObject; var CBInfo: SQLTraceDesc; var LogTrace: Boolean) of object;
  TTraceLogEvent = procedure(Sender: TObject; var CBInfo: SQLTraceDesc) of object;

  [RootDesignerSerializerAttribute('', '', False)]
  TSQLMonitor = class(TComponent)
  private
    FActive: Boolean;
    FAutoSave: Boolean;
    FFileName: string;
    FKeepConnection: Boolean;
    FMaxTraceCount: Integer;
    FOnTrace: TTraceEvent;
    FOnLogTrace: TTraceLogEvent;
    FSQLConnection: TSQLConnection;
    FStreamedActive: Boolean;
    FTraceFlags: TSQLTraceFlags;
    FTraceList: TStrings;
    FSQLCallBack: TSQLCallbackEvent;
    procedure CheckInactive;
    function GetTraceCount: Integer;
  protected
    function InvokeCallBack(CallType: TRACECat; CBInfo: IntPtr): CBRType;
    procedure SetActive(Value: Boolean);
    procedure SetSQLConnection(Value: TSQLConnection);
    procedure SetStreamedActive;
    procedure SetTraceList(Value: TStrings);
    procedure SetFileName(const Value: String);
    procedure SwitchConnection(const Value: TSQLConnection);
    procedure Trace(var Desc: SQLTraceDesc; LogTrace: Boolean); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadFromFile(AFileName: string);
    procedure SaveToFile(AFileName: string);
    property MaxTraceCount: Integer read FMaxTraceCount write FMaxTraceCount;
    property TraceCount: Integer read GetTraceCount;
  published
    property Active: Boolean read FActive write SetActive default False;
    property AutoSave: Boolean read FAutoSave write FAutoSave default False;
    property FileName: string read FFileName write SetFileName;
    property OnLogTrace: TTraceLogEvent read FOnLogTrace write FOnLogTrace;
    property OnTrace: TTraceEvent read FOnTrace write FOnTrace;
{   property TraceFlags not supported in DBExpress 1.0 }
    property TraceList: TStrings read FTraceList write SetTraceList stored False;
    property SQLConnection: TSQLConnection read FSQLConnection write SetSQLConnection;
  end;

{ TSQLConnection }

  TLocale = IntPtr;

  EConnectFlag = (eConnect, eReconnect, eDisconnect);

  TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns,
    stProcedureParams, stIndexes, stPackages);

  TConnectionState = (csStateClosed, csStateOpen, csStateConnecting,
    csStateExecuting, csStateFetching, csStateDisconnecting);

  TTableScope = (tsSynonym, tsSysTable, tsTable, tsView);

  TTableScopes = set of TTableScope;

  TLoginEvent = procedure(Sender: TObject; Username, Password: string) of object;

  TSQLConnectionLoginEvent = procedure(Database: TSQLConnection;
    LoginParams: TStrings) of object;

  TSQLConnection = class(TCustomConnection)
  private
    FActiveStatements: LongWord;
    FAutoClone: Boolean;
    FCloneParent: TSQLConnection;
    FConnectionState: TConnectionState;
    FConnectionName: string;
    FConnectionRegistryFile: string;
    FDriverName: string;
    FDriverRegistryFile: string;
    FGetDriverFunc: string;
    FTransactionCount: Integer;
    FIsCloned: Boolean;
    FISQLConnection: ISQLConnection;
    FKeepConnection: Boolean;
    FLastError: string;  // DBExpress GetError() clears error; need to save last
    FLibraryName: string;
    FLoadParamsOnConnect: Boolean;
    FMonitorUsers: TList;
    FOnLogin: TSQLConnectionLoginEvent;
    FParams: TStrings;
    FParamsLoaded: Boolean;
    FMaxStmtsPerConn: LongWord;
    FQuoteChar: String;
    FRefCount: Integer;
    FSQLDllHandle: THandle;
    FSQLDriver: ISQLDriver;
    FSQLHourGlass: Boolean;
    FSQLMetaData: ISQLMetaData;
    FSupportsMultiTrans: LongBool;
    FTableScope: TTableScopes;
    FTraceCallbackEvent: TSQLCallbackEvent;
    FTraceClientData: Integer;
    FTransactionsSupported: LongBool;
    FVendorLib: string;
    FTransIsoLevel: TTransIsolationLevel;
    procedure CheckActive;
    procedure CheckInactive;
    procedure CheckLoginParams;
    procedure ClearConnectionUsers;
    procedure ClearMonitors;
    procedure FreeSchemaTable(DataSet: TCustomSQLDataSet);
    function GetConnectionForStatement: TSQLConnection;
    function GetConnectionName: string;
    function GetFDriverRegistryFile: string;
    function GetLocaleCode: TLocaleCode;
    function GetInTransaction: Boolean;
    function GetLibraryName: string;
    procedure GetLoginParams(LoginParams: TStrings);
    function GetQuoteChar: string;
    function GetVendorLib: string;
    procedure Login(LoginParams: TStrings);
    function OpenSchemaTable(eKind: TSchemaType; SInfo: string; SQualifier: string = '';SPackage: string = ''): TCustomSQLDataSet;overload;
    function OpenSchemaTable(eKind: TSchemaType; SInfo: string; SQualifier: string = ''; SPackage: string = ''; SSchemaName: string = ''): TCustomSQLDataSet;overload;
    procedure RegisterTraceMonitor(Client: TObject);
    procedure RegisterTraceCallback(Value: Boolean);
    procedure SetBoolParamOption(Key: string; Option:TSQLConnectionOption);
    procedure SetConnectionParams;
    procedure SetConnectionName(Value: string);
    procedure SetDriverName(Value: string);
    procedure SetKeepConnection(Value: Boolean);
    procedure SetParams(Value: TStrings);
    procedure SetCursor(CursorType: Integer);
    procedure SetLocaleCode(Value: TLocaleCode);
//    function SQLTraceCallback(CBInfo: IntPtr): CBRType;
    procedure UnregisterTraceMonitor(Client: TObject);
  protected
    function Check(status: SQLResult): SQLResult;
    procedure CheckConnection(eFlag: eConnectFlag);
    procedure CheckDisconnect; virtual;
    procedure ConnectionOptions; virtual;
    procedure DoConnect; override;
    procedure DoDisconnect; override;
    function GetConnected: Boolean; override;
    function GetDataSet(Index: Integer): TCustomSQLDataSet; reintroduce;
    procedure Loaded; override;
    procedure LoadSQLDll;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure OpenSchema(eKind: TSchemaType; sInfo: string; List: TStrings); overload;
    procedure OpenSchema(eKind: TSchemaType; sInfo, SSchemaName: string; List: TStrings); overload;
    procedure RegisterClient(Client: TObject; Event: TConnectChangeEvent = nil); override;
    procedure SQLError(OpStatus: SQLResult; eType: TSQLExceptionType; const Command: ISQLCommand = nil);
    procedure UnRegisterClient(Client: TObject); override;
    property Connection: ISQLConnection read FISQLConnection;
    property ConnectionRegistryFile: string read FConnectionRegistryFile;
    property Driver: ISQLDriver read FSQLDriver;
    property DriverRegistryFile: string read GetFDriverRegistryFile;
    property LastError: string read FLastError write FLastError;
    property QuoteChar: String read FQuoteChar;
    property SQLDllHandle: THandle read FSQLDllHandle write FSQlDllHandle;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function CloneConnection: TSQLConnection;
    procedure CloseDataSets;
    procedure Commit( TransDesc: TTransactionDesc);
    function Execute(const SQL: string; Params: TParams): Integer; overload;
    function Execute(const SQL: string; Params: TParams;
      var ResultSet: TObject): Integer; overload;
    function ExecuteDirect(const SQL: string): Integer;
    procedure GetFieldNames(const TableName: string; List: TStrings);
    procedure GetIndexNames(const TableName: string; List: TStrings); overload;
    procedure GetIndexNames(const TableName, SchemaName: string; List: TStrings); overload;
    procedure GetProcedureNames(List: TStrings); overload;
    procedure GetProcedureNames(const PackageName: string; List: TStrings); overload;
    procedure GetProcedureNames(const PackageName, SchemaName: string; List: TStrings); overload;
    procedure GetPackageNames(List: TStrings);
    procedure GetProcedureParams(ProcedureName : string; List: TList); overload;
    procedure GetProcedureParams(ProcedureName, PackageName:string; List: TList); overload;
    procedure GetProcedureParams(ProcedureName, PackageName, SchemaName:string; List: TList); overload;
    procedure GetTableNames(List: TStrings; SchemaName:string; SystemTables: Boolean = False); overload;
    procedure GetTableNames(List: TStrings; SystemTables: Boolean = False); overload;
    procedure LoadParamsFromIniFile( FFileName: string = '');
    procedure Rollback( TransDesc: TTransactionDesc);
    procedure SetTraceCallbackEvent(Event: TSQLCallbackEvent; IClientInfo: Integer);
    procedure StartTransaction( TransDesc: TTransactionDesc);
    property ActiveStatements: LongWord read FActiveStatements;
    property AutoClone: Boolean read FAutoClone write FAutoClone default True;
    property ConnectionState: TConnectionState read FConnectionState write FConnectionState;
    property DataSets[Index: Integer]: TCustomSQLDataSet read GetDataSet;
    property InTransaction: Boolean read GetInTransaction;
    property LocaleCode: TLocaleCode read GetLocaleCode write SetLocaleCode default TLocaleCode(0);
    property MaxStmtsPerConn: LongWord read FMaxStmtsPerConn;
    property MetaData: ISQLMetaData read FSQLMetaData;
    property MultipleTransactionsSupported: LongBool read FSupportsMultiTrans;
    property ParamsLoaded: Boolean read FParamsLoaded write FParamsLoaded;
    property SQLConnection: ISQLConnection read FISQLConnection write FISQLConnection;
    property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default True;
    property TraceCallbackEvent: TSQLCallbackEvent read FTraceCallbackEvent;
    property TransactionsSupported: LongBool read FTransactionsSupported;
//    property Locale: TLocale read FLocale;
  published
    property ConnectionName: string read GetConnectionName write SetConnectionName;
    property DriverName: string read FDriverName write SetDriverName;
    property GetDriverFunc: string read FGetDriverFunc write FGetDriverFunc;
    property KeepConnection: Boolean read FKeepConnection write SetKeepConnection default True;
    property LibraryName: string read GetLibraryName write FLibraryName;
    property LoadParamsOnConnect: Boolean read FLoadParamsOnConnect write FLoadParamsOnConnect default False;
    property LoginPrompt default True;
    property Params: TStrings read FParams write SetParams;
    property TableScope: TTableScopes read FTableScope write FTableScope default [tsTable, tsView];
    property VendorLib: string read GetVendorLib write FVendorLib;
    property AfterConnect;
    property AfterDisconnect;
    property BeforeConnect;
    property BeforeDisconnect;
    property OnLogin: TSQLConnectionLoginEvent read FOnLogin write FOnLogin;
    property Connected;
  end;

{ TSQLDataLink }

  TSQLDataLink = class(TDetailDataLink)
  private
    FSQLDataSet: TCustomSQLDataSet;
  protected
    procedure ActiveChanged; override;
    procedure CheckBrowseMode; override;
    function GetDetailDataSet: TDataSet; override;
    procedure RecordChanged(Field: TField); override;
  public
    constructor Create(ADataSet: TCustomSQLDataSet);
  end;

{ TCustomSQLDataSet }

  TSQLCommandType = (ctQuery, ctTable, ctStoredProc);

  TSQLSchemaInfo = record
    FType: TSchemaType;
    ObjectName: string;
    Pattern: string;
    PackageName : string;
  end;

  TFieldDescList = array of FLDDesc;

  TCustomSQLDataSet = class(TDataSet)
  private
    FBlobBuffer: TBlobByteData;
    FCalcFieldsBuffer: TRecordBuffer;
    FCheckRowsAffected: Boolean;
    FClonedConnection: TSqlConnection;
    FCommandText: string;
    FCommandType: TSQLCommandType;
    FCurrentBlobSize: LongWord;
    FDataLink: TDataLink;
    FDesignerData: string;
    FGetNextRecordSet: Boolean;
    FIndexDefs: TIndexDefs;
    FIndexDefsLoaded: Boolean;
    FLastError: string;  // DBExpress GetError() clears error; need to save last
    FMaxBlobSize: Integer;
    FMaxColSize: LongWord;
    FNativeCommand: string;
    FGetMetadata: Boolean;
    FNumericMapping: Boolean;
    FParamCheck: Boolean;
    FParamCount: Integer;
    FParams: TParams;
    FPrepared: Boolean;
    FProcParams: TList;
    FRecords: Integer;
    FRowsAffected: Integer;
    FSchemaInfo: TSQLSchemaInfo;
    FSortFieldNames: string;
    FSQLCommand: ISQLCommand;
    FSQLConnection: TSQLConnection;
    FSQLCursor: ISQLCursor;
    FStatementOpen: Boolean;
    FTransactionLevel: SmallInt;
    FSchemaName: string;
    FBufferList: TDBBufferList;
    function CheckFieldNames(const FieldNames: string): Boolean;
    procedure CheckConnection(eFlag: eConnectFlag);
    function CheckDetail(const SQL: string): string;
    procedure CheckStatement(ForSchema: Boolean = False);
    function GetCalculatedField(Field: TField; var Buffer: TValueBuffer): Boolean;
    function GetDataSetFromSQL(TableName: string): TCustomSQLDataSet;
    function GetProcParams: TList;
    function GetInternalConnection: TSQLConnection;
    function GetObjectProcParamCount: Integer; virtual;
    function GetParamCount: Integer; virtual;
    function GetQueryFromType: string; virtual;
    function GetRowsAffected: Integer;
    procedure InitBuffers;
    procedure LoadFieldDef(FieldID: Word; var FldDesc: FLDDesc);
    procedure ReadDesignerData(Reader: TReader);
    procedure RefreshParams;
    procedure SetConnection(const Value: TSQLConnection); virtual;
    procedure SetCurrentBlobSize(Value: LongWord);
    procedure SetDataSource(Value: TDataSource);
    procedure SetParameters(const Value: TParams);
    procedure SetParamsFromProcedure;
    procedure SetParamsFromSQL(DataSet: TDataSet; bFromFields: Boolean);
    procedure SetPrepared(Value: Boolean);
    procedure SetCommandType(const Value: TSQLCommandType); virtual;
    procedure WriteDesignerData(Writer: TWriter);
    procedure SetSchemaName(const Value: string);
    procedure SetSchemaOption;
  protected
    { IProviderSupport }
    procedure PSEndTransaction(Commit: Boolean); override;
    procedure PSExecute; override;
    function PSExecuteStatement(const ASQL: string; AParams: TParams;
      var ResultSet: TObject): Integer; override;
    procedure PSGetAttributes(List: TList); override;
    function PSGetDefaultOrder: TIndexDef; override;
    function PSGetKeyFields: string; override;
    function PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs; override;
    function PSGetParams: TParams; override;
    function PSGetQuoteChar: string; override;
    function PSGetTableName: string; override;
    function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
    function PSInTransaction: Boolean; override;
    function PSIsSQLBased: Boolean; override;
    function PSIsSQLSupported: Boolean; override;
    procedure PSReset; override;
    procedure PSSetCommandText(const ACommandText: string); override;
    procedure PSSetParams(AParams: TParams); override;
    procedure PSStartTransaction; override;
    function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
  protected
    { implementation of abstract TDataSet methods }
    procedure InternalClose; override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalOpen; override;
    function IsCursorOpen: Boolean; override;
  protected
    procedure AddFieldDesc(FieldDescs: TFieldDescList; DescNo: Integer;
        var FieldID: Integer; RequiredFields: TBits; FieldDefs: TFieldDefs);
    procedure AddIndexDefs(SourceDS: TCustomSQLDataSet; IndexName: string = '') ;
    function Check(status: SQLResult; eType: TSQLExceptionType): SQLResult;
    procedure CheckPrepareError;
    procedure ClearIndexDefs;
    procedure CloseCursor; override;
    procedure CloseStatement;
    procedure DefineProperties(Filer: TFiler); override;
    function  InternalExecSQL(ExecDirect: Boolean = False): Integer; virtual;
    procedure ExecuteStatement;
    procedure FreeCursor;
    procedure FreeBuffers;
    procedure FreeStatement;
    function GetCanModify: Boolean; override;
    function GetDataSource: TDataSource; override;
    procedure GetObjectTypeNames(Fields: TFields);
    procedure GetOutputParams(AProcParams: TList);
    function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    function GetSortFieldNames: string;
    procedure InitRecord(Buffer: TRecordBuffer); override;
    procedure InternalRefresh; override;
    procedure Loaded; override;
    function LocateRecord(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions; SyncCursor: Boolean): Boolean;
    procedure OpenCursor(InfoQuery: Boolean); override;
    procedure OpenSchema; virtual;
    procedure PropertyChanged;
    procedure SetBufListSize(Value: Integer); override;
    procedure SetCommandText(const Value: string); virtual;
    procedure SetFieldData(Field: TField; Buffer: TValueBuffer); override;
    procedure SetParamsFromCursor;
    procedure SetSortFieldNames(Value: string);
    procedure SQLError(OpStatus: SQLResult; eType: TSQLExceptionType);
    procedure UpdateIndexDefs; override;
    { protected properties }
    property BlobBuffer: TBlobByteData read FBlobBuffer write FBlobBuffer;
    property CurrentBlobSize: LongWord read FCurrentBlobSize write SetCurrentBlobSize;
    property DataLink: TDataLink read FDataLink;
    property InternalConnection: TSqlConnection read GetInternalConnection;
    property LastError: string read FLastError write FLastError;
    property NativeCommand: string read FNativeCommand write FNativeCommand;
    property ProcParams: TList read GetProcParams write FProcParams;
    property RowsAffected: Integer read GetRowsAffected;
    procedure SetMaxBlobSize(MaxSize: Integer);
    procedure SetFCommandText(const Value: string);
    property ParamCount: Integer read GetParamCount;
    property SchemaInfo: TSQLSchemaInfo read FSchemaInfo write FSchemaInfo;
  protected  { publish in TSQLDataSet }
    property CommandType: TSQLCommandType read FCommandType write SetCommandType default ctQuery;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property MaxBlobSize: Integer read FMaxBlobSize write SetMaxBlobSize default 0;
    function GetRecordCount: Integer; override;
    property Params: TParams read FParams write SetParameters;
    property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
    property SortFieldNames: string read GetSortFieldNames write SetSortFieldNames;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property CommandText: string read FCommandText write SetCommandText;
    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
    function GetBlobFieldData(FieldNo: Integer; var Buffer: TBlobByteData): Integer; override;
    procedure GetDetailLinkFields(MasterFields, DetailFields: TObjectList); override;
    function GetFieldData(FieldNo: Integer; Buffer: TValueBuffer): Boolean; overload; override;
    function GetFieldData(Field: TField; Buffer: TValueBuffer): Boolean; overload; override;
    function GetKeyFieldNames(List: TStrings): Integer;
    function GetQuoteChar: string; virtual;
    function ParamByName(const Value: string): TParam;
    procedure PrepareStatement; virtual;
    property IndexDefs: TIndexDefs read FIndexDefs write FIndexDefs;
    function IsSequenced: Boolean; override;
    function Locate(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions): Boolean; override;
    function Lookup(const KeyFields: string; const KeyValues: Variant;
      const ResultFields: string): Variant; override;
    procedure SetSchemaInfo(SchemaType: TSchemaType; SchemaObjectName, SchemaPattern: string; PackageName: string = '');
    property Prepared: Boolean read FPrepared write SetPrepared default False;
    property DesignerData: string read FDesignerData write FDesignerData;
    property RecordCount: Integer read GetRecordCount;
    property SQLConnection: TSQLConnection read FSQLConnection write SetConnection;
    property TransactionLevel: SmallInt read FTransactionLevel write FTransactionLevel default 0;
  published
    property SchemaName: string read FSchemaName write SetSchemaName;
    property GetMetadata: Boolean read FGetMetadata write FGetMetadata default True;
    property NumericMapping: Boolean read FNumericMapping write FNumericMapping default False;
    property ObjectView default False;
    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeScroll;
    property AfterScroll;
    property BeforeRefresh;
    property AfterRefresh;
    property OnCalcFields;
    property Active default False;
  end;

{ TSQLDataSet }

  TSQLDataSet = class(TCustomSQLDataSet)
  public
    constructor Create(AOwner: TComponent); override;
    function ExecSQL(ExecDirect: Boolean = False): Integer;
  published
    property CommandText;
    property CommandType;
    property DataSource;
    property MaxBlobSize;
    property ParamCheck;
    property Params;
    property SortFieldNames;
    property SQLConnection;
  end;

{ TSQLQuery }

  TSQLQuery = class(TCustomSQLDataSet)
  private
    FSQL: TStrings;
    FText: string;
    procedure QueryChanged(Sender: TObject);
    procedure SetSQL(Value: TStrings);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecSQL(ExecDirect: Boolean = False): Integer;
    procedure PrepareStatement; override;
    property RowsAffected;
    property Text: string read FText;
  published
    property DataSource;
    property GetMetadata default False;
    property MaxBlobSize;
    property ParamCheck;
    property Params;
    property SQL: TStrings read FSQL write SetSQL;
    property SQLConnection;
  end;

{ TSQLStoredProc }

  TSQLStoredProc = class(TCustomSQLDataSet)
  private
    FStoredProcName: string;
    FPackageName: string;
    procedure SetStoredProcName(Value: string);
    procedure SetPackageName(Value: string);
  public
    constructor Create(AOwner: TComponent); override;
    function ExecProc: Integer; virtual;
    function NextRecordSet: TCustomSQLDataSet;
    procedure PrepareStatement; override;
  published
    property MaxBlobSize;
    property ParamCheck;
    property Params;
    { SetPackageName set StoredProcName to empty string
      Need to set PackageName 1st, and StoredProcName 2nd.
      Don't change following 2 items order }
    property PackageName: string read FPackageName write SetPackageName;
    property SQLConnection;
    property StoredProcName: string read FStoredProcName write SetStoredProcName;
  end;

{ TSQLTable }

  TSQLTable = class(TCustomSQLDataSet)
  private
    FIsDetail: Boolean;
    FIndexFields: TList;
    FIndexFieldNames: string;
    FIndexName: string;
    FMasterLink: TMasterDataLink;
    FTableName: string;
    FIndexFieldCount: Integer;
    procedure AddParamsToQuery;
    function GetMasterFields: string;
    function GetIndexField(Index: Integer): TField;
    function GetIndexFieldCount: Integer;
    function RefreshIndexFields: Integer;
    procedure SetIndexFieldNames(Value: string);
    procedure SetIndexName(Value: string);
    procedure SetMasterFields(Value: string);
    procedure SetTableName(Value: string);
    function GetQueryFromType: string; override;
    procedure SetDataSource(Value: TDataSource);
  protected
    procedure OpenCursor(InfoQuery: Boolean); override;
    procedure SetIndexField(Index: Integer; Value: TField);
    property MasterLink: TMasterDataLink read FMasterLink;
public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DeleteRecords;
    procedure GetIndexNames(List: TStrings);
    procedure PrepareStatement; override;
    property IndexFields[Index: Integer]: TField read GetIndexField write SetIndexField;
    property IndexFieldCount: Integer read GetIndexFieldCount;
  published
    property Active default False;
    property IndexFieldNames: string read FIndexFieldNames write SetIndexFieldNames;
    property IndexName: string read FIndexName write SetIndexName;
    property MasterFields: string read GetMasterFields write SetMasterFields;
    property MasterSource: TDataSource read GetDataSource write SetDataSource;
    property MaxBlobSize;
    property SQLConnection;
    property TableName: string read FTableName write SetTableName;
  end;

{ Utility Routines }

  procedure LoadParamListItems(Params: TParams; ProcParams: TList);
  procedure FreeProcParams(var ProcParams: TList);
  procedure GetConnectionNames(List: TStrings; Driver: string = ''; DesignMode: Boolean = True);
  procedure GetDriverNames(List: TStrings; DesignMode: Boolean = True);
  function GetDriverRegistryFile(DesignMode: Boolean = False): string;
  function GetConnectionRegistryFile(DesignMode: Boolean = False): string;

implementation

uses SqlConst, DBConsts, Registry, IniFiles, Math, DBConnAdmin, FMTBcd, StrUtils,
  System.Text;

 { Unit resource management }
type
  TSQLResourceMgr = class(TObject)
  private
    FCommands: TThreadList;
    FConnections: TThreadList;
    FModules: TThreadList;
    procedure FreeResources;
  strict protected
    procedure Finalize; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddCommand(Command: ISQLCommand);
    procedure RemoveCommand(Command: ISQLCommand);
    procedure AddConnection(Connection: ISQLConnection);
    procedure RemoveConnection(Connection: ISQLConnection);
    procedure AddCallback(Connection: ISQLConnection; Callback: TSQLCallbackEvent);
    procedure RemoveCallback(Connection: ISQLConnection);
    procedure AddModule(Module: HMODULE);
    procedure FreeModule(Module: HMODULE);
  end;

  TConnectionInfo = record
     FConnection: ISQLConnection;
     FCallback: TSQLCallbackEvent;
  end;

var SQLResources: TSQLResourceMgr = nil;

constructor TSQLResourceMgr.Create;
begin
  inherited Create;
  FCommands := TThreadList.Create;
  FConnections := TThreadList.Create;
  FModules := TThreadList.Create;
end;

destructor TSQLResourceMgr.Destroy;
begin
  FreeResources;
  System.GC.SuppressFinalize(self);
end;

procedure TSQLResourceMgr.Finalize;
begin
  FreeResources;
end;

procedure TSQLResourceMgr.FreeResources;
var
  I: Integer;
  CI: TConnectionInfo;
  L: TList;
begin
  if Assigned(FCommands) then
  begin
    L := FCommands.LockList;
      for I := 0 to L.Count - 1 do
        try
          ISQLCommand_close(ISQLCommand(L[I]));
        except
          // dont stop for exceptions
        end;
    FCommands.UnlockList;
    FreeAndNil(FCommands);
  end;
  if Assigned(FConnections) then
  begin
    L := FConnections.LockList;
    for I := 0 to L.Count - 1 do
      try
        CI := TConnectionInfo(L[I]);
        if Assigned(CI.FCallback) then
          ISQLConnection_SetOption(CI.FConnection,
            TSQLConnectionOption(eConnCallback), Integer(0));
        ISQLConnection_disconnect(CI.FConnection);
      except
        // dont stop for exceptions
      end;
    FConnections.UnlockList;
    FreeAndNil(FConnections);
  end;
  if Assigned(FModules) then
  begin
    L := FModules.LockList;
    for I := 0 to L.Count - 1 do
      try
        FreeLibrary(HMODULE(L[I]));
      except
        // dont stop for exceptions
      end;
    FModules.UnlockList;
    FreeAndNil(FModules);
  end;
end;

procedure TSQLResourceMgr.AddCommand(Command: ISQLCommand);
begin
  FCommands.Add(Command);
end;

procedure TSQLResourceMgr.RemoveCommand(Command: ISQLCommand);
begin
  FCommands.Remove(Command);
end;

procedure TSQLResourceMgr.AddConnection(Connection: ISQLConnection);
var
  CI: TConnectionInfo;
begin
  CI.FConnection := Connection;
  CI.FCallback := nil;
  FConnections.Add(TObject(CI));
end;

procedure TSQLResourceMgr.RemoveConnection(Connection: ISQLConnection);
var
  L: TList;
  I: Integer;
  CI: TConnectionInfo;
begin
  L := FConnections.LockList;
  try
    for I := 0 to L.Count - 1 do
    begin
      CI := TConnectionInfo(L[I]);
      if (CI.FConnection = Connection) then
      begin
        L.Delete(I);
        Break;
      end;
    end;
  finally
    FConnections.UnlockList;
  end;
end;

procedure TSQLResourceMgr.AddCallback(Connection: ISQLConnection; Callback: TSQLCallbackEvent);
var
  L: TList;
  I: Integer;
  CI: TConnectionInfo;
begin
  L := FConnections.LockList;
  try
    for I := 0 to L.Count - 1 do
    begin
      CI := TConnectionInfo(L[I]);
      if CI.FConnection = Connection then
      begin
        CI.FCallback := Callback;
        L[I] := TObject(CI);
        Break;
      end;
    end;
  finally
    FConnections.UnlockList;
  end;
end;

procedure TSQLResourceMgr.RemoveCallback(Connection: ISQLConnection);
var
  L: TList;
  I: Integer;
  CI: TConnectionInfo;
begin
  L := FConnections.LockList;
  try
    for I := 0 to L.Count - 1 do
    begin
      CI := TConnectionInfo(L[I]);
      if CI.FConnection = Connection then
      begin
        CI.FCallback := nil;
        L[I] := TObject(CI);
        Break;
      end;
    end;
  finally
    FConnections.UnlockList;
  end;
end;

procedure TSQLResourceMgr.AddModule(Module: HMODULE);
begin
  FModules.Add(TObject(Module));
end;

procedure TSQLResourceMgr.FreeModule(Module: HMODULE);
var
  L: TList;
  I: Integer;
begin
  L := FModules.LockList;
  try
    for I := 0 to L.Count - 1 do
      if HMODULE(L[I]) = Module then
      begin
        FreeLibrary(HMODULE(L[I]));
        L.Delete(I);
        break;
      end;
  finally
    FModules.UnlockList;
  end;
end;

{ Utility routines }

{
procedure CheckObject(const Value: IntPtr; const eType: TSQLExceptionType);
var
  Message: string;
begin
  if Value = nil then
  begin
    case eType of
      exceptConnection: Message := SDBXNOCONNECTION;
      exceptCommand: Message := SDBXNOCOMMAND;
      exceptCursor: Message := SDBXNOCURSOR;
      exceptMetadata: Message := SDBXNOMETAOBJECT;
    end;
    DatabaseError(Message);
  end;
end;
}
function AddQuoteCharToObjectName(DS : TCustomSQLDataSet; Name, Q: string): string;
var
  Status: SQLResult;
  Len : smallint;
  buf : IntPtr;
begin
  Result := '';
  Status := ISQLConnection_setOption(DS.GetInternalConnection.FISQLConnection,
    eConnQualifiedName, Name);
  if Status <> 0 then
    DS.SQLError(Status, exceptConnection);
  buf := Marshal.AllocHGlobal(256);
  try
    InitializeBuffer(buf, 256, 0);
    Status := ISQLConnection_getOption(DS.GetInternalConnection.FISQLConnection,
      eConnQuotedObjectName, buf, 256, Len);
    if Status <> 0 then
      DS.SQLError(Status, exceptConnection);
    Result := Marshal.PtrToStringAnsi(buf, Len);
  finally
    Marshal.FreeHGlobal(buf);
  end;
end;


function GetTableScope(Scope: TTableScopes): LongWord;
begin
  Result := 0;
  if tsTable in Scope then
    Result := Result OR eSQLTable;
  if tsView in Scope then
    Result := Result OR eSQLView;
  if tsSysTable in Scope then
    Result := Result OR eSQLSystemTable;
  if tsSynonym in Scope then
    Result := Result OR eSQLSynonym;
end;

function GetRegistryFile(Setting, Default: string; DesignMode: Boolean): string;
var
  Reg: TRegistry;
begin
  Result := '';
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKeyReadOnly(SDBEXPRESSREG_SETTING) then
      Result := Reg.ReadString(Setting);
  finally
    Reg.Free;
  end;
  if Result = '' then
    Result := ExtractFileDir(ParamStr(0)) + '\' + Default;
end;

function GetDriverRegistryFile(DesignMode: Boolean = False): string;
begin
  Result := GetRegistryFile(SDRIVERREG_SETTING, sDriverConfigFile, DesignMode);
end;

function GetConnectionRegistryFile(DesignMode: Boolean = False): string;
begin
  Result := GetRegistryFile(SCONNECTIONREG_SETTING, sConnectionConfigFile, DesignMode);
end;

function GetBlobSize(DataSet: TCustomSQLDataSet; FieldNo: Integer): LongWord;
var
  IsNull: LongBool;
  Status: SQLResult;
begin
  Result := 0;
  if not DataSet.EOF then
  begin
    if DataSet.MaxBlobSize = 0 then exit;
    Status := ISQLCursor_GetBlobSize(DataSet.FSQLCursor, Word(FieldNo), Result, IsNull);
    if Status <> DBXERR_NONE then
      DataSet.SQLError(Status, exceptCursor);
    if IsNull then
      Result := 0;
  end;
  DataSet.CurrentBlobSize := Result;
end;

function NextPiece(Start: string; InLiteral: Boolean; QuoteChar: Char; EndParam: Boolean = False): Integer;
var
  P, Len: Integer;
  C: Char;
  SearchChars: TSysCharSet;
begin
  SearchChars := [' ', ')', ',', '=', ':', '>', '<', #13, #10];
  P := 2;
  Len := Length(Start);
  Result := 0;
  while (Result = 0) and (P <= Len) and (Start[P] <> #0) do
  begin
    C := Start[P];
    if (C = '''') or (C = QuoteChar) then
      InLiteral := not InLiteral
    else if not InLiteral and (C in SearchChars) then
    begin
      if EndParam then
      begin
        if not (C in ['=', ':', '<', '>']) then
          Result := P;
      end else
      begin
        if (C = ':') then
        begin
          if (Start[P-1] in [' ', ')', ',', '=', '(']) then
            Result := P - 1;
        end else if (P < Len) and (Start[P + 1] = ':') then
          Result := P;
      end;
    end;
    Inc(P);
  end;
end;

// SqlObjects does not support named params: convert to ?
// if not yet converted
function FixParams(SQL: string; Count: Integer; QuoteChar: string): string;
var
  Param, Start: string;
  Pos, EndPos: Integer;
  InLiteral: Boolean;
  Q: Char;
begin
  Q := #0;
  if QuoteChar.Length > 0 then
    Q := QuoteChar[1];
  if (Q in [#0, ' ']) then Q := '''';
  InLiteral := False;
  Start := SQL;
  Pos := NextPiece(Start, InLiteral, Q);
  while Pos > 0 do
  begin
    Start := copy(Start, Pos + 1, Length(Start) - Pos);
    EndPos := NextPiece(Start, InLiteral, Q, True);
    if EndPos = 0 then
      Param := copy(Start, 1, Length(Start))
    else
      Param := copy(Start, 1, EndPos-1);
    SQL := StringReplace(SQL, Param, ' ? ', []);
    Pos := NextPiece(Start, InLiteral, Q);
  end;
  Result := SQL;
end;

function GetProfileString(Section, Setting, IniFileName: string): string;
var
  IniFile: TMemIniFile;
  List: TStrings;
begin
  List := TStringList.Create;
  try
    IniFile := TMemIniFile.Create(IniFileName);
    IniFile.ReadSectionValues(Section, List);
    try
      Result := List.Values[ Setting ];
    finally
      IniFile.Free;
    end;
  finally
    List.Free;
  end;
end;

procedure GetDriverNames(List: TStrings; DesignMode: Boolean = True);
var
  ConnectionAdmin: IConnectionAdmin;
begin
  ConnectionAdmin := GetConnectionAdmin;
  ConnectionAdmin.GetDriverNames(List);
end;

procedure GetConnectionNames(List: TStrings; Driver: string = ''; DesignMode: Boolean = True);
var
  I: Integer;
  ConnectionAdmin: IConnectionAdmin;
begin
  ConnectionAdmin := GetConnectionAdmin;
  ConnectionAdmin.GetConnectionNames(List, '');
  if Driver <> '' then
  begin
    List.BeginUpdate;
    try
      I := List.Count - 1;
      while I >= 0 do
      begin
        if WideCompareText(GetProfileString(List[I], DRIVERNAME_KEY,
              GetConnectionRegistryFile(DesignMode)), Driver) <> 0 then
           List.Delete(I);
        Dec(I);
      end;
    finally
      List.EndUpdate;
    end;
  end;
end;

procedure GetParamData(Param: TParam; Buffer: TRecordBuffer; const DrvLocale: TLocale);
begin
  if Buffer <> nil then
  begin
    with Param do
      if DataType in [ftString, ftFixedChar, ftMemo]  then
      begin
        NativeStr := VarToStr(Value);
        GetData(Buffer);
      end
      else
        GetData(Buffer);
  end;
end;


procedure CalcUnits( const Params: TParams; const ProcParams: TList;
          const Index: Integer; var pArgDesc: SPParamDesc; var ChildPos: array of Word );
var
  I: Integer;
  ArgDesc: SPParamDesc;
begin
  I := Index + 1;
  pArgDesc.iUnits1 := 0;
  pArgDesc.iUnits2 := 0;
  while (I < Params.Count) do
  begin
    ArgDesc := (SPParamDesc(ProcParams.Items[I]));
    if ArgDesc.iParamNum <> pArgDesc.iParamNum then
      break;
    Inc(pArgDesc.iUnits1);
    Inc(pArgDesc.iUnits2);
    ChildPos[I] := I - Index;
    if ArgDesc.iDataType = ftADT then
    begin
      CalcUnits(Params, ProcParams, I, ArgDesc, ChildPos);
      Inc(pArgDesc.iUnits2, ArgDesc.iUnits2);
      Inc(I, ArgDesc.iUnits2);
    end else
      Inc(I);
  end;
end;

function ReadBcdFromBuffer(Buffer: IntPtr): TBcd;
var
  Temp: TBytes;
begin
  SetLength(Temp, SizeOfTBcd);
  Marshal.Copy(Buffer, Temp, 0, SizeOfTBcd);
  Result := TBcd.FromBytes(Temp);
end;

procedure SetProcedureParams(const Sender: TSQLConnection;
  const Command: ISQLCommand; const Params: TParams; ProcParams: TList);
var
  I, J, IInd, DataLen, iLen, iUnits2: Integer;
  iFldNum: LongWord;
  RecBuffer: TRecordBuffer;
  iFldType, iSubType: Word;
  DrvLocale: TLocale;
  Status: SQLResult;
  ArgDesc: SPParamDesc;
  ChildPosArray: array of Word;
  Bcd: TBcd;
begin
  DrvLocale := nil;
  SetLength(ChildPosArray, Params.Count);
  for I := 0 to Params.Count - 1 do
    begin
      RecBuffer := nil;
      try
        if Params[I].ParamType = ptUnknown then  // Midas assumes its Input
          Params[I].ParamType := ptInput;
        iFldNum := i + 1;
        iFldType := FldTypeMap[Params[I].DataType];
        iSubType := 0;
        if iFldType in [fldBlob, fldZString] then
          iSubType := Word(FldSubTypeMap[Params[I].DataType])
        else if iFldType = fldUNKNOWN then
          DatabaseErrorFmt(SNoParameterValue, [Params[I].Name]);
        ArgDesc := (SPParamDesc(ProcParams.Items[I]));
        iLen := ArgDesc.iLen;
        iFldType := FldTypeMap[ArgDesc.iDataType];
        if Params[I].ParamType <> ptOutput then
          DataLen := Params[I].GetDataSize
        else
          DataLen := ArgDesc.iLen;
        {Check if the IN param is NULL and set the NULL indicator}
        if ((Params[I].ParamType = ptInput) and Params[I].IsNull) then
          iInd := 1
        else if (DataLen > 0) then
        begin
          iInd := 0;
          RecBuffer := Marshal.AllocHGlobal(DataLen);
          if Params[I].ParamType <> ptOutput then
            GetParamData(Params[I], RecBuffer, DrvLocale)
          else
            for J := 0 to DataLen - 1 do
              Marshal.WriteByte(RecBuffer, J, 0);
          if Params[I].ParamType = ptInput then
            Params[I].Size := 0;
          if (Params[I].ParamType = ptOutput) and not(iFldType in [fldFLOAT]) then
            iLen := 0
          else
            case iFldType of
              fldBlob, fldZString, fldBYTES, fldVARBYTES:
                begin
                  iLen := DataLen;	
                  iUnits2 := 0;
                  if (Params[I].ParamType = ptInputOutput) and (DataLen > Params[I].Size) then
                  begin
                    if iFldType = fldVARBYTES then
                      Params[I].Size := DataLen - 2
                    else if iFldType = fldZString then
                      Params[I].Size := DataLen - 1
                    else
                      Params[I].Size := DataLen;
                  end;
                end;
              fldFLOAT:
                begin
                  if Params[I].Precision = 4 then
		    iLen := 4
                  else
                    iLen := SizeOf(Double);
                end;
              fldFMTBCD, fldBCD:
                begin
                  iFldType := fldBCD;   { DBExpress does not distinguish }
                  if Params[I].Size = 0 then
                  begin
                    Bcd := ReadBcdFromBuffer(RecBuffer);
                    Params[I].Size := Bcd.Precision;
                    iUnits2 := Bcd.SignSpecialPlaces AND $3F;
                  end else
                  begin
                    iUnits2 := Params[I].NumericScale;
                  end;
                end;
              fldADT, fldARRAY:
                begin
                  CalcUnits(Params, ProcParams, I, ArgDesc, ChildPosArray);
                  iLen := DataLen;
                end;
            end;
        end else  // leave RecBuffer nil
        begin
          if iFldType in [fldADT, fldARRAY] then
            DatabaseError(SObjectTypenameRequired);
          iInd := 1;
        end;
        Status := ISQLCommand_setParameter(Command, iFldNum - ChildPosArray[I],
          ChildPosArray[I], TSTMTParamType(ArgDesc.iArgType), iFldType, iSubType,
          Params[I].Size, Integer(iUnits2), iLen, RecBuffer, IInd);
        if (Status <> DBXERR_NONE) then
          Sender.SQLError(Status, exceptConnection);
      finally
        if RecBuffer <> nil then Marshal.FreeHGlobal(RecBuffer);
      end;
    end;
end;

procedure FreeProcParams(var ProcParams: TList);
var
  ArgParam: SPParamDesc;
  I: Integer;
begin
  if not Assigned(ProcParams) then Exit;
  for I := 0 to ProcParams.Count -1 do
  begin
    ArgParam := SPParamDesc(ProcParams[I]);
    ArgParam.Free;
  end;
  FreeAndNil(ProcParams);
end;

procedure LoadParamListItems(Params: TParams; ProcParams: TList);
var
  I: Integer;
  ArgParam: SPParamDesc;
begin
  for I := 0 to ProcParams.Count -1 do
  begin
    ArgParam := SPParamDesc(ProcParams.Items[I]);
    with TParam(Params.Add) do
    begin
      Name := ArgParam.szName;
      ParamType := ArgParam.iArgType;
      DataType := ArgParam.iDataType;
      if ParamType <> ptInput then
        Size := ArgParam.iLen;
    end;
  end;
end;

{ TSQLBlobStream }

constructor TSQLBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode = bmRead);
begin
  inherited Create;
  if not Field.DataSet.Active then
    DataBaseError(SDatasetClosed);
  FField := Field;
  FDataSet := FField.DataSet as TCustomSQLDataSet;
  FFieldNo := FField.FieldNo;
  ReadBlobData;
end;

destructor TSQLBlobStream.Destroy;
begin
  inherited Destroy;
end;

procedure TSQLBlobStream.ReadBlobData;
var
  BlobLength: LongInt;
  Mem: IntPtr;
begin
  Clear;
  BlobLength := GetBlobSize(FDataSet, FFieldNo);
  SetSize(BlobLength);
  if BlobLength = 0 then Exit;
  Mem := Marshal.AllocHGlobal(BlobLength);
  try
    if FDataSet.GetFieldData(FField, Mem, True) then
    begin
      Marshal.Copy(Mem, FDataSet.FBlobBuffer, 0, FDataSet.FCurrentBlobSize);
      Write(FDataSet.FBlobBuffer, FDataSet.FCurrentBlobSize);
    end;
    Position := 0;
  finally
    Marshal.FreeHGlobal(Mem);
  end;
end;

{ TSQLParams }

type

{ TSQLParams }

  TSQLParams = class(TParams)
  private
    FFieldName: TStrings;
    FBindAllFields: Boolean;
    function ParseSelect(SQL: string; bDeleteQuery: Boolean): string;
    function ParseUpdate(SQL: string): string;
    function ParseInsert(SQL: string): string;
  public
    constructor Create(Owner: TPersistent);
    Destructor Destroy; override;
    function GetFieldName(index: Integer): string;
    function Parse(var SQL: string; DoCreate: Boolean): string;
    property BindAllFields: Boolean read FBindAllFields;
  end;

constructor TSQLParams.Create(Owner: TPersistent);
begin
  inherited;
  FBindAllFields := False;
  FFieldName := TStringList.Create;
end;

destructor TSQLParams.Destroy;
begin
  inherited;
  FreeAndNil(FFieldName);
end;

function TSQLParams.GetFieldName(index: Integer): string;
begin
   Result := FFieldName[ index ];
end;

const
  SDelete = 'delete';      { Do not localize }
  SUpdate = 'update';      { Do not localize }
  SInsert = 'insert';      { Do not localize }

function TSQLParams.Parse(var SQL: string; DoCreate: Boolean): string;
var
  Start: string;
begin
  SQL := ParseSQL(SQL, DoCreate);
  Start := LowerCase(copy(SQL, 1, 6));
{ attempt to determine fields and fieldtypes associated with params }
  if Start = SSelect then
    Result := ParseSelect(SQL, False)
  else if Start = SDelete then
    Result := ParseSelect(SQL, True)
  else if Start = SInsert then
    Result := ParseInsert(SQL)
  else if Start = SUpdate then
    Result := ParseUpdate(SQL)
  else
    Result := '';
end;

{ no attempt to match fields clause with values clause :
    types only added if all values are inserted }
function TSQLParams.ParseInsert(SQL: string): string;
var
  Start: Integer;
  Value: string;
  CurSection: TSQLToken;
begin
  Result := '';
  if Pos(SSelectSpaces, LowerCase(SQL)) > 1 then Exit;  // can't parse sub queries
  Start := 1;
  CurSection := stUnknown;
  { move past 'insert ' }
  NextSQLToken(SQL, Start, Value, CurSection);
  { move past 'into ' }
  NextSQLToken(SQL, Start, Value, CurSection);
  { move past <TableName> }
  NextSQLToken(SQL, Start, Value, CurSection);

  { Check for owner qualified table name }
  if (Start <= Length(SQL)) and (SQL[Start] = '.') then
    NextSQLToken(SQL, Start, Value, CurSection);
  Result := Value;

  { move past 'set' }
  NextSQLToken(SQL, Start, Value, CurSection);
  if (LowerCase(Value) = 'values') then
    FBindAllFields := True;
end;

function TSQLParams.ParseSelect(SQL: string; bDeleteQuery: Boolean): string;
var
  FWhereFound: Boolean;
  Start: Integer;
  FName, Value: string;
  SQLToken, CurSection, LastToken: TSQLToken;
  Params: Integer;
begin
  Result := '';
  if bDeleteQuery = False then
  begin
    if PosEx(SSelectSpaces, LowerCase(SQL), 9) > 1 then Exit;  // can't parse sub queries
  end else
  begin
    if Pos(SSelectSpaces, LowerCase(SQL)) > 1 then Exit;  // can't parse sub queries
    SQL := SSelectStar + Copy(SQL, 8, Length(SQL) - 7);
  end;
  Start := 1;
  CurSection := stUnknown;
  LastToken := stUnknown;
  FWhereFound := False;
  Params := 0;
  repeat
    repeat
      SQLToken := NextSQLToken(SQL, Start, FName, CurSection);
      if SQLToken = stWhere then
      begin
        FWhereFound := True;
        LastToken := stWhere;
      end else if SQLToken = stTableName then
      begin
        { Check for owner qualified table name }
        if (Start <= Length(SQL)) and (SQL[Start] = '.') then
          NextSQLToken(SQL, Start, FName, CurSection);
        Result := FName;
      end else if (SQLToken = stValue) and (LastToken = stWhere) then
        SQLToken := stFieldName;
      if SQLToken in SQLSections then
        CurSection := SQLToken;
    until SQLToken in [stFieldName, stEnd];
    if FWhereFound and (SQLToken = stFieldName) then
      repeat
        SQLToken := NextSQLToken(SQL, Start, Value, CurSection);
        if SQLToken in SQLSections then
          CurSection := SQLToken;
      until SQLToken in [stEnd,stValue,stIsNull,stIsNotNull,stFieldName];
    if Value='?' then
    begin
      FFieldName.Add(FName);
      Inc(Params);
    end;
  until (Params = Count) or (SQLToken = stEnd);
  if Result = '' then Result := GetTableNameFromSql(SQL);
end;

function TSQLParams.ParseUpdate(SQL: string): string;
var
  Start: Integer;
  FName, Value: string;
  SQLToken, CurSection: TSQLToken;
  Params: Integer;
begin
  Result := '';
  if Pos(SSelectSpaces, LowerCase(SQL)) > 1 then Exit;  // can't parse sub queries
  Start := 1;
  CurSection := stUnknown;
  { move past 'update ' }
  NextSQLToken(SQL, Start, FName, CurSection);
  { move past <TableName> }
  NextSQLToken(SQL, Start, FName, CurSection);

  { Check for owner qualified table name }
  if (Start <= Length(SQL)) and (SQL[Start] = '.') then
    NextSQLToken(SQL, Start, FName, CurSection);

  Result := FName;
  { move past 'set ' }
  NextSQLToken(SQL, Start, FName, CurSection);
  Params := 0;
  CurSection := stSelect;
  repeat
    repeat
      SQLToken := NextSQLToken(SQL, Start, FName, CurSection);
      if SQLToken in SQLSections then CurSection := SQLToken;
    until SQLToken in [stFieldName, stEnd];
    if Pos(LowerCase(FName), 'values(') > 0 then continue;   { do not localize }
    if Pos(LowerCase(FName), 'values (') > 0 then continue;  { do not localize }
    if SQLToken = stFieldName then
      repeat
        SQLToken := NextSQLToken(SQL, Start, Value, CurSection);
          if SQLToken in SQLSections then CurSection := SQLToken;
      until SQLToken in [stEnd,stValue,stIsNull,stIsNotNull,stFieldName];
    if Value='?' then
    begin
      FFieldName.Add(FName);
      Inc(Params);
    end;
  until (Params = Count) or (SQLToken = stEnd);
end;

{ TSQLMonitor }

constructor TSQLMonitor.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTraceList := TStringList.Create;
  FMaxTraceCount := -1;
  FSQLCallBack := @InvokeCallback;
end;

destructor TSQLMonitor.Destroy;
begin
  if Active then SetActive(False);
  SetSQLConnection(nil);
  inherited;
  FreeAndNil(FTraceList);
end;

procedure TSQLMonitor.SetFileName(const Value: String);
begin
  FFileName := Value;
end;

procedure TSQLMonitor.CheckInactive;
begin
  if FActive then
  begin
    if (csDesigning in ComponentState) or (csLoading in ComponentState) then
      SetActive(False)
    else
      DatabaseError(SMonitorActive, Self);
  end;
end;

procedure TSQLMonitor.SetSQLConnection(Value: TSQLConnection);
var
  IsActive: Boolean;
begin
  if Value <> FSQLConnection then
  begin
    IsActive := Active;
    CheckInactive;
    if Assigned(FSQLConnection) and not FKeepConnection then
      SQLConnection.UnregisterTraceMonitor(Self);
    FSQLConnection := Value;
    if Assigned(FSQLConnection) then
    begin
      FSQLConnection.RegisterTraceMonitor(Self);
      Active := IsActive;
    end;
  end;
end;

procedure TSQLMonitor.SwitchConnection(const Value: TSQLConnection);
var
  MonitorActive: Boolean;
begin
  FKeepConnection := True;
  MonitorActive := Active;
  if MonitorActive then
    SetActive(False);
  SQLConnection := Value;
  if MonitorActive and Assigned(Value) then
    SetActive(True);
  FKeepConnection := False;
end;

procedure TSQLMonitor.Trace(var Desc: SQLTraceDesc; LogTrace: Boolean);
begin
  if Assigned(FOnTrace) then
    FOnTrace(Self, Desc, LogTrace);
end;

function TSQLMonitor.InvokeCallBack(CallType: TRACECat; CBInfo: IntPtr): CBRType;
var
  Desc: SQLTraceDesc;
  LogTrace: Boolean;
begin
  Result := cbrUSEDEF;
  if csDestroying in ComponentState then exit;
  Desc := SQLTraceDesc(Marshal.PtrToStructure(CBInfo, TypeOf(SQLTraceDesc)));
  LogTrace := (TSQLTraceFlag(CallType) in FTraceFlags) or (FTraceFlags = []);
  Trace(Desc, LogTrace);
  if LogTrace then
  begin
    if (FMaxTraceCount = -1) or (TraceCount < FMaxTraceCount) then
      FTraceList.Add(Desc.pszTrace);
    if Assigned(FOnLogTrace) then
      FOnLogTrace(Self, Desc);
    if FAutoSave and (FFileName <> '') then
      SaveToFile('');
  end;
end;

procedure TSQLMonitor.SetActive(Value: Boolean);
var
  FileHandle: TOpenedFile;
begin
  if FActive <> Value then
  begin
    if (csReading in ComponentState) then
      FStreamedActive := Value
    else begin
      if not (csDestroying in ComponentState) and not Assigned(FSQLConnection) then
        DatabaseError(SConnectionNameMissing)
      else
      begin
        if Value and (FileName <> '') then
        begin
          if not FileExists(FileName) then
          begin
            FileHandle := FileCreate(FileName);
            if FileHandle = nil then
              DatabaseErrorFmt(SCannotCreateFile, [FileName])
            else
              FileClose(FileHandle);
          end;
        end;
        if Assigned(FSQLConnection) then
        begin
          if Value then
            FSQLConnection.SetTraceCallbackEvent(FSQLCallBack, 1)
          else
            FSQLConnection.SetTraceCallbackEvent(nil, 0);
        end;
        FActive := Value;
      end;
    end;
  end;
end;

procedure TSQLMonitor.SetStreamedActive;
begin
  if FStreamedActive then
    SetActive(True);
end;

function TSQLMonitor.GetTraceCount: Integer;
begin
  Result := FTraceList.Count;
end;

procedure TSQLMonitor.LoadFromFile(AFileName: string);
begin
  if AFileName <> '' then
    FTraceList.LoadFromFile(AFileName)
  else if FFileName <> '' then
    FTraceList.LoadFromFile(FFileName)
  else
    DatabaseError(SFileNameBlank);
end;

procedure TSQLMonitor.SaveToFile(AFileName: string);
begin
  if AFileName <> '' then
    FTraceList.SaveToFile(AFileName)
  else if FFileName <> '' then
    FTraceList.SaveToFile(FFileName)
  else
    DatabaseError(SFileNameBlank);
end;

procedure TSQLMonitor.SetTraceList(Value: TStrings);
begin
  if FTraceList <> Value then
  begin
    FTraceList.BeginUpdate;
    try
      FTraceList.Assign(Value);
    finally
      FTraceList.EndUpdate;
    end;
  end;
end;


{ TSQLConnection }

constructor TSQLConnection.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FParams := TStringList.Create;
  FAutoClone := True;
  try
    FConnectionRegistryFile := GetConnectionRegistryFile(csDesigning in ComponentState);
  except
    FConnectionRegistryFile := '';
  end;
  FKeepConnection := True;
  FMonitorUsers := TList.Create;
  FSQLHourGlass := True;
  FQuoteChar := '';
  FTableScope := [tsTable, tsView];
  LoginPrompt := True;
end;

destructor TSQLConnection.Destroy;
begin
  Destroying;
  ClearConnectionUsers;
  Close;
  ClearMonitors;
  FreeAndNil(FMonitorUsers);
  inherited Destroy;
  FreeAndNil(FParams);
end;

{ user registration }

procedure TSQLConnection.ClearConnectionUsers;
begin
  while DataSetCount > 0 do
  begin
    if TCustomSQLDataSet(DataSets[0]).Active then
      TCustomSQLDataSet(DataSets[0]).Close;
    TCustomSQLDataSet(DataSets[0]).FreeStatement;
    TCustomSQLDataSet(DataSets[0]).SetConnection(nil);
  end;
end;

procedure TSQLConnection.ClearMonitors;
var
  I: Integer;
begin
  for I := 0 to FMonitorUsers.Count -1 do
  begin
    if Self.FIsCloned then
      TSQLMonitor(FMonitorUsers[0]).SwitchConnection(Self.FCloneParent)
    else
    begin
      TSQLMonitor(FMonitorUsers[0]).SetActive(False);
      TSQLMonitor(FMonitorUsers[0]).FSQLConnection := nil;
    end;
  end;
end;

procedure TSQLConnection.RegisterTraceMonitor(Client: TObject);
begin
  FMonitorUsers.Add(Client);
end;

procedure TSQLConnection.UnregisterTraceMonitor(Client: TObject);
begin
  FMonitorUsers.Remove(Client);
end;

procedure TSQLConnection.RegisterClient(Client: TObject; Event: TConnectChangeEvent = nil);
begin
  inherited; 
end;

procedure TSQLConnection.UnRegisterClient(Client: TObject);
begin
  inherited;
end;

{ Driver Exception handling routine }
const
  DbxError : array[0..25] of String = (SqlConst.SNOERROR, SqlConst.SWARNING,
      SqlConst.SNOMEMORY, SqlConst.SINVALIDFLDTYPE, SqlConst.SINVALIDHNDL,
      SqlConst.SNOTSUPPORTED, SqlConst.SINVALIDTIME, SqlConst.SINVALIDXLATION,
      SqlConst.SOUTOFRANGE, SqlConst.SINVALIDPARAM, SqlConst.SEOF,
      SqlConst.SSQLPARAMNOTSET, SqlConst.SINVALIDUSRPASS, SqlConst.SINVALIDPRECISION,
      SqlConst.SINVALIDLEN, SqlConst.SINVALIDXISOLEVEL, SqlConst.SINVALIDTXNID,
      SqlConst.SDUPLICATETXNID, SqlConst.SDRIVERRESTRICTED, SqlConst.SLOCALTRANSACTIVE,
      SqlConst.SMULTIPLETRANSNOTENABLED, SqlConst.SCONNECTIONFAILED,
      SqlConst.SDRIVERINITFAILED, SqlConst.SOPTLOCKFAILED, SqlConst.SINVALIDREF,
      SqlConst.SNOTABLE);


procedure TSQLConnection.SQLError(OpStatus: SQLResult; eType: TSQLExceptionType; const Command: ISQLCommand = nil);
var
  dbxErrorMsg, ServerErrorMsg, ExceptionMessage: string;
  MessageBuf: StringBuilder;
  Status: SQLResult;
  MessageLen: SmallInt;
begin
  dbxErrorMsg := '';
  ServerErrorMsg := '';
  ExceptionMessage := '';
  Status := SQL_NULL_DATA;
  MessageBuf := nil;
  if (OpStatus > 0) and (OpStatus <=  DBX_MAXSTATICERRORS) then
  begin
    if OpStatus = 64 then dbxErrorMsg := Format(SDBXError, [SqlConst.SNODATA])
    else if OpStatus = 65 then dbxErrorMsg := Format(SDBXError, [SqlConst.SSQLERROR])
    else dbxErrorMsg := Format(SDBXError, [DbxError[OpStatus]]);
  end;
  case eType of
    exceptCommand:
    begin
      Status := ISQLCommand_getErrorMessageLen(Command, MessageLen);
      if (Status = DBXERR_NONE) and (MessageLen > 0) then
      begin
        MessageBuf := StringBuilder.Create(MessageLen + 1);
        Status := ISQLCommand_getErrorMessage(Command, MessageBuf);
      end;
    end;
    exceptConnection:
    begin
      Status := ISQLConnection_getErrorMessageLen(FISQLConnection, MessageLen);
      if (Status = DBXERR_NONE) and (MessageLen > 0) then
      begin
        MessageBuf := StringBuilder.Create(MessageLen + 1);
        Status := ISQLConnection_getErrorMessage(FISQLConnection, MessageBuf);
      end;
    end;
    exceptMetaData:
    begin
      Status := ISQLMetaData_getErrorMessageLen(FSQLMetaData, MessageLen);
      if (Status = DBXERR_NONE) and (MessageLen> 0) then
      begin
        MessageBuf := StringBuilder.Create(MessageLen + 1);
        Status := ISQLMetaData_getErrorMessage(FSQLMetaData, MessageBuf);
      end;
    end;
  end;
  if Status = DBXERR_NONE then
    if MessageLen > 0 then
      ServerErrorMsg := Format(SSQLServerError, [MessageBuf.ToString]);
  if dbxErrorMsg.Length > 0 then
    ExceptionMessage := dbxErrorMsg;
  if ServerErrorMsg.Length > 0 then
  begin
    if ExceptionMessage.Length > 0 then
      ExceptionMessage := ExceptionMessage + #13 + #10;
    ExceptionMessage := ExceptionMessage + ServerErrorMsg;
  end;
  if (ExceptionMessage.Length = 0) and (LastError <> '') then
    ExceptionMessage := LastError;
  if ExceptionMessage.Length = 0 then
    ExceptionMessage :=  Format(SDBXUNKNOWNERROR, [intToStr(OpStatus)]);
  FLastError := ExceptionMessage;
  DatabaseError(ExceptionMessage);
end;

{ loading, connecting and disconnecting }

procedure TSQLConnection.LoadSQLDll;
begin
  if SQLDllHandle = THandle(0) then
    SQLDllHandle := THandle(LoadLibrary(LibraryName));
  if SQLDllHandle = THandle(0) then
    DataBaseErrorFmt(sDLLLoadError, [LibraryName]);
  SQLResources.AddModule(HMODULE(SQLDllHandle));
end;

procedure TSQLConnection.CheckConnection(eFlag: eConnectFlag);
begin
  if (eFlag in [eDisconnect, eReconnect]) then
    Close;
  if (eFlag in [eConnect, eReconnect]) then
    Open
end;

procedure TSQLConnection.Login(LoginParams: TStrings);
var
  UserName, Password: string;
begin
  if Assigned(FOnLogin) then
    FOnLogin(Self, LoginParams)
  else
  begin
    UserName := LoginParams.Values[szUserName];
    if Assigned(LoginDialogExProc) then
    begin
      SetCursor(DefaultCursor);
      if not LoginDialogExProc(ConnectionName, UserName, Password, False) then
        DatabaseErrorFmt(SLoginError, [ConnectionName]);
      SetCursor(HourGlassCursor);
      LoginParams.Values[szUSERNAME] := UserName;
      LoginParams.Values[szPASSWORD] := Password;
    end;
  end;
end;

procedure TSQLConnection.CheckLoginParams;
var
  I: Integer;
begin
  if FLoadParamsOnConnect then
  begin
    LoadParamsFromIniFile;
    FDriverName := GetProfileString(FConnectionName, DRIVERNAME_KEY, ConnectionRegistryFile);
  end;
  if FDriverName = '' then DataBaseError(SMissingDriverName);
  if LoadParamsOnConnect then
    FLibraryName := Trim(GetProfileString(FDriverName, DLLLIB_KEY, GetDriverRegistryFile(csDesigning in ComponentState)));
  if FLibraryName = '' then DataBaseError(SMissingDLLName, Self);
  if LoadParamsOnConnect then
    FVendorLib := Trim(GetProfileString(FDriverName, VENDORLIB_KEY, GetDriverRegistryFile));
  if FVendorLib = '' then DataBaseError(SMissingDLLName, Self);
  if LoadParamsOnConnect then
    FGetDriverFunc := Trim(GetProfileString(FDriverName, GETDRIVERFUNC_KEY, GetDriverRegistryFile));
  if Params.Values[DATABASENAME_KEY] = '' then
  begin
    if FConnectionName = '' then DataBaseError(SConnectionNameMissing)
    else DataBaseError(SMissingDatabaseName);
  end;
  for I := 0 to FMonitorUsers.Count -1 do
    TSQLMonitor(FMonitorUsers[i]).SetStreamedActive;
end;

function TSQLConnection.GetQuoteChar: string;
var
  Status: SQLResult;
  Len: SmallInt;
  Q: Char;
begin
  FQuoteChar := '';
  Len := 1;
  Q := #0;
  Status := ISQLMetaData_getOption(FSQLMetadata, eMetaObjectQuoteChar, Q, Len, Len);
  if (Q <> #0) and (Status = DBXERR_NONE) then
    FQuoteChar := Q;
  Result := FQuoteChar;
end;

procedure TSQLConnection.SetCursor(CursorType: Integer);
begin
  if SQLHourGlass or (CursorType = DefaultCursor) then
    if Assigned(ScreenCursorProc) then
      ScreenCursorProc(CursorType);
end;

procedure TSQLConnection.ConnectionOptions;
var
  PropSize: SmallInt;
begin
  GetQuoteChar;
  if FParams.Values[MAXBLOBSIZE_KEY] <> '' then
    ISQLConnection_setOption(FISQLConnection, eConnBlobSize,
      LongInt(StrToInt(Trim(FParams.Values[MAXBLOBSIZE_KEY]))))
  else
    ISQLConnection_setOption(FISQLConnection, eConnBlobSize, DefaultMaxBlobSize);
  ISQLMetaData_GetOption(FSQLMetaData, eMetaSupportsTransaction,
    FTransActionsSupported, SizeOf(Integer), PropSize);
  ISQLMetaData_GetOption(FSQLMetaData, eMetaSupportsTransactions,
    FSupportsMultiTrans, SizeOf(Integer), PropSize);
end;

procedure TSQLConnection.DoConnect;
var
  Status: SQLResult;
  LoginParams: TStrings;
  PropSize: SmallInt;
  TrimmedUserName: string;
begin
  CheckLoginParams;
  ConnectionState := csStateConnecting;
  SetCursor(HourGlassCursor);
  LoginParams := TStringList.Create;
  try
    LoadSQLDll;
    Status := GetSQLDriver(SQLDllHandle, GetDriverFunc, FVendorLib,
      Trim(FParams.Values[ERROR_RESOURCE_KEY]), FSQLDriver);
    if Status <> DBXERR_NONE then
      DataBaseErrorFmt(sDLLLoadError, [FVendorLib]);
    Check(ISQLDriver_setOption(FSQLDriver, eDrvRestrict, 0 {GDAL}));             
    Check(ISQLDriver_getSQLConnection(FSQLDriver, FISQLConnection));
    GetLoginParams(LoginParams);
    RegisterTraceCallback(True);
    SetConnectionParams;
    Check(ISQLConnection_connect(Connection, Trim(LoginParams.Values[DATABASENAME_KEY]),
      LoginParams.Values[ szUSERNAME ],  LoginParams.Values[ szPASSWORD ]));
    SQLResources.AddConnection(FISQLConnection);
    ISQLConnection_getOption(FISQLConnection, eConnMaxActiveComm,
      FMaxStmtsPerConn, Sizeof(Integer), PropSize);
    Check(ISQLConnection_getSQLMetaData(Connection, FSQLMetaData));
    TrimmedUserName := Trim(LoginParams.Values[ szUSERNAME ]);
    if TrimmedUserName <> '' then
      ISQLMetaData_SetOption(FSQLMetaData, eMetaSchemaName, TrimmedUserName);
    ConnectionOptions;
    ConnectionState := csStateOpen;
  finally
    SetCursor(DefaultCursor);
    LoginParams.Free;
    if ConnectionState = csStateConnecting then // an exception occurred
    begin
      if Assigned(FISQLConnection) then
      begin
        SQLResources.RemoveConnection(FISQLConnection);
        ISQLConnection_release(FISQLConnection);
        FISQLConnection := nil;
      end;
      ConnectionState := csStateClosed;
      if SQLDllHandle <> THandle(0) then
      begin
        ISQLDriver_release(FSQLDriver);
        FSQLDriver := nil;
        SQLResources.FreeModule(SQLDllHandle);
        SQLDllHandle := THandle(0);
      end;
    end;
  end;
end;

procedure TSQLConnection.GetLoginParams(LoginParams: TStrings);
var
  I: Integer;
  PName: string;
begin
  LoginParams.BeginUpdate;
  try
    LoginParams.Clear;
    for I := 0 to FParams.Count - 1 do
      begin
        if LoginParams.IndexOf(FParams[I]) > -1 then continue;
        PName := FParams.Names[I];
        if SameText(PName, szPASSWORD) then
           LoginParams.Add(format('%s=%s',[szPASSWORD, FParams.Values[szPASSWORD] ]))
        else if SameText(PName, szUSERNAME) then
           LoginParams.Add(format('%s=%s',[szUSERNAME, FParams.Values[szUSERNAME]]))
        else if SameText(PName, DATABASENAME_KEY) then
          LoginParams.Add(format('%s=%s',[DATABASENAME_KEY, Trim(FParams.Values[DATABASENAME_KEY])]));
      end;
  finally
    LoginParams.EndUpdate;
  end;
  if LoginPrompt then
     Login(LoginParams);
end;

function TSQLConnection.GetConnected: Boolean;
begin
  Result := Assigned(FISQLConnection) and (not
      (ConnectionState in [csStateClosed, csStateConnecting,
      csStateDisconnecting]));
end;

procedure TSQLConnection.DoDisconnect;
begin
  if FSQLDriver <> nil then
  begin
    ConnectionState := csStateDisconnecting;
    CloseDataSets;
    RegisterTraceCallback(False);
    if (FSQLMetaData <> nil) then
    begin
      ISQLMetaData_release(FSQLMetaData);
      FSQLMetaData := nil;
    end;
    if (FISQLConnection <> nil) then
    begin
      ISQLConnection_disconnect(FISQLConnection);
      SQLResources.RemoveConnection(FISQLConnection);
      FTransactionCount := 0;
      ISQLConnection_release(FISQLConnection);
      FISQLConnection := nil;
    end;
    if SQLDllHandle <> THandle(0) then
    begin
      ISQLDriver_release(FSQLDriver);
      FSQLDriver := nil;
      SQLResources.FreeModule(HMODULE(SQLDllHandle));
      SQLDllHandle := THandle(0);
    end;
    ConnectionState := csStateClosed;
  end;
  FParamsLoaded := False;
end;

procedure TSQLConnection.CloseDataSets;
var
  I: Integer;
begin
  for I := 0 to DataSetCount -1 do
  begin
    if TCustomSQLDataSet(DataSets[i]).Active then
      TCustomSQLDataSet(DataSets[i]).Close;
    TCustomSQLDataSet(DataSets[i]).FreeStatement;
  end;
  for I := 0 to FMonitorUsers.Count -1 do
  begin
    if Self.FIsCloned then
      TSQLMonitor(FMonitorUsers[I]).SwitchConnection( Self.FCloneParent );
  end;
end;

procedure TSQLConnection.CheckDisconnect;
var
  I: Integer;
begin
  if Connected and not (KeepConnection or InTransaction or (csLoading in ComponentState)) then
  begin
    for I := 0 to DataSetCount - 1 do
      if (DataSets[I].State <> dsInActive) then Exit;
    Close;
  end;
end;

procedure TSQLConnection.CheckInactive;
begin
  if FISQLConnection <> nil then
    if csDesigning in ComponentState then
      Close
    else
      DatabaseError(SdatabaseOpen, Self);
end;

procedure TSQLConnection.CheckActive;
begin
  if FISQLConnection = nil then DatabaseError(SDatabaseClosed, Self);
end;

{ Query execution }

function TSQLConnection.GetConnectionForStatement: TSQLConnection;
begin
  if (FMaxStmtsPerConn > 0) and (FActiveStatements >= FMaxStmtsPerConn)  and
       not (FTransactionCount > 0) and AutoClone then
    Result := CloneConnection
  else
    Result := Self;
  FActiveStatements := 0;
end;

function TSQLConnection.ExecuteDirect(const SQL: string): Integer;
var
  Command: ISQLCommand;
  Cursor: ISQLCursor;
  Status: SQLResult;
  Connection: TSQLConnection;
  RowsetSize: Longint;
  Temp: LongWord;
begin
  CheckConnection(eConnect);
  Cursor := nil;
  Result := 0;
  RowsetSize := defaultRowsetSize;
  Connection := GetConnectionForStatement;
  if ISQLConnection_getSQLCommand(Connection.FISQLConnection, Command) = DBXERR_NONE then
  begin
    if Params.Values[ROWSETSIZE_KEY] <> '' then
    try
      RowsetSize := StrToInt(Trim(Params.Values[ROWSETSIZE_KEY]));
    except
      RowsetSize := defaultRowsetSize;
    end;
    ISQLCommand_setOption(Command, eCommRowsetSize, RowsetSize);

    Status := ISQLCommand_executeImmediate(Command, SQL, Cursor);
    if Status = DBXERR_NONE then
    begin
      Status := ISQLCommand_getRowsAffected(Command, Temp);
      Result := Temp;
      if not Assigned(Cursor) then
        ISQLCommand_Close(Command);
    end;
    if Status <> DBXERR_NONE then
      SQLError(Status, exceptCommand, Command);
  end;
end;

procedure SetQueryParams(const Sender: TSQLConnection; const Command: ISQLCommand;
  const Params: TParams);
var
  I, IInd: Integer;
  NumBytes, iFldNum: LongWord;
  RecBuffer: TRecordBuffer;
  iFldType, iSubType: Word;
  iUnits1, iUnits2: Integer;
  DrvLocale: TLocale;
  Status: SQLResult;
  Bcd: TBcd;
begin
  DrvLocale := nil;
  for I := 0 to Params.Count - 1 do
    begin
      RecBuffer := nil;
      if Params[I].IsNull then iInd := 1 else iInd := 0;
      try
        if Params[I].ParamType = ptUnknown then  // Midas assumes its Input
          Params[I].ParamType := ptInput;
        iFldNum := i + 1;
        iFldType := FldTypeMap[Params[I].DataType];
        iSubType := 0;
        iUnits1 := 0;
        iUnits2 := 0;
        if iFldType in [fldBlob, fldZString] then
          iSubType := Word(FldSubTypeMap[Params[I].DataType])
        else if iFldType = fldUNKNOWN then
          DatabaseErrorFmt(SNoParameterValue, [Params[I].Name]);
        NumBytes := Params[I].GetDataSize;
        if iInd = 1 then
          RecBuffer := Marshal.AllocHGlobal(0)
        else begin
          RecBuffer := Marshal.AllocHGlobal(NumBytes);
          GetParamData(Params[I], RecBuffer, DrvLocale);
        end;
        case iFldType of
          fldZString:
            begin
              if NumBytes > 0 then
                iUnits1 := Params[I].GetDataSize - 1    {Do not include null terminator}
              else
                iUnits1 := 0;
              iUnits2 := 0;
            end;
          fldBLOB:
            iUnits1 := NumBytes;
          fldBYTES:
            iUnits1 := Params[I].GetDataSize;
          fldVARBYTES:
            iUnits1 := Params[I].GetDataSize - 2;
          fldFLOAT:
            iUnits1 := SizeOf(double);
          fldFMTBCD, fldBCD:
            begin
              iFldType := fldBCD;   { DBExpress does not distinguish }
              if iInd = 0 then
              begin
                Bcd := ReadBcdFromBuffer(RecBuffer);
                iUnits1 := Bcd.Precision;
                iUnits2 := Bcd.SignSpecialPlaces AND $3F;
              end;
            end
        end;
        Status := ISQLCommand_setParameter(Command, iFldNum, 0,
          TSTMTParamType(Params[I].ParamType), iFldType, iSubType,
          Integer(iUnits1), Integer(iUnits2), NumBytes, RecBuffer, IInd);
        if (Status <> DBXERR_NONE) then
          Sender.SQLError(Status, exceptConnection);
      finally
        if RecBuffer <> nil then
          Marshal.FreeHGlobal(RecBuffer);
      end;
    end;
end;

function TSQLConnection.Execute(const SQL: string; Params: TParams): Integer;
var
  DS: TObject;
begin
  DS := NULL;
  Result := Execute(SQL, Params, DS);
  if Assigned(DS) then
    DS.Free;
end;

function TSQLConnection.Execute(const SQL: string; Params: TParams;
  var ResultSet: TObject): Integer;
var
  Status: SQLResult;
  SQLText: string;
  RowsAffected: LongWord;
  DS: TCustomSQLDataSet;
  I, ParamCount: Integer;
begin
  Result := 0;
  DS := TCustomSQLDataSet.Create(nil);
  try
    CheckConnection(eConnect);
    SetCursor(HourGlassCursor);
    DS.SQLConnection := Self;
    ConnectionState := csStateExecuting;
    if (Params <> nil) and (Params.Count > 0) then
    begin
      SQLText := FixParams(SQL, Params.Count, Self.GetQuoteChar);
      ParamCount := Params.Count;
    end else
    begin
      SQLText := Copy(SQL, 1, Length(SQL));
      ParamCount := 0;
    end;
    DS.FCommandText := SQLText;
    if ResultSet = nil then
    begin
      DS.CheckStatement;
      Status := ISQLCommand_prepare(DS.FSQLCommand, SQLText, ParamCount);
      if Status <> DBXERR_NONE then
        SQLError(Status, exceptCommand, DS.FSQLCommand);
      if ParamCount > 0 then
        SetQueryParams(Self, DS.FSQLCommand, Params);
      Status := ISQLCommand_execute(DS.FSQLCommand, DS.FSQLCursor);
      if Status <> DBXERR_NONE then
        SQLError(Status, exceptCommand, DS.FSQLCommand);
      Status := ISQLCommand_getRowsAffected(DS.FSQLCommand, RowsAffected);
      if Status <> DBXERR_NONE then
        SQLError(Status, exceptCommand, DS.FSqlCommand);
      Result := RowsAffected;
    end
    else
    begin
      if ParamCount > 0 then
      begin
        for I := 0 to ParamCount -1 do
        begin
          DS.Params.CreateParam(Params.Items[I].DataType, format('P%d',[I+1]), ptInput);
          DS.Params[I].Value := Params[I].Value;
        end;
      end;
      DS.MaxBlobSize := DefaultMaxBlobSize;
      DS.Active := True;
    end;
  finally
    SetCursor(DefaultCursor);
    if ResultSet = nil then
      DS.Free
    else
      ResultSet := DS;
    ConnectionState := csStateOpen;
  end;
end;

{ Metadata retrieval }

function TSQLConnection.CloneConnection: TSQLConnection;
var
  SelfParent: TSQLConnection;
  I: Integer;
begin      // do not allow nested clones
  if Self.FIsCloned then
    SelfParent := Self.FCloneParent
  else
    SelfParent := Self;
  Result := TSQLConnection.Create(nil);
  Result.FIsCloned := True;
  Result.FLoadParamsOnConnect := False;
  Result.LoginPrompt := False;
  Result.FDriverName := SelfParent.FDriverName;
  Result.FConnectionName := SelfParent.FConnectionName;
  Result.Name := SelfParent.Name + 'Clone1';
  Result.FParams.AddStrings(SelfParent.FParams);
  Result.FGetDriverFunc := SelfParent.FGetDriverFunc;
  Result.FLibraryName := SelfParent.FLibraryName;
  Result.FVendorLib := SelfParent.VendorLib;
  Result.FTableScope := SelfParent.TableScope;
  Result.Connected := Self.Connected;
  Result.FCloneParent := SelfParent;
  for I := 0 to FMonitorUsers.Count -1 do
    TSQLMonitor(FMonitorUsers[I]).SwitchConnection( Result );
end;

function TSQLConnection.OpenSchemaTable(eKind: TSchemaType; SInfo: string; SQualifier: string = ''; SPackage: string = ''): TCustomSQLDataSet;
begin
  Result := OpenSchemaTable(eKind, SInfo, SQualifier, SPackage , '');
end;

function TSQLConnection.OpenSchemaTable(eKind: TSchemaType; SInfo: string; SQualifier: string = ''; SPackage: string = ''; SSchemaName: string = ''): TCustomSQLDataSet;
var
  DataSet: TCustomSQLDataSet;
begin
  CheckConnection(eConnect);
  DataSet := TCustomSQLDataSet.Create(nil);
  try
    DataSet.SetConnection(Self);
    DataSet.SetSchemaInfo(eKind, SInfo, SQualifier, SPackage);
    DataSet.SchemaName := SSchemaName;
    DataSet.Active := True;
  except
    FreeSchemaTable(DataSet);
    DataSet := nil;
  end;
  Result := DataSet;
end;

procedure TSQLConnection.FreeSchemaTable(DataSet: TCustomSQLDataSet);
var
  SaveKeepConnection: Boolean;
  Temp: TObject;
begin
  Temp := TObject(DataSet.FClonedConnection);
  DataSet.FClonedConnection := nil;
  Temp.Free;
  SaveKeepConnection := FKeepConnection;
  FKeepConnection := True;
  if Assigned(Dataset) then
    DataSet.Free;
  FKeepConnection := SaveKeepConnection;
end;

procedure TSQLConnection.OpenSchema(eKind: TSchemaType; sInfo: string; List: TStrings);
begin
  OpenSchema(eKind, sInfo, '', List);
end;

const
  TBL_NAME_FIELD = 'TABLE_NAME';           { Do not localize }
  PROC_NAME_FIELD = 'PROC_NAME';           { Do not localize }
  COL_NAME_FIELD = 'COLUMN_NAME';          { Do not localize }
  IDX_NAME_FIELD = 'INDEX_NAME';           { Do not localize }
  PACKAGE_NAME_FIELD = 'OBJECT_NAME';      { Do not localize }

procedure TSQLConnection.OpenSchema(eKind: TSchemaType; sInfo, SSchemaName: string; List: TStrings);
var
  DataSet: TCustomSQLDataSet;
  NameField: TField;
  ColName: string;
  PackageName : string;
  i: integer;
  found: boolean;
begin
  CheckConnection(eConnect);
  if FISQLConnection = nil then
    DatabaseError(sConnectionNameMissing);
  DataSet := nil;
  NameField := nil;
  if eKind = stProcedures then
    PackageName := sInfo;
  CheckActive;
  SetCursor(HourGlassCursor);
  try
    DataSet := OpenSchemaTable(eKind, sInfo, '', PackageName, SSchemaName);
    if Assigned(DataSet) then
    begin
      case eKind of
        stColumns:
          NameField := DataSet.FieldByName(COL_NAME_FIELD);
        stProcedures:
          begin
            if not Assigned(DataSet) then DatabaseErrorFmt(SStoredProcsNotSupported, [FDriverName]);
            NameField := DataSet.FieldByName(PROC_NAME_FIELD);
          end;
        stPackages:
          begin
            if not Assigned(DataSet) then DatabaseErrorFmt(SPackagesNotSupported, [FDriverName]);
            NameField := DataSet.FieldByName(PACKAGE_NAME_FIELD);
          end;
        stIndexes:
          NameField := DataSet.FieldByName(IDX_NAME_FIELD);
        stTables, stSysTables:
          NameField := DataSet.FieldByName(TBL_NAME_FIELD);
      end;
      List.BeginUpdate;
      try
        List.Clear;
        while not DataSet.EOF do
        begin
          ColName := NameField.AsString;
          (* Begin fix for 179226. Code before was:
          if Pos(',' + ColName + ',', ',' + List.CommaText + ',') = 0 then
            List.Add(ColName);
          *)
          found := false;
          for i := 0 to List.Count -1 do
          begin
            if AnsiCompareStr(ColName, List[i]) = 0 then
            begin
              found := true;
              break;
            end;
          end;
          if not found then
            List.Add(ColName);
          (* End fix for 179226 *)
          DataSet.Next;
        end;
      finally
        List.EndUpdate;
      end;
    end;
  finally
    SetCursor(DefaultCursor);
    if Assigned(DataSet) then FreeSchemaTable(DataSet);
  end;
end;

procedure TSQLConnection.GetFieldNames(const TableName: string; List: TStrings);
begin
  OpenSchema(stColumns, TableName, List);
end;

procedure TSQLConnection.GetProcedureNames(List: TStrings);
begin
  OpenSchema(stProcedures, '', List);
end;

procedure TSQLConnection.GetProcedureNames(const PackageName : string; List: TStrings);
begin
  OpenSchema(stProcedures, PackageName, '',  List);
end;

procedure TSQLConnection.GetProcedureNames(const PackageName, SchemaName : string; List: TStrings);
begin
  OpenSchema(stProcedures, PackageName, SchemaName, List);
end;

procedure TSQLConnection.GetPackageNames(List: TStrings);
begin
  OpenSchema(stPackages, '', List);
end;


procedure TSQLConnection.GetTableNames(List: TStrings; SystemTables: Boolean = False);
begin
  GetTableNames( List, '', SystemTables );
end;

procedure TSQLConnection.GetTableNames(List: TStrings; SchemaName: String; SystemTables: Boolean = False);
var
  eType: TSchemaType;
begin
  if SystemTables then
    eType := stSysTables
  else
    eType := stTables;
  OpenSchema(eType, '', SchemaName, List);
end;

procedure TSQLConnection.GetIndexNames(const TableName: string; List: TStrings);
begin
  OpenSchema(stIndexes, TableName, '', List);
end;

procedure TSQLConnection.GetIndexNames(const TableName, SchemaName: string; List: TStrings);
begin
  OpenSchema(stIndexes, TableName, SchemaName, List);
end;

procedure TSQLConnection.GetProcedureParams(ProcedureName: string; List: TList);
begin
  GetProcedureParams(ProcedureName, '', List);
end;

procedure TSQLConnection.GetProcedureParams(ProcedureName, PackageName: string; List: TList);
begin
  GetProcedureParams(ProcedureName, PackageName, '',  List);
end;

const
  TypeFieldName = 'PARAM_TYPE';             { do not localize }
  DataTypeFieldName = 'PARAM_DATATYPE';     { do not localize }
  SubTypeFieldName = 'PARAM_SUBTYPE';       { do not localize }
  PosFieldName = 'PARAM_POSITION';          { do not localize }
  PrecisionFieldName = 'PARAM_PRECISION';   { do not localize }
  ScaleFieldName = 'PARAM_SCALE';           { do not localize }
  LengthFieldName = 'PARAM_LENGTH';         { do not localize }
  ParamNameFieldName = 'PARAM_NAME';        { do not localize }
  ResultParam = 'Result';                   { Do not localize }

procedure TSQLConnection.GetProcedureParams(ProcedureName, PackageName, SchemaName: string; List: TList);
var
  DataSet: TCustomSQLDataSet;
  ArgDesc: SPParamDesc;
  V: Variant;
  I: System.Int32;
begin
  DataSet := nil;
  try
    DataSet := OpenSchemaTable(stProcedureParams, ProcedureName,'', PackageName, SchemaName);
    if not Assigned(DataSet) then SQLError(SQLResult(-1), exceptMetadata);
    while not DataSet.EOF do
    begin
      ArgDesc := SPParamDesc.Create;
      ArgDesc.iParamNum := DataSet.FieldByName(PosFieldName).Value;
      V := DataSet.FieldByName(TypeFieldName).Value;
      if VarIsNull(V) then
        ArgDesc.iArgType := ptUnknown
      else
      begin
        I := System.Int32(V);
        ArgDesc.iArgType := TParamType(I);
      end;
      V := DataSet.FieldByName(DataTypeFieldName).Value;
      if VarIsNull(V) then
        ArgDesc.iDataType := ftUnknown
      else
        ArgDesc.iDataType := DataTypeMap[Integer(V)];
      V := DataSet.FieldByName(SubTypeFieldName).Value;
      if not VarIsNull(V) then
        if V = fldstFIXED then
          ArgDesc.iDataType := ftFixedChar;
      V := DataSet.FieldByName(PrecisionFieldName).Value;
      if VarIsNull(V) then
        ArgDesc.iUnits1 := 0
      else
        ArgDesc.iUnits1 := V;
      V := DataSet.FieldByName(ScaleFieldName).Value;
      if VarIsNull(V) then
        ArgDesc.iUnits2 := 0
      else
        ArgDesc.iUnits2 := V;
      V := DataSet.FieldByName(LengthFieldName).Value;
      if VarIsNull(V) then
        ArgDesc.iLen := 0
      else
        ArgDesc.iLen := V;
      V := DataSet.FieldByName(ParamNameFieldName).Value;
      if VarIsNull(V) then
        ArgDesc.szName := ResultParam
      else
        ArgDesc.szName := V;
      List.Add(ArgDesc);
      DataSet.next;
    end;
  finally
    FreeSchemaTable(DataSet);
  end;
end;

{ trace }

procedure TSQLConnection.SetTraceCallbackEvent(Event: TSQLCallbackEvent; IClientInfo: Integer);
begin
  FTraceCallbackEvent := Event;
  FTraceClientData := IClientInfo;
  if Connected and not (csLoading in ComponentState) then
    RegisterTraceCallBack(Assigned(Event) and (IClientInfo > 0));
end;

procedure TSQLConnection.RegisterTraceCallback(Value: Boolean);
begin
  if (Value) then
  begin
    if Assigned(FTraceCallbackEvent) and (FTraceClientData <> 0) then
    begin
      Check(ISQLConnection_SetOption(FISQLConnection,
           TSQLConnectionOption(eConnCallBack), FTraceCallbackEvent));
      SQLResources.AddCallback(FISQLConnection, FTraceCallbackEvent);
      Check(ISQLConnection_SetOption(FISQLConnection,
           TSQLConnectionOption(eConnCallBackInfo), FTraceClientData));
    end;
  end else
  begin
    if Assigned(FISQLConnection) then
    begin
      Check(ISQLConnection_SetOption(FISQLConnection,
            TSQLConnectionOption(eConnCallback), Integer(0)));
      SQLResources.RemoveCallback(FISQLConnection);
      Check(ISQLConnection_SetOption(FISQLConnection,
            TSQLConnectionOption(eConnCallBackInfo), Integer(0)));
    end;
  end;
end;

{ transaction support }

function TSQLConnection.GetInTransaction: Boolean;
begin
  Result := FTransactionCount > 0;
end;

procedure TSQLConnection.StartTransaction( TransDesc: TTransactionDesc);
var
  Status: SQLResult;
  Mem: IntPtr;
begin
  CheckConnection(eConnect);
  if Connected then
  begin
    if FTransactionsSupported then
    begin
      CheckActive;
      if (not InTransaction) or FSupportsMultiTrans then
      begin
        Mem := Marshal.AllocHGlobal(Marshal.SizeOf(TypeOf(TTransactionDesc)));
        try
          Marshal.StructureToPtr(TObject(TransDesc), Mem, False);
          Status := ISQLConnection_beginTransaction(FISQLConnection, Mem);
        finally
          Marshal.FreeHGlobal(Mem);
        end;
        if not ( Status in [DBXERR_NONE, DBXERR_NOTSUPPORTED] ) then
          Check(Status);
        Inc(FTransactionCount);
      end else
        DatabaseError(sActiveTrans, self)
    end;
  end else
    DatabaseError(SDatabaseClosed, Self);
end;

procedure TSQLConnection.Rollback( TransDesc: TTransactionDesc);
var
  Status: SQLResult;
  Mem: IntPtr;
begin
  if FTransactionsSupported then
  begin
    if InTransaction then
    begin
      if Assigned(FISQLConnection) then
      begin
        Mem := Marshal.AllocHGlobal(Marshal.SizeOf(TypeOf(TTransactionDesc)));
        try
          Marshal.StructureToPtr(TObject(TransDesc), Mem, False);
          Status := ISQLConnection_rollback(FISQLConnection, Mem);
        finally
          Marshal.FreeHGlobal(Mem);
        end;
        if not ( Status in [DBXERR_NONE, DBXERR_NOTSUPPORTED] ) then
          Check(Status);
        Dec(FTransactionCount);
      end
      else
        DatabaseError(SDatabaseClosed, Self);
    end else
      DatabaseError(sNoActiveTrans, self);
    CheckDisconnect;
  end;
end;

procedure TSQLConnection.Commit(TransDesc: TTransactionDesc);
var
  Status: SQLResult;
  Mem: IntPtr;
begin
  if FTransactionsSupported then
  begin
    if InTransaction then
    begin
      if Assigned(FISQLConnection) then
      begin
        Mem := Marshal.AllocHGlobal(Marshal.SizeOf(TypeOf(TTransactionDesc)));
        try
          Marshal.StructureToPtr(TObject(TransDesc), Mem, False);
          Status := ISQLConnection_Commit(FISQLConnection, Mem);
        finally
          Marshal.FreeHGlobal(Mem);
        end;
        if not ( Status in [DBXERR_NONE, DBXERR_NOTSUPPORTED] ) then
          Check(Status);
        Dec(FTransactionCount);
      end
      else
        DatabaseError(SDatabaseClosed, Self);
    end
    else
      DatabaseError(sNoActiveTrans, self);
    CheckDisconnect;
  end;
end;

function TSQLConnection.GetDataSet(Index: Integer): TCustomSQLDataSet;
begin
  Result := TCustomSQLDataSet(inherited GetDataSet(Index));
end;

{ misc. property set/get }

procedure TSQLConnection.SetDriverName(Value: string);

  procedure LoadDriverParams;
  var
    Index: Integer;
  begin
    FConnectionName := DriverName;
    LoadParamsFromIniFile(DriverRegistryFile);
    FConnectionName := '';
    Index := Params.IndexOfName(VENDORLIB_KEY);
    if Index <> -1 then
      Params.Delete(Index);
    Index := Params.IndexOfName(DLLLIB_KEY);
    if Index <> -1 then
      Params.Delete(Index);
    Index := Params.IndexOfName(GETDRIVERFUNC_KEY);
    if Index <> -1 then
      Params.Delete(Index);
  end;

begin
  if FDriverName <> Value then
  begin
    CheckInactive;
    if FConnectionName = '' then
    begin
      FVendorLib := '';
      FLibraryName := '';
      FGetDriverFunc := '';
      FParams.Clear;
    end;
    FDriverName := Value;
    if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
    begin
      FParams.Clear;
      FParamsLoaded := False;
      if FDriverName <> '' then
      begin
        try
          FVendorLib := Trim(GetProfileString(FDriverName, VENDORLIB_KEY, DriverRegistryFile));
          FLibraryName := Trim(GetProfileString(FDriverName, DLLLIB_KEY, DriverRegistryFile));
          FGetDriverFunc := Trim(GetProfileString(FDriverName, GETDRIVERFUNC_KEY, DriverRegistryFile));
          if FConnectionName = '' then
            LoadDriverParams;
        except
          DatabaseErrorFmt(SDriverNotInConfigFile, [Value, DriverRegistryFile]);
        end;
      end;
    end;
  end;
end;

function TSQLConnection.GetFDriverRegistryFile: string;
begin
  if FDriverRegistryFile = '' then
    FDriverRegistryFile := GetDriverRegistryFile(csDesigning in ComponentState);
  Result := FDriverRegistryFile;
end;

function TSQLConnection.GetConnectionName: string;
begin
  Result := FConnectionName;
end;

procedure TSQLConnection.SetConnectionName(Value: string);
var
  NewDriver: string;
begin
  if FConnectionName <> Value then
  begin
    FLastError := '';
    if not (csLoading in ComponentState) then
      if Connected then Connected := False;
    if (FDriverName = '') and (Value = '') then
    begin
      FVendorLib := '';
      FLibraryName := '';
      FParams.Clear;
    end;
    FParamsLoaded := False;
    FConnectionName := Value;
    if not (csLoading in ComponentState) then
      CloseDataSets;
    if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
    begin
      FParams.Clear;
      if Value <> '' then
      begin
        NewDriver := GetProfileString(FConnectionName, DRIVERNAME_KEY, ConnectionRegistryFile);
        if NewDriver <> DriverName then
          DriverName := NewDriver;
        LoadParamsFromIniFile;
      end;
    end;
  end;
end;

function TSQLConnection.GetVendorLib: string;
begin
  Result := FVendorLib;
  if (Result = '') and (FLoadParamsOnConnect or (csLoading in ComponentState)) then
    Result := Trim(GetProfileString(FDriverName, VENDORLIB_KEY, DriverRegistryFile));
end;

function TSQLConnection.GetLibraryName: string;
begin
  Result := FLibraryName;
  if (Result = '') and (FLoadParamsOnConnect or (csLoading in ComponentState)) then
    Result := Trim(GetProfileString(FDriverName, DLLLIB_KEY, DriverRegistryFile));
end;

procedure TSQLConnection.SetBoolParamOption(Key: string; Option:TSQLConnectionOption);
begin
  if FParams.Values[Key] <> '' then
  begin
    if UpperCase(Trim(FParams.Values[Key])) = 'TRUE' then
      ISQLConnection_SetOption(FISQLConnection, Option, LongInt(1))
    else
      ISQLConnection_SetOption(FISQLConnection, Option, LongInt(0));
  end;
end;

procedure TSQLConnection.SetConnectionParams;
var
  ServerCharSet, STransIsolationKey, ConnectionStr: string;
  ILevel: TTransIsolationLevel;
begin
  if FParams.Values[HOSTNAME_KEY] <> '' then
    ISQLConnection_SetOption(FISQLConnection, eConnHostName,
      Trim(FParams.Values[HOSTNAME_KEY]));
  if FParams.Values[ROLENAME_KEY] <> '' then
    ISQLConnection_SetOption(FISQLConnection, eConnRoleName,
      Trim(FParams.Values[ROLENAME_KEY]));
  SetBoolParamOption(WAITONLOCKS_KEY, eConnWaitOnLocks);
  SetBoolParamOption(COMMITRETAIN_KEY, eConnCommitRetain);
  SetBoolParamOption(AUTOCOMMIT_KEY, eConnAutoCommit);
  SetBoolParamOption(BLOCKINGMODE_KEY, eConnBlockingMode);
  ServerCharSet := Trim(FParams.Values[SQLSERVER_CHARSET_KEY]);
  if ServerCharSet <> '' then
    ISQLConnection_SetOption(FISQLConnection, eConnServerCharSet, ServerCharSet);
  ConnectionStr := Trim(FParams.Values[CONNECTION_STRING]);
  if ConnectionStr <> '' then
    ISQLConnection_SetOption(FISQLConnection, eConnConnectionString, ConnectionStr);

  FTransIsoLevel := xilReadCommitted;
  STransIsolationKey := Format(TRANSISOLATION_KEY, [DriverName]);
  if FParams.Values[STransIsolationKey] <> '' then
  begin
    if LowerCase(FParams.Values[STransIsolationKey]) = SRepeatRead then
      ILevel := xilRepeatableRead
    else if LowerCase(FParams.Values[STransIsolationKey]) = SDirtyRead then
      ILevel := xilDirtyRead
    else
      ILevel := xilReadCommitted;
    FTransIsoLevel := ILevel;
    ISQLConnection_SetOption(FISQLConnection, eConnTxnIsoLevel, LongInt(ILevel));
  end;
  if FParams.Values[SQLDIALECT_KEY] <> '' then
    ISQLConnection_SetOption(FISQLConnection, eConnSQLDialect,
      LongInt(StrToInt(trim(FParams.Values[SQLDIALECT_KEY]))));
  SetBoolParamOption(OSAUTHENTICATION, eConnOSAuthentication);
  if FParams.Values[SERVERPORT] <> '' then
    ISQLConnection_SetOption(FISQLConnection, eConnServerPort, Trim(FParams.Values[SERVERPORT]));
  SetBoolParamOption(MULTITRANSENABLED, eConnMultipleTransaction);
  SetBoolParamOption(TRIMCHAR, eConnTrimChar);

  if FParams.Values[CUSTOM_INFO] <> '' then
    ISQLConnection_SetOption(FISQLConnection, eConnCustomInfo, trim(FParams.Values[CUSTOM_INFO]));
  if FParams.Values[CONN_TIMEOUT] <> '' then
    ISQLConnection_SetOption(FISQLConnection, eConnTimeOut, LongInt(StrToInt(trim(FParams.Values[CONN_TIMEOUT]))));
end;

procedure TSQLConnection.LoadParamsFromIniFile(FFileName: string = '');
var
  IniFile: TMemIniFile;
  List: TStrings;
  FIniFileName: string;
begin
  if not FParamsLoaded then
  begin
    if FConnectionName = '' then
      DatabaseError(SConnectionNameMissing);
    List := TStringList.Create;
    try
      if FFileName = '' then
        FIniFileName := ConnectionRegistryFile
      else
        FIniFileName := FFileName;
      IniFile := TMemIniFile.Create(FIniFileName);
      try
        if FileExists(FIniFileName) then
        begin
          IniFile.ReadSectionValues(FConnectionName, List);
          Params.BeginUpdate;
          try
            Params.Clear;
            Params.AddStrings(List);
          finally
            Params.EndUpdate;
          end;
        end else
          DatabaseErrorFmt(sMissingDriverRegFile, [FIniFileName]);
      finally
        IniFile.Free;
      end;
    finally
      List.Free;
    end;
    FParamsLoaded := True;
  end;
end;

procedure TSQLConnection.SetLocaleCode(Value: TLocaleCode);
begin
  FParams.Values[SQLLOCALE_CODE_KEY] := IntToHex(Value, 4);
end;

function TSQLConnection.GetLocaleCode: TLocaleCode;
begin
  if FParams.Values[SQLLOCALE_CODE_KEY] <> '' then
    Result := StrToInt(HexDisplayPrefix + FParams.Values[SQLLOCALE_CODE_KEY])
  else
    Result := 0;
end;

procedure TSQLConnection.SetKeepConnection(Value: Boolean);
begin
  if FKeepConnection <> Value then
  begin
    FKeepConnection := Value;
    if not Value and (FRefCount = 0) then Close;
  end;
end;

procedure TSQLConnection.SetParams(Value: TStrings);
begin
  CheckInactive;
  FParams.Assign(Value);
end;

function TSQLConnection.Check(Status: SQLResult): SQLResult;
begin
  if Status <> 0 then SQLError(Status, exceptConnection);
  Result := Status;
end;

procedure TSQLConnection.Loaded;
begin
  inherited Loaded;
end;

procedure TSQLConnection.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
end;

{ TSQLDataLink }

constructor TSQLDataLink.Create(ADataSet: TCustomSQLDataSet);
begin
  inherited Create;
  FSQLDataSet := ADataSet;
end;

procedure TSQLDataLink.ActiveChanged;
begin
  if FSQLDataSet.Active then FSQLDataSet.RefreshParams;
end;

function TSQLDataLink.GetDetailDataSet: TDataSet;
begin
  Result := FSQLDataSet;
end;

procedure TSQLDataLink.RecordChanged(Field: TField);
begin
  if (Field = nil) and FSQLDataSet.Active then FSQLDataSet.RefreshParams;
end;

procedure TSQLDataLink.CheckBrowseMode;
begin
  if FSQLDataSet.Active then FSQLDataSet.CheckBrowseMode;
end;

{ TCustomSQLDataSet }

constructor TCustomSQLDataSet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FParams := TParams.Create(Self);
  FDataLink := TSQLDataLink.Create(Self);
  FIndexDefs := TIndexDefs.Create(Self);
  FCommandText := '';
  FParamCheck := True;
  FRecords := -1;
  FParamCount := -1;
  FSchemaInfo.FType := stNoSchema;
  FBufferList := TDBBufferList.Create;
  SetUniDirectional(True);
  ObjectView := False;
end;

destructor TCustomSQLDataSet.Destroy;
begin
  Close;
  if Assigned(FSQLCursor) then FreeCursor;
  if Assigned(FSQLCommand) then FreeStatement;
  FreeAndNil(FParams);
  FreeAndNil(FIndexDefs);
  FreeAndNil(FBufferList);
  SetConnection(nil);
  FreeProcParams(FProcParams);
  inherited Destroy;
  FDataLink.Free;
  FreeBuffers;
end;

{ connection management }

procedure TCustomSQLDataSet.CheckConnection(eFlag: eConnectFlag);
begin
  if (FSQLConnection <> nil) then
    FSQLConnection.CheckConnection(eFlag)
  else if (eFlag in [eConnect, eReconnect ]) then
    DatabaseError(SMissingSQLConnection);
end;

procedure TCustomSQLDataSet.SetConnection(const Value: TSQLConnection);
begin
  CheckInactive;
  if Assigned(FSQLConnection) then
    FSQLConnection.UnRegisterClient(Self);
  FSQLConnection := Value;
  if Assigned(FSQLConnection) then
  begin
    FSQLConnection.RegisterClient(Self,nil);
    if FMaxBlobSize = 0 then   // means it hasn't been changed
    begin
      if FSQLConnection.Params.Values[MAXBLOBSIZE_KEY] <> '' then
      try
        FMaxBlobSize := StrToInt(trim(FSQLConnection.Params.Values[MAXBLOBSIZE_KEY]));
      except
        FMaxBlobSize := DefaultMaxBlobSize;
      end else
        FMaxBlobSize := DefaultMaxBlobSize;
    end;
  end;
end;

function TCustomSQLDataSet.GetInternalConnection: TSQLConnection;
begin
  if Assigned(FClonedConnection) then
    Result := FClonedConnection
  else
    Result := FSQLConnection;
end;

{ Error Handling routine }
procedure TCustomSQLDataSet.SQLError(OpStatus: SQLResult; eType: TSQLExceptionType);
var
  dbxErrorMsg, ServerErrorMsg, ExceptionMessage: string;
  MessageBuf: StringBuilder;
  Status: SQLResult;
  MessageLen: SmallInt;
begin
  dbxErrorMsg := '';
  ServerErrorMsg := '';
  ExceptionMessage := '';
  Status := SQL_NULL_DATA;
  MessageBuf := nil;
  if (OpStatus > 0) and (OpStatus <=  DBX_MAXSTATICERRORS) then
  begin
    if OpStatus = 64 then dbxErrorMsg := Format(SDBXError, [SqlConst.SNODATA])
    else if OpStatus = 65 then dbxErrorMsg := Format(SDBXError, [SqlConst.SSQLERROR])
    else dbxErrorMsg := Format(SDBXError, [DbxError[OpStatus]]);
  end;
  case eType of
    exceptUseLast:
      Status := DBXERR_OUTOFRANGE;
    exceptCursor:
    begin
      Status := ISQLCursor_getErrorMessageLen(FSQLCursor, MessageLen);
      if (Status = DBXERR_NONE) and (MessageLen > 0) then
      begin
        MessageBuf := StringBuilder.Create(MessageLen + 1);
        Status := ISQLCursor_getErrorMessage(FSQLCursor, MessageBuf);
      end;
    end;
    exceptCommand:
    begin
      Status := ISQLCommand_getErrorMessageLen(FSQLCommand, MessageLen);
      if (Status = DBXERR_NONE) and (MessageLen > 0) then
      begin
        MessageBuf := StringBuilder.Create(MessageLen + 1);
        Status := ISQLCommand_getErrorMessage(FSQLCommand, MessageBuf);
      end;
    end;
  end;
  if Status = DBXERR_NONE then
    if MessageLen > 0 then
      ServerErrorMsg := Format(SSQLServerError, [MessageBuf.ToString]);
  if dbxErrorMsg.Length > 0 then
    ExceptionMessage := dbxErrorMsg;
  if ServerErrorMsg.Length > 0 then
  begin
    if ExceptionMessage.Length > 0 then
      ExceptionMessage := ExceptionMessage + #13 + #10;
    ExceptionMessage := ExceptionMessage + ServerErrorMsg;
  end;
  if (ExceptionMessage.Length = 0) and (LastError <> '') then
    ExceptionMessage := LastError;
  if ExceptionMessage.Length = 0 then
    ExceptionMessage :=  Format(SDBXUNKNOWNERROR, [intToStr(OpStatus)]);
  FLastError := ExceptionMessage;
  DatabaseError(ExceptionMessage);
end;

{ open/close Cursors and Statements }

procedure TCustomSQLDataSet.GetObjectTypeNames(Fields: TFields);
var
  Len: SmallInt;
  I, StructSize: Integer;
  TypeDesc: ObjTypeDesc;
  Mem: IntPtr;
  ObjectField: TObjectField;
begin
  for I := 0 to Fields.Count - 1 do
  begin
    if Fields[I] is TObjectField then
    begin
      ObjectField := TObjectField(Fields[I]);
      TypeDesc.iFldNum := ObjectField.FieldNo;
      StructSize := Marshal.SizeOf(TypeOf(ObjTypeDesc));
      Mem := Marshal.AllocHGlobal(StructSize);
      try
        Marshal.StructureToPtr(TObject(TypeDesc), Mem, False);
        if (ISQLCursor_getOption(FSQLCursor, eCurObjectTypeName, Mem,
          StructSize, Len) = DBXERR_NONE) then
        begin
          TypeDesc := ObjTypeDesc(Marshal.PtrToStructure(Mem, TypeOf(ObjTypeDesc)));
          ObjectField.ObjectType := TypeDesc.szTypeName;
        end;
      finally
        Marshal.FreeHGlobal(Mem);
      end;
      with ObjectField do
        if DataType in [ftADT, ftArray] then
        begin
          if (DataType = ftArray) and SparseArrays and
             (Fields[0].DataType = ftADT) then
            GetObjectTypeNames(TObjectField(Fields[0]).Fields) else
            GetObjectTypeNames(Fields);
        end;
    end;
  end;
end;

procedure TCustomSQLDataSet.InternalOpen;
begin
  ExecuteStatement;
  if not Assigned(FSQLCursor) then
  begin
    ISQLCommand_Close(FSQLCommand);
    SQLResources.RemoveCommand(FSQLCommand);
    FStatementOpen := False;
    DataBaseError(SNoCursor,Self);
  end;
  FieldDefs.Update;
  if DefaultFields then CreateFields;
  BindFields(True);
  if ObjectView then GetObjectTypeNames(Fields);
  InitBuffers;
end;

function TCustomSQLDataSet.IsCursorOpen: Boolean;
begin
  Result := (FSQLCursor <> nil);
end;

procedure TCustomSQLDataSet.OpenCursor(InfoQuery: Boolean);
begin
  if (SchemaInfo.FType = stNoSchema) and (FCommandText = '') then
    DatabaseError(SNoSQLStatement);
  CheckConnection(eConnect);
  SetPrepared(True);
  CheckPrepareError;
  if FDataLink.DataSource <> nil then
     SetParamsFromCursor;
  inherited OpenCursor;
end;

procedure TCustomSQLDataSet.CloseCursor;
begin
  inherited CloseCursor;
end;

procedure TCustomSQLDataSet.FreeCursor;
begin
  if Assigned(FSQLCursor) then
  begin
    ISQLCursor_release(FSQLCursor);
    FSQLCursor := nil;
    FStatementOpen := False;   // Releasing Cursor closes associated statement
  end;
end;

procedure TCustomSQLDataSet.FreeStatement;
begin
  if Assigned(FSQLCommand) then
  begin
    FreeCursor;
    CloseStatement;
    SQLResources.RemoveCommand(FSQLCommand);
    ISQLCommand_release(FSQLCommand);
    FSQLCommand := nil;
    if Assigned(FSQLConnection) and Assigned(FClonedConnection) then
      FreeAndNil(FClonedConnection);
    FPrepared := False;
    FParamCount := -1;

  end
  else if (FSchemaInfo.FType <> stNoSchema) and Assigned(FClonedConnection) then
    FreeAndNil(FClonedConnection);
  if Assigned(FieldDefs) then
    FieldDefs.Updated := False;
  ClearIndexDefs;
end;

procedure TCustomSQLDataSet.CloseStatement;
begin
  FParamCount := -1;
  if Assigned(FSQLCommand) and FStatementOpen then
  begin
    ISQLCommand_Close(FSQLCommand);
    SQLResources.RemoveCommand(FSQLCommand);
  end;
end;

procedure TCustomSQLDataSet.InternalClose;
var
  DetailList: TObjectList;
  I: Integer;
begin
  BindFields(False);
  if DefaultFields then DestroyFields;
  FreeBuffers;
  DetailList := TObjectList.Create;
  try
    GetDetailDataSets(DetailList);
    for I := 0 to DetailList.Count -1 do
    if DetailList[I] is TCustomSQLDataSet then
    begin
      TCustomSQLDataSet(DetailList[I]).Close;
      TCustomSQLDataSet(DetailList[I]).SetPrepared(False);
    end;
  finally
    DetailList.Free;
  end;
  if Assigned(FSQLConnection) and ((FSQLConnection.KeepConnection) or
     (FSQLConnection.DataSetCount > 1)) then
    FreeCursor
  else
    SetPrepared(False);
end;

procedure TCustomSQLDataSet.Loaded;
begin
  inherited Loaded;
end;

procedure TCustomSQLDataSet.InternalRefresh;
begin
  SetState(dsInactive);
  CloseCursor;
  OpenCursor(False);
  SetState(dsBrowse);
end;

procedure TCustomSQLDataSet.InitBuffers;
begin
  if (MaxBlobSize > 0) then
    SetLength(FBlobBuffer, MaxBlobSize * 1024);
  if (CalcFieldsSize > 0) then
    FCalcFieldsBuffer := FBufferList.AllocHGlobal(CalcFieldsSize);
end;

procedure TCustomSQLDataSet.ClearIndexDefs;
begin
  FIndexDefs.Clear;
  FIndexDefsLoaded := False;
end;

procedure TCustomSQLDataSet.FreeBuffers;
begin
  if FBlobBuffer <> nil then
    SetLength(FBlobBuffer, 0);
  if FCalcFieldsBuffer <> nil then
  begin
    FBufferList.FreeHGlobal(FCalcFieldsBuffer);
    FCalcFieldsBuffer := nil;
  end;
end;

procedure TCustomSQLDataSet.InitRecord(Buffer: TRecordBuffer);
begin
  { NOP }
end;

procedure TCustomSQLDataSet.SetBufListSize(Value: Integer);
begin
end;

{ Cursor Level Metadata }

procedure TCustomSQLDataSet.AddFieldDesc(FieldDescs: TFieldDescList; DescNo: Integer;
  var FieldID: Integer; RequiredFields: TBits; FieldDefs: TFieldDefs);
const
  ArrayIndex = '[0]';
var
  FType: TFieldType;
  FSize: LongWord;
  FRequired: Boolean;
  FPrecision, I: Integer;
  FieldName, FName: string;
  FieldDesc: FLDDesc;
  FldDef: TFieldDef;
begin
  FieldDesc := FieldDescs[DescNo];
  with FieldDesc do
  begin
    FieldName := szName;
    FName := FieldName;
    I := 0;
    while FieldDefs.IndexOf(FName) >= 0 do
    begin
      Inc(I);
      FName := Format('%s_%d', [FieldName, I]);
    end;
    if iFldType < MAXLOGFLDTYPES then
      FType := DataTypeMap[iFldType]
    else
      FType := ftUnknown;
    if iFldType in [fldFMTBCD, fldBCD] then
    begin
      iUnits2 := Abs(iUnits2);
      if iUnits1 < iUnits2 then   // iUnits1 indicates Oracle 'usable decimals'
        iUnits1 := iUnits2;
      // ftBCD supports only up to 18-4.  If Prec > 14 or Scale > 4, make FMTBcd
      if (iUnits1 > (MaxBcdPrecision-4)) or (iUnits2 > MaxBcdScale) or FNumericMapping then
      begin
        FType := ftFMTBcd;
        iFldType := fldFMTBCD;
        if (iUnits1 = 38) and (iUnits2 in [0,38]) then
        begin
          iUnits1 := 32;
          iUnits2 := 8;
        end;
        if iUnits1 > MaxFMTBcdDigits then
          iUnits1 := MaxFMTBcdDigits;
      end;
    end;
    FSize := 0;
    FPrecision := 0;
    if RequiredFields.Size > FieldID then
      FRequired := RequiredFields[FieldID] else
      FRequired := False;
    case iFldType of
      fldZSTRING, fldBYTES, fldVARBYTES, fldRef:
        begin
          if iUnits1 = 0 then { Ignore MLSLABEL field type on Oracle }
            FType := ftUnknown else
            FSize := iUnits1;
        end;
      fldINT16, fldUINT16:
        if iLen <> 2 then FType := ftUnknown;
      fldINT32:
        if iSubType = fldstAUTOINC then
        begin
          FType := ftAutoInc;
          FRequired := False;
        end;
      fldFLOAT:
        if iSubType = fldstMONEY then FType := ftCurrency;
      fldFMTBCD, fldBCD:
        begin
          FSize := Abs(iUnits2);
          FPrecision := iUnits1;
        end;
      fldADT, fldARRAY:
        begin
          FSize := iUnits2;
          FPrecision := iUnits1;
        end;
      fldBLOB:
        begin
          FSize := iUnits1;
          if (iSubType >= fldstMEMO) and (iSubType <= fldstBFILE) then
            FType := BlobTypeMap[iSubType];
        end;
    end;
    FldDef := FieldDefs.AddFieldDef;
    with FldDef do
    begin
      FieldNo := FieldID;
      Inc(FieldID);
      Name := FName;
      DataType := FType;
      Size := FSize;
      Precision := FPrecision;
      if FRequired then
        Attributes := [faRequired];
      if efldrRights = fldrREADONLY then
        Attributes := Attributes + [faReadonly];
      if iSubType = fldstFIXED then
        Attributes := Attributes + [faFixed];
      InternalCalcField := bCalcField;
      case FType of
        ftADT:
          begin
            if iSubType = fldstADTNestedTable then
              Attributes := Attributes + [faUnNamed];
            for I := 1 to iUnits1 do
            begin
              LoadFieldDef(Word(FieldNo + I), FieldDescs[1]);
              AddFieldDesc(FieldDescs, 1, FieldID, RequiredFields, ChildDefs);
            end;
          end;
        ftArray:
          begin
            for I := 1 to iUnits1 do
            begin
              LoadFieldDef(Word(FieldNo + I), FieldDescs[1]);
              FieldDescs[1].szName := Copy(FieldDesc.szName, 1, NAMEBUFLEN - Length(ArrayIndex)) + ArrayIndex;
              AddFieldDesc(FieldDescs, 1, FieldID, RequiredFields, ChildDefs);
            end;
          end;
      end;
    end;
  end;
end;

procedure TCustomSQLDataSet.LoadFieldDef(FieldID: Word; var FldDesc: FLDDesc);
var
  ReadOnly: LongBool;
  Temp: StringBuilder;
begin
  FldDesc.iFldNum := FieldID;
  Temp := StringBuilder.Create(NAMEBUFLEN);
  ISQLCursor_getColumnName(FSQLCursor, FieldId, Temp);
  FldDesc.szName := Temp.ToString;
  ISQLCursor_getColumnType(FSQLCursor, FieldId, FldDesc.iFldType, FldDesc.iSubtype);
  ISQLCursor_getColumnLength(FSQLCursor, FieldId, FldDesc.iLen);
  ISQLCursor_getColumnPrecision(FSQLCursor, FieldId, FldDesc.iUnits1);
  ISQLCursor_getColumnScale(FSQLCursor, FieldId, FldDesc.iUnits2);
  ISQLCursor_isReadOnly(FSQLCursor, FieldID, ReadOnly);
  if ReadOnly then
    FldDesc.efldrRights := fldrREADONLY;
end;

procedure TCustomSQLDataSet.InternalInitFieldDefs;
var
  FID: Integer;
  FieldDescs: TFieldDescList;
  RequiredFields: TBits;
  Nullable: LongBool;
  FldDescCount: Word;
begin
  if (FSQLCursor <> nil) then
  begin
    RequiredFields := TBits.Create;
    try
      ISQLCursor_getColumnCount(FSQLCursor, FldDescCount);
      SetLength(FieldDescs, FldDescCount);
      RequiredFields.Size := FldDescCount + 1;
      FieldDefs.Clear;
      FID := 1;
      FMaxColSize := FldDescCount;
      while FID <= FldDescCount do
      begin
        ISQLCursor_IsNullable(FSQLCursor, Word(FID), Nullable);
        RequiredFields[FID] := Nullable = False;
        LoadFieldDef(Word(FID), FieldDescs[0]);
        if (FieldDescs[0].iLen > FMaxColSize) and
           (FieldDescs[0].iFldType <> fldBLOB) then
          FMaxColSize := (FMaxColSize + FieldDescs[0].iLen);
        AddFieldDesc(FieldDescs, Integer(0), FID, RequiredFields, FieldDefs);
      end;
    finally
      RequiredFields.Free;
    end;
  end
  else
     DatabaseError(SDataSetClosed, self);
end;

{ Field and Record Access }

procedure NormalizeBcdData(BcdData: IntPtr; Precision, Scale: Word);
var
  LBcd: TBcd;
  ByteBuffer: TBytes;
begin
  if Assigned(BcdData) then
  begin
    if Precision > MaxFMTBcdDigits then Precision := MaxFMTBcdDigits;
    SetLength(ByteBuffer, SizeOfTBCD);
    Marshal.Copy(BcdData, ByteBuffer, 0, SizeOfTBcd);
    LBcd := TBcd.FromBytes(ByteBuffer);
    if (LBcd.SignSpecialPlaces = 38) and ((Scale and 63)in [38,0]) then
    begin
      if (Scale and (1 shl 7)) <> 0 then
        LBcd := LBcd.Normalize(MaxFMTBcdDigits, Word((DefaultFMTBcdScale and 63) or (1 shl 7)))
      else
        LBcd := LBcd.Normalize(MaxFMTBcdDigits, DefaultFMTBcdScale);
    end else
      LBcd := LBcd.Normalize(Precision, Scale);
    ByteBuffer := TBcd.ToBytes(LBcd);
    Marshal.Copy(ByteBuffer, 0, BcdData, SizeOfTBcd);
  end;
end;

function TCustomSQLDataSet.GetFieldData(FieldNo: Integer; Buffer: TValueBuffer): Boolean;
var
  FldType, Subtype: Word;
  Status: SQLResult;
  FBlank: LongBool;
  Field: TField;
  Precision, Scale: Word;
begin
  if (FSQLCursor = nil) then
    DatabaseError(SDataSetClosed, self);

  (* Part #1 fix for 157041. Calc fields on first record. See also Part #2.

  {When EOF is True we should not be calling into the driver to get Data}
  if EOF = True then
  begin
    Result := False;
    Exit;
  end;
  *)

  FBlank := True;
  Status := ISQLCursor_getColumnType(FSQLCursor, FieldNo, FldType, SubType);
  if (Status = 0) then
  begin
    case FldType of
      fldZSTRING:
        Status := ISQLCursor_GetString(FSQLCursor, FieldNo, Buffer, FBlank);
      fldINT16, fldUINT16:
        Status := ISQLCursor_GetShort(FSQLCursor, FieldNo, Buffer, FBlank);
      fldINT32, fldUINT32:
        Status := ISQLCursor_GetLong(FSQLCursor, FieldNo, Buffer, FBlank);
      fldFLOAT:
        Status := ISQLCursor_GetDouble(FSQLCursor, FieldNo, Buffer, FBlank);
      fldFMTBCD, fldBCD:
        begin
          Status := ISQLCursor_GetBcd(FSQLCursor, FieldNo, Buffer, FBlank);
          Field := FieldByNumber(FieldNo);
          if (not FBlank) and (Status = DBXERR_NONE) and (Field <> nil) then
          begin
            if Field is TBcdField then
            begin
              Precision := TBcdField(Field).Precision;
              Scale := TBcdField(Field).Size;
            end else if Field is TFMTBcdField then
            begin
              Precision := TFMTBcdField(Field).Precision;
              Scale := TFMTBcdField(Field).Size;
            end else
              DatabaseErrorFmt(SBadFieldType, [Field.FieldName]);
            NormalizeBcdData(Buffer, Precision, Scale);
          end;
        end;
      fldDATE:
        Status := ISQLCursor_GetDate(FSQLCursor, FieldNo, Buffer, FBlank);
      fldTIME:
        Status := ISQLCursor_GetTime(FSQLCursor, FieldNo, Buffer, FBlank);
      fldDATETIME:
        Status := ISQLCursor_GetTimeStamp(FSQLCursor, FieldNo, Buffer, FBlank);
      fldBOOL:
        Status := ISQLCursor_GetShort(FSQLCursor, FieldNo, Buffer, FBlank);
      fldBYTES, fldVARBYTES:
        Status := ISQLCursor_GetBytes(FSQLCursor, FieldNo, Buffer, FBlank);
      fldBLOB:
        begin
          GetBlobSize(Self, FieldNo);
          if CurrentBlobSize = 0 then
            FBlank := True
          else
            Status := ISQLCursor_GetBlob(FSQLCursor, FieldNo, Buffer, FBlank, CurrentBlobSize);
        end;
    end;
  end;
  Check(Status, exceptCursor);
  Result := not FBlank;
end;

function TCustomSQLDataSet.GetFieldData(Field: TField; Buffer: TValueBuffer): Boolean;
var
   FieldNo: Word;
   TempBuffer: TValueBuffer;
   ThisBuffer: TValueBuffer;
   BlobSize: LongWord;
   BlobNull: LongBool;
begin
  if not Self.Active then
    DataBaseError(SDatasetClosed);
  FieldNo := Field.FieldNo;
  if not Assigned(Buffer) then
  begin
    if Field.IsBlob then
    begin
      if EOF then
        BlobNull := True
      else
        ISQLCursor_GetBlobSize(FSQLCursor, Word(FieldNo), BlobSize, BlobNull);
      Result := not Boolean(BlobNull);
      Exit;
    end
    else if Field.Size > Field.DataSize then
      TempBuffer := Marshal.AllocHGlobal(Field.Size)
    else
      TempBuffer := Marshal.AllocHGlobal(Field.DataSize);
    ThisBuffer := TempBuffer;
  end else
  begin
    ThisBuffer := Buffer;
    TempBuffer := nil;
  end;
  try
    if Field.FieldNo < 1 then
      Result := GetCalculatedField(Field, ThisBuffer)
    else
      Result := GetFieldData(FieldNo, ThisBuffer);
  finally
    if Assigned(TempBuffer) then
      Marshal.FreeHGlobal(TempBuffer);
  end;
end;

procedure TCustomSQLDataSet.SetCurrentBlobSize(Value: LongWord);
begin
  FCurrentBlobSize := Value;
  SetLength(FBlobBuffer, FCurrentBlobSize);
end;

function TCustomSQLDataSet.GetBlobFieldData(FieldNo: Integer; var Buffer: TBlobByteData): Integer;
var
  IsNull: LongBool;
  FldType, SubType: Word;
  Mem: IntPtr;
begin
  Result := 0;
  GetBlobSize(Self, FieldNo);
  if (FSQLCursor = nil) then
    DatabaseError(SDataSetClosed, self);
  if FCurrentBlobSize > 0 then
  begin
    Check(ISQLCursor_getColumnType(FSQLCursor, LongWord(FieldNo), FldType, SubType), exceptCursor);
    if FCurrentBlobSize = 0 then
      Result := 0
    else
    begin
      Mem := Marshal.AllocHGlobal(CurrentBlobSize);
      try
        Check(ISQLCursor_GetBlob(FSQLCursor, LongWord(FieldNo), Mem, IsNull, FCurrentBlobSize), exceptCursor);
        if not IsNull then
        begin
          if LongWord(Length(Buffer)) < CurrentBlobSize then
            SetLength(Buffer, CurrentBlobSize);
          Marshal.Copy(Mem, Buffer, 0, CurrentBlobSize);
        end;
      finally
        Marshal.FreeHGlobal(Mem);
      end;
    end;
  end;
  if not IsNull then Result := CurrentBlobSize;
end;

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

procedure TCustomSQLDataSet.SetFieldData(Field: TField; Buffer: TValueBuffer);
var
  RecBuf: TRecordBuffer;
  I: Integer;
begin
  RecBuf := FCalcFieldsBuffer;
  with Field do
  begin
    if FieldNo < 1 then   //{fkCalculated}
    begin
      RecBuf := TRecordBuffer(Integer(RecBuf) + Offset);
      if Assigned(Buffer) then
      begin
        Marshal.WriteByte(RecBuf, 1);
        for I := 1 to DataSize do
          Marshal.WriteByte(RecBuf, I, Marshal.ReadByte(Buffer, I - 1));
      end else
        Marshal.WriteByte(RecBuf, 0);
    end;
  end;
end;

function TCustomSQLDataSet.GetCalculatedField(Field: TField; var Buffer: TValueBuffer): Boolean;
var
  RecBuf: TValueBuffer;
  I: Integer;
begin
  Result := False;
  RecBuf := FCalcFieldsBuffer;
  with Field do
  begin
    if FieldNo < 1 then   //{fkCalculated}
    begin
      RecBuf := TRecordBuffer(Integer(RecBuf) + Offset);
      if Marshal.ReadByte(RecBuf) <> 0 then
      begin
        for I := 1 to DataSize do
          Marshal.WriteByte(Buffer, I - 1, Marshal.ReadByte(RecBuf, I));
        Result := True;
      end;
    end;
  end;
end;

function TCustomSQLDataSet.GetCanModify: Boolean;
begin
  Result := False;
end;

function TCustomSQLDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
var
  Status: SQLResult;
begin
  Status := ISQLCursor_next(FSQLCursor);
  if (not (Status in [DBXERR_NONE, SQL_NULL_DATA, DBXERR_EOF])) then
     Check(Status, exceptCursor);
  if Status = DBXERR_NONE then
  begin
    GetCalcFields(FCalcFieldsBuffer);
    Result := grOK
  end
  else
    Result := grEOF;
end;

{ CommandText Management }

procedure TCustomSQLDataSet.SetFCommandText(const Value: string);
begin
  CheckInactive;
  FCommandText := Value;
  FNativeCommand := '';
end;

procedure TCustomSQLDataSet.SetCommandText(const Value: string);
var
  HasDataLink: Boolean;
  DataSet: TDataSet;
begin
  if FCommandText <> Value then
  begin
    CheckInactive;
    PropertyChanged;
    FCommandText := TrimLeft(Value);
    if (SQLConnection <> nil) and (Value <> '') then
    begin
      if FParamCheck and (FCommandType <> ctTable) then
      begin
        HasDataLink := (FDataLink.DataSource <> nil) and (FDataLink.DataSource.DataSet is TCustomSQLDataSet);
        if HasDataLink then
          DataSet := FDataLink.DataSource.DataSet
        else
          DataSet := nil;
        SetParamsFromSQL(DataSet, not HasDataLink);
      end;
    end;
    DataEvent(dePropertyChange, nil);
  end;
end;

function TCustomSQLDataSet.GetDataSetFromSQL(TableName: string): TCustomSQLDataSet;
var
  Q: string;
begin
  if TableName = '' then
    TableName := GetTableNameFromSQL(SSelectStarFrom +
              Copy(CommandText, 8, Length(CommandText) - 7));
  if TableName = '' then
    Result := nil
  else
  begin
    Result := TCustomSQLDataSet.Create(nil);
    try
      Result.SetConnection(Self.SQLConnection);
      Q := Self.FSqlConnection.GetQuoteChar;
      Result.CommandText := SSelectStarFrom +
                  Q + TableName + Q +
                  SWhere + ' 0 = 1';    // only metadata is needed
      Result.Active := True;
    except
      FreeAndNil(Result);
    end;
  end;
end;

{ Parameters }

function TCustomSQLDataSet.GetProcParams: TList;
begin
  if (Self.FSQLConnection.Connected) and not Assigned(FProcParams) then
  begin
    FProcParams := TList.Create;
    FSQLConnection.GetProcedureParams(CommandText, FSchemaInfo.PackageName, FSchemaName, FProcParams);
  end;
  Result := FProcParams;
end;

procedure TCustomSQLDataSet.SetParamsFromProcedure;
var
  List: TParams;
begin
  List := TParams.Create;
  try
    try
      { Preserve existing values }
      List.AssignValues(Params);
      if Assigned(FProcParams) then
        FreeProcParams(FProcParams);
      ProcParams := TList.Create;
      FSQLConnection.GetProcedureParams(CommandText, FSchemaInfo.PackageName, FSchemaName, ProcParams);
      LoadParamListItems(List, FProcParams);
    except
      FreeProcParams(FProcParams);
    end;
    if List.Count > 0 then
      Params.Assign(List);
  finally
    List.Free;
  end;
end;

procedure TCustomSQLDataSet.SetParamsFromSQL(DataSet: TDataSet; bFromFields: Boolean);
var
  Field: TField;
  I: Integer;
  List: TSQLParams;
  WasDatasetActive: Boolean;
  FTblName: string;
  DSCreated: Boolean;
begin
  DSCreated := False;
  FNativeCommand := Copy(CommandText, 1, Length(CommandText));
  if (CommandType = ctStoredProc) then
  begin
    SetParamsFromProcedure;
    Exit;
  end;
  List := TSQLParams.Create(Self);
  try                                              // DBExpress only supports '?', so
    FTblName := List.Parse(FNativeCommand, True);  // save query to avoid
    { Preserve existing values }                   // parsing again with prepare
    List.AssignValues(Params);
    if (Assigned(SQLConnection)) and (List.Count > 0) then
      begin
        WasDataSetActive := True;
        if DataSet = nil then
        begin
          if FTblName <> '' then
          begin
            if csDesigning in ComponentState then
            begin
              DataSet := GetDataSetFromSQL(FTblName);
              if Assigned(DataSet) then
                DSCreated := True;
            end;
          end;
        end else begin
          WasDataSetActive := DataSet.Active;
          if not DataSet.Active then DataSet.Active := True;
        end;
        for I := 0 to List.Count - 1 do
          List[I].ParamType := ptInput;
        if (DataSet <> nil) and
              ((not List.BindAllFields) or
              (List.Count = DataSet.FieldCount)) then
          try
            for I := 0 to List.Count - 1 do
            begin
              if List.BindAllFields then
                Field := DataSet.Fields[I]
              else if List.FFieldName.Count > I then
              begin
                if (bFromFields) then
                  Field := DataSet.FieldByName(List.GetFieldName(I))
                else
                  Field := DataSet.FieldByName(List[I].Name);
              end else
                 Field := nil;
              if Assigned(Field) then
              begin
                if Field.DataType <> ftString then
                  List[I].DataType := Field.DataType
                else if TStringField(Field).FixedChar then
                  List[I].DataType := ftFixedChar
                else
                  List[I].DataType := ftString;
              end;
            end;
          except
            // ignore exception: Column type won't be provided
          end;
        if List.Count > 0 then
          Params.Assign(List);
        if Assigned(DataSet) and (not WasDataSetActive) then DataSet.Active := False;
      end
    else
      Params.clear;
  finally
    List.Free;
    if DSCreated then DataSet.Free;
  end;
end;

procedure TCustomSQLDataSet.RefreshParams;
var
  DataSet: TDataSet;
begin
  DisableControls;
  try
    if FDataLink.DataSource <> nil then
    begin
      DataSet := FDataLink.DataSource.DataSet;
      if DataSet <> nil then
        if DataSet.Active and (DataSet.State <> dsSetKey) then
        begin
          Close;
          Open;
        end;
    end;
  finally
    EnableControls;
  end;
end;

procedure TCustomSQLDataSet.SetParamsFromCursor;
var
  I: Integer;
  DataSet: TDataSet;
begin
  if (FDataLink.DataSource <> nil) and (FParams.Count > 0) then
  begin
    DataSet := FDataLink.DataSource.DataSet;
    (*Part #2 fix for 157041. Calling into GetFieldData in MySQL
      with the DataSet being EOF will fail with an invalid handle. *)
    if (DataSet <> nil) and not (DataSet.Eof) then
    begin
      for I := 0 to FParams.Count - 1 do
        with FParams[I] do
          if not Bound then
          begin
            AssignField(DataSet.FieldByName(Name));
            Bound := False;
          end;
    end;
  end;
end;

function TCustomSQLDataSet.ParamByName(const Value: string): TParam;
begin
  Result := FParams.ParamByName(Value);
end;

procedure TCustomSQLDataSet.GetOutputParams(AProcParams: TList);
var
  I: Integer;
  RecBuffer: TRecordBuffer;
  ArgDesc: SPParamDesc;
  IsNull: Integer;
begin
  for I := 0 to Params.Count - 1 do
  begin
    isNull := 0;
    ArgDesc := (SPParamDesc(AProcParams.Items[I]));
    if (Params[I].ParamType in [ptOutput, ptResult, ptInputOutput]) and
       (ArgDesc.iDataType <> ftCursor) then
    begin
      RecBuffer := Marshal.AllocHGlobal(Params[I].Size + 1);
      try
        Check(ISQLCommand_getParameter(FSQLCommand, i+1, 0, RecBuffer,
          Params[I].Size, IsNull), exceptCommand);
        if IsNull = 1 then
          Params[I].Value := Null
        else
          Params[I].SetData(RecBuffer);
      finally
        Marshal.FreeHGlobal(RecBuffer);
      end;
    end;
  end;
end;

procedure TCustomSQLDataSet.SetParameters(const Value: TParams);
begin
  FParams.AssignValues(Value);
end;

{ Query Management }

procedure TCustomSQLDataSet.SetPrepared(Value: Boolean);
begin
  if Value then CheckConnection(eConnect);
  if FGetNextRecordSet then
    FPrepared := Value
  else
    FreeCursor;
  if SchemaInfo.FType <> stNoSchema then
  begin
    if Value then
      CheckStatement(True)
    else
      FreeStatement;
  end else if Value <> Prepared then
  begin
    try
      if Value then
        begin
          if FSQLCommand <> nil then DatabaseError(SSQLDataSetOpen, Self);
          FRowsAffected := -1;
          FCheckRowsAffected := True;
          PrepareStatement;
        end
      else
        begin
          if FCheckRowsAffected then
            FRowsAffected := RowsAffected;
          FreeStatement;
          if Assigned(FSQLConnection) then
            FSQLConnection.CheckDisconnect;
        end;
      FPrepared := Value;
    except
      if Assigned(FSQLCommand) then
        FreeStatement;
      FPrepared := False;
    end;
  end;
end;

procedure TCustomSQLDataSet.CheckStatement(ForSchema: Boolean = False);
var
  Connection: TSqlConnection;
  RowsetSize: Integer;
begin
  FLastError := '';
  RowsetSize := defaultRowsetSize;
  if not Assigned(FSQLConnection) then
    DatabaseError(SMissingSQLConnection);
  Connection := FSQLConnection.GetConnectionForStatement;
  if Connection.FIsCloned then
    FClonedConnection := Connection;
  if Connection.LoadParamsOnConnect then
    Connection.LoadParamsFromIniFile;
  if Assigned(FSQLCommand) then
    FreeStatement;
  if not Assigned(Connection.Connection) then
    DatabaseError(SdatabaseOpen, Self);
  if not ForSchema then
  begin
    if Length(FCommandText) = 0 then
      DatabaseError(SEmptySQLStatement, Self);
    Check(ISQLConnection_getSQLCommand(Connection.Connection, FSQLCommand), exceptCommand);

    if FSQLConnection.Params.Values[ROWSETSIZE_KEY] <> '' then
    try
      RowsetSize := StrToInt(trim(FSQLConnection.Params.Values[ROWSETSIZE_KEY]));
    except
      RowsetSize := defaultRowsetSize;
    end;

    ISQLCommand_setOption(FSQLCommand, eCommRowsetSize, RowsetSize);

    FStatementOpen := True;
    if FTransactionLevel > 0 then
      ISQLCommand_SetOption(FSQLCommand, eCommTransactionID, Integer(FTransactionLevel));
    if FNativeCommand = '' then
    begin
      if FParams.Count > 0 then
        FNativeCommand := FixParams(CommandText, FParams.Count, Connection.GetQuoteChar)
      else
        FNativeCommand := CommandText;
    end;
  end;
end;

function TCustomSQLDataSet.GetQueryFromType: string;
var
  STableName, SDot : string;
  SB: StringBuilder;
begin
  SDot := '.';
  SB := StringBuilder.Create(2 * Length(FCommandText));
  case CommandType of
     ctTable:
       begin
         if Self.FSchemaName <> '' then
         begin
           SB.Append(FSchemaName);
           SB.Append(SDot);
           if (FSortFieldNames <> '') or (FNativeCommand = '') then
             SB.Append(FCommandText)
           else
             SB.Append(FNativeCommand);
           STableName := AddQuoteCharToObjectName(Self, SB.ToString, FSQLConnection.QuoteChar)
         end else
           STableName := AddQuoteCharToObjectName(Self, FCommandText, FSQLConnection.QuoteChar);
         if FSortFieldNames <> '' then
         begin
           SB.Remove(0, SB.Length);  // clear the stringbuilder
           SB.Append(SSelectStarFrom);
           SB.Append(STableName);
           SB.Append(SOrderBy);
           SB.Append(FSortFieldNames);
           Result := SB.ToString;
         end else
           Result := SSelectStarFrom + STableName
       end;
     ctStoredProc:
       begin
         if FSchemaName <> '' then
         begin
           SB.Append(FSchemaName);
           SB.Append(SDot);
         end;
         SB.Append(FCommandText);
         Result := SB.ToString;
       end;
     else
       SB.Append(FNativeCommand);
       if (FSortFieldNames > '') and (Pos(SOrderBy, LowerCase(FCommandText)) = 0) then
       begin
         SB.Append(SOrderBy);
         SB.Append(FSortFieldNames);
       end;
       Result := SB.ToString;
  end;
end;

function TCustomSQLDataSet.CheckDetail(const SQL: string): string;
begin
  if (pos(SParam, SQL) = 0) and (pos(SSelect, LowerCase(SQL)) > 0) then // Select Query with no ?, but Parameters are set
    Result := AddParamSQLForDetail(Params, SQL, True)
  else
    Result := SQL;
end;

procedure TCustomSQLDataSet.PrepareStatement;
var
  SQLText, Value: string;
  CurSection : TSqlToken;
  Start: integer;
begin
  if Length(CommandText) = 0 then
    DatabaseError(SEmptySQLStatement, Self);
  Start := 1;
  CurSection := NextSQLToken(CommandText, Start , Value, CurSection);
  if CurSection = stSelect then
    Inc(FSQLConnection.FActiveStatements);
  CheckStatement;
  SQLText := GetQueryFromType;
  Start := 1;
  CurSection := NextSQLToken(SQLText , Start , Value, CurSection);
  if CurSection = stSelect then
    Inc(FSQLConnection.FActiveStatements);
  if Params.Count > 0 then
    SQLText := CheckDetail(SQLText);
  if CommandType = ctStoredProc then
    Check(ISQLCommand_SetOption(FSQLCommand, eCommStoredProc, Integer(True)), exceptCommand)
  else
    Check(ISQLCommand_SetOption(FSQLCommand, eCommStoredProc, Integer(False)), exceptCommand);
  Check(ISQLCommand_prepare(FSQLCommand, SQLText, ParamCount), exceptCommand);
  SQLResources.AddCommand(FSQLCommand);
end;

procedure TCustomSQLDataSet.CheckPrepareError;
begin
  if (FSQLCommand = nil) and (SchemaInfo.FType = stNoSchema) then
  begin     // prepare has failed
    if FLastError <> '' then
      SQLError(0, exceptUseLast)
    else if (CommandType = ctQuery) or (SortFieldNames <> '') then
      DatabaseError(sPrepareError)
    else
      DatabaseError(sObjectNameError);
  end;
end;

function TCustomSQLDataSet.InternalExecSQL(ExecDirect: Boolean = False): Integer;
begin
  CheckInActive;
  CheckConnection(eConnect);
  try
    FRowsAffected := 0;
    if not ExecDirect then
    begin
      SetPrepared(True);
      CheckPrepareError;
      ExecuteStatement;
    end else
    begin
      CheckStatement;
      Check(ISQLCommand_executeImmediate(FSQLCommand, CommandText, FSQLCursor), exceptCommand);
    end;
    if FSQLCursor <> nil then
       SetParamsFromCursor;
    Result := RowsAffected;
  finally
    if Assigned(FSQLCursor) then
    begin
      FreeCursor;
      FreeStatement;
    end else if ExecDirect then
      FreeStatement
    else
      CloseStatement;
  end;
end;

procedure TCustomSQLDataSet.ExecuteStatement;
var
  Status: SQLResult;
begin
  if SchemaInfo.FType = stNoSchema then
  begin
    if Assigned(FParams) and not FGetNextRecordSet then
    begin
      if CommandType = ctStoredProc then
        SetProcedureParams(Self.FSQLConnection, FSQLCommand, Params, ProcParams)
      else
      if (FParams.Count > 0) then
        SetQueryParams(Self.FSQLConnection, FSQLCommand, Params);
    end;
    if FGetNextRecordSet then
    begin
      Status := ISQLCommand_getNextCursor(FSQLCommand, FSQLCursor);
      if not (Status in [DBXERR_NONE, SQL_NULL_DATA]) then
        Check(Status, exceptCommand);
      if Status <> DBXERR_NONE then
        Active := False
      else if Params.Count > 0 then
        GetOutputParams(FProcParams);
    end else
    begin
      Check(ISQLCommand_execute(FSQLCommand, FSQLCursor), exceptCommand);
      if (CommandType = ctStoredProc) and (Params.Count > 0) then
        GetOutputParams(FProcParams);
    end;
  end
  else
    OpenSchema;
  FStatementOpen := True;
  FRecords := -1;
end;

function TCustomSQLDataSet.GetObjectProcParamCount: Integer;
var
  I, LastParamNum: Integer;
  ArgDesc: SPParamDesc;
begin
  GetProcParams;    // make sure FProcParams is loaded.
  Result := 0;
  LastParamNum := 0;
  for I := 0 to Params.Count -1 do
  begin
    ArgDesc := (SPParamDesc(ProcParams.Items[I]));
    if ArgDesc.iParamNum <> LastParamNum then Inc(Result);
    LastParamNum := ArgDesc.iParamNum;
  end;
end;

function TCustomSQLDataSet.GetParamCount: Integer;
var
  I : Integer;
begin
  Result := FParamCount;
  if Result = -1 then
  begin
    Result := 0;
    if Assigned(FParams) then
    begin
      if FCommandType = ctStoredProc then
      begin
        for I := 0 to Params.Count -1 do
        begin
          if Params.Items[I].DataType in [ftADT, ftARRAY] then
          begin
            Result := GetObjectProcParamCount;
            break;
          end;
        end;
      end;
      if Result = 0 then Result := FParams.Count
    end;
  end;
end;

function GetRows(Query: string; Connection: TSQLConnection): Integer;
var
  DS: TSQLDataSet;
begin
  Result := -1;
  DS := TSQLDataSet.Create(nil);
  try
    DS.SQLConnection := Connection;
    DS.CommandText := Query;
    DS.Active := True;
    if not DS.EOF then
      Result := DS.Fields[0].AsInteger;
  finally
    if Result = -1 then
      DatabaseError(SNotSupported);
    DS.Free;
  end;
end;

const
  SDistinct = ' distinct ';                 { do not localize }
  SSelectCount = 'select count(*) from ';   { do not localize }

function TCustomSQLDataSet.GetRecordCount: Integer;
var
  TableName, Query: string;
  HoldPos: Integer;
  Status : SQLResult;
  buf : IntPtr;
  Len : smallint;
begin
  if FRecords <> -1 then
    Result := FRecords
  else
  begin
    CheckConnection(eConnect);
    if Self.CommandText = '' then
      DatabaseError(SNoSQLStatement);
    case CommandType of
      ctStoredProc:
        DatabaseError(SNotSupported);
      ctTable:
        begin
          Query := 'select count(*) from ' + GetQuoteChar + FCommandText + GetQuoteChar;
          Status := ISQLConnection_setOption(GetInternalConnection.FISQLConnection,
            eConnQualifiedName, CommandText);
          if Status <> 0 then
            SQLError(Status, exceptConnection);
          buf := Marshal.AllocHGlobal(256);
          try
            InitializeBuffer(buf, 256, 0);
            Status := ISQLConnection_getOption(GetInternalConnection.FISQLConnection,
              eConnQuotedObjectName, buf, 256, Len);
            if Status <> 0 then
              SQLError(Status, exceptConnection);
            Query := SSelectCount + Marshal.PtrToStringAnsi(buf);
          finally
            Marshal.FreeHGlobal(buf);
          end;
        end;
      ctQuery:
        begin
          TableName := GetTableNameFromSQL(FCommandText);
          if (TableName = '') or (Params.Count > 0) then
            DatabaseError(SNotSupported);
          if Pos(SDistinct, LowerCase(FCommandText)) = 0 then
            Query := SSelectCount
          else
            DatabaseError(SNotSupported);
          HoldPos := Pos(SWhere, LowerCase(FCommandText));
          if HoldPos = 0 then
            Query := Query + GetQuoteChar + TableName + GetQuoteChar
          else begin
            Query := Query + GetQuoteChar + TableName + GetQuoteChar + copy(FCommandText, HoldPos, Length(FCommandText) - (HoldPos-1));
            HoldPos := Pos(sOrderBy, LowerCase(Query));
            if HoldPos > 0 then
              Query := copy(Query, 1, HoldPos - 1);
          end;
        end;
    end;
    FRecords := GetRows(Query, FSQLConnection);
    Result := FRecords;
  end;
end;

function TCustomSQLDataSet.GetRowsAffected: Integer;
var
  UpdateCount: LongWord;
begin
  if FRowsAffected > 0 then
    Result := Integer(FRowsAffected)
  else
    begin
      if FSQLCommand <> nil then
        Check(ISQLCommand_getRowsAffected(FSQLCommand, UpdateCount), exceptCommand)
      else
        UpdateCount := 0;
      FRowsAffected := Integer(UpdateCount);
      Result := Integer(UpdateCount);
    end;
end;

{ Misc. Set/Get Property }

procedure TCustomSQLDataSet.SetDataSource(Value: TDataSource);
begin
  if IsLinkedTo(Value) then DatabaseError(SCircularDataLink, Self);
  if FDataLink.DataSource <> Value then
    FDataLink.DataSource := Value;
end;

function TCustomSQLDataSet.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TCustomSQLDataSet.GetDetailLinkFields(MasterFields, DetailFields: TObjectList);

  function AddFieldToList(const FieldName: string; DataSet: TDataSet;
    List: TList): Boolean;
  var
    Field: TField;
  begin
    Field := DataSet.FindField(FieldName);
    if Field <> nil then
      List.Add(Field);
    Result := Field <> nil;
  end;

var
  I: Integer;
begin
  MasterFields.Clear;
  DetailFields.Clear;
  if (DataSource <> nil) and (DataSource.DataSet <> nil) then
    for I := 0 to Params.Count - 1 do
      if AddFieldToList(Params[I].Name, DataSource.DataSet, MasterFields) then
        AddFieldToList(Params[I].Name, Self, DetailFields);
end;

function TCustomSQLDataSet.GetSortFieldNames: string;
begin
  Result := FSortFieldNames;
end;

procedure TCustomSQLDataSet.SetSortFieldNames(Value: string);
begin
  FSortFieldNames := Value;
end;

procedure TCustomSQLDataSet.SetMaxBlobSize(MaxSize: Integer);
begin
  FMaxBlobSize := MaxSize;
  if (FSQLCommand <> nil) then
    ISQLCommand_SetOption(FSQLCommand, eCommBlobSize, MaxSize);
end;

procedure TCustomSQLDataSet.SetCommandType(const Value: TSQLCommandType);
begin
  if FCommandType <> Value then
  begin
    CheckInactive;
    FCommandType := Value;
    PropertyChanged;
    DataEvent(dePropertyChange, nil);
  end;
end;

procedure TCustomSQLDataSet.PropertyChanged;
begin
  if not (csLoading in ComponentState) then
  begin
    SetPrepared(False);
    FNativeCommand := '';
    FRecords := -1;
    FreeStatement;
    if SortFieldNames <> '' then
      FSortFieldNames := '';
    if FCommandText <> '' then
      FCommandText := '';
    FParams.Clear;
  end;
end;

{ Miscellaneous }

function TCustomSQLDataSet.IsSequenced: Boolean;
begin
  Result := False;
end;

procedure TCustomSQLDataSet.DefineProperties(Filer: TFiler);

  function DesignerDataStored: Boolean;
  begin
    if Filer.Ancestor <> nil then
      Result := TCustomSQLDataSet(Filer.Ancestor).DesignerData <> DesignerData else
      Result := DesignerData <> '';
  end;

begin
  inherited;
  Filer.DefineProperty('DesignerData', ReadDesignerData, WriteDesignerData,
    DesignerDataStored);
end;

procedure TCustomSQLDataSet.ReadDesignerData(Reader: TReader);
begin
  FDesignerData := Reader.ReadString;
end;

procedure TCustomSQLDataSet.WriteDesignerData(Writer: TWriter);
begin
  Writer.WriteString(FDesignerData);
end;

{ Exception Handling }

function TCustomSQLDataSet.Check(Status: SQLResult; eType: TSQLExceptionType): SQLResult;
begin
  if Status <> 0 then SQLError(Status, eType);
  Result := Status;
end;

procedure TCustomSQLDataSet.InternalHandleException;
begin
end;

{ Index Support }

procedure TCustomSQLDataSet.UpdateIndexDefs;
begin
  AddIndexDefs(Self);
end;

function TCustomSQLDataSet.CheckFieldNames(const FieldNames: string): Boolean;
var
  S: string;
  Pos: Integer;
begin
  Result := True;
  S := FieldNames;
  Pos := 1;
  while Result and (Pos <= Length(S)) do
    Result := FindField(ExtractFieldName(S, Pos)) <> nil;
end;

const
  IDX_TYPE_FIELD = 'INDEX_TYPE';           { Do not localize }
  IDX_SORT_FIELD = 'SORT_ORDER';           { Do not localize }
  DescendingOrder = 'D';                   { Do not localize }

procedure TCustomSQLDataSet.AddIndexDefs(SourceDS: TCustomSQLDataSet; IndexName: string = '');

  function DontUseIndex: Boolean;
  begin
    Result := CommandType in [ctQuery, ctStoredProc];
    if Result and (CommandType = ctQuery) then
      Result := IsMultiTableQuery(CommandText);
    if Result then FIndexDefsLoaded := True;
  end;

var
  DataSet: TCustomSQLDataSet;
  TableName, IdxName, SortOrder, FieldNames: string;
  IdxType: Integer;
  Options: TIndexOptions;
  IdxDef: TIndexDef;
begin
  if not FGetMetadata then FIndexDefsLoaded := True;
  if FIndexDefsLoaded then Exit;
  if SchemaInfo.FType <> stNoSchema then Exit;
  if DontUseIndex then Exit;
  if FCommandType = ctTable then
    TableName := FCommandText
  else
    TableName := GetTableNameFromSQL(CommandText);
  DataSet := FSQLConnection.OpenSchemaTable(stIndexes, TableName, '', '', '');
  if not Assigned(DataSet) then FSQLConnection.SQLError(SQLResult(-1), exceptMetadata);
  try
    FIndexDefs.Clear;
    IndexDefs.Clear;
    while not DataSet.EOF do
    begin
      begin
        Options := [];
        IdxName := DataSet.FieldByName(IDX_NAME_FIELD).Value;
        if (IndexName = '') or (IdxName = IndexName) then
        begin
          if IndexDefs.IndexOf(IdxName) = -1 then
          begin
            FieldNames := DataSet.FieldByName(COL_NAME_FIELD).Value;
            // don't add indexes on fields not in result set
            if SourceDS.CheckFieldNames(FieldNames) then
            begin
              IdxType := DataSet.FieldByName(IDX_TYPE_FIELD).Value;
              if (IdxType and eSQLPrimaryKey) = eSQLPrimaryKey then
                Options := Options + [ixPrimary];
              if (IdxType and eSQLUnique) = eSQLUnique then
                Options := Options + [ixUnique];
              SortOrder := DataSet.FieldByName(IDX_SORT_FIELD).Value;
              if SortOrder = DescendingOrder then
                Options := Options + [ixDescending];
              FIndexDefs.Add(IdxName, FieldNames, Options);
            end;
          end else
          begin
            IdxDef := IndexDefs.Find(IdxName);
            IdxDef.Fields := IdxDef.Fields + ';' + DataSet.FieldByName(COL_NAME_FIELD).Value;
          end;
        end;
      end;
      DataSet.Next;
    end;
  finally
    FSQLConnection.FreeSchemaTable(DataSet);
  end;
  FIndexDefsLoaded := True;
end;

function TCustomSQLDataSet.GetKeyFieldNames(List: TStrings): Integer;
var
  I: Integer;
begin
  if not FIndexDefsLoaded then
    AddIndexDefs(Self);
  Result := IndexDefs.Count;
  List.BeginUpdate;
  try
    List.Clear;
    for I := 0 to Result - 1 do
      List.Add(IndexDefs[I].Fields);
  finally
    List.EndUpdate;
  end;
end;

{ Schema Tables }

procedure TCustomSQLDataSet.SetSchemaInfo(SchemaType: TSchemaType; SchemaObjectName, SchemaPattern: string; PackageName: string = '' );
begin
  FreeStatement;
  FSchemaInfo.FType := SchemaType;
  FSchemaInfo.ObjectName := '';
  if Assigned(SchemaObjectName) then
    FSchemaInfo.ObjectName := SchemaObjectName;
  FSchemaInfo.Pattern := SchemaPattern;
  FSchemaInfo.PackageName := PackageName;
end;

procedure TCustomSQLDataSet.OpenSchema;
{
  function ExtractObjectName(Value: string): string;
  var
    NamePos: Integer;
    Q: string;
  begin
    Result := Value;
    Q := GetQuoteChar;
    if (Q = '') or (Q = ' ') then exit;
    NamePos := Pos('.' + Q, Value);
    if NamePos = 0 then
      NamePos := Pos(Q + '.', Value);
    if NamePos = 0 then exit;
    Result := Copy(Value, NamePos + 2, Length(Value) - NamePos);
    if Pos(Q, Result) > 0 then
      Result := Copy(Result, 1, Length(Result) -1);
  end;
}
var
  Status: SQLResult;
  TblType: LongWord;
begin
  Status := SQL_NULL_DATA;
  if FSQLConnection = nil then
    DatabaseError(sConnectionNameMissing);
  SetSchemaOption;
  //FSchemaInfo.ObjectName := ExtractObjectName(FSchemaInfo.ObjectName);
  case FSchemaInfo.FType of
    stTables:
    begin
      TblType := GetTableScope(GetInternalConnection.FTableScope);
      if FSchemaInfo.Pattern = '' then
        Status := ISQLMetaData_getTables(GetInternalConnection.FSQLMetaData,
                  nil, TblType, FSQLCursor)
      else
        Status := ISQLMetaData_getTables(GetInternalConnection.FSQLMetaData,
                  FSchemaInfo.Pattern, TblType, FSQLCursor)
    end;
    stSysTables:
      if FSchemaInfo.Pattern = '' then
        Status := ISQLMetaData_getTables(GetInternalConnection.FSQLMetaData,
                  nil, eSQLSystemTable, FSQLCursor)
      else
        Status := ISQLMetaData_getTables(GetInternalConnection.FSQLMetaData,
                  FSchemaInfo.Pattern, eSQLSystemTable, FSQLCursor);
    stColumns:
      Status := ISQLMetaData_getColumns(GetInternalConnection.FSQLMetaData,
                  FSchemaInfo.ObjectName,FSchemaInfo.Pattern, 0, FSQLCursor);
    stProcedures:
    begin
      Status := ISQLMetaData_setOption(GetInternalConnection.FSQLMetaData,
                  eMetaPackageName, FSchemaInfo.PackageName);
      if Status = DBXERR_NONE then
        if FSchemaInfo.Pattern = '' then
          Status := ISQLMetaData_getProcedures(GetInternalConnection.FSQLMetaData,
                  nil, eSQLProcedure, FSQLCursor)
        else
          Status := ISQLMetaData_getProcedures(GetInternalConnection.FSQLMetaData,
                  FSchemaInfo.Pattern, eSQLProcedure, FSQLCursor)
    end;
    stPackages:
      Status := ISQLMetaData_getObjectList(GetInternalConnection.FSQLMetaData,
                  eObjTypePackage, FSQLCursor);

    stProcedureParams:
    begin
      Status := ISQLMetaData_setOption(GetInternalConnection.FSQLMetaData,
                  eMetaPackageName, FSchemaInfo.PackageName);
      if Status = DBXERR_NONE then
        if FSchemaInfo.Pattern = '' then
          Status := ISQLMetaData_getProcedureParams(GetInternalConnection.FSQLMetaData,
                  FSchemaInfo.ObjectName, nil, FSQLCursor)
        else
          Status := ISQLMetaData_getProcedureParams(GetInternalConnection.FSQLMetaData,
                  FSchemaInfo.ObjectName, FSchemaInfo.Pattern, FSQLCursor)
    end;
    stIndexes:
      Status := ISQLMetaData_getIndices(GetInternalConnection.FSQLMetaData,
                  FSchemaInfo.ObjectName, 0, FSQLCursor);
  end;
  if Status <> DBXERR_NONE then
    GetInternalConnection.SQLError(Status, exceptMetaData);
end;

{ ProviderSupport }

procedure TCustomSQLDataSet.PSEndTransaction(Commit: Boolean);
var
  TransDesc: TTransactionDesc;
begin
  TransDesc.TransactionID := 1;
  TransDesc.GlobalID := 0;
  TransDesc.IsolationLevel := FSQLConnection.FTransIsoLevel;
  TransDesc.CustomIsolation := 0;
  if Commit then FSQLConnection.Commit(TransDesc)
  else FSQLConnection.Rollback(TransDesc);
end;

procedure TCustomSQLDataSet.PSExecute;
begin
  InternalExecSQL;
end;

function TCustomSQLDataSet.PSExecuteStatement(const ASQL: string; AParams: TParams;
  var ResultSet: TObject): Integer;
begin
  Result := FSQLConnection.execute(ASQL, AParams, ResultSet)
end;

procedure TCustomSQLDataSet.PSGetAttributes(List: TList);
var
  Attr: TPacketAttribute;
begin
  inherited PSGetAttributes(List);
  Attr.Name := SLocaleCode;
  Attr.Value := Integer(FSQLConnection.LocaleCode);
  Attr.IncludeInDelta := False;
  List.Add(TObject(Attr));
end;

function TCustomSQLDataSet.PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs;
begin
  if (not FIndexDefsLoaded) and (CommandType <> ctStoredProc)
     and (SchemaInfo.FType = stNoSchema) then
    AddIndexDefs(Self);
  Result := GetIndexDefs(IndexDefs, IndexTypes);
end;

function TCustomSQLDataSet.PSGetDefaultOrder: TIndexDef;

  function FieldsInQuery(IdxFields: string): Boolean;
  var
    I:  Integer;
    IdxFlds, Flds: TStrings;
    FldNames: string;
  begin
    Result := True;
    IdxFlds := TStringList.Create;
    try
      IdxFlds.CommaText := IdxFields;
      Flds := TStringList.Create;
      try
        Fields.GetFieldNames(Flds);
        FldNames := Flds.CommaText;
        for I := 0 to IdxFlds.Count -1 do
        begin
          if pos(IdxFlds[I], FldNames) = 0 then
          begin
            Result := False;
            exit;
          end;
        end;
      finally
        Flds.Free;
      end;
    finally
      IdxFlds.Free;
    end;
  end;

var
  I: Integer;
begin
  Result := inherited PSGetDefaultOrder;
  if not Assigned(Result) then
    Result := GetIndexForOrderBy(GetQueryFromType, Self);
  if (not Assigned(Result)) and
     (CommandType <> ctStoredProc) and (SchemaInfo.FType = stNoSchema) then
  begin
    if not FIndexDefsLoaded then
      AddIndexDefs(Self);
    for I := 0 to IndexDefs.Count - 1 do
    begin
      if (ixPrimary in TIndexDef(IndexDefs[I]).Options) and
         FieldsInQuery(TIndexDef(IndexDefs[I]).Fields) then
      begin
        Result := TIndexDef.Create(nil);
        Result.Assign(IndexDefs[I]);
        Break;
      end;
    end;
  end;
end;

function TCustomSQLDataSet.PSGetKeyFields: string;
var
  HoldPos, I: Integer;
  IndexFound:Boolean;
begin
  if (CommandType = ctStoredProc) or (SchemaInfo.FType <> stNoSchema) then exit;
  Result := inherited PSGetKeyFields;
  IndexFound := False;
  if (Result = '') and (SchemaInfo.FType = stNoSchema) then
  begin
    if not FIndexDefsLoaded then
      AddIndexDefs(Self);
    for I := 0 to IndexDefs.Count - 1 do
      if ixUnique in IndexDefs[I].Options then
      begin
        Result := IndexDefs[I].Fields;
        IndexFound := (FieldCount = 0);
        if not IndexFound then
        begin
          HoldPos := 1;
          while HoldPos <= Length(Result) do
          begin
            IndexFound := FindField(ExtractFieldName(Result, HoldPos)) <> nil;
            if not IndexFound then Break;
          end;
        end;
        if IndexFound then Break;
      end;
    if not IndexFound then
      Result := '';
  end;
end;

function TCustomSQLDataSet.PSGetParams: TParams;
begin
  Result := Params;
end;

function TCustomSQLDataSet.GetQuoteChar: string;
begin
  Result := PSGetQuoteChar;
end;

function TCustomSQLDataSet.PSGetQuoteChar: string;
begin
  Result := '';
  if FSQLConnection.QuoteChar <> '' then
    Result := FSQLConnection.QuoteChar;
end;

procedure TCustomSQLDataSet.PSReset;
begin
  inherited PSReset;
  if Active and (not BOF) then
    First;
end;

function TCustomSQLDataSet.PSGetTableName: string;
begin
   if CommandType = ctTable then
     Result := CommandText
   else
     Result := GetTableNameFromSQL(CommandText);
end;

function TCustomSQLDataSet.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError;
begin
  if not Assigned(E) then
    E := EDatabaseError.Create(SErrorMappingError);
  Result := inherited PSGetUpdateException(E, Prev);
end;

function TCustomSQLDataSet.PSInTransaction: Boolean;
begin
  Result := (FSQLConnection <> nil) and (FSQLConnection.InTransaction);
end;

function TCustomSQLDataSet.PSIsSQLBased: Boolean;
begin
  Result := True;
end;

function TCustomSQLDataSet.PSIsSQLSupported: Boolean;
begin
  Result := True;
end;

procedure TCustomSQLDataSet.PSSetParams(AParams: TParams);
begin
  if AParams.Count <> 0 then
  begin
    Params.Assign(AParams);
    if Prepared and (pos(SParam, FNativeCommand) = 0) then
      SetPrepared(False);
  end;
  Close;
end;

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

procedure TCustomSQLDataSet.PSStartTransaction;
var TransDesc: TTransactionDesc ;
begin
  TransDesc.TransactionID := 1;
  TransDesc.GlobalID := 0;
  TransDesc.IsolationLevel := FSQLConnection.FTransIsoLevel;
  TransDesc.CustomIsolation := 0;
  FSQLConnection.StartTransaction(TransDesc);
end;

function TCustomSQLDataSet.PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean;
begin
  { OnUpdateRecord is not supported }
  Result := False;
end;

function TCustomSQLDataSet.LocateRecord(const KeyFields: string; const KeyValues: Variant;
  Options: TLocateOptions; SyncCursor: Boolean): Boolean;

  function SameValue(V1, V2: Variant; IsString, CaseInsensitive,
           PartialLength: Boolean): Boolean;
  var
    V: Variant;
  begin
    if not IsString then
      Result := VarCompareValue(V1, V2) = vrEqual
    else
    begin
      if PartialLength then
        V := Copy(V1, 1, Length(V2))
      else
        V := V1;
      if CaseInsensitive then
        Result := LowerCase(V) = LowerCase(V2)
      else
        Result := V = V2;
    end;
  end;

  function CheckValues(AFields: TStrings; Values: Variant;
           CaseInsensitive, PartialLength: Boolean): Boolean;
  var
    J: Integer;
    Field: TField;
  begin
    Result := True;
    for J := 0 to AFields.Count -1 do
    begin
      Field := FieldByName(AFields[J]);
      if not SameValue(Field.Value, Values[J],
        Field.DataType in [ftString, ftFixedChar], CaseInsensitive, PartialLength) then
      begin
        Result := False;
        break;
      end;
    end;
  end;

var
  I: Integer;
  SaveFields, AFields: TStrings;
  PartialLength, CaseInsensitive: Boolean;
  Values, StartValues: Variant;
begin
  CheckBrowseMode;
  CursorPosChanged;
  AFields := TStringList.Create;
  SaveFields := TStringList.Create;
  try
    AFields.CommaText := StringReplace(KeyFields, ';', ',', [rfReplaceAll]);
    PartialLength := loPartialKey in Options;
    CaseInsensitive := loCaseInsensitive in Options;
    if VarIsArray(KeyValues) then
      Values := KeyValues
    else
      Values := VarArrayOf([KeyValues]);
    { save current record in case we cannot locate KeyValues }
    StartValues := VarArrayCreate([0, FieldCount], varObject);
    for I := 0 to FieldCount -1 do
    begin
      StartValues[I] := Fields[I].Value;
      SaveFields.Add(Fields[I].FieldName);
    end;
    First;
    while not EOF do
    begin
      if CheckValues(AFields, Values, CaseInsensitive, PartialLength) then
        break;
      Next;
    end;
    { if not found, reset cursor to starting position }
    if EOF then
    begin
      First;
      while not EOF do
      begin
        if CheckValues(SaveFields, StartValues, False, False) then
          break;
        Next;
      end;
    end;
    Result := not EOF;
  finally
    AFields.Free;
    SaveFields.Free;
  end;
end;

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

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

procedure TCustomSQLDataSet.SetSchemaName(const Value: string);
begin
  FSchemaName := Value;
end;

procedure TCustomSQLDataSet.SetSchemaOption;
var
  Status: SQLResult;
  Len : smallint;
  buf : IntPtr;
  UserName : String;
  ObjectName : String;
  CatalogName : String;
begin
  Status := 0;
  ObjectName := FSchemaInfo.ObjectName;
  if ObjectName <> '' then
  begin
    Status := ISQLConnection_setOption(GetInternalConnection.FISQLConnection,
      eConnQualifiedName, ObjectName);
    if Status <> 0 then
      SQLError(Status, exceptConnection);
    try
      buf := Marshal.AllocHGlobal(256);
      InitializeBuffer(buf, 256, 0);
      Status := ISQLConnection_getOption(GetInternalConnection.FISQLConnection,
        eConnCatalogName, buf, 256, Len);
      if Status <> 0 then
        SQLError(Status, exceptConnection);
      CatalogName := Marshal.PtrToStringAnsi(buf, Len);
      InitializeBuffer(buf, 256, 0);
      Status := ISQLConnection_getOption(GetInternalConnection.FISQLConnection,
        eConnSchemaName, buf, 256, Len);
      if Status <> 0 then
        SQLError(Status, exceptConnection);
      UserName := Marshal.PtrToStringAnsi(buf, Len);
      InitializeBuffer(buf, 256, 0);
      Status := ISQLConnection_getOption(GetInternalConnection.FISQLConnection,
        eConnObjectName, buf, 256, Len);
      if Status <> 0 then
        SQLError(Status, exceptConnection);
      FSchemaInfo.ObjectName := Marshal.PtrToStringAnsi(buf, Len);
    finally
      Marshal.FreeHGlobal(buf);
    end;
  end;
  if Length(CatalogName) = 0 then
    CataLogName := GetInternalConnection.FParams.Values[DATABASENAME_KEY];
  if Length(CatalogName) > 0 then
    Status := ISQLMetaData_setOption(GetInternalConnection.FSQLMetaData,
      eMetaCatalogName, CatalogName);
  if Status <> 0 then
    SQLError(Status, exceptMetaData);
  if Length(UserName) = 0 then
    UserName := SchemaName;
  if Length(UserName) = 0 then
    UserName := GetInternalConnection.FParams.Values[szUSERNAME];
  if Length(UserName) > 0 then
    Status := ISQLMetaData_setOption(GetInternalConnection.FSQLMetaData,
      eMetaSchemaName, UserName);
  if Status <> 0 then
    SQLError(Status, exceptMetaData);
end;

{ TSQLDataSet }

constructor TSQLDataSet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommandType := ctQuery;
  FGetMetadata := True;
end;

function TSQLDataSet.ExecSQL(ExecDirect: Boolean = False): Integer;
begin
  Result := InternalExecSQL(ExecDirect);
end;

{ TSQLQuery }

constructor TSQLQuery.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommandType := ctQuery;
  FSQL := TStringList.Create;
  FGetMetaData := False;
  TStringList(SQL).OnChange := QueryChanged;
end;

destructor TSQLQuery.Destroy;
begin
  FreeAndNil(FSQL);
  inherited Destroy;
end;

function TSQLQuery.ExecSQL(ExecDirect: Boolean = False): Integer;
begin
  Result := InternalExecSQL(ExecDirect);
end;

procedure TSQLQuery.PrepareStatement;
var
  Start: integer;
  CurSection : TSqlToken;
  Value: string;
begin
  if FCommandText = '' then
    SetSQL(SQL);
  if Length(CommandText) = 0 then
    DatabaseError(SEmptySQLStatement, Self);
  Start := 1;
  CurSection := NextSQLToken(CommandText, Start , Value, CurSection);
  if CurSection = stSelect then
    Inc(FSQLConnection.FActiveStatements);
  CheckStatement;
  Check(ISQLCommand_prepare(FSQLCommand, FNativeCommand, ParamCount), exceptCommand);
  SQLResources.AddCommand(FSQLCommand);
end;

procedure TSQLQuery.QueryChanged(Sender: TObject);
var
  List: TSQLParams;
begin
  if not (csReading in ComponentState) then
  begin
    Close;
    SetPrepared(False);
    if ParamCheck or (csDesigning in ComponentState) then
    begin
      List := TSQLParams.Create(Self);
      try
        FText := SQL.Text;
        List.Parse(FText, True);
        List.AssignValues(FParams);
        FParams.Clear;
        FParams.Assign(List);
      finally
        List.Free;
      end;
    end else
      FText := SQL.Text;
    DataEvent(dePropertyChange, nil);
  end else
    FText := FParams.ParseSQL(SQL.Text, False);
  SetFCommandText(FText);
end;

procedure TSQLQuery.SetSQL(Value: TStrings);
begin
  if SQL.Text <> Value.Text then
  begin
    Close;
    SQL.BeginUpdate;
    try
      SQL.Assign(Value);
    finally
      SQL.EndUpdate;
    end;
  end;
end;

{ TSQLStoredProc }

constructor TSQLStoredProc.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommandType := ctStoredProc;
  FGetMetadata := True;
end;

function TSQLStoredProc.ExecProc: Integer;
begin
  Result := InternalExecSQL;
end;

procedure TSQLStoredProc.PrepareStatement;
var
  Q: String;
  SQLText: string;
begin
  Q := FSQLConnection.QuoteChar;
  if FCommandText = '' then
    SetStoredProcName(FStoredProcName);
  if Length(CommandText) = 0 then
    DatabaseError(SEmptySQLStatement, Self);
  CheckStatement;
  Check(ISQLCommand_SetOption(FSQLCommand, eCommStoredProc, Integer(True)), exceptCommand);
  Check(ISQLCommand_SetOption(FSQLCommand, eCommPackageName, FPackageName), exceptCommand);
  if FSchemaName <> '' then
    SQLText := AddQuoteCharToObjectName(Self, FSchemaName + '.' + FNativeCommand, Q)
  else
    SQLText := AddQuoteCharToObjectName(Self, FNativeCommand, Q);
  Check(ISQLCommand_prepare(FSQLCommand, SQLText, ParamCount), exceptCommand);
  SQLResources.AddCommand(FSQLCommand);
end;

procedure TSQLStoredProc.SetStoredProcName(Value: string);
begin
  //if FStoredProcName <> Value then
  //begin
    FStoredProcName := Value;
    SetCommandText(Value);
    if Assigned(FProcParams) then  // free output params if any
      FreeProcParams(FProcParams);
  //end;
end;

procedure TSQLStoredProc.SetPackageName(Value: string);
begin
  if FPackageName <> Value then
  begin
    FPackageName := Value;
    FSchemaInfo.PackageName := Value;
    if Assigned(FProcParams) then
      FreeProcParams(FProcParams);
    FStoredProcName := '';
    SetCommandText('');
  end;
end;

function TSQLStoredProc.NextRecordSet: TCustomSQLDataSet;
begin
  FGetNextRecordSet := True;
  SetState(dsInactive);
  CloseCursor;
  if Assigned(FieldDefs) then
    FieldDefs.Updated := False;
  try
    Active := True;
  finally
    FGetNextRecordSet := False;
  end;
  Result := TCustomSQLDataSet(Self);
end;

{ TSQLTable }

constructor TSQLTable.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommandType := ctTable;
  FGetMetadata := True;
  FIndexFieldCount := -1;
  FMasterLink := TMasterDataLink.Create(Self);
  FIndexFields := TList.Create;
end;

destructor TSQLTable.Destroy;
begin
  FreeAndNil(FMasterLink);
  FreeAndNil(FIndexFields);
  inherited Destroy;
end;

procedure TSQLTable.DeleteRecords;
begin
  SQLConnection.ExecuteDirect('delete from ' + TableName);   { do not localize }
end;

function TSQLTable.GetIndexField(Index: Integer): TField;
begin
  if IndexName = '' then Result := nil
  else
  begin
    if FIndexFieldCount = -1 then
      RefreshIndexFields;
    Result := TField(FIndexFields[Index]);
  end;
end;

function TSQLTable.GetIndexFieldCount: Integer;
begin
  if IndexName = '' then Result := 0
  else if FIndexFieldCount >= 0 then Result := FIndexFieldCount
  else Result := RefreshIndexFields;
end;

procedure TSQLTable.GetIndexNames(List: TStrings);
begin
  FSQLConnection.GetIndexNames(FTableName,List);
end;

procedure TSQLTable.OpenCursor(InfoQuery: Boolean);
begin
  inherited OpenCursor(InfoQuery);
  if not FIsDetail and not FIndexDefsLoaded then
    AddIndexDefs(Self);
end;

procedure TSQLTable.AddParamsToQuery;
var
  I: Integer;
  Value: string;
begin
  if Pos('?', NativeCommand) = 0 then
  begin
    for I := 0 to Params.Count -1 do
    begin
      if Params[I].IsNull then
        Value := 'is NULL'
      else
        Value := '= ?';
      if I = 0 then
        NativeCommand := format('%s%s(%s %s)', [NativeCommand, SWhere, Params[I].Name, Value])
      else
        NativeCommand := format('%s%s(%s %s)', [NativeCommand, SAnd, Params[I].Name, Value]);
    end;
  end;
end;

procedure TSQLTable.SetDataSource(Value: TDataSource);
begin
  inherited SetDataSource(Value);
end;

function TSQLTable.GetQueryFromType: string;
begin
  if FNativeCommand <> '' then
    Result := FNativeCommand
  else
    Result := inherited GetQueryFromType;
end;

procedure TSQLTable.PrepareStatement;

  function GetFieldsForIndexName(IndexName: string): string;
  var
    DataSet: TCustomSQLDataSet;
    IdxName: string;
    Buffer: StringBuilder;
  begin
    DataSet := FSQLConnection.OpenSchemaTable(stIndexes, TableName,'','','');
    if not Assigned(DataSet) then FSQLConnection.SQLError(SQLResult(-1), exceptMetadata);
    try
      Buffer := StringBuilder.Create(256);
      while not DataSet.EOF do
      begin
        IdxName := DataSet.FieldByName(IDX_NAME_FIELD).Value;
        if IdxName = IndexName then
        begin
          if Buffer.Length > 0 then
            Buffer.Append(';');
          Buffer.Append(DataSet.FieldByName(COL_NAME_FIELD).AsString);
        end;
        DataSet.Next;
      end;
      Result := Buffer.ToString;
    finally
      FSQLConnection.FreeSchemaTable(DataSet);
    end;
  end;

  function GetIndexFieldNames(FieldNames, IndexName: string): string;
  begin
    if (FieldNames = '') and (IndexName = '') then
      Result := ''
    else if FieldNames <> '' then
      Result := FieldNames
    else
      Result := GetFieldsForIndexName(IndexName);
  end;

var
  CommandBuffer: StringBuilder;
  FIndex, Pos1, Pos2: Integer;
  Q, IdxFieldNames, FName1, FName2, TempString1, TempString2: string;
begin  // first, convert TableName into valid Query.
  if Length(FTableName) = 0 then
    DatabaseError(SEmptySQLStatement, Self);
  if FNativeCommand = '' then  // otherwise, already prepared
  begin
    Q := FSQLConnection.QuoteChar;
    CommandBuffer := StringBuilder.Create(SSelectStarFrom, 512);
    if (FDataLink.DataSource <> nil) and (MasterFields <> '') then
    begin
      CommandBuffer.Append(AddQuoteCharToObjectName(Self ,FTableName, Q));
      FIsDetail := True;
      Pos1 := 1;
      Pos2 := 1;
      FIndex := 1;
      TempString1 := MasterFields;
      TempString2 := IndexFieldNames;
      while Pos1 <= Length(TempString1) do
        begin
          FName1 := ExtractFieldName(TempString1, Pos1);
          FName2 := ExtractFieldName(TempString2, Pos2);
          if FName1 = '' then Break;
          if FIndex = 1 then
            CommandBuffer.Append(SWhere)
          else
            CommandBuffer.Append(SAnd);
          if FName2 <> '' then
            CommandBuffer.Append(FName2)
          else
            CommandBuffer.Append(FName1);
          CommandBuffer.Append(' = :');
          CommandBuffer.Append(FName1);
          Inc(FIndex);
        end;
      FCommandType := ctQuery;
      SetCommandText(CommandBuffer.ToString);
    end else
    begin
      FIsDetail := False;
      IdxFieldNames := GetIndexFieldNames(IndexFieldNames, IndexName);
      if Self.FSchemaName <> '' then
        CommandBuffer.Append(AddQuoteCharToObjectName(Self, FSchemaName + '.' + FTableName, Q))
      else
        CommandBuffer.Append(AddQuoteCharToObjectName(Self, FTableName, Q));
      if IdxFieldNames <> '' then
      begin
        CommandBuffer.Append(SOrderBy);
        CommandBuffer.Append(StringReplace(IdxFieldNames, ';', ',', [rfReplaceAll]));
      end;
      FCommandText := CommandBuffer.ToString;
    end;
  end else if Params.Count > 0 then
    AddParamsToQuery;

  Inc(FSQLConnection.FActiveStatements);
  CheckStatement;
  Check(ISQLCommand_prepare(FSQLCommand, FNativeCommand, ParamCount), exceptCommand);
  SQLResources.AddCommand(FSQLCommand);
  FCommandType := ctTable;
  FCommandText := FTableName;
end;

function TSQLTable.RefreshIndexFields: Integer;
var
  I, Pos: Integer;
  Temp: string;
  FField: TField;
begin
  Result := 0;
  if not FIndexDefsLoaded then
    AddIndexDefs(Self);
  FIndexFields.Clear;
  for I := 0 to IndexDefs.Count - 1 do
  begin
    if WideCompareText(IndexDefs[I].Name, IndexName) = 0 then
    begin
      Temp := IndexDefs[I].Fields;
      Pos := 1;
      while Pos <= Length(Temp) do
      begin
        FField := FindField(ExtractFieldName(Temp, Pos));
        if FField = nil then
          Break
        else
          FIndexFields.Add(FField);
        Inc(Result);
      end;
      Break;
    end;
  end;
end;

function TSQLTable.GetMasterFields: string;
begin
  Result := FMasterLink.FieldNames;
end;

procedure TSQLTable.SetMasterFields(Value: string);
begin
  FMasterLink.FieldNames := Value;
  if not (csLoading in ComponentState) then
  begin
    Close;
    FreeStatement;
    FNativeCommand := '';
  end;
end;

procedure TSQLTable.SetTableName(Value: string);
begin
  if FTableName <> Value then
  begin
    FNativeCommand := '';
    FTableName := Value;
    SetCommandText(Value);
  end;
end;

procedure TSQLTable.SetIndexFieldNames(Value: string);
begin
  if FIndexFieldNames <> Value then
  begin
    if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
      if TableName = '' then DatabaseError(SNoTableName,Self);
    FIndexFieldNames := Value;
    if FIndexFieldNames <> '' then
      SetIndexName('');
    FNativeCommand := '';
    SetPrepared(False);
  end;
end;

procedure TSQLTable.SetIndexField(Index: Integer; Value: TField);
begin
  GetIndexField(Index).Assign(Value);
end;

procedure TSQLTable.SetIndexName(Value: string);
begin
  if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
    if TableName = '' then DatabaseError(SNoTableName,Self);
  if FIndexName <> Value then
  begin
    FIndexName := Value;
    FNativeCommand := '';
    if Assigned(FSQLConnection) and (Value <> '') then
    begin
      SetIndexFieldNames('');  // clear out IndexFieldNames
      if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
        AddIndexDefs(Self, Value);
    end;
    SetPrepared(False);
  end;
  FIndexFieldCount := -1;
end;

initialization
  SQLResources := TSQLResourceMgr.Create;
finalization
  FreeAndNil(SQLResources);
  
end.
