datadrivereh.pas

最新的 DBGRIDEH4.0

{*******************************************************}
{                                                       }
{                     EhLib v4.0                        }
{                                                       }
{           TDataDriverEh, TSQLDataDriverEh             }
{                components (Build 4.2.27)              }
{                                                       }
{     Copyright (c) 2003-07 by Dmitry V. Bolshakov      }
{                                                       }
{*******************************************************}

unit DataDriverEh;// {$IFDEF CIL} platform{$ENDIF};

{$I EHLIB.INC}

interface

uses SysUtils, Classes, Controls, DB, Windows,
{$IFDEF EH_LIB_6} Variants, {$ENDIF}
{$IFDEF EH_LIB_5} Contnrs, {$ENDIF}
  ToolCtrlsEh, DBCommon, MemTableDataEh;
type

{ TDataDriverEh }
  TDataDriverEh = class;

  TUpdateErrorActionEh = (ueaBreakAbortEh, ueaBreakRaiseEh, ueaCountinueEh, ueaRetryEh, ueaCountinueSkip);

  TDataDriverProduceDataReaderEhEvent = procedure (DataDriver: TDataDriverEh; var DataReader: TDataSet; var FreeOnEof: Boolean) of object;
  TDataDriverBuildDataStructEhEvent = procedure (DataDriver: TDataDriverEh; DataStruct: TMTDataStructEh) of object;
  TDataDriverReadRecordEhEvent = procedure (DataDriver: TDataDriverEh; MemTableData: TMemTableDataEh;
    MemRec: TMemoryRecordEh; var ProviderEOF: Boolean) of object;
  TDataDriverUpdateErrorEhEvent = procedure (DataDriver: TDataDriverEh; MemTableData: TMemTableDataEh;
    MemRec: TMemoryRecordEh; var Action: TUpdateErrorActionEh) of object;
  TDataDriverRecordEhEvent = procedure (DataDriver: TDataDriverEh; MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh) of object;
  TDataDriverAssignFieldValueEhEvent = procedure (DataDriver: TDataDriverEh; MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh;
    DataFieldIndex: Integer; DataValueVersion: TDataValueVersionEh; ReaderDataSet: TDataSet) of object;

// TProviderOption = (poFetchBlobsOnDemand, poFetchDetailsOnDemand, poIncFieldProps,
//                    poCascadeDeletes, poCascadeUpdates, poReadOnly, poAllowMultiRecordUpdates,
//                    poDisableInserts, poDisableEdits, poDisableDeletes, poNoReset,
//                    poAutoRefresh, poPropogateChanges, poAllowCommandText, poRetainServerOrder);

// TDataDriverOptionEh = (ddoAutoRefresh, ddoUpdatesInTransactionEh);

  IDataDriverConsumerEh = interface
    ['{E390BBF2-666F-43D7-8CC8-1FA2BA8263D1}']
    procedure SetDataDriverConsumer(AObject: TObject);
    function GetDataDriverConsumer: TObject;
    property DataDriverConsumer: TObject read GetDataDriverConsumer write SetDataDriverConsumer;
  end;

  TDataDriverEh = class(TComponent, IDataDriverConsumerEh{$IFNDEF CIL}, IUnknown{$ENDIF})
  private
    FKeyFields: String;
    FOnAssignFieldValue: TDataDriverAssignFieldValueEhEvent;
    FOnBuildDataStruct: TDataDriverBuildDataStructEhEvent;
    FOnProduceDataReader: TDataDriverProduceDataReaderEhEvent;
    FOnReadRecord: TDataDriverReadRecordEhEvent;
    FOnRefreshRecord: TDataDriverRecordEhEvent;
    FOnUpdateError: TDataDriverUpdateErrorEhEvent;
    FOnUpdateRecord: TDataDriverRecordEhEvent;
    FProviderDataSet: TDataSet;
    FProviderEOF: Boolean;
    FReaderDataSet: TDataSet;
    FReaderDataSetFreeOnEof: Boolean;
    FResolveToDataSet: Boolean;
    FDataDriverConsumer: TObject;
    procedure SetKeyFields(const Value: String);
    procedure SetProviderDataSet(const Value: TDataSet);
    procedure SetProviderEOF(const Value: Boolean);
  protected
    function GetDataDriverConsumer: TObject;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetAutoIncFields(Fields: TFields; DataStruct: TMTDataStructEh); virtual;
    procedure SetDataDriverConsumer(ADataDriverConsumer: TObject);
    property KeyFields: String read FKeyFields write SetKeyFields;
    property ProviderDataSet: TDataSet read FProviderDataSet write SetProviderDataSet;
    property ReaderDataSet: TDataSet read FReaderDataSet;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ApplyUpdates(MemTableData: TMemTableDataEh): Integer; virtual;
    function DefaultUpdateRecord(MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh): Integer; virtual;
    function GetDataReader: TDataSet; virtual;
    function ReadData(MemTableData: TMemTableDataEh; Count: Integer): Integer; virtual;
    function RefreshReaderParamsFromCursor(DataSet: TDataSet): Boolean; virtual;
    procedure AssignFieldValue(MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh;
      DataFieldIndex: Integer; DataValueVersion: TDataValueVersionEh; ReaderDataSet: TDataSet); virtual;
    procedure UpdateRecord(MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh); virtual;
    procedure ConsumerClosed(ConsumerDataSet: TDataSet); virtual;
    procedure DefaultAssignFieldValue(MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh;
      DataFieldIndex: Integer; DataValueVersion: TDataValueVersionEh; ReaderDataSet: TDataSet); virtual;
    procedure DefaultBuildDataStruct(DataStruct: TMTDataStructEh); virtual;
    procedure DefaultProduceDataReader(var DataSet: TDataSet; var FreeOnEof: Boolean); virtual;
    procedure DefaultReadRecord(MemTableData: TMemTableDataEh; Rec: TMemoryRecordEh; var ProviderEOF: Boolean); virtual;
    procedure DefaultUpdateError(MemTableData: TMemTableDataEh;
      MemRec: TMemoryRecordEh; var Action: TUpdateErrorActionEh); virtual;
    procedure DefaultRefreshRecord(MemRecord: TMemoryRecordEh); virtual;
    procedure BuildDataStruct(DataStruct: TMTDataStructEh); virtual;
    procedure RefreshRecord(MemRecord: TMemoryRecordEh); virtual;
    procedure SetReaderParamsFromCursor(DataSet: TDataSet); virtual;
    property ProviderEOF: Boolean read FProviderEOF write SetProviderEOF;
    property ResolveToDataSet: Boolean read FResolveToDataSet write FResolveToDataSet default True;
    property OnBuildDataStruct: TDataDriverBuildDataStructEhEvent read FOnBuildDataStruct write FOnBuildDataStruct;
    property OnProduceDataReader: TDataDriverProduceDataReaderEhEvent read FOnProduceDataReader write FOnProduceDataReader;
    property OnAssignFieldValue: TDataDriverAssignFieldValueEhEvent read FOnAssignFieldValue write FOnAssignFieldValue;
    property OnReadRecord: TDataDriverReadRecordEhEvent read FOnReadRecord write FOnReadRecord;
    property OnRefreshRecord: TDataDriverRecordEhEvent read  FOnRefreshRecord write FOnRefreshRecord;
    property OnUpdateRecord: TDataDriverRecordEhEvent read  FOnUpdateRecord write FOnUpdateRecord;
    property OnUpdateError: TDataDriverUpdateErrorEhEvent read  FOnUpdateError write FOnUpdateError;
  end;

  TDataSetDriverEh = class(TDataDriverEh)
  published
    property KeyFields;
    property ProviderDataSet;
    property OnBuildDataStruct;
    property OnProduceDataReader;
    property OnAssignFieldValue;
    property OnReadRecord;
    property OnRefreshRecord;
    property OnUpdateRecord;
    property OnUpdateError;
    property ResolveToDataSet;
  end;

  TCustomSQLDataDriverEh = class;
  TCustomSQLCommandEh = class;
  TServerSpecOperationsEh = class;


{ TDynaSQLParamsEh }

  TDynaSQLOptionEh = ( dsoDynamicSQLInsertEh, dsoDynamicSQLUpdateEh, dsoDynamicSQLDeleteEh);
  TDynaSQLOptionsEh = set of TDynaSQLOptionEh;

  TDynaSQLParamsEh = class(TPersistent)
  private
    FDataDriver: TCustomSQLDataDriverEh;
    FUpdateTable: String;
    FUpdateFields: String;
    FKeyFields: String;
    FSkipUnchangedFields: Boolean;
    FOptions: TDynaSQLOptionsEh;
    procedure SetKeyFields(const Value: String);
    procedure SetUpdateFields(const Value: String);
    procedure SetUpdateTable(const Value: String);
  public
    constructor Create(ADataDriver: TCustomSQLDataDriverEh);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property DataDriver: TCustomSQLDataDriverEh read FDataDriver;
  published
    property KeyFields: String read FKeyFields write SetKeyFields;
    property UpdateFields: String read FUpdateFields write SetUpdateFields;
    property UpdateTable: String read FUpdateTable write SetUpdateTable;
    property SkipUnchangedFields: Boolean read FSkipUnchangedFields write FSkipUnchangedFields default False;
    property Options: TDynaSQLOptionsEh read FOptions write FOptions;
  end;

{ TCustomSQLCommandEh }

  TSQLCommandTypeEh = (cthSelectQuery, cthUpdateQuery, cthTable, cthStoredProc);
  TSQLExecuteEhEvent = function (var Cursor: TDataSet; var FreeOnEof: Boolean) : Integer of object;
  TAssignParamEhEvent = procedure (Command: TCustomSQLCommandEh;
    MemRecord: TMemoryRecordEh; DataValueVersion: TDataValueVersionEh; Param: TParam) of object;

  TCustomSQLCommandEh = class(TPersistent)
  private
    FCommandText: TStrings;
    FCommandType: TSQLCommandTypeEh;
    FDataDriver: TCustomSQLDataDriverEh;
//    FDynamicSQL: Boolean;
//    FOnExecute: TSQLExecuteEhEvent;
    function IsCommandTypeStored: Boolean;
//    procedure SetDynamicSQL(const Value: Boolean);
  protected
    function DefaultCommandType: TSQLCommandTypeEh; virtual;
    function GetCommandText: TStrings; virtual;
    function GetCommandType: TSQLCommandTypeEh; virtual;
    function GetOwner: TPersistent; override;
    procedure CommandTextChanged(Sender: TObject); virtual;
    procedure CommandTypeChanged; virtual;
    procedure SetCommandText(const Value: TStrings); virtual;
    procedure SetCommandType(const Value: TSQLCommandTypeEh); virtual;
  public
    constructor Create(ADataDriver: TCustomSQLDataDriverEh);
    destructor Destroy; override;
//    procedure AssignParams(AParams: TParams); virtual;
//    procedure AssignToParams(AParams: TParams); virtual;
//    property OnExecute: TSQLExecuteEhEvent read FOnExecute write FOnExecute;
    function Execute(var Cursor: TDataSet; var FreeOnEof: Boolean): Integer; virtual;
    function GetNamePath: String; override;
    function GetParams: TParams; virtual;
    procedure Assign(Source: TPersistent); override;
    procedure RefreshParams(MemRecord: TMemoryRecordEh; DataValueVersion: TDataValueVersionEh); virtual;
    procedure SetParams(AParams: TParams); virtual;
    property CommandText: TStrings read GetCommandText write SetCommandText;
    property CommandType: TSQLCommandTypeEh read GetCommandType write SetCommandType stored IsCommandTypeStored;
    property DataDriver: TCustomSQLDataDriverEh read FDataDriver;
//    property DynamicSQL: Boolean read FDynamicSQL write SetDynamicSQL default False;
  end;

{ TCustomSQLDataDriverEh }

{$IFNDEF EH_LIB_6}
  IInterface = IUnknown;
{$ENDIF}

  TDataDriverExecuteCommandEhEvent = function (DataDriver: TCustomSQLDataDriverEh;
    Command: TCustomSQLCommandEh; var Cursor: TDataSet; var FreeOnEof: Boolean): Integer of object;
  TDataDriverGetBackUpdatedValuesEhEvent = procedure (DataDriver: TCustomSQLDataDriverEh;
    MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet) of object;

  TCustomSQLDataDriverEh = class(TDataDriverEh)
  private
    FDeleteCommand: TCustomSQLCommandEh;
    FDesignDataBase: TComponent;
    FGetrecCommand: TCustomSQLCommandEh;
    FInsertCommand: TCustomSQLCommandEh;
    FOnExecuteCommand: TDataDriverExecuteCommandEhEvent;
    FOnGetBackUpdatedValues: TDataDriverGetBackUpdatedValuesEhEvent;
    FSelectCommand: TCustomSQLCommandEh;
    FSpecParams: TStrings;
    FUpdateCommand: TCustomSQLCommandEh;
    FServiceCommand: TCustomSQLCommandEh;
//    FServerService: TServerServiceEh;
    FServerSpecOperations: TServerSpecOperationsEh;
    FDynaSQLParams: TDynaSQLParamsEh;
    function GetDeleteSQL: TStrings;
    function GetGetrecSQL: TStrings;
    function GetInsertSQL: TStrings;
    function GetSelectSQL: TStrings;
    function GetUpdateSQL: TStrings;
    procedure SetDeleteCommand(const Value: TCustomSQLCommandEh);
    procedure SetDeleteSQL(const Value: TStrings);
    procedure SetGetrecCommand(const Value: TCustomSQLCommandEh);
    procedure SetGetrecSQL(const Value: TStrings);
    procedure SetInsertCommand(const Value: TCustomSQLCommandEh);
    procedure SetInsertSQL(const Value: TStrings);
    procedure SetSelectCommand(const Value: TCustomSQLCommandEh);
    procedure SetSelectSQL(const Value: TStrings);
    procedure SetSpecParams(const Value: TStrings);
    procedure SetUpdateCommand(const Value: TCustomSQLCommandEh);
    procedure SetUpdateSQL(const Value: TStrings);
    procedure SetServiceCommand(const Value: TCustomSQLCommandEh);
    procedure SetDynaSQLParams(const Value: TDynaSQLParamsEh);
    procedure SetServerSpecOperations(const Value: TServerSpecOperationsEh);
  protected
    procedure SetAutoIncFields(Fields: TFields; DataStruct: TMTDataStructEh); override;
    procedure SetDesignDataBase(const Value: TComponent); virtual;
  public
    {DesignTime stuff}
    function CreateDesignCopy: TCustomSQLDataDriverEh; virtual;
    function CreateDesignDataBase: TComponent; virtual;
    function GetDesignDataBase: TComponent; virtual;
    procedure AssignFromDesignDriver(DesignDataDriver: TCustomSQLDataDriverEh); virtual;
    property DesignDataBase: TComponent read FDesignDataBase write SetDesignDataBase;
  protected
//    function GetReaderDataSet: TDataSet; override;
    function CreateCommand: TCustomSQLCommandEh; virtual;
    function CreateDeleteCommand: TCustomSQLCommandEh; virtual;
    function CreateInsertCommand: TCustomSQLCommandEh; virtual;
    function CreateSelectCommand: TCustomSQLCommandEh; virtual;
    function CreateGetrecCommand: TCustomSQLCommandEh; virtual;
    function CreateUpdateCommand: TCustomSQLCommandEh; virtual;
    function GetDefaultCommandTypeFor(Command: TCustomSQLCommandEh): TSQLCommandTypeEh; virtual;
    function InternalGetServerSpecOperations: TServerSpecOperationsEh; virtual;
    procedure CommandTextChanged(Sender: TCustomSQLCommandEh); virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure UpdateServerService; virtual;
    property ServiceCommand: TCustomSQLCommandEh read FServiceCommand write SetServiceCommand;
//    property ServerService: TServerServiceEh read FServerService;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function DefaultUpdateRecord(MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh): Integer; override;
    function DoUpdateRecord(MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh): Integer; virtual;
    function ExecuteCommand(Command: TCustomSQLCommandEh; var Cursor: TDataSet; var FreeOnEof: Boolean): Integer; virtual;
    function DefaultExecuteCommand(Command: TCustomSQLCommandEh; var Cursor: TDataSet; var FreeOnEof: Boolean): Integer; virtual;
    function RefreshReaderParamsFromCursor(DataSet: TDataSet): Boolean; override;
    function HaveDataConnection(): Boolean; virtual;
    procedure GetBackUpdatedValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet); virtual;
    procedure DefaultBuildDataStruct(DataStruct: TMTDataStructEh); override;
    procedure DefaultGetUpdatedServerValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet); virtual;
    procedure DefaultProduceDataReader(var DataSet: TDataSet; var FreeOnEof: Boolean); override;
    procedure DefaultRefreshRecord(MemRecord: TMemoryRecordEh); override;
    procedure GenerateDynamicSQLCommand(MemRecord: TMemoryRecordEh; Command: TCustomSQLCommandEh); virtual;
    procedure SetReaderParamsFromCursor(DataSet: TDataSet); override;
    property DynaSQLParams: TDynaSQLParamsEh read FDynaSQLParams write SetDynaSQLParams;
    property ResolveToDataSet default False;
    property DeleteCommand: TCustomSQLCommandEh read FDeleteCommand write SetDeleteCommand;
    property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL stored False;
    property GetrecCommand: TCustomSQLCommandEh read FGetrecCommand write SetGetrecCommand;
    property GetrecSQL: TStrings read GetGetrecSQL write SetGetrecSQL stored False;
    property InsertCommand: TCustomSQLCommandEh read FInsertCommand write SetInsertCommand;
    property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL stored False;
    property SelectCommand: TCustomSQLCommandEh read FSelectCommand write SetSelectCommand;
    property SelectSQL: TStrings read GetSelectSQL write SetSelectSQL stored False;
    property ServerSpecOperations: TServerSpecOperationsEh read FServerSpecOperations write SetServerSpecOperations;
    property SpecParams: TStrings read FSpecParams write SetSpecParams;
    property UpdateCommand: TCustomSQLCommandEh read FUpdateCommand write SetUpdateCommand;
    property UpdateSQL: TStrings read GetUpdateSQL write SetUpdateSQL stored False;
    property OnExecuteCommand: TDataDriverExecuteCommandEhEvent read FOnExecuteCommand write FOnExecuteCommand;
    property OnGetBackUpdatedValues: TDataDriverGetBackUpdatedValuesEhEvent read FOnGetBackUpdatedValues write FOnGetBackUpdatedValues;
  end;

{ TServerSpecOperationsEh }

  TServerSpecOperationsEh = class
  private
    FIncludeInsertFieldsInUpdateCommand: Boolean;
  protected
    procedure GenWhereClause(KeyFields: String; SQL: TStrings); virtual;
    procedure BuildChangedFieldList(MemRec: TMemoryRecordEh; UpdateFieldList, ChangedFieldList: TStringList); virtual;
  public
    constructor Create; virtual;
//    procedure BeforeExecuteCommand(Command: TCustomSQLCommandEh; MemRec: TMemoryRecordEh); virtual;
//    procedure AfterExecuteCommand(Command: TCustomSQLCommandEh; MemRec: TMemoryRecordEh; ResDataSet: TDataSet); virtual;
    function UpdateRecord(SQLDataDriver: TCustomSQLDataDriverEh; MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh): Integer; virtual;
    procedure GetBackUpdatedValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet); virtual;
    procedure GenerateDynaSQLCommand(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh); virtual;
    procedure GenerateDeleteCommand(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh); virtual;
    procedure GenerateUpdateCommand(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh); virtual;
    procedure GenerateInsertCommand(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh); virtual;
    property IncludeInsertFieldsInUpdateCommand: Boolean read FIncludeInsertFieldsInUpdateCommand write FIncludeInsertFieldsInUpdateCommand;
  end;

{ TSQLDataDriverResolver }

  TResolverExecuteCommandEhEvent = function (SQLDataDriver: TCustomSQLDataDriverEh;
    Command: TCustomSQLCommandEh; var Cursor: TDataSet; var FreeOnEof: Boolean;
    var Processed: Boolean): Integer of object;

  TResolverGetBackUpdatedValuesEhEvent = procedure (SQLDataDriver: TCustomSQLDataDriverEh;
   MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet;
   var Processed: Boolean) of object;
  TResolverGetServerSpecOperationsEh = function (var Processed: Boolean):
    TServerSpecOperationsEh of object;
  TResolverUpdateRecordEhEvent = procedure (SQLDataDriver: TCustomSQLDataDriverEh;
      MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh; var Processed: Boolean);

  TSQLDataDriverResolver = class(TPersistent)
  private
    FServerSpecOperations: TServerSpecOperationsEh;
    FOnExecuteCommand: TResolverExecuteCommandEhEvent;
    FOnGetBackUpdatedValues: TResolverGetBackUpdatedValuesEhEvent;
    FOnGetServerSpecOperations: TResolverGetServerSpecOperationsEh;
    FOnUpdateRecord: TResolverUpdateRecordEhEvent;
  public
    function ExecuteCommand(SQLDataDriver: TCustomSQLDataDriverEh; Command: TCustomSQLCommandEh;
      var Cursor: TDataSet; var FreeOnEof: Boolean; var Processed: Boolean): Integer; virtual;
    function GetServerSpecOperations(var Processed: Boolean): TServerSpecOperationsEh; virtual;
    procedure UpdateRecord(SQLDataDriver: TCustomSQLDataDriverEh;
      MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh; var Processed: Boolean); virtual;
    procedure DefaultUpdateRecord(SQLDataDriver: TCustomSQLDataDriverEh;
      MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh; var Processed: Boolean); virtual;
    procedure GetBackUpdatedValues(SQLDataDriver: TCustomSQLDataDriverEh; MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet; var Processed: Boolean); virtual;