home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / Runimage / Delphi50 / Source / Vcl / adodb.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  180.9 KB  |  6,017 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {       ADO Components                                  }
  6. {                                                       }
  7. {       Copyright (c) 1999 Inprise Corporation          }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit ADODB;
  12.  
  13. interface
  14.  
  15. {$R-}
  16.  
  17. uses
  18.   Windows, ActiveX, SysUtils, Classes, Graphics, TypInfo, DB,
  19.   OLEDB, ADOInt;
  20.  
  21. type
  22.  
  23. { Forward declarations }
  24.  
  25.   TADOCommand = class;
  26.   TCustomADODataSet = class;
  27.   TADODataSet = class;
  28.   TParameters = class;
  29.   TADOConnection = class;
  30.  
  31. { Redclare ADO types exposed by this unit }
  32.  
  33.   _Connection = ADOInt._Connection;
  34.   _Command = ADOInt._Command;
  35.   _Recordset = ADOInt.Recordset;
  36.   Error = ADOInt.Error;
  37.   Errors = ADOInt.Errors;
  38.   _Parameter = ADOInt._Parameter;
  39.   Parameters = ADOInt.Parameters;
  40.   Property_ = ADOInt.Property_;
  41.   Properties = ADOInt.Properties;
  42.  
  43. { Errors }
  44.  
  45.   EADOError = class(EDatabaseError);
  46.  
  47. { TADOConnection }
  48.  
  49.   TConnectMode = (cmUnknown, cmRead, cmWrite, cmReadWrite, cmShareDenyRead,
  50.     cmShareDenyWrite, cmShareExclusive, cmShareDenyNone);
  51.  
  52.   TConnectOption = (coConnectUnspecified, coAsyncConnect);
  53.  
  54.   TCursorLocation = (clUseServer, clUseClient);
  55.  
  56.   TCursorType = (ctUnspecified, ctOpenForwardOnly, ctKeyset, ctDynamic,
  57.     ctStatic);
  58.  
  59.   TEventStatus = (esOK, esErrorsOccured, esCantDeny, esCancel, esUnwantedEvent);
  60.  
  61.   TExecuteOption = (eoAsyncExecute, eoAsyncFetch, eoAsyncFetchNonBlocking,
  62.     eoExecuteNoRecords);
  63.   TExecuteOptions = set of TExecuteOption;
  64.  
  65.   TIsolationLevel = (ilUnspecified, ilChaos, ilReadUncommitted, ilBrowse,
  66.     ilCursorStability, ilReadCommitted, ilRepeatableRead, ilSerializable,
  67.     ilIsolated);
  68.  
  69.   TADOLockType = (ltUnspecified, ltReadOnly, ltPessimistic, ltOptimistic,
  70.     ltBatchOptimistic);
  71.  
  72.   TObjectState = (stClosed, stOpen, stConnecting, stExecuting, stFetching);
  73.   TObjectStates = set of TObjectState;
  74.  
  75.   TSchemaInfo = (siAsserts, siCatalogs, siCharacterSets, siCollations,
  76.     siColumns, siCheckConstraints, siConstraintColumnUsage,
  77.     siConstraintTableUsage, siKeyColumnUsage, siReferentialConstraints,
  78.     siTableConstraints, siColumnsDomainUsage, siIndexes, siColumnPrivileges,
  79.     siTablePrivileges, siUsagePrivileges, siProcedures, siSchemata,
  80.     siSQLLanguages, siStatistics, siTables, siTranslations, siProviderTypes,
  81.     siViews, siViewColumnUsage, siViewTableUsage, siProcedureParameters,
  82.     siForeignKeys, siPrimaryKeys, siProcedureColumns, siDBInfoKeywords,
  83.     siDBInfoLiterals, siCubes, siDimensions, siHierarchies, siLevels,
  84.     siMeasures, siProperties, siMembers, siProviderSpecific);
  85.  
  86.   TXactAttribute = (xaCommitRetaining, xaAbortRetaining);
  87.   TXactAttributes = set of TXactAttribute;
  88.  
  89.   TBeginTransCompleteEvent = procedure(Connection: TADOConnection;
  90.     TransactionLevel: Integer; const Error: Error;
  91.     var EventStatus: TEventStatus) of object;
  92.  
  93.   TCommandType = (cmdUnknown, cmdText, cmdTable, cmdStoredProc, cmdFile, cmdTableDirect);
  94.  
  95.   TConnectErrorEvent = procedure(Connection: TADOConnection;
  96.     const Error: Error; var EventStatus: TEventStatus) of object;
  97.  
  98.   TDisconnectEvent = procedure(Connection: TADOConnection;
  99.     var EventStatus: TEventStatus) of object;
  100.  
  101.   TExecuteCompleteEvent = procedure(Connection: TADOConnection;
  102.     RecordsAffected: Integer; const Error: Error;  var EventStatus: TEventStatus;
  103.     const Command: _Command; const Recordset: _Recordset) of object;
  104.  
  105.   TWillConnectEvent = procedure(Connection: TADOConnection;
  106.     var ConnectionString, UserID, Password: WideString;
  107.     var ConnectOptions: TConnectOption; var EventStatus: TEventStatus) of object;
  108.  
  109.   TWillExecuteEvent = procedure(Connection: TADOConnection;
  110.     var CommandText: WideString; var CursorType: TCursorType;
  111.     var LockType: TADOLockType; var CommandType: TCommandType;
  112.     var ExecuteOptions: TExecuteOptions; var EventStatus: TEventStatus;
  113.     const Command: _Command; const Recordset: _Recordset) of object;
  114.  
  115.   TInfoMessageEvent = procedure(Connection: TADOConnection; const Error: Error;
  116.     var EventStatus: TEventStatus) of object;
  117.  
  118.   TADOConnection = class(TCustomConnection, IUnknown, ConnectionEventsVT)
  119.   private
  120.     FCommands: TList;
  121.     FConnectionObject: _Connection;
  122.     FConnEventsID: Integer;
  123.     FDefaultDatabase: WideString;
  124.     FUserID: WideString;
  125.     FPassword: WideString;
  126.     FConnectOptions: TConnectOption;
  127.     FIsolationLevel: TIsolationLevel;
  128.     FTransactionLevel: Integer;
  129.     FKeepConnection: Boolean;
  130.     FOnBeginTransComplete: TBeginTransCompleteEvent;
  131.     FOnConnectComplete: TConnectErrorEvent;
  132.     FOnCommitTransComplete: TConnectErrorEvent;
  133.     FOnRollbackTransComplete: TConnectErrorEvent;
  134.     FOnDisconnect: TDisconnectEvent;
  135.     FOnInfoMessage: TInfoMessageEvent;
  136.     FOnWillConnect: TWillConnectEvent;
  137.     FOnExecuteComplete: TExecuteCompleteEvent;
  138.     FOnWillExecute: TWillExecuteEvent;
  139.     procedure ClearRefs;
  140.     function IsProviderStored: Boolean;
  141.     function IsDefaultDatabaseStored: Boolean;
  142.     function GetADODataSet(Index: Integer): TCustomADODataSet;
  143.     function GetAttributes: TXactAttributes;
  144.     function GetCommand(Index: Integer): TADOCommand;
  145.     function GetCommandCount: Integer;
  146.     function GetCommandTimeout: Integer;
  147.     function GetConnectionString: WideString;
  148.     function GetConnectionTimeout: Integer;
  149.     function GetCursorLocation: TCursorLocation;
  150.     function GetDefaultDatabase: WideString;
  151.     function GetIsolationLevel: TIsolationLevel;
  152.     function GetMode: TConnectMode;
  153.     function GetProperties: Properties;
  154.     function GetProvider: WideString;
  155.     function GetState: TObjectStates;
  156.     function GetVersion: WideString;
  157.     procedure SetAttributes(const Value: TXactAttributes);
  158.     procedure SetCommandTimeout(const Value: Integer);
  159.     procedure SetConnectionString(const Value: WideString);
  160.     procedure SetConnectionTimeout(const Value: Integer);
  161.     procedure SetCursorLocation(const Value: TCursorLocation);
  162.     procedure SetDefaultDatabase(const Value: WideString);
  163.     procedure SetIsolationLevel(const Value: TIsolationLevel);
  164.     procedure SetMode(const Value: TConnectMode);
  165.     procedure SetProvider(const Value: WideString);
  166.     procedure SetConnectOptions(const Value: TConnectOption);
  167.     function GetInTransaction: Boolean;
  168.     procedure SetConnectionObject(const Value: _Connection);
  169.     procedure SetKeepConnection(const Value: Boolean);
  170.   protected
  171.     { ConnectionEvents }
  172.     function ConnectionPoint: IConnectionPoint;
  173.     procedure InfoMessage(const pError: Error; var adStatus: EventStatusEnum;
  174.       const pConnection: _Connection); safecall;
  175.     procedure BeginTransComplete(TransactionLevel: Integer; const pError: Error;
  176.       var adStatus: EventStatusEnum; const pConnection: _Connection); safecall;
  177.     procedure CommitTransComplete(const pError: Error; var adStatus: EventStatusEnum;
  178.       const pConnection: _Connection); safecall;
  179.     procedure RollbackTransComplete(const pError: Error; var adStatus: EventStatusEnum;
  180.       const pConnection: _Connection); safecall;
  181.     procedure WillExecute(var Source: WideString; var CursorType: CursorTypeEnum;
  182.       var LockType: LockTypeEnum; var Options: Integer;
  183.       var adStatus: EventStatusEnum; const pCommand: _Command;
  184.       const pRecordset: _Recordset; const pConnection: _Connection); safecall;
  185.     procedure ExecuteComplete(RecordsAffected: Integer; const pError: Error;
  186.       var adStatus: EventStatusEnum; const pCommand: _Command;
  187.       const pRecordset: _Recordset; const pConnection: _Connection); safecall;
  188.     procedure WillConnect(var ConnectionString: WideString; var UserID: WideString;
  189.       var Password: WideString; var Options: Integer;
  190.       var adStatus: EventStatusEnum; const pConnection: _Connection); safecall;
  191.     procedure ConnectComplete(const pError: Error; var adStatus: EventStatusEnum;
  192.       const pConnection: _Connection); safecall;
  193.     procedure Disconnect(var adStatus: EventStatusEnum; const pConnection: _Connection); safecall;
  194.   protected
  195.     procedure CheckActive;
  196.     procedure CheckDisconnect; virtual;
  197.     procedure CheckInactive;
  198.     procedure DoConnect; override;
  199.     procedure DoDisconnect; override;
  200.     function GetConnected: Boolean; override;
  201.     function GetErrors: Errors;
  202.     procedure Loaded; override;
  203.     procedure RegisterClient(Client: TObject; Event: TConnectChangeEvent = nil); override;
  204.     procedure UnRegisterClient(Client: TObject); override;
  205.     procedure WaitForConnectComplete; virtual;
  206.   public
  207.     constructor Create(AOwner: TComponent); override;
  208.     destructor Destroy; override;
  209.     function BeginTrans: Integer;
  210.     procedure Cancel;
  211.     procedure CommitTrans;
  212.     procedure Execute(const CommandText: WideString; var RecordsAffected: Integer;
  213.       const ExecuteOptions: TExecuteOptions = [eoExecuteNoRecords]); overload;
  214.     function Execute(const CommandText: WideString;
  215.       const CommandType: TCommandType = cmdText; const ExecuteOptions: TExecuteOptions = []): _Recordset; overload;
  216.     procedure GetProcedureNames(List: TStrings);
  217.     procedure GetFieldNames(const TableName: string; List: TStrings);
  218.     procedure GetTableNames(List: TStrings; SystemTables: Boolean = False);
  219.     procedure Open(const UserID: WideString; const Password: WideString); overload;
  220.     procedure OpenSchema(const Schema: TSchemaInfo; const Restrictions: OleVariant;
  221.       const SchemaID: OleVariant; DataSet: TADODataSet);
  222.     procedure RollbackTrans;
  223.     property ConnectionObject: _Connection read FConnectionObject write SetConnectionObject;
  224.     property CommandCount: Integer read GetCommandCount;
  225.     property Commands[Index: Integer]: TADOCommand read GetCommand;
  226.     property DataSets[Index: Integer]: TCustomADODataSet read GetADODataSet;
  227.     property Errors: Errors read GetErrors;
  228.     property InTransaction: Boolean read GetInTransaction;
  229.     property Properties: Properties read GetProperties;
  230.     property State: TObjectStates read GetState;
  231.     property Version: WideString read GetVersion;
  232.   published
  233.     property Attributes: TXactAttributes read GetAttributes write SetAttributes default [];
  234.     property CommandTimeout: Integer read GetCommandTimeout write SetCommandTimeout default 30;
  235.     property Connected;
  236.     property ConnectionString: WideString read GetConnectionString write SetConnectionString;
  237.     property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout default 15;
  238.     property ConnectOptions: TConnectOption read FConnectOptions write SetConnectOptions default coConnectUnspecified;
  239.     property CursorLocation: TCursorLocation read GetCursorLocation write SetCursorLocation default clUseClient;
  240.     property DefaultDatabase: WideString read GetDefaultDatabase write SetDefaultDatabase stored IsDefaultDatabaseStored;
  241.     property IsolationLevel: TIsolationLevel read GetIsolationLevel write SetIsolationLevel default ilCursorStability;
  242.     property KeepConnection: Boolean read FKeepConnection write SetKeepConnection default True;
  243.     property LoginPrompt default True;
  244.     property Mode: TConnectMode read GetMode write SetMode default cmUnknown;
  245.     property Provider: WideString read GetProvider write SetProvider stored IsProviderStored;
  246.     { Events }
  247.     property AfterConnect;
  248.     property BeforeConnect;
  249.     property AfterDisconnect;
  250.     property BeforeDisconnect;
  251.     property OnDisconnect: TDisconnectEvent read FOnDisconnect write FOnDisconnect;
  252.     property OnInfoMessage: TInfoMessageEvent read FOnInfoMessage write FOnInfoMessage;
  253.     property OnBeginTransComplete: TBeginTransCompleteEvent read FOnBeginTransComplete write FOnBeginTransComplete;
  254.     property OnCommitTransComplete: TConnectErrorEvent read FOnCommitTransComplete write FOnCommitTransComplete;
  255.     property OnRollbackTransComplete: TConnectErrorEvent read FOnRollbackTransComplete write FOnRollbackTransComplete;
  256.     property OnConnectComplete: TConnectErrorEvent read FOnConnectComplete write FOnConnectComplete;
  257.     property OnWillConnect: TWillConnectEvent read FOnWillConnect write FOnWillConnect;
  258.     property OnExecuteComplete: TExecuteCompleteEvent read FOnExecuteComplete write FOnExecuteComplete;
  259.     property OnWillExecute: TWillExecuteEvent read FOnWillExecute write FOnWillExecute;
  260.     property OnLogin;
  261.   end;
  262.  
  263. { TRDSConnection }
  264.  
  265.   TRDSConnection = class(TCustomConnection)
  266.   private
  267.     FDataSpace: DataSpace;
  268.     FComputerName: WideString;
  269.     FServerName: WideString;
  270.     FAppServer: OleVariant;
  271.     FInternetTimeout: Integer;
  272.     FIsAppServer: Boolean;
  273.     procedure CheckInactive;
  274.     procedure ClearRefs;
  275.     procedure SetServerName(const Value: WideString);
  276.     procedure SetComputerName(const Value: WideString);
  277.   protected
  278.     procedure DoConnect; override;
  279.     procedure DoDisconnect; override;
  280.     function GetConnected: Boolean; override;
  281.   public
  282.     constructor Create(AOwner: TComponent); override;
  283.     destructor Destroy; override;
  284.     function GetRecordset(const CommandText: WideString;
  285.       ConnectionString: WideString = ''): _Recordset;
  286.     property AppServer: OleVariant read FAppServer;
  287.     property DataSpaceObject: DataSpace read FDataSpace;
  288.   published
  289.     property ComputerName: WideString read FComputerName write SetComputerName;
  290.     property Connected;
  291.     property InternetTimeout: Integer read FInternetTimeout write FInternetTimeout default 0;
  292.     property ServerName: WideString read FServerName write SetServerName stored FIsAppServer;
  293.     property AfterConnect;
  294.     property AfterDisconnect;
  295.     property BeforeConnect;
  296.     property BeforeDisconnect;
  297.   end;
  298.  
  299. { TParameter }
  300.  
  301.   TDataType = TFieldType;
  302.   TParameterAttribute = (paSigned, paNullable, paLong);
  303.   TParameterAttributes = set of TParameterAttribute;
  304.   TParameterDirection = (pdUnknown, pdInput, pdOutput, pdInputOutput,
  305.     pdReturnValue);
  306.  
  307.   TParameter = class(TCollectionItem)
  308.   private
  309.     FParameter: _Parameter;
  310.     function GetAttributes: TParameterAttributes;
  311.     function GetDataType: TDataType;
  312.     function GetName: WideString;
  313.     function GetNumericScale: Byte;
  314.     function GetParameter: _Parameter;
  315.     function GetParameterDirection: TParameterDirection;
  316.     function GetPrecision: Byte;
  317.     function GetProperties: Properties;
  318.     function GetSize: Integer;
  319.     function GetValue: Variant;
  320.     procedure SetAttributes(const Value: TParameterAttributes);
  321.     procedure SetDataType(const Value: TDataType);
  322.     procedure SetName(const Value: WideString);
  323.     procedure SetNumericScale(const Value: Byte);
  324.     procedure SetParameterDirection(const Value: TParameterDirection);
  325.     procedure SetPrecision(const Value: Byte);
  326.     procedure SetSize(const Value: Integer);
  327.     procedure SetValue(const Value: Variant);
  328.     function GetParameters: TParameters;
  329.   protected
  330.     procedure AssignTo(Dest: TPersistent); override;
  331.     function GetDisplayName: string; override;
  332.     function IsEqual(Value: TParameter): Boolean;
  333.   public
  334.     procedure Assign(Source: TPersistent); override;
  335.     procedure AppendChunk(Val: OleVariant);
  336.     procedure LoadFromFile(const FileName: string; DataType: TDataType);
  337.     procedure LoadFromStream(Stream: TStream; DataType: TDataType);
  338.     property ParameterObject: _Parameter read GetParameter;
  339.     property Parameters: TParameters read GetParameters;
  340.     property Properties: Properties read GetProperties;
  341.   published
  342.     property Name: WideString read GetName write SetName;
  343.     property Attributes: TParameterAttributes read GetAttributes write SetAttributes default [];
  344.     property DataType: TDataType read GetDataType write SetDataType default ftUnknown;
  345.     property Direction: TParameterDirection read GetParameterDirection write SetParameterDirection default pdInput;
  346.     property NumericScale: Byte read GetNumericScale write SetNumericScale default 0;
  347.     property Precision: Byte read GetPrecision write SetPrecision default 0;
  348.     property Size: Integer read GetSize write SetSize default 0;
  349.     property Value: Variant read GetValue write SetValue;
  350.   end;
  351.  
  352. { TParameters }
  353.  
  354.   TPropList = array of PPropInfo;
  355.  
  356.   TParameters = class(TOwnedCollection)
  357.   private
  358.     FModified: Boolean;
  359.     function GetCommand: TADOCommand;
  360.     function GetItem(Index: Integer): TParameter;
  361.     function GetParamCollection: Parameters;
  362.     function GetParamValue(const ParamName: WideString): Variant;
  363.     procedure SetItem(Index: Integer; const Value: TParameter);
  364.     procedure SetParamValue(const ParamName: WideString; const Value: Variant);
  365.   protected
  366.     function Create_Parameter(const Name: WideString;
  367.       DataType: TDataType; Direction: TParameterDirection = pdInput;
  368.       Size: Integer = 0): _Parameter;
  369.     function GetAttrCount: Integer; override;
  370.     function GetAttr(Index: Integer): string; override;
  371.     function GetItemAttr(Index, ItemIndex: Integer): string; override;
  372.     function InternalRefresh: Boolean;
  373.     procedure AppendParameters;
  374.     procedure Update(Item: TCollectionItem); override;
  375.     property Modified: Boolean read FModified;
  376.   public
  377.     function AddParameter: TParameter;
  378.     procedure AssignValues(Value: TParameters);
  379.     function CreateParameter(const Name: WideString; DataType: TDataType;
  380.       Direction: TParameterDirection; Size: Integer; Value: OleVariant): TParameter;
  381.     function FindParam(const Value: WideString): TParameter;
  382.     procedure GetParamList(List: TList; const ParamNames: WideString);
  383.     function IsEqual(Value: TParameters): Boolean;
  384.     function ParamByName(const Value: WideString): TParameter;
  385.     function ParseSQL(SQL: string; DoCreate: Boolean): string;
  386.     function Refresh: Boolean;
  387.     property ParamValues[const ParamName: WideString]: Variant read GetParamValue write SetParamValue;
  388.     property Command: TADOCommand read GetCommand;
  389.     property Items[Index: Integer]: TParameter read GetItem write SetItem; default;
  390.     property ParameterCollection: Parameters read GetParamCollection;
  391.   end;
  392.  
  393. { TADOCommand }
  394.  
  395.   TADOCommand = class(TComponent)
  396.   private
  397.     FCommandObject: _Command;
  398.     FConnection: TADOConnection;
  399.     FConnectionString: WideString;
  400.     FCommandText: WideString;
  401.     FCommandTextAlias: string;
  402.     FComponentRef: TComponent;
  403.     FExecuteOptions: TExecuteOptions;
  404.     FParameters: TParameters;
  405.     FConnectionFlags: set of 1..8;
  406.     FParamCheck: Boolean;
  407.     function GetCommandTimeOut: Integer;
  408.     function GetCommandType: TCommandType;
  409.     function GetPrepared: WordBool;
  410.     function GetProperties: Properties;
  411.     function GetState: TObjectStates;
  412.     procedure SetCommandTimeOut(const Value: Integer);
  413.     procedure SetComandType(const Value: TCommandType);
  414.     procedure SetConnection(const Value: TADOConnection);
  415.     procedure SetConnectionString(const Value: WideString);
  416.     procedure SetParameters(const Value: TParameters);
  417.     procedure SetPrepared(const Value: WordBool);
  418.     function GetActiveConnection: _Connection;
  419.   protected
  420.     procedure AssignCommandText(const Value: WideString; Loading: Boolean = False);
  421.     procedure CheckCommandText;
  422.     procedure ClearActiveConnection;
  423.     function ComponentLoading: Boolean;
  424.     procedure ConnectionStateChange(Sender: TObject; Connecting: Boolean);
  425.     procedure Initialize(DoAppend: Boolean = True); virtual;
  426.     procedure OpenConnection; virtual;
  427.     procedure SetCommandText(const Value: WideString); virtual;
  428.     function SetConnectionFlag(Flag: Integer; Value: Boolean): Boolean; virtual;
  429.     procedure SetName(const NewName: TComponentName); override;
  430.     property ActiveConnection: _Connection read GetActiveConnection;
  431.     property CommandTextAlias: string read FCommandTextAlias write FCommandTextAlias;
  432.     property ComponentRef: TComponent read FComponentRef write FComponentRef;
  433.   public
  434.     constructor Create(AOwner: TComponent); override;
  435.     destructor Destroy; override;
  436.     procedure Assign(Source: TPersistent); override;
  437.     procedure Cancel;
  438.     function Execute: _Recordset; overload;
  439.     function Execute(const Parameters: OleVariant): _Recordset; overload;
  440.     function Execute(var RecordsAffected: Integer; const Parameters: OleVariant): _Recordset; overload;
  441.     property CommandObject: _Command read FCommandObject;
  442.     property Properties: Properties read GetProperties;
  443.     property States: TObjectStates read GetState;
  444.   published
  445.     property CommandText: WideString read FCommandText write SetCommandText;
  446.     property CommandTimeout: Integer read GetCommandTimeOut write SetCommandTimeOut default 30;
  447.     property CommandType: TCommandType read GetCommandType write SetComandType default cmdText;
  448.     property Connection: TADOConnection read FConnection write SetConnection;
  449.     property ConnectionString: WideString read FConnectionString write SetConnectionString;
  450.     property ExecuteOptions: TExecuteOptions read FExecuteOptions write FExecuteOptions default [];
  451.     property Prepared: WordBool read GetPrepared write SetPrepared default False;
  452.     property Parameters: TParameters read FParameters write SetParameters;
  453.     property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
  454.   end;
  455.  
  456. { TCustomADODataSet }
  457.  
  458.   TCursorOption = (coHoldRecords, coMovePrevious, coAddNew, coDelete, coUpdate,
  459.     coBookmark, coApproxPosition, coUpdateBatch, coResync, coNotify, coFind,
  460.     coSeek, coIndex);
  461.   TCursorOptions = set of TCursorOption;
  462.  
  463.   TEventReason = (erAddNew, erDelete, erUpdate, erUndoUpdate, erUndoAddNew,
  464.     erUndoDelete, erRequery, erResynch, erClose, erMove, erFirstChange,
  465.     erMoveFirst, erMoveNext, erMovePrevious, erMoveLast);
  466.  
  467.   TFilterGroup = (fgUnassigned, fgNone, fgPendingRecords, fgAffectedRecords,
  468.     fgFetchedRecords, fgPredicate, fgConflictingRecords);
  469.  
  470.   TMarshalOption = (moMarshalAll, moMarshalModifiedOnly);
  471.  
  472.   TRecordStatus = (rsOK, rsNew, rsModified, rsDeleted, rsUnmodified, rsInvalid,
  473.     rsMultipleChanges, rsPendingChanges, rsCanceled, rsCantRelease,
  474.     rsConcurrencyViolation, rsIntegrityViolation, rsMaxChangesExceeded,
  475.     rsObjectOpen, rsOutOfMemory, rsPermissionDenied, rsSchemaViolation,
  476.     rsDBDeleted);
  477.   TRecordStatusSet = set of TRecordStatus;
  478.  
  479.   TAffectRecords = (arCurrent, arFiltered, arAll, arAllChapters);
  480.  
  481.   TPersistFormat = (pfADTG, pfXML);
  482.  
  483.   TSeekOption = (soFirstEQ, soLastEQ, soAfterEQ, soAfter, soBeforeEQ, soBefore);
  484.  
  485.   PVariantList = ^TVariantList;
  486.   TVariantList = array[0..0] of OleVariant;
  487.  
  488.   TWillChangeFieldEvent = procedure(DataSet: TCustomADODataSet;
  489.     const FieldCount: Integer; const Fields: OleVariant;
  490.     var EventStatus: TEventStatus) of object;
  491.  
  492.   TFieldChangeCompleteEvent = procedure(DataSet: TCustomADODataSet;
  493.     const FieldCount: Integer; const Fields: OleVariant;
  494.     const Error: Error; var EventStatus: TEventStatus) of object;
  495.  
  496.   TWillChangeRecordEvent = procedure(DataSet: TCustomADODataSet;
  497.     const Reason: TEventReason; const RecordCount: Integer;
  498.     var EventStatus: TEventStatus) of object;
  499.  
  500.   TRecordChangeCompleteEvent = procedure(DataSet: TCustomADODataSet;
  501.     const Reason: TEventReason; const RecordCount: Integer;
  502.     const Error: Error; var EventStatus: TEventStatus) of object;
  503.  
  504.   TEndOfRecordsetEvent = procedure (DataSet: TCustomADODataSet;
  505.     var MoreData: WordBool; var EventStatus: TEventStatus) of object;
  506.  
  507.   TFetchProgressEvent = procedure(DataSet: TCustomADODataSet;
  508.     Progress, MaxProgress: Integer; var EventStatus: TEventStatus) of object;
  509.  
  510.   TRecordsetErrorEvent = procedure(DataSet: TCustomADODataSet;
  511.     const Reason: TEventReason; const Error: Error; var EventStatus: TEventStatus) of object;
  512.  
  513.   TRecordsetReasonEvent = procedure(DataSet: TCustomADODataSet;
  514.     const Reason: TEventReason; var EventStatus: TEventStatus) of object;
  515.  
  516.   TRecordsetEvent = procedure(DataSet: TCustomADODataSet;
  517.     const Error: Error; var EventStatus: TEventStatus) of object;
  518.  
  519.   TCustomADODataSet = class(TDataSet, IUnknown, RecordsetEventsVt)
  520.   private
  521.     FRecordsetObject: _Recordset;
  522.     FFindCursor: _Recordset;
  523.     FLookupCursor: _Recordset;
  524.     FRowset: IRowset;
  525.     FAccessor: IAccessor;
  526.     FRowsetFind: IRowsetFind;
  527.     FHAccessor: HACCESSOR;
  528.     FOleRecBufSize: Integer;
  529.     FEventsID: Integer;
  530.     FCommand: TADOCommand;
  531.     FFilterBuffer: PChar;
  532.     FRecBufSize: Integer;
  533.     FCacheSize: Integer;
  534.     FDetailFilter: string;
  535.     FIndexFieldNames: string;
  536.     FMaxRecords: Integer;
  537.     FModifiedFields: TList;
  538.     FParentRecNo: Integer;
  539.     FIndexFields: TList;
  540.     FIndexDefs: TIndexDefs;
  541.     FParams: TParams;
  542.     FIndexName: string;
  543.     FDesignerData: string;
  544.     FMasterDataLink: TMasterDataLink;
  545.     FFilterGroup: TFilterGroup;
  546.     FCursorLocation: TCursorLocation;
  547.     FCursorType: TCursorType;
  548.     FLockType: TADOLockType;
  549.     FMarshalOptions: TMarshalOption;
  550.     FRSCommandType: TCommandType;
  551.     FParentDataSet: TCustomADODataSet;
  552.     FBlockReadInfo: Pointer;
  553.     FStoreDefs: Boolean;
  554.     FEnableBCD: Boolean;
  555.     FConnectionChanged: Boolean;
  556.     FOnWillChangeField: TWillChangeFieldEvent;
  557.     FOnFieldChangeComplete: TFieldChangeCompleteEvent;
  558.     FOnWillChangeRecord: TWillChangeRecordEvent;
  559.     FOnRecordChangeComplete: TRecordChangeCompleteEvent;
  560.     FOnWillChangeRecordset: TRecordsetReasonEvent;
  561.     FOnRecordsetChangeComplete: TRecordsetErrorEvent;
  562.     FOnWillMove: TRecordsetReasonEvent;
  563.     FOnMoveComplete: TRecordsetErrorEvent;
  564.     FOnEndOfRecordset: TEndOfRecordsetEvent;
  565.     FOnFetchComplete: TRecordsetEvent;
  566.     FOnFetchProgress: TFetchProgressEvent;
  567.     function GetCacheSize: Integer;
  568.     function GetCommandText: WideString;
  569.     function GetCommandTimeout: Integer;
  570.     function GetCommandType: TCommandType;
  571.     function GetConnection: TADOConnection;
  572.     function GetConnectionString: WideString;
  573.     function GetCursorLocation: TCursorLocation;
  574.     function GetCursorType: TCursorType;
  575.     function GetExecuteOptions: TExecuteOptions;
  576.     function GetFilterGroup: TFilterGroup;
  577.     function GetIndexField(Index: Integer): TField;
  578.     function GetIndexFieldCount: Integer;
  579.     function GetIndexFieldNames: string;
  580.     function GetIndexName: string;
  581.     function GetLockType: TADOLockType;
  582.     function GetMarshalOptions: TMarshalOption;
  583.     function GetMasterFields: string;
  584.     function GetMaxRecords: Integer;
  585.     function GetParamCheck: Boolean;
  586.     function GetParameters: TParameters;
  587.     function GetPrepared: Boolean;
  588.     function GetProperties: Properties;
  589.     function GetRecordsetState: TObjectStates;
  590.     function GetRecordStatus: TRecordStatusSet;
  591.     function GetSort: WideString;
  592.     procedure PropertyChanged;
  593.     procedure ReadDesignerData(Reader: TReader);
  594.     procedure RefreshIndexFields;
  595.     procedure SetCacheSize(const Value: Integer);
  596.     procedure SetCommandText(const Value: WideString);
  597.     procedure SetCommandTimeout(const Value: Integer);
  598.     procedure SetCommandType(const Value: TCommandType);
  599.     procedure SetConnectionString(const Value: WideString);
  600.     procedure SetCursorLocation(const Value: TCursorLocation);
  601.     procedure SetCursorType(const Value: TCursorType);
  602.     procedure SetExecuteOptions(const Value: TExecuteOptions);
  603.     procedure SetFilterGroup(const Value: TFilterGroup);
  604.     procedure SetIndexField(Index: Integer; const Value: TField);
  605.     procedure SetIndexFieldNames(const Value: string);
  606.     procedure SetIndexName(const Value: string);
  607.     procedure SetLockType(const Value: TADOLockType);
  608.     procedure SetMarshalOptions(const Value: TMarshalOption);
  609.     procedure SetMasterFields(const Value: string);
  610.     procedure SetMaxRecords(const Value: Integer);
  611.     procedure SetParamCheck(const Value: Boolean);
  612.     procedure SetParameters(const Value: TParameters);
  613.     procedure SetRecordset(const Value: _Recordset);
  614.     procedure SetPrepared(const Value: Boolean);
  615.     procedure SetSort(const Value: WideString);
  616.     procedure WriteDesignerData(Writer: TWriter);
  617.   protected
  618.     { IProviderSupport }
  619.     procedure PSEndTransaction(Commit: Boolean); override;
  620.     procedure PSExecute; override;
  621.     function PSExecuteStatement(const ASQL: string; AParams: TParams;
  622.       ResultSet: Pointer = nil): Integer; override;
  623.     procedure PSGetAttributes(List: TList); override;
  624.     function PSGetDefaultOrder: TIndexDef; override;
  625.     function PSGetKeyFields: string; override;
  626.     function PSGetParams: TParams; override;
  627.     function PSGetQuoteChar: string; override;
  628.     function PSGetTableName: string; override;
  629.     function PSGetIndexDefs(IndexTypes: TIndexOptions = [ixPrimary..ixNonMaintained]): TIndexDefs; override;
  630.     function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
  631.     function PSInTransaction: Boolean; override;
  632.     function PSIsSQLBased: Boolean; override;
  633.     function PSIsSQLSupported: Boolean; override;
  634.     procedure PSReset; override;
  635.     procedure PSSetParams(AParams: TParams); override;
  636.     procedure PSSetCommandText(const CommandText: string); override;
  637.     procedure PSStartTransaction; override;
  638.     function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
  639.   protected
  640.     procedure ActivateTextFilter(const FilterText: string);
  641.     function AllocRecordBuffer: PChar; override;
  642.     procedure CheckActive; override;
  643.     procedure CheckFieldCompatibility(Field: TField; FieldDef: TFieldDef); override;
  644.     procedure ClearCalcFields(Buffer: PChar); override;
  645.     procedure DataEvent(Event: TDataEvent; Info: Longint); override;
  646.     procedure DeactivateFilters;
  647.     procedure DefChanged(Sender: TObject); override;
  648.     procedure DefineProperties(Filer: TFiler); override;
  649.     procedure DestroyLookupCursor; virtual;
  650.     procedure DoOnNewRecord; override;
  651.     procedure EnableEvents;
  652.     function FindRecord(Restart, GoForward: Boolean): Boolean; override;
  653.     procedure FreeRecordBuffer(var Buffer: PChar); override;
  654.     function GetActiveRecBuf(var RecBuf: PChar): Boolean;
  655.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  656.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  657.     function GetCanModify: Boolean; override;
  658.     function GetDataSource: TDataSource; override;
  659.     function GetRecNo: Integer; override;
  660.     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  661.     function GetRecordCount: Integer; override;
  662.     function GetRecordSize: Word; override;
  663.     function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; override;
  664.     procedure InitOleDBAccess(Initializing: Boolean);
  665.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
  666.     procedure InternalCancel; override;
  667.     procedure InternalClose; override;
  668.     procedure InternalDelete; override;
  669.     procedure InternalEdit; override;
  670.     procedure InternalFirst; override;
  671.     function InternalGetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
  672.     procedure InternalGotoBookmark(Bookmark: Pointer); override;
  673.     procedure InternalHandleException; override;
  674.     procedure InternalInitFieldDefs; override;
  675.     procedure InternalInitRecord(Buffer: PChar); override;
  676.     procedure InternalInsert; override;
  677.     procedure InternalLast; override;
  678.     procedure InternalOpen; override;
  679.     procedure InternalPost; override;
  680.     procedure InternalRefresh; override;
  681.     procedure InternalSetSort(Value: WideString);
  682.     procedure InternalSetToRecord(Buffer: PChar); override;
  683.     function IsCursorOpen: Boolean; override;
  684.     procedure Loaded; override;
  685.     function LocateRecord(const KeyFields: string; const KeyValues: OleVariant;
  686.       Options: TLocateOptions; SyncCursor: Boolean): Boolean;
  687.     procedure MasterChanged(Sender: TObject); virtual;
  688.     procedure MasterDisabled(Sender: TObject); virtual;
  689.     procedure OpenCursor(InfoQuery: Boolean); override;
  690.     procedure PrepareCursor; virtual;
  691.     procedure RefreshParams;
  692.     procedure SetBlockReadSize(Value: Integer); override;
  693.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  694.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  695.     procedure SetConnection(const Value: TADOConnection); virtual;
  696.     function SetConnectionFlag(Flag: Integer; Value: Boolean): Boolean; virtual;
  697.     procedure SetDataSource(const Value: TDataSource); virtual;
  698.     function SetDetailFilter: Boolean;
  699.     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  700.     procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); override;
  701.     procedure SetFiltered(Value: Boolean); override;
  702.     procedure SetFilterOptions(Value: TFilterOptions); override;
  703.     procedure SetFilterText(const Value: string); override;
  704.     procedure SetParamsFromCursor;
  705.     procedure SetRecNo(Value: Integer); override;
  706.     procedure UpdateIndexDefs; override;
  707.     procedure UpdateRecordSetPosition(Buffer: PChar);
  708.     property MasterDataLink: TMasterDataLink read FMasterDataLink;
  709.     property Command: TADOCommand read FCommand;
  710.     property CommandText: WideString read GetCommandText write SetCommandText;
  711.     property CommandTimeout: Integer read GetCommandTimeout write SetCommandTimeout default 30;
  712.     property CommandType: TCommandType read GetCommandType write SetCommandType default cmdText;
  713.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  714.     property FieldDefs stored FStoreDefs;
  715.     property IndexDefs: TIndexDefs read FIndexDefs write FIndexDefs;
  716.     property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
  717.     property MasterFields: string read GetMasterFields write SetMasterFields;
  718.     property ParamCheck: Boolean read GetParamCheck write SetParamCheck default True;
  719.     property Parameters: TParameters read GetParameters write SetParameters;
  720.     property Prepared: Boolean read GetPrepared write SetPrepared default False;
  721.     property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
  722.   protected
  723.     { RecordsetEvents }
  724.     function ConnectionPoint: IConnectionPoint;
  725.     procedure WillChangeField(cFields: Integer; Fields: OleVariant;
  726.       var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
  727.     procedure FieldChangeComplete(cFields: Integer; Fields: OleVariant;
  728.       const pError: Error; var adStatus: EventStatusEnum;
  729.       const pRecordset: _Recordset); safecall;
  730.     procedure WillChangeRecord(adReason: EventReasonEnum;
  731.       cRecords: Integer; var adStatus: EventStatusEnum;
  732.       const pRecordset: _Recordset); safecall;
  733.     procedure RecordChangeComplete(adReason: EventReasonEnum;
  734.       cRecords: Integer; const pError: Error;
  735.       var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
  736.     procedure WillChangeRecordset(adReason: EventReasonEnum;
  737.       var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
  738.     procedure RecordsetChangeComplete(adReason: EventReasonEnum;
  739.       const pError: Error; var adStatus: EventStatusEnum;
  740.       const pRecordset: _Recordset); safecall;
  741.     procedure WillMove(adReason: EventReasonEnum;
  742.       var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
  743.     procedure MoveComplete(adReason: EventReasonEnum; const pError: Error;
  744.       var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
  745.     procedure EndOfRecordset(var fMoreData: WordBool;
  746.       var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
  747.     procedure FetchProgress(Progress, MaxProgress: Integer;
  748.       var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
  749.     procedure FetchComplete(const pError: Error;
  750.       var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
  751.   public
  752.     constructor Create(AOwner: TComponent); override;
  753.     destructor Destroy; override;
  754.     function BookmarkValid(Bookmark: TBookmark): Boolean; override;
  755.     procedure CancelBatch(AffectRecords: TAffectRecords = arAll);
  756.     procedure CancelUpdates;
  757.     procedure Clone(Source: TCustomADODataSet; LockType: TADOLockType = ltUnspecified);
  758.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
  759.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  760.     procedure DeleteRecords(AffectRecords: TAffectRecords = arAll);
  761.     property EnableBCD: Boolean read FEnableBCD write FEnableBCD default True;
  762.     procedure FilterOnBookmarks(Bookmarks: array of const);
  763.     function GetBlobFieldData(FieldNo: Integer; var Buffer: TBlobByteData): Integer; override;
  764.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  765.     function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; override;
  766.     function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
  767.     function IsSequenced: Boolean; override;
  768.     procedure LoadFromFile(const FileName: WideString);
  769.     function Locate(const KeyFields: string; const KeyValues: Variant;
  770.       Options: TLocateOptions): Boolean; override;
  771.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  772.       const ResultFields: string): Variant; override;
  773.     function NextRecordset(var RecordsAffected: Integer): _Recordset;
  774.     procedure Requery(Options: TExecuteOptions = []);
  775.     procedure SaveToFile(const FileName: WideString = ''; Format: TPersistFormat = pfADTG);
  776.     function Seek(const KeyValues: Variant; SeekOption: TSeekOption = soFirstEQ): Boolean;
  777.     function Supports(CursorOptions: TCursorOptions): Boolean;
  778.     procedure UpdateBatch(AffectRecords: TAffectRecords = arAll);
  779.     function UpdateStatus: TUpdateStatus; override;
  780.     property DesignerData: string read FDesignerData write FDesignerData;
  781.     property IndexName: string read GetIndexName write SetIndexName;
  782.     property IndexFieldCount: Integer read GetIndexFieldCount;
  783.     property IndexFields[Index: Integer]: TField read GetIndexField write SetIndexField;
  784.     property FilterGroup: TFilterGroup read GetFilterGroup write SetFilterGroup;
  785.     property Properties: Properties read GetProperties;
  786.     property Recordset: _Recordset read FRecordsetObject write SetRecordset;
  787.     property RecordsetState: TObjectStates read GetRecordsetState;
  788.     property RecordStatus: TRecordStatusSet read GetRecordStatus;
  789.     property Sort: WideString read GetSort write SetSort;
  790.   published
  791.     property Active default False;
  792.     property AutoCalcFields;
  793.     property CacheSize: Integer read GetCacheSize write SetCacheSize default 1;
  794.     property Connection: TADOConnection read GetConnection write SetConnection;
  795.     property ConnectionString: WideString read GetConnectionString write SetConnectionString;
  796.     property CursorLocation: TCursorLocation read GetCursorLocation write SetCursorLocation default clUseClient;
  797.     property CursorType: TCursorType read GetCursorType write SetCursorType default ctKeyset;
  798.     property ExecuteOptions: TExecuteOptions read GetExecuteOptions write SetExecuteOptions default [];
  799.     property Filter;
  800.     property Filtered;
  801.     property LockType: TADOLockType read GetLockType write SetLockType default ltOptimistic;
  802.     property MarshalOptions: TMarshalOption read GetMarshalOptions write SetMarshalOptions default moMarshalAll;
  803.     property MaxRecords: Integer read GetMaxRecords write SetMaxRecords default 0;
  804.     property BeforeOpen;
  805.     property AfterOpen;
  806.     property BeforeClose;
  807.     property AfterClose;
  808.     property BeforeInsert;
  809.     property AfterInsert;
  810.     property BeforeEdit;
  811.     property AfterEdit;
  812.     property BeforePost;
  813.     property AfterPost;
  814.     property BeforeCancel;
  815.     property AfterCancel;
  816.     property BeforeDelete;
  817.     property AfterDelete;
  818.     property BeforeScroll;
  819.     property AfterScroll;
  820.     property BeforeRefresh;
  821.     property AfterRefresh;
  822.     property OnCalcFields;
  823.     property OnDeleteError;
  824.     property OnEditError;
  825.     property OnFilterRecord;
  826.     property OnNewRecord;
  827.     property OnPostError;
  828.     property OnWillChangeField: TWillChangeFieldEvent read FOnWillChangeField write FOnWillChangeField;
  829.     property OnFieldChangeComplete: TFieldChangeCompleteEvent read FOnFieldChangeComplete write FOnFieldChangeComplete;
  830.     property OnWillChangeRecord: TWillChangeRecordEvent read FOnWillChangeRecord write FOnWillChangeRecord;
  831.     property OnRecordChangeComplete: TRecordChangeCompleteEvent read FOnRecordChangeComplete write FOnRecordChangeComplete;
  832.     property OnWillChangeRecordset: TRecordsetReasonEvent read FOnWillChangeRecordset write FOnWillChangeRecordset;
  833.     property OnRecordsetChangeComplete: TRecordsetErrorEvent read FOnRecordsetChangeComplete write FOnRecordsetChangeComplete;
  834.     property OnWillMove: TRecordsetReasonEvent read FOnWillMove write FOnWillMove;
  835.     property OnMoveComplete: TRecordsetErrorEvent read FOnMoveComplete write FOnMoveComplete;
  836.     property OnEndOfRecordset: TEndOfRecordsetEvent read FOnEndOfRecordset write FOnEndOfRecordset;
  837.     property OnFetchComplete: TRecordsetEvent read FOnFetchComplete write FOnFetchComplete;
  838.     property OnFetchProgress: TFetchProgressEvent read FOnFetchProgress write FOnFetchProgress;
  839.   end;
  840.  
  841. { TADODataSet }
  842.  
  843.   TADODataSet = class(TCustomADODataSet)
  844.   private
  845.     FRDSConnection: TRDSConnection;
  846.     procedure SetRDSConnection(Value: TRDSConnection);
  847.   protected
  848.     procedure DataEvent(Event: TDataEvent; Info: Longint); override;
  849.     procedure OpenCursor(InfoQuery: Boolean); override;
  850.     procedure SetConnection(const Value: TADOConnection); override;
  851.     procedure SetDataSetField(const Value: TDataSetField); override;
  852.   public
  853.     procedure CreateDataSet;
  854.     procedure GetIndexNames(List: TStrings);
  855.     property IndexDefs;
  856.   published
  857.     property CommandText;
  858.     property CommandTimeout;
  859.     property CommandType;
  860.     property DataSetField;
  861.     property DataSource;
  862.     property EnableBCD;
  863.     property FieldDefs;
  864.     property IndexName;
  865.     property IndexFieldNames;
  866.     property MasterFields;
  867.     property ParamCheck;
  868.     property Parameters;
  869.     property Prepared;
  870.     property RDSConnection: TRDSConnection read FRDSConnection write SetRDSConnection;
  871.     property StoreDefs;
  872.     property BeforeOpen;
  873.     property AfterOpen;
  874.     property BeforeClose;
  875.     property AfterClose;
  876.     property BeforeInsert;
  877.     property AfterInsert;
  878.     property BeforeEdit;
  879.     property AfterEdit;
  880.     property BeforePost;
  881.     property AfterPost;
  882.     property BeforeCancel;
  883.     property AfterCancel;
  884.     property BeforeDelete;
  885.     property AfterDelete;
  886.     property BeforeScroll;
  887.     property AfterScroll;
  888.     property OnCalcFields;
  889.     property OnDeleteError;
  890.     property OnEditError;
  891.     property OnNewRecord;
  892.     property OnPostError;
  893.    end;
  894.  
  895. { TADOTable }
  896.  
  897.   TADOTable = class(TCustomADODataSet)
  898.   private
  899.     function GetTableDirect: Boolean;
  900.     procedure SetTableDirect(const Value: Boolean);
  901.     function GetReadOnly: Boolean;
  902.     procedure SetReadOnly(const Value: Boolean);
  903.   public
  904.     constructor Create(AOwner: TComponent); override;
  905.     procedure GetIndexNames(List: TStrings);
  906.     property IndexDefs;
  907.   published
  908.     property EnableBCD;
  909.     property IndexFieldNames;
  910.     property IndexName;
  911.     property MasterFields;
  912.     property MasterSource: TDataSource read GetDataSource write SetDataSource;
  913.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly stored False;
  914.     property TableDirect: Boolean read GetTableDirect write SetTableDirect default False;
  915.     property TableName: WideString read GetCommandText write SetCommandText;
  916.   end;
  917.  
  918. { TADOQuery }
  919.  
  920.   TADOQuery = class(TCustomADODataSet)
  921.   private
  922.     FSQL: TSTrings;
  923.     FRowsAffected: Integer;
  924.     function GetSQL: TStrings;
  925.     procedure SetSQL(const Value: TStrings);
  926.   protected
  927.     procedure QueryChanged(Sender: TObject);
  928.   public
  929.     constructor Create(AOwner: TComponent); override;
  930.     destructor Destroy; override;
  931.     function ExecSQL: Integer; {for TQuery compatibility}
  932.     property RowsAffected: Integer read FRowsAffected;
  933.   published
  934.     property DataSource;
  935.     property EnableBCD;
  936.     property ParamCheck;
  937.     property Parameters;
  938.     property Prepared;
  939.     property SQL: TStrings read GetSQL write SetSQL;
  940.   end;
  941.  
  942. { TADOStoredProc }
  943.  
  944.   TADOStoredProc = class(TCustomADODataSet)
  945.   public
  946.     constructor Create(AOwner: TComponent); override;
  947.     procedure ExecProc;
  948.   published
  949.     property DataSource;
  950.     property EnableBCD;
  951.     property ProcedureName: WideString read GetCommandText write SetCommandText;
  952.     property Parameters;
  953.     property Prepared;
  954.   end;
  955.  
  956. { TADOBlobStream }
  957.  
  958.   TADOBlobStream = class(TMemoryStream)
  959.   private
  960.     FField: TBlobField;
  961.     FDataSet: TCustomADODataSet;
  962.     FBuffer: PChar;
  963.     FFieldNo: Integer;
  964.     FModified: Boolean;
  965.     FData: Variant;
  966.     FFieldData: Variant;
  967.   protected
  968.     procedure ReadBlobData;
  969.     function Realloc(var NewCapacity: Longint): Pointer; override;
  970.   public
  971.     constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
  972.     destructor Destroy; override;
  973.     function Write(const Buffer; Count: Longint): Longint; override;
  974.     procedure Truncate;
  975.   end;
  976.  
  977. { Global Functions }
  978.  
  979. procedure CreateUDLFile(const FileName, ProviderName, DataSourceName: WideString);
  980. function DataLinkDir: string;
  981. procedure GetProviderNames(Names: TStrings);
  982. function PromptDataSource(ParentHandle: THandle; InitialString: WideString): WideString;
  983. function PromptDataLinkFile(ParentHandle: THandle; InitialFile: WideString): WideString;
  984. function GetDataLinkFiles(FileNames: TStrings; Directory: string = ''): Integer;
  985.  
  986. implementation
  987.  
  988. uses
  989.   DBCommon, DBLogDlg, Forms, MTX, OleCtrls, DBConsts, ComObj, ADOConst;
  990.  
  991. type  
  992.   PRecInfo = ^TRecInfo;
  993.   TRecInfo = packed record
  994.     Bookmark: OleVariant;
  995.     BookmarkFlag: TBookmarkFlag;
  996.     RecordStatus: Integer;
  997.     RecordNumber: Integer;
  998.   end;
  999.  
  1000. const
  1001.   { Connection Flags }
  1002.   cfOpen       = 1;
  1003.   cfExecute    = 2;
  1004.   cfIndex      = 3;
  1005.   cfParameters = 4;
  1006.   cfProvider   = 5;
  1007.   
  1008.   bfNA = TBookmarkFlag(Ord(High(TBookmarkFlag)) + 1);
  1009.   RSOnlyCommandTypes = [cmdTableDirect, cmdFile]; { Command Types valid only in RecordSet.Open calls }
  1010.  
  1011. var
  1012.   GlobalMalloc: IMalloc;
  1013.  
  1014. { Enum Mappings }
  1015.  
  1016. const
  1017.   CommandTypeValues: array[TCommandType] of TOleEnum = (adCmdUnknown,
  1018.     adCmdText, adCmdTable, adCmdStoredProc, adCmdFile, adCmdTableDirect);
  1019.  
  1020.   ConnectModeValues: array[TConnectMode] of TOleEnum = (adModeUnknown,
  1021.     adModeRead, adModeWrite, adModeReadWrite, adModeShareDenyRead,
  1022.     adModeShareDenyWrite, adModeShareExclusive, adModeShareDenyNone);
  1023.  
  1024.   ConnectOptionValues: array[TConnectOption] of TOleEnum = (adConnectUnspecified,
  1025.     adAsyncConnect);
  1026.  
  1027.   CursorLocationValues: array[TCursorLocation] of TOleEnum = (adUseServer, adUseClient);
  1028.  
  1029.   CursorOptionValues: array[TCursorOption] of TOleEnum = (adHoldRecords,
  1030.     adMovePrevious, adAddNew, adDelete, adUpdate, adBookmark, adApproxPosition,
  1031.     adUpdateBatch, adResync, adNotify, adFind, adSeek, adIndex);
  1032.  
  1033.   CursorTypeValues: array[TCursorType] of TOleEnum = (adOpenUnspecified,
  1034.     adOpenForwardOnly, adOpenKeyset, adOpenDynamic, adOpenStatic);
  1035.  
  1036.   DataTypeValues: array[TDataType] of TOleEnum = (
  1037.     adEmpty, adVarChar, adSmallint, adInteger, adUnsignedSmallint,
  1038.     adBoolean, adDouble, adDouble, adCurrency, adDBDate, adDBTime,
  1039.     adDBTimeStamp, adBinary, adVarBinary, adInteger, adLongVarBinary,
  1040.     adLongVarChar, adLongVarBinary, adLongVarBinary, adLongVarBinary,
  1041.     adLongVarBinary, adLongVarBinary, adEmpty, adChar, adChar, adBigInt,
  1042.     adEmpty, adEmpty, adEmpty, adEmpty, adEmpty, adEmpty, adVariant,
  1043.     adIUnknown, adIDispatch, adGuid
  1044.     );
  1045.  
  1046.   EventReasonValues: array[TEventReason] of TOleEnum = (adRsnAddNew,
  1047.     adRsnDelete, adRsnUpdate, adRsnUndoUpdate, adRsnUndoAddNew, adRsnUndoDelete,
  1048.     adRsnRequery, adRsnResynch, adRsnClose, adRsnMove, adRsnFirstChange,
  1049.     adRsnMoveFirst, adRsnMoveNext, adRsnMovePrevious, adRsnMoveLast);
  1050.  
  1051.   EventStatusValues: array[TEventStatus] of TOleEnum = (adStatusOK,
  1052.     adStatusErrorsOccurred, adStatusCantDeny, adStatusCancel,
  1053.     adStatusUnwantedEvent);
  1054.  
  1055.   ExecuteOptionValues: array[TExecuteOption] of TOleEnum = (adAsyncExecute,
  1056.     adAsyncFetch, adAsyncFetchNonBlocking, adExecuteNoRecords);
  1057.  
  1058.   FilterGroupValues: array[TFilterGroup] of TOleEnum = (-1 {Unassigned},
  1059.     adFilterNone, adFilterPendingRecords, adFilterAffectedRecords,
  1060.     adFilterFetchedRecords, adFilterPredicate, adFilterConflictingRecords);
  1061.  
  1062.   IsolationLevelValues: array[TIsolationLevel] of TOleEnum = (adXactUnspecified,
  1063.     adXactChaos, adXactReadUncommitted, adXactBrowse, adXactCursorStability,
  1064.     adXactReadCommitted, adXactRepeatableRead, adXactSerializable,
  1065.     adXactIsolated);
  1066.  
  1067.   LockTypeValues: array[TADOLockType] of TOleEnum = (adLockUnspecified,
  1068.     adLockReadOnly, adLockPessimistic, adLockOptimistic,
  1069.     adLockBatchOptimistic);
  1070.  
  1071.   MarshalOptionValues: array[TMarshalOption] of TOleEnum = (adMarshalAll,
  1072.     adMarshalModifiedOnly);
  1073.     
  1074.   ObjectStateValues: array[TObjectState] of TOleEnum = (adStateClosed,
  1075.     adStateOpen, adStateConnecting, adStateExecuting, adStateFetching);
  1076.  
  1077.   ParameterAttributeValues: array[TParameterAttribute] of TOleEnum =
  1078.     (adParamSigned, adParamNullable, adParamLong);
  1079.  
  1080.   ParameterDirectionValues: array[TParameterDirection] of TOleEnum =
  1081.     (adParamUnknown, adParamInput, adParamOutput, adParamInputOutput,
  1082.      adParamReturnValue);
  1083.  
  1084.   RecordStatusValues: array[TRecordStatus] of TOleEnum = (adRecOK, adRecNew,
  1085.     adRecModified, adRecDeleted, adRecUnmodified, adRecInvalid,
  1086.     adRecMultipleChanges, adRecPendingChanges, adRecCanceled, adRecCantRelease,
  1087.     adRecConcurrencyViolation, adRecIntegrityViolation, adRecMaxChangesExceeded,
  1088.     adRecObjectOpen, adRecOutOfMemory, adRecPermissionDenied,
  1089.     adRecSchemaViolation, adRecDBDeleted);
  1090.  
  1091.   SeekOptionValues: array[TSeekOption] of TOleEnum = (adSeekFirstEQ,
  1092.     adSeekLastEQ, adSeekAfterEQ, adSeekAfter, adSeekBeforeEQ, adSeekBefore);
  1093.  
  1094.   AffectRecordsValues: array[TAffectRecords] of TOleEnum =
  1095.     (adAffectCurrent, adAffectGroup, adAffectAll, adAffectAllChapters);
  1096.  
  1097.   XactAttributeValues: array[TXactAttribute] of TOleEnum = (adXactCommitRetaining,
  1098.     adXactAbortRetaining);
  1099.  
  1100. { Utility Functions }
  1101.  
  1102. function CreateADOObject(const ClassID: TGUID): IUnknown;
  1103. var
  1104.   Status: HResult;
  1105.   FPUControlWord: Word;
  1106. begin
  1107.   asm
  1108.     FNSTCW  FPUControlWord
  1109.   end;
  1110.   Status := CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
  1111.     CLSCTX_LOCAL_SERVER, IUnknown, Result);
  1112.   asm
  1113.     FNCLEX
  1114.     FLDCW FPUControlWord
  1115.   end;
  1116.   if (Status = REGDB_E_CLASSNOTREG) then
  1117.     raise Exception.CreateRes(@SADOCreateError) else
  1118.     OleCheck(Status);
  1119. end;
  1120.  
  1121. function ADOTypeToFieldType(const ADOType: DataTypeEnum; EnableBCD: Boolean = True): TFieldType;
  1122. begin
  1123.   case ADOType of
  1124.     adEmpty: Result := ftUnknown;
  1125.     adTinyInt, adSmallInt: Result := ftSmallint;
  1126.     adError, adInteger, adUnsignedInt: Result := ftInteger;
  1127.     adBigInt, adUnsignedBigInt: Result := ftLargeInt;
  1128.     adUnsignedTinyInt, adUnsignedSmallInt: Result := ftWord;
  1129.     adSingle, adDouble: Result := ftFloat;
  1130.     adCurrency: Result := ftBCD;
  1131.     adBoolean: Result := ftBoolean;
  1132.     adDate, adDBDate: Result := ftDate;
  1133.     adDBTime: Result := ftTime;
  1134.     adDBTimeStamp, adFileTime, adDBFileTime: Result := ftDateTime;
  1135.     adChar, adVarChar: Result := ftString;
  1136.     adBSTR, adWChar, adVarWChar: Result := ftWideString;
  1137.     adLongVarChar, adLongVarWChar: Result := ftMemo;
  1138.     adLongVarBinary: Result := ftBlob;
  1139.     adBinary: Result := ftBytes;
  1140.     adVarBinary: Result := ftVarBytes;
  1141.     adChapter: Result := ftDataSet;
  1142.     adPropVariant, adVariant: Result := ftVariant;
  1143.     adIUnknown: Result := ftInterface;
  1144.     adIDispatch: Result := ftIDispatch;
  1145.     adGUID: Result := ftGUID;
  1146.     adDecimal, adNumeric, adVarNumeric:
  1147.       if EnableBCD then Result := ftBCD
  1148.       else Result := ftFloat;
  1149.   else
  1150.     Result := ftUnknown;
  1151.   end;
  1152. end;
  1153.  
  1154. function FieldTypeToADOType(const FieldType: TFieldType): DataTypeEnum;
  1155. begin
  1156.   case FieldType of
  1157.     ftUnknown: Result := adEmpty;
  1158.     ftString, ftWideString: Result := adVarChar;
  1159.     ftSmallint: Result := adSmallint;
  1160.     ftInteger, ftAutoInc: Result := adInteger;
  1161.     ftWord: Result := adUnsignedSmallInt;
  1162.     ftBoolean: Result := adBoolean;
  1163.     ftFloat: Result := adDouble;
  1164.     ftCurrency, ftBCD: Result := adCurrency;
  1165.     ftDate: Result := adDBDate;
  1166.     ftTime: Result := adDBTime;
  1167.     ftDateTime: Result := adDBTimeStamp;
  1168.     ftBytes: Result := adBinary;
  1169.     ftVarBytes: Result := adVarBinary;
  1170.     ftMemo: Result := adLongVarChar;
  1171.     ftBlob, ftGraphic..ftTypedBinary: Result := adLongVarBinary;
  1172.     ftFixedChar: Result := adChar;
  1173.     ftLargeint: Result := adBigInt;
  1174.     ftVariant: Result := adVariant;
  1175.     ftInterface: Result := adIUnknown;
  1176.     ftIDispatch: Result := adIDispatch;
  1177.     ftGuid: Result := adGUID;
  1178.   else
  1179.     DatabaseErrorFmt(SNoMatchingADOType, [FieldTypeNames[FieldType]]);
  1180.     Result := adEmpty;
  1181.   end;
  1182. end;
  1183.  
  1184. function StripVarByteLenPrefix(const Value: Variant): Variant;
  1185. var
  1186.   PSource, PDest: Pointer;
  1187.   Size: Word;
  1188. begin
  1189.   if VarIsNull(Value) then
  1190.     Result := Null
  1191.   else
  1192.   begin
  1193.     PSource := VarArrayLock(Value);
  1194.     try
  1195.       Size := PWord(PSource)^;
  1196.       { Verify the length prefix is valid before trying to strip it }
  1197.       if Size < VarArrayHighBound(Value, 1)  then
  1198.       begin
  1199.         Result := VarArrayCreate([0, Size-1], varByte);
  1200.         PDest := VarArrayLock(Result);
  1201.         try
  1202.           Move((PChar(PSource)+2)^, PDest^, Size);
  1203.         finally
  1204.           VarArrayUnlock(Result);
  1205.         end;
  1206.       end else
  1207.         Result := Value;
  1208.     finally
  1209.       VarArrayUnlock(Value);
  1210.     end;
  1211.   end;
  1212. end;
  1213.  
  1214. function StringToVarArray(const Value: string): OleVariant;
  1215. var
  1216.   PData: Pointer;
  1217.   Size: Integer;
  1218. begin
  1219.   Size := Length(Value);
  1220.   Result := VarArrayCreate([0, Size-1], varByte);
  1221.   PData := VarArrayLock(Result);
  1222.   try
  1223.     Move(Pointer(Value)^, PData^, Size);
  1224.   finally
  1225.     VarArrayUnlock(Result);
  1226.   end;
  1227. end;
  1228.  
  1229. function VarDataSize(const Value: OleVariant): Integer;
  1230. begin
  1231.   if VarIsNull(Value) then
  1232.     Result := -1
  1233.   else if VarIsArray(Value) then
  1234.     Result := VarArrayHighBound(Value, 1) + 1
  1235.   else if TVarData(Value).VType = varOleStr then
  1236.     Result := Length(PWideString(@TVarData(Value).VOleStr)^)
  1237.   else
  1238.     Result := SizeOf(OleVariant);
  1239. end;
  1240.  
  1241. function OleEnumToOrd(OleEnumArray: array of TOleEnum; Value: TOleEnum): Integer;
  1242. begin
  1243.   for Result := Low(OleEnumArray) to High(OleEnumArray) do
  1244.     if Value = OleEnumArray[Result] then Exit;
  1245.   raise EADOError.CreateRes(@SInvalidEnumValue);
  1246. end;
  1247.  
  1248. function GetStates(State: Integer): TObjectStates;
  1249. var
  1250.   Os: TObjectState;
  1251. begin
  1252.   Result := [];
  1253.   for Os := stOpen to High(TObjectState) do
  1254.     if (ObjectStateValues[Os] and State) <> 0 then
  1255.       Include(Result, Os);
  1256.   if Result = [] then Result := [stClosed];
  1257. end;
  1258.  
  1259. function ExecuteOptionsToOrd(ExecuteOptions: TExecuteOptions): Integer;
  1260. var
  1261.   Eo: TExecuteOption;
  1262. begin
  1263.   Result := 0;
  1264.   if ExecuteOptions <> [] then
  1265.     for Eo := Low(TExecuteOption) to High(TExecuteOption) do
  1266.       if Eo in ExecuteOptions then
  1267.         Inc(Result, ExecuteOptionValues[Eo]);
  1268. end;
  1269.  
  1270. function OrdToExecuteOptions(Options: Integer): TExecuteOptions;
  1271. var
  1272.   Eo: TExecuteOption;
  1273. begin
  1274.   Result := [];
  1275.   if Options <> 0 then
  1276.     for Eo := Low(TExecuteOption) to High(TExecuteOption) do
  1277.       if (ExecuteOptionValues[Eo] and Options) <> 0 then
  1278.         Include(Result, Eo);
  1279. end;
  1280.  
  1281. function ExtractFieldName(const Fields: WideString; var Pos: Integer): WideString;
  1282. var
  1283.   I: Integer;
  1284. begin
  1285.   I := Pos;
  1286.   while (I <= Length(Fields)) and (Fields[I] <> ';') do Inc(I);
  1287.   Result := Copy(Fields, Pos, I - Pos);
  1288.   if (I <= Length(Fields)) and (Fields[I] = ';') then Inc(I);
  1289.   Pos := I;
  1290. end;
  1291.  
  1292. function GetFilterStr(Field: TField; Value: Variant; Partial: Boolean = False): string;
  1293. var
  1294.   Operator,
  1295.   FieldName,
  1296.   QuoteCh: string;
  1297. begin
  1298.   QuoteCh := '';
  1299.   Operator := '=';
  1300.   FieldName := Field.FieldName;
  1301.   if Pos(' ', FieldName) > 0 then
  1302.     FieldName := Format('[%s]', [FieldName]);
  1303.   if VarIsNull(Value) then
  1304.     Value := 'Null'
  1305.   else
  1306.     case Field.DataType of
  1307.       ftDate, ftTime, ftDateTime:
  1308.         QuoteCh := '#';
  1309.       ftString, ftFixedChar, ftWideString:
  1310.         begin
  1311.           if Partial then
  1312.           begin
  1313.             Value := Value + '*';
  1314.             Operator := ' like ';
  1315.           end;
  1316.           if Pos('''', Value) > 0 then
  1317.             QuoteCh := '#' else
  1318.             QuoteCh := '''';
  1319.         end;
  1320.     end;
  1321.   Result := Format('(%s%s%s%s%2:s)', [FieldName, Operator, QuoteCh, VarToStr(Value)]);
  1322. end;
  1323.  
  1324. function PropertyExists(const PropList: ADOInt.Properties; const PropName: WideString): Boolean;
  1325. var
  1326.   I: Integer;
  1327. begin
  1328.   for I := PropList.Count - 1  downto 0 do
  1329.     if PropList[I].Name = PropName then
  1330.     begin
  1331.       Result := True;
  1332.       Exit;
  1333.     end;
  1334.   Result := False;
  1335. end;
  1336.  
  1337. function PropertyEquals(const PropCollection: Properties; const Name: WideString;
  1338.   const Value: OleVariant): Boolean;
  1339. var
  1340.   I: Integer;
  1341. begin
  1342.   for I := 0 to PropCollection.Count - 1 do
  1343.   begin
  1344.     if PropCollection[I].Name = Name then
  1345.     begin
  1346.       Result := PropCollection[I].Value = Value;
  1347.       Exit;
  1348.     end;
  1349.   end;
  1350.   Result := False;
  1351. end;
  1352.  
  1353. { Public Global Functions }
  1354.  
  1355. procedure CreateUDLFile(const FileName, ProviderName, DataSourceName: WideString);
  1356. const
  1357.   ConnStrTemplate = 'Provider=%s;Data Source=%s'; { Do not localize }
  1358. var
  1359.   ConnStr: WideString;
  1360.   DataInit: IDataInitialize;
  1361. begin
  1362.   DataInit := CreateComObject(CLSID_DataLinks) as IDataInitialize;
  1363.   ConnStr := Format(ConnStrTemplate, [ProviderName, DataSourceName]);
  1364.   OleCheck(DataInit.WriteStringToStorage(PWideChar(FileName),
  1365.               PWideChar(ConnStr), CREATE_NEW));
  1366. end;
  1367.  
  1368. procedure GetProviderNames(Names: TStrings);
  1369. var
  1370.   RSCon: ADORecordsetConstruction;
  1371.   Rowset: IRowset;
  1372.   SourcesRowset: ISourcesRowset;
  1373.   SourcesRecordset: _Recordset;
  1374.   SourcesName, SourcesType: TField;
  1375. begin
  1376.   SourcesRecordset := CreateADOObject(CLASS_Recordset) as _Recordset;
  1377.   RSCon := SourcesRecordset as ADORecordsetConstruction;
  1378.   SourcesRowset := CreateComObject(CLSID_OLEDB_ENUMERATOR) as ISourcesRowset;
  1379.   OleCheck(SourcesRowset.GetSourcesRowset(nil, IRowset, 0, nil, IUnknown(Rowset)));
  1380.   RSCon.Rowset := RowSet;
  1381.   with TADODataSet.Create(nil) do
  1382.   try
  1383.     Recordset := SourcesRecordset;
  1384.     First;
  1385.     SourcesName := FieldByName('SOURCES_NAME'); { do not localize }
  1386.     SourcesType := FieldByName('SOURCES_TYPE'); { do not localize }
  1387.     Names.BeginUpdate;
  1388.     try
  1389.       while not EOF do
  1390.       begin
  1391.         if SourcesType.AsInteger = DBSOURCETYPE_DATASOURCE then
  1392.           Names.Add(SourcesName.AsString);
  1393.         Next;
  1394.       end;
  1395.     finally
  1396.       Names.EndUpdate;
  1397.     end;
  1398.   finally
  1399.     Free;
  1400.   end;
  1401. end;
  1402.  
  1403. function PromptDataSource(ParentHandle: THandle; InitialString: WideString): WideString;
  1404. var
  1405.   DataInit: IDataInitialize;
  1406.   DBPrompt: IDBPromptInitialize;
  1407.   DataSource: IUnknown;
  1408.   InitStr: PWideChar;
  1409. begin
  1410.   Result := InitialString;
  1411.   DataInit := CreateComObject(CLSID_DataLinks) as IDataInitialize;
  1412.   if InitialString <> '' then
  1413.     DataInit.GetDataSource(nil, CLSCTX_INPROC_SERVER,
  1414.       PWideChar(InitialString), IUnknown, DataSource);
  1415.   DBPrompt := CreateComObject(CLSID_DataLinks) as IDBPromptInitialize;
  1416.   if Succeeded(DBPrompt.PromptDataSource(nil, ParentHandle,
  1417.     DBPROMPTOPTIONS_PROPERTYSHEET, 0, nil, nil, IUnknown, DataSource)) then
  1418.   begin
  1419.     InitStr := nil;
  1420.     DataInit.GetInitializationString(DataSource, True, InitStr);
  1421.     Result := InitStr;
  1422.   end;
  1423. end;
  1424.  
  1425. function PromptDataLinkFile(ParentHandle: THandle; InitialFile: WideString): WideString;
  1426. var
  1427.   SelectedFile: PWideChar;
  1428.   InitialDir: WideString;
  1429.   DBPrompt: IDBPromptInitialize;
  1430. begin
  1431.   Result := InitialFile;
  1432.   DBPrompt := CreateComObject(CLSID_DataLinks) as IDBPromptInitialize;
  1433.   if InitialFile <> '' then
  1434.     InitialDir := ExtractFilePath(InitialFile);
  1435.     InitialFile := '*.udl';
  1436.   if Succeeded(DBPrompt.PromptFileName(ParentHandle, 0, Pointer(InitialDir),
  1437.      Pointer(InitialFile), SelectedFile)) then
  1438.     Result := SelectedFile;
  1439. end;
  1440.  
  1441. function DataLinkDir: string;
  1442. const
  1443.   CVMASKKEY  = 'SOFTWARE\Microsoft\Windows\CurrentVersion';
  1444.   COMMONFILESDIR = 'CommonFilesDir';
  1445.   DLDRELATIVE = '\System\OLE DB\Data Links';
  1446. var
  1447.   Buffer: array[0..MAX_PATH] of Char;
  1448.   phkResult: HKEY;
  1449.   DataSize: Longint;
  1450. begin
  1451.   Result := '';
  1452.   if RegOpenKeyEx(HKEY_LOCAL_MACHINE, CVMASKKEY, 0, KEY_QUERY_VALUE, phkResult) = 0 then
  1453.   try
  1454.     DataSize := Sizeof(Buffer);
  1455.     if RegQueryValueEx(phkResult, COMMONFILESDIR, nil,  nil, @Buffer, @DataSize) = ERROR_SUCCESS then
  1456.       Result := string(Buffer) + DLDRELATIVE;
  1457.   finally
  1458.     RegCloseKey(phkResult);
  1459.   end;
  1460. end;
  1461.  
  1462. function GetDataLinkFiles(FileNames: TStrings; Directory: string = ''): Integer;
  1463. const
  1464.   FileMask = '\*.udl';
  1465. var
  1466.   Status: Integer;
  1467.   SearchRec: TSearchRec;
  1468. begin
  1469.   with FileNames do
  1470.   begin
  1471.     BeginUpdate;
  1472.     try
  1473.       Clear;
  1474.       if Directory = '' then Directory := DataLinkDir;
  1475.       Status := FindFirst(Directory+FileMask, faAnyFile, SearchRec);
  1476.       while Status = 0 do
  1477.       begin
  1478.         if (SearchRec.Attr and faDirectory) = 0 then
  1479.           Add(SearchRec.Name);
  1480.         Status := FindNext(SearchRec);
  1481.       end;
  1482.       FindClose(SearchRec);
  1483.     finally
  1484.       EndUpdate;
  1485.     end;
  1486.   end;
  1487.   Result := FileNames.Count;
  1488. end;
  1489.  
  1490. { TADOConnection }
  1491.  
  1492. constructor TADOConnection.Create(AOwner: TComponent);
  1493. begin
  1494.   inherited Create(AOwner);
  1495.   FConnectionObject := CreateADOObject(CLASS_Connection) as _Connection;
  1496.   OleCheck(ConnectionPoint.Advise(Self as IUnknown, FConnEventsID));
  1497.   FCommands := TList.Create;
  1498.   LoginPrompt := True;
  1499.   FIsolationLevel := ilCursorStability;
  1500.   CursorLocation := clUseClient;
  1501.   FKeepConnection := True;
  1502. end;
  1503.  
  1504. destructor TADOConnection.Destroy;
  1505. begin
  1506.   Destroying;
  1507.   Close;
  1508.   ClearRefs;
  1509.   FreeAndNil(FCommands);
  1510.   if FConnEventsID > 0 then
  1511.     OleCheck(ConnectionPoint.UnAdvise(FConnEventsID));
  1512.   FConnEventsID := 0;
  1513.   FConnectionObject := nil;
  1514.   inherited Destroy;
  1515. end;
  1516.  
  1517. procedure TADOConnection.Loaded;
  1518. begin
  1519.   try
  1520.     inherited Loaded;
  1521.   except
  1522.     { Need to trap any exceptions opening while we are loading here }
  1523.     Application.HandleException(Self)
  1524.   end;
  1525. end;
  1526.  
  1527. procedure TADOConnection.CheckActive;
  1528. begin
  1529.   if Connected then Exit;
  1530.   Open;
  1531.   WaitForConnectComplete;
  1532. end;
  1533.  
  1534. procedure TADOConnection.CheckInactive;
  1535. begin
  1536.   { At design time, force connection to be closed as needed }
  1537.   if Connected and (csDesigning in ComponentState) then
  1538.     Close;
  1539. end;
  1540.  
  1541. procedure TADOConnection.ClearRefs;
  1542. begin
  1543.   if Assigned(FCommands) then
  1544.     while FCommands.Count > 0 do
  1545.       TADOCommand(FCommands[0]).Connection := nil;
  1546.   while DataSetCount > 0 do
  1547.     DataSets[0].Connection := nil;
  1548. end;
  1549.  
  1550. function TADOConnection.BeginTrans: Integer;
  1551. begin
  1552.   Result := ConnectionObject.BeginTrans;
  1553.   FTransactionLevel := Result;
  1554. end;
  1555.  
  1556. procedure TADOConnection.CommitTrans;
  1557. begin
  1558.   ConnectionObject.CommitTrans;
  1559.   if FTransactionLevel > 0 then Dec(FTransactionLevel);
  1560.   CheckDisconnect;
  1561. end;
  1562.  
  1563. procedure TADOConnection.RollbackTrans;
  1564. begin
  1565.   ConnectionObject.RollbackTrans;
  1566.   if FTransactionLevel > 0 then Dec(FTransactionLevel);
  1567.   CheckDisconnect;
  1568. end;
  1569.  
  1570. procedure TADOConnection.Cancel;
  1571. begin
  1572.   ConnectionObject.Cancel;
  1573. end;
  1574.  
  1575. procedure TADOConnection.WaitForConnectComplete;
  1576. begin
  1577.   if Assigned(ConnectionObject) then
  1578.     while (ConnectionObject.State = adStateConnecting) do
  1579.       Application.ProcessMessages;
  1580. end;
  1581.  
  1582. procedure TADOConnection.DoConnect;
  1583. begin
  1584.   ConnectionObject.Open(ConnectionObject.ConnectionString, FUserID, FPassword,
  1585.     ConnectOptionValues[FConnectOptions]);
  1586.   if FDefaultDatabase <> '' then
  1587.     ConnectionObject.DefaultDatabase := FDefaultDatabase;
  1588. end;
  1589.  
  1590. procedure TADOConnection.DoDisconnect;
  1591. begin
  1592.   if Assigned(ConnectionObject) then
  1593.   begin
  1594.     while InTransaction do RollbackTrans;
  1595.     ConnectionObject.Close;
  1596.   end;
  1597. end;
  1598.  
  1599. procedure TADOConnection.CheckDisconnect;
  1600. var
  1601.   I: Integer;
  1602. begin
  1603.   if Connected and not (KeepConnection or InTransaction or (csLoading in ComponentState)) then
  1604.   begin
  1605.     for I := 0 to DataSetCount - 1 do
  1606.       if (DataSets[I].State <> dsInActive) then Exit;
  1607.     Close;
  1608.   end;
  1609. end;
  1610.  
  1611. procedure TADOConnection.Execute(const CommandText: WideString;
  1612.   var RecordsAffected: Integer; const ExecuteOptions: TExecuteOptions = [eoExecuteNoRecords]);
  1613. var
  1614.   VarRecsAffected: OleVariant;
  1615. begin
  1616.   CheckActive;
  1617.   ConnectionObject.Execute(CommandText, VarRecsAffected,
  1618.     adCmdText+ExecuteOptionsToOrd(ExecuteOptions));
  1619.   RecordsAffected := VarRecsAffected;
  1620. end;
  1621.  
  1622. function TADOConnection.Execute(const CommandText: WideString;
  1623.   const CommandType: TCommandType = cmdText;
  1624.   const ExecuteOptions: TExecuteOptions = []): _Recordset;
  1625. var
  1626.   VarRecsAffected: OleVariant;
  1627. begin
  1628.   CheckActive;
  1629.   Result := ConnectionObject.Execute(CommandText, VarRecsAffected,
  1630.     CommandTypeValues[CommandType]+ExecuteOptionsToOrd(ExecuteOptions));
  1631. end;
  1632.  
  1633. procedure TADOConnection.Open(const UserID, Password: WideString);
  1634. begin
  1635.   FUserID := UserID;
  1636.   FPassword := Password;
  1637.   try
  1638.     SetConnected(True);
  1639.   finally
  1640.     FUserID := '';
  1641.     FPassword := '';
  1642.   end;
  1643. end;
  1644.  
  1645. procedure TADOConnection.OpenSchema(const Schema: TSchemaInfo;
  1646.   const Restrictions, SchemaID: OleVariant; DataSet: TADODataSet);
  1647. var
  1648.   SchemaOrd: TOleEnum;
  1649. begin
  1650.   CheckActive;
  1651.   if Schema = siProviderSpecific then
  1652.     SchemaOrd := adSchemaProviderSpecific else
  1653.     SchemaOrd := SchemaEnum(Schema);
  1654.   DataSet.Recordset := ConnectionObject.OpenSchema(SchemaOrd, Restrictions,
  1655.     SchemaID);
  1656. end;
  1657.  
  1658. procedure TADOConnection.GetProcedureNames(List: TStrings);
  1659. var
  1660.   NameField: TField;
  1661.   DataSet: TADODataSet;
  1662. begin
  1663.   CheckActive;
  1664.   DataSet := TADODataSet.Create(nil);
  1665.   try
  1666.     OpenSchema(siProcedures, EmptyParam, EmptyParam, DataSet);
  1667.     NameField := DataSet.FieldByName('PROCEDURE_NAME'); { do not localize }
  1668.     while not DataSet.EOF do
  1669.     begin
  1670.       List.Add(NameField.AsString);
  1671.       DataSet.Next;
  1672.     end;
  1673.   finally
  1674.     DataSet.Free;
  1675.   end;
  1676. end;
  1677.  
  1678. procedure TADOConnection.GetFieldNames(const TableName: string;
  1679.   List: TStrings);
  1680. const
  1681.   COLUMN_NAME = 'COLUMN_NAME'; { Do not localize }
  1682. var
  1683.   Fields: _Recordset;
  1684. begin
  1685.   CheckActive;
  1686.   Fields := ConnectionObject.OpenSchema(adSchemaColumns, VarArrayOf([Null, Null, TableName]),
  1687.     EmptyParam);
  1688.   with List do
  1689.   begin
  1690.     BeginUpdate;
  1691.     try
  1692.       Clear;
  1693.       while not Fields.EOF do
  1694.       begin
  1695.         Add(VarToStr(Fields.Fields[COLUMN_NAME].Value));
  1696.         Fields.MoveNext;
  1697.       end;
  1698.     finally
  1699.       EndUpdate;
  1700.     end;
  1701.   end;
  1702. end;
  1703.  
  1704. procedure TADOConnection.GetTableNames(List: TStrings;
  1705.   SystemTables: Boolean);
  1706. var
  1707.   TypeField,
  1708.   NameField: TField;
  1709.   DataSet: TADODataSet;
  1710. begin
  1711.   CheckActive;
  1712.   DataSet := TADODataSet.Create(nil);
  1713.   try
  1714.     OpenSchema(siTables, EmptyParam, EmptyParam, DataSet);
  1715.     TypeField := DataSet.FieldByName('TABLE_TYPE'); { do not localize }
  1716.     NameField := DataSet.FieldByName('TABLE_NAME'); { do not localize }
  1717.     List.BeginUpdate;
  1718.     try
  1719.       List.Clear;
  1720.       while not DataSet.EOF do
  1721.       begin
  1722.         if (TypeField.AsString = 'TABLE') or (SystemTables and { do not localize }
  1723.            (TypeField.AsString = 'SYSTEM TABLE')) then         { do not localize }
  1724.           List.Add(NameField.AsString);
  1725.         DataSet.Next;
  1726.       end;
  1727.     finally
  1728.       List.EndUpdate;
  1729.     end;
  1730.   finally
  1731.     DataSet.Free;
  1732.   end;
  1733. end;
  1734.  
  1735. { ConnectionEvents }
  1736.  
  1737. function TADOConnection.ConnectionPoint: IConnectionPoint;
  1738. var
  1739.   ConnPtContainer: IConnectionPointContainer;
  1740. begin
  1741.   OleCheck(ConnectionObject.QueryInterface(IConnectionPointContainer,
  1742.     ConnPtContainer));
  1743.   OleCheck(ConnPtContainer.FindConnectionPoint(ConnectionEvents, Result));
  1744. end;
  1745.  
  1746. procedure TADOConnection.BeginTransComplete(TransactionLevel: Integer;
  1747.   const pError: Error; var adStatus: EventStatusEnum;
  1748.   const pConnection: _Connection);
  1749. var
  1750.   EventStatus: TEventStatus;
  1751. begin
  1752.   if Assigned(FOnBeginTransComplete) then
  1753.   begin
  1754.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  1755.     FOnBeginTransComplete(Self, TransactionLevel, pError, EventStatus);
  1756.     adStatus := EventStatusValues[EventStatus];
  1757.   end;
  1758. end;
  1759.  
  1760. procedure TADOConnection.CommitTransComplete(const pError: Error;
  1761.   var adStatus: EventStatusEnum; const pConnection: _Connection);
  1762. var
  1763.   EventStatus: TEventStatus;
  1764. begin
  1765.   if Assigned(FOnCommitTransComplete) then
  1766.   begin
  1767.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  1768.     FOnCommitTransComplete(Self, pError, EventStatus);
  1769.     adStatus := EventStatusValues[EventStatus];
  1770.   end;
  1771. end;
  1772.  
  1773. procedure TADOConnection.ConnectComplete(const pError: Error;
  1774.   var adStatus: EventStatusEnum; const pConnection: _Connection);
  1775. var
  1776.   EventStatus: TEventStatus;
  1777. begin
  1778.   if Assigned(FOnConnectComplete) then
  1779.   begin
  1780.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  1781.     FOnConnectComplete(Self, pError, EventStatus);
  1782.     adStatus := EventStatusValues[EventStatus];
  1783.   end;
  1784. end;
  1785.  
  1786. procedure TADOConnection.Disconnect(var adStatus: EventStatusEnum;
  1787.   const pConnection: _Connection);
  1788. var
  1789.   I: Integer;
  1790.   EventStatus: TEventStatus;
  1791. begin
  1792.   if Assigned(FOnDisconnect) then
  1793.   begin
  1794.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  1795.     FOnDisconnect(Self, EventStatus);
  1796.     adStatus := EventStatusValues[EventStatus];
  1797.   end;
  1798.   for I := 0 to DataSetCount - 1 do
  1799.     with DataSets[I] do
  1800.       if stClosed in RecordsetState then Close;
  1801. end;
  1802.  
  1803. procedure TADOConnection.ExecuteComplete(RecordsAffected: Integer;
  1804.   const pError: Error; var adStatus: EventStatusEnum;
  1805.   const pCommand: _Command; const pRecordset: _Recordset;
  1806.   const pConnection: _Connection);
  1807.  
  1808.   procedure CheckForAsyncExecute;
  1809.   var
  1810.     I: Integer;
  1811.   begin
  1812.     try
  1813.       if not Assigned(pError) and Assigned(pRecordset) and
  1814.          ((pRecordset.State and adStateOpen) <> 0) then
  1815.         for I := 0 to DataSetCount - 1 do
  1816.           with DataSets[I] do
  1817.           if (Recordset = pRecordset) and (eoAsyncExecute in ExecuteOptions) then
  1818.           begin
  1819.             OpenCursorComplete;
  1820.             Break;
  1821.           end;
  1822.     except
  1823.       Application.HandleException(Self);
  1824.     end;
  1825.   end;
  1826.  
  1827. var
  1828.   EventStatus: TEventStatus;
  1829. begin
  1830.   if Assigned(FOnExecuteComplete) then
  1831.   begin
  1832.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  1833.     FOnExecuteComplete(Self, RecordsAffected, pError, EventStatus, pCommand, pRecordset);
  1834.     adStatus := EventStatusValues[EventStatus];
  1835.   end;
  1836.   CheckForAsyncExecute;
  1837. end;
  1838.  
  1839. procedure TADOConnection.InfoMessage(const pError: Error;
  1840.   var adStatus: EventStatusEnum; const pConnection: _Connection);
  1841. var
  1842.   EventStatus: TEventStatus;
  1843. begin
  1844.   if Assigned(FOnInfoMessage) then
  1845.   begin
  1846.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  1847.     FOnInfoMessage(Self, pError, EventStatus);
  1848.     adStatus := EventStatusValues[EventStatus];
  1849.   end;
  1850. end;
  1851.  
  1852. procedure TADOConnection.RollbackTransComplete(const pError: Error;
  1853.   var adStatus: EventStatusEnum; const pConnection: _Connection);
  1854. var
  1855.   EventStatus: TEventStatus;
  1856. begin
  1857.   if Assigned(FOnRollbackTransComplete) then
  1858.   begin
  1859.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  1860.     FOnRollbackTransComplete(Self, pError, EventStatus);
  1861.     adStatus := EventStatusValues[EventStatus];
  1862.   end;
  1863. end;
  1864.  
  1865. procedure TADOConnection.WillConnect(var ConnectionString, UserID,
  1866.   Password: WideString; var Options: Integer;
  1867.   var adStatus: EventStatusEnum; const pConnection: _Connection);
  1868.  
  1869.   function ExtractUserID(ConnStr: string): string;
  1870.   var
  1871.     UIDPos, UIDLen: Integer;
  1872.   begin
  1873.     UIDPos := Pos(CT_USERID, AnsiUpperCase(ConnStr)) + Length(CT_USERID);
  1874.     if UIDPos > Length(CT_USERID) then
  1875.     begin
  1876.       UIDLen := Pos(';', Copy(ConnStr, UIDPos, 255)) - 1;
  1877.       Result := Copy(ConnStr, UIDPos, UIDLen);
  1878.     end else
  1879.       Result := '';
  1880.   end;
  1881.  
  1882.   function GetUserName(ConnStr: string): string;
  1883.   var
  1884.     DataInit: IDataInitialize;
  1885.     DataLinkFileName: WideString;
  1886.     InnerConnStr: POleStr;
  1887.   begin
  1888.     if CompareText(Copy(ConnStr, 1, 10), CT_FILENAME) = 0 then
  1889.     begin
  1890.       DataInit := CreateComObject(CLSID_DataLinks) as IDataInitialize;
  1891.       DataLinkFileName := Copy(ConnStr, 11, MAX_PATH);
  1892.       if Succeeded(DataInit.LoadStringFromStorage(PWideChar(DataLinkFileName), InnerConnStr)) then
  1893.         Result := ExtractUserID(InnerConnStr);
  1894.     end
  1895.     else
  1896.       Result := ExtractUserID(ConnStr);
  1897.   end;
  1898.  
  1899. var
  1900.   SPassword, SUserID: string;
  1901.   EventStatus: TEventStatus;
  1902.   ConnectOptions: TConnectOption;
  1903. begin
  1904.   if Assigned(FOnWillConnect) then
  1905.   begin
  1906.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  1907.     ConnectOptions := TConnectOption(OleEnumToOrd(ConnectOptionValues, Options));
  1908.     FOnWillConnect(Self, ConnectionString, UserID, Password, ConnectOptions,
  1909.       EventStatus);
  1910.     adStatus := EventStatusValues[EventStatus];
  1911.     Options := ConnectOptionValues[ConnectOptions];
  1912.   end;
  1913.   if LoginPrompt then
  1914.   begin
  1915.     if UserID = '' then
  1916.       SUserID := UserID;
  1917.       SUserID := GetUserName(ConnectionString);
  1918.     if LoginDialogEx(Name, SUserID, SPassword, False) then
  1919.     begin
  1920.       UserID := SUserID;
  1921.       Password := SPassword;
  1922.     end else
  1923.       adStatus := adStatusCancel;
  1924.   end;
  1925.   if Assigned(OnLogin) then
  1926.     OnLogin(Self, UserID, Password);
  1927. end;
  1928.  
  1929. procedure TADOConnection.WillExecute(var Source: WideString;
  1930.   var CursorType: CursorTypeEnum; var LockType: LockTypeEnum;
  1931.   var Options: Integer; var adStatus: EventStatusEnum;
  1932.   const pCommand: _Command; const pRecordset: _Recordset;
  1933.   const pConnection: _Connection);
  1934.  
  1935.   function ExtractCommandType: TCommandType;
  1936.   begin
  1937.   { Can't use OleEnumToOrd for this since it also contains the Execute options }
  1938.     for Result := Low(TCommandType) to High(TCommandType) do
  1939.       if (CommandTypeValues[Result] and Options) <> 0 then Exit;
  1940.     Result := cmdText;
  1941.   end;
  1942.  
  1943. var
  1944.   ECursorType: TCursorType;
  1945.   ELockType: TADOLockType;
  1946.   EventStatus: TEventStatus;
  1947.   ExecuteOptions: TExecuteOptions;
  1948.   CommandType: TCommandType;
  1949. begin
  1950.   if Assigned(FOnWillExecute) then
  1951.   begin
  1952.     ECursorType := TCursorType(OleEnumToOrd(CursorTypeValues, CursorType));
  1953.     ELockType := TADOLockType(OleEnumToOrd(LockTypeValues, LockType));
  1954.     CommandType := ExtractCommandType;
  1955.     ExecuteOptions := OrdToExecuteOptions(Options);
  1956.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  1957.     FOnWillExecute(Self, Source, ECursorType, ELockType, CommandType,
  1958.       ExecuteOptions, EventStatus, pCommand, pRecordset);
  1959.     CursorType := CursorTypeValues[ECursorType];
  1960.     LockType := LockTypeValues[ELockType];
  1961.     Options := CommandTypeValues[CommandType] + ExecuteOptionsToOrd(ExecuteOptions);
  1962.     adStatus := EventStatusValues[EventStatus];
  1963.   end;
  1964. end;
  1965.  
  1966. { Property Access }
  1967.  
  1968. function TADOConnection.GetAttributes: TXactAttributes;
  1969. var
  1970.   Attributes: Integer;
  1971.   Xa: TXactAttribute;
  1972. begin
  1973.   Result := [];
  1974.   Attributes := ConnectionObject.Attributes;
  1975.   if Attributes <> 0 then
  1976.     for Xa := Low(TXactAttribute) to High(TXactAttribute) do
  1977.       if (XactAttributeValues[Xa] and Attributes) <> 0 then
  1978.         Include(Result, Xa);
  1979. end;
  1980.  
  1981. procedure TADOConnection.SetAttributes(const Value: TXactAttributes);
  1982. var
  1983.   Attributes: Integer;
  1984.   Xa: TXactAttribute;
  1985. begin
  1986.   Attributes := 0;
  1987.   if Value <> [] then
  1988.     for Xa := Low(TXactAttribute) to High(TXactAttribute) do
  1989.       if Xa in Value then
  1990.         Attributes := Attributes + XactAttributeValues[Xa];
  1991.   ConnectionObject.Attributes := Attributes;
  1992. end;
  1993.  
  1994. function TADOConnection.GetCommandTimeout: Integer;
  1995. begin
  1996.   Result := ConnectionObject.CommandTimeOut;
  1997. end;
  1998.  
  1999. procedure TADOConnection.SetCommandTimeout(const Value: Integer);
  2000. begin
  2001.   ConnectionObject.CommandTimeOut := Value;
  2002. end;
  2003.  
  2004. function TADOConnection.GetConnected: Boolean;
  2005. begin
  2006.   WaitForConnectComplete;
  2007.   Result := Assigned(ConnectionObject) and ((adStateOpen and ConnectionObject.State) <> 0);
  2008. end;
  2009.  
  2010. procedure TADOConnection.SetConnectionObject(const Value: _Connection);
  2011. begin
  2012.   CheckInActive;
  2013.   if Assigned(Value) then
  2014.     FConnectionObject := Value;
  2015. end;
  2016.  
  2017. function TADOConnection.GetConnectionString: WideString;
  2018. begin
  2019.   Result := ConnectionObject.ConnectionString;
  2020. end;
  2021.  
  2022. procedure TADOConnection.SetConnectionString(const Value: WideString);
  2023. begin
  2024.   if ConnectionString <> Value then
  2025.   begin
  2026.     CheckInactive;
  2027.     ConnectionObject.ConnectionString := Value;
  2028.   end;
  2029. end;
  2030.  
  2031. function TADOConnection.GetConnectionTimeout: Integer;
  2032. begin
  2033.   Result := ConnectionObject.ConnectionTimeout;
  2034. end;
  2035.  
  2036. procedure TADOConnection.SetConnectionTimeout(const Value: Integer);
  2037. begin
  2038.   if ConnectionTimeout <> Value then
  2039.   begin
  2040.     CheckInactive;
  2041.     ConnectionObject.ConnectionTimeout := Value;
  2042.   end;
  2043. end;
  2044.  
  2045. procedure TADOConnection.SetConnectOptions(const Value: TConnectOption);
  2046. begin
  2047.   if ConnectOptions <> Value then
  2048.   begin
  2049.     CheckInactive;
  2050.     FConnectOptions := Value;
  2051.   end;
  2052. end;
  2053.  
  2054. function TADOConnection.GetCursorLocation: TCursorLocation;
  2055. begin
  2056.   Result := TCursorLocation(OleEnumToOrd(CursorLocationValues,
  2057.     ConnectionObject.CursorLocation));
  2058. end;
  2059.  
  2060. procedure TADOConnection.SetCursorLocation(const Value: TCursorLocation);
  2061. begin
  2062.   ConnectionObject.CursorLocation := CursorLocationValues[Value];
  2063. end;
  2064.  
  2065.  
  2066. procedure TADOConnection.RegisterClient(Client: TObject; Event: TConnectChangeEvent = nil);
  2067. begin
  2068.   inherited;
  2069.   if (Client is TADOCommand) and not (TADOCommand(Client).Owner is TCustomADODataSet) then
  2070.     FCommands.Add(Client);
  2071. end;
  2072.  
  2073. procedure TADOConnection.UnRegisterClient(Client: TObject);
  2074. begin
  2075.   inherited;
  2076.   if (Client is TADOCommand) and not (TADOCommand(Client).Owner is TCustomADODataSet) then
  2077.     FCommands.Remove(Client);
  2078. end;
  2079.  
  2080. function TADOConnection.GetCommand(Index: Integer): TADOCommand;
  2081. begin
  2082.   Result := FCommands[Index];
  2083. end;
  2084.  
  2085. function TADOConnection.GetCommandCount: Integer;
  2086. begin
  2087.   Result := FCommands.Count;
  2088. end;
  2089.  
  2090. function TADOConnection.GetADODataSet(Index: Integer): TCustomADODataSet;
  2091. begin
  2092.   Result := GetDataSet(Index) as TCustomADODataSet;
  2093. end;
  2094.  
  2095. function TADOConnection.IsDefaultDatabaseStored: Boolean;
  2096. begin
  2097.   Result := FDefaultDatabase <> '';
  2098. end;
  2099.  
  2100. function TADOConnection.GetDefaultDatabase: WideString;
  2101. begin
  2102.   if Connected then
  2103.   try
  2104.     Result := ConnectionObject.DefaultDatabase
  2105.   except
  2106.     { Ignore errors reading this property }
  2107.   end
  2108.   else
  2109.     Result := FDefaultDatabase;
  2110. end;
  2111.  
  2112. procedure TADOConnection.SetDefaultDatabase(const Value: WideString);
  2113. begin
  2114.   if DefaultDatabase <> Value then
  2115.   begin
  2116.     FDefaultDatabase := Value;
  2117.     if Connected then
  2118.       ConnectionObject.DefaultDatabase := Value;
  2119.   end;
  2120. end;
  2121.  
  2122. function TADOConnection.GetErrors: Errors;
  2123. begin
  2124.   Result := ConnectionObject.Errors;
  2125. end;
  2126.  
  2127. function TADOConnection.GetInTransaction: Boolean;
  2128. begin
  2129.   Result := FTransactionLevel > 0;
  2130. end;
  2131.  
  2132. function TADOConnection.GetIsolationLevel: TIsolationLevel;
  2133. var
  2134.   OleEnum: TOleEnum;
  2135. begin
  2136.   { IsolationLevelEnum has several duplicate values, here we try to return the
  2137.     one specified by the user if it matches }
  2138.   OleEnum := ConnectionObject.IsolationLevel;
  2139.   if IsolationLevelValues[FIsolationLevel] = OleEnum then
  2140.     Result := FIsolationLevel
  2141.   else
  2142.   begin
  2143.     Result := TIsolationLevel(OleEnumToOrd(IsolationLevelValues, OleEnum));
  2144.     FIsolationLevel := Result;
  2145.   end;
  2146. end;
  2147.  
  2148. procedure TADOConnection.SetIsolationLevel(const Value: TIsolationLevel);
  2149. begin
  2150.   ConnectionObject.IsolationLevel := IsolationLevelValues[Value];
  2151.   FIsolationLevel := Value;
  2152. end;
  2153.  
  2154. function TADOConnection.GetMode: TConnectMode;
  2155. begin
  2156.   Result := TConnectMode(OleEnumToOrd(ConnectModeValues, ConnectionObject.Mode));
  2157. end;
  2158.  
  2159. procedure TADOConnection.SetMode(const Value: TConnectMode);
  2160. begin
  2161.   if Mode <> Value then
  2162.   begin
  2163.     CheckInactive;
  2164.     ConnectionObject.Mode := ConnectModeValues[Value];
  2165.   end;
  2166. end;
  2167.  
  2168. function TADOConnection.GetProperties: Properties;
  2169. begin
  2170.   Result := ConnectionObject.Properties;
  2171. end;
  2172.  
  2173. function TADOConnection.GetProvider: WideString;
  2174. begin
  2175.   Result := ConnectionObject.Provider;
  2176. end;
  2177.  
  2178. procedure TADOConnection.SetProvider(const Value: WideString);
  2179. begin
  2180.   if Provider <> Value then
  2181.   begin
  2182.     CheckInactive;
  2183.     ConnectionObject.Provider := Value;
  2184.   end;
  2185. end;
  2186.  
  2187. function TADOConnection.IsProviderStored: Boolean;
  2188. begin
  2189.   if Connected then
  2190.     Result := Provider <> 'MSDASQL.1' else
  2191.     Result := Provider <> 'MSDASQL';
  2192. end;
  2193.  
  2194. function TADOConnection.GetState: TObjectStates;
  2195. begin
  2196.   Result := GetStates(ConnectionObject.State);
  2197. end;
  2198.  
  2199. function TADOConnection.GetVersion: WideString;
  2200. begin
  2201.   Result := ConnectionObject.Version;
  2202. end;
  2203.  
  2204. procedure TADOConnection.SetKeepConnection(const Value: Boolean);
  2205. begin
  2206.   if FKeepConnection <> Value then
  2207.   begin
  2208.     FKeepConnection := Value;
  2209.     CheckDisconnect;
  2210.   end;
  2211. end;
  2212.  
  2213.  
  2214. { TRDSConnection }
  2215.  
  2216. const
  2217.   DataFactoryProgID = 'RDSServer.DataFactory';
  2218.  
  2219. constructor TRDSConnection.Create(AOwner: TComponent);
  2220. begin
  2221.   inherited;
  2222.   SetServerName(DataFactoryProgID);
  2223. end;
  2224.  
  2225. destructor TRDSConnection.Destroy;
  2226. begin
  2227.   Destroying;
  2228.   Close;
  2229.   ClearRefs;
  2230.   FDataSpace := nil;
  2231.   inherited Destroy;
  2232. end;
  2233.  
  2234. procedure TRDSConnection.CheckInactive;
  2235. begin
  2236.   { At design time, force connection to be closed as needed }
  2237.   if Connected and (csDesigning in ComponentState) then
  2238.     Close;
  2239. end;
  2240.  
  2241. procedure TRDSConnection.ClearRefs;
  2242. var
  2243.   I: Integer;
  2244. begin
  2245.   for I := (DataSetCount - 1) downto 0 do
  2246.     if DataSets[I] is TADODataSet then
  2247.       TADODataSet(DataSets[I]).RDSConnection := nil;
  2248. end;
  2249.  
  2250. procedure TRDSConnection.DoConnect;
  2251. begin
  2252.   if not Assigned(FDataSpace) then
  2253.     FDataSpace := CreateADOObject(CLASS_DataSpace) as DataSpace;
  2254.   FDataSpace.InternetTimeout := InternetTimeout;
  2255.   FAppServer := FDataSpace.CreateObject(ServerName, ComputerName);
  2256. end;
  2257.  
  2258. procedure TRDSConnection.DoDisconnect;
  2259. begin
  2260.   VarClear(FAppServer);
  2261. end;
  2262.  
  2263. function TRDSConnection.GetConnected: Boolean;
  2264. begin
  2265.   Result := not VarIsEmpty(FAppServer);
  2266. end;
  2267.  
  2268. function TRDSConnection.GetRecordset(const CommandText: Widestring;
  2269.   ConnectionString: WideString = ''): _Recordset;
  2270.  
  2271.   function GetFromDataFactory: _RecordSet;
  2272.   begin
  2273.     Result := IUnknown(AppServer.Query(ConnectionString, CommandText, 0)) as _Recordset;
  2274.   end;
  2275.  
  2276.   function GetFromProperty: _RecordSet;
  2277.   var
  2278.     Status, DispID: Integer;
  2279.     ExcepInfo: TExcepInfo;
  2280.     VarResult: OleVariant;
  2281.     FServDisp: IDispatch;
  2282.     DispParams: TDispParams;
  2283.   begin
  2284.     FServDisp := IUnknown(FAppServer) as IDispatch;
  2285.     FillChar(DispParams, SizeOf(DispParams), 0);
  2286.     OLECheck(FServDisp.GetIDsOfNames(GUID_NULL, @CommandText, 1, 0, @DispID));
  2287.     Status := FServDisp.Invoke(DispID, GUID_NULL, LOCALE_USER_DEFAULT,
  2288.       DISPATCH_PROPERTYGET, DispParams, @VarResult, @ExcepInfo, nil);
  2289.     if Status <> 0 then DispatchInvokeError(Status, ExcepInfo);
  2290.     Result := IUnknown(VarResult) as _Recordset;
  2291.   end;
  2292.  
  2293. begin
  2294.   if not Connected then Open;
  2295.   if FIsAppServer then
  2296.     Result := GetFromProperty else
  2297.     Result := GetFromDataFactory;
  2298. end;
  2299.  
  2300. procedure TRDSConnection.SetComputerName(const Value: WideString);
  2301. begin
  2302.   CheckInactive;
  2303.   FComputerName := Value;
  2304. end;
  2305.  
  2306. procedure TRDSConnection.SetServerName(const Value: WideString);
  2307. begin
  2308.   CheckInactive;
  2309.   FServerName := Value;
  2310.   { Determine if the name is the default RDSServer.DataFactory }
  2311.   FIsAppServer := Pos(UpperCase(Value), UpperCase(DataFactoryProgID)) <> 1;
  2312. end;
  2313.  
  2314. { TParameters }
  2315.  
  2316. function TParameters.Create_Parameter(const Name: WideString;
  2317.   DataType: TDataType; Direction: TParameterDirection = pdInput;
  2318.   Size: Integer = 0): _Parameter;
  2319. begin
  2320.   Result := Command.CommandObject.CreateParameter(Name, DataTypeValues[DataType],
  2321.     ParameterDirectionValues[Direction], Size, Null);
  2322. end;
  2323.  
  2324. function TParameters.Refresh: Boolean;
  2325. begin
  2326.   Command.SetConnectionFlag(cfParameters, True);
  2327.   try
  2328.     Command.Initialize(False);
  2329.     Result := InternalRefresh;
  2330.   finally
  2331.     Command.SetConnectionFlag(cfParameters, False);
  2332.   end;
  2333. end;
  2334.  
  2335. function TParameters.InternalRefresh: Boolean;
  2336.  
  2337.   { This method uses OLEDB instead of ADO to get the parameter info.  This
  2338.     prevents an exception from being raised when the parameter information
  2339.     is not available }
  2340.  
  2341.   procedure RefreshFromOleDB;
  2342.   var
  2343.     I: Integer;
  2344.     ParamCount: UINT;
  2345.     ParamInfo: PDBParamInfoArray;
  2346.     NamesBuffer: POleStr;
  2347.     Name: WideString;
  2348.     Parameter: _Parameter;
  2349.     OLEDBCommand: ICommand;
  2350.     OLEDBParameters: ICommandWithParameters;
  2351.     CommandPrepare: ICommandPrepare;
  2352.   begin
  2353.     OLEDBCommand := (Command.CommandObject as ADOCommandConstruction).OLEDBCommand as ICommand;
  2354.     OLEDBCommand.QueryInterface(ICommandWithParameters, OLEDBParameters);
  2355.     OLEDBParameters.SetParameterInfo(0, nil, nil);
  2356.     if Assigned(OLEDBParameters) then
  2357.     begin
  2358.       ParamInfo := nil;
  2359.       NamesBuffer := nil;
  2360.       try
  2361.         OLEDBCommand.QueryInterface(ICommandPrepare, CommandPrepare);
  2362.         if Assigned(CommandPrepare) then CommandPrepare.Prepare(0);
  2363.         if OLEDBParameters.GetParameterInfo(ParamCount, PDBPARAMINFO(ParamInfo), @NamesBuffer) = S_OK then
  2364.           for I := 0 to ParamCount - 1 do
  2365.             with ParamInfo[I] do
  2366.             begin
  2367.               { When no default name, fabricate one like ADO does }
  2368.               if pwszName = nil then
  2369.                 Name := 'Param' + IntToStr(I+1) else { Do not localize }
  2370.                 Name := pwszName;
  2371.               { OLEDB has no DBTYPE_VARBYTES, but ADO seems to use
  2372.                 adVarBinary for parameters of type DBTYPE_BYTES instead }
  2373.               if wType = DBTYPE_BYTES then wType := adVarBinary;
  2374.               Parameter := Command.CommandObject.CreateParameter(Name, wType, dwFlags and $F, ulParamSize, EmptyParam);
  2375.               Parameter.Precision := bPrecision;
  2376.               Parameter.NumericScale := ParamInfo[I].bScale;
  2377.               Parameter.Attributes := dwFlags and $FFFFFFF0; { Mask out Input/Output flags }
  2378.               AddParameter.FParameter := Parameter;
  2379.             end;
  2380.       finally
  2381.         if (ParamInfo <> nil) then GlobalMalloc.Free(ParamInfo);
  2382.         if (NamesBuffer <> nil) then GlobalMalloc.Free(NamesBuffer);
  2383.       end;
  2384.     end;
  2385.   end;
  2386.  
  2387.   procedure RefreshFromADO;
  2388.   var
  2389.     I: Integer;
  2390.     Parameter: _Parameter;
  2391.   begin
  2392.     with Command.CommandObject do
  2393.     try
  2394.       Parameters.Refresh;
  2395.       for I := 0 to Parameters.Count - 1 do
  2396.         with Parameters[I] do
  2397.         begin
  2398.         { We can't use the instance of the parameter in the ADO collection because
  2399.           it will be freed when the connection is closed even though we have a
  2400.           reference to it.  So instead we create our own and copy the settings }
  2401.           Parameter := CreateParameter(Name, Type_, Direction, Size, EmptyParam);
  2402.           Parameter.Precision := Precision;
  2403.           Parameter.NumericScale := NumericScale;
  2404.           Parameter.Attributes := Attributes;
  2405.           AddParameter.FParameter := Parameter;
  2406.         end;
  2407.     except
  2408.       { do nothing }
  2409.     end;
  2410.   end;
  2411.  
  2412. begin
  2413.   BeginUpdate;
  2414.   try
  2415.     Clear;
  2416.     if Command.CommandType = cmdText then
  2417.       RefreshFromOLEDB else
  2418.       RefreshFromADO;
  2419.     Result := Count > 0;
  2420.   finally
  2421.     EndUpdate;
  2422.   end;
  2423. end;
  2424.  
  2425. procedure TParameters.Update(Item: TCollectionItem);
  2426. begin
  2427.   FModified := True;
  2428. end;
  2429.  
  2430. function TParameters.AddParameter: TParameter;
  2431. begin
  2432.   Result := Add as TParameter;
  2433. end;
  2434.  
  2435. procedure TParameters.AppendParameters;
  2436. var
  2437.   I: Integer;
  2438. begin
  2439.   if Modified then
  2440.   begin
  2441.     try
  2442.       { Create a dummy parameter first, so that we won't raise an exception
  2443.         on the call to Count if the provider does not supply prameter info }
  2444.       ParameterCollection.Append(Create_Parameter('_', ftInteger));
  2445.       for I := ParameterCollection.Count - 1 downto 0 do
  2446.         ParameterCollection.Delete(I);
  2447.     except
  2448.       { just in case... }
  2449.     end;
  2450.     for I := 0 to Count - 1 do
  2451.       ParameterCollection.Append(Items[I].ParameterObject);
  2452.     FModified := False;
  2453.   end;
  2454. end;
  2455.  
  2456. function TParameters.CreateParameter(const Name: WideString;
  2457.   DataType: TDataType; Direction: TParameterDirection; Size: Integer;
  2458.   Value: OleVariant): TParameter;
  2459. begin
  2460.   Result := AddParameter;
  2461.   Result.FParameter := Create_Parameter(Name, DataType, Direction, Size);
  2462.   Result.FParameter.Value := Value;
  2463. end;
  2464.  
  2465. procedure TParameters.AssignValues(Value: TParameters);
  2466. var
  2467.   I: Integer;
  2468.   P: TParameter;
  2469. begin
  2470.   for I := 0 to Value.Count - 1 do
  2471.   begin
  2472.     P := FindParam(Value[I].Name);
  2473.     if P <> nil then
  2474.       P.Assign(Value[I]);
  2475.   end;
  2476. end;
  2477.  
  2478. function TParameters.IsEqual(Value: TParameters): Boolean;
  2479. var
  2480.   I: Integer;
  2481. begin
  2482.   Result := Count = Value.Count;
  2483.   if Result then
  2484.     for I := 0 to Count - 1 do
  2485.     begin
  2486.       Result := Items[I].IsEqual(Value.Items[I]);
  2487.       if not Result then Break;
  2488.     end
  2489. end;
  2490.  
  2491. function TParameters.FindParam(const Value: WideString): TParameter;
  2492. var
  2493.   I: Integer;
  2494. begin
  2495.   for I := 0 to Count - 1 do
  2496.   begin
  2497.     Result := TParameter(inherited Items[I]);
  2498.     if CompareText(Result.Name, Value) = 0 then Exit;
  2499.   end;
  2500.   Result := nil;
  2501. end;
  2502.  
  2503. function TParameters.ParamByName(const Value: WideString): TParameter;
  2504.  
  2505.   function GetComponent: TComponent;
  2506.   begin
  2507.     Result := GetCommand;
  2508.     if Assigned(Result) and (Result.Owner is TCustomADODataSet) then
  2509.       Result := Command.Owner;
  2510.   end;
  2511.  
  2512. begin
  2513.   Result := FindParam(Value);
  2514.   if Result = nil then
  2515.     DatabaseErrorFmt(SParameterNotFound, [Value], GetComponent);
  2516. end;
  2517.  
  2518. procedure TParameters.GetParamList(List: TList; const ParamNames: WideString);
  2519. var
  2520.   Pos: Integer;
  2521. begin
  2522.   Pos := 1;
  2523.   while Pos <= Length(ParamNames) do
  2524.     List.Add(ParamByName(ExtractFieldName(ParamNames, Pos)));
  2525. end;
  2526.  
  2527. function TParameters.GetParamValue(const ParamName: WideString): Variant;
  2528. var
  2529.   I: Integer;
  2530.   Params: TList;
  2531. begin
  2532.   if Pos(';', ParamName) <> 0 then
  2533.   begin
  2534.     Params := TList.Create;
  2535.     try
  2536.       GetParamList(Params, ParamName);
  2537.       Result := VarArrayCreate([0, Params.Count - 1], varVariant);
  2538.       for I := 0 to Params.Count - 1 do
  2539.         Result[I] := TParam(Params[I]).Value;
  2540.     finally
  2541.       Params.Free;
  2542.     end;
  2543.   end else
  2544.     Result := ParamByName(ParamName).Value
  2545. end;
  2546.  
  2547. procedure TParameters.SetParamValue(const ParamName: WideString;
  2548.   const Value: Variant);
  2549. var
  2550.   I: Integer;
  2551.   Params: TList;
  2552. begin
  2553.   if Pos(';', ParamName) <> 0 then
  2554.   begin
  2555.     Params := TList.Create;
  2556.     try
  2557.       GetParamList(Params, ParamName);
  2558.       for I := 0 to Params.Count - 1 do
  2559.         TParam(Params[I]).Value := Value[I];
  2560.     finally
  2561.       Params.Free;
  2562.     end;
  2563.   end else
  2564.     ParamByName(ParamName).Value := Value;
  2565. end;
  2566.  
  2567. function TParameters.ParseSQL(SQL: string; DoCreate: Boolean): string;
  2568. const
  2569.   Literals = ['''', '"', '`'];
  2570. var
  2571.   Value, CurPos, StartPos: PChar;
  2572.   CurChar: Char;
  2573.   Literal: Boolean;
  2574.   EmbeddedLiteral: Boolean;
  2575.   Name: string;
  2576.  
  2577.   function NameDelimiter: Boolean;
  2578.   begin
  2579.     Result := CurChar in [' ', ',', ';', ')', #13, #10];
  2580.   end;
  2581.  
  2582.   function IsLiteral: Boolean;
  2583.   begin
  2584.     Result := CurChar in Literals;
  2585.   end;
  2586.  
  2587.   function StripLiterals(Buffer: PChar): string;
  2588.   var
  2589.     Len: Word;
  2590.     TempBuf: PChar;
  2591.  
  2592.     procedure StripChar;
  2593.     begin
  2594.       if TempBuf^ in Literals then
  2595.         StrMove(TempBuf, TempBuf + 1, Len - 1);
  2596.       if TempBuf[StrLen(TempBuf) - 1] in Literals then
  2597.         TempBuf[StrLen(TempBuf) - 1] := #0;
  2598.     end;
  2599.  
  2600.   begin
  2601.     Len := StrLen(Buffer) + 1;
  2602.     TempBuf := AllocMem(Len);
  2603.     Result := '';
  2604.     try
  2605.       StrCopy(TempBuf, Buffer);
  2606.       StripChar;
  2607.       Result := StrPas(TempBuf);
  2608.     finally
  2609.       FreeMem(TempBuf, Len);
  2610.     end;
  2611.   end;
  2612.  
  2613. begin
  2614.   Result := SQL;
  2615.   Value := PChar(Result);
  2616.   if DoCreate then Clear;
  2617.   CurPos := Value;
  2618.   Literal := False;
  2619.   EmbeddedLiteral := False;
  2620.   repeat
  2621.     while (CurPos^ in LeadBytes) do Inc(CurPos, 2);
  2622.     CurChar := CurPos^;
  2623.     if (CurChar = ':') and not Literal and ((CurPos + 1)^ <> ':') then
  2624.     begin
  2625.       StartPos := CurPos;
  2626.       while (CurChar <> #0) and (Literal or not NameDelimiter) do
  2627.       begin
  2628.         Inc(CurPos);
  2629.         while (CurPos^ in LeadBytes) do Inc(CurPos, 2);
  2630.         CurChar := CurPos^;
  2631.         if IsLiteral then
  2632.         begin
  2633.           Literal := Literal xor True;
  2634.           if CurPos = StartPos + 1 then EmbeddedLiteral := True;
  2635.         end;
  2636.       end;
  2637.       CurPos^ := #0;
  2638.       if EmbeddedLiteral then
  2639.       begin
  2640.         Name := StripLiterals(StartPos + 1);
  2641.         EmbeddedLiteral := False;
  2642.       end
  2643.       else Name := StrPas(StartPos + 1);
  2644.       if DoCreate then
  2645.         AddParameter.Name := Name;
  2646.       CurPos^ := CurChar;
  2647.       StartPos^ := '?';
  2648.       Inc(StartPos);
  2649.       StrMove(StartPos, CurPos, StrLen(CurPos) + 1);
  2650.       CurPos := StartPos;
  2651.     end
  2652.     else if (CurChar = ':') and not Literal and ((CurPos + 1)^ = ':') then
  2653.       StrMove(CurPos, CurPos + 1, StrLen(CurPos) + 1)
  2654.     else if IsLiteral then Literal := Literal xor True;
  2655.     Inc(CurPos);
  2656.   until CurChar = #0;
  2657. end;
  2658.  
  2659. function TParameters.GetAttr(Index: Integer): string;
  2660. begin
  2661.   case Index of
  2662.     0: Result := 'Name';
  2663.     1: Result := 'Value';
  2664.   else
  2665.     Result := '';
  2666.   end;
  2667. end;
  2668.  
  2669. function TParameters.GetAttrCount: Integer;
  2670. begin
  2671.   Result := 2;
  2672. end;
  2673.  
  2674. function TParameters.GetItemAttr(Index, ItemIndex: Integer): string;
  2675. begin
  2676.   case Index of
  2677.     0: begin
  2678.          Result := Items[ItemIndex].Name;
  2679.          if Result = '' then Result := IntToStr(ItemIndex);
  2680.        end;
  2681.     1: Result := VarToStr(Items[ItemIndex].Value);
  2682.   else
  2683.     Result := '';
  2684.   end;
  2685. end;
  2686.  
  2687. { Property Access }
  2688.  
  2689. function TParameters.GetCommand: TADOCommand;
  2690. begin
  2691.   Result := GetOwner as TADOCommand;
  2692. end;
  2693.  
  2694. function TParameters.GetItem(Index: Integer): TParameter;
  2695. begin
  2696.   Result := TParameter(inherited Items[Index]);
  2697. end;
  2698.  
  2699. procedure TParameters.SetItem(Index: Integer; const Value: TParameter);
  2700. begin
  2701.   inherited SetItem(Index, TCollectionItem(Value));
  2702. end;
  2703.  
  2704. function TParameters.GetParamCollection: Parameters;
  2705. begin
  2706.   Result := Command.CommandObject.Parameters;
  2707. end;
  2708.  
  2709. { TParameter }
  2710.  
  2711. procedure TParameter.AppendChunk(Val: OleVariant);
  2712. begin
  2713.   ParameterObject.AppendChunk(Val);
  2714. end;
  2715.  
  2716. procedure TParameter.Assign(Source: TPersistent);
  2717.  
  2718.   procedure AssignParameter(Parameter: TParameter);
  2719.   begin
  2720.     Attributes := Parameter.Attributes;
  2721.     if Parameter.DataType <> ftUnknown then
  2722.       DataType := Parameter.DataType;
  2723.     Direction := Parameter.Direction;
  2724.     Name := Parameter.Name;
  2725.     NumericScale := Parameter.NumericScale;
  2726.     Precision := Parameter.Precision;
  2727.     Size := Parameter.Size;
  2728.     Value := Parameter.Value;
  2729.   end;
  2730.  
  2731.   procedure AssignField(Field: TField);
  2732.   begin
  2733.     DataType := Field.DataType;
  2734.     Size := Field.Size;
  2735.     Value := Field.Value;
  2736.   end;
  2737.  
  2738.   procedure AssignParam(Param: TParam);
  2739.   begin
  2740.     if Param.ParamType = ptUnknown then
  2741.       Direction := pdInput else
  2742.       Direction := TParameterDirection(Param.ParamType);
  2743.     Name := Param.Name;
  2744.     Attributes := [];
  2745.     NumericScale := 0;
  2746.     Precision := 0;
  2747.     Size := 0;
  2748.     Value := Param.Value;
  2749.   end;
  2750.  
  2751.   procedure LoadFromBitmap(Bitmap: TBitmap);
  2752.   var
  2753.     MS: TMemoryStream;
  2754.   begin
  2755.     MS := TMemoryStream.Create;
  2756.     try
  2757.       Bitmap.SaveToStream(MS);
  2758.       LoadFromStream(MS, ftGraphic);
  2759.     finally
  2760.       MS.Free;
  2761.     end;
  2762.   end;
  2763.  
  2764.   procedure LoadFromStrings(Source: TStrings);
  2765.   begin
  2766.     Value := Source.Text;
  2767.     DataType := ftString;
  2768.   end;
  2769.  
  2770. begin
  2771.   if Source is TParameter then
  2772.     AssignParameter(TParameter(Source))
  2773.   else if Source is TField then
  2774.     AssignField(TField(Source))
  2775.   else if Source is TParam then
  2776.     AssignParam(TParam(Source))
  2777.   else if Source is TStrings then
  2778.     LoadFromStrings(TStrings(Source))
  2779.   else if Source is TBitmap then
  2780.     LoadFromBitmap(TBitmap(Source))
  2781.   else if (Source is TPicture) and (TPicture(Source).Graphic is TBitmap) then
  2782.     LoadFromBitmap(TBitmap(TPicture(Source).Graphic))
  2783.   else
  2784.     inherited Assign(Source);
  2785. end;
  2786.  
  2787. procedure TParameter.AssignTo(Dest: TPersistent);
  2788.  
  2789.   procedure AssignToParam(Param: TParam);
  2790.   begin
  2791.     Param.Name := Name;
  2792.     Param.ParamType := TParamType(Direction);
  2793.     Param.DataType := DataType;
  2794.     Param.Value := Value;
  2795.   end;
  2796.  
  2797. begin
  2798.   if Dest is TField then
  2799.     TField(Dest).Value := Value
  2800.   else if Dest is TParam then
  2801.     AssignToParam(TParam(Dest)) else
  2802.     inherited AssignTo(Dest);
  2803. end;
  2804.  
  2805. procedure TParameter.LoadFromFile(const FileName: string; DataType: TDataType);
  2806. var
  2807.   Stream: TStream;
  2808. begin
  2809.   Stream := TFileStream.Create(FileName, fmOpenRead);
  2810.   try
  2811.     LoadFromStream(Stream, DataType);
  2812.   finally
  2813.     Stream.Free;
  2814.   end;
  2815. end;
  2816.  
  2817. procedure TParameter.LoadFromStream(Stream: TStream; DataType: TDataType);
  2818. var
  2819.   StrData: string;
  2820.   WStrData: WideString;
  2821.   BinData: OleVariant;
  2822.   DataPtr: Pointer;
  2823.   Len: Integer;
  2824. begin
  2825.   Self.DataType := DataType;
  2826.   with Stream do
  2827.   begin
  2828.     Position := 0;
  2829.     Len := Size;
  2830.     case DataType of
  2831.       ftString, ftFixedChar, ftMemo:
  2832.         begin
  2833.           SetLength(StrData, Len);
  2834.           ReadBuffer(Pointer(StrData)^, Len);
  2835.           Self.Value := StrData;
  2836.         end;
  2837.       ftWideString:
  2838.         begin
  2839.           SetLength(WStrData, Len div 2);
  2840.           ReadBuffer(Pointer(WStrData)^, Len);
  2841.           Self.Value := WStrData;
  2842.         end;
  2843.       else { Assume binary for all others }
  2844.         begin
  2845.           BinData := VarArrayCreate([0, Len-1], varByte);
  2846.           DataPtr := VarArrayLock(BinData);
  2847.           try
  2848.             ReadBuffer(DataPtr^, Len);
  2849.             Self.Value := BinData;
  2850.           finally
  2851.             VarArrayUnlock(BinData);
  2852.           end;
  2853.         end;
  2854.     end;
  2855.   end;
  2856. end;
  2857.  
  2858. function TParameter.IsEqual(Value: TParameter): Boolean;
  2859. begin
  2860.   Result := (VarType(Self.Value) = VarType(Value.Value)) and
  2861.     (VarIsEmpty(Self.Value) or (Self.Value = Value.Value)) and (Name = Value.Name) and
  2862.     (DataType = Value.DataType) and (Direction = Value.Direction) and
  2863.     (NumericScale = Value.NumericScale) and (Precision = Value.Precision) and
  2864.     (Size = Value.Size);
  2865. end;
  2866.  
  2867. function TParameter.GetAttributes: TParameterAttributes;
  2868. var
  2869.   Attributes: Integer;
  2870.   Pa: TParameterAttribute;
  2871. begin
  2872.   Result := [];
  2873.   Attributes := ParameterObject.Attributes;
  2874.   if Attributes <> 0 then
  2875.     for Pa := Low(TParameterAttribute) to High(TParameterAttribute) do
  2876.       if (ParameterAttributeValues[Pa] and Attributes) <> 0 then
  2877.         Include(Result, Pa);
  2878. end;
  2879.  
  2880. procedure TParameter.SetAttributes(const Value: TParameterAttributes);
  2881. var
  2882.   Attributes: Integer;
  2883.   Pa: TParameterAttribute;
  2884. begin
  2885.   Attributes := 0;
  2886.   if Value <> [] then
  2887.     for Pa := Low(TParameterAttribute) to High(TParameterAttribute) do
  2888.       if Pa in Value then
  2889.         Attributes := Attributes + ParameterAttributeValues[Pa];
  2890.   ParameterObject.Attributes := Attributes;
  2891.   Changed(False);
  2892. end;
  2893.  
  2894. function TParameter.GetDataType: TDataType;
  2895. begin
  2896.   Result := ADOTypeToFieldType(ParameterObject.Type_);
  2897. end;
  2898.  
  2899. procedure TParameter.SetDataType(const Value: TDataType);
  2900. begin
  2901.   ParameterObject.Type_ := DataTypeValues[Value];
  2902.   Changed(False);
  2903. end;
  2904.  
  2905. function TParameter.GetDisplayName: string;
  2906. begin
  2907.   Result := GetName;
  2908. end;
  2909.  
  2910. function TParameter.GetName: WideString;
  2911. begin
  2912.   Result := ParameterObject.Name;
  2913. end;
  2914.  
  2915. procedure TParameter.SetName(const Value: WideString);
  2916. begin
  2917.   ParameterObject.Name := Value;
  2918.   Changed(False);
  2919. end;
  2920.  
  2921. function TParameter.GetNumericScale: Byte;
  2922. begin
  2923.   Result := ParameterObject.NumericScale;
  2924. end;
  2925.  
  2926. procedure TParameter.SetNumericScale(const Value: Byte);
  2927. begin
  2928.   ParameterObject.NumericScale := Value;
  2929.   Changed(False);
  2930. end;
  2931.  
  2932. function TParameter.GetParameter: _Parameter;
  2933. begin
  2934.   if not Assigned(FParameter) then
  2935.     FParameter := Parameters.Create_Parameter('', ftUnknown);
  2936.   Result := FParameter;
  2937. end;
  2938.  
  2939. function TParameter.GetParameterDirection: TParameterDirection;
  2940. begin
  2941.   Result := TParameterDirection(OleEnumToOrd(ParameterDirectionValues,
  2942.     ParameterObject.Direction));
  2943. end;
  2944.  
  2945. procedure TParameter.SetParameterDirection(const Value: TParameterDirection);
  2946. begin
  2947.   ParameterObject.Direction := ParameterDirectionValues[Value];
  2948.   Changed(False);
  2949. end;
  2950.  
  2951. function TParameter.GetParameters: TParameters;
  2952. begin
  2953.   Result := TParameters(Collection);
  2954. end;
  2955.  
  2956. function TParameter.GetPrecision: Byte;
  2957. begin
  2958.   Result := ParameterObject.Precision;
  2959. end;
  2960.  
  2961. procedure TParameter.SetPrecision(const Value: Byte);
  2962. begin
  2963.   ParameterObject.Precision := Value;
  2964.   Changed(False);
  2965. end;
  2966.  
  2967. function TParameter.GetProperties: Properties;
  2968. begin
  2969.   Result := ParameterObject.Properties;
  2970. end;
  2971.  
  2972. function TParameter.GetSize: Integer;
  2973. begin
  2974.   Result := ParameterObject.Size;
  2975. end;
  2976.  
  2977. procedure TParameter.SetSize(const Value: Integer);
  2978. begin
  2979.   ParameterObject.Size := Value;
  2980.   Changed(False);
  2981. end;
  2982.  
  2983. function TParameter.GetValue: Variant;
  2984. begin
  2985.   Result := ParameterObject.Value;
  2986. end;
  2987.  
  2988. procedure TParameter.SetValue(const Value: Variant);
  2989. const
  2990.   SizedDataTypes = [ftUnknown, ftString, ftFixedChar, ftWideString, ftMemo,
  2991.     ftBlob, ftBytes, ftVarBytes];
  2992. var
  2993.   NewSize: Integer;
  2994.   NewValue: OleVariant;
  2995. begin
  2996.   if VarIsEmpty(Value) or VarIsNull(Value) then
  2997.     NewValue := Null
  2998.   else
  2999.   begin
  3000.     if DataType = ftUnknown then
  3001.       SetDataType(VarTypeToDataType(VarType(Value)));
  3002.     { Convert blob data stored in AnsiStrings into variant arrays first }
  3003.     if (DataType = ftBlob) and (VarType(Value) = varString) then
  3004.       NewValue := StringToVarArray(Value) else
  3005.       NewValue := Value;
  3006.   end;
  3007.   if DataType in SizedDataTypes then
  3008.   begin
  3009.     NewSize := VarDataSize(NewValue);
  3010.     if (Size = 0) or (NewSize > Size) then
  3011.       Size := NewSize;
  3012.   end;
  3013.   ParameterObject.Value := NewValue;
  3014. end;
  3015.  
  3016. { TADOCommand }
  3017.  
  3018. constructor TADOCommand.Create(AOwner: TComponent);
  3019. begin
  3020.   inherited Create(AOwner);
  3021.   FCommandObject := CreateADOObject(CLASS_Command) as _Command;
  3022.   FParameters := TParameters.Create(Self, TParameter);
  3023.   FParamCheck := True;
  3024.   CommandType := cmdText;
  3025.   CommandTextAlias := 'CommandText'; { Do not localize }
  3026.   ComponentRef := Self;
  3027. end;
  3028.  
  3029. destructor TADOCommand.Destroy;
  3030. begin
  3031.   inherited Destroy;
  3032.   Connection := nil;
  3033.   FCommandObject := nil;
  3034.   FreeAndNil(FParameters);
  3035. end;
  3036.  
  3037. procedure TADOCommand.Assign(Source: TPersistent);
  3038. var
  3039.   Command: TADOCommand;
  3040. begin
  3041.   if Source is TADOCommand then
  3042.   begin
  3043.     Command := TADOCommand(Source);
  3044.     if Assigned(Command.Connection) then
  3045.       Connection := Command.Connection else
  3046.       ConnectionString := Command.ConnectionString;
  3047.     CommandTimeout := Command.CommandTimeout;
  3048.     CommandType := Command.CommandType;
  3049.     CommandText := Command.CommandText;
  3050.     Prepared := Command.Prepared;
  3051.     Parameters := Command.Parameters;
  3052.   end else
  3053.     inherited;
  3054. end;
  3055.  
  3056. procedure TADOCommand.Cancel;
  3057. begin
  3058.   CommandObject.Cancel;
  3059. end;
  3060.  
  3061. procedure TADOCommand.CheckCommandText;
  3062. begin
  3063.   if CommandText = '' then
  3064.     DatabaseErrorFmt(SMissingCommandText, [CommandTextAlias], FComponentRef);
  3065. end;
  3066.  
  3067. function TADOCommand.SetConnectionFlag(Flag: Integer;
  3068.   Value: Boolean): Boolean;
  3069. begin
  3070.   Result := Flag in FConnectionFlags;
  3071.   if Value then
  3072.   begin
  3073.     if not Result then
  3074.     begin
  3075.       if FConnectionFlags = [] then OpenConnection;
  3076.       Include(FConnectionFlags, Flag);
  3077.     end;
  3078.   end else
  3079.   begin
  3080.     if Result then
  3081.     begin
  3082.       Exclude(FConnectionFlags, Flag);
  3083.       if (FConnectionFlags = []) and Assigned(Connection) then
  3084.         Connection.CheckDisconnect;
  3085.     end;
  3086.   end;
  3087. end;
  3088.  
  3089. procedure TADOCommand.OpenConnection;
  3090. begin
  3091.   if not Assigned(CommandObject.Get_ActiveConnection) then
  3092.   begin
  3093.     if ConnectionString <> '' then
  3094.       CommandObject._Set_ActiveConnection(FConnectionString)
  3095.     else if Assigned(FConnection) then
  3096.     begin
  3097.       FConnection.CheckActive;
  3098.       CommandObject.Set_ActiveConnection(FConnection.ConnectionObject);
  3099.     end else
  3100.       DatabaseError(SMissingConnection);
  3101.   end;
  3102. end;
  3103.  
  3104. function TADOCommand.ComponentLoading: Boolean;
  3105. begin
  3106.   Result := (csLoading in ComponentState) or (Assigned(Owner) and
  3107.     (csLoading in Owner.ComponentState));
  3108. end;
  3109.  
  3110. function TADOCommand.Execute: _Recordset;
  3111. begin
  3112.   Result := Execute(EmptyParam);
  3113. end;
  3114.  
  3115. function TADOCommand.Execute(const Parameters: OleVariant): _Recordset;
  3116. var
  3117.   RecordsAffected: Integer;
  3118. begin
  3119.   RecordsAffected := 0;
  3120.   Result := Execute(RecordsAffected, Parameters);
  3121. end;
  3122.  
  3123. function TADOCommand.Execute(var RecordsAffected: Integer;
  3124.   const Parameters: OleVariant): _Recordset;
  3125. var
  3126.   VarRecsAffected: OleVariant;
  3127. begin
  3128.   SetConnectionFlag(cfExecute, True);
  3129.   try
  3130.     Initialize;
  3131.     Result := CommandObject.Execute(VarRecsAffected, Parameters,
  3132.       CommandObject.CommandType + ExecuteOptionsToOrd(FExecuteOptions));
  3133.     RecordsAffected := VarRecsAffected;
  3134.   finally
  3135.     SetConnectionFlag(cfExecute, False);
  3136.   end;
  3137. end;
  3138.  
  3139. procedure TADOCommand.Initialize(DoAppend: Boolean);
  3140. begin
  3141.   CheckCommandText;
  3142.   { Put brackets around table names with spaces }
  3143.   if (CommandType in [cmdTable, cmdStoredProc]) and (Pos(' ', FCommandText) > 0) and
  3144.      (FCommandText[1] <> '[') then
  3145.     CommandObject.CommandText := '['+FCommandText+']';
  3146.   if DoAppend then
  3147.     Parameters.AppendParameters;
  3148. end;
  3149.  
  3150. { Property Access }
  3151.  
  3152. function TADOCommand.GetActiveConnection: _Connection;
  3153. begin
  3154.   Result := CommandObject.Get_ActiveConnection;
  3155. end;
  3156.  
  3157. procedure TADOCommand.AssignCommandText(const Value: WideString; Loading: Boolean);
  3158.  
  3159.   procedure InitParameters;
  3160.   var
  3161.     I: Integer;
  3162.     List: TParameters;
  3163.     NativeCommand: string;
  3164.   begin
  3165.     List := TParameters.Create(Self, TParameter);
  3166.     try
  3167.       NativeCommand := List.ParseSQL(Value, True);
  3168.       { Preserve existing values }
  3169.       List.AssignValues(Parameters);
  3170.       CommandObject.CommandText := NativeCommand;
  3171.       if not Loading and (Assigned(Connection) or (ConnectionString <> '')) then
  3172.       begin
  3173.         try
  3174.           SetConnectionFlag(cfParameters, True);
  3175.           try
  3176.             { Retrieve additional parameter info from the server if supported }
  3177.             Parameters.InternalRefresh;
  3178.             { Use additional parameter info from server to initialize our list }
  3179.             if Parameters.Count = List.Count then
  3180.               for I := 0 to List.Count - 1 do
  3181.               begin
  3182.                 List[I].DataType := Parameters[I].DataType;
  3183.                 List[I].Size := Parameters[I].Size;
  3184.                 List[I].NumericScale := Parameters[I].NumericScale;
  3185.                 List[I].Precision := Parameters[I].Precision;
  3186.                 List[I].Direction := Parameters[I].Direction;
  3187.                 List[I].Attributes := Parameters[I].Attributes;
  3188.               end
  3189.           finally
  3190.             SetConnectionFlag(cfParameters, False);
  3191.           end;
  3192.         except
  3193.           { Ignore error if server cannot provide parameter info }
  3194.         end;
  3195.         if List.Count > 0 then
  3196.           Parameters.Assign(List);
  3197.       end;
  3198.     finally
  3199.       List.Free;
  3200.     end;
  3201.   end;
  3202.  
  3203. begin
  3204.   if (CommandType = cmdText) and (Value <> '') and ParamCheck then
  3205.     InitParameters
  3206.   else
  3207.   begin
  3208.     CommandObject.CommandText := Value;
  3209.     if not Loading then Parameters.Clear;
  3210.   end;
  3211. end;
  3212.  
  3213. procedure TADOCommand.SetCommandText(const Value: WideString);
  3214. begin
  3215.   FCommandText := Value;
  3216.   AssignCommandText(Value, ComponentLoading);
  3217. end;
  3218.  
  3219. function TADOCommand.GetCommandTimeOut: Integer;
  3220. begin
  3221.   Result := CommandObject.CommandTimeout;
  3222. end;
  3223.  
  3224. procedure TADOCommand.SetCommandTimeOut(const Value: Integer);
  3225. begin
  3226.   CommandObject.CommandTimeout := Value;
  3227. end;
  3228.  
  3229. function TADOCommand.GetCommandType: TCommandType;
  3230. begin
  3231.   Result := TCommandType(OleEnumToOrd(CommandTypeValues,
  3232.     CommandObject.CommandType));
  3233. end;
  3234.  
  3235. procedure TADOCommand.SetComandType(const Value: TCommandType);
  3236. begin
  3237.   CommandObject.CommandType := CommandTypeValues[Value];
  3238. end;
  3239.  
  3240. procedure TADOCommand.ClearActiveConnection;
  3241. begin
  3242.   CommandObject.Set_ActiveConnection(nil);
  3243. end;
  3244.  
  3245. procedure TADOCommand.ConnectionStateChange(Sender: TObject;
  3246.   Connecting: Boolean);
  3247. begin
  3248.   if not Connecting then ClearActiveConnection;
  3249. end;
  3250.  
  3251. procedure TADOCommand.SetConnection(const Value: TADOConnection);
  3252. begin
  3253.   if Connection <> Value then
  3254.   begin
  3255.     FConnectionString := '';
  3256.     if Assigned(FConnection) then
  3257.       FConnection.UnRegisterClient(Self);
  3258.     FConnection := Value;
  3259.     if Assigned(FConnection) then
  3260.       FConnection.RegisterClient(Self, ConnectionStateChange);
  3261.     ClearActiveConnection;
  3262.   end;
  3263. end;
  3264.  
  3265. procedure TADOCommand.SetConnectionString(const Value: WideString);
  3266. begin
  3267.   if ConnectionString <> Value then
  3268.   begin
  3269.     Connection := nil;
  3270.     FConnectionString := Value;
  3271.     ClearActiveConnection;
  3272.   end;
  3273. end;
  3274.  
  3275. procedure TADOCommand.SetName(const NewName: TComponentName);
  3276. begin
  3277.   inherited SetName(NewName);
  3278.   if (NewName <> '') and Assigned(CommandObject) then
  3279.     CommandObject.Name := NewName;
  3280. end;
  3281.  
  3282. procedure TADOCommand.SetParameters(const Value: TParameters);
  3283. begin
  3284.   FParameters.Assign(Value);
  3285. end;
  3286.  
  3287. function TADOCommand.GetPrepared: WordBool;
  3288. begin
  3289.   Result := CommandObject.Prepared;
  3290. end;
  3291.  
  3292. procedure TADOCommand.SetPrepared(const Value: WordBool);
  3293. begin
  3294.   CommandObject.Prepared := Value;
  3295. end;
  3296.  
  3297. function TADOCommand.GetState: TObjectStates;
  3298. begin
  3299.   Result := GetStates(CommandObject.State);
  3300. end;
  3301.  
  3302. function TADOCommand.GetProperties: Properties;
  3303. begin
  3304.   Result := CommandObject.Properties;
  3305. end;
  3306.  
  3307. { TCustomADODataSet }
  3308.  
  3309. constructor TCustomADODataSet.Create(AOwner: TComponent);
  3310. begin
  3311.   inherited Create(AOwner);
  3312.   FCommand := TADOCommand.Create(Self);
  3313.   FCommand.ComponentRef := Self;
  3314.   FIndexDefs := TIndexDefs.Create(Self);
  3315.   FModifiedFields := TList.Create;
  3316.   FIndexFields := TList.Create;
  3317.   FCursorType := ctKeyset;
  3318.   FLockType := ltOptimistic;
  3319.   FCursorLocation := clUseClient;
  3320.   FCacheSize := 1;
  3321.   CommandType := cmdText;
  3322.   NestedDataSetClass := TADODataSet;
  3323.   FMasterDataLink := TMasterDataLink.Create(Self);
  3324.   MasterDataLink.OnMasterChange := MasterChanged;
  3325.   MasterDataLink.OnMasterDisable := MasterDisabled;
  3326.   EnableBCD := True;
  3327. end;
  3328.  
  3329. destructor TCustomADODataSet.Destroy;
  3330. begin
  3331.   Destroying;
  3332.   Close;
  3333.   SetConnection(nil);
  3334.   FreeAndNil(FCommand);
  3335.   FreeAndNil(FModifiedFields);
  3336.   FreeAndNil(FIndexDefs);
  3337.   FreeAndNil(FIndexFields);
  3338.   FreeAndNil(FMasterDataLink);
  3339.   FreeAndNil(FParams);
  3340.   inherited Destroy;
  3341. end;
  3342.  
  3343. procedure TCustomADODataSet.Loaded;
  3344. begin
  3345.   try
  3346.     inherited Loaded;
  3347.   except
  3348.     { Need to trap any exceptions opening while we are loading here }
  3349.     Application.HandleException(Self)
  3350.   end;
  3351. end;
  3352.  
  3353. function TCustomADODataSet.SetConnectionFlag(Flag: Integer;
  3354.   Value: Boolean): Boolean;
  3355. begin
  3356.   Result := Command.SetConnectionFlag(Flag, Value);
  3357. end;
  3358.  
  3359. procedure TCustomADODataSet.OpenCursor(InfoQuery: Boolean);
  3360. const
  3361.   AsyncOptions = [eoAsyncExecute, eoAsyncFetch, eoAsyncFetchNonBlocking];
  3362. var
  3363.   ActiveConnection,
  3364.   Source: OleVariant;
  3365.   
  3366.   procedure InitializeMasterFields;
  3367.   var
  3368.     I: Integer;
  3369.     FieldList: string;
  3370.   begin
  3371.     { Assign MasterFields from parameters as needed by the MasterDataLink }
  3372.     if (Parameters.Count > 0) and Assigned(MasterDataLink.DataSource) and
  3373.       Assigned(MasterDataLink.DataSource.DataSet) then
  3374.     begin
  3375.       for I := 0 to Parameters.Count - 1 do
  3376.         if (Parameters[I].Direction in [pdInput, pdInputOutput]) and
  3377.           (MasterDataLink.DataSource.DataSet.FindField(Parameters[I].Name) <> nil) then
  3378.           FieldList := FieldList + Parameters[I].Name + ';';
  3379.       MasterFields := Copy(FieldList, 1, Length(FieldList)-1);
  3380.       SetParamsFromCursor;
  3381.     end;
  3382.   end;
  3383.  
  3384.   procedure InitializeConnection;
  3385.   var
  3386.     UseCommand: Boolean;
  3387.   begin
  3388.     { Async operations require a connection component so we can hook events }
  3389.     if not Assigned(Connection) and (ExecuteOptions * AsyncOptions <> []) then
  3390.       DatabaseError(SConnectionRequired);
  3391.     FConnectionChanged := False;
  3392.     ActiveConnection := EmptyParam;
  3393.     UseCommand := not (CommandType in RSOnlyCommandTypes);
  3394.     if UseCommand then
  3395.     begin
  3396.       SetConnectionFlag(cfOpen, True);
  3397.       Command.Initialize;
  3398.       InitializeMasterFields;
  3399.       Source := Command.CommandObject;
  3400.     end else
  3401.     begin
  3402.       { Can't use command for cmdFile and cmdTableDirect }
  3403.       if Assigned(Connection) then
  3404.       begin
  3405.         Connection.Open;
  3406.         ActiveConnection := Connection.ConnectionObject;
  3407.       end else
  3408.         ActiveConnection := ConnectionString;
  3409.       Command.CheckCommandText;
  3410.       Source := CommandText;
  3411.     end;
  3412.   end;
  3413.  
  3414.   procedure InitializeRecordset;
  3415.   begin
  3416.     FRecordsetObject := CreateADOObject(CLASS_Recordset) as _Recordset;
  3417.     Recordset.CursorLocation := CursorLocationValues[FCursorLocation];
  3418.     Recordset.CacheSize := FCacheSize;
  3419.     Recordset.MaxRecords := FMaxRecords;
  3420.     if FIndexName <> '' then
  3421.       Recordset.Index := FIndexName;
  3422.     EnableEvents;
  3423.   end;
  3424.  
  3425. begin
  3426.   if not Assigned(Recordset) then
  3427.   begin
  3428.     InitializeConnection;
  3429.     InitializeRecordset;
  3430.     Recordset.Open(Source, ActiveConnection,
  3431.       CursorTypeValues[FCursorType], LockTypeValues[FLockType],
  3432.       CommandTypeValues[CommandType] + ExecuteOptionsToOrd(ExecuteOptions));
  3433.     if Recordset.State = adStateClosed then
  3434.       DatabaseError(SNoResultSet, Self);
  3435.   end else
  3436.     EnableEvents;
  3437.   if (eoAsyncExecute in ExecuteOptions) and ((Recordset.State and adStateExecuting) <> 0) then
  3438.     SetState(dsOpening);
  3439.   inherited OpenCursor(False);
  3440. end;
  3441.  
  3442. procedure TCustomADODataSet.InternalOpen;
  3443. begin
  3444.   if Recordset.Supports(adBookmark) then
  3445.     BookmarkSize := SizeOf(OleVariant) else
  3446.     BookmarkSize := 0;
  3447.   FieldDefs.Updated := False;
  3448.   FieldDefs.Update;
  3449.   if DefaultFields then CreateFields;
  3450.   BindFields(True);
  3451.   FRecBufSize := SizeOf(TRecInfo) + (Fields.Count * SizeOf(OleVariant));
  3452.   PrepareCursor;
  3453. end;
  3454.  
  3455. procedure TCustomADODataSet.InternalClose;
  3456. begin
  3457.   BindFields(False);
  3458.   if DefaultFields then DestroyFields;
  3459.   FIndexFields.Clear;
  3460.   DestroyLookupCursor;
  3461.   if stOpen in RecordsetState then
  3462.   begin
  3463.     Recordset.CancelUpdate;
  3464.     if FEventsID > 0 then
  3465.     begin
  3466.       OleCheck(ConnectionPoint.UnAdvise(FEventsID));
  3467.       FEventsID := 0;
  3468.     end;
  3469.     Recordset.Close;
  3470.   end;
  3471.   FFindCursor := nil;
  3472.   FRecordsetObject := nil;
  3473.   FFilterGroup := fgUnassigned;
  3474.   SetConnectionFlag(cfOpen, False);
  3475. end;
  3476.  
  3477. procedure TCustomADODataSet.InternalRefresh;
  3478. begin
  3479.   Recordset.Resync(adAffectAll, adResyncAllValues);
  3480. end;
  3481.  
  3482. procedure TCustomADODataSet.Requery(Options: TExecuteOptions);
  3483. begin
  3484.   CheckBrowseMode;
  3485.   if FConnectionChanged then
  3486.     DatabaseError(SCantRequery);
  3487.   try
  3488.     Recordset.Requery(ExecuteOptionsToOrd(Options));
  3489.   except
  3490.     if Recordset.State = adStateClosed then Close;
  3491.     raise;
  3492.   end;
  3493.   DestroyLookupCursor;
  3494.   First;
  3495. end;
  3496.  
  3497. procedure TCustomADODataSet.CheckActive;
  3498. begin
  3499.   { Block here to prevent errors }
  3500.   while State = dsOpening do
  3501.     Application.ProcessMessages;
  3502.   inherited CheckActive;
  3503. end;
  3504.  
  3505. procedure TCustomADODataSet.CheckFieldCompatibility(Field: TField;
  3506.   FieldDef: TFieldDef);
  3507. var
  3508.   Compatible: Boolean;
  3509. begin
  3510.   case Field.DataType of
  3511.     ftVariant:          { TVariantField should work for any field type }
  3512.       Compatible := True;
  3513.     ftFloat, ftCurrency, ftBCD: { Numeric and Doubles are interchangeable }
  3514.       Compatible := FieldDef.DataType in [ftFloat, ftCurrency, ftBCD];
  3515.     ftString, ftWideString: { As are string and widestring }
  3516.       Compatible := FieldDef.DataType in [ftString, ftWideString];
  3517.   else
  3518.     Compatible := False;
  3519.   end;
  3520.   if not Compatible then inherited;
  3521. end;
  3522.  
  3523. function TCustomADODataSet.IsCursorOpen: Boolean;
  3524. begin
  3525.   Result := stOpen in RecordsetState;
  3526. end;
  3527.  
  3528. procedure TCustomADODataSet.DefChanged(Sender: TObject);
  3529. begin
  3530.   FStoreDefs := True;
  3531. end;
  3532.  
  3533. procedure TCustomADODataSet.InternalInitFieldDefs;
  3534. const
  3535.   SIsAutoInc: WideString = 'ISAUTOINCREMENT'; { do not localize }
  3536. var
  3537.   HasAutoIncProp: Boolean;
  3538.  
  3539.   { Determine if the field's property list contains an ISAUTOINCREMENT entry }
  3540.   procedure AddFieldDef(F: Field; FieldDefs: TFieldDefs);
  3541.   var
  3542.     FieldType: TFieldType;
  3543.     FieldDef: TFieldDef;
  3544.     I: Integer;
  3545.     FName: string;
  3546.     FSize: Integer;
  3547.     FPrecision: Integer;
  3548.   begin
  3549.     FieldType := ADOTypeToFieldType(F.Type_, EnableBCD);
  3550.     if FieldType <> ftUnknown then
  3551.     begin
  3552.       FSize := 0;
  3553.       FPrecision := 0;
  3554.       FieldDef := FieldDefs.AddFieldDef;
  3555.       with FieldDef do
  3556.       begin
  3557.         FieldNo := FieldDefs.Count;
  3558.         I := 0;
  3559.         FName := F.Name;
  3560.         while (FName = '') or (FieldDefs.IndexOf(FName) >= 0) do
  3561.         begin
  3562.           Inc(I);
  3563.           if F.Name = '' then
  3564.             FName := Format('COLUMN%d', [I]) else { Do not localize }
  3565.             FName := Format('%s_%d', [F.Name, I]);
  3566.         end;
  3567.         Name := FName;
  3568.         case FieldType of
  3569.           ftString, ftWideString, ftBytes, ftVarBytes, ftFixedChar:
  3570.             FSize := F.DefinedSize;
  3571.           ftBCD:
  3572.             begin
  3573.               FPrecision := F.Precision;
  3574.               FSize := ShortInt(F.NumericScale);
  3575.               if FSize < 0 then FSize := 4;
  3576.             end;
  3577.           ftInteger:
  3578.             if HasAutoIncProp and (F.Properties[SIsAutoInc].Value = True) then
  3579.               FieldType := ftAutoInc;
  3580.           ftGuid:
  3581.             FSize := 38;
  3582.         end;
  3583.         if ((adFldRowID and F.Attributes) <> 0) then
  3584.            Attributes := Attributes + [faHiddenCol];
  3585.         if ((adFldFixed and F.Attributes) <> 0) then
  3586.            Attributes := Attributes + [faFixed];
  3587.         if (((adFldUpdatable+adFldUnknownUpdatable) and F.Attributes) = 0) then
  3588.           Attributes := Attributes + [faReadOnly];
  3589.         DataType := FieldType;
  3590.         Size := FSize;
  3591.         Precision := FPrecision;
  3592.         if (DataType = ftDataSet) and (Fields.Count = 0) then
  3593.           ObjectView := True;
  3594.       end;
  3595.     end;
  3596.   end;
  3597.  
  3598. var
  3599.   Count, I: Integer;
  3600. begin
  3601.   FieldDefs.Clear;
  3602.   Count := Recordset.Fields.Count;
  3603.   if Count > 0 then
  3604.     HasAutoIncProp := PropertyExists(Recordset.Fields[0].Properties, SIsAutoInc);
  3605.   for I := 0 to Count - 1 do
  3606.     AddFieldDef(Recordset.Fields[I], FieldDefs);
  3607. end;
  3608.  
  3609. { Routine to initialize OLE DB Intefaces for data access.  Not currently
  3610.   used but my be in a future release }
  3611.   
  3612. procedure TCustomADODataSet.InitOleDBAccess(Initializing: Boolean);
  3613.  
  3614.   procedure InitBinding(var Binding: TDBBinding; const ColInfo: TDBColumnInfo;
  3615.     var Offset: UINT);
  3616.   begin
  3617.     FillChar(Binding, SizeOf(Binding), 0);
  3618.     with Binding do
  3619.     begin
  3620.       dwPart := DBPART_VALUE + DBPART_LENGTH + DBPART_STATUS;
  3621.       iOrdinal := ColInfo.iOrdinal;
  3622.       wType := ColInfo.wType;
  3623.       obStatus := Offset;
  3624.       obLength := Offset + 4;
  3625.       obValue := Offset + 8;
  3626.  
  3627.       if (wType = DBTYPE_WSTR) and (ColInfo.ulColumnSize <> $FFFFFFFF) then
  3628.         cbMaxLen := ColInfo.ulColumnSize * SizeOf(WideChar)
  3629.       else
  3630.         cbMaxLen := ColInfo.ulColumnSize;
  3631.       Inc(Offset, (cbMaxLen + 15) and not 7); {cbMaxLen+Status+Length, rounded up to nearest 8 byte boundry};
  3632.     end;
  3633.   end;
  3634.  
  3635.   procedure SetupBindings;
  3636.   var
  3637.     Offset, Count, I: UINT;
  3638.     ColumnsInfo: IColumnsInfo;
  3639.     StringsBuffer: PWideChar;
  3640.     ColumnInfo: PDBColumnInfoArray;
  3641.     FFieldBindings: array of TDBBinding;
  3642.   begin
  3643.     Count := 0;
  3644.     StringsBuffer := nil;
  3645.     ColumnsInfo := FRowset as IColumnsInfo;
  3646.     OleCheck(ColumnsInfo.GetColumnInfo(Count, PDBColumnInfo(ColumnInfo),
  3647.       StringsBuffer));
  3648.     try
  3649.       Offset := 0;
  3650.       SetLength(FFieldBindings, Count);
  3651.       for I := 0 to Count - 1 do
  3652.         InitBinding(FFieldBindings[I], ColumnInfo[I], Offset);
  3653.       OleCheck(FAccessor.CreateAccessor(DBACCESSOR_ROWDATA, Count,
  3654.         PDBBindingArray(FFieldBindings), Offset, FHAccessor, nil));
  3655.       FOleRecBufSize := Offset;
  3656.     finally
  3657.       GlobalMalloc.Free(StringsBuffer);
  3658.       GlobalMalloc.Free(ColumnInfo);
  3659.     end;
  3660.   end;
  3661.  
  3662. begin
  3663.   if Initializing then
  3664.   begin
  3665.     FRowset := (Recordset as ADORecordsetConstruction).Rowset as IRowset;
  3666.     FRowset.QueryInterface(IAccessor, FAccessor);
  3667.     FRowset.QueryInterface(IRowsetFind, FRowsetFind);
  3668.     SetupBindings;
  3669.   end else
  3670.   begin
  3671.     if Assigned(FAccessor) and (FHAccessor <> 0) then
  3672.     begin
  3673.       FAccessor.ReleaseAccessor(FHAccessor, nil);
  3674.       FHAccessor := 0;
  3675.     end;
  3676.     FAccessor := nil;
  3677.     FRowsetFind := nil;
  3678.     FRowset := nil;
  3679.   end;
  3680. end;
  3681.  
  3682. procedure TCustomADODataSet.PrepareCursor;
  3683. begin
  3684.   if FIndexFieldNames <> '' then
  3685.     InternalSetSort(StringReplace(FIndexFieldNames, ';', ',', [rfReplaceAll]));
  3686.   if MasterDataLink.Active and (Parameters.Count = 0) then
  3687.     SetDetailFilter;
  3688.   if Filtered and (Filter <> '') then
  3689.     ActivateTextFilter(Filter);
  3690.   if Recordset.Supports(adMovePrevious + adBookmark) then
  3691.     InternalFirst;
  3692. end;
  3693.  
  3694. procedure TCustomADODataSet.InternalHandleException;
  3695. begin
  3696.   Application.HandleException(Self);
  3697. end;
  3698.  
  3699. procedure TCustomADODataSet.LoadFromFile(const FileName: WideString);
  3700. begin
  3701.   Close;
  3702.   CommandType := cmdFile;
  3703.   LockType := ltBatchOptimistic;
  3704.   CommandText := FileName;
  3705.   Open;
  3706. end;
  3707.  
  3708. procedure TCustomADODataSet.SaveToFile(const FileName: WideString;
  3709.   Format: TPersistFormat);
  3710. begin
  3711.   CheckBrowseMode;
  3712.   if FileExists(FileName) then DeleteFile(FileName);
  3713.   if LowerCase(ExtractFileExt(FileName)) = '.xml' then
  3714.     Format := pfXML;
  3715.   Recordset.Save(FileName, PersistFormatEnum(Format));
  3716.   CursorPosChanged;
  3717. end;
  3718.  
  3719. procedure TCustomADODataSet.Clone(Source: TCustomADODataSet;
  3720.   LockType: TADOLockType);
  3721. begin
  3722.   Close;
  3723.   FRecordsetObject := Source.Recordset.Clone(LockTypeValues[LockType]);
  3724.   try
  3725.     Open;
  3726.   except
  3727.     FRecordsetObject := nil;
  3728.     raise;
  3729.   end;
  3730. end;
  3731.  
  3732. function TCustomADODataSet.NextRecordset(
  3733.   var RecordsAffected: Integer): _Recordset;
  3734. var
  3735.   VarRecsAffected: OleVariant;
  3736. begin
  3737.   CheckBrowseMode;
  3738.   Result := RecordSet.NextRecordSet(VarRecsAffected);
  3739.   RecordsAffected := VarRecsAffected;
  3740. end;
  3741.  
  3742. procedure TCustomADODataSet.DataEvent(Event: TDataEvent; Info: Integer);
  3743. var
  3744.   I: Integer;
  3745. begin
  3746.   case Event of
  3747.     dePropertyChange:
  3748.       IndexDefs.Updated := False;
  3749.     deLayoutChange:
  3750.       if Active then
  3751.       begin
  3752.         for I := 0 to BufferCount - 1 do
  3753.           Finalize(PVariantList(Buffers[I]+SizeOf(TRecInfo))^, Fields.Count);
  3754.       end;
  3755.   end;
  3756.   inherited;
  3757. end;
  3758.  
  3759. procedure TCustomADODataSet.DefineProperties(Filer: TFiler);
  3760.  
  3761.   function DesignerDataStored: Boolean;
  3762.   begin
  3763.     if Filer.Ancestor <> nil then
  3764.       Result := TCustomADODataSet(Filer.Ancestor).DesignerData <> DesignerData else
  3765.       Result := DesignerData <> '';
  3766.   end;
  3767.  
  3768. begin
  3769.   inherited;
  3770.   Filer.DefineProperty('DesignerData', ReadDesignerData, WriteDesignerData,
  3771.     DesignerDataStored);
  3772. end;
  3773.  
  3774. procedure TCustomADODataSet.ReadDesignerData(Reader: TReader);
  3775. begin
  3776.   FDesignerData := Reader.ReadString;
  3777. end;
  3778.  
  3779. procedure TCustomADODataSet.WriteDesignerData(Writer: TWriter);
  3780. begin
  3781.   Writer.WriteString(FDesignerData);
  3782. end;
  3783.  
  3784. { Master / Detail }
  3785.  
  3786. procedure TCustomADODataSet.MasterChanged(Sender: TObject);
  3787. begin
  3788.   if not Active then Exit;
  3789.   if Parameters.Count = 0 then
  3790.   begin
  3791.     CheckBrowseMode;
  3792.     if SetDetailFilter then First;
  3793.   end else
  3794.     RefreshParams;
  3795. end;
  3796.  
  3797. procedure TCustomADODataSet.MasterDisabled(Sender: TObject);
  3798. begin
  3799.   if Parameters.Count = 0 then
  3800.   begin
  3801.     CheckBrowseMode;
  3802.     DeactivateFilters;
  3803.   end;
  3804. end;
  3805.  
  3806. procedure TCustomADODataSet.RefreshParams;
  3807. var
  3808.   DataSet: TDataSet;
  3809. begin
  3810.   DisableControls;
  3811.   try
  3812.     if MasterDataLink.DataSource <> nil then
  3813.     begin
  3814.       DataSet := MasterDataLink.DataSource.DataSet;
  3815.       if DataSet <> nil then
  3816.         if DataSet.Active and (DataSet.State <> dsSetKey) then
  3817.         begin
  3818.           SetParamsFromCursor;
  3819.           Requery;
  3820.         end;
  3821.     end;
  3822.   finally
  3823.     EnableControls;
  3824.   end;
  3825. end;
  3826.  
  3827. procedure TCustomADODataSet.SetParamsFromCursor;
  3828. var
  3829.   I: Integer;
  3830. begin
  3831.   if MasterDataLink.DataSource <> nil then
  3832.     for I := 0 to MasterDataLink.Fields.Count - 1 do
  3833.       with TField(MasterDataLink.Fields[I]) do
  3834.         Parameters.ParamByName(FieldName).Assign(MasterDataLink.Fields[I]);
  3835. end;
  3836.  
  3837. function TCustomADODataSet.SetDetailFilter: Boolean;
  3838. var
  3839.   I: Integer;
  3840.   LinkField: TField;
  3841.   FieldExpr, FilterStr: string;
  3842. begin
  3843.   for I := 0 to MasterDataLink.Fields.Count - 1 do
  3844.   begin
  3845.     if IndexFieldCount > I then
  3846.       LinkField := IndexFields[I] else
  3847.       LinkField := MasterDataLink.Fields[I];
  3848.     FieldExpr := GetFilterStr(LinkField, TField(MasterDataLink.Fields[I]).Value);
  3849.     if FilterStr <> '' then
  3850.     begin
  3851.       if not VarIsNull(TField(MasterDataLink.Fields[I]).Value) then
  3852.         FilterStr := FilterStr + ' AND ' + FieldExpr;
  3853.     end
  3854.     else
  3855.       FilterStr := FieldExpr;
  3856.     end;
  3857.   Result := FDetailFilter <> FilterStr;
  3858.   if Result then
  3859.   begin
  3860.     FDetailFilter := FilterStr;
  3861.     ActivateTextFilter(FilterStr);
  3862.   end;
  3863. end;
  3864.  
  3865. procedure TCustomADODataSet.DoOnNewRecord;
  3866. var
  3867.   I: Integer;
  3868.   LinkField: TField;
  3869. begin
  3870.   if MasterDataLink.Active and (MasterDataLink.Fields.Count > 0) then
  3871.     for I := 0 to MasterDataLink.Fields.Count - 1 do
  3872.     begin
  3873.       if IndexFieldCount > I then
  3874.         LinkField := IndexFields[I] else
  3875.         LinkField := FieldByName(TField(MasterDataLink.Fields[I]).FieldName);
  3876.       LinkField.Assign(TField(MasterDataLink.Fields[I]));
  3877.     end;
  3878.   inherited DoOnNewRecord;
  3879. end;
  3880.  
  3881. { Bookmarks }
  3882.  
  3883. procedure TCustomADODataSet.InternalGotoBookmark(Bookmark: Pointer);
  3884. begin
  3885.   Recordset.Bookmark := POleVariant(Bookmark)^;
  3886. end;
  3887.  
  3888. procedure TCustomADODataSet.InternalSetToRecord(Buffer: PChar);
  3889. begin
  3890.   if PRecInfo(Buffer)^.BookmarkFlag in [bfCurrent, bfInserted] then
  3891.     InternalGotoBookmark(@PRecInfo(Buffer)^.Bookmark);
  3892. end;
  3893.  
  3894. function TCustomADODataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
  3895. begin
  3896.   Result := PRecInfo(Buffer)^.BookmarkFlag;
  3897. end;
  3898.  
  3899. procedure TCustomADODataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
  3900. begin
  3901.   PRecInfo(Buffer).BookmarkFlag := Value;
  3902. end;
  3903.  
  3904. procedure TCustomADODataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
  3905. begin
  3906.   Initialize(POleVariant(Data)^);
  3907.   POleVariant(Data)^ := PRecInfo(Buffer).Bookmark;
  3908. end;
  3909.  
  3910. procedure TCustomADODataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
  3911. begin
  3912.   if Assigned(Data) then
  3913.     PRecInfo(Buffer).Bookmark := POleVariant(Data)^ else
  3914.     PRecInfo(Buffer).BookmarkFlag := bfNA;
  3915. end;
  3916.  
  3917. function TCustomADODataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
  3918. begin
  3919.   Result := False;
  3920.   if Assigned(Bookmark) and not VarIsNull(POleVariant(Bookmark)^) then
  3921.   try
  3922.     Recordset.Bookmark := POleVariant(Bookmark)^;
  3923.     CursorPosChanged;
  3924.     Result := True;
  3925.   except
  3926.   end;
  3927. end;
  3928.  
  3929. function TCustomADODataSet.CompareBookmarks(Bookmark1,
  3930.   Bookmark2: TBookmark): Integer;
  3931. const
  3932.   RetCodes: array[Boolean, Boolean] of ShortInt = ((2, -1),(1, 0));
  3933. begin
  3934.   Result := RetCodes[Bookmark1 = nil, Bookmark2 = nil];
  3935.   if Result = 2 then
  3936.   try
  3937.     Result := RecordSet.CompareBookmarks(POleVariant(Bookmark1)^,
  3938.       POleVariant(Bookmark2)^) - 1;
  3939.     if Result > 1 then Result := 0;
  3940.   except
  3941.     Result := 0;
  3942.   end;
  3943. end;
  3944.  
  3945. { Record Functions }
  3946.  
  3947. function TCustomADODataSet.GetRecordSize: Word;
  3948. begin
  3949.   Result := FRecBufSize;
  3950. end;
  3951.  
  3952. function TCustomADODataSet.AllocRecordBuffer: PChar;
  3953. begin
  3954.   Result := AllocMem(FRecBufSize);
  3955.   Initialize(PRecInfo(Result)^);
  3956.   Initialize(PVariantList(Result+SizeOf(TRecInfo))^, Fields.Count);
  3957. end;
  3958.  
  3959. procedure TCustomADODataSet.FreeRecordBuffer(var Buffer: PChar);
  3960. begin
  3961.   Finalize(PRecInfo(Buffer)^);
  3962.   Finalize(PVariantList(Buffer+SizeOf(TRecInfo))^, Fields.Count);
  3963.   FreeMem(Buffer);
  3964. end;
  3965.  
  3966. function TCustomADODataSet.InternalGetRecord(Buffer: PChar;
  3967.   GetMode: TGetMode; DoCheck: Boolean): TGetResult;
  3968. begin
  3969.   if Assigned(FParentDataSet) and FParentDataSet.Active and (FParentDataSet.IsEmpty or (FParentDataset.State = dsInsert)) then
  3970.   begin
  3971.     Result := grEOF;
  3972.     Exit;
  3973.   end;
  3974.   try
  3975.     Result := grOK;
  3976.     case GetMode of
  3977.       gmNext:
  3978.         begin
  3979.           { Don't call MoveNext during open if no bookmark support }
  3980.           if (State <> dsInactive) or (BookmarkSize > 0) then
  3981.             if not Recordset.EOF then Recordset.MoveNext;
  3982.           if Recordset.EOF then
  3983.           begin
  3984.             Result := grEOF;
  3985.             { This code blanks out the field values for active
  3986.               buffer on forward only recordsets. }
  3987.             if BookmarkSize = 0 then
  3988.               Finalize(PVariantList(ActiveBuffer+SizeOf(TRecInfo))^, Fields.Count);
  3989.           end;
  3990.         end;
  3991.       gmPrior:
  3992.         begin
  3993.           if not Recordset.BOF then Recordset.MovePrevious;
  3994.           if Recordset.BOF then Result := grBOF;
  3995.         end;
  3996.       gmCurrent:
  3997.         begin
  3998.           if Recordset.BOF then Result := grBOF;
  3999.           if Recordset.EOF then Result := grEOF;
  4000.         end;
  4001.     end;
  4002.     if Result = grOK then
  4003.     begin
  4004.       Assert(not (Recordset.EOF or Recordset.BOF));
  4005.       with PRecInfo(Buffer)^ do
  4006.       begin
  4007.         RecordStatus := Recordset.Status;
  4008.         RecordNumber := Recordset.AbsolutePosition;
  4009.         if (BookmarkSize > 0) and ((adRecDeleted and RecordStatus) = 0) then
  4010.         begin
  4011.           BookmarkFlag := bfCurrent;
  4012.           Bookmark := Recordset.Bookmark;
  4013.         end else
  4014.           BookmarkFlag := bfNA;
  4015.       end;
  4016.       Finalize(PVariantList(Buffer+SizeOf(TRecInfo))^, Fields.Count);
  4017.       GetCalcFields(Buffer);
  4018.     end;
  4019.   except
  4020.     if DoCheck then raise;
  4021.     Result := grError;
  4022.   end;
  4023. end;
  4024.  
  4025. function TCustomADODataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
  4026.   DoCheck: Boolean): TGetResult;
  4027. var
  4028.   Accept: Boolean;
  4029.   SaveState: TDataSetState;
  4030. begin
  4031.   if (BookmarkSize = 0) and (BufferCount > 1) then
  4032.     DatabaseError(SBookmarksRequired);
  4033.   if Filtered and Assigned(OnFilterRecord) then
  4034.   begin
  4035.     FFilterBuffer := Buffer;
  4036.     SaveState := SetTempState(dsFilter);
  4037.     try
  4038.       Accept := True;
  4039.       repeat
  4040.         Result := InternalGetRecord(Buffer, GetMode, DoCheck);
  4041.         OnFilterRecord(Self, Accept);
  4042.       until (Result <> grOK) or Accept;
  4043.     except
  4044.       Application.HandleException(Self);
  4045.       Result := grError;
  4046.     end;
  4047.     RestoreState(SaveState);
  4048.   end else
  4049.     Result := InternalGetRecord(Buffer, GetMode, DoCheck)
  4050. end;
  4051.  
  4052. procedure TCustomADODataSet.InternalInitRecord(Buffer: PChar);
  4053. begin
  4054.   Finalize(PVariantList(Buffer+SizeOf(TRecInfo))^, Fields.Count);
  4055.   Finalize(PRecInfo(Buffer)^);
  4056.   PRecInfo(Buffer)^.BookmarkFlag := bfBOF;
  4057.   PRecInfo(Buffer)^.RecordStatus := adRecNew;
  4058. end;
  4059.  
  4060. procedure TCustomADODataSet.ClearCalcFields(Buffer: PChar);
  4061. var
  4062.   I: Integer;
  4063. begin
  4064.   if CalcFieldsSize > 0 then
  4065.     for I := 0 to Fields.Count - 1 do
  4066.       with Fields[I] do
  4067.         if FieldKind = fkCalculated then
  4068.           PVariantList(Buffer + SizeOf(TRecInfo))[Index] := Null;
  4069. end;
  4070.  
  4071. function TCustomADODataSet.GetActiveRecBuf(var RecBuf: PChar): Boolean;
  4072. begin
  4073.   case State of
  4074.     dsBlockRead,
  4075.     dsBrowse:
  4076.       if IsEmpty or ((BookmarkSize = 0) and Recordset.EOF) then
  4077.         RecBuf := nil else
  4078.         RecBuf := ActiveBuffer;
  4079.     dsEdit, dsInsert, dsNewValue: RecBuf := ActiveBuffer;
  4080.     dsCalcFields,
  4081.     dsInternalCalc: RecBuf := CalcBuffer;
  4082.     dsFilter: RecBuf := FFilterBuffer;
  4083.   else
  4084.     RecBuf := nil;
  4085.   end;
  4086.   Result := RecBuf <> nil;
  4087. end;
  4088.  
  4089. procedure TCustomADODataSet.UpdateRecordSetPosition(Buffer: PChar);
  4090. begin
  4091.   if (State <> dsCalcFields) and (BookmarkSize > 0) and (RecordSet.BOF or
  4092.      RecordSet.EOF or (RecordSet.Bookmark <> PRecInfo(Buffer)^.Bookmark)) then
  4093.   begin
  4094.     if Assigned(FParentDataSet) and (FParentDataSet.Active) then
  4095.       FParentDataSet.UpdateRecordSetPosition(FParentDataSet.ActiveBuffer);
  4096.     InternalSetToRecord(Buffer);
  4097.     CursorPosChanged;
  4098.   end;
  4099.   Assert(not (Recordset.EOF or Recordset.BOF));
  4100. end;
  4101.  
  4102. { Field Data }
  4103.  
  4104. function TCustomADODataSet.GetBlobFieldData(FieldNo: Integer;
  4105.   var Buffer: TBlobByteData): Integer;
  4106. begin
  4107.   Result := inherited GetBlobFieldData(FieldNo, Buffer);
  4108. end;
  4109.  
  4110. function TCustomADODataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  4111. begin
  4112.   Result := GetFieldData(Field, Buffer, True);
  4113. end;
  4114.  
  4115. function TCustomADODataSet.GetFieldData(Field: TField; Buffer: Pointer;
  4116.   NativeFormat: Boolean): Boolean;
  4117. var
  4118.   RecBuf: PChar;
  4119.   Data: OleVariant;
  4120.  
  4121.   procedure CurrToBuffer(const C: Currency);
  4122.   begin
  4123.     if NativeFormat then
  4124.       DataConvert(Field, @C, Buffer, True) else
  4125.       Currency(Buffer^) := C;
  4126.   end;
  4127.  
  4128.   procedure VarToBuffer;
  4129.   begin
  4130.     with tagVariant(Data) do
  4131.       case Field.DataType of
  4132.         ftGuid, ftFixedChar, ftString:
  4133.           begin
  4134.             PChar(Buffer)[Field.Size] := #0;
  4135.             WideCharToMultiByte(0, 0, bStrVal, SysStringLen(bStrVal)+1,
  4136.               Buffer, Field.Size, nil, nil);
  4137.           end;
  4138.         ftWideString:
  4139.         begin
  4140.           VarDataSize(Data);
  4141.           WideString(Buffer^) := bStrVal;
  4142.         end;
  4143.         ftSmallint:
  4144.           SmallInt(Buffer^) := iVal;
  4145.         ftWord:
  4146.           Word(Buffer^) := bVal;
  4147.         ftAutoInc, ftInteger:
  4148.           Integer(Buffer^) := lVal;
  4149.         ftFloat, ftCurrency:
  4150.           if vt = VT_R8 then
  4151.             Double(Buffer^) := dblVal else
  4152.             Double(Buffer^) := Data;
  4153.         ftBCD:
  4154.           if vt = VT_CY then
  4155.             CurrToBuffer(cyVal) else
  4156.             CurrToBuffer(Data);
  4157.         ftBoolean:
  4158.           WordBool(Buffer^) := vbool;
  4159.         ftDate, ftTime, ftDateTime:
  4160.           if NativeFormat then
  4161.             DataConvert(Field, @date, Buffer, True) else
  4162.             TOleDate(Buffer^) := date;
  4163.         ftBytes, ftVarBytes:
  4164.           if NativeFormat then
  4165.             DataConvert(Field, @Data, Buffer, True) else
  4166.             OleVariant(Buffer^) := Data;
  4167.         ftInterface: IUnknown(Buffer^) := Data;
  4168.         ftIDispatch: IDispatch(Buffer^) := Data;
  4169.         ftLargeInt: LargeInt(Buffer^) := Decimal(Data).Lo64;
  4170.         ftBlob..ftTypedBinary, ftVariant: OleVariant(Buffer^) := Data;
  4171.       else
  4172.         DatabaseErrorFmt(SUsupportedFieldType, [FieldTypeNames[Field.DataType],
  4173.           Field.DisplayName]);
  4174.       end;
  4175.   end;
  4176.  
  4177. begin
  4178.   Result := GetActiveRecBuf(RecBuf);
  4179.   if not Result then Exit;
  4180.   Data := PVariantList(RecBuf+SizeOf(TRecInfo))[Field.Index];
  4181.   if VarIsEmpty(Data) and (Field.FieldNo > 0) then
  4182.   begin
  4183.     UpdateRecordSetPosition(RecBuf);
  4184.     Data := Recordset.Fields[Field.FieldNo-1].Value;
  4185.     PVariantList(RecBuf+SizeOf(TRecInfo))[Field.Index] := Data;
  4186.   end;
  4187.   Result := not VarIsNull(Data);
  4188.   if Result and (Buffer <> nil) then
  4189.     VarToBuffer;
  4190. end;
  4191.  
  4192. function TCustomADODataSet.GetFieldData(FieldNo: Integer;
  4193.   Buffer: Pointer): Boolean;
  4194. begin
  4195.   Result := GetFieldData(FieldByNumber(FieldNo), Buffer);
  4196. end;
  4197.  
  4198. function TCustomADODataSet.GetStateFieldValue(State: TDataSetState;
  4199.   Field: TField): Variant;
  4200. begin
  4201.   if IsEmpty or not (Self.State in [dsBrowse, dsEdit]) then
  4202.     Result := Null
  4203.   else
  4204.   begin
  4205.     UpdateCursorPos;
  4206.     case State of
  4207.       dsOldValue:
  4208.         Result := Recordset.Fields[Field.FieldNo-1].OriginalValue;
  4209.       dsCurValue:
  4210.         Result := Recordset.Fields[Field.FieldNo-1].UnderlyingValue;
  4211.     else
  4212.       Result := inherited GetStateFieldValue(State, Field);
  4213.     end;
  4214.   end;
  4215. end;
  4216.  
  4217. procedure TCustomADODataSet.SetFieldData(Field: TField; Buffer: Pointer);
  4218. begin
  4219.   SetFieldData(Field, Buffer, True);
  4220. end;
  4221.  
  4222. procedure TCustomADODataSet.SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean);
  4223.  
  4224.   procedure BufferToVar(var Data: OleVariant);
  4225.   begin
  4226.     case Field.DataType of
  4227.       ftString, ftFixedChar, ftGuid:
  4228.         Data := WideString(PChar(Buffer));
  4229.       ftWideString:
  4230.         Data := WideString(Buffer^);
  4231.       ftAutoInc, ftInteger:
  4232.         Data := LongInt(Buffer^);
  4233.       ftSmallInt:
  4234.         Data := SmallInt(Buffer^);
  4235.       ftWord:
  4236.         Data := Word(Buffer^);
  4237.       ftBoolean:
  4238.         Data := WordBool(Buffer^);
  4239.       ftFloat, ftCurrency:
  4240.         Data := Double(Buffer^);
  4241.       ftBlob, ftMemo, ftGraphic, ftVariant:
  4242.         Data := Variant(Buffer^);
  4243.       ftInterface:
  4244.         Data := IUnknown(Buffer^);
  4245.       ftIDispatch:
  4246.         Data := IDispatch(Buffer^);
  4247.       ftDate, ftTime, ftDateTime:
  4248.         if NativeFormat then
  4249.           DataConvert(Field, Buffer, @TVarData(Data).VDate, False) else
  4250.           Data := TDateTime(Buffer^);
  4251.       ftBCD:
  4252.         if NativeFormat then
  4253.           DataConvert(Field, Buffer, @TVarData(Data).VCurrency, False) else
  4254.           Data := Currency(Buffer^);
  4255.       ftBytes, ftVarBytes:
  4256.         if NativeFormat then
  4257.           DataConvert(Field, Buffer, @Data, False) else
  4258.           Data := OleVariant(Buffer^);
  4259.       ftLargeInt:
  4260.         begin
  4261.           TVarData(Data).VType := VT_DECIMAL;
  4262.           Decimal(Data).Lo64 := Int64(Buffer^);
  4263.         end;
  4264.       else
  4265.         DatabaseErrorFmt(SUsupportedFieldType, [FieldTypeNames[Field.DataType],
  4266.           Field.DisplayName]);
  4267.     end;
  4268.   end;
  4269.  
  4270. var
  4271.   Data: OleVariant;
  4272.   RecBuf: PChar;
  4273. begin
  4274.   with Field do
  4275.   begin
  4276.     if not (State in dsWriteModes) then DatabaseError(SNotEditing, Self);
  4277.     GetActiveRecBuf(RecBuf);
  4278.     if FieldNo > 0 then
  4279.     begin
  4280.       if ReadOnly and not (State in [dsSetKey, dsFilter]) then
  4281.         DatabaseErrorFmt(SFieldReadOnly, [DisplayName]);
  4282.       Validate(Buffer);
  4283.       if FModifiedFields.IndexOf(Field) = -1 then
  4284.         FModifiedFields.Add(Field);
  4285.     end;
  4286.     if Buffer = nil then
  4287.       Data := Null else
  4288.       BufferToVar(Data);
  4289.     PVariantList(RecBuf + SizeOf(TRecInfo))[Field.Index] := Data;
  4290.     if not (State in [dsCalcFields, dsInternalCalc, dsFilter, dsNewValue]) then
  4291.       DataEvent(deFieldChange, Longint(Field));
  4292.   end;
  4293. end;
  4294.  
  4295. function TCustomADODataSet.CreateBlobStream(Field: TField;
  4296.   Mode: TBlobStreamMode): TStream;
  4297. begin
  4298.   Result := TADOBlobStream.Create(Field as TBlobField, Mode);
  4299. end;
  4300.  
  4301. procedure TCustomADODataSet.SetBlockReadSize(Value: Integer);
  4302. begin
  4303.   inherited;
  4304.   FBlockReadInfo := nil; { Placeholder for future optimization here }
  4305. end;
  4306.  
  4307. { Record Navigation / Editing }
  4308.  
  4309. procedure TCustomADODataSet.InternalFirst;
  4310. begin
  4311.   if not Recordset.BOF then
  4312.   begin
  4313.     Recordset.MoveFirst;
  4314.     if Recordset.Supports(adMovePrevious) and not Recordset.BOF then
  4315.       Recordset.MovePrevious;
  4316.   end;
  4317. end;
  4318.  
  4319. procedure TCustomADODataSet.InternalLast;
  4320. begin
  4321.   if not Recordset.EOF then
  4322.   begin
  4323.     Recordset.MoveLast;
  4324.     if not Recordset.EOF then
  4325.       Recordset.MoveNext;
  4326.   end;
  4327. end;
  4328.  
  4329. function TCustomADODataSet.GetCanModify: Boolean;
  4330. begin
  4331.   Result := Recordset.Supports(adUpdate);
  4332. end;
  4333.  
  4334. procedure TCustomADODataSet.InternalEdit;
  4335. begin
  4336.   FModifiedFields.Clear;
  4337. end;
  4338.  
  4339. procedure TCustomADODataSet.InternalInsert;
  4340. var
  4341.   I: Integer;
  4342.   FieldData: PVariantList;
  4343. begin
  4344.   FModifiedFields.Clear;
  4345.   FieldData := PVariantList(ActiveBuffer + SizeOf(TRecInfo));
  4346.   for I := 0 to Fields.Count - 1 do
  4347.     with Fields[I] do
  4348.       if FieldKind = fkData then
  4349.         FieldData[Index] := Null;
  4350. end;
  4351.  
  4352. procedure TCustomADODataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
  4353. begin
  4354.   if Append then InternalLast;
  4355.   InternalPost;
  4356. end;
  4357.  
  4358. procedure TCustomADODataSet.InternalPost;
  4359.  
  4360.   procedure UpdateData;
  4361.   var
  4362.     I: Integer;
  4363.     FieldData: PVariantList;
  4364.     Data: OleVariant;
  4365.   begin
  4366.     FieldData := PVariantList(ActiveBuffer + SizeOf(TRecInfo));
  4367.     for I := 0 to FModifiedFields.Count - 1 do
  4368.       with TField(FModifiedFields[I]) do
  4369.       if not ReadOnly then
  4370.       begin
  4371.         Data := FieldData[Index];
  4372.         if not VarIsEmpty(Data) then
  4373.           Recordset.Fields[FieldNo-1].Value := Data;
  4374.       end;
  4375.     if (Recordset.EditMode * (adEditInProgress + adEditAdd)) <> 0 then
  4376.       Recordset.Update(EmptyParam, EmptyParam);
  4377.   end;
  4378.  
  4379.   procedure CheckForFlyAway;
  4380.   begin
  4381.     if BookmarkSize > 0 then
  4382.     try
  4383.       { Check for fly away }
  4384.       Recordset.Bookmark := Recordset.Bookmark;
  4385.       if Recordset.EOF or Recordset.BOF then
  4386.       begin
  4387.         { If recordset is empty, then this prevents an error calling InternalFirst }
  4388.         if not Recordset.BOF and Recordset.Supports(adMovePrevious) then
  4389.           Recordset.MovePrevious;
  4390.         { Reposition to last record we were on }
  4391.         CursorPosChanged;
  4392.         UpdateCursorPos;
  4393.       end;
  4394.     except
  4395.       CursorPosChanged;
  4396.     end;
  4397.   end;
  4398.  
  4399. begin
  4400.   UpdateCursorPos;
  4401.   try
  4402.     if State = dsEdit then
  4403.       UpdateData
  4404.     else
  4405.     begin
  4406.       Recordset.AddNew(EmptyParam, EmptyParam);
  4407.       try
  4408.         UpdateData;
  4409.       except
  4410.         CursorPosChanged;
  4411.         Recordset.CancelUpdate;
  4412.         raise;
  4413.       end;
  4414.     end;
  4415.   except
  4416.     on E: Exception do
  4417.       DatabaseError(E.Message);
  4418.   end;
  4419.   CheckForFlyAway;
  4420. end;
  4421.  
  4422. procedure TCustomADODataSet.InternalDelete;
  4423. begin
  4424.   try
  4425.     Recordset.Delete(adAffectCurrent);
  4426.     Recordset.MoveNext;
  4427.   except
  4428.     on E: Exception do
  4429.       DatabaseError(E.Message);
  4430.   end;
  4431. end;
  4432.  
  4433. procedure TCustomADODataSet.DeleteRecords(AffectRecords: TAffectRecords);
  4434. begin
  4435.   CheckActive;
  4436.   UpdateCursorPos;
  4437.   CursorPosChanged;
  4438.   Recordset.Delete(AffectRecordsValues[AffectRecords]);
  4439.   Resync([]);
  4440. end;
  4441.  
  4442. procedure TCustomADODataSet.InternalCancel;
  4443. begin
  4444.   Recordset.CancelUpdate;
  4445. end;
  4446.  
  4447. procedure TCustomADODataSet.CancelUpdates;
  4448. begin
  4449.   CheckActive;
  4450.   InternalCancel;
  4451. end;
  4452.  
  4453. procedure TCustomADODataSet.CancelBatch(AffectRecords: TAffectRecords);
  4454. begin
  4455.   CancelUpdates;
  4456.   Recordset.CancelBatch(AffectRecordsValues[AffectRecords]);
  4457.   UpdateCursorPos;
  4458.   Resync([]);
  4459. end;
  4460.  
  4461. procedure TCustomADODataSet.UpdateBatch(AffectRecords: TAffectRecords);
  4462. begin
  4463.   CheckBrowseMode;
  4464.   Recordset.UpdateBatch(AffectRecordsValues[AffectRecords]);
  4465.   UpdateCursorPos;
  4466.   Resync([]);
  4467. end;
  4468.  
  4469. { Filters }
  4470.  
  4471. procedure TCustomADODataSet.ActivateTextFilter(const FilterText: string);
  4472. begin
  4473.   try
  4474.     Recordset.Filter := FilterText;
  4475.   except
  4476.     CursorPosChanged;
  4477.     raise;
  4478.   end;
  4479. end;
  4480.  
  4481. procedure TCustomADODataSet.DeactivateFilters;
  4482. begin
  4483.   Recordset.Filter := adFilterNone;
  4484. end;
  4485.  
  4486. procedure TCustomADODataSet.SetFilterOptions(Value: TFilterOptions);
  4487. begin
  4488.   if Value <> [] then
  4489.     DatabaseError(SNoFilterOptions);
  4490. end;
  4491.  
  4492. procedure TCustomADODataSet.SetFilterText(const Value: string);
  4493. begin
  4494.   if Filter <> Value then
  4495.   begin
  4496.     if (Value <> '') and (MasterFields <> '') then
  4497.       DatabaseError(SNoDetailFilter, Self);
  4498.     if Active and Filtered then
  4499.     begin
  4500.       CheckBrowseMode;
  4501.       if Value <> '' then
  4502.         ActivateTextFilter(Value) else
  4503.         DeactivateFilters;
  4504.       DestroyLookupCursor;
  4505.       First;
  4506.     end;
  4507.     inherited SetFilterText(Value);
  4508.     FFilterGroup := fgUnassigned;
  4509.   end;
  4510. end;
  4511.  
  4512. procedure TCustomADODataSet.SetFiltered(Value: Boolean);
  4513. begin
  4514.   if Filtered <> Value then
  4515.   begin
  4516.     if Active then
  4517.     begin
  4518.       CheckBrowseMode;
  4519.       DestroyLookupCursor;
  4520.       if Value then
  4521.       begin
  4522.         if FFilterGroup <> fgUnassigned then
  4523.           Recordset.Filter := FilterGroupValues[FFilterGroup] else
  4524.           ActivateTextFilter(Filter)
  4525.       end
  4526.       else
  4527.         DeactivateFilters;
  4528.       inherited SetFiltered(Value);
  4529.       First;
  4530.     end else
  4531.       inherited SetFiltered(Value);
  4532.   end;
  4533. end;
  4534.  
  4535. function TCustomADODataSet.GetFilterGroup: TFilterGroup;
  4536. var
  4537.   FilterVar: OleVariant;
  4538. begin
  4539.   if Active and Filtered then
  4540.   begin
  4541.     FilterVar := Recordset.Filter;
  4542.     if (VarType(FilterVar) = varInteger) and
  4543.       (FilterVar >= adFilterNone) and (FilterVar <= adFilterConflictingRecords) then
  4544.       FFilterGroup := TFilterGroup(OleEnumToOrd(FilterGroupValues, FilterVar))
  4545.     else
  4546.       FFilterGroup := fgUnassigned;
  4547.   end;
  4548.   Result := FFilterGroup;
  4549. end;
  4550.  
  4551. procedure TCustomADODataSet.SetFilterGroup(const Value: TFilterGroup);
  4552. begin
  4553.   CheckBrowseMode;
  4554.   inherited SetFilterText('');
  4555.   FFilterGroup := Value;
  4556.   if (FFilterGroup <> fgUnassigned) and Filtered then
  4557.   begin
  4558.     Recordset.Filter := FilterGroupValues[FFilterGroup];
  4559.     First;
  4560.   end;
  4561. end;
  4562.  
  4563. procedure TCustomADODataSet.FilterOnBookmarks(Bookmarks: array of const);
  4564. var
  4565.   I: Integer;
  4566.   BookmarkData: OleVariant;
  4567. begin
  4568.   CheckBrowseMode;
  4569.   BookmarkData := VarArrayCreate([Low(Bookmarks), High(Bookmarks)], varVariant);
  4570.   for I := Low(Bookmarks) to High(Bookmarks) do
  4571.      BookmarkData[I] := POleVariant(TVarRec(Bookmarks[I]).VPointer)^;
  4572.   inherited SetFilterText('');
  4573.   FFilterGroup := fgUnassigned;
  4574.   DestroyLookupCursor;
  4575.   try
  4576.     Recordset.Filter := BookmarkData;
  4577.     First;
  4578.     inherited SetFiltered(True);
  4579.   except
  4580.     inherited SetFiltered(False);
  4581.     raise;
  4582.   end;
  4583. end;
  4584.  
  4585. function TCustomADODataSet.FindRecord(Restart,
  4586.   GoForward: Boolean): Boolean;
  4587. var
  4588.   Cursor: _Recordset;
  4589. begin
  4590.   CheckBrowseMode;
  4591.   SetFound(False);
  4592.   UpdateCursorPos;
  4593.   CursorPosChanged;
  4594.   DoBeforeScroll;
  4595.   if not Filtered then
  4596.   begin
  4597.     if Restart then FFindCursor := nil;
  4598.     if not Assigned(FFindCursor) then
  4599.     begin
  4600.       FFindCursor := Recordset.Clone(adLockReadOnly);
  4601.       FFindCursor.Filter := Filter;
  4602.     end else
  4603.       if not Restart then FFindCursor.Bookmark := Recordset.Bookmark;
  4604.     Cursor := FFindCursor;
  4605.   end else
  4606.     Cursor := Recordset;
  4607.   try
  4608.     if GoForward then
  4609.     begin
  4610.       if Restart then
  4611.         Cursor.MoveFirst else
  4612.         Cursor.MoveNext;
  4613.     end else
  4614.     begin
  4615.       if Restart then
  4616.         Cursor.MoveLast else
  4617.         Cursor.MovePrevious;
  4618.     end;
  4619.     if Cursor <> Recordset then
  4620.       Recordset.Bookmark := FFindCursor.Bookmark;
  4621.     Resync([rmExact, rmCenter]);
  4622.     SetFound(True);
  4623.   except
  4624.     { Exception = not found }
  4625.   end;
  4626.   Result := Found;
  4627.   if Result then DoAfterScroll;
  4628. end;
  4629.  
  4630. { Lookup and Locate }
  4631.  
  4632. procedure TCustomADODataSet.DestroyLookupCursor;
  4633. begin
  4634.   FLookupCursor := nil;
  4635.   FFindCursor := nil;
  4636. end;
  4637.  
  4638. function TCustomADODataSet.LocateRecord(const KeyFields: string;
  4639.   const KeyValues: OleVariant; Options: TLocateOptions;
  4640.   SyncCursor: Boolean): Boolean;
  4641. var
  4642.   Fields: TList;
  4643.   Buffer: PChar;
  4644.   I, FieldCount: Integer;
  4645.   Partial: Boolean;
  4646.   SortList, FieldExpr, LocateFilter: string;
  4647. begin
  4648.   CheckBrowseMode;
  4649.   UpdateCursorPos;
  4650.   CursorPosChanged;
  4651.   Buffer := TempBuffer;
  4652.   Partial := loPartialKey in Options;
  4653.   Fields := TList.Create;
  4654.   DoBeforeScroll;
  4655.   try
  4656.     GetFieldList(Fields, KeyFields);
  4657.     if not Assigned(FLookupCursor) then
  4658.       FLookupCursor := Recordset.Clone(adLockReadOnly);
  4659.     if CursorLocation = clUseClient then
  4660.     begin
  4661.       for I := 0 to Fields.Count - 1 do
  4662.         with TField(Fields[I]) do
  4663.           if Pos(' ', FieldName) > 0 then
  4664.           SortList := Format('%s[%s],', [SortList, FieldName]) else
  4665.           SortList := Format('%s%s,', [SortList, FieldName]);
  4666.       SetLength(SortList, Length(SortList)-1);
  4667.       FLookupCursor.Sort := SortList;
  4668.     end;
  4669.     FLookupCursor.Filter := '';
  4670.     FFilterBuffer := Buffer;
  4671.     SetTempState(dsFilter);
  4672.     try
  4673.       InitRecord(Buffer);
  4674.       FieldCount := Fields.Count;
  4675.       if FieldCount = 1 then
  4676.         FLookupCursor.Find(GetFilterStr(FieldByName(KeyFields), KeyValues, Partial), 0,
  4677.          adSearchForward, EmptyParam)
  4678.       else
  4679.       begin
  4680.         for I := 0 to FieldCount - 1 do
  4681.         begin
  4682.           FieldExpr := GetFilterStr(Fields[I], KeyValues[I], (Partial and (I = FieldCount-1)));
  4683.           if LocateFilter <> '' then
  4684.              LocateFilter := LocateFilter + ' AND ' + FieldExpr else
  4685.              LocateFilter := FieldExpr;
  4686.         end;
  4687.         FLookupCursor.Filter := LocateFilter;
  4688.       end;
  4689.     finally
  4690.       RestoreState(dsBrowse);
  4691.     end;
  4692.   finally
  4693.     Fields.Free;
  4694.   end;
  4695.   Result := not FLookupCursor.EOF;
  4696.   if Result then
  4697.     if SyncCursor then
  4698.       Recordset.Bookmark := FLookupCursor.Bookmark
  4699.     else
  4700.       { For lookups, read all field values into the temp buffer }
  4701.       for I := 0 to Self.Fields.Count - 1 do
  4702.        with Self.Fields[I] do
  4703.         if FieldKind = fkData then
  4704.           PVariantList(Buffer+SizeOf(TRecInfo))[Index] := FLookupCursor.Fields[FieldNo-1].Value;
  4705. end;
  4706.  
  4707. function TCustomADODataSet.Lookup(const KeyFields: string; const KeyValues: Variant;
  4708.   const ResultFields: string): Variant;
  4709. begin
  4710.   Result := Null;
  4711.   if LocateRecord(KeyFields, KeyValues, [], False) then
  4712.   begin
  4713.     SetTempState(dsCalcFields);
  4714.     try
  4715.       CalculateFields(TempBuffer);
  4716.       Result := FieldValues[ResultFields];
  4717.     finally
  4718.       RestoreState(dsBrowse);
  4719.     end;
  4720.   end;
  4721. end;
  4722.  
  4723. function TCustomADODataSet.Locate(const KeyFields: string;
  4724.   const KeyValues: Variant; Options: TLocateOptions): Boolean;
  4725. begin
  4726.   DoBeforeScroll;
  4727.   Result := LocateRecord(KeyFields, KeyValues, Options, True);
  4728.   if Result then
  4729.   begin
  4730.     Resync([rmExact, rmCenter]);
  4731.     DoAfterScroll;
  4732.   end;
  4733. end;
  4734.  
  4735. function TCustomADODataSet.Seek(const KeyValues: Variant;
  4736.   SeekOption: TSeekOption = soFirstEQ): Boolean;
  4737. begin
  4738.   DoBeforeScroll;
  4739.   CheckBrowseMode;
  4740.   Recordset.Seek(KeyValues, SeekOptionValues[SeekOption]);
  4741.   Result := not RecordSet.EOF;
  4742.   if Result then
  4743.   begin
  4744.     Resync([rmExact, rmCenter]);
  4745.     DoAfterScroll;
  4746.   end else
  4747.     CursorPosChanged;
  4748. end;
  4749.  
  4750. { Indexes }
  4751.  
  4752. procedure TCustomADODataSet.UpdateIndexDefs;
  4753. const
  4754.   SUnique = 'UNIQUE';                      { Do not localize + 5 }
  4755.   SIndexName = 'INDEX_NAME';
  4756.   SColumnName = 'COLUMN_NAME';
  4757.   SPrimaryKey = 'PRIMARY_KEY';
  4758.   SAutoUpdate = 'AUTO_UPDATE';
  4759.   SOrdinalPosition = 'ORDINAL_POSITION';
  4760. var
  4761.   IndexInfo: _Recordset;
  4762. begin
  4763.   try
  4764.     FieldDefs.Update;
  4765.     IndexDefs.Clear;
  4766.     if (CommandType in [cmdTable, cmdTableDirect]) and (CommandText <> '') then
  4767.     begin
  4768.       SetConnectionFlag(cfIndex, True);
  4769.       try
  4770.         IndexInfo := Command.ActiveConnection.OpenSchema(adSchemaIndexes,
  4771.           VarArrayOf([Unassigned, Unassigned, Unassigned, Unassigned, CommandText]),
  4772.           EmptyParam);
  4773.         while not IndexInfo.EOF do
  4774.         begin
  4775.           if TagVariant(IndexInfo.Fields[SOrdinalPosition].Value).ulVal > 1 then
  4776.             with IndexDefs.Find(IndexInfo.Fields[SIndexName].Value) do
  4777.               Fields := Format('%s;%s', [Fields, IndexInfo.Fields[SColumnName].Value])
  4778.           else
  4779.             with IndexDefs.AddIndexDef do
  4780.             begin
  4781.               Name := VarToStr(IndexInfo.Fields[SIndexName].Value);
  4782.               Fields := VarToStr(IndexInfo.Fields[SColumnName].Value);
  4783.               if IndexInfo.Fields[SPrimaryKey].Value = True then
  4784.                 Options := Options + [ixPrimary];
  4785.               if IndexInfo.Fields[SUnique].Value = True then
  4786.                 Options := Options + [ixUnique];
  4787.               if IndexInfo.Fields[SAutoUpdate].Value = False then
  4788.                 Options := Options + [ixNonMaintained];
  4789.             end;
  4790.           IndexInfo.MoveNext;
  4791.         end;
  4792.       finally
  4793.         SetConnectionFlag(cfIndex, False);
  4794.       end;
  4795.     end;
  4796.   except
  4797.     { do nothing }
  4798.   end;
  4799. end;
  4800.  
  4801. { RecordsetEvents }
  4802.  
  4803. procedure TCustomADODataSet.EnableEvents;
  4804. begin
  4805.   if Assigned(FOnWillChangeField) or Assigned(FOnFieldChangeComplete) or
  4806.     Assigned(FOnWillChangeRecord) or Assigned(FOnRecordChangeComplete) or
  4807.     Assigned(FOnWillChangeRecordset) or Assigned(FOnRecordsetChangeComplete) or
  4808.     Assigned(FOnWillMove) or Assigned(FOnMoveComplete) or
  4809.     Assigned(FOnEndOfRecordset) or Assigned(FOnFetchComplete) or
  4810.     Assigned(FOnFetchProgress) then
  4811.   begin
  4812.     if (CommandType = cmdTableDirect) and (CursorLocation = clUseServer) then
  4813.       DatabaseError(SEventsNotSupported);
  4814.     OleCheck(ConnectionPoint.Advise(Self as IUnknown, FEventsID));
  4815.   end;
  4816. end;
  4817.  
  4818. function TCustomADODataSet.ConnectionPoint: IConnectionPoint;
  4819. var
  4820.   ConnPtContainer: IConnectionPointContainer;
  4821. begin
  4822.   OleCheck(Recordset.QueryInterface(IConnectionPointContainer,
  4823.     ConnPtContainer));
  4824.   OleCheck(ConnPtContainer.FindConnectionPoint(RecordsetEvents, Result));
  4825. end;
  4826.  
  4827. procedure TCustomADODataSet.WillChangeField(cFields: Integer;
  4828.   Fields: OleVariant; var adStatus: EventStatusEnum;
  4829.   const pRecordset: _Recordset);
  4830. var
  4831.   EventStatus: TEventStatus;
  4832. begin
  4833.   if Assigned(OnWillChangeField) then
  4834.   begin
  4835.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  4836.     OnWillChangeField(Self, cFields, Fields, EventStatus);
  4837.     adStatus := EventStatusValues[EventStatus];
  4838.   end else
  4839.     adStatus := adStatusUnwantedEvent;
  4840. end;
  4841.  
  4842. procedure TCustomADODataSet.FieldChangeComplete(cFields: Integer;
  4843.   Fields: OleVariant; const pError: Error; var adStatus: EventStatusEnum;
  4844.   const pRecordset: _Recordset);
  4845. var
  4846.   EventStatus: TEventStatus;
  4847. begin
  4848.   if Assigned(OnFieldChangeComplete) then
  4849.   begin
  4850.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  4851.     OnFieldChangeComplete(Self, cFields, Fields, pError, EventStatus);
  4852.     adStatus := EventStatusValues[EventStatus];
  4853.   end else
  4854.     adStatus := adStatusUnwantedEvent;
  4855. end;
  4856.  
  4857. procedure TCustomADODataSet.WillChangeRecord(adReason: EventReasonEnum;
  4858.   cRecords: Integer; var adStatus: EventStatusEnum;
  4859.   const pRecordset: _Recordset);
  4860. var
  4861.   EventStatus: TEventStatus;
  4862. begin
  4863.   if Assigned(OnWillChangeRecord) then
  4864.   begin
  4865.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  4866.     OnWillChangeRecord(Self, TEventReason(OleEnumToOrd(EventReasonValues,
  4867.       adReason)), cRecords, EventStatus);
  4868.     adStatus := EventStatusValues[EventStatus];
  4869.   end else
  4870.     adStatus := adStatusUnwantedEvent;
  4871. end;
  4872.  
  4873. procedure TCustomADODataSet.RecordChangeComplete(adReason: EventReasonEnum;
  4874.   cRecords: Integer; const pError: Error; var adStatus: EventStatusEnum;
  4875.   const pRecordset: _Recordset);
  4876. var
  4877.   EventStatus: TEventStatus;
  4878. begin
  4879.   if Assigned(OnRecordChangeComplete) then
  4880.   begin
  4881.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  4882.     OnRecordChangeComplete(Self, TEventReason(OleEnumToOrd(EventReasonValues,
  4883.       adReason)), cRecords, pError, EventStatus);
  4884.     adStatus := EventStatusValues[EventStatus];
  4885.   end else
  4886.     adStatus := adStatusUnwantedEvent;
  4887. end;
  4888.  
  4889. procedure TCustomADODataSet.WillChangeRecordset(adReason: EventReasonEnum;
  4890.   var adStatus: EventStatusEnum; const pRecordset: _Recordset);
  4891. var
  4892.   EventStatus: TEventStatus;
  4893. begin
  4894.   if Assigned(OnWillChangeRecordset) then
  4895.   begin
  4896.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  4897.     OnWillChangeRecordset(Self, TEventReason(OleEnumToOrd(EventReasonValues,
  4898.       adReason)), EventStatus);
  4899.     adStatus := EventStatusValues[EventStatus];
  4900.   end else
  4901.     adStatus := adStatusUnwantedEvent;
  4902. end;
  4903.  
  4904. procedure TCustomADODataSet.RecordsetChangeComplete(
  4905.   adReason: EventReasonEnum; const pError: Error;
  4906.   var adStatus: EventStatusEnum; const pRecordset: _Recordset);
  4907. var
  4908.   EventStatus: TEventStatus;
  4909. begin
  4910.   if Assigned(OnRecordsetChangeComplete) then
  4911.   begin
  4912.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  4913.     OnRecordsetChangeComplete(Self, TEventReason(OleEnumToOrd(EventReasonValues, adReason)),
  4914.       pError, EventStatus);
  4915.     adStatus := EventStatusValues[EventStatus];
  4916.   end else
  4917.     adStatus := adStatusUnwantedEvent;
  4918. end;
  4919.  
  4920. procedure TCustomADODataSet.WillMove(adReason: EventReasonEnum;
  4921.   var adStatus: EventStatusEnum; const pRecordset: _Recordset);
  4922. var
  4923.   EventStatus: TEventStatus;
  4924. begin
  4925.   if Assigned(OnWillMove) then
  4926.   begin
  4927.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  4928.     OnWillMove(Self, TEventReason(OleEnumToOrd(EventReasonValues, adReason)),
  4929.       EventStatus);
  4930.     adStatus := EventStatusValues[EventStatus];
  4931.   end else
  4932.     adStatus := adStatusUnwantedEvent;
  4933. end;
  4934.  
  4935. procedure TCustomADODataSet.MoveComplete(adReason: EventReasonEnum;
  4936.   const pError: Error; var adStatus: EventStatusEnum;
  4937.   const pRecordset: _Recordset);
  4938. var
  4939.   EventStatus: TEventStatus;
  4940. begin
  4941.   if Assigned(OnMoveComplete) then
  4942.   begin
  4943.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  4944.     OnMoveComplete(Self, TEventReason(OleEnumToOrd(EventReasonValues, adReason)),
  4945.       pError, EventStatus);
  4946.     adStatus := EventStatusValues[EventStatus];
  4947.   end else
  4948.     adStatus := adStatusUnwantedEvent;
  4949. end;
  4950.  
  4951. procedure TCustomADODataSet.EndOfRecordset(var fMoreData: WordBool;
  4952.   var adStatus: EventStatusEnum; const pRecordset: _Recordset);
  4953. var
  4954.   EventStatus: TEventStatus;
  4955. begin
  4956.   if Assigned(OnEndOfRecordset) then
  4957.   begin
  4958.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  4959.     OnEndOfRecordset(Self, fMoreData, EventStatus);
  4960.     adStatus := EventStatusValues[EventStatus];
  4961.   end else
  4962.     adStatus := adStatusUnwantedEvent;
  4963. end;
  4964.  
  4965. procedure TCustomADODataSet.FetchComplete(const pError: Error;
  4966.   var adStatus: EventStatusEnum; const pRecordset: _Recordset);
  4967. var
  4968.   EventStatus: TEventStatus;
  4969. begin
  4970.   if Assigned(OnFetchComplete) then
  4971.   begin
  4972.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  4973.     OnFetchComplete(Self, pError, EventStatus);
  4974.     adStatus := EventStatusValues[EventStatus];
  4975.   end else
  4976.     adStatus := adStatusUnwantedEvent;
  4977. end;
  4978.  
  4979. procedure TCustomADODataSet.FetchProgress(Progress, MaxProgress: Integer;
  4980.   var adStatus: EventStatusEnum; const pRecordset: _Recordset);
  4981. var
  4982.   EventStatus: TEventStatus;
  4983. begin
  4984.   if Assigned(OnFetchProgress) then
  4985.   begin
  4986.     EventStatus := TEventStatus(OleEnumToOrd(EventStatusValues, adStatus));
  4987.     OnFetchProgress(Self, Progress, MaxProgress, EventStatus);
  4988.     adStatus := EventStatusValues[EventStatus];
  4989.   end
  4990.   { Note that if we return unwanted for this event it also disables Fetchcomplete }
  4991.   else if not Assigned(OnFetchComplete) then
  4992.     adStatus := adStatusUnwantedEvent;
  4993. end;
  4994.  
  4995. { Informational }
  4996.  
  4997. function TCustomADODataSet.GetRecordCount: Longint;
  4998. begin
  4999.   CheckActive;
  5000.   Result := Recordset.RecordCount;
  5001. end;
  5002.  
  5003. function TCustomADODataSet.GetRecNo: Longint;
  5004. var
  5005.   BufPtr: PChar;
  5006. begin
  5007.   CheckActive;
  5008.   if State = dsCalcFields then
  5009.     BufPtr := CalcBuffer else
  5010.     BufPtr := ActiveBuffer;
  5011.   Result := PRecInfo(BufPtr).RecordNumber;
  5012. end;
  5013.  
  5014. procedure TCustomADODataSet.SetRecNo(Value: Integer);
  5015. begin
  5016.   if RecNo <> Value then
  5017.   begin
  5018.     DoBeforeScroll;
  5019.     Recordset.AbsolutePosition := Value;
  5020.     Resync([rmCenter]);
  5021.     DoAfterScroll;
  5022.   end;
  5023. end;
  5024.  
  5025. function TCustomADODataSet.IsSequenced: Boolean;
  5026. begin
  5027.   Result := Assigned(RecordSet) and Recordset.Supports(adApproxPosition);
  5028. end;
  5029.  
  5030. function TCustomADODataSet.Supports(CursorOptions: TCursorOptions): Boolean;
  5031. var
  5032.   Opt: TCursorOption;
  5033.   Options: TOleEnum;
  5034. begin
  5035.   CheckActive;
  5036.   begin
  5037.     Options := 0;
  5038.     for Opt := Low(TCursorOption) to High(TCursorOption) do
  5039.       if Opt in CursorOptions then
  5040.         Options := Options + CursorOptionValues[Opt];
  5041.     Result := Recordset.Supports(Options);
  5042.   end;
  5043. end;
  5044.  
  5045. { Property Access }
  5046.  
  5047. procedure TCustomADODataSet.PropertyChanged;
  5048. begin
  5049.   if not (csReading in ComponentState) then
  5050.     DataEvent(dePropertyChange, 0);
  5051. end;
  5052.  
  5053. function TCustomADODataSet.GetCacheSize: Integer;
  5054. begin
  5055.   if Assigned(Recordset) then
  5056.     FCacheSize := Recordset.CacheSize;
  5057.   Result := FCacheSize;
  5058. end;
  5059.  
  5060. procedure TCustomADODataSet.SetCacheSize(const Value: Integer);
  5061. begin
  5062.   FCacheSize := Value;
  5063.   if Assigned(Recordset) then
  5064.     Recordset.CacheSize := FCacheSize;
  5065. end;
  5066.  
  5067. function TCustomADODataSet.GetCommandText: WideString;
  5068. begin
  5069.   Result := Command.CommandText;
  5070. end;
  5071.  
  5072. procedure TCustomADODataSet.SetCommandText(const Value: WideString);
  5073. begin
  5074.   if CommandText <> Value then
  5075.   begin
  5076.     CheckInactive;
  5077.     Command.CommandText := Value;
  5078.     PropertyChanged;
  5079.   end;
  5080. end;
  5081.  
  5082. function TCustomADODataSet.GetCommandTimeout: Integer;
  5083. begin
  5084.   Result := Command.CommandTimeout;
  5085. end;
  5086.  
  5087. procedure TCustomADODataSet.SetCommandTimeout(const Value: Integer);
  5088. begin
  5089.   Command.CommandTimeout := Value;
  5090. end;
  5091.  
  5092. function TCustomADODataSet.GetCommandType: TCommandType;
  5093. begin
  5094.   if (FRSCommandType in RSOnlyCommandTypes) then
  5095.     Result := FRSCommandType else
  5096.     Result := Command.CommandType;
  5097. end;
  5098.  
  5099. procedure TCustomADODataSet.SetCommandType(const Value: TCommandType);
  5100. begin
  5101.   if CommandType <> Value then
  5102.   begin
  5103.     CheckInactive;
  5104.     FRSCommandType := Value;
  5105.     if not (Value in RSOnlyCommandTypes) then
  5106.       Command.CommandType := Value else
  5107.       Command.CommandType := cmdUnknown;
  5108.     PropertyChanged;
  5109.   end;
  5110. end;
  5111.  
  5112. function TCustomADODataSet.GetConnection: TADOConnection;
  5113. begin
  5114.   if Assigned(Command) then
  5115.     Result := Command.Connection else
  5116.     Result := nil;
  5117. end;
  5118.  
  5119. procedure TCustomADODataSet.SetConnection(const Value: TADOConnection);
  5120. begin
  5121.   if Connection <> Value then
  5122.   begin
  5123.     { At design time we require the dataset to be closed }
  5124.     if (csDesigning in ComponentState) then CheckInactive;
  5125.     { Set a flag that we can no longer requery if active }
  5126.     FConnectionChanged := Active;
  5127.     { Allow nil assignment while open for disconnected recordsets }
  5128.     if Active and (Value = nil) then
  5129.       RecordSet.Set_ActiveConnection(nil);
  5130.     if Assigned(Connection) then Connection.UnregisterClient(Self);
  5131.     if Assigned(Command) then Command.Connection := Value;
  5132.     if Assigned(Value) then
  5133.     begin
  5134.       Value.RegisterClient(Self);
  5135.       if Active and Assigned(Value.ConnectionObject) then
  5136.         RecordSet.Set_ActiveConnection(Value.ConnectionObject);
  5137.     end;
  5138.     if not (csLoading in ComponentState) then
  5139.       DataEvent(dePropertyChange, 0);
  5140.   end;
  5141. end;
  5142.  
  5143. function TCustomADODataSet.GetConnectionString: WideString;
  5144. begin
  5145.   Result := Command.ConnectionString;
  5146. end;
  5147.  
  5148. procedure TCustomADODataSet.SetConnectionString(const Value: WideString);
  5149. begin
  5150.   if ConnectionString <> Value then
  5151.   begin
  5152.     CheckInactive;
  5153.     Connection := nil;
  5154.     Command.ConnectionString := Value
  5155.   end;
  5156. end;
  5157.  
  5158. function TCustomADODataSet.GetCursorLocation: TCursorLocation;
  5159. begin
  5160.   if Assigned(Recordset) then
  5161.     FCursorLocation := TCursorLocation(OleEnumToOrd(CursorLocationValues,
  5162.       Recordset.CursorLocation));
  5163.   Result := FCursorLocation;
  5164. end;
  5165.  
  5166. procedure TCustomADODataSet.SetCursorLocation(const Value: TCursorLocation);
  5167. begin
  5168.   if CursorLocation <> Value then
  5169.   begin
  5170.     CheckInactive;
  5171.     FCursorLocation := Value;
  5172.     PropertyChanged;
  5173.   end;
  5174. end;
  5175.  
  5176. function TCustomADODataSet.GetCursorType: TCursorType;
  5177. begin
  5178.   if Assigned(Recordset) then
  5179.     FCursorType := TCursorType(OleEnumToOrd(CursorTypeValues,
  5180.       Recordset.CursorType));
  5181.   Result := FCursorType;
  5182. end;
  5183.  
  5184. procedure TCustomADODataSet.SetCursorType(const Value: TCursorType);
  5185. begin
  5186.   if CursorType <> Value then
  5187.   begin
  5188.     CheckInactive;
  5189.     FCursorType := Value;
  5190.     PropertyChanged;
  5191.   end;
  5192. end;
  5193.  
  5194. function TCustomADODataSet.GetDataSource: TDataSource;
  5195. begin
  5196.   Result := MasterDataLink.DataSource;
  5197. end;
  5198.  
  5199. procedure TCustomADODataSet.SetDataSource(const Value: TDataSource);
  5200. begin
  5201.   if IsLinkedTo(Value) then DatabaseError(SCircularDataLink, Self);
  5202.   MasterDataLink.DataSource := Value;
  5203. end;
  5204.  
  5205. function TCustomADODataSet.GetExecuteOptions: TExecuteOptions;
  5206. begin
  5207.   Result := Command.ExecuteOptions;
  5208. end;
  5209.  
  5210. procedure TCustomADODataSet.SetExecuteOptions(const Value: TExecuteOptions);
  5211. begin
  5212.   Command.ExecuteOptions := Value;
  5213. end;
  5214.  
  5215. function TCustomADODataSet.GetLockType: TADOLockType;
  5216. begin
  5217.   if Assigned(Recordset) then
  5218.     FLockType := TADOLockType(OleEnumToOrd(LockTypeValues, Recordset.LockType));
  5219.   Result := FLockType;
  5220. end;
  5221.  
  5222. procedure TCustomADODataSet.SetLockType(const Value: TADOLockType);
  5223. begin
  5224.   if LockType <> Value then
  5225.   begin
  5226.     CheckInactive;
  5227.     FLockType := Value;
  5228.   end;
  5229. end;
  5230.  
  5231. function TCustomADODataSet.GetMarshalOptions: TMarshalOption;
  5232. begin
  5233.   if Assigned(Recordset) then
  5234.     FMarshalOptions := TMarshalOption(OleEnumToOrd(MarshalOptionValues,
  5235.       Recordset.MarshalOptions));
  5236.   Result := FMarshalOptions;
  5237. end;
  5238.  
  5239. procedure TCustomADODataSet.SetMarshalOptions(const Value: TMarshalOption);
  5240. begin
  5241.   if Assigned(Recordset) then
  5242.     Recordset.MarshalOptions := MarshalOptionValues[Value];
  5243.   FMarshalOptions := Value;
  5244. end;
  5245.  
  5246. function TCustomADODataSet.GetMasterFields: string;
  5247. begin
  5248.   Result := MasterDataLink.FieldNames;
  5249. end;
  5250.  
  5251. procedure TCustomADODataSet.SetMasterFields(const Value: string);
  5252. begin
  5253.   if (Value <> '') and (Filter <> '') then
  5254.     DatabaseError(SNoDetailFilter, Self);
  5255.   MasterDataLink.FieldNames := Value;
  5256. end;
  5257.  
  5258. function TCustomADODataSet.GetMaxRecords: Integer;
  5259. begin
  5260.   if Assigned(Recordset) then
  5261.     FMaxRecords := Recordset.MaxRecords;
  5262.   Result := FMaxRecords;
  5263. end;
  5264.  
  5265. procedure TCustomADODataSet.SetMaxRecords(const Value: Integer);
  5266. begin
  5267.   if MaxRecords <> Value then
  5268.   begin
  5269.     CheckInactive;
  5270.     FMaxRecords := Value;
  5271.   end;
  5272. end;
  5273.  
  5274. function TCustomADODataSet.GetParamCheck: Boolean;
  5275. begin
  5276.   Result := Command.ParamCheck;
  5277. end;
  5278.  
  5279. procedure TCustomADODataSet.SetParamCheck(const Value: Boolean);
  5280. begin
  5281.   Command.ParamCheck := Value;
  5282. end;
  5283.  
  5284. function TCustomADODataSet.GetParameters: TParameters;
  5285. begin
  5286.   Result := Command.Parameters;
  5287. end;
  5288.  
  5289. procedure TCustomADODataSet.SetParameters(const Value: TParameters);
  5290. begin
  5291.   Command.Parameters.Assign(Value);
  5292. end;
  5293.  
  5294. function TCustomADODataSet.GetPrepared: Boolean;
  5295. begin
  5296.   Result := Command.Prepared;
  5297. end;
  5298.  
  5299. procedure TCustomADODataSet.SetPrepared(const Value: Boolean);
  5300. begin
  5301.   Command.Prepared := Value;
  5302. end;
  5303.  
  5304. function TCustomADODataSet.GetProperties: Properties;
  5305. begin
  5306.   if Assigned(Recordset) then
  5307.     Result := Recordset.Properties else
  5308.     Result := nil; 
  5309. end;
  5310.  
  5311. procedure TCustomADODataSet.SetRecordset(const Value: _Recordset);
  5312. begin
  5313.   Close;
  5314.   FRecordsetObject := Value;
  5315.   if Assigned(Value) then
  5316.   try
  5317.     Open;
  5318.   except
  5319.     Close;
  5320.     raise;
  5321.   end;
  5322. end;
  5323.  
  5324. function TCustomADODataSet.GetRecordsetState: TObjectStates;
  5325. begin
  5326.   if Assigned(Recordset) then
  5327.     Result := GetStates(Recordset.State) else
  5328.     Result := [];
  5329. end;
  5330.  
  5331. function TCustomADODataSet.GetRecordStatus: TRecordStatusSet;
  5332. var
  5333.   Status: Integer;
  5334.   RecStatus: TRecordStatus;
  5335. begin
  5336.   CheckActive;
  5337.   Result := [];
  5338.   if State = dsCalcFields then
  5339.     Status := PRecInfo(CalcBuffer).RecordStatus else
  5340.     Status := PRecInfo(ActiveBuffer).RecordStatus;
  5341.   for RecStatus := Low(TRecordStatus) to High(TRecordStatus) do
  5342.     if (RecordStatusValues[RecStatus] and Status) <> 0 then
  5343.       Include(Result, RecStatus);
  5344. end;
  5345.  
  5346. function TCustomADODataSet.GetSort: WideString;
  5347. begin
  5348.   if Assigned(Recordset) then
  5349.     Result := Recordset.Sort else
  5350.     Result := '';
  5351. end;
  5352.  
  5353. procedure TCustomADODataSet.InternalSetSort(Value: WideString);
  5354. begin
  5355.   Recordset.Sort := Value;
  5356.   RefreshIndexFields;
  5357. end;
  5358.  
  5359. procedure TCustomADODataSet.SetSort(const Value: WideString);
  5360. begin
  5361.   CheckActive;
  5362.   UpdateCursorPos;
  5363.   InternalSetSort(Value);
  5364.   Resync([]);
  5365. end;
  5366.  
  5367. function TCustomADODataSet.GetIndexFieldNames: string;
  5368. begin
  5369.   if Active then
  5370.   begin
  5371.     Result := StringReplace(Sort, ',', ';', [rfReplaceAll]);
  5372.     FIndexFieldNames := Result;
  5373.   end else
  5374.     Result := FIndexFieldNames;
  5375. end;
  5376.  
  5377. procedure TCustomADODataSet.SetIndexFieldNames(const Value: string);
  5378. begin
  5379.   if IndexFieldNames <> Value then
  5380.   begin
  5381.     FIndexFieldNames := Value;
  5382.     if Active then
  5383.       Sort := StringReplace(Value, ';', ',', [rfReplaceAll]);
  5384.   end;
  5385. end;
  5386.  
  5387. function TCustomADODataSet.GetIndexField(Index: Integer): TField;
  5388. begin
  5389.   Result := FIndexFields[Index];
  5390. end;
  5391.  
  5392. procedure TCustomADODataSet.SetIndexField(Index: Integer;
  5393.   const Value: TField);
  5394. begin
  5395.   GetIndexField(Index).Assign(Value);
  5396. end;
  5397.  
  5398. function TCustomADODataSet.GetIndexFieldCount: Integer;
  5399. begin
  5400.   RefreshIndexFields;
  5401.   Result := FIndexFields.Count;
  5402. end;
  5403.  
  5404. procedure TCustomADODataSet.RefreshIndexFields;
  5405. var
  5406.   FList: string;
  5407. begin
  5408.   FList := StringReplace(Sort, ',', ';', [rfReplaceAll]);
  5409.   FList := StringReplace(FList, ' DESC', '', [rfReplaceAll]);
  5410.   FList := StringReplace(FList, ' ASC', '', [rfReplaceAll]);
  5411.   GetFieldList(FIndexFields, FList);
  5412. end;
  5413.  
  5414. function TCustomADODataSet.GetIndexName: string;
  5415. begin
  5416.   if Active and (FIndexName <> RecordSet.Index) then
  5417.     FIndexName := RecordSet.Index;
  5418.   Result := FIndexName;
  5419. end;
  5420.  
  5421. procedure TCustomADODataSet.SetIndexName(const Value: string);
  5422. begin
  5423.   if Active then
  5424.   begin
  5425.     Filter := '';
  5426.     RecordSet.Index := Value;
  5427.     Resync([]);
  5428.   end;
  5429.   FIndexName := Value;
  5430. end;
  5431.  
  5432. function TCustomADODataSet.UpdateStatus: TUpdateStatus;
  5433. var
  5434.   RecordStatus: TRecordStatusSet;
  5435. begin
  5436.   RecordStatus := GetRecordStatus;
  5437.   if rsDeleted in RecordStatus then
  5438.     Result := usDeleted
  5439.   else if rsNew in RecordStatus then
  5440.     Result := usInserted
  5441.   else if rsModified in RecordStatus then
  5442.     Result := usModified
  5443.   else
  5444.     Result := usUnmodified;
  5445. end;
  5446.  
  5447. { TCustomADODataSet IProviderSupport }
  5448.  
  5449. function TCustomADODataSet.PSGetDefaultOrder: TIndexDef;
  5450.  
  5451.   function GetIdx(IdxType: TIndexOption): TIndexDef;
  5452.   var
  5453.     i: Integer;
  5454.   begin
  5455.     Result := nil;
  5456.     for i := 0 to IndexDefs.Count - 1 do
  5457.       if IdxType in IndexDefs[i].Options then
  5458.       try
  5459.         Result := IndexDefs[i];
  5460.         GetFieldList(nil, Result.Fields);
  5461.         break;
  5462.       except
  5463.         Result := nil;
  5464.       end;
  5465.   end;
  5466.  
  5467. var
  5468.   DefIdx: TIndexDef;
  5469. begin
  5470.   DefIdx := nil;
  5471.   IndexDefs.Update;
  5472.   try
  5473.     if IndexName <> '' then
  5474.       DefIdx := IndexDefs.Find(IndexName)
  5475.     else if IndexFieldNames <> '' then
  5476.       DefIdx := IndexDefs.FindIndexForFields(IndexFieldNames);
  5477.     if Assigned(DefIdx) then
  5478.       GetFieldList(nil, DefIdx.Fields);
  5479.   except
  5480.     DefIdx := nil;
  5481.   end;
  5482.   if not Assigned(DefIdx) then
  5483.     DefIdx := GetIdx(ixPrimary);
  5484.   if not Assigned(DefIdx) then
  5485.     DefIdx := GetIdx(ixUnique);
  5486.   if Assigned(DefIdx) then
  5487.   begin
  5488.     Result := TIndexDef.Create(nil);
  5489.     Result.Assign(DefIdx);
  5490.   end else
  5491.     Result := nil;
  5492. end;
  5493.  
  5494. procedure TCustomADODataSet.PSExecute;
  5495. begin
  5496.   Command.Execute;
  5497. end;
  5498.  
  5499. function TCustomADODataSet.PSExecuteStatement(const ASQL: string; AParams: TParams;
  5500.   ResultSet: Pointer = nil): Integer;
  5501. var
  5502.   I: Integer;
  5503.   RS: _RecordSet;
  5504.   Cmd: TADOCommand;
  5505. begin
  5506.   Cmd := TADOCommand.Create(Self);
  5507.   try
  5508.     Cmd.CommandObject._Set_ActiveConnection(Command.CommandObject.Get_ActiveConnection);
  5509.     Cmd.ParamCheck := False;
  5510.     Cmd.CommandText := ASQL;
  5511.     { Initialize parameter settings from the server if possible }
  5512.     try
  5513.       if Cmd.Parameters.Refresh and (Cmd.Parameters.Count = AParams.Count) then
  5514.         for I := 0 to AParams.Count - 1 do
  5515.         begin
  5516.           if Cmd.Parameters[I].DataType <> AParams[I].DataType then
  5517.             Cmd.Parameters[I].DataType := AParams[I].DataType;
  5518.           Cmd.Parameters[I].Value := AParams[I].Value;
  5519.         end
  5520.       else
  5521.         Cmd.Parameters.Assign(AParams);
  5522.     except
  5523.       Cmd.Parameters.Assign(AParams);
  5524.     end;
  5525.     if Assigned(ResultSet) then
  5526.     begin
  5527.       RS := Cmd.Execute;
  5528.       TDataSet(ResultSet^) := TADODataSet.Create(nil);
  5529.       TADODataSet(ResultSet^).RecordSet := RS;
  5530.     end else
  5531.     begin
  5532.       Cmd.ExecuteOptions := [eoExecuteNoRecords];
  5533.       Cmd.Execute(Result, EmptyParam);
  5534.     end
  5535.   finally
  5536.     Cmd.Free;
  5537.   end;
  5538. end;
  5539.  
  5540. function TCustomADODataSet.PSGetKeyFields: string;
  5541. var
  5542.   i, Pos: Integer;
  5543.   IndexFound: Boolean;
  5544. begin
  5545.   Result := inherited PSGetKeyFields;
  5546.   if Result = '' then
  5547.   begin
  5548.     IndexFound := False;
  5549.     IndexDefs.Update;
  5550.     for i := 0 to IndexDefs.Count - 1 do
  5551.       if ixUnique in IndexDefs[I].Options then
  5552.       begin
  5553.         Result := IndexDefs[I].Fields;
  5554.         IndexFound := (FieldCount = 0);
  5555.         if not IndexFound then
  5556.         begin
  5557.           Pos := 1;
  5558.           while Pos <= Length(Result) do
  5559.           begin
  5560.             IndexFound := FindField(ExtractFieldName(Result, Pos)) <> nil;
  5561.             if not IndexFound then Break;
  5562.           end;
  5563.         end;
  5564.         if IndexFound then Break;
  5565.       end;
  5566.     if not IndexFound then
  5567.       Result := '';
  5568.   end;
  5569. end;
  5570.  
  5571. function TCustomADODataSet.PSGetParams: TParams;
  5572. begin
  5573.   if not Assigned(FParams) then
  5574.     FParams := TParams.Create(Self);
  5575.   FParams.Assign(Parameters);
  5576.   Result := FParams;
  5577. end;
  5578.  
  5579. function TCustomADODataSet.PSGetTableName: string;
  5580. begin
  5581.   case CommandType of
  5582.     cmdTable, cmdTableDirect: Result := CommandText;
  5583.     cmdText, cmdUnknown: Result := GetTableNameFromSQL(CommandText);
  5584.   else
  5585.     Result := '';
  5586.   end;
  5587. end;
  5588.  
  5589. function TCustomADODataSet.PSGetQuoteChar: string;
  5590. begin
  5591.   Result := '';
  5592. end;
  5593.  
  5594. function TCustomADODataSet.PSInTransaction: Boolean;
  5595.  
  5596.   function InMTSTransaction: Boolean;
  5597.   var
  5598.     ObjectContext: IObjectContext;
  5599.   begin
  5600.     Result := False;
  5601.     try
  5602.       ObjectContext := GetObjectContext;
  5603.       if Assigned(ObjectContext) then
  5604.         Result := ObjectContext.IsInTransaction;
  5605.     except
  5606.     end;
  5607.   end;
  5608.  
  5609. begin
  5610.   if Assigned(Connection) then
  5611.     Result := Connection.InTransaction else
  5612.     Result := False;
  5613.   if not Result then
  5614.     Result := InMTSTransAction;
  5615. end;
  5616.  
  5617. procedure TCustomADODataSet.PSStartTransaction;
  5618. begin
  5619.   SetConnectionFlag(cfProvider, True);
  5620.   try
  5621.     Command.CommandObject.Get_ActiveConnection.BeginTrans;
  5622.   except
  5623.     SetConnectionFlag(cfProvider, False);
  5624.     raise;
  5625.   end;
  5626. end;
  5627.  
  5628. procedure TCustomADODataSet.PSEndTransaction(Commit: Boolean);
  5629. var
  5630.   ActiveConnection: _Connection;
  5631. begin
  5632.   ActiveConnection := Command.CommandObject.Get_ActiveConnection;
  5633.   if Assigned(ActiveConnection) then
  5634.   try
  5635.     if Commit then
  5636.       ActiveConnection.CommitTrans else
  5637.       ActiveConnection.RollbackTrans;
  5638.   finally
  5639.     SetConnectionFlag(cfProvider, False);
  5640.   end;
  5641. end;
  5642.  
  5643. function TCustomADODataSet.PSIsSQLBased: Boolean;
  5644. begin
  5645.   Result := True;
  5646. end;
  5647.  
  5648. procedure TCustomADODataSet.PSReset;
  5649. begin
  5650.   inherited;
  5651. end;
  5652.  
  5653. procedure TCustomADODataSet.PSSetCommandText(const CommandText: string);
  5654. begin
  5655.   if CommandText <> '' then
  5656.     Self.CommandText := CommandText;
  5657. end;
  5658.  
  5659. procedure TCustomADODataSet.PSSetParams(AParams: TParams);
  5660. begin
  5661.   if AParams.Count > 0 then
  5662.   begin
  5663.     Parameters.Assign(AParams);
  5664.     Close;
  5665.   end;
  5666. end;
  5667.  
  5668. function TCustomADODataSet.PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs;
  5669. begin
  5670.   Result := GetIndexDefs(IndexDefs, IndexTypes);
  5671. end;
  5672.  
  5673. procedure TCustomADODataSet.PSGetAttributes(List: TList);
  5674. begin
  5675.   inherited;
  5676. end;
  5677.  
  5678. function TCustomADODataSet.PSGetUpdateException(E: Exception;
  5679.   Prev: EUpdateError): EUpdateError;
  5680. var
  5681.   PrevErr: Integer;
  5682. begin
  5683.   if E is EOleException then
  5684.   begin
  5685.     if Prev <> nil then
  5686.       PrevErr := Prev.ErrorCode else
  5687.       PrevErr := 0;
  5688.     with EOleException(E) do
  5689.       Result := EUpdateError.Create(E.Message, '', ErrorCode, PrevErr, E);
  5690.   end else
  5691.     Result := inherited PSGetUpdateException(E, Prev);
  5692. end;
  5693.  
  5694. function TCustomADODataSet.PSIsSQLSupported: Boolean;
  5695. begin
  5696.   Result := True;
  5697. end;
  5698.  
  5699. function TCustomADODataSet.PSUpdateRecord(UpdateKind: TUpdateKind;
  5700.   Delta: TDataSet): Boolean;
  5701. begin
  5702.   { OnUpdateRecord is not supported }
  5703.   Result := False;
  5704. end;
  5705.  
  5706. { TADODataSet }
  5707.  
  5708. procedure TADODataSet.CreateDataSet;
  5709.  
  5710.   procedure CreateFields;
  5711.   var
  5712.     Options, I: Integer;
  5713.   begin
  5714.     for I := 0 to FieldDefs.Count - 1 do
  5715.     with FieldDefs[I] do
  5716.     begin
  5717.       if Required then
  5718.         Options := 0 else
  5719.         Options := adFldIsNullable + adFldMayBeNull;
  5720.       if (DataType in [ftMemo, ftBlob]) and (Size = 0) then
  5721.         Size := High(Integer); 
  5722.       Recordset.Fields.Append(Name, FieldTypeToADOType(DataType), Size, Options);
  5723.     end;
  5724.   end;
  5725.  
  5726. begin
  5727.   CheckInactive;
  5728.   InitFieldDefsFromFields;
  5729.   FRecordsetObject := CreateADOObject(CLASS_Recordset) as _Recordset;
  5730.   try
  5731.     Recordset.CursorLocation := adUseClient;
  5732.     CreateFields;
  5733.     Recordset.Open(EmptyParam, EmptyParam, adOpenUnspecified, adLockUnspecified, 0);
  5734.     Open;
  5735.   except
  5736.     FRecordsetObject := nil;
  5737.     raise;
  5738.   end;
  5739. end;
  5740.  
  5741. procedure TADODataSet.DataEvent(Event: TDataEvent; Info: Integer);
  5742. begin
  5743.   case Event of
  5744.     deParentScroll:
  5745.       begin
  5746.         CheckBrowseMode;
  5747.         if FParentRecNo <> FParentDataSet.RecNo then
  5748.         begin
  5749.           First;
  5750.           FParentRecNo := FParentDataSet.RecNo;
  5751.         end else
  5752.         begin
  5753.           UpdateCursorPos;
  5754.           Resync([]);
  5755.         end;
  5756.       end;
  5757.     deConnectChange:
  5758.       if Active and not Bool(Info) and Assigned(RDSConnection) then
  5759.         if (CursorLocation = clUseClient) and not (csDestroying in ComponentState) then
  5760.           Recordset.Set_ActiveConnection(nil) else
  5761.           Close;
  5762.   end;
  5763.   inherited;
  5764. end;
  5765.  
  5766. procedure TADODataSet.GetIndexNames(List: TStrings);
  5767. begin
  5768.   IndexDefs.Update;
  5769.   IndexDefs.GetItemNames(List);
  5770. end;
  5771.  
  5772. procedure TADODataSet.OpenCursor(InfoQuery: Boolean);
  5773. begin
  5774.   if not Assigned(FRecordsetObject) then
  5775.   begin
  5776.     if DataSetField <> nil then
  5777.     begin
  5778.       FParentDataSet := DataSetField.DataSet as TCustomADODataSet;
  5779.       OpenParentDataSet(FParentDataSet);
  5780.       FRecordsetObject := IUnknown(FParentDataSet.Recordset.Fields[DataSetField.FieldName].Value) as _Recordset;
  5781.     end
  5782.     else if Assigned(RDSConnection)then
  5783.       FRecordsetObject := RDSConnection.GetRecordSet(CommandText, ConnectionString);
  5784.   end;
  5785.   inherited;
  5786. end;
  5787.  
  5788. procedure TADODataSet.SetConnection(const Value: TADOConnection);
  5789. begin
  5790.   if Assigned(Value) then
  5791.     RDSConnection := nil;
  5792.   inherited;
  5793. end;
  5794.  
  5795. procedure TADODataSet.SetRDSConnection(Value: TRDSConnection);
  5796. begin
  5797.   if Assigned(Value) then
  5798.     Connection := nil;
  5799.   if Assigned(FRDSConnection) then FRDSConnection.UnRegisterClient(Self);
  5800.   FRDSConnection := Value;
  5801.   if Assigned(FRDSConnection) then FRDSConnection.RegisterClient(Self);
  5802. end;
  5803.  
  5804. procedure TADODataSet.SetDataSetField(const Value: TDataSetField);
  5805. begin
  5806.   if Assigned(Value) then
  5807.   begin
  5808.     Close;
  5809.     ConnectionString := '';
  5810.     Connection := nil;
  5811.     CommandText := '';
  5812.     CursorLocation := clUseClient;
  5813.   end;
  5814.   inherited;
  5815. end;
  5816.  
  5817. { TADOTable }
  5818.  
  5819. constructor TADOTable.Create(AOwner: TComponent);
  5820. begin
  5821.   inherited Create(AOwner);
  5822.   CommandType := cmdTable;
  5823.   Command.CommandTextAlias := 'TableName'; { Do not localize }
  5824. end;
  5825.  
  5826. { Property Access }
  5827.  
  5828. function TADOTable.GetReadOnly: Boolean;
  5829. begin
  5830.   Result := LockType = ltReadOnly;
  5831. end;
  5832.  
  5833. procedure TADOTable.SetReadOnly(const Value: Boolean);
  5834. begin
  5835.   if Value then
  5836.     LockType := ltReadOnly else
  5837.     LockType := ltOptimistic;
  5838. end;
  5839.  
  5840. function TADOTable.GetTableDirect: Boolean;
  5841. begin
  5842.   Result := CommandType = cmdTableDirect;
  5843. end;
  5844.  
  5845. procedure TADOTable.SetTableDirect(const Value: Boolean);
  5846. begin
  5847.   if Value then
  5848.     CommandType := cmdTableDirect else
  5849.     CommandType := cmdTable;
  5850. end;
  5851.  
  5852. procedure TADOTable.GetIndexNames(List: TStrings);
  5853. begin
  5854.   IndexDefs.Update;
  5855.   IndexDefs.GetItemNames(List);
  5856. end;
  5857.  
  5858. { TADOQuery }
  5859.  
  5860. constructor TADOQuery.Create(AOwner: TComponent);
  5861. begin
  5862.   inherited Create(AOwner);
  5863.   FSQL := TStringList.Create;
  5864.   TStringList(FSQL).OnChange := QueryChanged;
  5865.   Command.CommandTextAlias := 'SQL'; { Do not localize }
  5866. end;
  5867.  
  5868. destructor TADOQuery.Destroy;
  5869. begin
  5870.   inherited Destroy;
  5871.   FreeAndNil(FSQL);
  5872. end;
  5873.  
  5874. function TADOQuery.ExecSQL: Integer;
  5875. begin
  5876.   Command.Execute(FRowsAffected, EmptyParam);
  5877.   Result := FRowsAffected;
  5878. end;
  5879.  
  5880. procedure TADOQuery.QueryChanged(Sender: TObject);
  5881. begin
  5882.   CommandText := FSQL.Text;
  5883. end;
  5884.  
  5885. { Property Access }
  5886.  
  5887. function TADOQuery.GetSQL: TStrings;
  5888. begin
  5889.   Result := FSQL;
  5890. end;
  5891.  
  5892. procedure TADOQuery.SetSQL(const Value: TStrings);
  5893. begin
  5894.   FSQL.Assign(Value);
  5895. end;
  5896.  
  5897. { TADOStoredProc }
  5898.  
  5899. constructor TADOStoredProc.Create(AOwner: TComponent);
  5900. begin
  5901.   inherited Create(AOwner);
  5902.   Command.CommandType := cmdStoredProc;
  5903.   Command.CommandTextAlias := 'ProcedureName'; { Do not localize }
  5904. end;
  5905.  
  5906. procedure TADOStoredProc.ExecProc;
  5907. begin
  5908.   Command.Execute;
  5909. end;
  5910.  
  5911. { TADOBlobStream }
  5912.  
  5913. constructor TADOBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
  5914. begin
  5915.   FField := Field;
  5916.   FFieldNo := FField.FieldNo - 1;
  5917.   FDataSet := FField.DataSet as TCustomADODataSet;
  5918.   FFieldData := Null;
  5919.   if not FDataSet.GetActiveRecBuf(FBuffer) then Exit;
  5920.   if Mode <> bmRead then
  5921.   begin
  5922.     if FField.ReadOnly then
  5923.       DatabaseErrorFmt(SFieldReadOnly, [FField.DisplayName], FDataSet);
  5924.     if not (FDataSet.State in [dsEdit, dsInsert]) then
  5925.       DatabaseError(SNotEditing, FDataSet);
  5926.   end;
  5927.   if Mode = bmWrite then Truncate
  5928.   else ReadBlobData;
  5929. end;
  5930.  
  5931. destructor TADOBlobStream.Destroy;
  5932. begin
  5933.   if FModified then
  5934.   try
  5935.     FDataSet.SetFieldData(FField, @FData);
  5936.     FField.Modified := True;
  5937.     FDataSet.DataEvent(deFieldChange, Longint(FField));
  5938.   except
  5939.     Application.HandleException(Self);
  5940.   end;
  5941.   inherited Destroy;
  5942. end;
  5943.  
  5944. procedure TADOBlobStream.ReadBlobData;
  5945. begin
  5946.   FDataSet.GetFieldData(FField, @FFieldData, True);
  5947.   if not VarIsNull(FFieldData) then
  5948.   begin
  5949.     if VarType(FFieldData) = varOleStr then
  5950.     begin
  5951.       { Convert OleStr into a pascal string (format used by TBlobField) }
  5952.       FFieldData := string(FFieldData);
  5953.       Size := Length(FFieldData);
  5954.     end else
  5955.       Size := VarArrayHighBound(FFieldData, 1) + 1;
  5956.     FFieldData := Null;
  5957.   end;
  5958. end;
  5959.  
  5960. function TADOBlobStream.Realloc(var NewCapacity: Longint): Pointer;
  5961.  
  5962.   procedure VarAlloc(var V: Variant; StrField: Boolean);
  5963.   var
  5964.     S: string;
  5965.   begin
  5966.     if StrField then
  5967.     begin
  5968.       if not VarIsNull(V) then S := string(V);
  5969.       SetLength(S, NewCapacity);
  5970.       V := S;
  5971.     end else
  5972.     begin
  5973.       if VarIsEmpty(V) or VarIsNull(V) then
  5974.         V := VarArrayCreate([0, NewCapacity-1], varByte) else
  5975.         VarArrayRedim(V, NewCapacity-1);
  5976.     end;
  5977.   end;
  5978.  
  5979. begin
  5980.   Result := Memory;
  5981.   if NewCapacity <> Capacity then
  5982.   begin
  5983.     if VarIsArray(FData) then VarArrayUnlock(FData);
  5984.     if NewCapacity = 0 then
  5985.     begin
  5986.       FData := Null;
  5987.       Result := nil;
  5988.     end else
  5989.     begin
  5990.       if VarIsNull(FFieldData) then
  5991.         VarAlloc(FData, FField.DataType = ftMemo) else
  5992.         FData := FFieldData;
  5993.       if VarIsArray(FData) then
  5994.         Result := VarArrayLock(FData) else
  5995.         Result := TVarData(FData).VString;
  5996.     end;
  5997.   end;
  5998. end;
  5999.  
  6000. function TADOBlobStream.Write(const Buffer; Count: Longint): Longint;
  6001. begin
  6002.   Result := inherited Write(Buffer, Count);
  6003.   FModified := True;
  6004. end;
  6005.  
  6006. procedure TADOBlobStream.Truncate;
  6007. begin
  6008.   Clear;
  6009.   FModified := True;
  6010. end;
  6011.  
  6012. initialization
  6013.   OleCheck(CoGetMalloc(1, GlobalMalloc));
  6014. finalization
  6015.   GlobalMalloc := nil;
  6016. end.
  6017.