📄 datadrivereh.pas
字号:
{*******************************************************}
{ }
{ EhLib vX.X }
{ }
{ TDataDriverEh, TSQLDataDriverEh }
{ components (Build 11) }
{ }
{ Copyright (c) 2003,04 by Dmitry V. Bolshakov }
{ }
{*******************************************************}
unit DataDriverEh {$IFDEF CIL} platform{$ENDIF};
{$I EHLIB.INC}
interface
uses SysUtils, Classes, Controls, DB,
{$IFDEF EH_LIB_6} Variants, {$ENDIF}
{$IFDEF EH_LIB_5} Contnrs, {$ENDIF}
ToolCtrlsEh, DBCommon, MemTableDataEh;
type
{ TDataDriverEh }
TUpdateErrorActionEh = (ueaBreakAbortEh, ueaBreakRaiseEh, ueaCountinueEh, ueaRetryEh);
TProduceDataReaderEhEvent = procedure (var DataReader: TDataSet; var FreeOnEof: Boolean) of object;
TBuildDataStructEhEvent = procedure (DataStruct: TMTDataStructEh) of object;
TReadRecordEhEvent = procedure (MemTableData: TMemTableDataEh;
MemRec: TMemoryRecordEh; var ProviderEOF: Boolean) of object;
TUpdateErrorEhEvent = procedure (MemTableData: TMemTableDataEh;
MemRec: TMemoryRecordEh; var Action: TUpdateErrorActionEh) of object;
TRecordEhEvent = procedure (MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh) of object;
TAssignFieldValueEhEvent = procedure (MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh;
DataFieldIndex: Integer; DataValueVersion: TDataValueVersionEh; ReaderDataSet: TDataSet) of object;
TDataDriverEh = class(TComponent)
private
FKeyFields: String;
FOnAssignFieldValue: TAssignFieldValueEhEvent;
FOnBuildDataStruct: TBuildDataStructEhEvent;
FOnProduceDataReader: TProduceDataReaderEhEvent;
FOnReadRecord: TReadRecordEhEvent;
FOnRefreshRecord: TRecordEhEvent;
FOnUpdateError: TUpdateErrorEhEvent;
FOnUpdateRecord: TRecordEhEvent;
FProviderDataSet: TDataSet;
FProviderEOF: Boolean;
FReaderDataSet: TDataSet;
FReaderDataSetFreeOnEof: Boolean;
FResolveToDataSet: Boolean;
procedure SetKeyFields(const Value: String);
procedure SetProviderDataSet(const Value: TDataSet);
procedure SetProviderEOF(const Value: Boolean);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetAutoIncFields(Fields: TFields; DataStruct: TMTDataStructEh); virtual;
property KeyFields: String read FKeyFields write SetKeyFields;
property ProviderDataSet: TDataSet read FProviderDataSet write SetProviderDataSet;
property ReaderDataSet: TDataSet read FReaderDataSet;
public
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 OnBuildDataStruct: TBuildDataStructEhEvent read FOnBuildDataStruct write FOnBuildDataStruct;
property OnProduceDataReader: TProduceDataReaderEhEvent read FOnProduceDataReader write FOnProduceDataReader;
property OnAssignFieldValue: TAssignFieldValueEhEvent read FOnAssignFieldValue write FOnAssignFieldValue;
property OnReadRecord: TReadRecordEhEvent read FOnReadRecord write FOnReadRecord;
property OnRefreshRecord: TRecordEhEvent read FOnRefreshRecord write FOnRefreshRecord;
property OnUpdateRecord: TRecordEhEvent read FOnUpdateRecord write FOnUpdateRecord;
property OnUpdateError: TUpdateErrorEhEvent read FOnUpdateError write FOnUpdateError;
property ProviderEOF: Boolean read FProviderEOF write SetProviderEOF;
property ResolveToDataSet: Boolean read FResolveToDataSet write FResolveToDataSet;
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;
{ TCustomSQLCommandEh }
TCustomSQLDataDriverEh = class;
TCustomSQLCommandEh = class;
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;
// FOnExecute: TSQLExecuteEhEvent;
function IsCommandTypeStored: 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;
function Execute(var Cursor: TDataSet; var FreeOnEof: Boolean): Integer; virtual;
function GetNamePath: String; override;
procedure Assign(Source: TPersistent); override;
procedure RefreshParams(MemRecord: TMemoryRecordEh; DataValueVersion: TDataValueVersionEh); virtual;
// property OnExecute: TSQLExecuteEhEvent read FOnExecute write FOnExecute;
property DataDriver: TCustomSQLDataDriverEh read FDataDriver;
property CommandText: TStrings read GetCommandText write SetCommandText;
property CommandType: TSQLCommandTypeEh read GetCommandType write SetCommandType
stored IsCommandTypeStored;
end;
{ TCustomSQLDataDriverEh }
{$IFNDEF EH_LIB_6}
IInterface = IUnknown;
{$ENDIF}
TExecuteCommandEhEvent = function (Command: TCustomSQLCommandEh; var Cursor: TDataSet;
var FreeOnEof: Boolean): Integer of object;
TGetBackUpdatedValuesEhEvent = procedure (MemRec: TMemoryRecordEh;
Command: TCustomSQLCommandEh; ResDataSet: TDataSet) of object;
TCustomSQLDataDriverEh = class(TDataDriverEh)
private
FDeleteCommand: TCustomSQLCommandEh;
FDesignDataBase: IInterface;
FInsertCommand: TCustomSQLCommandEh;
FSelectCommand: TCustomSQLCommandEh;
FGetrecCommand: TCustomSQLCommandEh;
FUpdateCommand: TCustomSQLCommandEh;
FOnExecuteCommand: TExecuteCommandEhEvent;
FOnGetBackUpdatedValues: TGetBackUpdatedValuesEhEvent;
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 SetGetrecSQL(const Value: TStrings);
procedure SetInsertCommand(const Value: TCustomSQLCommandEh);
procedure SetInsertSQL(const Value: TStrings);
procedure SetSelectCommand(const Value: TCustomSQLCommandEh);
procedure SetGetrecCommand(const Value: TCustomSQLCommandEh);
procedure SetSelectSQL(const Value: TStrings);
procedure SetUpdateCommand(const Value: TCustomSQLCommandEh);
procedure SetUpdateSQL(const Value: TStrings);
public
{DesignTime stuff}
function CreateDesignCopy: TCustomSQLDataDriverEh; virtual;
function CreateDesignDataBase: IInterface; virtual;
procedure AssignFromDesignDriver(DesignDataDriver: TCustomSQLDataDriverEh); virtual;
property DesignDataBase: IInterface read FDesignDataBase write FDesignDataBase;
protected
// function GetReaderDataSet: TDataSet; override;
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;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function DefaultUpdateRecord(MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh): Integer; override;
function ExecuteCommand(Command: TCustomSQLCommandEh; var Cursor: TDataSet; var FreeOnEof: Boolean): Integer; virtual;
function DefaultExecuteCommand(Command: TCustomSQLCommandEh; var Cursor: TDataSet; var FreeOnEof: Boolean): Integer; 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;
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 UpdateCommand: TCustomSQLCommandEh read FUpdateCommand write SetUpdateCommand;
property UpdateSQL: TStrings read GetUpdateSQL write SetUpdateSQL stored False;
property OnExecuteCommand: TExecuteCommandEhEvent read FOnExecuteCommand write FOnExecuteCommand;
property OnGetBackUpdatedValues: TGetBackUpdatedValuesEhEvent read FOnGetBackUpdatedValues write FOnGetBackUpdatedValues;
end;
{ TSQLDataDriverResolver }
TResolverExecuteCommandEhEvent = function (SQLDataDriver: TCustomSQLDataDriverEh;
Command: TCustomSQLCommandEh; var Cursor: TDataSet; var FreeOnEof: Boolean;
var Processed: Boolean): Integer of object;
TSQLDataDriverResolver = class(TPersistent)
private
FOnExecuteCommand: TResolverExecuteCommandEhEvent;
public
function ExecuteCommand(SQLDataDriver: TCustomSQLDataDriverEh; Command: TCustomSQLCommandEh;
var Cursor: TDataSet; var FreeOnEof: Boolean; var Processed: Boolean): Integer; virtual;
property OnExecuteCommand: TResolverExecuteCommandEhEvent read FOnExecuteCommand write FOnExecuteCommand;
end;
TBaseSQLCommandEh = class;
{ TBaseSQLDataDriverEh }
TBaseSQLDataDriverEh = class(TCustomSQLDataDriverEh)
private
FOnAssignCommandParam: TAssignParamEhEvent;
function GetDeleteCommand: TBaseSQLCommandEh;
function GetInsertCommand: TBaseSQLCommandEh;
function GetSelectCommand: TBaseSQLCommandEh;
function GetGetrecCommand: TBaseSQLCommandEh;
function GetUpdateCommand: TBaseSQLCommandEh;
procedure SetDeleteCommand(const Value: TBaseSQLCommandEh);
procedure SetInsertCommand(const Value: TBaseSQLCommandEh);
procedure SetSelectCommand(const Value: TBaseSQLCommandEh);
procedure SetGetrecCommand(const Value: TBaseSQLCommandEh);
procedure SetUpdateCommand(const Value: TBaseSQLCommandEh);
protected
function CreateDeleteCommand: TCustomSQLCommandEh; override;
function CreateInsertCommand: TCustomSQLCommandEh; override;
function CreateSelectCommand: TCustomSQLCommandEh; override;
function CreateGetrecCommand: TCustomSQLCommandEh; override;
function CreateUpdateCommand: TCustomSQLCommandEh; override;
procedure AssignCommandParam(Command: TBaseSQLCommandEh;
MemRecord: TMemoryRecordEh; DataValueVersion: TDataValueVersionEh; Param: TParam); virtual;
public
procedure DefaultGetUpdatedServerValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet); override;
procedure DefaultAssignCommandParam(Command: TBaseSQLCommandEh;
MemRecord: TMemoryRecordEh; DataValueVersion: TDataValueVersionEh; Param: TParam); virtual;
property OnAssignCommandParam: TAssignParamEhEvent read FOnAssignCommandParam write FOnAssignCommandParam;
property DeleteCommand: TBaseSQLCommandEh read GetDeleteCommand write SetDeleteCommand;
property GetrecCommand: TBaseSQLCommandEh read GetGetrecCommand write SetGetrecCommand;
property InsertCommand: TBaseSQLCommandEh read GetInsertCommand write SetInsertCommand;
property SelectCommand: TBaseSQLCommandEh read GetSelectCommand write SetSelectCommand;
property UpdateCommand: TBaseSQLCommandEh read GetUpdateCommand write SetUpdateCommand;
end;
{ TBaseSQLCommandEh }
TBaseSQLCommandEh = class(TCustomSQLCommandEh)
private
FParamCheck: Boolean;
FParams: TParams;
FOnAssignParam: TAssignParamEhEvent;
function GetParamCheck: Boolean;
function GetParams: TParams;
function GetDataDriver: TBaseSQLDataDriverEh;
protected
procedure CommandTextChanged(Sender: TObject); override;
procedure SetParamCheck(const Value: Boolean); virtual;
procedure SetParams(const Value: TParams); virtual;
public
constructor Create(ADataDriver: TBaseSQLDataDriverEh);
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure DefaultRefreshParam(MemRecord: TMemoryRecordEh;
DataValueVersion: TDataValueVersionEh; Param: TParam); virtual;
procedure RefreshParams(MemRecord: TMemoryRecordEh; DataValueVersion: TDataValueVersionEh); override;
property DataDriver: TBaseSQLDataDriverEh read GetDataDriver;
property OnAssignParam: TAssignParamEhEvent read FOnAssignParam write FOnAssignParam;
property Params: TParams read GetParams write SetParams;
property ParamCheck: Boolean read GetParamCheck write SetParamCheck default True;
end;
TSQLCommandEh = class(TBaseSQLCommandEh)
published
property Params;
property ParamCheck;
property CommandText;
property CommandType;
end;
TSQLDataDriverEh = class(TBaseSQLDataDriverEh)
protected
function CreateSelectCommand: TCustomSQLCommandEh; override;
function CreateUpdateCommand: TCustomSQLCommandEh; override;
function CreateInsertCommand: TCustomSQLCommandEh; override;
function CreateDeleteCommand: TCustomSQLCommandEh; override;
function CreateGetrecCommand: TCustomSQLCommandEh; override;
published
property DeleteCommand;
property DeleteSQL;
property GetrecCommand;
property GetrecSQL;
property InsertCommand;
property InsertSQL;
property SelectCommand;
property SelectSQL;
property UpdateCommand;
property UpdateSQL;
property KeyFields;
property ProviderDataSet;
property OnAssignCommandParam;
property OnAssignFieldValue;
property OnBuildDataStruct;
property OnExecuteCommand;
property OnGetBackUpdatedValues;
property OnProduceDataReader;
property OnReadRecord;
property OnRefreshRecord;
property OnUpdateError;
property OnUpdateRecord;
end;
TSQLDataDriverEhClass = class of TCustomSQLDataDriverEh;
TSetDesignDataBaseProcEh = procedure(DataDriver: TBaseSQLDataDriverEh);
function DefaultSQLDataDriverResolver: TSQLDataDriverResolver;
function RegisterDefaultSQLDataDriverResolver(ASQLDataDriverResolver: TSQLDataDriverResolver): TSQLDataDriverResolver;
procedure RegisterDesignDataBuilderProcEh(DataDriverClass: TSQLDataDriverEhClass;
DesignDataBaseProc: TSetDesignDataBaseProcEh);
procedure UnregisterDesignDataBuilderProcEh(DataDriverClass: TSQLDataDriverEhClass);
function GetDesignDataBuilderProcEh(DataDriverClass: TSQLDataDriverEhClass):
TSetDesignDataBaseProcEh;
implementation
uses
{$IFDEF CIL}
System.Runtime.InteropServices,
{$ENDIF}
MemTableEh;
{$IFDEF CIL}
function DataSetCompareBookmarks(DataSet: TDataSet; Bookmark1, Bookmark2: TBookmarkStr): Integer;
var
I1, I2: IntPtr;
begin
try
I1 := Marshal.StringToHGlobalAnsi(Bookmark1);
I2 := Marshal.StringToHGlobalAnsi(Bookmark1);
Result := DataSet.CompareBookmarks(TBookmark(I1), TBookmark(I2));
finally
Marshal.FreeHGlobal(I1);
if Assigned(I2) then
Marshal.FreeHGlobal(I2);
end;
end;
function DataSetBookmarkValid(DataSet: TDataSet; Bookmark: TBookmarkStr): Boolean;
var
I1: IntPtr;
begin
try
I1 := Marshal.StringToHGlobalAnsi(Bookmark);
Result := DataSet.BookmarkValid(TBookmark(I1));
finally
Marshal.FreeHGlobal(I1);
end;
end;
{$ELSE}
function DataSetCompareBookmarks(DataSet: TDataSet; Bookmark1, Bookmark2: TBookmarkStr): Integer;
begin
Result := DataSet.CompareBookmarks(TBookmark(Bookmark1), TBookmark(Bookmark2));
end;
function DataSetBookmarkValid(DataSet: TDataSet; Bookmark: TBookmarkStr): Boolean;
begin
Result := DataSet.BookmarkValid(TBookmark(Bookmark));
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -