{ +-------------------------------------------------------------+ } { | | } { | GM-Software | } { | =========== | } { | | } { | Project: DB Projects | } { | | } { | Description: ODBC Data Access Objects. | } { | | } { | | } { | Copyright (C) - 2000 - Gerrit Moeller. | } { | | } { | Source code dstributed under MIT license. | } { | | } { | See: https://www.gm-software.de | } { | | } { +-------------------------------------------------------------+ } {$INCLUDE GMCompilerSettings.inc} unit GMOdbcObj; interface uses {$IFDEF JEDIAPI}jwaWinType,{$ELSE}Windows,{$ENDIF} GMStrDef, GMCommon, GMCollections, GMUnionValue, GMSql, GMOdbcAPI, GMIntf, GMActiveX; // GMZStrm type TRecordCountStrategy = (csUseCountFromODBCDriver, csUseSelectCountStatement, csCountByLogarithmicPositioning); TRecordCountStrategies = set of TRecordCountStrategy; // caAllowDriverDialogs TOdbcConnectionAttribute = (caAsynchronOperations, caAutoCommitTransactions, caCaseSensitiveCatalogNames, caCompleteConnectionString); TOdbcConnectionAttributes = set of TOdbcConnectionAttribute; TOdbcAllowDriverDialogs = (adpNoDriverDialogs, adpPromtIfIncomplete, adpAlwaysPromt, adpAlwaysPromtReqiredOnly); //TGMMaxStringLengthOrigin = (sloLengthInChars, sloLengthInBytes); const cDfltODBCVersion = odbc3x; cDfltConnectionPooling = cpOff; cDfltCPSelectStartegy = ssExactMatch; cDfltAccessMode = amReadWrite; cDfltLoginTimeout = SQL_DEFAULT_LOGIN_TIMEOUT; cDfltStatementTimeout = SQL_DEFAULT_STATEMENT_TIMEOUT; cDfltCursorOrigin = coUseODBCCursorsIfNeeded; cDfltNetPacketSize = 0; //cDfltTransactionIsolation = [tiReadCommitted]; cDfltUpdateStrategy = usMinimalLock; cDfltCursorSensitivity = csUseDriverDefault; // csUnspecified; cDfltCursorType = ctKeyset; cDfltKeysetSize = 0; cDfltMaxRecords = 0; cDfltUsername = ''; cDfltUseConnectionValue = True; cDfltEnableTracing = Boolean(SQL_OPT_TRACE_DEFAULT); cDfltTranslateOptions = SQL_DEFAULT_TRANSLATE_OPTIONS; cDfltMaxFieldDataSize = SQL_DEFAULT_MAX_DATA_SIZE; cDfltAsyncOperations = Boolean(SQL_ASYNC_ENABLE_DEFAULT); cDfltCaseSensitiveCatalogNames = Boolean(SQL_METADATA_ID_DEFAULT); cDfltDSNFmtStr = '"%s" [%s]'; //cDfltUserDSNFmtStr = 'User DSN: "%s" [%s]'; //cDfltSystemDSNFmtStr = 'System DSN: "%s" [%s]'; CPropEnumDSNFmt = cStrCnStrDSN + '=%s'; cDfltRecordCountStrategies = [csUseSelectCountStatement]; // csUseCountFromODBCDriver //cDfltMaxStringLengthOrigin = sloLengthInChars; //cDfltMaxStringLengthCharSizeFactor = 1.0; cDfltUseSQLEscapeSequences = not Boolean(SQL_NOSCAN_DEFAULT); cDfltPositionedUpdateSimulation = pusUseDriverDefault; // pusAllowNonUniqueUpdate; cDfltConnectionAttributes = [caAutoCommitTransactions]; cDfltDriverDialogs = adpPromtIfIncomplete; //cDfltBlobCompressionType = 0; // ctMaximum; cDfltRSAttributes = [raAutoSaveChanges, raAutoEdit, raConfrimDeletions, raStripTrailingBlanks]; cSimplestRecordsetAttributes = [raAutoSaveChanges, raAutoEdit]; cRowArraySize = 1; cInvalidBufferSize = -1; cNoCompression = 0; cGetDataBufSizeInChars = $8000; // <- 32 K chars type TGMOdbcConnectProperties = class; TGMOdbcConnection = class; TGMOdbcEnvironment = class; TGMOdbcField = class; TGMOdbcStatementBase = class; TGMOdbcStatement = class; TGMOdbcRecordsetBase = class; TGMOdbcRecordset = class; IGMOdbcConnectProperties = interface(IUnknown) ['{5C8594D1-5972-411F-822B-9D0D8D61CF77}'] function Obj: TGMOdbcConnectProperties; end; TGMOdbcConnectProperties = class(TGMRefCountedObj, IGMLoadStoreData, IGMAssignFromObj, IGMAssignToObj, IGMAssignToIntf, IGMAssignFromIntf, IGMGetName, IGMOdbcConnectProperties) protected FOwners: array of TObject; FAccessMode: TAccessMode; //FAsynchronOperations: Boolean; FUsername: TGMString; FPassword: TGMString; FConnectionString: TGMString; FTimeoutForStatements: SQLUINTEGER; FTimeoutForLogin: SQLUINTEGER; FCursorOrigin: TCursorOrigin; FTransactionIsolation: TTransactionIsolations; FAttributes: TOdbcConnectionAttributes; FAllowDriverDialogs: TOdbcAllowDriverDialogs; // procedure CheckIsInactive(const ACallingName: TGMString); // procedure SetAccessMode(const AValue: TAccessMode); // procedure SetTimeoutForStatements(const AValue: SQLUINTEGER); // procedure SetTimeoutForLogin(const AValue: SQLUINTEGER); // procedure SetConnectionString(const AValue: TGMString); // procedure SetCursorOrigin(const AValue: TCursorOrigin); procedure SetTransactionIsolation(const AValue: TTransactionIsolations); procedure SetAttributes(const AValue: TOdbcConnectionAttributes); public constructor Create(const ARefLifeTime: Boolean = False); overload; override; constructor CreateFromObj(const ASource: TObject; const ARefLifeTime: Boolean = False); reintroduce; overload; constructor CreateFromIntf(const ASource: IUnknown; const ACryptCtrlData: PGMCryptCtrlData = nil; const ARefLifeTime: Boolean = False); reintroduce; overload; constructor CreateOwned(const AOwner: TObject; const ARefLifeTime: Boolean = False); reintroduce; overload; function Obj: TGMOdbcConnectProperties; function GetName: TGMString; stdcall; function DatabaseName: TGMString; procedure SetDefaultValues; function AddOwner(const AOwner: TObject): TObject; function FindOwner(const AOwner: TObject; var AIdx: LongInt): Boolean; procedure RemoveOwner(const AOwner: TObject); procedure AssignFromObj(const ASource: TObject); stdcall; procedure AssignToObj(const ADest: TObject); stdcall; procedure AssignToIntf(const ADest: IUnknown); stdcall; procedure AssignFromIntf(const ASource: IUnknown); stdcall; procedure LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall; procedure StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall; //published property AccessMode: TAccessMode read FAccessMode write FAccessMode default cDfltAccessMode; // SetAccessMode property Attributes: TOdbcConnectionAttributes read FAttributes write SetAttributes default cDfltConnectionAttributes; property AllowDriverDialogs: TOdbcAllowDriverDialogs read FAllowDriverDialogs write FAllowDriverDialogs; //property AsynchronOperations: Boolean read FAsynchronOperations Write FAsynchronOperations default cDfltAsyncOperations; property Username: TGMString read FUsername write FUsername; property Password: TGMString read FPassword write FPassword; property ConnectionString: TGMString read FConnectionString write FConnectionString; // SetConnectionString; property TimeoutForStatements: SQLUINTEGER read FTimeoutForStatements write FTimeoutForStatements default cDfltStatementTimeout; // SetTimeoutForStatements property TimeoutForLogin: SQLUINTEGER read FTimeoutForLogin write FTimeoutForLogin default cDfltLoginTimeout; // SetTimeoutForLogin property CursorOrigin: TCursorOrigin read FCursorOrigin write FCursorOrigin default cDfltCursorOrigin; // SetCursorOrigin property TransactionIsolation: TTransactionIsolations read FTransactionIsolation write SetTransactionIsolation default cSqlDefaultTransactionIsolation; end; TOdbcHandleAllocObj = class(TGMHandleActivateObj, IGMGetHandleType, IGMCriticalSection) protected FCriticalSection: IGMCriticalSection; procedure ReleaseHandle; override; function GetHandleType: LongWord; virtual; stdcall; abstract; public constructor Create(const ArefLifeTime: Boolean = False); overload; override; property CriticalSection: IGMCriticalSection read FCriticalSection implements IGMCriticalSection; property HandleType: LongWord read GetHandleType; //published property ActivationProperties; property OnBeforeActiveChange; property OnAfterActiveChange; property CallEventsWhenDisabled; end; TTransactionSupport = (txnNone, txnDMLOnly, txnDDLCommit, txnDDLIgnore, txnAll); TGMOdbcTransactedObj = class(TOdbcHandleAllocObj, IGMTransactions) protected FTransactionLevel: LongInt; function GetTransactionSupport: TTransactionSupport; virtual; public function GetTransactionLevel: LongInt; virtual; stdcall; procedure BeginTransaction; virtual; stdcall; procedure CommitTransaction; virtual; stdcall; procedure RollbackTransaction; virtual; stdcall; property TransactionSupport: TTransactionSupport read GetTransactionSupport; property TransactionLevel: LongInt read GetTransactionLevel; end; TGMOdbcEnvironment = class(TGMOdbcTransactedObj) protected FODBCVersion: TOdbcVersion; FConnectionPooling: TOdbcConnectionPooling; FConnectionPoolSelectStrategy: TOdbcConnectionPoolSelectStrategy; procedure SetODBCConnectionPoolSelectStrategy(const AValue: TOdbcConnectionPoolSelectStrategy); procedure SetODBCConnectionPooling(const AValue: TOdbcConnectionPooling); procedure SetODBCODBCVersion(const AValue: TOdbcVersion); procedure SetODBCVersion(const AValue: TOdbcVersion); procedure SetConnectionPooling(const AValue: TOdbcConnectionPooling); procedure SetConnectionPoolSelectStrategy(const AValue: TOdbcConnectionPoolSelectStrategy); procedure AllocHandle; override; public constructor Create(const ARefLifeTime: Boolean); overload; override; constructor Create(const AOdbcVersion: TOdbcVersion; const AConnectionPooling: TOdbcConnectionPooling; const AConnectionPoolSelectStrategy: TOdbcConnectionPoolSelectStrategy; const ARefLifeTime: Boolean); reintroduce; overload; procedure AssignFromObj(const Source: TObject); function GetHandleType: LongWord; override; //published property ODBCVersion: TOdbcVersion read FODBCVersion write SetODBCVersion default cDfltODBCVersion; property ConnectionPooling: TOdbcConnectionPooling read FConnectionPooling write SetConnectionPooling default cDfltConnectionPooling; property ConnectionPoolSelectStrategy: TOdbcConnectionPoolSelectStrategy read FConnectionPoolSelectStrategy write SetConnectionPoolSelectStrategy default cDfltCPSelectStartegy; end; TOdbcComponentSubProperty = class(TGMRefCountedObj) protected FOwner: TGMActivatableObject; function ODBCConnection: TGMOdbcConnection; function ODBCStatement: TGMOdbcStatementBase; public constructor Create(const AOwner: TGMActivatableObject); reintroduce; overload; end; TOdbcTraceProperties = class(TOdbcComponentSubProperty) protected FEnableTracing: Boolean; FTraceFilename: TGMString; procedure SetODBCEnableTracing(const AValue: Boolean); procedure SetODBCTraceFilename(const AValue: TGMString); procedure SetEnableTracing(const AValue: Boolean); procedure SetTraceFilename(const AValue: TGMString); public constructor Create(const AOwner: TGMActivatableObject); reintroduce; overload; function IsEqualTo(const AValue: TOdbcTraceProperties): Boolean; procedure AssignFromObj(const Source: TObject); procedure SetODBCValues; //published property EnableTracing: Boolean read FEnableTracing write SetEnableTracing default cDfltEnableTracing; property TraceFilename: TGMString read FTraceFilename write SetTraceFilename; end; TOdbcTranslateProperties = class(TOdbcComponentSubProperty) protected FTranslationDLLFilename: TGMString; FTranslationAttributes: SQLUINTEGER; procedure SetODBCTranslationDLLFilename(const AValue: TGMString); procedure SetODBCTranslationAttributes(const AValue: PtrUInt); procedure SetTranslationDLLFilename(const AValue: TGMString); procedure SetTranslationAttributes(const AValue: SQLUINTEGER); public constructor Create(const AOwner: TOdbcHandleAllocObj); reintroduce; overload; function IsEqualTo(const AValue: TOdbcTranslateProperties): Boolean; procedure AssignFromObj(const Source: TObject); procedure SetODBCValues; //published property TranslationDLLFilename: TGMString read FTranslationDLLFilename write SetTranslationDLLFilename; property TranslationAttributes: SQLUINTEGER read FTranslationAttributes write SetTranslationAttributes default cDfltTranslateOptions; end; TGMOdbcConnection = class(TGMOdbcTransactedObj, IGMGetName, IGMAskBoolean, IGMExecuteSQL, IGMOdbcConnectProperties, IGMLoadStoreData, IGMSqlSyntaxElements) protected FDataSourceCatalog: TGMString; FNetworkPacketSize: SQLUINTEGER; FTraceProperties: TOdbcTraceProperties; FTranslateProperties: TOdbcTranslateProperties; FInternalConnected: Boolean; FProperties: IGMOdbcConnectProperties; FLoadStore: IGMLoadStoreData; function GetODBCEnvironmentIntf: IUnknown; function GetODBCEnvironment: TGMOdbcEnvironment; procedure SetODBCTimeoutForLogin(const AValue: SQLULEN); procedure SetODBCTimeoutForStatements(const AValue: SQLULEN); procedure SetODBCAccessMode(const AValue: TAccessMode); procedure SetODBCDataSorceCatalog(const AValue: TGMString); procedure SetODBCCursorOrigin(const AValue: TCursorOrigin); procedure SetODBCAsynchronOperations(const AValue: Boolean); procedure SetODBCAutoCommitTransactions(const AValue: Boolean); procedure SetODBCDriverDialogPrntWnd(const AValue: HWnd); procedure SetODBCCaseSensitiveCatalogNames(const AValue: Boolean); procedure SetODBCNetworkPacketSize(const AValue: SQLULEN); procedure SetODBCTransactionIsolation(const AValue: TTransactionIsolations); function GetNetworkPacketSize: SQLUINTEGER; function GetTransactionSupport: TTransactionSupport; override; procedure SetODBCEnvironment(const AValue: TGMOdbcEnvironment); procedure SetODBCEnvironmentIntf(const AValue: IUnknown); //procedure SetAsynchronOperations(const AValue: Boolean); //procedure SetAutoCommitTransactions(const AValue: Boolean); //procedure SetAllowDriverDialogs(const AValue: Boolean); procedure SetDataSourceCatalog(const AValue: TGMString); //procedure SetCaseSensitiveCatalogNames(const AValue: Boolean); procedure SetNetworkPacketSize(const AValue: SQLUINTEGER); procedure SetTraceProperties(const AValue: TOdbcTraceProperties); procedure SetTranslateProperties(const AValue: TOdbcTranslateProperties); procedure OnBeforeIntfSourceChange(const AOldSource, ANewSource: IUnknown); function AskBoolean(const AValueId: LongInt): LongInt; virtual; stdcall; procedure AllocHandle; override; procedure ReleaseHandle; override; public constructor Create(const ArefLifeTime: Boolean = False); overload; override; constructor Create(const AOdbcEnvironment: IUnknown; const AConnectionString: TGMString = ''; const ARefLifeTime: Boolean = True); reintroduce; overload; destructor Destroy; override; function GetName: TGMString; virtual; stdcall; procedure SetSharedProperties(const AProperties: IGMOdbcConnectProperties); //procedure AssignFromObj(const Source: TObject); function GetHandleType: LongWord; override; function SqlIdentifierQuoteChar: TGMString; function SqlDateTimeFormatStr: TGMString; function ExecuteSQL(const ASQL: TGMString): SQLLEN; virtual; function ConnetionAlive: Boolean; property InternalConnected: Boolean read FInternalConnected; property ODBCEnvironmentIntf: IUnknown read GetODBCEnvironmentIntf write SetODBCEnvironmentIntf; //published property ODBCEnvironment: TGMOdbcEnvironment read GetODBCEnvironment write SetODBCEnvironment; property DataSourceCatalog: TGMString read FDataSourceCatalog write SetDataSourceCatalog; property NetworkPacketSize: SQLUINTEGER read GetNetworkPacketSize write SetNetworkPacketSize default cDfltNetPacketSize; property TraceProperties: TOdbcTraceProperties read FTraceProperties write SetTraceProperties; property TranslateProperties: TOdbcTranslateProperties read FTranslateProperties write SetTranslateProperties; property Properties: IGMOdbcConnectProperties read FProperties implements IGMOdbcConnectProperties; property LoadStore: IGMLoadStoreData read FLoadStore implements IGMLoadStoreData; // property Name: IGMGetName read FName implements IGMGetName; end; TOdbcBlobStreamBase = class(TGMSequentialIStream) protected FOwner: TObject; //FPosition: LongInt; FStatementHandle: SQLHANDLE; public constructor Create(const AMode: DWORD; const AOwner: TObject; const AStatementHandle: SQLHANDLE; const ARefLifeTime: Boolean = True); reintroduce; overload; end; TOdbcBlobReadStream = class(TOdbcBlobStreamBase) protected FStartData: AnsiString; FDataType: TGMDBColumnDataType; FColumnPosition: LongInt; public constructor Create(const AOwner: TObject; const ADataType: TGMDBColumnDataType; const AColumnPosition: LongInt; const AStatementHandle: SQLHANDLE; const ATotalSize: Int64; const AStartData: AnsiString; const ARefLifeTime: Boolean = True); reintroduce; overload; procedure InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); override; procedure InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord); override; //function Seek(dlibMove: Int64; dwOrigin: LongInt; out libNewPosition: Int64): HResult; override; end; TOdbcBlobWriteStream = class(TOdbcBlobStreamBase) public procedure InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); override; procedure InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord); override; function Seek(dlibMove: Int64; dwOrigin: LongInt; libNewPosition: PInt64): HResult; override; end; TODBCFieldStateValueBuffer = class(TGMFieldValueBuffer, IGMAskInteger) protected FDataLength: SQLLEN; // FFirstDataRead: Boolean; function OwnerRecordset: TGMOdbcRecordsetBase; //procedure InternalSetSize(ANewSize: Int64); override; // procedure AccessBufferContents(const AAccessMode: TGMValueBufferAccessMode; const ANewSize: LongInt = 0); function GetDataLength: PtrInt; override; procedure SetDataLength(const AValue: PtrInt); override; function InternalGetUnionValue: RGMUnionValue; override; procedure InternalSetUnionValue(const AValue: RGMUnionValue); override; procedure InternalSetNullValue; override; function InternalBuildDisplayText: TGMString; override; public constructor Create(const AOwner: TObject; const ADataType: TGMDBColumnDataType; const AZeroInit: Boolean = False; const AFreeMemoryOnDestroy: Boolean = True; const ARefLifeTime: Boolean = False); override; function WriteAt(ulOffset: Int64; pv: Pointer; cb: LongInt; pcbWritten: PLongint): HResult; override; function AskInteger(const AValueId: LongInt): LongInt; virtual; stdcall; //function ODBCFetchSuccess: Boolean; function IsNull: Boolean; override; procedure Invalidate(const AResetOffset, ASetToNULL: Boolean); override; function CalculateBufferSize: LongInt; override; // procedure SetUnionValue(const AValue: RGMUnionValue); override; //procedure ReadFirstData; virtual; procedure AssignFromIntf(const Source: IUnknown); override; function IsBookmarkColumn: Boolean; virtual; end; TODBCFieldValueBuffer = class(TODBCFieldStateValueBuffer) protected FSavedDataLength: Integer; // FFirstDataSize: Integer; FBufferBound: Boolean; procedure OnAfterRealloc(const Sender: TObject); override; public // constructor CreateFieldBuffer(const AOwner: TObject; // const ADataType: TGMDBColumnDataType; // const AColumnPosition: LongInt; // const AFieldName: TGMString; // const ASizeInBytes: Cardinal; // const AMaxStrLength: Cardinal; // const AStatementHandle: THandle); override; destructor Destroy; override; function IsFixedBufferSize: Boolean; override; procedure SetupDataLengthForUpdate; procedure RestoreDataLength; function IsBookmarkColumn: Boolean; override; function CalculateBufferSize: LongInt; override; // procedure InvalidateAndReadFirstData(const AResetOffset: Boolean); virtual; //procedure Invalidate(const AResetOffset: Boolean); override; //procedure InternalFetchData(const AForDisplayText: Boolean = False); override; // procedure FetchBlobData; virtual; //procedure ReadFirstData; override; // procedure StoreBlobData(const CompressionType: Integer); procedure StoreBlobData; procedure BindBuffer(const ABind: Boolean); virtual; //procedure BindBlobBuffer(const ABind: Boolean); // procedure AssignFromIntf(const ASource: IUnknown); override; function CreateValueStream(const AMode: DWORD): ISequentialStream; override; end; TGMOdbcField = class(TGMDBField) // IGMAccessValueBuffer protected function ValueBufferCreateClass: TGMFieldValueBufferClass; override; // function AccessValueBuffer(const AAccessMode: LongInt; const AIID: TGUID; out Intf; const AValueBufferInstance: LongInt = Ord(vbiValue)): HResult; virtual; stdcall; public // procedure AfterActiveChange(const ANewActive: Boolean); override; // procedure AfterPositionChange; override; // procedure AfterOperation(const AOperation: Integer; const AParameter: IUnknown = nil); override; public //constructor Create(const ARecordset: TObject; const ACreateData: RGMFieldCreateData); override; //destructor Destroy; override; function ODBCValueBuffer(const AValueBufferInstance: EGMValueBufferInstance): TODBCFieldValueBuffer; procedure BindBuffer(const ABind: Boolean); procedure StoreBlobData; procedure SetupDataLengthForUpdate; procedure RestoreDataLength; procedure SwapBufferMap; override; end; TGMOdbcFieldClass = class of TGMOdbcField; TStmtCNAwareSubProperty = class(TOdbcComponentSubProperty) protected FUseValueFromConnection: Boolean; procedure SetUseValueFromConnection(const AValue: Boolean); public constructor Create(const AOwner: TGMActivatableObject); reintroduce; overload; function IsEqualTo(const AValue: TStmtCNAwareSubProperty): Boolean; virtual; procedure AssignFromObj(const ASource: TObject); procedure SetODBCValue; virtual; abstract; procedure ValueFromConnectionChanged; virtual; abstract; procedure LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall; procedure StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall; //published property UseValueFromConnection: Boolean read FUseValueFromConnection write SetUseValueFromConnection default cDfltUseConnectionValue; end; TStmtTimeoutProperties = class(TStmtCNAwareSubProperty) protected FTimeoutForStatements: SQLUINTEGER; function GetTimeoutForStatements: SQLUINTEGER; procedure SetODBCTimeoutForStatements(const AValue: PtrUInt); procedure SetTimeoutForStatements(const AValue: SQLUINTEGER); public constructor Create(const AOwner: TGMActivatableObject = nil); reintroduce; overload; function IsEqualTo(const AValue: TStmtCNAwareSubProperty): Boolean; override; procedure AssignFromObj(const Source: TObject); procedure SetODBCValue; override; procedure ValueFromConnectionChanged; override; procedure LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); override; procedure StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); override; //published property TimeoutForStatements: SQLUINTEGER read GetTimeoutForStatements write SetTimeoutForStatements default cDfltStatementTimeout; end; TStmtAsyncOperationProperties = class(TStmtCNAwareSubProperty) protected FAsynchronOperations: Boolean; function GetAsynchronOperations: Boolean; procedure SetODBCAsynchronOperations(const AValue: Boolean); procedure SetAsynchronOperations(const AValue: Boolean); public constructor Create(const AOwner: TGMActivatableObject = nil); reintroduce; overload; function IsEqualTo(const AValue: TStmtCNAwareSubProperty): Boolean; override; procedure AssignFromObj(const Source: TObject); procedure SetODBCValue; override; procedure ValueFromConnectionChanged; override; procedure LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); override; procedure StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); override; //published property AsynchronOperations: Boolean read GetAsynchronOperations write SetAsynchronOperations default cDfltAsyncOperations; end; TStmtCatalogNameCaseProperties = class(TStmtCNAwareSubProperty) protected FCaseSensitiveCatalogNames: Boolean; function GetCaseSensitiveCatalogNames: Boolean; procedure SetODBCCaseSensitiveCatalogNames(const AValue: Boolean); procedure SetCaseSensitiveCatalogNames(const AValue: Boolean); public constructor Create(const AOwner: TGMActivatableObject = nil); reintroduce; overload; function IsEqualTo(const AValue: TStmtCNAwareSubProperty): Boolean; override; procedure AssignFromObj(const Source: TObject); procedure SetODBCValue; override; procedure ValueFromConnectionChanged; override; procedure LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); override; procedure StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); override; //published property CaseSensitiveCatalogNames: Boolean read GetCaseSensitiveCatalogNames write SetCaseSensitiveCatalogNames default cDfltCaseSensitiveCatalogNames; end; TGMOdbcStatementProperties = class(TGMRefCountedObj, IGMLoadStoreData, IGMAssignFromObj, IGMAssignToObj, IGMAssignToIntf, IGMAssignFromIntf) protected FAssignSQL: Boolean; FSQL: TGMString; FReExecuteAfterSQLChange: Boolean; FUseSQLEscapeSequences: Boolean; FTimedReExecutionDelay: Integer; FTimeoutProperties: TStmtTimeoutProperties; FAsyncOperationProperties: TStmtAsyncOperationProperties; FCatalogNameCaseProperties: TStmtCatalogNameCaseProperties; procedure SetTimeoutProperties(const AValue: TStmtTimeoutProperties); procedure SetAsyncOperationProperties(const AValue: TStmtAsyncOperationProperties); procedure SetCatalogNameCaseProperties(const AValue: TStmtCatalogNameCaseProperties); procedure SetDefaultValues; virtual; public constructor Create(const AAssignSQL: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; constructor Create(const ASource: TObject; const AAssignSQL: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; constructor Create(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil; const AAssignSQL: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; destructor Destroy; override; procedure AssignFromObj(const ASource: TObject); virtual; stdcall; procedure AssignToObj(const ADest: TObject); virtual; stdcall; procedure AssignToIntf(const ADest: IUnknown); stdcall; procedure AssignFromIntf(const ASource: IUnknown); stdcall; procedure LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall; procedure StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall; property AssignSQL: Boolean read FAssignSQL; //published property SQL: TGMString read FSQL write FSQL; property ReExecuteAfterSQLChange: Boolean read FReExecuteAfterSQLChange write FReExecuteAfterSQLChange default cDfltReExecuteAfterSQLChange; property UseSQLEscapeSequences: Boolean read FUseSQLEscapeSequences write FUseSQLEscapeSequences default cDfltUseSQLEscapeSequences; property TimedReExecutionDelay: Integer read FTimedReExecutionDelay write FTimedReExecutionDelay default cDfltReExecutionDelay; property TimeoutProperties: TStmtTimeoutProperties read FTimeoutProperties write SetTimeoutProperties; property AsyncOperationProperties: TStmtAsyncOperationProperties read FAsyncOperationProperties write SetAsyncOperationProperties; property CatalogNameCaseProperties: TStmtCatalogNameCaseProperties read FCatalogNameCaseProperties write SetCatalogNameCaseProperties; end; TRecordStausArray = array [0..cRowArraySize-1] of SQLUSMALLINT; TGMOdbcStatementBase = class(TGMSqlStatementBase, IGMGetHandleType) protected FUseSQLEscapeSequences: Boolean; FTimeoutProperties: TStmtTimeoutProperties; FAsyncOperationProperties: TStmtAsyncOperationProperties; FCatalogNameCaseProperties: TStmtCatalogNameCaseProperties; function GetOdbcConnection: TGMOdbcConnection; procedure SetUseSQLEscapeSequences(const AValue: Boolean); procedure SetTimeoutProperties(const AValue: TStmtTimeoutProperties); procedure SetAsyncProperties(const AValue: TStmtAsyncOperationProperties); procedure SetCatalogNameCaseProperties(const AValue: TStmtCatalogNameCaseProperties); procedure SetODBCConnection(const AValue: TGMOdbcConnection); procedure AllocHandle; override; procedure ReleaseHandle; override; procedure SetODBCAttributes; virtual; procedure APIExecuteSQL(const ASQLText: TGMString); override; public constructor Create(const ARefLifeTime: Boolean); overload; override; destructor Destroy; override; procedure AssignFromObj(const Source: TObject); override; function GetHandleType: LongWord; stdcall; procedure CancelExecution; function StillExecuting: Boolean; function AffectedRecordCount: SQLLEN; property HandleType: LongWord read GetHandleType; //published property ActivationProperties; property OnBeforeActiveChange; property OnAfterActiveChange; property CallEventsWhenDisabled; property ODBCConnection: TGMOdbcConnection read GetOdbcConnection write SetODBCConnection; property TimeoutProperties: TStmtTimeoutProperties read FTimeoutProperties write SetTimeoutProperties; property AsynchronOperationProperties: TStmtAsyncOperationProperties read FAsyncOperationProperties write SetAsyncProperties; property CatalogNameCaseProperties: TStmtCatalogNameCaseProperties read FCatalogNameCaseProperties write SetCatalogNameCaseProperties; property TimedReExecutionDelay: Integer read GetTimedReExecutionDelay write SetTimedReExecutionDelay default cDfltReExecutionDelay; property UseSQLEscapeSequences: Boolean read FUseSQLEscapeSequences write SetUseSQLEscapeSequences default cDfltUseSQLEscapeSequences; property OnAfterSQLChange; end; TGMOdbcStatement = class(TGMOdbcStatementBase) //published property SQL; property UseSQLEscapeSequences; end; TOdbcFieldState = class(TGMFieldStateHolder) protected function ValueBufferCreateClass: TGMValueBufferClass; override; end; TGMOdbcRecordsetState = class(TGMRecordsetStateHolder) protected function FieldStateCreateClass: TGMFieldStateCreateClass; override; end; TGMOdbcRecordsetProperties = class; IGMOdbcRecordsetProperties = interface(IGMAssignToObj) ['{02C7DF42-9CCF-45C8-8A34-B7101E588EB7}'] function Obj: TGMOdbcRecordsetProperties; end; TGMOdbcRecordsetProperties = class(TGMOdbcStatementProperties, IGMOdbcRecordsetProperties) protected FAttributes: TGMRecordsetAttributes; FUpdateStrategy: TUpdateStrategy; FPositionedUpdateSimulation: TPositionedUpdateSimulation; FCursorSensitivity: TCursorSensitivity; FCursorType: TGMCursorType; FKeysetSize: SQLUINTEGER; FMaxRecordsReturned: SQLUINTEGER; FMaxFieldDataSize: SQLUINTEGER; // FBlobCompressionType: Integer; // TGMCompressionType; FRecordCountStrategies: TRecordCountStrategies; // FMaxStringLengthOrigin: TGMMaxStringLengthOrigin; // FMaxStringLengthCharSizeFactor: Double; procedure SetDefaultValues; override; public function Obj: TGMOdbcRecordsetProperties; procedure AssignFromObj(const ASource: TObject); override; procedure AssignToObj(const ADest: TObject); override; procedure LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); override; procedure StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); override; //published property Attributes: TGMRecordsetAttributes read FAttributes write FAttributes default cDfltRSAttributes; property UpdateStrategy: TUpdateStrategy read FUpdateStrategy write FUpdateStrategy default cDfltUpdateStrategy; property PositionedUpdateSimulation: TPositionedUpdateSimulation read FPositionedUpdateSimulation write FPositionedUpdateSimulation default cDfltPositionedUpdateSimulation; property CursorSensitivity: TCursorSensitivity read FCursorSensitivity write FCursorSensitivity default cDfltCursorSensitivity; property CursorType: TGMCursorType read FCursorType write FCursorType default cDfltCursorType; property KeysetSize: SQLUINTEGER read FKeysetSize write FKeysetSize default cDfltKeysetSize; property MaxRecordsReturned: SQLUINTEGER read FMaxRecordsReturned write FMaxRecordsReturned default cDfltMaxRecords; property MaxFieldDataSize: SQLUINTEGER read FMaxFieldDataSize write FMaxFieldDataSize default cDfltMaxFieldDataSize; // property BlobCompressionType: Integer read FBlobCompressionType write FBlobCompressionType default cDfltBlobCompressionType; // TGMCompressionType property RecordCountStrategies: TRecordCountStrategies read FRecordCountStrategies write FRecordCountStrategies default cDfltRecordCountStrategies; // property MaxStringLengthOrigin: TGMMaxStringLengthOrigin read FMaxStringLengthOrigin write FMaxStringLengthOrigin; // property MaxStringLengthCharSizeFactor: Double read FMaxStringLengthCharSizeFactor write FMaxStringLengthCharSizeFactor; end; TGMOdbcRecordsetOperationEvent = procedure (Sender: TGMOdbcRecordsetBase; const Operation: TGMRecordsetOperation) of object; TGMOdbcRecordsetEvent = procedure (Sender: TGMOdbcRecordsetBase) of object; TGMOdbcRecordsetFieldValueChangeEvent = procedure (Sender: TGMOdbcRecordsetBase; const FieldName: TGMString) of object; TGMOdbcFieldCreateEvent = procedure (const FieldName: TGMString; var CreateData: RGMFieldCreateData) of object; RGMFetchResult = record ResultCode: SQLRETURN; ErrorText: TGMString; end; TGMOdbcRecordsetBase = class(TGMOdbcStatementBase, IGMUnidirectionalCursor, IGMBidirectionalCursor, IGMCursorFirstLast, IGMGetPosition, IGMGetSetPosition, IGMGetIntfByName, IGMGetIntfByPosition, IGMGetCount, IGMLookupValues, IGMLocateValues, IGMPositionOfValues, IGMGetAttributes, IGMGetSetAttributes, IGMNamedValueChange, IGMAskBoolean, IGMAskInteger, IGMLoadStoreData) protected FFieldPosList: TGMObjArrayCollection; FFieldNameList: TGMObjArrayCollection; FSearchName: IGMGetSetName; FCascadedContentsProperties: TGMCascadedContentsProperties; FRecordCountStrategies: TRecordCountStrategies; FUpdateStrategy: TUpdateStrategy; FPositionedUpdateSimulation: TPositionedUpdateSimulation; FCursorSensitivity: TCursorSensitivity; FCursorType: TGMCursorType; FKeysetSize: SQLUINTEGER; FMaxRecordsReturned: SQLUINTEGER; FMaxFieldDataSize: SQLUINTEGER; FRecordCount: PtrInt; FPosition: PtrInt; FFetchResult: RGMFetchResult; FAttributes: TGMRecordsetAttributes; // FBlobCompressionType: Integer; // TGMCompressionType; FRowStatusArray: TRecordStausArray; // FMaxStringLengthOrigin: TGMMaxStringLengthOrigin; // FMaxStringLengthCharSizeFactor: Double; FOnBeforeOperation: TGMOdbcRecordsetOperationEvent; FOnAfterOperation: TGMOdbcRecordsetOperationEvent; FOnBeforePositionChange: TGMOdbcRecordsetEvent; FOnAfterPositionChange: TGMOdbcRecordsetEvent; FOnAfterFieldValueChange: TGMOdbcRecordsetFieldValueChangeEvent; FOnValidateFieldValues: TGMOdbcRecordsetEvent; FOnCreateField: TGMOdbcFieldCreateEvent; function ActivationPropertyCreateClass: TGMActivationPropertyClass; override; function GetODBCRowNumber: SQLLEN; function ODBCRecordCount: SQLLEN; procedure SetODBCUseSQLEscapeSequences(const AValue: Boolean); procedure SetODBCCursorType(const AValue: TGMCursorType); procedure SetODBCUpdateStrategy(const AValue: TUpdateStrategy); procedure SetODBCCursorScrollable(const AValue: Boolean); procedure SetODBCCursorSensitivity(const AValue: TCursorSensitivity); procedure SetODBCPositionedUpdateSimulation(const AValue: TPositionedUpdateSimulation); procedure SetODBCKeysetSize(const AValue: SQLULEN); procedure SetODBCMaxRecordsReturned(const AValue: SQLULEN); procedure SetODBCMaxFieldDataSize(const AValue: SQLULEN); procedure SetODBCBookmarksEnabled(const AValue: Boolean); procedure SetODBCRowArraySize(const AValue: PtrUInt); procedure SetODBCRowStatusPtr(const AValue: SQLPOINTER); procedure SetUpdateStrategy(const AValue: TUpdateStrategy); procedure SetPositionedUpdateSimulation(const AValue: TPositionedUpdateSimulation); procedure SetCursorSensitivity(const AValue: TCursorSensitivity); procedure SetCursorType(const AValue: TGMCursorType); procedure SetKeysetSize(const AValue: SQLUINTEGER); procedure SetMaxRecordsReturned(const AValue: SQLUINTEGER); procedure SetMaxFieldDataSize(const AValue: SQLUINTEGER); // procedure SetBlobCompressionType(const Value: Integer); // TGMCompressionType procedure IDESetAttributes(const AValue: TGMRecordsetAttributes); procedure SetCascadedContentsProperties(const AValue: TGMCascadedContentsProperties); procedure ResetMembers; override; procedure AllocHandle; override; procedure ReleaseHandle; override; procedure SetODBCAttributes; override; procedure InternalApplyChanges; virtual; function GetODBCFieldCount: SQLSMALLINT; // virtual; procedure CreateFields; virtual; procedure ClearFieldLists; virtual; procedure DoCursorMove(const ADirection: SQLSMALLINT; AOffset: SQLLEN; const AMethodName: TGMString); procedure DoCursorFetch(const ADirection: SQLSMALLINT; AOffset: SQLLEN; const AMethodName: TGMString; const ANotifyPositionChange: Boolean = True); procedure CheckLocateValues(const Values: IGMGetIntfByPosition); function LocateResult(const Values: IGMGetIntfByPosition; const FindPos: LongInt): Boolean; procedure NotifyConnectedObjectsBeforeOperation(const Operation: Integer; const Parameter: IUnknown = nil); procedure NotifyConnectedObjectsAfterOperation(const Operation: Integer; const Parameter: IUnknown = nil); procedure NotifyConnectedObjectsBeforePositionChange; override; procedure NotifyConnectedObjectsAfterPositionChange; override; procedure NotifyBeforeOperation(const Operation: Integer; const Parameter: IUnknown = nil); override; procedure NotifyAfterOperation(const Operation: Integer; const Parameter: IUnknown = nil); override; procedure NotifyBeforePositionChange; virtual; procedure NotifyAfterPositionChange; virtual; procedure NotifyBeforeActiveChange(const NewActive: Boolean); override; procedure NotifyAfterActiveChange(const ANewActive: Boolean); override; procedure NotifyValidateFieldValues; virtual; public constructor Create(const ARefLifeTime: Boolean); override; constructor Create(const AConnection: IUnknown; const ASql: TGMString; const ACursorType: TGMCursorType; const ARefLifeTime: Boolean = True); reintroduce; overload; destructor Destroy; override; procedure AssignFromObj(const Source: TObject); override; function CanModify: Boolean; override; function PositionalInsert: Boolean; function IsEmpty: Boolean; virtual; function ODBCFetchSuccess: Boolean; { ---- IGMFreeCursor ---- } function GetBOF: Boolean; virtual; stdcall; function GetEOF: Boolean; virtual; stdcall; //function GetIsEmpty: Boolean; virtual; stdcall; procedure MoveToNext; virtual; stdcall; procedure MoveToPrevious; virtual; stdcall; procedure MoveToFirst; virtual; stdcall; procedure MoveToLast; virtual; stdcall; { ---- IGMGetSetPosition ---- } function GetPosition: PtrInt; virtual; stdcall; procedure SetPosition(const AValue: PtrInt); virtual; stdcall; property Position: PtrInt read GetPosition write SetPosition; { ---- Operations ---- } function CanExecuteOperation(const AOperation: Integer; const AParameter: IUnknown = nil): Boolean; override; function ExecuteOperation(const AOperation: Integer; const AParameter: IUnknown = nil): Boolean; override; procedure Edit; virtual; procedure Insert(const Parameter: IUnknown = nil); virtual; procedure RefreshRecord; virtual; procedure Delete; virtual; procedure CancelChanges; virtual; procedure Applychanges; virtual; procedure SetSimplestConfiguration; virtual; procedure LeaveModifyingState; virtual; { ---- IGMGetFieldIntfXxxx ---- } function GetIntfByName(const AFieldName: TGMString; const AIID: TGUID; out AIntf): HResult; overload; virtual; stdcall; function GetIntfByPosition(const AFieldPosition: PtrInt; const AIID: TGUID; out AIntf): HResult; overload; virtual; stdcall; { ---- IGMEnumerateItems ---- } procedure EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer = nil); override; { ---- IGMGetCount ---- } function ComputeRecordCount: SQLLEN; virtual; //function CountBySelectStatement: SQLLEN; function GetCount: PtrInt; virtual; stdcall; { ---- IGMSaveRestoreState ---- } function CaptureState: IUnknown; override; procedure RestoreState(const State: IUnknown); override; { ---- IGMLookupValues ---- } function LookupValues(const SQLCriteria: TGMString; const Values: IUnknown): Boolean; virtual; stdcall; { ---- IGMFindValues ---- } function PositionOfNearestValues(const Values: IGMGetIntfByPosition): LongInt; virtual; stdcall; function PositionOfValues(const Values: IUnknown; var FindPos: LongInt): Boolean; virtual; stdcall; function LocateValues(const Values: IUnknown): Boolean; virtual; stdcall; { ---- IGMNamedValueChange ---- } procedure AfterValueChange(const FieldName: TGMString); virtual; { ---- IGMGetSetAttributes ---- } function GetAttributes: Longword; virtual; stdcall; procedure SetAttributes(const AValue: Longword); virtual; stdcall; { ---- IGMAskXxxxx ---- } function AskBoolean(const AValueId: LongInt): LongInt; virtual; stdcall; function AskInteger(const AValueId: LongInt): LongInt; virtual; stdcall; // ---- IGMLoadStoreData ---- // procedure LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall; procedure StoreData(const Dest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall; function GetFieldByIndex(const AIndex: RGMUnionValue): TGMOdbcField; // virtual; function GetFieldValue(const AIndex: RGMUnionValue): RGMUnionValue; //virtual; procedure SetFieldValue(const AIndex: RGMUnionValue; const AValue: RGMUnionValue); // virtual; property FieldPosList: TGMObjArrayCollection read FFieldPosList; property FieldNameList: TGMObjArrayCollection read FFieldNameList; property ODBCFieldCount: SQLSMALLINT read GetODBCFieldCount; property FieldValue[const Index: RGMUnionValue]: RGMUnionValue read GetFieldValue write SetFieldValue; default; property BOF: Boolean read GetBOF; property EOF: Boolean read GetEOF; property Count: PtrInt read GetCount; property RowStatusArray: TRecordStausArray read FRowStatusArray; property FetchResult: RGMFetchResult read FFetchResult; //published property Attributes: TGMRecordsetAttributes read FAttributes write IDESetAttributes default cDfltRSAttributes; property UpdateStrategy: TUpdateStrategy read FUpdateStrategy write SetUpdateStrategy default cDfltUpdateStrategy; property PositionedUpdateSimulation: TPositionedUpdateSimulation read FPositionedUpdateSimulation write SetPositionedUpdateSimulation default cDfltPositionedUpdateSimulation; property CursorSensitivity: TCursorSensitivity read FCursorSensitivity write SetCursorSensitivity default cDfltCursorSensitivity; property CursorType: TGMCursorType read FCursorType write SetCursorType default cDfltCursorType; property KeysetSize: SQLUINTEGER read FKeysetSize write SetKeysetSize default cDfltKeysetSize; property MaxRecordsReturned: SQLUINTEGER read FMaxRecordsReturned write SetMaxRecordsReturned default cDfltMaxRecords; property MaxFieldDataSize: SQLUINTEGER read FMaxFieldDataSize write SetMaxFieldDataSize default cDfltMaxFieldDataSize; // property BlobCompressionType: Integer read FBlobCompressionType write SetBlobCompressionType default cDfltBlobCompressionType; // TGMCompressionType property RecordCountStrategies: TRecordCountStrategies read FRecordCountStrategies write FRecordCountStrategies default cDfltRecordCountStrategies; property CascadedContentsProperties: TGMCascadedContentsProperties read FCascadedContentsProperties write SetCascadedContentsProperties; // property MaxStringLengthOrigin: TGMMaxStringLengthOrigin read FMaxStringLengthOrigin write FMaxStringLengthOrigin; // property MaxStringLengthCharSizeFactor: Double read FMaxStringLengthCharSizeFactor write FMaxStringLengthCharSizeFactor; property OnBeforeOperation: TGMOdbcRecordsetOperationEvent read FOnBeforeOperation write FOnBeforeOperation; property OnAfterOperation: TGMOdbcRecordsetOperationEvent read FOnAfterOperation write FOnAfterOperation; property OnAfterFieldValueChange: TGMOdbcRecordsetFieldValueChangeEvent read FOnAfterFieldValueChange write FOnAfterFieldValueChange; property OnBeforePositionChange: TGMOdbcRecordsetEvent read FOnBeforePositionChange write FOnBeforePositionChange; property OnAfterPositionChange: TGMOdbcRecordsetEvent read FOnAfterPositionChange write FOnAfterPositionChange; property OnValidateFieldValues: TGMOdbcRecordsetEvent read FOnValidateFieldValues write FOnValidateFieldValues; property OnCreateField: TGMOdbcFieldCreateEvent read FOnCreateField write FOnCreateField; end; TGMOdbcRecordset = class(TGMOdbcRecordsetBase, IGMGetMasterSource, IGMGetSetMasterSource) protected FMasterSource: TGMRecordsetMasterSource; procedure IDESetMasterSource(const AValue: TGMRecordsetMasterSource); procedure AfterMasterActiveChange(const ANewActive: Boolean); virtual; procedure AfterMasterPositionChange; virtual; procedure AfterMasterOperation(const AOperation: LongInt; const AParameter: IUnknown = nil); virtual; procedure AfterMasterFieldValueChange(ASender: IUnknown; const AFieldName: TGMString); virtual; public constructor Create(const ARefLifeTime: Boolean); override; destructor Destroy; override; function GetMasterSource: IUnknown; procedure SetMasterSource(const AValue: IUnknown); procedure EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer = nil); override; function GetResolvedSQLStatement: TGMString; override; // procedure CheckSQLStatementText(const SQL: TGMString); override; procedure Insert(const Parameter: IUnknown = nil); override; procedure OpenMasterSource(const MethodName: TGMString); procedure AssignMasterParamValues; virtual; procedure AssignFieldValuesFromMasterSource; virtual; //published property SQL; property UseSQLEscapeSequences; property MasterSource: TGMRecordsetMasterSource read FMasterSource write IDESetMasterSource; end; TGMOdbcGroupSlaveRS = class(TGMOdbcRecordset) public constructor Create(const ARefLifeTime: Boolean); override; procedure ScheduleReExecution(const ColumnsStayValid: Boolean = True); override; end; TGMOdbcSchemaRecordset = class(TGMOdbcRecordsetBase, IGMSchemaProperties, IGMGetText) protected FSchemaData: TGMSchemaProperties; //procedure SetSchemaData(const Value: TGMSchemaProperties); procedure InternalExecute; override; procedure AfterSchemaDataChange(const Sender: TObject); //function GetText: TGMString; virtual; stdcall; // function GetODBCFieldCount: SQLSMALLINT; override; public constructor Create(const ARefLifeTime: Boolean); override; overload; destructor Destroy; override; //function Obj: TGMOdbcSchemaRecordset; //function GetPropertyIntf(const PropertyName: TGMString; const IID: TGUID; out Intf): HResult; override; //procedure SetSimplestConfiguration; override; procedure AssignFromObj(const ASource: TObject); override; property SchemaData: TGMSchemaProperties read FSchemaData implements IGMSchemaProperties, IGMGetText; // write SetSchemaData end; TODBCFieldClasses = array [TGMDBColumnDataType] of TGMOdbcFieldClass; TGMEnumDSNProc = procedure (const AValue: TGMString; const AObj: TObject = nil); // of object; var vODBCFieldCreateClasses: TODBCFieldClasses = ( TGMOdbcField, // fdtBoolean TGMOdbcField, // fdtBoolean TGMOdbcField, // fdtInt8 TGMOdbcField, // fdtUInt8 TGMOdbcField, // fdtInt16 TGMOdbcField, // fdtUInt16 TGMOdbcField, // fdtInt32 TGMOdbcField, // fdtUInt32 TGMOdbcField, // fdtInt64 TGMOdbcField, // fdtUInt64 TGMOdbcField, // fdtSingle TGMOdbcField, // fdtDouble TGMOdbcField, // fdtNumeric TGMOdbcField, // fdtDate TGMOdbcField, // fdtTime TGMOdbcField, // fdtDateTime TGMOdbcField, // fdtAnsiString TGMOdbcField, // fdtUnicodeString TGMOdbcField, // fdtAnsiText TGMOdbcField, // fdtUnicodeText TGMOdbcField, // fdtBinary TGMOdbcField // fdtGUID ); function ODBCCalculateValueBufferSize(const AFieldDataType: TGMDBColumnDataType; const ASizeInBytes: PtrInt; const ACallingRoutineName: TGMString): Integer; function ODBCTypeFromFieldDataType(const ADataType: TGMDBColumnDataType; const ACallingRoutineName: TGMString): SQLSMALLINT; function SQLTypeFromFieldDataType(const ADataType: TGMDBColumnDataType; const ACallingRoutineName: TGMString): SQLSMALLINT; function FieldTypeFromODBCType(const AODBCDataType: SQLINTEGER; // const ATypeName: TGMstring; // const AOctetLength: SQLINTEGER; const ASigned: Boolean; const AObj: TObject = nil; const ACallingRoutineName: TGMString = cDfltRoutineName): TGMDBColumnDataType; procedure ODBCEnumDSN(const AEnvironment: TGMOdbcEnvironment; const ADSNKind: TDSNKind; const ADSNEnumProc: TGMEnumDSNProc; const AObj: TObject; const AFormatStr: TGMString); procedure ODBCEnumUserDSN(const Environment: TGMOdbcEnvironment; const DSNEnumProc: TGMEnumDSNProc; const Obj: TObject = nil; const FormatStr: TGMString = cDfltDSNFmtStr); procedure ODBCEnumSystemDSN(const Environment: TGMOdbcEnvironment; const DSNEnumProc: TGMEnumDSNProc; const Obj: TObject = nil; const FormatStr: TGMString = cDfltDSNFmtStr); //function GMOdbcSelectSingleValue(const ODBCConnection: TGMOdbcConnection; const FieldName, TableName, SQLWhere: TGMString): RGMUnionValue; overload; //function GMOdbcSelectSingleValue(const ODBCConnection: TGMOdbcConnection; const SelectedDields, ResultField, TableName, SQLWhere: TGMString): RGMUnionValue; overload; function GMOdbcSelectSingleValue(const AOdbcConnection: IUnknown; const ASqlText: TGMString; const AResultField: RGMUnionValue): RGMUnionValue; //procedure GMExploreODBCConnection(const ODBCConnection: TGMOdbcConnection); function GMCursorOriginName(const ACursorOrigin: TCursorOrigin): TGMString; function GMTransactionIsolationName(const ATransactionIsolation: TTransactionIsolation): TGMString; function GMDriverDialogName(const ADriverDialog: TOdbcAllowDriverDialogs): TGMString; function GMAccessModeName(const AAccessMode: TAccessMode): TGMString; function GMCursorTypeName(const ACursorType: TGMCursorType): TGMString; function GMCursorSensitivityName(const ACursorSensitivity: TCursorSensitivity): TGMString; function GMUpdateStrategyName(const AUpdateStrategy: TUpdateStrategy): TGMString; function GMUpdateSimulationName(const AUpdateSimulation: TPositionedUpdateSimulation): TGMString; function GMCountStrategyName(const ACountStrategy: TRecordCountStrategy): TGMString; function GMOdbcConnectionAttrName(const AConnectionAttribute: TOdbcConnectionAttribute): TGMString; //function GMMaxStrLenOriginName(const AMaxStrLenOrigin: TGMMaxStringLengthOrigin): TGMString; const //cStrOdbcSelectDSNDlg = 'ODBC Select DSN Dialog'; cPrsConnectionString = 'ConnectionString'; cPrsCursorOrigin = 'Cursor Origin'; cPrsUsername = 'Username'; cPrsPassword = 'Password'; cPrsLoginTimeout = 'LoginTimeout'; cPrsStatementTimeout = 'StatementTimeout'; cPrsTransactionIsolation = 'TransactionIsolation'; cStrAccessMode = 'AccessMode'; cPrsDriverDialogs = 'DriverDialogs'; //cStrAsyncOperations = 'AsynchronOperations'; //cStrAutoCommitTrans = 'AutocommitTransactions'; cPrsUseTimeoutValueFromConnection = 'UseTimeoutFromConnection'; cPrsUseAsyncValueFromConnection = 'UseAsynchronFromConnection'; cPrsAsynchronOperations = 'AsynchronOperations'; cPrsUseCaseValueFromConnection = 'UseCatalogcaseFromConnection'; cPrsCaseSensitiveCatalogNames = 'CaseSensitiveCatalogNames'; cPrsReExecuteAfterSQLChange = 'ReexecuteAfterSQlChange'; cPrsUseSQLEscapeSequences = 'UseSQLEscapeSequences'; cPrsTimedReExecutionDelay = 'TimedReExecutionDelay'; cPrsAttributes = 'Attributes'; cPrsUpdateStrategy = 'UpdateStrategy'; cPrsPositionedUpdateSimulation = 'PositionedUpdateSimulation'; cPrsCursorSensitivity = 'CursorSensitivity'; cPrsCursorType = 'CursorType'; cPrsKeysetSize = 'KeysetSize'; cPrsMaxRecordsReturned = 'MaximumRecordsReturned'; cPrsMaxFieldDataSize = 'MaximumFieldDataSize'; //cPrsBlobCompressionType = 'BLOBCompressionKind'; //cPrsMaxStringLengthOrigin = 'MaxStringLengthOrigin'; //cPrsMaxStringLengthCharSizeFactor = 'MaxStringLengthCharSizeFactor'; cPrsCountStrategies = 'CountStrategies'; cSqlReplacements = #253#254#255; cSqlReplaceChars = #9#10#13; resourcestring srDSN = 'DSN'; srUser = 'User'; srSystem = 'System'; srcoUseODBCCursorsIfNeeded = 'Use ODBC cursors if needed'; srcoUseODBCCursors = 'Use ODBC cursors'; srcoUseDriverCursors = 'Use driver cursors'; srReadUnCommitted = 'Read uncommitted'; srReadCommitted = 'Read committed'; srRepeatableRead = 'Repeatable read'; srSerializable = 'Serializable'; srNoDriverDialogs = 'No driver dialogs'; srPromtIfIncomplete = 'Promt only if incomplete'; srAlwaysPromt = 'Always Promt'; srPromtReqiredOnly = 'Always promt for required properties only'; srReadWrite = 'Read/Write'; srReadOnly = 'Readonly'; srUnidirectional = 'Unidirectional'; srStatic = 'Static'; srKeyset = 'Keyset'; srDynamic = 'Virtual'; srUnspecified = 'Unspecified'; srInsensitive = 'Insensitive'; srReflectChanges = 'Reflect changes made by others'; srMinimalLock = 'Minimal lock'; srCompareRecordVersionBeforeWrite = 'Compare record version before write'; srCompareValuesBeforeWrite = 'Compare values before write'; srUseDriverDefault = 'Use driver default value'; srAllowNonUniqueUpdate = 'Allow Non-Unique Update'; srTryUniqueUpdate = 'Try Unique Update'; srGuaranteeUniqueUpdate = 'Guarantee Unique Update'; srUseCountFromODBCDriver = 'Use count from ODBC driver'; srUseSelectCountStatement = 'Use Select Count(*) statement'; srCountByLogarithmicPositioning = 'Count by logarithmic positioning'; srAsynchronOperations = 'Asynchron operations'; srAutoCommitTransactions = 'Autocommit transactions'; srCaseSensitiveCatalogNames = 'Casesensitive catalog names'; srCompleteConnectionString = 'Complete connectionstring'; //RStrslcbCharLength = 'Derive from size in Characters'; //RStrslcbByteLength = 'Derive from size in Byte(s)'; //var //gCursorOriginNames: array [TCursorOrigin] of TGMString = (RStrcoUseODBCCursorsIfNeeded, RStrcoUseODBCCursors, RStrcoUseDriverCursors); //gTransactionIsolationNames: array [TTransactionIsolation] of TGMString = (RStrReadUnCommitted, RStrReadCommitted, RStrRepeatableRead, RStrSerializable); //vDriverDialogNames: array [TOdbcAllowDriverDialogs] of TGMString = (RStrNoDriverDialogs, RStrPromtIfIncomplete, RStrAlwaysPromt, RStrPromtReqiredOnly); //gAccessModeNames: array [TAccessMode] of TGMString = (RStrReadWrite, RStrReadOnly); //gCursorTypeNames: array [TGMCursorType] of TGMString = (RStrUnidirectional, RStrStatic, RStrKeyset, RStrDynamic); //gCursorSensitivityNames: array [TCursorSensitivity] of TGMString = (RStrUnspecified, RStrInsensitive, RStrReflectChanges); //gUpdateStrategyNames: array [TUpdateStrategy] of TGMString = (RStrReadOnly, RStrMinimalLock, RStrCompareRecordVersionBeforeWrite, RStrCompareValuesBeforeWrite); //gUpdateSimulationNames: array [TPositionedUpdateSimulation] of TGMString = (RStrAllowNonUniqueUpdate, RStrTryUniqueUpdate, RStrGuaranteeUniqueUpdate); //gCountStrategyNames: array [TRecordCountStrategy] of TGMString = (RStrUseCountFromODBCDriver, RStrUseSelectCountStatement, RStrCountByLogarithmicPositioning); //vOdbcConnectionAttrNames: array [TOdbcConnectionAttribute] of TGMString = (RStrAsynchronOperations, RStrAutoCommitTransactions, RStrCaseSensitiveCatalogNames, RStrCompleteConnectionString); implementation uses GMWinCrypt, GMCharCoding {$IFDEF JEDIAPI},jwaWinError, jwaWinCrypt{$ENDIF} ; resourcestring srUnknownODBCFieldDataType = 'Unknown ODBC Field Data Type: %d'; srNoValuesToLocate = 'No Values passed to Locate'; srNoSortClauseForField = 'The Recordset is not sorted by Field: "%s"'; srNoFieldChangedBeforeInsert = 'No field value has been set before inserting a new Record'; //RStrBlobDisplayText = '<binary data, size: %d bytes, stored size: %d bytes, compression ratio: %d%%>'; srInvalidFormatParamCount = 'Invalid number of format parameters'; srUnsupportedStreamOperation = 'Unsupported Stream Operation: %s'; srUnsupportedSeekOffset = 'Unsupported Seek operation Offset: %d, Origin: %d'; srUnknownBlobFieldPos = 'Unable to send BLOB data, no Field with ordinal position: %d'; const scAllocHandle = 'AllocHandle'; //cInvalidDataSize = -1; { ------------------------- } { ---- Global Routines ---- } { ------------------------- } {procedure GMExploreODBCConnection(const ODBCConnection: TGMOdbcConnection); begin if ODBCConnection <> nil then with ODBCConnection do GMExecuteSQL2(ConnectionString, Username, Password); end;} function GMCursorOriginName(const ACursorOrigin: TCursorOrigin): TGMString; begin case ACursorOrigin of coUseODBCCursorsIfNeeded: Result := srcoUseODBCCursorsIfNeeded; coUseODBCCursors: Result := srcoUseODBCCursors; coUseDriverCursors: Result := srcoUseDriverCursors; else Result := ''; end; end; function GMTransactionIsolationName(const ATransactionIsolation: TTransactionIsolation): TGMString; begin case ATransactionIsolation of tiReadUncommitted: Result := srReadUnCommitted; tiReadCommitted: Result := srReadCommitted; tiRepeatableRead: Result := srRepeatableRead; tiSerializable: Result := srSerializable; else Result := ''; end; end; function GMDriverDialogName(const ADriverDialog: TOdbcAllowDriverDialogs): TGMString; begin case ADriverDialog of adpNoDriverDialogs: Result := srNoDriverDialogs; adpPromtIfIncomplete: Result := srPromtIfIncomplete; adpAlwaysPromt: Result := srAlwaysPromt; adpAlwaysPromtReqiredOnly: Result := srPromtReqiredOnly; else Result := ''; end; end; function GMAccessModeName(const AAccessMode: TAccessMode): TGMString; begin case AAccessMode of amReadWrite: Result := srReadWrite; amReadOnly: Result := srReadOnly; else Result := ''; end; end; function GMCursorTypeName(const ACursorType: TGMCursorType): TGMString; begin case ACursorType of ctUnidirectional: Result := srUnidirectional; ctStatic: Result := srStatic; ctKeyset: Result := srKeyset; ctDynamic: Result := srDynamic; else Result := ''; end; end; function GMCursorSensitivityName(const ACursorSensitivity: TCursorSensitivity): TGMString; begin case ACursorSensitivity of csUnspecified: Result := srUnspecified; csInsensitive: Result := srInsensitive; csReflectChanges: Result := srReflectChanges; csUseDriverDefault: Result := srUseDriverDefault; else Result := ''; end; end; function GMUpdateStrategyName(const AUpdateStrategy: TUpdateStrategy): TGMString; begin case AUpdateStrategy of usReadOnly: Result := srReadOnly; usMinimalLock: Result := srMinimalLock; usCompareRecordVersionBeforeWrite: Result := srCompareRecordVersionBeforeWrite; usCompareValuesBeforeWrite: Result := srCompareValuesBeforeWrite; usUseDriverDefault: Result := srUseDriverDefault; else Result := ''; end; end; function GMUpdateSimulationName(const AUpdateSimulation: TPositionedUpdateSimulation): TGMString; begin case AUpdateSimulation of pusAllowNonUniqueUpdate: Result := srAllowNonUniqueUpdate; pusTryUniqueUpdate: Result := srTryUniqueUpdate; pusGuaranteeUniqueUpdate: Result := srGuaranteeUniqueUpdate; pusUseDriverDefault: Result := srUseDriverDefault; else Result := ''; end; end; //function GMMaxStrLenOriginName(const AMaxStrLenOrigin: TGMMaxStringLengthOrigin): TGMString; //begin //case AMaxStrLenOrigin of // sloLengthInChars: Result := RStrslcbCharLength; // sloLengthInBytes: Result := RStrslcbByteLength; // else Result := ''; //end; //end; function GMCountStrategyName(const ACountStrategy: TRecordCountStrategy): TGMString; begin case ACountStrategy of csUseCountFromODBCDriver: Result := srUseCountFromODBCDriver; csUseSelectCountStatement: Result := srUseSelectCountStatement; csCountByLogarithmicPositioning: Result := srCountByLogarithmicPositioning; else Result := ''; end; end; function GMOdbcConnectionAttrName(const AConnectionAttribute: TOdbcConnectionAttribute): TGMString; begin case AConnectionAttribute of caAsynchronOperations: Result := srAsynchronOperations; caAutoCommitTransactions: Result := srAutoCommitTransactions; caCaseSensitiveCatalogNames: Result := srCaseSensitiveCatalogNames; caCompleteConnectionString: Result := srCompleteConnectionString; else Result := ''; end; end; function ODBCTypeFromFieldDataType(const ADataType: TGMDBColumnDataType; const ACallingRoutineName: TGMString): SQLSMALLINT; //var FieldType: TGMDBColumnDataType; begin //FieldType := ADataType; case ADataType of fdtBoolean: Result := SQL_C_BIT; fdtInt8: Result := SQL_C_STINYINT; fdtUInt8: Result := SQL_C_UTINYINT; fdtInt16: Result := SQL_C_SSHORT; fdtUInt16: Result := SQL_C_USHORT; fdtInt32: Result := SQL_C_SLONG; fdtUInt32: Result := SQL_C_ULONG; fdtInt64: Result := SQL_C_SBIGINT; fdtUInt64: Result := SQL_C_UBIGINT; fdtSingle: Result := SQL_C_FLOAT; fdtDouble: Result := SQL_C_DOUBLE; //fdtNumeric: Result := SQL_C_NUMERIC; fdtNumeric: Result := SQL_C_DOUBLE; fdtDate: Result := SQL_C_TYPE_DATE; fdtTime: Result := SQL_C_TYPE_TIME; fdtDateTime: Result := SQL_C_TYPE_TIMESTAMP; fdtAnsiString: Result := SQL_C_CHAR; fdtUnicodeString: Result := SQL_C_WCHAR; fdtBinary: Result := SQL_C_BINARY; fdtAnsiText: Result := SQL_C_CHAR; fdtUnicodeText: Result := SQL_C_WCHAR; fdtGUID: Result := SQL_C_GUID; else raise EGMException.ObjError(MsgUnknownFieldDataType(Ord(ADataType)), nil, ACallingRoutineName); end; end; function SQLTypeFromFieldDataType(const ADataType: TGMDBColumnDataType; const ACallingRoutineName: TGMString): SQLSMALLINT; //var FieldType: TGMDBColumnDataType; begin //FieldType := ADataType; case ADataType of fdtBoolean: Result := SQL_BIT; fdtInt8, fdtUInt8: Result := SQL_TINYINT; fdtInt16, fdtUInt16: Result := SQL_SMALLINT; fdtInt32, fdtUInt32: Result := SQL_INTEGER; fdtInt64, fdtUInt64: Result := SQL_BIGINT; fdtSingle: Result := SQL_REAL; fdtDouble: Result := SQL_DOUBLE; //fdtNumeric: Result := SQL_C_NUMERIC; fdtNumeric: Result := SQL_DOUBLE; fdtDate: Result := SQL_TYPE_DATE; fdtTime: Result := SQL_TYPE_TIME; fdtDateTime: Result := SQL_TYPE_TIMESTAMP; fdtAnsiString, fdtAnsiText: Result := SQL_CHAR; fdtUnicodeString, fdtUnicodeText: Result := SQL_WCHAR; fdtBinary: Result := SQL_BINARY; fdtGUID: Result := SQL_GUID; else raise EGMException.ObjError(MsgUnknownFieldDataType(Ord(ADataType)), nil, ACallingRoutineName); end; end; function ODBCCalculateValueBufferSize(const AFieldDataType: TGMDBColumnDataType; const ASizeInBytes: PtrInt; const ACallingRoutineName: TGMString): Integer; begin case AFieldDataType of fdtBoolean: Result := SizeOf(Byte); fdtInt8: Result := SizeOf(Byte); fdtUInt8: Result := SizeOf(Byte); fdtInt16: Result := SizeOf(Smallint); fdtUInt16: Result := SizeOf(Word); fdtInt32: Result := SizeOf(LongInt); fdtUInt32: Result := SizeOf(LongWord); fdtInt64: Result := SizeOf(Int64); fdtUInt64: Result := SizeOf(Int64); fdtSingle: Result := SizeOf(Single); fdtDouble: Result := SizeOf(Double); //fdtNumeric: Result := SizeOf(SQL_NUMERIC_STRUCT); fdtNumeric: Result := SizeOf(Double); fdtDate: Result := SizeOf(SQL_DATE_STRUCT); fdtTime: Result := SizeOf(SQL_TIME_STRUCT); fdtDateTime: Result := SizeOf(SQL_TIMESTAMP_STRUCT); fdtAnsiString: Result := ASizeInBytes + SizeOf(AnsiChar); fdtUnicodeString: Result := ASizeInBytes + SizeOf(WideChar); // ASizeInBytes + SizeOf(WideChar); fdtBinary: Result := 0; fdtAnsiText: Result := 0; fdtUnicodeText: Result := 0; fdtGUID: Result := SizeOf(SQLGUID); else raise EGMException.ObjError(MsgUnknownFieldDataType(Ord(AFieldDataType)), nil, ACallingRoutineName); end; end; function FieldTypeFromODBCType(const AODBCDataType: SQLINTEGER; const ASigned: Boolean; const AObj: TObject = nil; const ACallingRoutineName: TGMString = cDfltRoutineName): TGMDBColumnDataType; begin case AODBCDataType of SQL_CHAR, SQL_VARCHAR: Result := fdtAnsiString; SQL_WCHAR, SQL_WVARCHAR: Result := fdtUnicodeString; SQL_DECIMAL, SQL_NUMERIC: Result := fdtNumeric; SQL_TINYINT: if ASigned then Result := fdtInt8 else Result := fdtUInt8; SQL_SMALLINT: if ASigned then Result := fdtInt16 else Result := fdtUInt16; SQL_INTEGER: if ASigned then Result := fdtInt32 else Result := fdtUInt32; SQL_BIGINT: if ASigned then Result := fdtInt64 else Result := fdtUInt64; SQL_FLOAT: Result := fdtSingle; SQL_DOUBLE, SQL_REAL: Result := fdtDouble; SQL_BIT: Result := fdtBoolean; SQL_BINARY, SQL_VARBINARY, SQL_LONGVARBINARY: Result := fdtBinary; SQL_TYPE_DATE, SQL_DATE: Result := fdtDate; SQL_TYPE_TIME, SQL_TIME: Result := fdtTime; SQL_TYPE_TIMESTAMP: Result := fdtDateTime; SQL_GUID: Result := fdtGUID; SQL_LONGVARCHAR: Result := fdtAnsiText; SQL_WLONGVARCHAR: Result := fdtUnicodeText; else raise EGMException.ObjError(GMFormat(srUnknownODBCFieldDataType, [AODBCDataType]), AObj, ACallingRoutineName); end; end; procedure ODBCEnumDSN(const AEnvironment: TGMOdbcEnvironment; const ADSNKind: TDSNKind; const ADSNEnumProc: TGMEnumDSNProc; const AObj: TObject; const AFormatStr: TGMString); var WasActive: Boolean; Name, Desc: TGMString; FetchKind: SQLUSMALLINT; begin if (AEnvironment <> nil) and Assigned(ADSNEnumProc) and (AFormatStr <> '') then begin WasActive := AEnvironment.Active; AEnvironment.Open; try case ADSNKind of dsnUser: FetchKind := SQL_FETCH_FIRST_USER; dsnSystem: FetchKind := SQL_FETCH_FIRST_SYSTEM; else raise EGMException.ObjError(MsgUnknownValue('TDSNKind', Ord(ADSNKind)), nil, {$I %CurrentRoutine%}); end; if ODBCFetchDSN(AEnvironment.Handle, FetchKind, Name, Desc) then repeat case GMTokenCount(AFormatStr, '%s', '') of 1: ADSNEnumProc(GMFormat(AFormatStr, [Name]), AObj); 2: ADSNEnumProc(GMFormat(AFormatStr, [Name, Desc]), AObj); else raise EGMException.ObjError(srInvalidFormatParamCount, nil, {$I %CurrentRoutine%}); end; until not ODBCFetchDSN(AEnvironment.Handle, SQL_FETCH_NEXT, Name, Desc); finally if not WasActive then AEnvironment.Close; end; end; end; procedure ODBCEnumUserDSN(const Environment: TGMOdbcEnvironment; const DSNEnumProc: TGMEnumDSNProc; const Obj: TObject; const FormatStr: TGMString); begin ODBCEnumDSN(Environment, dsnUser, DSNEnumProc, Obj, srUser + ' ' + srDSN + ': ' + FormatStr); end; procedure ODBCEnumSystemDSN(const Environment: TGMOdbcEnvironment; const DSNEnumProc: TGMEnumDSNProc; const Obj: TObject; const FormatStr: TGMString); begin ODBCEnumDSN(Environment, dsnSystem, DSNEnumProc, Obj, srSystem + ' ' + srDSN + ': ' + FormatStr); end; function GMOdbcSelectSingleValue(const AOdbcConnection: IUnknown; const ASqlText: TGMString; const AResultField: RGMUnionValue): RGMUnionValue; var rs: TGMOdbcRecordsetBase; begin if (AOdbcConnection = nil) or (Length(ASqlText) <= 0) then Exit(uvtUnassigned); rs := TGMOdbcRecordsetBase.Create(AOdbcConnection, ASqlText, ctUnidirectional, False); try //rs.SQL.SQLText := ASqlText; rs.SetSimplestConfiguration; rs.Open; if rs.EOF then Result := uvtUnassigned else Result := rs[AResultField]; finally rs.Free; end; end; function TransactionIsolationsToInt(const AValue: TTransactionIsolations): LongInt; var i: TTransactionIsolation; begin Result := 0; for i:=Low(i) to High(i) do if i in AValue then Result := Result or (1 shl Ord(i)); end; function TransactionIsolationsFromInt(const AValue: LongInt): TTransactionIsolations; var i: TTransactionIsolation; begin Result := []; for i:=Low(i) to High(i) do if AValue and (1 shl Ord(i)) <> 0 then Include(Result, i); end; function OdbcCnAttributesToInt(const AValue: TOdbcConnectionAttributes): LongInt; var i: TOdbcConnectionAttribute; begin Result := 0; for i:=Low(i) to High(i) do if i in AValue then Result := Result or (1 shl Ord(i)); end; function OdbcCnAttributesFromInt(const AValue: LongInt): TOdbcConnectionAttributes; var i: TOdbcConnectionAttribute; begin Result := []; for i:=Low(i) to High(i) do if AValue and (1 shl Ord(i)) <> 0 then Include(Result, i); end; function RecordCountStrategiesToInt(const AValue: TRecordCountStrategies): LongInt; var i: TRecordCountStrategy; begin Result := 0; for i:=Low(i) to High(i) do if i in AValue then Result := Result or (1 shl Ord(i)); end; function RecordCountStrategiesFromInt(const AValue: LongInt): TRecordCountStrategies; var i: TRecordCountStrategy; begin Result := []; for i:=Low(i) to High(i) do if AValue and (1 shl Ord(i)) <> 0 then Include(Result, i); end; { ---------------------------------- } { ---- TGMOdbcConnectProperties ---- } { ---------------------------------- } constructor TGMOdbcConnectProperties.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); SetDefaultValues; end; constructor TGMOdbcConnectProperties.CreateFromObj(const ASource: TObject; const ARefLifeTime: Boolean); begin Create(ARefLifeTime); if ASource <> nil then AssignFromObj(ASource); end; constructor TGMOdbcConnectProperties.CreateFromIntf(const ASource: IUnknown; const ACryptCtrlData: PGMCryptCtrlData; const ARefLifeTime: Boolean); var ValueStg: IGMValueStorage; CnProps: IGMOdbcConnectProperties; begin Create(ARefLifeTime); if GMQueryInterface(ASource, IGMValueStorage, ValueStg) then LoadData(ValueStg, ACryptCtrlData); if GMQueryInterface(ASource, IGMOdbcConnectProperties, CnProps) then AssignFromObj(CnProps.Obj); end; constructor TGMOdbcConnectProperties.CreateOwned(const AOwner: TObject; const ARefLifeTime: Boolean); begin Create(ARefLifeTime); AddOwner(AOwner); end; function TGMOdbcConnectProperties.GetName: TGMString; stdcall; begin Result := GMExtractNameFromConnectionString(ConnectionString); end; function TGMOdbcConnectProperties.DatabaseName: TGMString; var cnStrParser: IGMValueStorage; begin cnStrParser := TGMConnectionStringStorage.Create(ConnectionString, True); Result := cnStrParser.ReadString(cStrCnStrDatabase); if Result = '' then Result := cnStrParser.ReadString(cStrCnStrDBQ); if Result = '' then Result := cnStrParser.ReadString('FILENAME'); if Result = '' then Result := GMStripRight(cnStrParser.ReadString(cStrCnDir), cDirSep); if Result = '' then Result := GMStripRight(cnStrParser.ReadString(cStrCnDefaultDir), cDirSep); if Length(Result) > 0 then Result := GMExtractFileName(Result); end; function TGMOdbcConnectProperties.Obj: TGMOdbcConnectProperties; begin Result := Self; end; function TGMOdbcConnectProperties.FindOwner(const AOwner: TObject; var AIdx: LongInt): Boolean; var i: LongInt; begin for i:=Low(FOwners) to High(FOwners) do if FOwners[i] = AOwner then begin AIdx := i; Exit(True); end; //AIdx := cInvalidItemIdx; Result := False; end; function TGMOdbcConnectProperties.AddOwner(const AOwner: TObject): TObject; var idx: LongInt; begin Result := AOwner; if FindOwner(AOwner, idx) then Exit; SetLength(FOwners, Length(FOwners)+1); FOwners[High(FOwners)] := AOwner; end; procedure TGMOdbcConnectProperties.RemoveOwner(const AOwner: TObject); var i, foundIdx: LongInt; begin if FindOwner(AOwner, foundIdx) then begin for i:=foundIdx to High(FOwners)-1 do FOwners[i] := FOwners[i+1]; SetLength(FOwners, Length(FOwners)-1); end; end; //procedure TGMOdbcConnectProperties.CheckIsInactive(const ACallingName: TGMString); //var I: LongInt; //begin //for i:=Low(FOwners) to High(FOwners) do GMCheckObjIsInActive(FOwners[i], ACallingName); // //if FOwners[i] is TGMActivatableObject then TGMActivatableObject(FOwners[i]).CheckIsInactive(ACallingName); //end; //procedure TGMOdbcConnectProperties.SetAccessMode(const AValue: TAccessMode); //begin //if AValue <> AccessMode then // begin // CheckIsInactive('AccessMode ' + RStrProperty); // FAccessMode := AValue; // end; //end; //procedure TGMOdbcConnectProperties.SetTimeoutForStatements(const AValue: SQLUINTEGER); //begin //if AValue <> TimeoutForStatements then // begin // CheckIsInactive('TimeoutForStatements ' + RStrProperty); // FTimeoutForStatements := AValue; // end; //end; //procedure TGMOdbcConnectProperties.SetTimeoutForLogin(const AValue: SQLUINTEGER); //begin //if AValue <> TimeoutForLogin then // begin // CheckIsInactive('TimeoutForLogin ' + RStrProperty); // FTimeoutForLogin := AValue; // end; //end; //procedure TGMOdbcConnectProperties.SetConnectionString(const AValue: TGMString); //begin //if AValue <> ConnectionString then // begin // CheckIsInactive('ConnectionString ' + RStrProperty); // FConnectionString := AValue; // end; //end; //procedure TGMOdbcConnectProperties.SetCursorOrigin(const AValue: TCursorOrigin); //begin //if AValue <> CursorOrigin then // begin // CheckIsInactive('CursorOrigin ' + RStrProperty); // FCursorOrigin := AValue; // end; //end; procedure TGMOdbcConnectProperties.SetTransactionIsolation(const AValue: TTransactionIsolations); var i: LongInt; begin if AValue <> TransactionIsolation then begin for i:=Low(FOwners) to High(FOwners) do if FOwners[i] is TGMOdbcConnection then TGMOdbcConnection(FOwners[i]).SetODBCTransactionIsolation(AValue); FTransactionIsolation := AValue; end; end; procedure TGMOdbcConnectProperties.SetAttributes(const AValue: TOdbcConnectionAttributes); var i: LongInt; begin for i:=Low(FOwners) to High(FOwners) do if FOwners[i] is TGMOdbcConnection then with TGMOdbcConnection(FOwners[i]) do begin if (caAutoCommitTransactions in AValue) <> (caAutoCommitTransactions in Properties.Obj.Attributes) then SetODBCAutoCommitTransactions(caAutoCommitTransactions in AValue); //if (caAllowDriverDialogs in AValue) <> (caAllowDriverDialogs in FAttributes) then SetODBCDriverDialogPrntWnd(caAllowDriverDialogs in AValue); if (caCaseSensitiveCatalogNames in AValue) <> (caCaseSensitiveCatalogNames in Properties.Obj.Attributes) then SetODBCCaseSensitiveCatalogNames(caCaseSensitiveCatalogNames in AValue); if (caAsynchronOperations in AValue) <> (caAsynchronOperations in Properties.Obj.Attributes) then CheckIsInactive('caAsynchronOperations Attribute'); end; FAttributes := AValue; end; procedure TGMOdbcConnectProperties.SetDefaultValues; begin FAccessMode := cDfltAccessMode; //FAsynchronOperations := cDfltAsyncOperations; //FAutoCommitTransactions := cDfltAutoCommitTrans; FUsername := cDfltUsername; FPassword := ''; FConnectionString := ''; FTimeoutForStatements := cDfltStatementTimeout; FTimeoutForLogin := cDfltLoginTimeout; FCursorOrigin := cDfltCursorOrigin; FTransactionIsolation := cSqlDefaultTransactionIsolation; FAttributes := cDfltConnectionAttributes; FAllowDriverDialogs := cDfltDriverDialogs; end; procedure TGMOdbcConnectProperties.AssignFromIntf(const ASource: IUnknown); stdcall; begin AssignFromObj(GMObjFromIntf(ASource)); end; procedure TGMOdbcConnectProperties.AssignToIntf(const ADest: IUnknown); stdcall; begin AssignToObj(GMObjFromIntf(ADest)); end; procedure TGMOdbcConnectProperties.AssignFromObj(const ASource: TObject); stdcall; begin if ASource is TGMOdbcConnectProperties then begin AccessMode := TGMOdbcConnectProperties(ASource).AccessMode; //AsynchronOperations := TGMOdbcConnectProperties(ASource).AsynchronOperations; //AutoCommitTransactions := TGMOdbcConnectProperties(ASource).AutoCommitTransactions; Username := TGMOdbcConnectProperties(ASource).Username; Password := TGMOdbcConnectProperties(ASource).Password; ConnectionString := TGMOdbcConnectProperties(ASource).ConnectionString; TimeoutForStatements := TGMOdbcConnectProperties(ASource).TimeoutForStatements; TimeoutForLogin := TGMOdbcConnectProperties(ASource).TimeoutForLogin; CursorOrigin := TGMOdbcConnectProperties(ASource).CursorOrigin; TransactionIsolation := TGMOdbcConnectProperties(ASource).TransactionIsolation; Attributes := TGMOdbcConnectProperties(ASource).Attributes; AllowDriverDialogs := TGMOdbcConnectProperties(ASource).AllowDriverDialogs; end else if (ASource is TGMOdbcConnection) and (TGMOdbcConnection(ASource).Properties <> nil) then AssignFromObj(TGMOdbcConnection(ASource).Properties.Obj); end; procedure TGMOdbcConnectProperties.AssignToObj(const ADest: TObject); stdcall; begin if ADest is TGMOdbcConnectProperties then TGMOdbcConnectProperties(ADest).AssignFromObj(Self) else if (ADest is TGMOdbcConnection) and (TGMOdbcConnection(ADest).Properties <> nil) then TGMOdbcConnection(ADest).Properties.Obj.AssignFromObj(Self); end; procedure TGMOdbcConnectProperties.LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); stdcall; begin if ASource <> nil then begin AccessMode := TAccessMode(GMBoundedInt(ASource.ReadInteger(cStrAccessMode, Ord(cDfltAccessMode)), Ord(Low(TAccessMode)), Ord(High(TAccessMode)))); if ACryptCtrlData <> nil then begin UserName := GMDecryptStringW(GMDecodeBase16Str(ASource.ReadString(cPrsUsername, cDfltUserName)), ACryptCtrlData.KeyData, CALG_MD5, CALG_RC4, Self); Password := GMDecryptStringW(GMDecodeBase16Str(ASource.ReadString(cPrsPassword, cDfltPassword)), ACryptCtrlData.KeyData, CALG_MD5, CALG_RC4, Self); end; ConnectionString := ASource.ReadString(cPrsConnectionString); TimeoutForLogin := ASource.ReadInteger(cPrsLoginTimeout, cDfltLoginTimeout); TimeoutForStatements := ASource.ReadInteger(cPrsStatementTimeout, cDfltStatementTimeout); CursorOrigin := TCursorOrigin(GMBoundedInt(ASource.ReadInteger(cPrsCursorOrigin, Ord(cDfltCursorOrigin)), Ord(Low(TCursorOrigin)), Ord(High(TCursorOrigin)))); AllowDriverDialogs := TOdbcAllowDriverDialogs(GMBoundedInt(ASource.ReadInteger(cPrsDriverDialogs, Ord(cDfltDriverDialogs)), Ord(Low(TOdbcAllowDriverDialogs)), Ord(High(TOdbcAllowDriverDialogs)))); //AsynchronOperations := ASource.ReadBoolean(cStrAsyncOperations, cDfltAsyncOperations); //AutoCommitTransactions := ASource.ReadBoolean(cStrAutoCommitTrans, cDfltAutoCommitTrans); TransactionIsolation := TransactionIsolationsFromInt(ASource.ReadInteger(cPrsTransactionIsolation, TransactionIsolationsToInt(cSqlDefaultTransactionIsolation))); Attributes := OdbcCnAttributesFromInt(ASource.ReadInteger(cPrsAttributes, OdbcCnAttributesToInt(cDfltConnectionAttributes))); end; end; procedure TGMOdbcConnectProperties.StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); stdcall; begin if ADest <> nil then begin GMStoreInteger(ADest, cStrAccessMode, Ord(AccessMode), Ord(cDfltAccessMode)); if ACryptCtrlData <> nil then begin GMStoreString(ADest, cPrsUsername, GMEncodeBase16Str(GMEncryptStringW(UserName, ACryptCtrlData.KeyData, CALG_MD5, CALG_RC4, Self)), cDfltUserName); GMStoreString(ADest, cPrsPassword, GMEncodeBase16Str(GMEncryptStringW(Password, ACryptCtrlData.KeyData, CALG_MD5, CALG_RC4, Self)), cDfltPassword); end; GMStoreString(ADest, cPrsConnectionString, ConnectionString); GMStoreInteger(ADest, cPrsLoginTimeout, TimeoutForLogin, cDfltLoginTimeout); GMStoreInteger(ADest, cPrsStatementTimeout, TimeoutForStatements, cDfltStatementTimeout); GMStoreInteger(ADest, cPrsCursorOrigin, Ord(CursorOrigin), Ord(cDfltCursorOrigin)); GMStoreInteger(ADest, cPrsDriverDialogs, Ord(AllowDriverDialogs), Ord(cDfltDriverDialogs)); //if AsynchronOperations <> cDfltAsyncOperations then ADest.WriteBoolean(cStrAsyncOperations, AsynchronOperations); //if AutoCommitTransactions <> cDfltAutoCommitTrans then ADest.WriteBoolean(cStrAutoCommitTrans, AutoCommitTransactions); GMStoreInteger(ADest, cPrsTransactionIsolation, TransactionIsolationsToInt(TransactionIsolation), TransactionIsolationsToInt(cSqlDefaultTransactionIsolation)); GMStoreInteger(ADest, cPrsAttributes, OdbcCnAttributesToInt(Attributes), OdbcCnAttributesToInt(cDfltConnectionAttributes)); end; end; { ----------------------------- } { ---- TOdbcHandleAllocObj ---- } { ----------------------------- } constructor TOdbcHandleAllocObj.Create(const ArefLifeTime: Boolean); begin inherited Create(ArefLifeTime); FCriticalSection := TGMCriticalSection.Create(True); end; procedure TOdbcHandleAllocObj.ReleaseHandle; begin if GetHandleAllocated then begin SQLFreeHandle(HandleType, Handle); FHandle := 0; end; end; { ------------------------------ } { ---- TGMOdbcTransactedObj ---- } { ------------------------------ } function TGMOdbcTransactedObj.GetTransactionSupport: TTransactionSupport; begin Result := txnAll; end; function TGMOdbcTransactedObj.GetTransactionLevel: LongInt; begin Result := FTransactionLevel; end; procedure TGMOdbcTransactedObj.BeginTransaction; begin CheckIsActive('BeginTransaction ' + RStrMethod); Inc(FTransactionLevel); end; procedure TGMOdbcTransactedObj.CommitTransaction; begin CheckIsActive('CommitTransaction ' + RStrMethod); ODBCCheck(SQLEndTran(HandleType, Handle, SQL_COMMIT), Self, 'SQLEndTran(SQL_COMMIT)'); Dec(FTransactionLevel); end; procedure TGMOdbcTransactedObj.RollbackTransaction; begin CheckIsActive('RollbackTransaction ' + RStrMethod); ODBCCheck(SQLEndTran(HandleType, Handle, SQL_ROLLBACK), Self, 'SQLEndTran(SQL_ROLLBACK)'); Dec(FTransactionLevel); end; { ---------------------------- } { ---- TGMOdbcEnvironment ---- } { ---------------------------- } constructor TGMOdbcEnvironment.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FODBCVersion := cDfltODBCVersion; FConnectionPooling := cDfltConnectionPooling; FConnectionPoolSelectStrategy := cDfltCPSelectStartegy; end; constructor TGMOdbcEnvironment.Create(const AOdbcVersion: TOdbcVersion; const AConnectionPooling: TOdbcConnectionPooling; const AConnectionPoolSelectStrategy: TOdbcConnectionPoolSelectStrategy; const ARefLifeTime: Boolean); begin Create(ARefLifeTime); FODBCVersion := AOdbcVersion; FConnectionPooling := AConnectionPooling; FConnectionPoolSelectStrategy := AConnectionPoolSelectStrategy; end; procedure TGMOdbcEnvironment.AssignFromObj(const Source: TObject); begin if Source is TGMOdbcEnvironment then begin Close; ODBCVersion := TGMOdbcEnvironment(Source).ODBCVersion; ConnectionPooling := TGMOdbcEnvironment(Source).ConnectionPooling; ConnectionPoolSelectStrategy := TGMOdbcEnvironment(Source).ConnectionPoolSelectStrategy; end; end; function TGMOdbcEnvironment.GetHandleType: LongWord; begin Result := SQL_HANDLE_ENV; end; procedure TGMOdbcEnvironment.AllocHandle; begin if not GetHandleAllocated then begin if ConnectionPooling <> TOdbcConnectionPooling(SQL_CP_DEFAULT) then SetODBCConnectionPooling(ConnectionPooling); ODBCCheck(SQLAllocHandle(HandleType, SQL_NULL_HANDLE, FHandle), Self, 'SQLAllocHandle'); SetODBCODBCVersion(ODBCVersion); SetODBCConnectionPoolSelectStrategy(ConnectionPoolSelectStrategy); end; end; { ---- Property Set on ODBC API Level ---- } procedure TGMOdbcEnvironment.SetODBCConnectionPooling(const AValue: TOdbcConnectionPooling); var Pooling: PtrUInt; begin case AValue of cpOff: Pooling := SQL_CP_OFF; cpOnePoolPerDriver: Pooling := SQL_CP_ONE_PER_DRIVER; cpOnePoolPerEnvironment: Pooling := SQL_CP_ONE_PER_HENV; else raise EGMException.ObjError(MsgUnknownValue('TOdbcConnectionPooling', Ord(AValue)), Self, {$I %CurrentRoutine%}); end; ODBCCheck(SQLSetEnvAttr(SQL_NULL_HANDLE, SQL_ATTR_CONNECTION_POOLING, SQLPOINTER(Pooling), 0), Self, {$I %CurrentRoutine%}); end; procedure TGMOdbcEnvironment.SetODBCConnectionPoolSelectStrategy(const AValue: TOdbcConnectionPoolSelectStrategy); var CPSelectStragegy: PtrUInt; begin if Active then begin case AValue of ssExactMatch: CPSelectStragegy := SQL_CP_STRICT_MATCH; ssRelaxedMatch: CPSelectStragegy := SQL_CP_RELAXED_MATCH; else raise EGMException.ObjError(MsgUnknownValue('TOdbcConnectionPoolSelectStrategy', Ord(AValue)), Self, {$I %CurrentRoutine%}); end; ODBCCheck(SQLSetEnvAttr(Handle, SQL_ATTR_CP_MATCH, SQLPOINTER(CPSelectStragegy), 0), Self, {$I %CurrentRoutine%}); end; end; procedure TGMOdbcEnvironment.SetODBCODBCVersion(const AValue: TOdbcVersion); var ODBCVer: PtrUInt; begin if Active then begin case AValue of odbc2x: ODBCVer := SQL_OV_ODBC2; odbc3x: ODBCVer := SQL_OV_ODBC3; else raise EGMException.ObjError(MsgUnknownValue('TOdbcVersion', Ord(AValue)), Self, {$I %CurrentRoutine%}); end; ODBCCheck(SQLSetEnvAttr(Handle, SQL_ATTR_ODBC_VERSION, SQLPOINTER(ODBCVer), 0), Self, {$I %CurrentRoutine%}); end; end; { ---- Property Get/Set ---- } procedure TGMOdbcEnvironment.SetODBCVersion(const AValue: TOdbcVersion); begin if AValue <> ODBCVersion then begin CheckIsInactive('ODBCVersion ' + RStrProperty); FODBCVersion := AValue; end; end; procedure TGMOdbcEnvironment.SetConnectionPooling(const AValue: TOdbcConnectionPooling); begin if AValue <> ConnectionPooling then begin CheckIsInactive('ConnectionPooling ' + RStrProperty); FConnectionPooling := AValue; end; end; procedure TGMOdbcEnvironment.SetConnectionPoolSelectStrategy(const AValue: TOdbcConnectionPoolSelectStrategy); begin if AValue <> ConnectionPoolSelectStrategy then begin SetODBCConnectionPoolSelectStrategy(AValue); FConnectionPoolSelectStrategy := AValue; end; end; { ----------------------------------- } { ---- TOdbcComponentSubProperty ---- } { ----------------------------------- } constructor TOdbcComponentSubProperty.Create(const AOwner: TGMActivatableObject); begin inherited Create; FOwner := AOwner; end; function TOdbcComponentSubProperty.ODBCConnection: TGMOdbcConnection; begin Result := FOwner as TGMOdbcConnection; //Assert(Result <> nil, 'Result <> nil'); end; function TOdbcComponentSubProperty.ODBCStatement: TGMOdbcStatementBase; begin Result := FOwner as TGMOdbcStatementBase; //Assert(Result <> nil, 'Result <> nil'); end; { ------------------------------ } { ---- TOdbcTraceProperties ---- } { ------------------------------ } constructor TOdbcTraceProperties.Create(const AOwner: TGMActivatableObject); begin inherited Create(AOwner); FEnableTracing := cDfltEnableTracing; FTraceFilename := SQL_OPT_TRACE_FILE_DEFAULT; end; function TOdbcTraceProperties.IsEqualTo(const AValue: TOdbcTraceProperties): Boolean; begin if AValue = nil then Result := True else Result := (EnableTracing = AValue.EnableTracing) and (TraceFilename = AValue.TraceFilename); end; procedure TOdbcTraceProperties.AssignFromObj(const Source: TObject); begin if Source is TOdbcTraceProperties then begin EnableTracing := TOdbcTraceProperties(Source).EnableTracing; TraceFilename := TOdbcTraceProperties(Source).TraceFilename; end; //else inherited AssignFromObj(Source); end; procedure TOdbcTraceProperties.SetODBCEnableTracing(const AValue: Boolean); var trace: PtrUInt; begin if ODBCConnection.Active then begin if AValue then trace := SQL_OPT_TRACE_ON else trace := SQL_OPT_TRACE_OFF; ODBCCheck(SQLSetConnectAttr(ODBCConnection.Handle, SQL_ATTR_TRACE, SQLPOINTER(trace), 0), ODBCConnection, {$I %CurrentRoutine%}); end; end; procedure TOdbcTraceProperties.SetEnableTracing(const AValue: Boolean); begin if AValue <> EnableTracing then begin SetODBCEnableTracing(AValue); FEnableTracing := AValue; end; end; procedure TOdbcTraceProperties.SetODBCTraceFilename(const AValue: TGMString); begin if ODBCConnection.Active then ODBCCheck(SQLSetConnectAttr(ODBCConnection.Handle, SQL_ATTR_TRACEFILE, SQLPOINTER(AValue), Length(AValue)), ODBCConnection, {$I %CurrentRoutine%}); end; procedure TOdbcTraceProperties.SetTraceFilename(const AValue: TGMString); begin if AValue <> TraceFilename then begin SetODBCTraceFilename(AValue); FTraceFilename := AValue; end; end; procedure TOdbcTraceProperties.SetODBCValues; begin if EnableTracing <> Boolean(SQL_OPT_TRACE_DEFAULT) then begin SetODBCEnableTracing(EnableTracing); if TraceFilename <> '' then SetODBCTraceFilename(TraceFilename); end; end; { ---------------------------------- } { ---- TOdbcTranslateProperties ---- } { ---------------------------------- } constructor TOdbcTranslateProperties.Create(const AOwner: TOdbcHandleAllocObj); begin inherited Create(AOwner); FTranslationAttributes := cDfltTranslateOptions; end; function TOdbcTranslateProperties.IsEqualTo(const AValue: TOdbcTranslateProperties): Boolean; begin if AValue = nil then Result := True else Result := (TranslationDLLFilename = AValue.TranslationDLLFilename) and (TranslationAttributes = AValue.TranslationAttributes); end; procedure TOdbcTranslateProperties.AssignFromObj(const Source: TObject); begin if Source is TOdbcTranslateProperties then begin TranslationDLLFilename := TOdbcTranslateProperties(Source).TranslationDLLFilename; TranslationAttributes := TOdbcTranslateProperties(Source).TranslationAttributes; end; //else inherited AssignFromObj(Source); end; procedure TOdbcTranslateProperties.SetODBCTranslationDLLFilename(const AValue: TGMString); begin if ODBCConnection.Active then ODBCCheck(SQLSetConnectAttr(ODBCConnection.Handle, SQL_ATTR_TRANSLATE_LIB, SQLPOINTER(AValue), Length(AValue)), ODBCConnection, {$I %CurrentRoutine%}); end; procedure TOdbcTranslateProperties.SetTranslationDLLFilename(const AValue: TGMString); begin if AValue <> TranslationDLLFilename then begin SetODBCTranslationDLLFilename(AValue); FTranslationDLLFilename := AValue; end; end; procedure TOdbcTranslateProperties.SetODBCTranslationAttributes(const AValue: PtrUInt); begin if ODBCConnection.Active then ODBCCheck(SQLSetConnectAttr(ODBCConnection.Handle, SQL_ATTR_TRANSLATE_OPTION, SQLPOINTER(AValue), 0), ODBCConnection, {$I %CurrentRoutine%}); end; procedure TOdbcTranslateProperties.SetTranslationAttributes(const AValue: SQLUINTEGER); begin if AValue <> TranslationAttributes then begin SetODBCTranslationAttributes(AValue); FTranslationAttributes := AValue; end; end; procedure TOdbcTranslateProperties.SetODBCValues; begin if TranslationDLLFilename <> '' then SetODBCTranslationDLLFilename(TranslationDLLFilename); if TranslationAttributes <> SQL_DEFAULT_TRANSLATE_OPTIONS then SetODBCTranslationAttributes(TranslationAttributes); end; { --------------------------- } { ---- TGMOdbcConnection ---- } { --------------------------- } constructor TGMOdbcConnection.Create(const ArefLifeTime: Boolean); begin inherited; ObjectConnectedTo.OnBeforeIntfSourceChange := OnBeforeIntfSourceChange; FProperties := TGMOdbcConnectProperties.CreateOwned(Self, True); GMCheckQueryInterface(FProperties, IGMLoadStoreData, FLoadStore, 'TGMOdbcConnection.Create'); //GMCheckQueryInterface(FProperties, IGMGetName, FName, 'TGMOdbcConnection.Create'); FTraceProperties := TOdbcTraceProperties.Create(Self); FTranslateProperties := TOdbcTranslateProperties.Create(Self); FNetworkPacketSize := cDfltNetPacketSize; end; constructor TGMOdbcConnection.Create(const AOdbcEnvironment: IUnknown; const AConnectionString: TGMString; const ARefLifeTime: Boolean); begin Create(ARefLifeTime); if AOdbcEnvironment <> nil then ODBCEnvironmentIntf := AOdbcEnvironment; FProperties.Obj.ConnectionString := AConnectionString; end; destructor TGMOdbcConnection.Destroy; begin inherited Destroy; GMFreeAndNil(FTraceProperties); GMFreeAndNil(FTranslateProperties); FProperties.Obj.RemoveOwner(Self); end; //function TGMOdbcConnection.Obj: TGMOdbcConnection; //begin // Result := Self; //end; function TGMOdbcConnection.GetName: TGMString; stdcall; var propName: IGMGetName; begin if GMQueryInterface(FProperties, IGMGetName, propName) then Result := propName.Name else Result := ''; end; procedure TGMOdbcConnection.SetSharedProperties(const AProperties: IGMOdbcConnectProperties); //var objInfo: IGMObjInfo; begin //if GMQueryInterface(AProperties, IGMObjInfo, objInfo) and (objInfo.Instance is TGMOdbcConnectProperties) then if AProperties <> nil then begin if FProperties <> nil then begin FProperties.Obj.RemoveOwner(Self); FProperties := nil; end; AProperties.Obj.AddOwner(Self); FProperties := AProperties; end; end; //procedure TGMOdbcConnection.AssignFromObj(const Source: TObject); //begin // if Source is TGMOdbcConnection then // begin // Close; // // if TGMOdbcConnection(Source).ODBCEnvironment <> nil then // ODBCEnvironment := TGMOdbcConnection(Source).ODBCEnvironment // else // ODBCEnvironmentIntf := TGMOdbcConnection(Source).ODBCEnvironmentIntf; // // AccessMode := TGMOdbcConnection(Source).AccessMode; // //AsynchronOperations := TGMOdbcConnection(Source).AsynchronOperations; // //AutoCommitTransactions := TGMOdbcConnection(Source).AutoCommitTransactions; // //AllowDriverDialogs := TGMOdbcConnection(Source).AllowDriverDialogs; // ConnectionString := TGMOdbcConnection(Source).ConnectionString; // DataSourceCatalog := TGMOdbcConnection(Source).DataSourceCatalog; // Username := TGMOdbcConnection(Source).Username; // Password := TGMOdbcConnection(Source).Password; // TimeoutForStatements := TGMOdbcConnection(Source).TimeoutForStatements; // TimeoutForLogin := TGMOdbcConnection(Source).TimeoutForLogin; // //CaseSensitiveCatalogNames := TGMOdbcConnection(Source).CaseSensitiveCatalogNames; // CursorOrigin := TGMOdbcConnection(Source).CursorOrigin; // NetworkPacketSize := TGMOdbcConnection(Source).NetworkPacketSize; // TransactionIsolation := TGMOdbcConnection(Source).TransactionIsolation; // TraceProperties := TGMOdbcConnection(Source).TraceProperties; // TranslateProperties := TGMOdbcConnection(Source).TranslateProperties; // Attributes := TGMOdbcConnection(Source).Attributes; // end; //end; function TGMOdbcConnection.GetHandleType: LongWord; begin Result := SQL_HANDLE_DBC; end; function TGMOdbcConnection.ConnetionAlive: Boolean; var dead: SQLUINTEGER; //GMStrLen: SQLINTEGER; begin if not Active then Result := False else begin ODBCCheck(SQLGetConnectAttr(Handle, SQL_ATTR_CONNECTION_DEAD, @dead, SQL_IS_UINTEGER, nil), Self, 'ConnetionAlive'); case dead of SQL_CD_TRUE: Result := False; SQL_CD_FALSE: Result := True; else raise EGMException.ObjError(MsgUnknownPropVal('ConnetionAlive', dead), Self, 'ConnetionAlive'); end; end; end; function TGMOdbcConnection.SqlIdentifierQuoteChar: TGMString; var len: SQLSMALLINT; begin if not Active then Exit(''); // cSqlIdQuoteCh //CheckIsActive({$I %CurrentRoutine%}); len := 0; ODBCCheck(SQLGetInfo(Handle, SQL_IDENTIFIER_QUOTE_CHAR, nil, 0, @len), Self, {$I %CurrentRoutine%}); SetLength(Result, (len div SizeOf(TGMChar))); if Length(Result) > 0 then begin ODBCCheck(SQLGetInfo(Handle, SQL_IDENTIFIER_QUOTE_CHAR, PGMChar(Result), (Length(Result)+1) * SizeOf(TGMChar), @len), Self, {$I %CurrentRoutine%}); Result := GMStrip(Result, cWhiteSpace); end; end; function TGMOdbcConnection.SqlDateTimeFormatStr: TGMString; begin Result := cODBCDateTimeFormatStrMS; end; procedure TGMOdbcConnection.AllocHandle; var mousePtrWait: IUnknown; envHandle: IGMGetHandle; envHandleType: IGMGetHandleType; connectionString, completedCnStr: TGMString; completedCnStrLen: SQLSMALLINT; dlgPrntWnd: HWnd; begin if not GetHandleAllocated then begin if ODBCEnvironmentIntf = nil then raise EGMException.ObjError(GMFormat(RStrMissingPropVal, ['ODBCEnvironment']), Self, scAllocHandle); mousePtrWait := TGMTempCursor.Create(vDBWaitCursor); GMSetIntfActive(ODBCEnvironmentIntf, True, {$I %CurrentRoutine%}); GMCheckQueryInterface(ODBCEnvironmentIntf, IGMGetHandle, envHandle, {$I %CurrentRoutine%}); GMCheckQueryInterface(ODBCEnvironmentIntf, IGMGetHandleType, envHandleType, {$I %CurrentRoutine%}); ODBCCheck(SQLAllocHandle(HandleType, envHandle.Handle, FHandle), Self, 'SQLAllocHandle', envHandleType.HandleType, envHandle.Handle); if Properties.Obj.AllowDriverDialogs = adpNoDriverDialogs then dlgPrntWnd := 0 else dlgPrntWnd := GMModalDlgParentWnd; SetODBCDriverDialogPrntWnd(dlgPrntWnd); if Properties.Obj.TransactionIsolation <> [] then SetODBCTransactionIsolation(Properties.Obj.TransactionIsolation); if Properties.Obj.AccessMode <> TAccessMode(SQL_MODE_DEFAULT) then SetODBCAccessMode(Properties.Obj.AccessMode); if Properties.Obj.CursorOrigin <> TCursorOrigin(SQL_CUR_DEFAULT) then SetODBCCursorOrigin(Properties.Obj.CursorOrigin); if Properties.Obj.TimeoutForStatements <> SQL_DEFAULT_TIMEOUT then SetODBCTimeoutForStatements(Properties.Obj.TimeoutForStatements); if Properties.Obj.TimeoutForLogin <> SQL_DEFAULT_TIMEOUT then SetODBCTimeoutForLogin(Properties.Obj.TimeoutForLogin); if DataSourceCatalog <> '' then SetODBCDataSorceCatalog(DataSourceCatalog); if FNetworkPacketSize <> cDfltNetPacketSize then SetODBCNetworkPacketSize(FNetworkPacketSize); // <-- Must be FNetworkPacketSize here if caAsynchronOperations in Properties.Obj.Attributes <> Boolean(SQL_ASYNC_ENABLE_DEFAULT) then SetODBCAsynchronOperations(caAsynchronOperations in Properties.Obj.Attributes); if caAutoCommitTransactions in Properties.Obj.Attributes <> Boolean(SQL_AUTOCOMMIT_DEFAULT) then SetODBCAutoCommitTransactions(caAutoCommitTransactions in Properties.Obj.Attributes); if caCaseSensitiveCatalogNames in Properties.Obj.Attributes <> Boolean(SQL_METADATA_ID_DEFAULT) then SetODBCCaseSensitiveCatalogNames(caCaseSensitiveCatalogNames in Properties.Obj.Attributes); TraceProperties.SetODBCValues; connectionString := Properties.Obj.connectionString; if (Properties.Obj.Username <> '') then connectionString := GMAddOrReplaceValueInConnectionString(connectionString, cStrCnStrUserName, Properties.Obj.Username); if (Properties.Obj.Password <> '') then connectionString := GMAddOrReplaceValueInConnectionString(connectionString, cStrCnStrPassword, Properties.Obj.Password); // if (Properties.Obj.Username <> '') or (Properties.Obj.Password <> '') then // ODBCCheck(SQLConnect(Handle, SQLPCHAR(GMExtractNameFromConnectionString(Properties.Obj.connectionString)), SQL_NTS, SQLPCHAR(Properties.Obj.Username), Length(Properties.Obj.Username), SQLPCHAR(Properties.Obj.Password), Length(Properties.Obj.Password)), Self, 'SQLConnect') // else // begin SetLength(completedCnStr, 8192); completedCnStrLen := 0; ODBCCheck(SQLDriverConnect(Handle, dlgPrntWnd, PGMChar(connectionString), Length(connectionString), PGMChar(completedCnStr), Length(completedCnStr), @completedCnStrLen, Ord(Properties.Obj.AllowDriverDialogs)), Self, 'SQLDriverConnect'); // end; // cDriverCompletion[caAllowDriverDialogs in Attributes] FInternalConnected := True; // Set FConnectionString member here, setting connectionString property would trigger CheckIsInaktive if caCompleteConnectionString in Properties.Obj.Attributes then Properties.Obj.FConnectionString := PGMChar(completedCnStr); TranslateProperties.SetODBCValues; end; end; procedure TGMOdbcConnection.ReleaseHandle; //var mousePtrWait: IUnknown; begin //mousePtrWait := TGMTempCursor.Create(vDBWaitCursor); if InternalConnected then begin if not (caAutoCommitTransactions in Properties.Obj.Attributes) then RollbackTransaction; SQLDisconnect(Handle); //ODBCCheck(SQLDisconnect(Handle), Self, 'SQLDisconnect'); FInternalConnected := False; end; inherited ReleaseHandle; end; function TGMOdbcConnection.ExecuteSQL(const ASQL: TGMString): SQLLEN; var ODBCStatement: TGMOdbcStatementBase; begin if Length(ASQL) <= 0 then Result := 0 else begin ODBCStatement := TGMOdbcStatementBase.Create(Self, ASQL, False); try // ODBCStatement.ODBCConnection := Self; // ODBCStatement.SQL.SQLText := ASQL; ODBCStatement.Execute; Result := ODBCStatement.AffectedRecordCount; //� if PAffectedRecordCount <> nil then PAffectedRecordCount^ := ODBCStatement.AffectedRecordCount; //OdbcStatement.Close; //OdbcStatement.ODBCConnection := nil; finally ODBCStatement.Free; end; end; end; function TGMOdbcConnection.AskBoolean(const AValueId: LongInt): LongInt; stdcall; begin case AValueId of Ord(bvCanModify): Result := GMBooleanAskResult(Properties.Obj.AccessMode <> amReadOnly); else Result := Ord(barUnknown); end; end; { ---- Property set on OSBC API Level ---- } procedure TGMOdbcConnection.SetODBCTimeoutForStatements(const AValue: SQLULEN); begin if GetHandleAllocated then ODBCCheck(SQLSetConnectAttr(Handle, SQL_ATTR_CONNECTION_TIMEOUT, SQLPOINTER(AValue), 0), Self, {$I %CurrentRoutine%}); end; procedure TGMOdbcConnection.SetODBCTimeoutForLogin(const AValue: SQLULEN); begin if GetHandleAllocated then ODBCCheck(SQLSetConnectAttr(Handle, SQL_ATTR_LOGIN_TIMEOUT, SQLPOINTER(AValue), 0), Self, {$I %CurrentRoutine%}); end; procedure TGMOdbcConnection.SetODBCDataSorceCatalog(const AValue: TGMString); begin if GetHandleAllocated then ODBCCheck(SQLSetConnectAttr(Handle, SQL_ATTR_CURRENT_CATALOG, SQLPOINTER(AValue), Length(AValue)), Self, {$I %CurrentRoutine%}); end; procedure TGMOdbcConnection.SetODBCAccessMode(const AValue: TAccessMode); var accMode: SQLULEN; begin if Active then begin case AValue of amReadWrite: accMode := SQL_MODE_READ_WRITE; amReadOnly: accMode := SQL_MODE_READ_ONLY; else raise EGMException.ObjError(MsgUnknownValue('TAccessMode', Ord(AValue)), Self, {$I %CurrentRoutine%}); end; ODBCCheck(SQLSetConnectAttr(Handle, SQL_ATTR_ACCESS_MODE, SQLPOINTER(accMode), 0), Self, {$I %CurrentRoutine%}); end; end; procedure TGMOdbcConnection.SetODBCCursorOrigin(const AValue: TCursorOrigin); var curOrg: SQLULEN; begin if Active then begin case AValue of coUseODBCCursorsIfNeeded: curOrg := SQL_CUR_USE_IF_NEEDED; coUseODBCCursors: curOrg := SQL_CUR_USE_ODBC; coUseDriverCursors: curOrg := SQL_CUR_USE_DRIVER; else raise EGMException.ObjError(MsgUnknownValue('TCursorOrigin', Ord(AValue)), Self, {$I %CurrentRoutine%}); end; ODBCCheck(SQLSetConnectAttr(Handle, SQL_ATTR_ODBC_CURSORS, SQLPOINTER(curOrg), 0), Self, {$I %CurrentRoutine%}); end; end; procedure TGMOdbcConnection.SetODBCAsynchronOperations(const AValue: Boolean); var asyncOp: SQLULEN; begin if Active then begin if AValue then asyncOp := SQL_ASYNC_ENABLE_ON else asyncOp := SQL_ASYNC_ENABLE_OFF; ODBCCheck(SQLSetConnectAttr(Handle, SQL_ATTR_ASYNC_ENABLE, SQLPOINTER(asyncOp), 0), Self, {$I %CurrentRoutine%}); end; end; procedure TGMOdbcConnection.SetODBCAutoCommitTransactions(const AValue: Boolean); var autoCommit: SQLLEN; begin if Active then begin if AValue then autoCommit := SQL_AUTOCOMMIT_ON else autoCommit := SQL_AUTOCOMMIT_OFF; ODBCCheck(SQLSetConnectAttr(Handle, SQL_ATTR_AUTOCOMMIT, SQLPOINTER(autoCommit), 0), Self, {$I %CurrentRoutine%}); end; end; procedure TGMOdbcConnection.SetODBCDriverDialogPrntWnd(const AValue: HWnd); //var WndHandle: HWnd; begin //if Active then // begin // if AValue then WndHandle := vGMTopWindow else WndHandle := 0; ODBCCheck(SQLSetConnectAttr(Handle, SQL_ATTR_QUIET_MODE, SQLPOINTER(AValue), 0), Self, {$I %CurrentRoutine%}); // end; end; procedure TGMOdbcConnection.SetODBCCaseSensitiveCatalogNames(const AValue: Boolean); var CatalogCase: SQLLEN; begin if Active then begin if AValue then CatalogCase := SQL_FALSE else CatalogCase := SQL_TRUE; ODBCCheck(SQLSetConnectAttr(Handle, SQL_ATTR_METADATA_ID, SQLPOINTER(CatalogCase), 0), Self, {$I %CurrentRoutine%}); end; end; procedure TGMOdbcConnection.SetODBCNetworkPacketSize(const AValue: SQLULEN); begin //if Active then //try ODBCCheck(SQLSetConnectAttr(Handle, SQL_ATTR_PACKET_SIZE, SQLPOINTER(AValue), 0), Self, {$I %CurrentRoutine%}); //except //if not GMComponentIsLoading(Self) then raise; //end; end; procedure TGMOdbcConnection.SetODBCTransactionIsolation(const AValue: TTransactionIsolations); var txnIsolation: PtrUInt; begin if Active then begin txnIsolation := 0; if tiReadUncommitted in AValue then txnIsolation := txnIsolation or SQL_TRANSACTION_READ_UNCOMMITTED; if tiReadCommitted in AValue then txnIsolation := txnIsolation or SQL_TRANSACTION_READ_COMMITTED; if tiRepeatableRead in AValue then txnIsolation := txnIsolation or SQL_TRANSACTION_REPEATABLE_READ; if tiSerializable in AValue then txnIsolation := txnIsolation or SQL_TRANSACTION_SERIALIZABLE; ODBCCheck(SQLSetConnectAttr(Handle, SQL_ATTR_TXN_ISOLATION, SQLPOINTER(txnIsolation), 0), Self, {$I %CurrentRoutine%}); end; end; { ---- property get/set ---- } procedure TGMOdbcConnection.OnBeforeIntfSourceChange(const AOldSource, ANewSource: IUnknown); begin if AOldSource <> ANewSource then CheckIsInactive('ODBCEnvironment ' + RStrProperty); end; function TGMOdbcConnection.GetODBCEnvironmentIntf: IUnknown; begin Result := ObjectConnectedTo.InterfaceSource; end; procedure TGMOdbcConnection.SetODBCEnvironmentIntf(const AValue: IUnknown); begin ObjectConnectedTo.InterfaceSource := AValue; // <- will be checked vai OnBeforeIntfSourceChange {if AValue <> ODBCEnvironmentIntf then begin CheckIsInactive('ODBCEnvironment ' + RStrProperty); ObjectConnectedTo.InterfaceSource := AValue; end;} end; function TGMOdbcConnection.GetODBCEnvironment: TGMOdbcEnvironment; begin Result := GMObjFromIntf(ObjectConnectedTo.InterfaceSource) as TGMOdbcEnvironment; end; procedure TGMOdbcConnection.SetODBCEnvironment(const AValue: TGMOdbcEnvironment); begin ObjectConnectedTo.InterfaceSource := GMObjAsIntf(AValue); // <- will be checked vai OnBeforeIntfSourceChange {if AValue <> ODBCEnvironment then begin CheckIsInactive('ODBCEnvironment ' + RStrProperty); ObjectConnectedTo.InterfaceSourceObject := AValue; end;} end; procedure TGMOdbcConnection.SetDataSourceCatalog(const AValue: TGMString); begin if AValue <> DataSourceCatalog then begin CheckIsInactive('DataSourceCatalog ' + RStrProperty); FDataSourceCatalog := AValue; end; end; function TGMOdbcConnection.GetTransactionSupport: TTransactionSupport; var TxnSupport: SQLUSMALLINT; //Len: SQLSMALLINT; begin CheckIsActive('TransactionSupport ' + RStrProperty); ODBCCheck(SQLGetInfo(Handle, SQL_TXN_CAPABLE, @TxnSupport, SizeOf(TxnSupport), nil), Self, {$I %CurrentRoutine%}); case TxnSupport of SQL_TC_NONE: Result := txnNone; SQL_TC_DML: Result := txnDMLOnly; SQL_TC_DDL_COMMIT: Result := txnDDLCommit; SQL_TC_DDL_IGNORE: Result := txnDDLIgnore; SQL_TC_ALL: Result := txnAll; else raise EGMException.ObjError(MsgUnknownValue('SQL_TXN_CAPABLE', TxnSupport), Self, {$I %CurrentRoutine%}); end; end; function TGMOdbcConnection.GetNetworkPacketSize: SQLUINTEGER; //var GMStrLen: SQLINTEGER; begin if not Active then Result := FNetworkPacketSize else if not ODBCSucceeded(SQLGetConnectAttr(Handle, SQL_ATTR_PACKET_SIZE, @Result, SQL_IS_UINTEGER, nil)) then Result := 0; end; procedure TGMOdbcConnection.SetNetworkPacketSize(const AValue: SQLUINTEGER); begin if AValue <> NetworkPacketSize then begin SetODBCNetworkPacketSize(AValue); FNetworkPacketSize := AValue; end; end; {procedure TGMOdbcConnection.SetAsynchronOperations(const AValue: Boolean); begin if AValue <> AsynchronOperations then begin CheckIsInactive('AsynchronOperations ' + RStrProperty); FAsynchronOperations := AValue; end; end;} {procedure TGMOdbcConnection.SetAutoCommitTransactions(const AValue: Boolean); begin if AValue <> AutoCommitTransactions then begin SetODBCAutoCommitTransactions(AValue); FAutoCommitTransactions := AValue; end; end;} {procedure TGMOdbcConnection.SetAllowDriverDialogs(const AValue: Boolean); begin if AValue <> AllowDriverDialogs then begin SetODBCDriverDialogPrntWnd(AValue); FAllowDriverDialogs := AValue; end; end;} {procedure TGMOdbcConnection.SetCaseSensitiveCatalogNames(const AValue: Boolean); begin if AValue <> CaseSensitiveCatalogNames then begin SetODBCCaseSensitiveCatalogNames(AValue); FCaseSensitiveCatalogNames := AValue; end; end;} procedure TGMOdbcConnection.SetTraceProperties(const AValue: TOdbcTraceProperties); begin if not TraceProperties.IsEqualTo(AValue) then TraceProperties.AssignFromObj(AValue); end; procedure TGMOdbcConnection.SetTranslateProperties(const AValue: TOdbcTranslateProperties); begin if not TranslateProperties.IsEqualTo(AValue) then TranslateProperties.AssignFromObj(AValue); end; { ----------------------------- } { ---- TOdbcBlobStreamBase ---- } { ----------------------------- } constructor TOdbcBlobStreamBase.Create(const AMode: DWORD; const AOwner: TObject; const AStatementHandle: SQLHANDLE; const ARefLifeTime: Boolean); begin inherited Create(AMode, '', ARefLifeTime); FOwner := AOwner; FStatementHandle := AStatementHandle; end; { ----------------------------- } { ---- TOdbcBlobReadStream ---- } { ----------------------------- } constructor TOdbcBlobReadStream.Create(const AOwner: TObject; const ADataType: TGMDBColumnDataType; const AColumnPosition: LongInt; const AStatementHandle: SQLHANDLE; const ATotalSize: Int64; const AStartData: AnsiString; const ARefLifeTime: Boolean); begin inherited Create(STGM_READ, AOwner, AStatementHandle, ARefLifeTime); FColumnPosition := AColumnPosition; FSize := ATotalSize; // cInvalidDataSize; FDataType := ADataType; FStartData := AStartData; end; procedure TOdbcBlobReadStream.InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); var n: SQLLEN; startLen: Int64; // pos: Int64; // ret: SQLRETURN; begin n := 0; startLen := 0; // pos := FPosition; if FPosition < Length(FStartData) then begin startLen := Min(Length(FStartData) - FPosition, cb); Move((PAnsiChar(FStartData) + FPosition)^, pv^, startLen); Dec(cb, startLen); pv := GMAddPtr(pv, startLen); // Inc(pos, startLen); end; // // SQL Server: SQLGetData returns in DataLenthIndicator the ammount of data that was present before the call was made. // if (FPosition + startLen < FSize) and (cb > 0) then // ret := SQL_SUCCESS else // begin // ret := SQLGetData(FStatementHandle, FColumnPosition, SQL_C_BINARY, pv, cb, @n); OdbcCheck(SQLGetData(FStatementHandle, FColumnPosition, SQL_C_BINARY, pv, cb, @n), FOwner, {$I %CurrentRoutine%}); // end; if @pcbRead <> nil then pcbRead := Max(0, Min(cb + startLen, FSize - FPosition)); //if @pcbRead <> nil then // if ret = SQL_SUCCESS_WITH_INFO then pcbRead := cb else pcbRead := Max(0, FSize - FPosition); //if FPosition < FSize then // begin // OdbcCheck(SQLGetData(FStatementHandle, FColumnPosition, SQL_C_BINARY, pv, cb, @n), FOwner, {$I %CurrentRoutine%}); //// if FSize = cInvalidDataSize then FSize := n; //// n := GMBoundedInt(cb, 0, FSize - FPosition); // //Inc(FPosition, Result); // end; end; procedure TOdbcBlobReadStream.InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord); begin raise EGMException.ObjError(GMFormat(srUnsupportedStreamOperation, [{$I %CurrentRoutine%}]), FOwner); end; //function TOdbcBlobReadStream.Seek(dlibMove: Int64; dwOrigin: LongInt; out libNewPosition: Int64): HResult; //begin // if (Offset <> 0) or (Origin <> soFromCurrent) then raise EGMException.ObjError(GMFormat(RStrUnsupportedSeekOffset, [Offset, Origin]), FOwner, {$I %CurrentRoutine%}); // Result := FPosition; //end; { ------------------------------ } { ---- TOdbcBlobWriteStream ---- } { ------------------------------ } procedure TOdbcBlobWriteStream.InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); begin raise EGMException.ObjError(GMFormat(srUnsupportedStreamOperation, [{$I %CurrentRoutine%}]), FOwner); end; procedure TOdbcBlobWriteStream.InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord); begin OdbcCheck(SQLPutData(FStatementHandle, pv, cb), FOwner, {$I %CurrentRoutine%}); if @pcbWritten <> nil then pcbWritten := cb; end; function TOdbcBlobWriteStream.Seek(dlibMove: Int64; dwOrigin: LongInt; libNewPosition: PInt64): HResult; {$IFDEF FPC}{$push}{$WARN 5033 off : Function result variable does not seem to be initialized}{$ENDIF} begin //Result := E_NOTIMPL; {if (Offset <> 0) or (Origin <> soFromCurrent) then} raise EGMException.ObjError(GMFormat(srUnsupportedSeekOffset, [dlibMove, dwOrigin]), FOwner, {$I %CurrentRoutine%}); //Result := FPosition; end; {$IFDEF FPC}{$pop}{$ENDIF} { ------------------------------- } { ---- TODBCFieldValueBuffer ---- } { ------------------------------- } constructor TODBCFieldStateValueBuffer.Create(const AOwner: TObject; const ADataType: TGMDBColumnDataType; const AZeroInit: Boolean; const AFreeMemoryOnDestroy: Boolean; const ARefLifeTime: Boolean); begin inherited Create(AOwner, ADataType, AZeroInit, AFreeMemoryOnDestroy, ARefLifeTime); DataLength := SQL_NULL_DATA; end; function TODBCFieldStateValueBuffer.CalculateBufferSize: LongInt; begin Result := ODBCCalculateValueBufferSize(DataType, 0, {$I %CurrentRoutine%}); end; function TODBCFieldStateValueBuffer.OwnerRecordset: TGMOdbcRecordsetBase; begin Result := Owner as TGMOdbcRecordsetBase; end; function TODBCFieldStateValueBuffer.IsNull: Boolean; begin Result := DataLength = SQL_NULL_DATA; end; //procedure TODBCFieldStateValueBuffer.InternalSetSize(ANewSize: Int64); //begin // inherited InternalSetSize(ANewSize); // //if DataSize = 0 then DataLength := SQL_NULL_DATA; //end; function TODBCFieldStateValueBuffer.WriteAt(ulOffset: Int64; pv: Pointer; cb: LongInt; pcbWritten: PLongint): HResult; begin Result := inherited WriteAt(ulOffset, pv, cb, pcbWritten); DataLength := DataSize; end; function TODBCFieldStateValueBuffer.AskInteger(const AValueId: LongInt): LongInt; begin //Result := inherited AskInteger(AValueId); //if Result = CInvalidIntValue then case AValueId of Ord(ivDataLength): Result := DataLength; else Result := cInvalidIntValue; end; end; procedure TODBCFieldStateValueBuffer.Invalidate(const AResetOffset, ASetToNULL: Boolean); begin inherited Invalidate(AResetOffset, ASetToNULL); if IsStreamedFieldDataType(DataType) then Clear; if ASetToNULL then DataLength := SQL_NULL_DATA; //FFirstDataRead := False; end; //procedure TODBCFieldStateValueBuffer.ReadFirstData; //begin //end; function TODBCFieldStateValueBuffer.IsBookmarkColumn: Boolean; begin Result := False; end; procedure TODBCFieldStateValueBuffer.AssignFromIntf(const Source: IUnknown); begin // DataLength may indicate NULL Value which skips data copy in inherited AssignFromIntf DataLength := GMCheckAskInteger(Source, Ord(ivDataLength), {$I %CurrentRoutine%}); inherited AssignFromIntf(Source); // WriteAt will set DataLength := DataSize which is wrong in case of TGMString/Memo Data Types DataLength := GMCheckAskInteger(Source, Ord(ivDataLength), {$I %CurrentRoutine%}); end; function TODBCFieldStateValueBuffer.GetDataLength: PtrInt; begin Result := FDataLength; end; procedure TODBCFieldStateValueBuffer.SetDataLength(const AValue: PtrInt); begin FDataLength := AValue; end; //procedure TODBCFieldStateValueBuffer.AccessBufferContents(const AAccessMode: TGMValueBufferAccessMode; const ANewSize: LongInt); //begin ////Assert(IsStreamedFieldDataType(DataType)); //if not IsStreamedFieldDataType(DataType) then FetchData(False) else // case AAccessMode of // baRead: FetchData(False); // baWrite: // begin // SetSize(ANewSize); // // Once we are writing there is no need to // // fetch anything until Apply or Cancel Changes. // // Otherwise it is questionalbe how we did get here ... //// FFirstDataRead := True; // DataFetched := True; // Modified := True; // InvalidateDisplayText; // end; // end; //end; function TODBCFieldStateValueBuffer.InternalBuildDisplayText: TGMString; //function PercentCompressionRatio(const DataLength, StoredDataLength: Integer): Integer; //begin // if DataLength = 0 then Result := 0 else Result := Round((1 - (StoredDataLength / DataLength)) * 100); //end; begin if not OwnerRecordset.ODBCFetchSuccess and (OwnerRecordset.State <> rsInserting) then begin if (OwnerRecordset.CursorType <> ctUniDirectional) and not OwnerRecordset.IsEmpty then Result := '<' + GMStringJoin(ODBCReturnCodeAsString(OwnerRecordset.FetchResult.ResultCode), ': ', OwnerRecordset.FetchResult.ErrorText) + '>' else Result := ''; end else //if IsNull then Result := '' //else case DataType of fdtBinary: if IsBookmarkColumn then case DataSize of SizeOf(Word): Result := GMIntToStr(Word(Memory^)); SizeOf(LongWord): Result := GMIntToStr(LongWord(Memory^)); SizeOf(Int64): Result := GMIntToStr(Int64(Memory^)); else Result := GMEncodeBase16(Memory, DataSize); end else Result := inherited InternalBuildDisplayText; // Result := GMFormat(RStrBlobDisplayText, [DataLength, FStoredDataLength, PercentCompressionRatio(DataLength, FStoredDataLength)]); else Result := inherited InternalBuildDisplayText; end; end; function TODBCFieldStateValueBuffer.InternalGetUnionValue: RGMUnionValue; function GetOdbcAnsiString: AnsiString; var strLen: Integer; pChA: PAnsichar; begin if (Memory = nil) or (DataLength <= 0) and (DataSize <= 0) then Exit(''); strLen := Max(0, Min(DataLength, DataSize - 1)); if (strLen > 0) and (Owner is TGMOdbcRecordsetBase) and (raStripTrailingBlanks in TGMOdbcRecordsetBase(Owner).Attributes) then begin pChA := GMStrCRLScanA(PAnsiChar(Memory) + strLen - 1, ' ', strLen); if pChA = nil then strLen := 0 else strLen := pChA - PAnsiChar(Memory) + 1; end; SetString(Result, PAnsiChar(Memory), strLen); end; function GetOdbcUnicodeString: UnicodeString; var strLen: Integer; pChW: PWideChar; begin if (Memory = nil) or (DataLength <= 0) and (DataSize <= 0) then Exit(''); strLen := Max(0, Min(DataLength div SizeOf(WideChar), (DataSize div SizeOf(WideChar)) - 1)); if (strLen > 0) and (Owner is TGMOdbcRecordsetBase) and (raStripTrailingBlanks in TGMOdbcRecordsetBase(Owner).Attributes) then begin pChW := GMStrCRLScanW(PWideChar(Memory) + strLen - 1, ' ', strLen); if pChW = nil then strLen := 0 else strLen := pChW - PWideChar(Memory) + 1; end; SetString(Result, PWideChar(Memory), strLen); end; function GetOdbcAnsiText: AnsiString; var retCode: SQLRETURN; begin SetLength(Result, cGetDataBufSizeInChars); retCode := SQLGetData(OwnerRecordset.Handle, FColumnPosition, SQL_C_CHAR, PAnsiChar(Result), Length(Result)+1, @FDataLength); if retcode < 0 then ODBCCheck(retcode, Self, 'SQLGetData', OwnerRecordset.HandleType, OwnerRecordset.Handle); if FDataLength < 0 then SetLength(Result, 0) else if FDataLength < Length(Result) then SetLength(Result, FDataLength); end; function GetOdbcUnicodeText: UnicodeString; var retCode: SQLRETURN; begin SetLength(Result, cGetDataBufSizeInChars); retCode := SQLGetData(OwnerRecordset.Handle, FColumnPosition, SQL_C_WCHAR, PWideChar(Result), (Length(Result)+1) * SizeOf(WideChar), @FDataLength); if retcode < 0 then ODBCCheck(retcode, Self, 'SQLGetData', OwnerRecordset.HandleType, OwnerRecordset.Handle); if FDataLength < 0 then SetLength(Result, 0) else if FDataLength div SizeOf(WideChar) < Length(Result) then SetLength(Result, FDataLength div SizeOf(WideChar)); end; begin case DataType of //fdtNumeric: Result := CurrencyFromODBCNumeric(SQL_NUMERIC_STRUCT(Memory^)); fdtDate: Result := DateTimeFromODBCDate(PSQL_DATE_STRUCT(Memory)); fdtTime: Result := DateTimeFromODBCTime(PSQL_TIME_STRUCT(Memory)); fdtDateTime: Result := DateTimeFromODBCTimestamp(PSQL_TIMESTAMP_STRUCT(Memory)); fdtAnsiString: Result := GetOdbcAnsiString; fdtUnicodeString: result := GetOdbcUnicodeString; fdtAnsiText: Result := GetOdbcAnsiText; fdtUnicodeText: Result := GetOdbcUnicodeText; else Result := inherited InternalGetUnionValue; end; end; procedure TODBCFieldStateValueBuffer.InternalSetNullValue; begin if IsStreamedFieldDataType(DataType) then Clear(False); // else DataLength := SQL_NULL_DATA; DataLength := SQL_NULL_DATA; inherited InternalSetNullValue; end; procedure TODBCFieldStateValueBuffer.InternalSetUnionValue(const AValue: RGMUnionValue); begin DataLength := MemoryBuffer.SizeInBytes; case DataType of fdtDate: ODBCDateFromDateTime(AValue, PSQL_DATE_STRUCT(Memory)); fdtTime: ODBCTimeFromDateTime(AValue, PSQL_TIME_STRUCT(Memory)); fdtDateTime: ODBCTimestampFromDateTime(AValue, PSQL_TIMESTAMP_STRUCT(Memory)); else inherited InternalSetUnionValue(AValue); end; end; //procedure TODBCFieldStateValueBuffer.SetUnionValue(const AValue: RGMUnionValue); //begin //inherited SetValue(AValue); ////FFirstDataRead := True; //end; { ------------------------------- } { ---- TODBCFieldValueBuffer ---- } { ------------------------------- } //constructor TODBCFieldValueBuffer.CreateFieldBuffer(const AOwner: TObject; // const ADataType: TGMDBColumnDataType; // const AColumnPosition: LongInt; // const AFieldName: TGMString; // const ASizeInBytes: Cardinal; // const AMaxStrLength: Cardinal; // const AStatementHandle: THandle); ////const cFirstDataSize: array [Boolean] of Integer = (0, SizeOf(TGMCompressedBlobHeaderData)); //begin //inherited CreateFieldBuffer(AOwner, ADataType, AColumnPosition, AFieldName, ASizeInBytes, AMaxStrLength, AStatementHandle); ////FFirstDataSize := cFirstDataSize[ADataType = fdtBinary]; // <- Don't compress Memos //end; destructor TODBCFieldValueBuffer.Destroy; begin try inherited Destroy; except end; // Realloc -> BindBuffer -> may raise -> never raise in destructor, memory leak! end; function TODBCFieldValueBuffer.IsFixedBufferSize: Boolean; begin Result := not IsStreamedFieldDataType(DataType) or IsBookmarkColumn; end; //procedure TODBCFieldValueBuffer.Invalidate(const AResetOffset: Boolean); //begin // inherited Invalidate(AResetOffset); // if IsStreamedFieldDataType(DataType) and not IsBookmarkColumn then Clear(AResetOffset); //end; procedure TODBCFieldValueBuffer.OnAfterRealloc(const Sender: TObject); begin if FBufferBound and (MemoryBuffer <> nil) then BindBuffer(True); end; function TODBCFieldValueBuffer.CalculateBufferSize: LongInt; begin if (StatementHandle = cOdbcInvalidHandle) or (FColumnPosition = cInvalidColumnPos) then Result := 0 else if IsBookmarkColumn then Result := SizeInBytes else Result := ODBCCalculateValueBufferSize(DataType, SizeInBytes, {$I %CurrentRoutine%}); end; function TODBCFieldValueBuffer.IsBookmarkColumn: Boolean; begin Result := FColumnPosition = cOdbcBookmarkColPos; end; procedure TODBCFieldValueBuffer.SetupDataLengthForUpdate; begin //BindBlobBuffer(True); FSavedDataLength := DataLength; if not Modified then DataLength := SQL_COLUMN_IGNORE else if IsStreamedFieldDataType(DataType) then if FValueReadStream <> nil then DataLength := OdbcDataLenAtExec(GMIStreamSize(FValueReadStream)) else DataLength := OdbcDataLenAtExec(DataLength); end; procedure TODBCFieldValueBuffer.RestoreDataLength; begin DataLength := FSavedDataLength; //BindBlobBuffer(False); end; //procedure TODBCFieldValueBuffer.InvalidateAndReadFirstData(const AResetOffset: Boolean); //begin //Invalidate(AResetOffset); //// ReadFirstData; //end; //procedure TODBCFieldValueBuffer.ReadFirstData; //var fetchSize: LongInt; //// //// Why this? //// //// The ODBC fetch operations doesn't return the length of BLOB Data. //// //// SQLGetData is the only way to know about the Size and NULL state of BLOB Data. //// The smallest ammount to transfer is 1 Byte. And if there is a first byte of data //// we must keep it, since SQLGetData gives Data only once. //// //begin // if IsStreamedFieldDataType(DataType) and not IsBookmarkColumn and not DataFetched then // begin // if not OwnerRecordset.ODBCFetchSuccess then Clear else // begin // // MS-Access Memo fields makes Access Violation when FFirstDataSize <> SizeOf(TGMChar) // case DataType of // fdtAnsiText, fdtUnicodeText: fetchSize := GMCharSizeInBytes(DataType); // fdtBinary: fetchSize := 1; // else fetchSize := 0; // end; // // if fetchSize = 0 then Exit; // // SetSize(fetchSize); // ODBCCheck(SQLGetData(StatementHandle, FColumnPosition, ODBCTypeFromFieldDataType(DataType, {$I %CurrentRoutine%}), Memory, // DataSize, @FDataLength), Owner, {$I %CurrentRoutine%}); // // if IsNull then Clear(False); //// begin Clear(False); DataFetched := True; end; //// else //// Inc(FDataLength, DataSize); // <- The size of the fetched data has already been subtracted from FDataLength // end; // // DataFetched := True; //// FFirstDataRead := True; // end; //end; //procedure TODBCFieldValueBuffer.FetchBlobData; //var DataLen: LongInt; //procedure UnCompressData; ////var DecompressorStream, SourceStream, DestStream: IStream; mousePtrWait: IUnknown; //begin // Assert(False, 'ToDo: TODBCFieldValueBuffer.UnCompressData'); // {Clear; // SourceStream := TOdbcBlobReadStream.Create(Owner, DataType, ColumnPosition, StatementHandle); // try // DestStream := TGMLockBytesStream.Create(Self); // try // DecompressorStream := TGMDecompressorStream.Create(SourceStream); // try // mousePtrWait := TGMTempCursor.Create(vDBWaitCursor); // GMCopyStream(DecompressorStream, DestStream); // finally DecompressorStream.Free; end; // finally DestStream := nil; end; // finally SourceStream := nil; end; // InvalidateDisplayText; // //OwnerRecordset.AfterValueChange(FieldName);} //end; //begin //if IsStreamedFieldDataType(DataType) and not DataFetched then // begin // ReadFirstData; // <- May set: DataFetched := True; // if not DataFetched then // begin // if DataIsCompressed then UnCompressData else // begin // SetSize(DataLength + GMCharSizeInBytes(DataType)); DataLen := 0; // SQLGetData(StatementHandle, ColumnPosition, ODBCTypeFromFieldDataType(DataType, {$I %CurrentRoutine%}), GMAddPtr(Memory, FFirstDataSize), DataSize - FFirstDataSize, @DataLen); // //Assert(SQLCode = SQL_SUCCESS); // end; // DataFetched := True; // OwnerRecordset.AfterValueChange(FieldName); // end; // end; //end; //procedure TODBCFieldValueBuffer.InternalFetchData(const AForDisplayText: Boolean = False); //var termChPos, chSize: Integer; pChA: PAnsichar; pChW: PWideChar; //begin // if not OwnerRecordset.ODBCFetchSuccess then DataFetched := True // else // if not IsStreamedFieldDataType(DataType) or IsBookmarkColumn then // begin //// if IsNull then SetSize(0) else // if IsStringFieldDataType(DataType) and not IsNull // and (Owner is TGMOdbcRecordsetBase) and (raStripTrailingBlanks in TGMOdbcRecordsetBase(Owner).Attributes) // and (Memory <> nil) and (DataLength >= 0) and (DataSize > 0) then // begin // // // // Some ODBC drivers deliver strings padded right with blanks, strip right blanks here. // // // chSize := GMCharSizeInBytes(DataType); // <- GMCharSizeInBytes should not return 0 when IsStringFieldDataType = True // // if chSize > 0 then // <- avoid division by zero // begin // // // // DataLength is in bytes! // // // termChPos := Min(DataLength div chSize, (DataSize div chSize) - 1); // // case DataType of // fdtAnsiString: // begin // // while (termChPos >= 0) and ((PAnsiChar(Memory) + termChPos)^ = ' ') do Dec(termChPos); // if termChPos > 0 then // begin // pChA := GMStrCRLScanA(PAnsiChar(Memory) + termChPos - 1, ' ', termChPos); // if pChA = nil then termChPos := 0 else termChPos := pChA - PAnsiChar(Memory) + 1; // end; // // (PAnsiChar(Memory) + termChPos)^ := #0; // end; // // fdtUnicodeString: // begin // // while (termChPos >= 0) and ((PWideChar(Memory) + termChPos)^ = ' ') do Dec(termChPos); //// wVal := PWideChar(Memory); // // if termChPos > 0 then // begin // pChW := GMStrCRLScanW(PWideChar(Memory) + termChPos - 1, ' ', termChPos); // if pChW = nil then termChPos := 0 else termChPos := pChW - PWideChar(Memory) + 1; // end; // // (PWideChar(Memory) + termChPos)^ := #0; // end; // end; // end; // end; // // DataFetched := True; // end // else //// if AForDisplayText and (DataType = fdtBinary) then ReadFirstData else FetchBlobData; // ReadFirstData; //end; function TODBCFieldValueBuffer.CreateValueStream(const AMode: DWORD): ISequentialStream; var firstData: AnsiString; begin if not IsStreamedFieldDataType(DataType) then Result := inherited CreateValueStream(AMode) else case AMode of STGM_WRITE: Result := TOdbcBlobWriteStream.Create(STGM_WRITE, Owner, StatementHandle); STGM_READ: begin // // Don't pass Memory and DataSize here, memory may be reallocated after additional writes. // So better copy contents with data read by ReadFirstData to an AnsiString. // SetLength(firstData, DataSize); Move(Memory^, PAnsiChar(firstData)^, Length(firstData)); Result := TOdbcBlobReadStream.Create(Owner, DataType, FColumnPosition, StatementHandle, DataLength, firstData); end; end; end; procedure TODBCFieldValueBuffer.StoreBlobData; var dstStream: ISequentialStream; begin if IsStreamedFieldDataType(DataType) and (FValueReadStream <> nil) then begin dstStream := TOdbcBlobWriteStream.Create(STGM_WRITE, Owner, StatementHandle); GMCopyIStream(FValueReadStream, dstStream); end; end; //procedure TODBCFieldValueBuffer.BindBlobBuffer(const ABind: Boolean); //begin // if IsStreamedFieldDataType(DataType) then // if ABind then // ODBCCheck(SQLBindCol(StatementHandle, FColumnPosition, ODBCTypeFromFieldDataType(DataType, {$I %CurrentRoutine%}), @FColumnPosition, SizeOf(FColumnPosition), @FDataLength), Owner, {$I %CurrentRoutine%}) // else // ODBCCheck(SQLBindCol(StatementHandle, FColumnPosition, ODBCTypeFromFieldDataType(DataType, {$I %CurrentRoutine%}), nil, 0, @FDataLength), Owner, {$I %CurrentRoutine%}); //end; procedure TODBCFieldValueBuffer.BindBuffer(const ABind: Boolean); begin if not ABind then ODBCCheck(SQLBindCol(StatementHandle, FColumnPosition, ODBCTypeFromFieldDataType(DataType, {$I %CurrentRoutine%}), nil, 0, @FDataLength), Owner, {$I %CurrentRoutine%}) else if IsStreamedFieldDataType(DataType) then // or IsBookmarkColumn then // <- Blob Fields never have their Buffer Bound! ODBCCheck(SQLBindCol(StatementHandle, FColumnPosition, ODBCTypeFromFieldDataType(DataType, {$I %CurrentRoutine%}), nil, 0, @FDataLength), Owner, {$I %CurrentRoutine%}) else ODBCCheck(SQLBindCol(StatementHandle, FColumnPosition, ODBCTypeFromFieldDataType(DataType, {$I %CurrentRoutine%}), Memory, PtrInt(MemoryBuffer.SizeInBytes) - Offset, @FDataLength), Owner, {$I %CurrentRoutine%}); // //// begin //// if ABind then ODBCCheck(SQLBindCol(StatementHandle, ColumnPosition, ODBCTypeFromFieldDataType(DataType, {$I %CurrentRoutine%}), nil, 0, @FDataLength), Owner, {$I %CurrentRoutine%}); //// end ////else // begin // if not ABind then // ODBCCheck(SQLBindCol(StatementHandle, FColumnPosition, ODBCTypeFromFieldDataType(DataType, {$I %CurrentRoutine%}), nil, 0, @FDataLength), Owner, {$I %CurrentRoutine%}) // else // ODBCCheck(SQLBindCol(StatementHandle, FColumnPosition, ODBCTypeFromFieldDataType(DataType, {$I %CurrentRoutine%}), Memory, PtrInt(MemoryBuffer.SizeInBytes) - Offset, @FDataLength), Owner, {$I %CurrentRoutine%}); // // FBufferBound := ABind; // end; end; //procedure TODBCFieldValueBuffer.AssignFromIntf(const ASource: IUnknown); //begin //inherited AssignFromIntf(ASource); //if DataFetched then FFirstDataRead := True; //end; { ---------------------- } { ---- TGMOdbcField ---- } { ---------------------- } {constructor TGMOdbcField.Create(const ARecordset: TObject; const ACreateData: RGMFieldCreateData); begin inherited Create(ARecordset, ACreateData); end; destructor TGMOdbcField.Destroy; begin inherited Destroy; end;} function TGMOdbcField.ValueBufferCreateClass: TGMFieldValueBufferClass; begin Result := TODBCFieldValueBuffer; end; function TGMOdbcField.ODBCValueBuffer(const AValueBufferInstance: EGMValueBufferInstance): TODBCFieldValueBuffer; begin Result := ValueBuffer(AValueBufferInstance) as TODBCFieldValueBuffer; end; procedure TGMOdbcField.BindBuffer(const ABind: Boolean); begin ODBCValueBuffer(vbiValue).BindBuffer(ABind); end; //function TGMOdbcField.AccessValueBuffer(const AAccessMode: LongInt; const AIID: TGUID; out Intf; const AValueBufferInstance: LongInt): HResult; //begin //GMCheckIntRange(cStrBufAccessTypeName, AAccessMode, Ord(Low(TGMValueBufferAccessMode)), Ord(High(TGMValueBufferAccessMode)), Owner, {$I %CurrentRoutine%}); //GMCheckIntRange(cStrValBufInstTypeName, AValueBufferInstance, Ord(Low(EGMValueBufferInstance)), Ord(High(EGMValueBufferInstance)), Owner, {$I %CurrentRoutine%}); // //// Just check if we would get the desired interface //Result := CQIResult[ValueBuffer(EGMValueBufferInstance(AValueBufferInstance)).GetInterface(AIID, Intf)]; //IUnknown(Intf) := nil; //if Result = S_OK then // begin // if AAccessMode = Ord(baWrite) then // begin // EditRecordset; // CheckUpdatableState({$I %CurrentRoutine%}); // end; // ODBCValueBuffer(EGMValueBufferInstance(AValueBufferInstance)).AccessBufferContents(TGMValueBufferAccessMode(AAccessMode)); // // Buffers may have been swapped, so get the Interface again // Assert(ValueBuffer(EGMValueBufferInstance(AValueBufferInstance)).GetInterface(AIID, Intf)); // end; //end; procedure TGMOdbcField.SwapBufferMap; begin ODBCValueBuffer(vbiValue).FBufferBound := False; inherited SwapBufferMap; ODBCValueBuffer(vbiValue).BindBuffer(True); end; procedure TGMOdbcField.SetupDataLengthForUpdate; begin ODBCValueBuffer(vbiValue).SetupDataLengthForUpdate; end; procedure TGMOdbcField.RestoreDataLength; begin ODBCValueBuffer(vbiValue).RestoreDataLength; end; //procedure TGMOdbcField.AfterActiveChange(const ANewActive: Boolean); //begin //inherited AfterActiveChange(ANewActive); //if ANewActive then // begin //// ODBCValueBuffer(vbiValue).BindBuffer(ANewActive); //// ODBCValueBuffer(vbiValue).InvalidateAndReadFirstData(True); // ODBCValueBuffer(vbiValue).Invalidate(True); // end; //end; //procedure TGMOdbcField.AfterPositionChange; //begin //// No inherited call here ////ODBCValueBuffer(vbiValue).InvalidateAndReadFirstData(True); //ODBCValueBuffer(vbiValue).Invalidate(True); //end; procedure TGMOdbcField.StoreBlobData; begin //if IsStreamedFieldDataType(DataType) then ODBCValueBuffer(vbiValue).StoreBlobData(CreateData.BlobCompressionType); if IsStreamedFieldDataType(DataType) then ODBCValueBuffer(vbiValue).StoreBlobData; end; //procedure TGMOdbcField.AfterOperation(const AOperation: Integer; const AParameter: IUnknown = nil); //begin //inherited AfterOperation(AOperation, AParameter); //case AOperation of //// Ord(roCancelChanges), Ord(roEdit), Ord(roInsert): inherited AfterOperation(AOperation, AParameter); //// Ord(roRefreshCurrent): ODBCValueBuffer(vbiValue).Invalidate(True); // InvalidateAndReadFirstData(True); // // Ord(roApplyChanges): // begin // if IsStreamedFieldDataType(DataType) and not ODBCValueBuffer(vbiValue).DataFetched then //// begin // // Applying Changes has the fetching semantics of a cursor move // // If we hadn't fetched all of the Data we must start all over again //// ODBCValueBuffer(vbiValue).FFirstDataRead := False; // ODBCValueBuffer(vbiValue).ReadFirstData; //// end; // //ValueBuffer(vbiValue).Modified := False; // end; //end; //end; //procedure TGMOdbcField.AfterOperation(const AOperation: Integer; const AParameter: IUnknown = nil); //begin //case AOperation of // Ord(roCancelChanges), Ord(roEdit), Ord(roInsert): inherited AfterOperation(AOperation, AParameter); // Ord(roRefreshCurrent): ODBCValueBuffer(vbiValue).Invalidate(True); // InvalidateAndReadFirstData(True); // // Ord(roApplyChanges): // begin // inherited AfterOperation(AOperation, AParameter); // if IsStreamedFieldDataType(DataType) and not ODBCValueBuffer(vbiValue).DataFetched then //// begin // // Applying Changes has the fetching semantics of a cursor move // // If we hadn't fetched all of the Data we must start all over again //// ODBCValueBuffer(vbiValue).FFirstDataRead := False; // ODBCValueBuffer(vbiValue).ReadFirstData; //// end; // //ValueBuffer(vbiValue).Modified := False; // end; //end; //end; { --------------------------------- } { ---- TStmtCNAwareSubProperty ---- } { --------------------------------- } constructor TStmtCNAwareSubProperty.Create(const AOwner: TGMActivatableObject); begin inherited Create(AOwner); FUseValueFromConnection := cDfltUseConnectionValue; end; function TStmtCNAwareSubProperty.IsEqualTo(const AValue: TStmtCNAwareSubProperty): Boolean; begin if AValue = nil then Result := True else Result := (UseValueFromConnection = AValue.UseValueFromConnection); end; procedure TStmtCNAwareSubProperty.AssignFromObj(const ASource: TObject); begin if ASource is TStmtCNAwareSubProperty then UseValueFromConnection := TStmtCNAwareSubProperty(ASource).UseValueFromConnection; //else inherited AssignFromObj(ASource); end; procedure TStmtCNAwareSubProperty.SetUseValueFromConnection(const AValue: Boolean); begin if AValue <> UseValueFromConnection then begin FUseValueFromConnection := AValue; // <-- Before SetODBCValue !!! ValueFromConnectionChanged; end; end; procedure TStmtCNAwareSubProperty.LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); begin end; procedure TStmtCNAwareSubProperty.StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); begin end; { -------------------------------- } { ---- TStmtTimeoutProperties ---- } { -------------------------------- } constructor TStmtTimeoutProperties.Create(const AOwner: TGMActivatableObject = nil); begin inherited Create(AOwner); FTimeoutForStatements := cDfltStatementTimeout; end; function TStmtTimeoutProperties.IsEqualTo(const AValue: TStmtCNAwareSubProperty): Boolean; begin Result := inherited IsEqualTo(AValue); if AValue is TStmtTimeoutProperties then Result := Result and (TimeoutForStatements = TStmtTimeoutProperties(AValue).TimeoutForStatements); end; procedure TStmtTimeoutProperties.AssignFromObj(const Source: TObject); begin if Source is TStmtTimeoutProperties then TimeoutForStatements := TStmtTimeoutProperties(Source).TimeoutForStatements; //inherited AssignFromObj(Source); end; procedure TStmtTimeoutProperties.SetODBCTimeoutForStatements(const AValue: PtrUInt); begin if (ODBCStatement <> nil) and ODBCStatement.Active then ODBCCheck(SQLSetStmtAttr(ODBCStatement.Handle, SQL_ATTR_QUERY_TIMEOUT, SQLPOINTER(AValue), 0), ODBCStatement, {$I %CurrentRoutine%}); end; function TStmtTimeoutProperties.GetTimeoutForStatements: SQLUINTEGER; begin if UseValueFromConnection and (ODBCStatement <> nil) and (ODBCStatement.ODBCConnection <> nil) then Result := ODBCStatement.ODBCConnection.Properties.Obj.TimeoutForStatements else Result := FTimeoutForStatements; end; procedure TStmtTimeoutProperties.SetTimeoutForStatements(const AValue: SQLUINTEGER); begin if AValue <> TimeoutForStatements then begin if ODBCStatement <> nil then begin ODBCStatement.CheckIsInactive('TimeoutForStatements ' + RStrProperty); if UseValueFromConnection and (ODBCStatement.ODBCConnection <> nil) then ODBCStatement.ODBCConnection.Properties.Obj.TimeoutForStatements := AValue; end; SetODBCTimeoutForStatements(AValue); FTimeoutForStatements := AValue; end; end; procedure TStmtTimeoutProperties.SetODBCValue; begin if (TimeoutForStatements <> SQL_DEFAULT_TIMEOUT) and not UseValueFromConnection then SetODBCTimeoutForStatements(TimeoutForStatements); end; procedure TStmtTimeoutProperties.ValueFromConnectionChanged; begin SetTimeoutForStatements(TimeoutForStatements); end; procedure TStmtTimeoutProperties.LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); begin inherited LoadData(ASource, ACryptCtrlData); if ASource <> nil then begin UseValueFromConnection := ASource.ReadBoolean(cPrsUseTimeoutValueFromConnection, cDfltUseConnectionValue); TimeoutForStatements := ASource.ReadInteger(cPrsStatementTimeout, cDfltStatementTimeout); end; end; procedure TStmtTimeoutProperties.StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); begin inherited StoreData(ADest, ACryptCtrlData); if ADest <> nil then begin GMStoreBoolean(ADest, cPrsUseTimeoutValueFromConnection, UseValueFromConnection, cDfltUseConnectionValue); GMStoreInteger(ADest, cPrsStatementTimeout, TimeoutForStatements, cDfltStatementTimeout); end; end; { --------------------------------------- } { ---- TStmtAsyncOperationProperties ---- } { --------------------------------------- } constructor TStmtAsyncOperationProperties.Create(const AOwner: TGMActivatableObject = nil); begin inherited Create(AOwner); FAsynchronOperations := cDfltAsyncOperations; end; function TStmtAsyncOperationProperties.IsEqualTo(const AValue: TStmtCNAwareSubProperty): Boolean; begin Result := inherited IsEqualTo(AValue); if AValue is TStmtAsyncOperationProperties then Result := Result and (AsynchronOperations = TStmtAsyncOperationProperties(AValue).AsynchronOperations); end; procedure TStmtAsyncOperationProperties.AssignFromObj(const Source: TObject); begin if Source is TStmtAsyncOperationProperties then AsynchronOperations := TStmtAsyncOperationProperties(Source).AsynchronOperations; //inherited AssignFromObj(Source); end; function TStmtAsyncOperationProperties.GetAsynchronOperations: Boolean; begin if UseValueFromConnection and (ODBCStatement <> nil) and (ODBCStatement.ODBCConnection <> nil) then Result := caAsynchronOperations in ODBCStatement.ODBCConnection.Properties.Obj.Attributes else Result := FAsynchronOperations; end; procedure TStmtAsyncOperationProperties.SetAsynchronOperations(const AValue: Boolean); begin if AValue <> AsynchronOperations then begin if UseValueFromConnection and (ODBCStatement <> nil) and (ODBCStatement.ODBCConnection <> nil) then with ODBCStatement.ODBCConnection.Properties.Obj do if AValue then Attributes := Attributes + [caAsynchronOperations] else Attributes := Attributes - [caAsynchronOperations]; SetODBCAsynchronOperations(AValue); FAsynchronOperations := AValue; end; end; procedure TStmtAsyncOperationProperties.SetODBCAsynchronOperations(const AValue: Boolean); var AsyncOp: PtrUInt; begin if (ODBCStatement <> nil) and ODBCStatement.Active then begin if AValue then AsyncOp := SQL_ASYNC_ENABLE_ON else AsyncOp := SQL_ASYNC_ENABLE_OFF; ODBCCheck(SQLSetStmtAttr(ODBCStatement.Handle, SQL_ATTR_ASYNC_ENABLE, SQLPOINTER(AsyncOp), 0), ODBCStatement, {$I %CurrentRoutine%}); end; end; procedure TStmtAsyncOperationProperties.SetODBCValue; begin if (AsynchronOperations <> Boolean(SQL_ASYNC_ENABLE_DEFAULT)) and not UseValueFromConnection then SetODBCAsynchronOperations(AsynchronOperations); end; procedure TStmtAsyncOperationProperties.ValueFromConnectionChanged; begin SetAsynchronOperations(AsynchronOperations); end; procedure TStmtAsyncOperationProperties.LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); begin inherited LoadData(Source, ACryptCtrlData); if Source <> nil then begin UseValueFromConnection := Source.ReadBoolean(cPrsUseAsyncValueFromConnection, cDfltUseConnectionValue); AsynchronOperations := Source.ReadBoolean(cPrsAsynchronOperations, cDfltAsyncOperations); end; end; procedure TStmtAsyncOperationProperties.StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); begin inherited StoreData(ADest, ACryptCtrlData); if ADest <> nil then begin GMStoreBoolean(ADest, cPrsUseAsyncValueFromConnection, UseValueFromConnection, cDfltUseConnectionValue); GMStoreBoolean(ADest, cPrsAsynchronOperations, AsynchronOperations, cDfltAsyncOperations); end; end; { ---------------------------------------- } { ---- TStmtCatalogNameCaseProperties ---- } { ---------------------------------------- } constructor TStmtCatalogNameCaseProperties.Create(const AOwner: TGMActivatableObject = nil); begin inherited Create(AOwner); FCaseSensitiveCatalogNames := cDfltCaseSensitiveCatalogNames; end; function TStmtCatalogNameCaseProperties.IsEqualTo(const AValue: TStmtCNAwareSubProperty): Boolean; begin Result := inherited IsEqualTo(AValue); if AValue is TStmtCatalogNameCaseProperties then Result := Result and (CaseSensitiveCatalogNames = TStmtCatalogNameCaseProperties(AValue).CaseSensitiveCatalogNames); end; procedure TStmtCatalogNameCaseProperties.AssignFromObj(const Source: TObject); begin if Source is TStmtCatalogNameCaseProperties then CaseSensitiveCatalogNames := TStmtCatalogNameCaseProperties(Source).CaseSensitiveCatalogNames; //inherited AssignFromObj(Source); end; function TStmtCatalogNameCaseProperties.GetCaseSensitiveCatalogNames: Boolean; begin if UseValueFromConnection and (ODBCStatement <> nil) and (ODBCStatement.ODBCConnection <> nil) then Result := caCaseSensitiveCatalogNames in ODBCStatement.ODBCConnection.Properties.Obj.Attributes else Result := FCaseSensitiveCatalogNames; end; procedure TStmtCatalogNameCaseProperties.SetCaseSensitiveCatalogNames(const AValue: Boolean); begin if AValue <> CaseSensitiveCatalogNames then begin if UseValueFromConnection and (ODBCStatement <> nil) and (ODBCStatement.ODBCConnection <> nil) then with ODBCStatement.ODBCConnection.Properties.Obj do if AValue then Attributes := Attributes + [caCaseSensitiveCatalogNames] else Attributes := Attributes - [caCaseSensitiveCatalogNames]; SetODBCCaseSensitiveCatalogNames(AValue); FCaseSensitiveCatalogNames := AValue; end; end; procedure TStmtCatalogNameCaseProperties.SetODBCCaseSensitiveCatalogNames(const AValue: Boolean); var catalogCase: PtrUInt; begin if (ODBCStatement <> nil) and ODBCStatement.Active then begin if AValue then catalogCase := SQL_FALSE else catalogCase := SQL_TRUE; ODBCCheck(SQLSetStmtAttr(ODBCStatement.Handle, SQL_ATTR_METADATA_ID, SQLPOINTER(catalogCase), 0), ODBCStatement, {$I %CurrentRoutine%}); end; end; procedure TStmtCatalogNameCaseProperties.SetODBCValue; begin if (CaseSensitiveCatalogNames <> Boolean(SQL_METADATA_ID_DEFAULT)) and not UseValueFromConnection then SetODBCCaseSensitiveCatalogNames(CaseSensitiveCatalogNames); end; procedure TStmtCatalogNameCaseProperties.ValueFromConnectionChanged; begin SetCaseSensitiveCatalogNames(CaseSensitiveCatalogNames); end; procedure TStmtCatalogNameCaseProperties.LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); begin inherited LoadData(Source, ACryptCtrlData); if Source <> nil then begin UseValueFromConnection := Source.ReadBoolean(cPrsUseCaseValueFromConnection, cDfltUseConnectionValue); CaseSensitiveCatalogNames := Source.ReadBoolean(cPrsCaseSensitiveCatalogNames, cDfltCaseSensitiveCatalogNames); end; end; procedure TStmtCatalogNameCaseProperties.StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); begin inherited StoreData(ADest, ACryptCtrlData); if ADest <> nil then begin GMStoreBoolean(ADest, cPrsUseCaseValueFromConnection, UseValueFromConnection, cDfltUseConnectionValue); GMStoreBoolean(ADest, cPrsCaseSensitiveCatalogNames, CaseSensitiveCatalogNames, cDfltCaseSensitiveCatalogNames); end; end; { ------------------------------------ } { ---- TGMOdbcStatementProperties ---- } { ------------------------------------ } constructor TGMOdbcStatementProperties.Create(const AAssignSQL: Boolean; const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FAssignSQL := AAssignSQL; FTimeoutProperties := TStmtTimeoutProperties.Create; FAsyncOperationProperties := TStmtAsyncOperationProperties.Create; FCatalogNameCaseProperties := TStmtCatalogNameCaseProperties.Create; SetDefaultValues; end; constructor TGMOdbcStatementProperties.Create(const ASource: TObject; const AAssignSQL: Boolean; const ARefLifeTime: Boolean); begin Create(AAssignSQL, ARefLifeTime); if ASource <> nil then AssignFromObj(ASource); end; constructor TGMOdbcStatementProperties.Create(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData; const AAssignSQL: Boolean; const ARefLifeTime: Boolean); begin Create(AAssignSQL, ARefLifeTime); if ASource <> nil then LoadData(ASource, ACryptCtrlData); end; destructor TGMOdbcStatementProperties.Destroy; begin GMFreeAndNil(FTimeoutProperties); GMFreeAndNil(FAsyncOperationProperties); GMFreeAndNil(FCatalogNameCaseProperties); inherited Destroy; end; procedure TGMOdbcStatementProperties.SetDefaultValues; begin FTimedReExecutionDelay := cDfltReExecutionDelay; FReExecuteAfterSQLChange := cDfltReExecuteAfterSQLChange; FUseSQLEscapeSequences := cDfltUseSQLEscapeSequences; end; procedure TGMOdbcStatementProperties.SetTimeoutProperties(const AValue: TStmtTimeoutProperties); begin TimeoutProperties.AssignFromObj(AValue); end; procedure TGMOdbcStatementProperties.SetAsyncOperationProperties(const AValue: TStmtAsyncOperationProperties); begin AsyncOperationProperties.AssignFromObj(AValue); end; procedure TGMOdbcStatementProperties.SetCatalogNameCaseProperties(const AValue: TStmtCatalogNameCaseProperties); begin CatalogNameCaseProperties.AssignFromObj(AValue); end; procedure TGMOdbcStatementProperties.AssignFromIntf(const ASource: IUnknown); begin AssignFromObj(GMObjFromIntf(ASource)); end; procedure TGMOdbcStatementProperties.AssignToIntf(const ADest: IUnknown); begin AssignToObj(GMObjFromIntf(ADest)); end; procedure TGMOdbcStatementProperties.AssignFromObj(const ASource: TObject); begin if ASource is TGMOdbcStatementProperties then begin if AssignSQL then SQL := TGMOdbcStatementProperties(ASource).SQL; ReExecuteAfterSQLChange := TGMOdbcStatementProperties(ASource).ReExecuteAfterSQLChange; UseSQLEscapeSequences := TGMOdbcStatementProperties(ASource).UseSQLEscapeSequences; TimedReExecutionDelay := TGMOdbcStatementProperties(ASource).TimedReExecutionDelay; TimeoutProperties := TGMOdbcStatementProperties(ASource).TimeoutProperties; AsyncOperationProperties := TGMOdbcStatementProperties(ASource).AsyncOperationProperties; CatalogNameCaseProperties := TGMOdbcStatementProperties(ASource).CatalogNameCaseProperties; end else if ASource is TGMOdbcStatementBase then begin if AssignSQL then SQL := TGMOdbcStatementBase(ASource).SQL.SQLText; ReExecuteAfterSQLChange := TGMOdbcStatementBase(ASource).SQL.ReExecuteAfterSQLChange; UseSQLEscapeSequences := TGMOdbcStatementBase(ASource).UseSQLEscapeSequences; TimedReExecutionDelay := TGMOdbcStatementBase(ASource).TimedReExecutionDelay; TimeoutProperties := TGMOdbcStatementBase(ASource).TimeoutProperties; AsyncOperationProperties := TGMOdbcStatementBase(ASource).AsynchronOperationProperties; CatalogNameCaseProperties := TGMOdbcStatementBase(ASource).CatalogNameCaseProperties; end; end; procedure TGMOdbcStatementProperties.AssignToObj(const ADest: TObject); begin if ADest is TGMOdbcStatementBase then begin if AssignSQL then TGMOdbcStatementBase(ADest).SQL.SQLText := SQL; TGMOdbcStatementBase(ADest).SQL.ReExecuteAfterSQLChange := ReExecuteAfterSQLChange; TGMOdbcStatementBase(ADest).UseSQLEscapeSequences := UseSQLEscapeSequences; TGMOdbcStatementBase(ADest).TimedReExecutionDelay := TimedReExecutionDelay; TGMOdbcStatementBase(ADest).TimeoutProperties := TimeoutProperties; TGMOdbcStatementBase(ADest).AsynchronOperationProperties := AsyncOperationProperties; TGMOdbcStatementBase(ADest).CatalogNameCaseProperties := CatalogNameCaseProperties; end end; procedure TGMOdbcStatementProperties.LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); begin if ASource <> nil then begin if AssignSQL then SQL := GMReplaceChars(ASource.ReadString(cStrSQL), cSqlReplacements, cSqlReplaceChars); ReExecuteAfterSQLChange := ASource.ReadBoolean(cPrsReExecuteAfterSQLChange, cDfltReExecuteAfterSQLChange); UseSQLEscapeSequences := ASource.ReadBoolean(cPrsUseSQLEscapeSequences, cDfltUseSQLEscapeSequences); TimedReExecutionDelay := ASource.ReadInteger(cPrsTimedReExecutionDelay, cDfltReExecutionDelay); TimeoutProperties.LoadData(ASource, ACryptCtrlData); AsyncOperationProperties.LoadData(ASource, ACryptCtrlData); CatalogNameCaseProperties.LoadData(ASource, ACryptCtrlData); end; end; procedure TGMOdbcStatementProperties.StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); begin if ADest <> nil then begin // if AssignSQL and (SQL <> cDfltReadString) then ADest.WriteString(cStrSQL, GMReplaceChars(SQL, cSqlReplaceChars, cSqlReplacements)); if AssignSQL then GMStoreString(ADest, cStrSQL, SQL); GMStoreBoolean(ADest, cPrsReExecuteAfterSQLChange, ReExecuteAfterSQLChange, cDfltReExecuteAfterSQLChange); GMStoreBoolean(ADest, cPrsUseSQLEscapeSequences, UseSQLEscapeSequences, cDfltUseSQLEscapeSequences); GMStoreInteger(ADest, cPrsTimedReExecutionDelay, TimedReExecutionDelay, cDfltReExecutionDelay); TimeoutProperties.StoreData(ADest, ACryptCtrlData); AsyncOperationProperties.StoreData(ADest, ACryptCtrlData); CatalogNameCaseProperties.StoreData(ADest, ACryptCtrlData); end; end; { ------------------------------ } { ---- TGMOdbcStatementBase ---- } { ------------------------------ } constructor TGMOdbcStatementBase.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FTimeoutProperties := TStmtTimeoutProperties.Create(Self); FAsyncOperationProperties := TStmtAsyncOperationProperties.Create(Self); FCatalogNameCaseProperties := TStmtCatalogNameCaseProperties.Create(Self); end; destructor TGMOdbcStatementBase.Destroy; begin inherited Destroy; GMFreeAndNil(FCatalogNameCaseProperties); GMFreeAndNil(FAsyncOperationProperties); GMFreeAndNil(FTimeoutProperties); end; procedure TGMOdbcStatementBase.AssignFromObj(const Source: TObject); begin //inherited AssignFromObj(Source); if Source is TGMOdbcStatementBase then begin ConnectionIntf := TGMSqlStatementBase(Source).ConnectionIntf; // if TGMOdbcStatementBase(Source).ODBCConnection <> nil then ODBCConnection := TGMOdbcStatementBase(Source).ODBCConnection; UseSQLEscapeSequences := TGMOdbcStatementBase(Source).UseSQLEscapeSequences; TimeoutProperties := TGMOdbcStatementBase(Source).TimeoutProperties; AsynchronOperationProperties := TGMOdbcStatementBase(Source).AsynchronOperationProperties; CatalogNameCaseProperties := TGMOdbcStatementBase(Source).CatalogNameCaseProperties; end; end; function TGMOdbcStatementBase.GetHandleType: LongWord; begin Result := SQL_HANDLE_STMT; end; procedure TGMOdbcStatementBase.AllocHandle; var mousePtrWait: IUNknown; PIConnHandle: IGMGetHandle; PIConnHandleType: IGMGetHandleType; begin mousePtrWait := TGMTempCursor.Create(vDBWaitCursor); if not GetHandleAllocated then begin if ConnectionIntf = nil then raise EGMException.ObjError(GMFormat(RStrMissingPropVal, ['ODBCConnection']), Self, scAllocHandle); GMSetIntfActive(ConnectionIntf, True, {$I %CurrentRoutine%}); GMCheckQueryInterface(ConnectionIntf, IGMGetHandle, PIConnHandle, {$I %CurrentRoutine%}); GMCheckQueryInterface(ConnectionIntf, IGMGetHandleType, PIConnHandleType, {$I %CurrentRoutine%}); ODBCCheck(SQLAllocHandle(HandleType, PIConnHandle.Handle, FHandle), Self, 'SQLAllocHandle', PIConnHandleType.HandleType, PIConnHandle.Handle); SetODBCAttributes; end; inherited AllocHandle; end; procedure TGMOdbcStatementBase.ReleaseHandle; begin ReExecutionTimer.Stop; // <- do this first! if GetHandleAllocated then begin SQLFreeHandle(HandleType, Handle); FHandle := 0; end; inherited ReleaseHandle; end; procedure TGMOdbcStatementBase.APIExecuteSQL(const ASQLText: TGMString); var sqlResult: SQLRETURN; begin sqlResult := SQLExecDirect(Handle, SQLPCHAR(ASQLText), Length(ASQLText)); if sqlResult <> SQL_NO_DATA then try ODBCCheck(sqlResult, Self, {$I %CurrentRoutine%}); except on ex: TObject do begin GMSetObjText(ex, GMGetObjText(ex) + c2NewLine + 'SQL:' + cNewLine + '=====' + cNewLine + ASQLText); raise; end; end; end; procedure TGMOdbcStatementBase.SetODBCAttributes; begin if GetHandleAllocated then begin TimeoutProperties.SetODBCValue; AsynchronOperationProperties.SetODBCValue; CatalogNameCaseProperties.SetODBCValue; end; end; procedure TGMOdbcStatementBase.CancelExecution; begin if StillExecuting then ODBCCheck(SQLCancel(Handle), Self, {$I %CurrentRoutine%}); end; function TGMOdbcStatementBase.StillExecuting: Boolean; begin Result := SQLExecDirect(Handle, nil, 0) = SQL_STILL_EXECUTING; end; function TGMOdbcStatementBase.AffectedRecordCount: SQLLEN; {$IFDEF FPC}{$push}{$WARN 5060 off : Function result variable does not seem to be initialized}{$ENDIF} begin if not ODBCSucceeded(SQLRowCount(Handle, Result)) then Result := cGMUnknownCount; end; {$IFDEF FPC}{$pop}{$ENDIF} { ---- properties ---- } procedure TGMOdbcStatementBase.SetUseSQLEscapeSequences(const AValue: Boolean); begin if AValue <> UseSQLEscapeSequences then begin CheckIsInactive('UseSQLEscapeSequences ' + RStrProperty); FUseSQLEscapeSequences := AValue; end; end; procedure TGMOdbcStatementBase.SetTimeoutProperties(const AValue: TStmtTimeoutProperties); begin if not TimeoutProperties.IsEqualTo(AValue) then TimeoutProperties.AssignFromObj(AValue); end; procedure TGMOdbcStatementBase.SetAsyncProperties(const AValue: TStmtAsyncOperationProperties); begin if not AsynchronOperationProperties.IsEqualTo(AValue) then AsynchronOperationProperties.AssignFromObj(AValue); end; procedure TGMOdbcStatementBase.SetCatalogNameCaseProperties(const AValue: TStmtCatalogNameCaseProperties); begin if not CatalogNameCaseProperties.IsEqualTo(AValue) then CatalogNameCaseProperties.AssignFromObj(AValue); end; function TGMOdbcStatementBase.GetOdbcConnection: TGMOdbcConnection; begin //Result := ObjectConnectedTo.InterfaceSourceObject as TGMOdbcConnection; Result := GMObjFromIntf(ObjectConnectedTo.InterfaceSource) as TGMOdbcConnection; end; procedure TGMOdbcStatementBase.SetODBCConnection(const AValue: TGMOdbcConnection); begin //ObjectConnectedTo.InterfaceSourceObject := AValue; // <- will be checked vai OnBeforeIntfSourceChange ObjectConnectedTo.InterfaceSource := GMObjAsIntf(AValue); {if AValue <> ODBCConnection then begin CheckIsInactive('ODBCConnection ' + RStrProperty); ObjectConnectedTo.InterfaceSourceObject := AValue; end;} end; { ------------------------- } { ---- TOdbcFieldState ---- } { ------------------------- } function TOdbcFieldState.ValueBufferCreateClass: TGMValueBufferClass; begin Result := TODBCFieldStateValueBuffer; end; { ------------------------------- } { ---- TGMOdbcRecordsetState ---- } { ------------------------------- } function TGMOdbcRecordsetState.FieldStateCreateClass: TGMFieldStateCreateClass; begin Result := TOdbcFieldState; end; { ------------------------------------ } { ---- TGMOdbcRecordsetProperties ---- } { ------------------------------------ } procedure TGMOdbcRecordsetProperties.SetDefaultValues; begin inherited SetDefaultValues; FAttributes := cDfltRSAttributes; FUpdateStrategy := cDfltUpdateStrategy; FPositionedUpdateSimulation := cDfltPositionedUpdateSimulation; FCursorSensitivity := cDfltCursorSensitivity; FCursorType := cDfltCursorType; FKeysetSize := cDfltKeysetSize; FMaxRecordsReturned := cDfltMaxRecords; FMaxFieldDataSize := cDfltMaxFieldDataSize; //FBlobCompressionType := cDfltBlobCompressionType; FRecordCountStrategies := cDfltRecordCountStrategies; //FMaxStringLengthOrigin := cDfltMaxStringLengthOrigin; //FMaxStringLengthCharSizeFactor := cDfltMaxStringLengthCharSizeFactor; end; function TGMOdbcRecordsetProperties.Obj: TGMOdbcRecordsetProperties; begin Result := Self; end; procedure TGMOdbcRecordsetProperties.AssignFromObj(const ASource: TObject); begin inherited AssignFromObj(ASource); if ASource is TGMOdbcRecordsetProperties then begin Attributes := TGMOdbcRecordsetProperties(ASource).Attributes; UpdateStrategy := TGMOdbcRecordsetProperties(ASource).UpdateStrategy; PositionedUpdateSimulation := TGMOdbcRecordsetProperties(ASource).PositionedUpdateSimulation; CursorSensitivity := TGMOdbcRecordsetProperties(ASource).CursorSensitivity; CursorType := TGMOdbcRecordsetProperties(ASource).CursorType; KeysetSize := TGMOdbcRecordsetProperties(ASource).KeysetSize; MaxRecordsReturned := TGMOdbcRecordsetProperties(ASource).MaxRecordsReturned; MaxFieldDataSize := TGMOdbcRecordsetProperties(ASource).MaxFieldDataSize; // BlobCompressionType := TGMOdbcRecordsetProperties(ASource).BlobCompressionType; RecordCountStrategies := TGMOdbcRecordsetProperties(ASource).RecordCountStrategies; // MaxStringLengthOrigin := TGMOdbcRecordsetProperties(ASource).MaxStringLengthOrigin; // MaxStringLengthCharSizeFactor := TGMOdbcRecordsetProperties(ASource).MaxStringLengthCharSizeFactor; end else if ASource is TGMOdbcRecordsetBase then begin Attributes := TGMOdbcRecordsetBase(ASource).Attributes; UpdateStrategy := TGMOdbcRecordsetBase(ASource).UpdateStrategy; PositionedUpdateSimulation := TGMOdbcRecordsetBase(ASource).PositionedUpdateSimulation; CursorSensitivity := TGMOdbcRecordsetBase(ASource).CursorSensitivity; CursorType := TGMOdbcRecordsetBase(ASource).CursorType; KeysetSize := TGMOdbcRecordsetBase(ASource).KeysetSize; MaxRecordsReturned := TGMOdbcRecordsetBase(ASource).MaxRecordsReturned; MaxFieldDataSize := TGMOdbcRecordsetBase(ASource).MaxFieldDataSize; // BlobCompressionType := TGMOdbcRecordsetBase(ASource).BlobCompressionType; RecordCountStrategies := TGMOdbcRecordsetBase(ASource).RecordCountStrategies; // MaxStringLengthOrigin := TGMOdbcRecordsetBase(ASource).MaxStringLengthOrigin; // MaxStringLengthCharSizeFactor := TGMOdbcRecordsetBase(ASource).MaxStringLengthCharSizeFactor; end; end; procedure TGMOdbcRecordsetProperties.AssignToObj(const ADest: TObject); begin inherited AssignToObj(ADest); if ADest is TGMOdbcRecordsetBase then begin TGMOdbcRecordsetBase(ADest).Attributes := Attributes; TGMOdbcRecordsetBase(ADest).UpdateStrategy := UpdateStrategy; TGMOdbcRecordsetBase(ADest).PositionedUpdateSimulation := PositionedUpdateSimulation; TGMOdbcRecordsetBase(ADest).CursorSensitivity := CursorSensitivity; TGMOdbcRecordsetBase(ADest).CursorType := CursorType; TGMOdbcRecordsetBase(ADest).KeysetSize := KeysetSize; TGMOdbcRecordsetBase(ADest).MaxRecordsReturned := MaxRecordsReturned; TGMOdbcRecordsetBase(ADest).MaxFieldDataSize := MaxFieldDataSize; // TGMOdbcRecordsetBase(ADest).BlobCompressionType := BlobCompressionType; TGMOdbcRecordsetBase(ADest).RecordCountStrategies := RecordCountStrategies; // TGMOdbcRecordsetBase(ADest).MaxStringLengthOrigin := MaxStringLengthOrigin; // TGMOdbcRecordsetBase(ADest).MaxStringLengthCharSizeFactor := MaxStringLengthCharSizeFactor; end; end; procedure TGMOdbcRecordsetProperties.LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); //var PIBinaryStorage: IGMBinaryStorage; begin inherited LoadData(ASource, ACryptCtrlData); if ASource <> nil then begin UpdateStrategy := TUpdateStrategy(GMBoundedInt(ASource.ReadInteger(cPrsUpdateStrategy, Ord(cDfltUpdateStrategy)), Ord(Low(TUpdateStrategy)), Ord(High(TUpdateStrategy)))); PositionedUpdateSimulation := TPositionedUpdateSimulation(GMBoundedInt(ASource.ReadInteger(cPrsPositionedUpdateSimulation, Ord(cDfltPositionedUpdateSimulation)), Ord(Low(TPositionedUpdateSimulation)), Ord(High(TPositionedUpdateSimulation)))); CursorSensitivity := TCursorSensitivity(GMBoundedInt(ASource.ReadInteger(cPrsCursorSensitivity, Ord(cDfltCursorSensitivity)), Ord(Low(TCursorSensitivity)), Ord(High(TCursorSensitivity)))); CursorType := TGMCursorType(GMBoundedInt(ASource.ReadInteger(cPrsCursorType, Ord(cDfltCursorType)), Ord(Low(TGMCursorType)), Ord(High(TGMCursorType)))); KeysetSize := ASource.ReadInteger(cPrsKeysetSize, cDfltKeysetSize); MaxRecordsReturned := ASource.ReadInteger(cPrsMaxRecordsReturned, cDfltMaxRecords); MaxFieldDataSize := ASource.ReadInteger(cPrsMaxFieldDataSize, cDfltMaxFieldDataSize); // BlobCompressionType := TGMCompressionType(GMBoundedInt(ASource.ReadInteger(cPrsBlobCompressionType, Ord(cDfltBlobCompressionType)), Ord(Low(TGMCompressionType)), Ord(High(TGMCompressionType)))); // BlobCompressionType := ASource.ReadInteger(cPrsBlobCompressionType, cDfltBlobCompressionType); //FAttributes := cDfltRSAttributes; Attributes := RecordsetAttributesFromInt(ASource.ReadInteger(cPrsAttributes, RecordsetAttributesToInt(cDfltRSAttributes))); //PIBinaryStorage.ReadBinary(cStrAttributes, FAttributes, SizeOf(FAttributes), False); //FRecordCountStrategies := cDfltRecordCountStrategies; RecordCountStrategies := RecordCountStrategiesFromInt(ASource.ReadInteger(cPrsCountStrategies, RecordCountStrategiesToInt(cDfltRecordCountStrategies))); //PIBinaryStorage.ReadBinary(cStrCountStrategies, FRecordCountStrategies, SizeOf(FRecordCountStrategies), False); // MaxStringLengthOrigin := TGMMaxStringLengthOrigin(GMBoundedInt(ASource.ReadInteger(cPrsMaxStringLengthOrigin, Ord(cDfltMaxStringLengthOrigin)), Ord(Low(MaxStringLengthOrigin)), Ord(High(MaxStringLengthOrigin)))); // MaxStringLengthCharSizeFactor := ASource.ReadDouble(cPrsMaxStringLengthCharSizeFactor, cDfltMaxStringLengthCharSizeFactor); end; end; procedure TGMOdbcRecordsetProperties.StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); //var PIBinaryStorage: IGMBinaryStorage; begin inherited StoreData(ADest, ACryptCtrlData); if ADest <> nil then begin GMStoreInteger(ADest, cPrsUpdateStrategy, Ord(UpdateStrategy), Ord(cDfltUpdateStrategy)); GMStoreInteger(ADest, cPrsPositionedUpdateSimulation, Ord(PositionedUpdateSimulation), Ord(cDfltPositionedUpdateSimulation)); GMStoreInteger(ADest, cPrsCursorSensitivity, Ord(CursorSensitivity), Ord(cDfltCursorSensitivity)); GMStoreInteger(ADest, cPrsCursorType, Ord(CursorType), Ord(cDfltCursorType)); GMStoreInteger(ADest, cPrsKeysetSize, KeysetSize, cDfltKeysetSize); GMStoreInteger(ADest, cPrsMaxRecordsReturned, MaxRecordsReturned, cDfltMaxRecords); GMStoreInteger(ADest, cPrsMaxFieldDataSize, MaxFieldDataSize, cDfltMaxFieldDataSize); // GMStoreInteger(ADest, cPrsBlobCompressionType, Ord(BlobCompressionType), Ord(cDfltBlobCompressionType)); //GMCheckQueryInterface(ADest, IGMBinaryStorage, PIBinaryStorage, {$I %CurrentRoutine%}); GMStoreInteger(ADest, cPrsAttributes, RecordsetAttributesToInt(Attributes), RecordsetAttributesToInt(cDfltRSAttributes)); //if Attributes <> cDfltRSAttributes then PIBinaryStorage.WriteBinary(cStrAttributes, FAttributes, SizeOf(FAttributes)); GMStoreInteger(ADest, cPrsCountStrategies, RecordCountStrategiesToInt(RecordCountStrategies), RecordCountStrategiesToInt(cDfltRecordCountStrategies)); //if RecordCountStrategies <> cDfltRecordCountStrategies then PIBinaryStorage.WriteBinary(cStrCountStrategies, FRecordCountStrategies, SizeOf(FRecordCountStrategies)); // GMStoreInteger(ADest, cPrsMaxStringLengthOrigin, Ord(MaxStringLengthOrigin), Ord(cDfltMaxStringLengthOrigin)); // GMStoreDouble(ADest, cPrsMaxStringLengthCharSizeFactor, MaxStringLengthCharSizeFactor, cDfltMaxStringLengthCharSizeFactor); end; end; { ------------------------------ } { ---- TGMOdbcRecordsetBase ---- } { ------------------------------ } constructor TGMOdbcRecordsetBase.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FFieldPosList := TGMObjArrayCollection.Create(True, False, True, GMCompareByPosition); FFieldNameList := TGMObjArrayCollection.Create(False, True, True, GMCompareByName); FCascadedContentsProperties := TGMCascadedContentsProperties.Create(Self); FUpdateStrategy := cDfltUpdateStrategy; FPositionedUpdateSimulation := cDfltPositionedUpdateSimulation; FCursorSensitivity := cDfltCursorSensitivity; FCursorType := cDfltCursorType; FKeysetSize := cDfltKeysetSize; FMaxRecordsReturned := cDfltMaxRecords; FMaxFieldDataSize := cDfltMaxFieldDataSize; FUseSQLEscapeSequences := cDfltUseSQLEscapeSequences; FAttributes := cDfltRSAttributes; //FBlobCompressionType := cDfltBlobCompressionType; FRecordCountStrategies := cDfltRecordCountStrategies; //FMaxStringLengthOrigin := cDfltMaxStringLengthOrigin; //FMaxStringLengthCharSizeFactor := cDfltMaxStringLengthCharSizeFactor; ResetMembers; CreateConnectionPoint(IGMOperationNotifications); CreateConnectionPoint(IGMPositionChangeNotifications); CreateConnectionPoint(IGMNamedValueChange); CreateConnectionPoint(IGMValidateValues); end; constructor TGMOdbcRecordsetBase.Create(const AConnection: IUnknown; const ASql: TGMString; const ACursorType: TGMCursorType; const ARefLifeTime: Boolean); begin inherited Create(AConnection, ASql, ARefLifeTime); FCursorType := ACursorType; end; destructor TGMOdbcRecordsetBase.Destroy; begin inherited Destroy; GMFreeAndNil(FFieldNameList); GMFreeAndNil(FFieldPosList); GMFreeAndNil(FCascadedContentsProperties); end; function TGMOdbcRecordsetBase.ActivationPropertyCreateClass: TGMActivationPropertyClass; begin Result := TGMActivationStoredProperties; end; procedure TGMOdbcRecordsetBase.AssignFromObj(const Source: TObject); begin inherited AssignFromObj(Source); if Source is TGMOdbcRecordsetBase then begin Attributes := TGMOdbcRecordsetBase(Source).Attributes; UpdateStrategy := TGMOdbcRecordsetBase(Source).UpdateStrategy; PositionedUpdateSimulation := TGMOdbcRecordsetBase(Source).PositionedUpdateSimulation; CursorSensitivity := TGMOdbcRecordsetBase(Source).CursorSensitivity; CursorType := TGMOdbcRecordsetBase(Source).CursorType; KeysetSize := TGMOdbcRecordsetBase(Source).KeysetSize; MaxRecordsReturned := TGMOdbcRecordsetBase(Source).MaxRecordsReturned; MaxFieldDataSize := TGMOdbcRecordsetBase(Source).MaxFieldDataSize; // BlobCompressionType := TGMOdbcRecordsetBase(Source).BlobCompressionType; RecordCountStrategies := TGMOdbcRecordsetBase(Source).RecordCountStrategies; CascadedContentsProperties := TGMOdbcRecordsetBase(Source).CascadedContentsProperties; end; end; procedure TGMOdbcRecordsetBase.SetODBCAttributes; begin if GetHandleAllocated then begin inherited SetODBCAttributes; //if Ord(UpdateStrategy) <> (SQL_CONCUR_DEFAULT - 1) then SetODBCUpdateStrategy(UpdateStrategy); //if (raUseScrollableCursor in Attributes) <> Boolean(SQL_SCROLLABLE_DEFAULT) then SetODBCCursorScrollable(raUseScrollableCursor in Attributes); //if Ord(CursorSensitivity) <> SQL_UNSPECIFIED then SetODBCCursorSensitivity(CursorSensitivity); if Ord(CursorType) <> SQL_CURSOR_TYPE_DEFAULT then SetODBCCursorType(CursorType); if KeysetSize <> SQL_DEFAULT_KEYSET_SIZE then SetODBCKeysetSize(KeysetSize); if MaxRecordsReturned <> SQL_DEFAULT_MAX_RECORDS then SetODBCMaxRecordsReturned(MaxRecordsReturned); if MaxFieldDataSize <> SQL_DEFAULT_MAX_DATA_SIZE then SetODBCMaxFieldDataSize(MaxFieldDataSize); if UseSQLEscapeSequences <> not Boolean(SQL_NOSCAN_DEFAULT) then SetODBCUseSQLEscapeSequences(UseSQLEscapeSequences); if (raBookmarksEnabled in Attributes) <> Boolean(SQL_UB_DEFAULT) then SetODBCBookmarksEnabled(raBookmarksEnabled in Attributes); //if Ord(PositionedUpdateSimulation) <> SQL_SC_DEFAULT then SetODBCPositionedUpdateSimulation(PositionedUpdateSimulation); SetODBCRowArraySize(cRowArraySize); SetODBCRowStatusPtr(@FRowStatusArray); end; end; procedure TGMOdbcRecordsetBase.SetSimplestConfiguration; begin Attributes := cSimplestRecordsetAttributes; CursorType := ctUnidirectional; UpdateStrategy := usReadOnly; // <- MS Access unidirectional only allowed readonly // Readonly speeds up reading records for some drivers because they use an internal chache for readonly cursors //CursorSensitivity := csUnspecified; end; procedure TGMOdbcRecordsetBase.AllocHandle; begin inherited AllocHandle; if InternalExecuted then begin CreateFields; FState := rsBrowsing; end; end; procedure TGMOdbcRecordsetBase.ResetMembers; var i: Integer; begin inherited ResetMembers; FRecordCount := cGMUnknownCount; FPosition := 0; FFetchResult.ResultCode := SQL_SUCCESS; FFetchResult.ErrorText := ''; for i:=Low(RowStatusArray) to High(RowStatusArray) do FRowStatusArray[i] := SQL_ROW_SUCCESS; end; procedure TGMOdbcRecordsetBase.ReleaseHandle; //var mousePtrWait: IUnknown; begin ReExecutionTimer.Stop; ClearFieldLists; if InternalExecuted then begin // mousePtrWait := TGMTempCursor.Create(vDBWaitCursor); //ODBCCheck(SQLCloseCursor(Handle), Self, {$I %CurrentRoutine%}); <-- no Exception here, may be called from destructor SQLCloseCursor(Handle); FInternalExecuted := False; end; inherited ReleaseHandle; end; { ---- Fields ---- } function TGMOdbcRecordsetBase.GetODBCFieldCount: SQLSMALLINT; {$IFDEF FPC}{$push}{$WARN 5060 off : Function result variable does not seem to be initialized}{$ENDIF} begin CheckIsActive('ODBCFieldCount ' + RStrProperty); ODBCCheck(SQLNumResultCols(Handle, Result), Self, 'SQLNumResultCols'); end; {$IFDEF FPC}{$pop}{$ENDIF} procedure TGMOdbcRecordsetBase.ClearFieldLists; begin FieldNameList.Clear; FieldPosList.Clear; end; procedure TGMOdbcRecordsetBase.CreateFields; var i: Integer; fieldCreateData: RGMFieldCreateData; bookMarkField: TObject; function AssignFieldCreateData(const AColumnPos: Integer): RGMFieldCreateData; var nameLen, odbcDataType, decDigits, nullable: SQLSMALLINT; sizeInChars: SQLULEN; begin Result := Default(RGMFieldCreateData); Result.Position := AColumnPos; SetLength(Result.Name, 2048); nullable := SQL_NULLABLE_UNKNOWN; OdbcCheck(SQLDescribeCol(Handle, AColumnPos, PGMChar(Result.Name), Length(Result.Name)+1, nameLen, odbcDataType, sizeInChars, decDigits, nullable), Self, 'SQLDescribeCol'); if nameLen < Length(Result.Name) then Setlength(Result.Name, nameLen); if (Length(Result.Name) <= 0) then begin if AColumnPos = cOdbcBookmarkColPos then Result.Name := 'Bookmark' else Result.Name := 'UnnamedCol' + GMIntToStr(AColumnPos); end; Result.IsSigned := ODBCIsSignedField(Handle, AColumnPos, Self, {$I %CurrentRoutine%}); if AColumnPos = cOdbcBookmarkColPos then odbcDataType := SQL_C_VARBOOKMARK; Result.DataType := FieldTypeFromODBCType(odbcDataType, Result.IsSigned, Self, {$I %CurrentRoutine%}); case nullable of SQL_NO_NULLS: Result.AllowNullValues := nvNullValuesNotAllowed; SQL_NULLABLE: Result.AllowNullValues := nvNullValuesAllowed; SQL_NULLABLE_UNKNOWN: Result.AllowNullValues := nvNullableUnknown; else Result.AllowNullValues := nvNullableUnknown; //else raise EGMException.ObjError(MsgUnknownPropVal('NullValuesAllowed', nullable), Self, {$I %CurrentRoutine%}); end; if IsIntegerFieldDataType(Result.DataType) then Result.IsAutoincrementing := ODBCFieldIsAutoIncrementing(Handle, AColumnPos, Self, {$I %CurrentRoutine%}) else Result.IsAutoincrementing := False; if IsIntegerFieldDataType(Result.DataType) and Result.IsAutoIncrementing then Result.Updatable := False else Result.Updatable := ODBCFieldUpdatable(Handle, AColumnPos, Self, {$I %CurrentRoutine%}); // Result.BlobCompressionType := Ord(ABlobCompressionType); Result.SizeInBytes := 0; Result.MaxStrLength := 0; case Result.DataType of fdtAnsiString, fdtUnicodeString: begin // Result.SizeInBytes := sizeInChars * GMCharSizeInBytes(Result.DataType); if not ODBCSucceeded(SQLColAttribute(Handle, AColumnPos, SQL_DESC_OCTET_LENGTH, nil, 0, nil, @Result.SizeInBytes)) then Result.SizeInBytes := 0; Result.MaxStrLength := sizeInChars; // Round(sizeInChars * MaxStringLengthCharSizeFactor); end; fdtBinary: if AColumnPos = cOdbcBookmarkColPos then Result.SizeInBytes := sizeInChars; end; // case GMCharSizeInBytes(Result.DataType) of // 0: begin Result.SizeInBytes := 0; Result.MaxStrLength := 0; end; // else // begin //// Result.SizeInBytes := sizeInChars * GMCharSizeInBytes(Result.DataType); // if not ODBCSucceeded(SQLColAttribute(Handle, AColumnPos, SQL_DESC_OCTET_LENGTH, nil, 0, nil, @Result.SizeInBytes)) then Result.SizeInBytes := 0; // Result.MaxStrLength := sizeInChars; // Round(sizeInChars * MaxStringLengthCharSizeFactor); // end; // end end; begin if Active then begin ClearFieldLists; if raBookmarksEnabled in Attributes then begin bookMarkField := FieldPosList.Add(vODBCFieldCreateClasses[FieldTypeFromODBCType(SQL_C_VARBOOKMARK, False, Self, {$I %CurrentRoutine%})].Create(Self, AssignFieldCreateData(cOdbcBookmarkColPos))); // , ctNone if raExposeBookmarkColumn in Attributes then FieldNameList.Add(bookMarkField); end; for i:=1 to ODBCFieldCount do try fieldCreateData := AssignFieldCreateData(i); // , BlobCompressionType if Assigned(OnCreateField) then OnCreateField(fieldCreateData.Name, fieldCreateData); FieldNameList.Add(FieldPosList.Add(vODBCFieldCreateClasses[fieldCreateData.DataType].Create(Self, fieldCreateData))); except end; end; end; function TGMOdbcRecordsetBase.GetIntfByName(const AFieldName: TGMString; const AIID: TGUID; out AIntf): HResult; stdcall; var searchName: IGMGetName; foundField: TObject; begin searchName := TGMNameObj.Create(AFieldName, True); if FieldNameList.Find(searchName, foundField) then Result := CQIResult[foundField.GetInterface(AIID, AIntf)] else Result := GMHResultFromWin32(ERROR_FILE_NOT_FOUND); // ERROR_INVALID_NAME end; function TGMOdbcRecordsetBase.GetIntfByPosition(const AFieldPosition: PtrInt; const AIID: TGUID; out AIntf): HResult; stdcall; var searchPosition: IGMGetPosition; foundField: TObject; begin searchPosition := TGMPositionObj.Create(AFieldPosition, True); if FieldPosList.Find(searchPosition, foundField) then Result := CQIResult[foundField.GetInterface(AIID, AIntf)] else Result := GMHResultFromWin32(ERROR_INVALID_INDEX); end; function TGMOdbcRecordsetBase.GetFieldByIndex(const AIndex: RGMUnionValue): TGMOdbcField; const cBookmarkColOffs: array [Boolean] of PtrInt = (-1 , 0); var fieldPos: PtrInt; fieldName: TGMString; foundField: TObject; begin case AIndex.ValueType of uvtInt16, uvtInt32, uvtInt64, uvtDouble: begin fieldPos := AIndex + cBookmarkColOffs[raBookmarksEnabled in Attributes]; Result := FieldPosList[fieldPos] as TGMOdbcField; end; uvtString: begin fieldName := AIndex; if FSearchName = nil then FSearchName := TGMNameObj.Create('', True); // <- Avoid repeated memory allocation FSearchName.Name := fieldName; if FieldNameList.Find(FSearchName, foundField) then Result := foundField as TGMOdbcField else raise EGMException.ObjError(GMFormat(RStrFieldNotFound, [fieldName, GMGetObjName(Self)]), Self, {$I %CurrentRoutine%}) end; else raise EGMException.ObjError(GMFormat(RStrUnsupportedIdxType, [AIndex.ValueTypeName]), Self, {$I %CurrentRoutine%}); end; end; function TGMOdbcRecordsetBase.GetFieldValue(const AIndex: RGMUnionValue): RGMUnionValue; var field: TGMOdbcField; begin //Result := GMGetFieldValueImpl(Self, AIndex); CheckIsActive({$I %CurrentRoutine%}); field := GetFieldByIndex(AIndex); Result := field.Value; end; procedure TGMOdbcRecordsetBase.SetFieldValue(const AIndex: RGMUnionValue; const AValue: RGMUnionValue); var field: TGMOdbcField; begin //GMSetFieldValueImpl(Self, AIndex, AValue); CheckIsActive({$I %CurrentRoutine%}); field := GetFieldByIndex(AIndex); field.Value := AValue; end; { ---- Lookup / locate ---- } function TGMOdbcRecordsetBase.LookupValues(const SQLCriteria: TGMString; const Values: IUnknown): Boolean; stdcall; begin Result := GMLookupValues(Self, Values, SQLCriteria, False); end; function TGMOdbcRecordsetBase.PositionOfNearestValues(const Values: IGMGetIntfByPosition): LongInt; stdcall; var PICount: IGMGetCount; function Compare(const RecPos: Integer): TGMCompareResult; var i: Integer; PIValue: IGMGetUnionValue; PIName: IGMGetName; begin Result := crALessThanB; Position := RecPos; for i:=0 to PICount.Count-1 do begin GMCheckGetIntfByPosition(Values, i, IGMGetUnionValue, PIValue, RStrValue, {$I %CurrentRoutine%}); GMCheckGetIntfByPosition(Values, i, IGMGetName, PIName, RStrValue, {$I %CurrentRoutine%}); Result := GMCompareUnionValues(PIValue.Value, FieldValue[PIName.Name], GMCheckAskBoolean(PIValue, Ord(bvMatchCase), {$I %CurrentRoutine%})); if Result <> crAEqualToB then Break; end; end; function FindInRange(const L, R: Integer): Integer; var M: Integer; CmpRes: TGMCompareResult; begin if L >= R then Result := L else begin M := (L + R) shr 1; CmpRes := Compare(M); case CmpRes of crAEqualToB: Result := M; crALessThanB: Result := FindInRange(L, M); crAGreaterThanB: if L = M then Result := R else Result := FindInRange(M, R); else raise EGMException.ObjError(MsgUnknownValue(cStrTCompareResult, Ord(CmpRes)), Self, {$I %CurrentRoutine%}); end; end; end; begin GMCheckQueryInterface(Values, IGMGetCount, PICount, {$I %CurrentRoutine%}); Result := FindInRange(1, Count); end; procedure TGMOdbcRecordsetBase.CheckLocateValues(const Values: IGMGetIntfByPosition); var SortClause, SortPart: TGMString; i, Pos1, Pos2: PtrInt; PICount: IGMGetCount; PIName: IGMGetName; begin GMCheckQueryInterface(Values, IGMGetCount, PICount, {$I %CurrentRoutine%}); if PICount.Count = 0 then raise EGMException.ObjError(srNoValuesToLocate, Self, {$I %CurrentRoutine%}); SortClause := SQL.SQLOrderBy; Pos1 := 1; for i:=0 to PICount.Count-1 do begin GMCheckGetIntfByPosition(Values, i, IGMGetName, PIName, RStrValue, {$I %CurrentRoutine%}); SortPart := GMExtractNextFieldName(Pos1, SortClause); Pos2 := 1; if not GMFindToken(SortPart, PIName.Name, Pos2, cSqlSeparators, True, True) then raise EGMException.ObjError(GMFormat(srNoSortClauseForField, [PIName.Name]), Self, {$I %CurrentRoutine%}); end; end; function TGMOdbcRecordsetBase.LocateResult(const Values: IGMGetIntfByPosition; const FindPos: LongInt): Boolean; var i: Integer; PICount: IGMGetCount; PIValue: IGMGetUnionValue; PIName: IGMGetName; begin GMCheckQueryInterface(Values, IGMGetCount, PICount, {$I %CurrentRoutine%}); Position := FindPos; Result := True; for i:=0 to PICount.Count-1 do begin GMCheckGetIntfByPosition(Values, i, IGMGetUnionValue, PIValue, RStrValue, {$I %CurrentRoutine%}); GMCheckGetIntfByPosition(Values, i, IGMGetName, PIName, RStrValue, {$I %CurrentRoutine%}); if (GMCheckAskInteger(PIValue, Ord(ivMatchKind), {$I %CurrentRoutine%}) = Ord(GMIntf.mkExactMatch)) and (GMCompareUnionValues(PIValue.Value, FieldValue[PIName.Name], GMCheckAskBoolean(PIValue, Ord(bvMatchCase), {$I %CurrentRoutine%})) <> crAEqualToB) then begin Result := False; Break; end; end; end; function TGMOdbcRecordsetBase.PositionOfValues(const Values: IUnknown; var FindPos: LongInt): Boolean; stdcall; var SaveState: IUnknown; PIIntfByPos: IGMGetIntfByPosition; begin GMCheckQueryInterface(Values, IGMGetIntfByPosition, PIIntfByPos, {$I %CurrentRoutine%}); CheckLocateValues(PIIntfByPos); DisableNotifications; try SaveState := CaptureState; try LeaveModifyingState; FindPos := PositionOfNearestValues(PIIntfByPos); Result := LocateResult(PIIntfByPos, FindPos); if not Result then FindPos := CGMUnknownPosition; finally RestoreState(SaveState); end; finally EnableNotifications; end; end; function TGMOdbcRecordsetBase.LocateValues(const Values: IUnknown): Boolean; stdcall; //const CRefreshKind: array [Boolean] of LongInt = (Ord(rgNone), Ord(rgRefreshPosition)); var SaveState: IUnknown; FindPos: LongInt; PIIntfByPos: IGMGetIntfByPosition; begin Result := False; GMCheckQueryInterface(Values, IGMGetIntfByPosition, PIIntfByPos, {$I %CurrentRoutine%}); CheckLocateValues(PIIntfByPos); DisableNotifications(Ord(rgRefreshPosition)); try SaveState := CaptureState; try LeaveModifyingState; FindPos := PositionOfNearestValues(PIIntfByPos); Result := LocateResult(PIIntfByPos, FindPos); if Result then Position := FindPos; finally if not Result then RestoreState(SaveState); end; finally EnableNotifications(Ord(rgRefreshPosition){CRefreshKind[Result]}); end; end; { ---- IGMEnumerateItems ---- } procedure TGMOdbcRecordsetBase.EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer); const CSlTables = slTables; var i: Integer; PIEnumSink: IGMTellEnumString; PIActivator, PIQuiet: IUnknown; schemaCursor: IGMUnidirectionalCursor; PIAssignFromObj: IGMAssignFromObj; schemaProps: IGMSchemaProperties; begin inherited EnumerateItems(ItemKind, TellEnumSink, Parameter); if not GMQueryInterface(TellEnumSink, IGMTellEnumString, PIEnumSink) then Exit; case ItemKind of Ord(eidFieldNames): begin PIQuiet := TGMNotificationDisabler.Create(Self); PIActivator := TGMActiveKeeper.Create(Self, True); for i:=0 to FieldPosList.Count-1 do if (FieldPosList[i] is TGMDBField) and ((TGMDBField(FieldPosList[i]).Position <> cOdbcBookmarkColPos) or (raExposeBookmarkColumn in Attributes)) then try PIEnumSink.TellEnumString(ItemKind, TGMDBField(FieldPosList[i]).Name, Pointer(Parameter)); except end; end; Ord(eidTableNames): begin schemaCursor := TGMOdbcSchemaRecordset.Create(True); GMCheckQueryInterface(schemaCursor, IGMAssignFromObj, PIAssignFromObj); PIAssignFromObj.AssignFromObj(Self); GMCheckExecRSOperation(schemaCursor, roSetSimplestConfiguration); GMCheckQueryInterface(schemaCursor, IGMSchemaProperties, schemaProps); //GMHrCheckObj(GMGetPropIntfFromIntf(schemaCursor, cStrSchemaData, IGMSchemaProperties, schemaProps), Self); schemaProps.SchemaList := cSlTables; schemaProps.TableName := cSqlWildcardChar; GMSetIntfActive(schemaCursor, True); while not schemaCursor.EOF do begin PIEnumSink.TellEnumString(ItemKind, GMGetItemValue(schemaCursor, COdbcSchemaNameColPos[CSlTables]), Pointer(Parameter)); schemaCursor.MoveToNext; end; end; end; end; { ---- IGMFreeCursor ---- } function TGMOdbcRecordsetBase.ODBCFetchSuccess: Boolean; begin Result := OdbcSucceeded(FetchResult.ResultCode); end; function TGMOdbcRecordsetBase.IsEmpty: Boolean; begin Result := Count <= 0; end; function TGMOdbcRecordsetBase.GetBOF: Boolean; stdcall; begin Result := Position <= 1; end; function TGMOdbcRecordsetBase.GetEOF: Boolean; stdcall; begin if CursorType = ctUnidirectional then Result := not OdbcSucceeded(FetchResult.ResultCode) else Result := Position >= Count; end; procedure TGMOdbcRecordsetBase.DoCursorMove(const ADirection: SQLSMALLINT; AOffset: SQLLEN; const AMethodName: TGMString); function IsValidMove(const ADirection: SQLSMALLINT; var AOffset: SQLLEN): Boolean; begin case ADirection of SQL_FETCH_NEXT, SQL_FETCH_LAST: Result := not EOF; SQL_FETCH_PRIOR, SQL_FETCH_FIRST: Result := not BOF; SQL_FETCH_ABSOLUTE: begin Result := not IsEmpty; AOffset := GMBoundedInt(AOffset, 1, Count); end; SQL_FETCH_RELATIVE: begin Result := not IsEmpty; AOffset := GMBoundedInt(AOffset, 1 - Position, Count - Position); end; else Result := False; end; end; begin if IsValidMove(ADirection, AOffset) then DoCursorFetch(ADirection, AOffset, AMethodName); end; procedure TGMOdbcRecordsetBase.DoCursorFetch(const ADirection: SQLSMALLINT; AOffset: SQLLEN; const AMethodName: TGMString; const ANotifyPositionChange: Boolean); begin if (ADirection = SQL_FETCH_NEXT) or (CursorType <> ctUnidirectional) then begin if ANotifyPositionChange then NotifyBeforePositionChange; // if ADirection in [SQL_FETCH_ABSOLUTE, SQL_FETCH_RELATIVE] then case ADirection of SQL_FETCH_ABSOLUTE: AOffset := GMBoundedInt(AOffset, 1, Count); SQL_FETCH_RELATIVE: AOffset := GMBoundedInt(Position + AOffset, 1, Count); end; if (CursorType = ctUnidirectional) then FFetchResult.ResultCode := SQLFetch(Handle) else FFetchResult.ResultCode := SQLFetchScroll(Handle, ADirection, AOffset); if not ODBCSucceeded(FetchResult.ResultCode) then FFetchResult.ErrorText := OdbcErrorDescAsString(OdbcErrorDesc(HandleType, Handle, 1, FetchResult.ResultCode)) else begin FFetchResult.ErrorText := ''; case ADirection of SQL_FETCH_NEXT: Inc(FPosition); SQL_FETCH_LAST: FPosition := Count; SQL_FETCH_PRIOR: Dec(FPosition); SQL_FETCH_FIRST: FPosition := 1; SQL_FETCH_ABSOLUTE: FPosition := AOffset; SQL_FETCH_RELATIVE: FPosition := FPosition + AOffset; end; if ANotifyPositionChange then NotifyAfterPositionChange; end; end; end; procedure TGMOdbcRecordsetBase.MoveToNext; stdcall; begin DoCursorMove(SQL_FETCH_NEXT, 0, 'MoveToNext'); end; procedure TGMOdbcRecordsetBase.MoveToLast; stdcall; begin DoCursorMove(SQL_FETCH_LAST, 0, 'MoveToLast'); end; procedure TGMOdbcRecordsetBase.MoveToPrevious; stdcall; begin DoCursorMove(SQL_FETCH_PRIOR, 0, 'MoveToPrevious'); end; procedure TGMOdbcRecordsetBase.MoveToFirst; stdcall; begin DoCursorMove(SQL_FETCH_FIRST, 0, 'MoveToFirst'); end; { ---- IGMGetSetPosition ---- } function TGMOdbcRecordsetBase.GetPosition: PtrInt; stdcall; begin Result := FPosition; end; procedure TGMOdbcRecordsetBase.SetPosition(const AValue: PtrInt); stdcall; begin if AValue <> Position then DoCursorMove(SQL_FETCH_ABSOLUTE, AValue, {$I %CurrentRoutine%}); end; { ---- IGMAskXxxxx ---- } function TGMOdbcRecordsetBase.AskBoolean(const AValueId: LongInt): LongInt; stdcall; begin case AValueId of //Ord(bvCursorValid): Result := GMBooleanAskResult(CursorValid); Ord(bvConfirmDeletions): Result := GMBooleanAskResult(raConfrimDeletions in Attributes); //Ord(bvIsUnidirectional): Result := GMBooleanAskResult(CursorType = ctUnidirectional); //Ord(bvIsEmpty): Result := GMBooleanAskResult(IsEmpty); Ord(bvCanModify): Result := GMBooleanAskResult(CanModify); Ord(bvPositionalInsert): Result := GMBooleanAskResult(PositionalInsert); Ord(bvCanSetPosition): Result := GMBooleanAskResult(Active and (CursorType <> ctUnidirectional)); else Result := Ord(barUnknown); end; end; function TGMOdbcRecordsetBase.AskInteger(const AValueId: LongInt): LongInt; stdcall; begin case AValueId of //Ord(ivRowStatus): Result := RowStatusArray[Low(RowStatusArray)]; Ord(ivCursorType): Result := Ord(CursorType); Ord(ivFieldCount): Result := FieldNameList.Count; else Result := CInvalidIntValue; end; end; procedure TGMOdbcRecordsetBase.LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); stdcall; var assignToObj: IGMAssignToObj; begin assignToObj := TGMOdbcRecordsetProperties.Create(Source, ACryptCtrlData, True, True); assignToObj.AssignToObj(Self); end; procedure TGMOdbcRecordsetBase.StoreData(const Dest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); stdcall; var loadStore: IGMLoadStoreData; begin loadStore := TGMOdbcRecordsetProperties.Create(Self, True, True); loadStore.StoreData(Dest, ACryptCtrlData); end; { ---- IGMGetCount ---- } function TGMOdbcRecordsetBase.ComputeRecordCount: SQLLEN; const StartCount = 256; var cnt: SQLLEN; SaveState: IUnknown; function CountBySelectStatement: SQLLEN; var count: RGMUnionValue; // sss: TGMString; begin try //sss := GMModifyToSelectCountSQL(SQL.SQLText, Self); count := GMOdbcSelectSingleValue(ConnectionIntf, GMModifyToSelectCountSQL(SQL.SQLText, Self), 1); except count := uvtUnassigned end; if Count.IsNullOrUnassigned then Result := cGMUnknownCount else Result := Count; end; function LogarithmicCount: SQLLEN; function FindLastPosition(const al, ar: SQLLEN): SQLLEN; var m: LongInt; //SQLCode: SQLRETURN; begin if al >= ar then Result := al else begin m := (al + ar) shr 1; //SQLCode := SQLFetchScroll(Handle, SQL_FETCH_ABSOLUTE, m); //if not ODBCIsValidFetch(SQLFetchScroll(Handle, SQL_FETCH_ABSOLUTE, m)) then if not ODBCSucceeded(SQLFetchScroll(Handle, SQL_FETCH_ABSOLUTE, m)) then Result := FindLastPosition(al, m) else if al = m then Result := ar else Result := FindLastPosition(m, ar); end; end; begin FFetchResult.ErrorText := ''; DisableNotifications; try SaveState := CaptureState; try LeaveModifyingState; cnt := StartCount; GMNotifyFieldsBeforePositionChange(FieldPosList); try //while ODBCIsValidFetch(SQLFetchScroll(Handle, SQL_FETCH_ABSOLUTE, cnt)) do cnt := cnt shl 1; while ODBCSucceeded(SQLFetchScroll(Handle, SQL_FETCH_ABSOLUTE, cnt)) do cnt := cnt shl 1; Result := FindLastPosition(1, cnt) - 1; FFetchResult.ResultCode := SQLFetchScroll(Handle, SQL_FETCH_ABSOLUTE, FPosition); finally GMNotifyFieldsAfterPositionChange(FieldPosList); end; finally RestoreState(SaveState); end; finally EnableNotifications; end; end; begin Result := cGMUnknownCount; if Active then begin if csUseCountFromODBCDriver in RecordCountStrategies then Result := ODBCRecordCount; if (Result = cGMUnknownCount) and (csUseSelectCountStatement in RecordCountStrategies) then Result := CountBySelectStatement; if (Result = cGMUnknownCount) and (csCountByLogarithmicPositioning in RecordCountStrategies) and (CursorType <> ctUnidirectional) then Result := LogarithmicCount; end; end; function TGMOdbcRecordsetBase.GetCount: PtrInt; stdcall; //const cUniDirRecCounts: array [Boolean] of LongInt = (0, 1); begin // dont't Assign FRecordCount when inactive if not Active then Result := cGMUnknownCount else begin if FRecordCount = cGMUnknownCount then FRecordCount := ComputeRecordCount; // case CursorType of // ctUnidirectional: FRecordCount := cUniDirRecCounts[OdbcSucceeded(FetchResult.ResultCode)] // else FRecordCount := ComputeRecordCount; // end; Result := FRecordCount; end; end; { ---- IGMSaveRestoreState ---- } function TGMOdbcRecordsetBase.CaptureState: IUnknown; begin Result := TGMOdbcRecordsetState.Create(Self); end; procedure TGMOdbcRecordsetBase.RestoreState(const State: IUnknown); var PIInftAssign: IGMAssignToIntf; begin if GMQueryInterface(State, IGMAssignToIntf, PIInftAssign) then PIInftAssign.AssignToIntf(Self); end; { ---- Operations ---- } procedure TGMOdbcRecordsetBase.LeaveModifyingState; begin if IsUpdatableState(Ord(State)) then if not (raAutoSaveChanges in Attributes) then CancelChanges else try ApplyChanges; except CancelChanges; raise; end; end; function TGMOdbcRecordsetBase.CanModify: Boolean; begin Result := inherited CanModify and (UpdateStrategy <> usReadOnly); end; function TGMOdbcRecordsetBase.PositionalInsert: Boolean; var posIns: SQLINTEGER; begin Result := GetHandleAllocated and ODBCSucceeded(SQLGetStmtAttr(Handle, SQL_ATTR_GM_POSITIONAL_INSERT, @posIns, SQL_IS_INTEGER, nil)) and (posIns = SQL_TRUE); end; procedure TGMOdbcRecordsetBase.Edit; begin DoStateChange(roEdit); end; procedure TGMOdbcRecordsetBase.Insert(const Parameter: IUnknown = nil); begin DoStateChange(roInsert, nil, Parameter); end; procedure TGMOdbcRecordsetBase.CancelChanges; begin DoStateChange(roCancelChanges); end; procedure TGMOdbcRecordsetBase.Applychanges; var mousePtrWait: IUnknown; oldState: TGMRecordsetState; begin mousePtrWait := TGMTempCursor.Create(vDBWaitCursor); oldState := State; NotifyValidateFieldValues; DoStateChange(roApplyChanges, InternalApplyChanges); if (oldState = rsInserting) {and not PositionalInsert} then begin // Fields have been notified inside InternalApplyChanges NotifyConnectedObjectsBeforePositionChange; NotifyConnectedObjectsAfterPositionChange; end; end; procedure TGMOdbcRecordsetBase.InternalApplyChanges; var i: Integer; nothingChanged: Boolean; procedure UpdateData(ARowNumber: SQLSETPOSIROW; AOperation: SQLUSMALLINT); var sqlCode: SQLRETURN; searchPos: IGMGetPosition; i: Integer; PParamData: Pointer; field: TGMOdbcField; begin for i:=0 to FieldPosList.Count-1 do try (FieldPosList[i] as TGMOdbcField).SetupDataLengthForUpdate; except end; try sqlCode := SQLSetPos(Handle, ARowNumber, AOperation, SQL_LOCK_NO_CHANGE); try if sqlCode <> SQL_NEED_DATA then OdbcCheck(sqlCode, Self, {$I %CurrentRoutine%}) else begin repeat sqlCode := SQLParamData(Handle, PParamData); if sqlCode = SQL_NEED_DATA then begin searchPos := TGMPositionObj.Create(PLongInt(PParamData)^, True); if FieldPosList.Find(searchPos, field) then field.StoreBlobData else raise EGMException.ObjError(GMFormat(srUnknownBlobFieldPos, [searchPos.Position]), Self, {$I %CurrentRoutine%}); end; until sqlCode <> SQL_NEED_DATA; OdbcCheck(sqlCode, Self, {$I %CurrentRoutine%}); end; except if sqlCode = SQL_NEED_DATA then SQLCancel(Handle); raise; end; finally for i:=0 to FieldPosList.Count-1 do try (FieldPosList[i] as TGMOdbcField).RestoreDataLength; except end; end; end; begin nothingChanged := True; for i:=0 to FieldPosList.Count-1 do if (FieldPosList[i] as TGMDBField).Modified then begin nothingChanged := False; Break; end; case State of rsEditing: if not nothingChanged then UpdateData(1, SQL_UPDATE); rsInserting: begin if nothingChanged then raise EGMException.ObjError(srNoFieldChangedBeforeInsert, Self, {$I %CurrentRoutine%}); UpdateData(1, SQL_ADD); if FRecordCount <> cGMUnknownCount then Inc(FRecordCount); // (RecordCountStrategies <> []) and if CursorType <> ctUnidirectional then begin if PositionalInsert then DoCursorFetch(SQL_FETCH_ABSOLUTE, Position, {$I %CurrentRoutine%}, False) else DoCursorFetch(SQL_FETCH_LAST, 0, {$I %CurrentRoutine%}, False); GMNotifyFieldsBeforePositionChange(FieldPosList); GMNotifyFieldsAfterPositionChange(FieldPosList); end; end; end; end; procedure TGMOdbcRecordsetBase.RefreshRecord; var mousePtrWait: IUnknown; begin mousePtrWait := TGMTempCursor.Create(vDBWaitCursor); NotifyBeforeOperation(Ord(roRefreshCurrent)); ODBCCheck(SQLSetPos(Handle, 1, SQL_REFRESH, SQL_LOCK_NO_CHANGE), Self, {$I %CurrentRoutine%}); NotifyAfterOperation(Ord(roRefreshCurrent)); end; procedure TGMOdbcRecordsetBase.Delete; var mousePtrWait: IUnknown; begin mousePtrWait := TGMTempCursor.Create(vDBWaitCursor); NotifyBeforeOperation(Ord(roDelete)); ODBCCheck(SQLSetPos(Handle, 1, SQL_DELETE, SQL_LOCK_NO_CHANGE), Self, {$I %CurrentRoutine%}); if (FRecordCount > 0) and (FRecordCount <> cGMUnknownCount) then Dec(FRecordCount); // and (CursorType <> ctUnidirectional) and (RecordCountStrategies <> []) then FRecordCount := Max(0, FRecordCount-1); NotifyAfterOperation(Ord(roDelete)); // <- reflect new count here! DoCursorFetch(SQL_FETCH_NEXT, Position, {$I %CurrentRoutine%}); // <- SQL_FETCH_ABSOLUTE did�NOT work with ORACLE Odbc driver! //if CursorType = ctUnidirectional then DoCursorFetch(SQL_FETCH_NEXT, Position, {$I %CurrentRoutine%}) else DoCursorFetch(SQL_FETCH_ABSOLUTE, Position, {$I %CurrentRoutine%}); end; function TGMOdbcRecordsetBase.CanExecuteOperation(const AOperation: Integer; const AParameter: IUnknown = nil): Boolean; begin case AOperation of Ord(roReExecuteStatement), Ord(roScheduleReExecution): Result := inherited CanExecuteOperation(AOperation, AParameter); Ord(roDelete), Ord(roEdit): Result := {Active and} CanModify and (State = rsBrowsing) and ODBCFetchSuccess; // not IsEmpty; Ord(roRefreshCurrent): Result := {Active and} (State = rsBrowsing) and ODBCFetchSuccess; // not IsEmpty; Ord(roInsert): Result := {Active and} CanModify and (State = rsBrowsing); Ord(roSetSimplestConfiguration): Result := not Active; Ord(roCancelChanges), Ord(roApplyChanges), Ord(roLeaveModifyingState): Result := Active and IsUpdatableState(Ord(State)); else Result := False; end; end; function TGMOdbcRecordsetBase.ExecuteOperation(const AOperation: Integer; const AParameter: IUnknown = nil): Boolean; begin Result := True; case AOperation of Ord(roReExecuteStatement), Ord(roScheduleReExecution): Result := inherited ExecuteOperation(AOperation, AParameter); Ord(roEdit): Edit; Ord(roInsert): Insert(AParameter); Ord(roCancelChanges): CancelChanges; Ord(roApplyChanges): ApplyChanges; Ord(roRefreshCurrent): RefreshRecord; Ord(roDelete): Delete; Ord(roLeaveModifyingState): LeaveModifyingState; Ord(roSetSimplestConfiguration): SetSimplestConfiguration; else Result := False end; end; { ---- Set on ODBC API Level ---- } procedure TGMOdbcRecordsetBase.SetODBCRowArraySize(const AValue: PtrUInt); begin if Active then ODBCCheck(SQLSetStmtAttr(Handle, SQL_ATTR_ROW_ARRAY_SIZE, SQLPOINTER(AValue), 0), Self, {$I %CurrentRoutine%}); end; procedure TGMOdbcRecordsetBase.SetODBCRowStatusPtr(const AValue: SQLPOINTER); begin if Active then ODBCCheck(SQLSetStmtAttr(Handle, SQL_ATTR_ROW_STATUS_PTR, AValue, 0), Self, {$I %CurrentRoutine%}); end; procedure TGMOdbcRecordsetBase.SetODBCUseSQLEscapeSequences(const AValue: Boolean); var sqlEscSeq: PtrUInt; begin if Active then begin if AValue then sqlEscSeq := SQL_NOSCAN_OFF else sqlEscSeq := SQL_NOSCAN_ON; ODBCCheck(SQLSetStmtAttr(Handle, SQL_ATTR_NOSCAN, SQLPOINTER(sqlEscSeq), 0), Self, {$I %CurrentRoutine%}); end; end; procedure TGMOdbcRecordsetBase.SetODBCCursorType(const AValue: TGMCursorType); var sqlCurType: PtrUInt; begin if Active then begin case AValue of ctUnidirectional: sqlCurType := SQL_CURSOR_FORWARD_ONLY; ctStatic: sqlCurType := SQL_CURSOR_STATIC; ctKeyset: sqlCurType := SQL_CURSOR_KEYSET_DRIVEN; ctDynamic: sqlCurType := SQL_CURSOR_DYNAMIC; else raise EGMException.ObjError(MsgUnknownValue('TGMCursorType', Ord(AValue)), Self, {$I %CurrentRoutine%}); end; ODBCCheck(SQLSetStmtAttr(Handle, SQL_ATTR_CURSOR_TYPE, SQLPOINTER(sqlCurType), 0), Self, {$I %CurrentRoutine%}); end; end; procedure TGMOdbcRecordsetBase.SetODBCUpdateStrategy(const AValue: TUpdateStrategy); var sqlUpdtVal: PtrUInt; begin if Active then begin case AValue of usReadOnly: sqlUpdtVal := SQL_CONCUR_READ_ONLY; usMinimalLock: sqlUpdtVal := SQL_CONCUR_LOCK; usCompareRecordVersionBeforeWrite: sqlUpdtVal := SQL_CONCUR_ROWVER; usCompareValuesBeforeWrite: sqlUpdtVal := SQL_CONCUR_VALUES; usUseDriverDefault: sqlUpdtVal := 0; // <- Not used else raise EGMException.ObjError(MsgUnknownValue('TUpdateStrategy', Ord(AValue)), Self, {$I %CurrentRoutine%}); end; if AValue <> usUseDriverDefault then ODBCCheck(SQLSetStmtAttr(Handle, SQL_ATTR_CONCURRENCY, SQLPOINTER(sqlUpdtVal), 0), Self, {$I %CurrentRoutine%}); end; end; procedure TGMOdbcRecordsetBase.SetODBCCursorScrollable(const AValue: Boolean); var sqlScrollVal: PtrUInt; begin if Active then begin if AValue then sqlScrollVal := SQL_SCROLLABLE else sqlScrollVal := SQL_NONSCROLLABLE; ODBCCheck(SQLSetStmtAttr(Handle, SQL_ATTR_CURSOR_SCROLLABLE, SQLPOINTER(sqlScrollVal), 0), Self, {$I %CurrentRoutine%}); end; end; procedure TGMOdbcRecordsetBase.SetODBCCursorSensitivity(const AValue: TCursorSensitivity); var Sensitivity: PtrUInt; begin if Active then begin case AValue of csUnspecified: Sensitivity := SQL_UNSPECIFIED; csInsensitive: Sensitivity := SQL_INSENSITIVE; csReflectChanges: Sensitivity := SQL_SENSITIVE; csUseDriverDefault: Sensitivity := 0; // <- Not used else raise EGMException.ObjError(MsgUnknownValue('TCursorSensitivity', Ord(AValue)), Self, {$I %CurrentRoutine%}); end; if AValue <> csUseDriverDefault then ODBCCheck(SQLSetStmtAttr(Handle, SQL_ATTR_CURSOR_SENSITIVITY, SQLPOINTER(Sensitivity), 0), Self, {$I %CurrentRoutine%}); end; end; procedure TGMOdbcRecordsetBase.SetODBCPositionedUpdateSimulation(const AValue: TPositionedUpdateSimulation); var updateSimulation: PtrUInt; begin if Active then begin case AValue of pusAllowNonUniqueUpdate: updateSimulation := SQL_SC_NON_UNIQUE; pusTryUniqueUpdate: updateSimulation := SQL_SC_TRY_UNIQUE; pusGuaranteeUniqueUpdate: updateSimulation := SQL_SC_UNIQUE; pusUseDriverDefault: updateSimulation := 0; // <- Not used else raise EGMException.ObjError(MsgUnknownValue('TPositionedUpdateSimulation', Ord(AValue)), Self, {$I %CurrentRoutine%}); end; if AValue <> pusUseDriverDefault then ODBCCheck(SQLSetStmtAttr(Handle, SQL_ATTR_SIMULATE_CURSOR, SQLPOINTER(updateSimulation), 0), Self, {$I %CurrentRoutine%}); end; end; procedure TGMOdbcRecordsetBase.SetODBCMaxRecordsReturned(const AValue: SQLULEN); begin if Active then ODBCCheck(SQLSetStmtAttr(Handle, SQL_ATTR_MAX_ROWS, SQLPOINTER(AValue), 0), Self, {$I %CurrentRoutine%}); end; procedure TGMOdbcRecordsetBase.SetODBCKeysetSize(const AValue: SQLULEN); begin if Active then ODBCCheck(SQLSetStmtAttr(Handle, SQL_ATTR_KEYSET_SIZE, SQLPOINTER(AValue), 0), Self, {$I %CurrentRoutine%}); end; procedure TGMOdbcRecordsetBase.SetODBCMaxFieldDataSize(const AValue: SQLULEN); begin if Active then ODBCCheck(SQLSetStmtAttr(Handle, SQL_ATTR_MAX_LENGTH, SQLPOINTER(AValue), 0), Self, {$I %CurrentRoutine%}); end; procedure TGMOdbcRecordsetBase.SetODBCBookmarksEnabled(const AValue: Boolean); var useBookmarks: SQLULEN; begin if Active then begin if AValue then useBookmarks := SQL_UB_VARIABLE else useBookmarks := SQL_UB_OFF; ODBCCheck(SQLSetStmtAttr(Handle, SQL_ATTR_USE_BOOKMARKS, SQLPOINTER(useBookmarks), 0), Self, {$I %CurrentRoutine%}); end; end; function TGMOdbcRecordsetBase.GetODBCRowNumber: SQLLEN; begin if not Active then Result := CGMUnknownPosition else //if not ODBCSucceeded(SQLGetStmtAttr(Handle, SQL_ATTR_ROW_NUMBER, @Result, SQL_IS_INTEGER, nil)) then Result := CGMUnknownPosition; if not ODBCSucceeded(SQLGetStmtAttr(Handle, SQL_ATTR_ROW_NUMBER, @Result, SizeOf(Result), nil)) then Result := CGMUnknownPosition; end; function TGMOdbcRecordsetBase.ODBCRecordCount: SQLLEN; // var len: begin if not Active then Result := cGMUnknownCount else //if not ODBCSucceeded(SQLGetStmtAttr(Handle, SQL_DESC_COUNT, @Result, SizeOf(Result), nil)) then Result := cGMUnknownCount; //if not ODBCSucceeded(SQLGetDiagField(HandleType, Handle, 0, SQL_DIAG_CURSOR_ROW_COUNT, @Result, SQL_IS_INTEGER, nil)) then if not ODBCSucceeded(SQLGetDiagField(HandleType, Handle, 0, SQL_DIAG_CURSOR_ROW_COUNT, @Result, SizeOf(Result), nil)) then Result := cGMUnknownCount else if Result = 0 then Result := cGMUnknownCount; end; { ---- IGMGetSetAttributes ---- } function TGMOdbcRecordsetBase.GetAttributes: Longword; stdcall; begin Result := RSAttributesToLongword(Attributes); end; procedure TGMOdbcRecordsetBase.SetAttributes(const AValue: Longword); stdcall; begin Attributes := RSAttributesFromLongword(AValue); end; { ---- Property Get/Set ---- } procedure TGMOdbcRecordsetBase.IDESetAttributes(const AValue: TGMRecordsetAttributes); begin if (raBookmarksEnabled in Attributes) <> (raBookmarksEnabled in AValue) then CheckIsInactive('raBookmarksEnabled Attribute'); //if (raFetchDataOnDemand in Attributes) <> (raFetchDataOnDemand in AValue) then CheckIsInactive('raFetchDataOnDemand Attribute'); if (raExposeBookmarkColumn in Attributes) <> (raExposeBookmarkColumn in AValue) then CheckIsInactive('raExposeBookmarkColumn Attribute'); //if (raUseScrollableCursor in Attributes) <> (raUseScrollableCursor in AValue) then SetODBCCursorScrollable(raUseScrollableCursor in AValue); FAttributes := AValue; end; procedure TGMOdbcRecordsetBase.SetCascadedContentsProperties(const AValue: TGMCascadedContentsProperties); begin CascadedContentsProperties.AssignFromObj(AValue); end; procedure TGMOdbcRecordsetBase.SetUpdateStrategy(const AValue: TUpdateStrategy); begin if AValue <> UpdateStrategy then begin CheckIsInactive('UpdateStrategy ' + RStrProperty); FUpdateStrategy := AValue; end; end; procedure TGMOdbcRecordsetBase.SetPositionedUpdateSimulation(const AValue: TPositionedUpdateSimulation); begin if AValue <> PositionedUpdateSimulation then begin SetODBCPositionedUpdateSimulation(AValue); FPositionedUpdateSimulation := AValue; end; end; procedure TGMOdbcRecordsetBase.SetCursorSensitivity(const AValue: TCursorSensitivity); begin if AValue <> CursorSensitivity then begin SetODBCCursorSensitivity(AValue); FCursorSensitivity := AValue; end; end; procedure TGMOdbcRecordsetBase.SetCursorType(const AValue: TGMCursorType); begin if AValue <> CursorType then begin CheckIsInactive('CursorType ' + RStrProperty); FCursorType := AValue; end; end; procedure TGMOdbcRecordsetBase.SetKeysetSize(const AValue: SQLUINTEGER); begin if AValue <> KeysetSize then begin SetODBCKeysetSize(AValue); FKeysetSize := AValue; end; end; procedure TGMOdbcRecordsetBase.SetMaxRecordsReturned(const AValue: SQLUINTEGER); begin if AValue <> MaxRecordsReturned then begin SetODBCMaxRecordsReturned(AValue); FMaxRecordsReturned := AValue; end; end; procedure TGMOdbcRecordsetBase.SetMaxFieldDataSize(const AValue: SQLUINTEGER); begin if AValue <> MaxFieldDataSize then begin SetODBCMaxFieldDataSize(AValue); FMaxFieldDataSize := AValue; end; end; //procedure TGMOdbcRecordsetBase.SetBlobCompressionType(const Value: Integer); // TGMCompressionType //begin //if Value <> BlobCompressionType then // begin // CheckIsInactive('BlobCompressionType ' + RStrProperty); // FBlobCompressionType := Value; // end; //end; // // Notify fields separate from any other Objects that are connected // via the connection Points. If something changes controls will contact // the fields. So the Fields should know before the controls about the Change. // procedure TGMOdbcRecordsetBase.AfterValueChange(const FieldName: TGMString); begin GMCpcCallNotifySinks(Self, IGMNamedValueChange, GMCallSinkAfterFieldValueChange, NotifyDisableCount = 0, [FieldName]); if Assigned(OnAfterFieldValueChange) and DoCallEvents then try OnAfterFieldValueChange(Self, FieldName); except on E: EGMOdbcError do raise; end; end; procedure TGMOdbcRecordsetBase.NotifyConnectedObjectsBeforePositionChange; begin inherited NotifyConnectedObjectsBeforePositionChange; if Assigned(OnBeforePositionChange) and DoCallEvents then OnBeforePositionChange(Self); GMCpcCallNotifySinks(Self, IGMPositionChangeNotifications, GMCallSinkBeforePositionChange, NotifyDisableCount = 0, []); end; procedure TGMOdbcRecordsetBase.NotifyBeforePositionChange; begin NotifyConnectedObjectsBeforePositionChange; GMNotifyFieldsBeforePositionChange(FieldPosList); LeaveModifyingState; end; procedure TGMOdbcRecordsetBase.NotifyConnectedObjectsAfterPositionChange; begin inherited NotifyConnectedObjectsAfterPositionChange; GMCpcCallNotifySinks(Self, IGMPositionChangeNotifications, GMCallSinkAfterPositionChange, NotifyDisableCount = 0, []); if Assigned(OnAfterPositionChange) and DoCallEvents then try OnAfterPositionChange(Self); except on E: EGMOdbcError do raise; end; end; procedure TGMOdbcRecordsetBase.NotifyAfterPositionChange; begin GMNotifyFieldsAfterPositionChange(FieldPosList); NotifyConnectedObjectsAfterPositionChange; end; procedure TGMOdbcRecordsetBase.NotifyValidateFieldValues; begin GMCpcCallNotifySinks(Self, IGMValidateValues, GMCallSinkValidateValue, NotifyDisableCount = 0, []); if Assigned(OnValidateFieldValues) and DoCallEvents then OnValidateFieldValues(Self); end; procedure TGMOdbcRecordsetBase.NotifyConnectedObjectsBeforeOperation(const Operation: Integer; const Parameter: IUnknown = nil); begin if Assigned(OnBeforeOperation) and DoCallEvents then OnBeforeOperation(Self, TGMRecordsetOperation(Operation)); GMCpcCallNotifySinks(Self, IGMOperationNotifications, GMCallSinkBeforeOperation, NotifyDisableCount = 0, [Operation, Parameter]); end; procedure TGMOdbcRecordsetBase.NotifyBeforeOperation(const Operation: Integer; const Parameter: IUnknown = nil); begin inherited NotifyBeforeOperation(Operation, Parameter); NotifyConnectedObjectsBeforeOperation(Operation, Parameter); GMNotifyFieldsBeforeOperation(FieldPosList, Operation, Parameter); end; procedure TGMOdbcRecordsetBase.NotifyConnectedObjectsAfterOperation(const Operation: Integer; const Parameter: IUnknown = nil); begin GMCpcCallNotifySinks(Self, IGMOperationNotifications, GMCallSinkAfterOperation, NotifyDisableCount = 0, [Operation, Parameter]); if Assigned(OnAfterOperation) and DoCallEvents then try OnAfterOperation(Self, TGMRecordsetOperation(Operation)); except on E: EGMOdbcError do raise; end; end; procedure TGMOdbcRecordsetBase.NotifyAfterOperation(const Operation: Integer; const Parameter: IUnknown = nil); begin inherited NotifyAfterOperation(Operation, Parameter); GMNotifyFieldsAfterOperation(FieldPosList, Operation, Parameter); NotifyConnectedObjectsAfterOperation(Operation, Parameter); end; procedure TGMOdbcRecordsetBase.NotifyBeforeActiveChange(const NewActive: Boolean); begin //try if not NewActive then LeaveModifyingState; //except //if not (csDestroying in ComponentState) then raise; //end; inherited NotifyBeforeActiveChange(NewActive); GMNotifyFieldsBeforeActiveChange(FieldPosList, NewActive); end; procedure TGMOdbcRecordsetBase.NotifyAfterActiveChange(const ANewActive: Boolean); var i: Integer; begin if ANewActive then begin for i:=0 to FieldPosList.Count-1 do (FieldPosList[i] as TGMOdbcField).BindBuffer(True); // <- Some drivers need a buffer before fetching DoCursorFetch(SQL_FETCH_NEXT, 0, {$I %CurrentRoutine%}, False); FPosition := 1; // <- Have Position 1 even when empty end; GMNotifyFieldsAfterActiveChange(FieldPosList, ANewActive); // <- must be done after cursor fetch, will ask the cursor state inherited NotifyAfterActiveChange(ANewActive); end; { -------------------------- } { ---- TGMOdbcRecordset ---- } { -------------------------- } constructor TGMOdbcRecordset.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FMasterSource := TGMRecordsetMasterSource.Create(Self, []); MasterSource.OnAfterActiveChange := AfterMasterActiveChange; MasterSource.OnAfterPositionChange := AfterMasterPositionChange; MasterSource.OnAfterOperation := AfterMasterOperation; MasterSource.OnAfterFieldValueChange := AfterMasterFieldValueChange; end; destructor TGMOdbcRecordset.Destroy; begin inherited Destroy; GMFreeAndNil(FMasterSource); end; //procedure TGMOdbcRecordset.CheckSQLStatementText(const SQL: TGMString); //begin //GMCheckSQLNotEmpty(SQL, Self, {$I %CurrentRoutine%}); ////if not IsSelectSQL(SQL) then raise EGMException.ObjError(RStrNoModfifiyngSQL, Self, {$I %CurrentRoutine%}); //end; procedure TGMOdbcRecordset.Insert(const Parameter: IUnknown = nil); begin inherited Insert(Parameter); AssignFieldValuesFromMasterSource; end; procedure TGMOdbcRecordset.OpenMasterSource(const MethodName: TGMString); begin GMSetIntfActive(MasterSource.InterfaceSource, True, MethodName); end; procedure TGMOdbcRecordset.EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer); var PIMasterActive: IUnknown; PIEnumSink: IGMTellEnumString; begin if GMQueryInterface(TellEnumSink, IGMTellEnumString, PIEnumSink) then case ItemKind of Ord(eidFieldNames): PIMasterActive := TGMActiveKeeper.Create(MasterSource.InterfaceSource, True); end; inherited EnumerateItems(ItemKind, TellEnumSink, Parameter); end; procedure TGMOdbcRecordset.AssignMasterParamValues; var i: Integer; PIFieldByName: IGMGetIntfByName; PIGetValue: IGMGetUnionValue; begin if MasterSource.InterfaceSource <> nil then begin OpenMasterSource({$I %CurrentRoutine%}); if GMQueryInterface(MasterSource.InterfaceSource, IGMGetIntfByName, PIFieldByName) then for i:=0 to SQL.SQLParameter.Count-1 do if PIFieldByName.GetIntfByName(SQL.SQLParameter[i].Name, IGMGetUnionValue, PIGetValue) = S_OK then SQL.SQLParameter[i].AssignValue(PIGetValue.Value, False); // <- AssignFromObj without triggering ScheduleReExecution (again) end; end; procedure TGMOdbcRecordset.AssignFieldValuesFromMasterSource; var ChPos, StartPos: PtrInt; Token, SQLText: TGMString; PIFieldValue: IGMGetSetUnionValue; begin if MasterSource.InterfaceSource <> nil then begin OpenMasterSource({$I %CurrentRoutine%}); SQLText := SQL.SQLText; ChPos := 1; while ChPos <= Length(SQLText) do begin StartPos := ChPos-1; Token := GMNextSQLToken(ChPos, SQLText, cSqlSeparators + cSqlOperators); if (Length(Token) > 1) and (Token[1] = cSqlParamPrefixChar) and (GetIntfByName(GMPreviousWord(StartPos, SQLText, cSqlSeparators + cSqlOperators), IGMGetSetUnionValue, PIFieldValue) = S_OK) then PIFieldValue.Value := GMCheckGetItemValue(MasterSource.InterfaceSource, GMStrip(Token, cSqlParamPrefixChar + cSqlSeparators + cSqlOperators), {$I %CurrentRoutine%}); end; end; end; procedure TGMOdbcRecordset.IDESetMasterSource(const AValue: TGMRecordsetMasterSource); begin MasterSource.AssignFromObj(AValue); end; function TGMOdbcRecordset.GetMasterSource: IUnknown; begin Result := MasterSource.InterfaceSource; end; procedure TGMOdbcRecordset.SetMasterSource(const AValue: IUnknown); begin MasterSource.InterfaceSource := AValue; end; function TGMOdbcRecordset.GetResolvedSQLStatement: TGMString; begin AssignMasterParamValues; Result := inherited GetResolvedSQLStatement; end; procedure TGMOdbcRecordset.AfterMasterActiveChange(const ANewActive: Boolean); begin if not MasterSource.AutoActivate then Exit; if ANewActive then ScheduleReexecution else Close; end; procedure TGMOdbcRecordset.AfterMasterPositionChange; begin ScheduleReexecution; end; procedure TGMOdbcRecordset.AfterMasterOperation(const AOperation: LongInt; const AParameter: IUnknown = nil); begin case AOperation of Ord(roInsert), Ord(roCancelChanges), {Ord(roApplychanges),} Ord(roRefreshCurrent), Ord(roReExecuteStatement): ScheduleReExecution; end; end; procedure TGMOdbcRecordset.AfterMasterFieldValueChange(ASender: IUnknown; const AFieldName: TGMString); var i: Integer; begin for i:=0 to SQL.SQLParameter.Count-1 do if GMSameText(SQL.SQLParameter[i].Name, AFieldName) then begin ScheduleReExecution; Break; end; end; { ----------------------------- } { ---- TGMOdbcGroupSlaveRS ---- } { ----------------------------- } constructor TGMOdbcGroupSlaveRS.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); MasterSource.AlwaysNotify := True; end; procedure TGMOdbcGroupSlaveRS.ScheduleReExecution(const ColumnsStayValid: Boolean = True); begin ReExecuteStatement(ColumnsStayValid); end; { -------------------------------- } { ---- TGMOdbcSchemaRecordset ---- } { -------------------------------- } constructor TGMOdbcSchemaRecordset.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FSchemaData := TGMSchemaProperties.Create(Self); SchemaData.OnAfterSchemaDataChange := AfterSchemaDataChange; end; destructor TGMOdbcSchemaRecordset.Destroy; begin inherited Destroy; GMFreeAndNil(FSchemaData); end; //function TGMOdbcSchemaRecordset.Obj: TGMOdbcSchemaRecordset; //begin // Result := Self; //end; //function TGMOdbcSchemaRecordset.GetPropertyIntf(const PropertyName: TGMString; const IID: TGUID; out Intf): HResult; //begin // if GMSameText(PropertyName, cStrSchemaData) then // Result := SchemaData.QueryInterface(IID, Intf) // else // Result := inherited GetPropertyIntf(PropertyName, IID, Intf); //end; procedure TGMOdbcSchemaRecordset.AssignFromObj(const ASource: TObject); begin inherited AssignFromObj(ASource); SchemaData.AssignFromObj(ASource); //if ASource is TGMOdbcSchemaRecordset then SchemaData := TGMOdbcSchemaRecordset(ASource).SchemaData; end; //procedure TGMOdbcSchemaRecordset.SetSchemaData(const Value: TGMSchemaProperties); //begin // SchemaData.AssignFromObj(Value); //end; //function TGMOdbcSchemaRecordset.GetText: TGMString; //begin // Result := SchemaData.GetText; //end; procedure TGMOdbcSchemaRecordset.AfterSchemaDataChange(const Sender: TObject); begin NotifyAfterSQLChange; end; //function TGMOdbcSchemaRecordset.GetODBCFieldCount: SQLSMALLINT; //begin //case SchemaData.SchemaList of // slSystemTables, slTables, slViews: Result := 5; // else Result := inherited GetODBCFieldCount; //end; //end; procedure TGMOdbcSchemaRecordset.InternalExecute; var pszCatalogName, pszSchemaName, pszTableName, pszTableKind, pszColumnName, pszForeignCatalogName, pszForeignSchemaName, pszForeignTableName: SQLPCHAR; ccDatabaseNameLen, ccSchemaNameLen, ccTableNameLen, ccTableKindLen, ccColumnNameLen, ccForeignCatalogNameLen, ccForeignSchemaNameLen, ccForeignTableNameLen: SQLSMALLINT; procedure AssignString(const AValue: TGMString; var APszFilterStr: SQLPCHAR; var AFilterStrLen: SQLSMALLINT); begin if GMSameText(AValue, cStrNil) then begin APszFilterStr := nil; AFilterStrLen := 0; end else begin APszFilterStr := PGMChar(AValue); AFilterStrLen := Length(AValue); end; end; procedure OpenCheck(const SQLCode: SQLRETURN; const RoutineName: TGMString); begin if SQLCode <> SQL_NO_DATA then ODBCCheck(SQLCode, Self, RoutineName); end; begin AssignString(SchemaData.CatalogName, pszCatalogName, ccDatabaseNameLen); AssignString(SchemaData.SchemaName, pszSchemaName, ccSchemaNameLen); AssignString(SchemaData.TableName, pszTableName, ccTableNameLen); AssignString(SchemaData.ColumnName, pszColumnName, ccColumnNameLen); AssignString(SchemaData.ForeignCatalogName, pszForeignCatalogName, ccForeignCatalogNameLen); AssignString(SchemaData.ForeignSchemaName, pszForeignSchemaName, ccForeignSchemaNameLen); AssignString(SchemaData.ForeignTableName, pszForeignTableName, ccForeignTableNameLen); case SchemaData.SchemaList of slTables: begin // case SchemaData.SchemaList of // slSystemTables: AssignString(cStrSysTable, pszTableKind, ccTableKindLen); // slTables: AssignString(cStrTable, pszTableKind, ccTableKindLen); // slViews: AssignString(cStrView, pszTableKind, ccTableKindLen); // else AssignString(cStrNil, pszTableKind, ccTableKindLen); // end; AssignString(SchemaData.TableKind, pszTableKind, ccTableKindLen); OpenCheck(SQLTables(Handle, pszCatalogName, ccDatabaseNameLen, pszSchemaName, ccSchemaNameLen, pszTableName, ccTableNameLen, pszTableKind, ccTableKindLen), cStrSQLTables); end; slPrimaryKeys: OpenCheck(SQLPrimaryKeys(Handle, pszCatalogName, ccDatabaseNameLen, pszSchemaName, ccSchemaNameLen, pszTableName, ccTableNameLen), cStrSQLPrimaryKeys); slColumns: OpenCheck(SQLColumns(Handle, pszCatalogName, ccDatabaseNameLen, pszSchemaName, ccSchemaNameLen, pszTableName, ccTableNameLen, pszColumnName, ccColumnNameLen), cStrSQLColumns); slStatistics: OpenCheck(SQLStatistics(Handle, pszCatalogName, ccDatabaseNameLen, pszSchemaName, ccSchemaNameLen, pszTableName, ccTableNameLen, SQL_INDEX_ALL, SQL_QUICK), cStrSQLStatistics); slProcedures: OpenCheck(SQLProcedures(Handle, pszCatalogName, ccDatabaseNameLen, pszSchemaName, ccSchemaNameLen, pszTableName, ccTableNameLen), cStrSQLProcedures); slProcedureColumns: OpenCheck(SQLProcedureColumns(Handle, pszCatalogName, ccDatabaseNameLen, pszSchemaName, ccSchemaNameLen, pszTableName, ccTableNameLen, pszColumnName, ccColumnNameLen), cStrSQLProcedureColumns); slForeignKeys: OpenCheck(SQLForeignKeys(Handle, pszCatalogName, ccDatabaseNameLen, pszSchemaName, ccSchemaNameLen, pszTableName, ccTableNameLen, pszForeignCatalogName, ccForeignCatalogNameLen, pszForeignSchemaName, ccForeignSchemaNameLen, pszForeignTableName, ccForeignTableNameLen), cStrSQLForeignKeys); slTablePrivileges: OpenCheck(SQLTablePrivileges(Handle, pszCatalogName, ccDatabaseNameLen, pszSchemaName, ccSchemaNameLen, pszTableName, ccTableNameLen), cStrSQLTablePrivileges); slColumnPrivileges: OpenCheck(SQLColumnPrivileges(Handle, pszCatalogName, ccDatabaseNameLen, pszSchemaName, ccSchemaNameLen, pszTableName, ccTableNameLen, pszColumnName, ccColumnNameLen), cStrSQLColumnPrivileges); slTypeInfo: OpenCheck(SQLGetTypeInfo(Handle, GMStrToInt(GMMakeDezInt(SchemaData.ColumnName, SQL_UNKNOWN_TYPE))), cStrSQLGetTypeInfo); else raise EGMException.ObjError(MsgUnsupportedValue(cStrSchemaList, Ord(SchemaData.SchemaList)), Self, {$I %CurrentRoutine%}); end; end; initialization vSQLDatTimeFmtStr := cODBCDateTimeFormatStrMS; end.