datadrivereh.pas

最新的 DBGRIDEH4.0

    procedure DefaultGetUpdatedServerValues(SQLDataDriver: TCustomSQLDataDriverEh; MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet; var Processed: Boolean); virtual;
    property ServerSpecOperations: TServerSpecOperationsEh read FServerSpecOperations write FServerSpecOperations;
    property OnExecuteCommand: TResolverExecuteCommandEhEvent read FOnExecuteCommand write FOnExecuteCommand;
    property OnGetBackUpdatedValues: TResolverGetBackUpdatedValuesEhEvent read FOnGetBackUpdatedValues write FOnGetBackUpdatedValues;
    property OnGetServerSpecOperations: TResolverGetServerSpecOperationsEh read FOnGetServerSpecOperations write FOnGetServerSpecOperations;
    property OnUpdateRecord: TResolverUpdateRecordEhEvent read FOnUpdateRecord write FOnUpdateRecord;
  end;

  TBaseSQLCommandEh = class;
  TBaseSQLDataDriverEh = class;

  TSQLDataDriverExecuteCommandEhEvent = function (DataDriver: TBaseSQLDataDriverEh;
    Command: TBaseSQLCommandEh; var Cursor: TDataSet; var FreeOnEof: Boolean): Integer of object;
  TSQLDataDriverAssignParamEhEvent = procedure (DataDriver: TBaseSQLDataDriverEh;
    Command: TBaseSQLCommandEh; MemRecord: TMemoryRecordEh;
    DataValueVersion: TDataValueVersionEh; Param: TParam) of object;
  TSQLDataDriverGetBackUpdatedValuesEhEvent = procedure (DataDriver: TBaseSQLDataDriverEh;
    MemRec: TMemoryRecordEh; Command: TBaseSQLCommandEh; ResDataSet: TDataSet) of object;

{ TBaseSQLDataDriverEh }

  TBaseSQLDataDriverEh = class(TCustomSQLDataDriverEh)
  private
    FOnAssignCommandParam: TSQLDataDriverAssignParamEhEvent;
    FOnExecuteCommand: TSQLDataDriverExecuteCommandEhEvent;
    FOnGetBackUpdatedValues: TSQLDataDriverGetBackUpdatedValuesEhEvent;
    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 CreateCommand: TCustomSQLCommandEh; override;
    procedure AssignCommandParam(Command: TBaseSQLCommandEh;
      MemRecord: TMemoryRecordEh; DataValueVersion: TDataValueVersionEh; Param: TParam); virtual;
  public
    function ExecuteCommand(Command: TCustomSQLCommandEh; var Cursor: TDataSet; var FreeOnEof: Boolean): Integer; override;
    procedure DefaultGetUpdatedServerValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet); override;
    procedure DefaultAssignCommandParam(Command: TBaseSQLCommandEh;
      MemRecord: TMemoryRecordEh; DataValueVersion: TDataValueVersionEh; Param: TParam); virtual;
    procedure GetBackUpdatedValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet); override;
    property DynaSQLParams;
    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;
    property SpecParams;
    property OnAssignCommandParam: TSQLDataDriverAssignParamEhEvent read FOnAssignCommandParam write FOnAssignCommandParam;
    property OnExecuteCommand: TSQLDataDriverExecuteCommandEhEvent read FOnExecuteCommand write FOnExecuteCommand;
    property OnGetBackUpdatedValues: TSQLDataDriverGetBackUpdatedValuesEhEvent read FOnGetBackUpdatedValues write FOnGetBackUpdatedValues;
  end;

{ TBaseSQLCommandEh }

  TBaseSQLCommandEh = class(TCustomSQLCommandEh)
  private
    FParamCheck: Boolean;
    FParams: TParams;
    FOnAssignParam: TAssignParamEhEvent;
    function GetParamCheck: Boolean;
    function GetDataDriver: TBaseSQLDataDriverEh;
  protected
    procedure CommandTextChanged(Sender: TObject); override;
    procedure SetParamCheck(const Value: Boolean); virtual;
  public
    constructor Create(ADataDriver: TBaseSQLDataDriverEh);
    destructor Destroy; override;
    function GetParams: TParams; override;
    procedure Assign(Source: TPersistent); override;
//    procedure AssignParams(AParams: TParams); override;
//    procedure AssignToParams(AParams: TParams); override;
    procedure SetParams(AParams: TParams); 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 }

  TSQLCommandEh = class(TBaseSQLCommandEh)
  published
    property Params;
    property ParamCheck;
    property CommandText;
    property CommandType;
//    property DynamicSQL;
  end;

{ TSQLDataDriverEh }

  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 DynaSQLParams;
    property GetrecCommand;
    property GetrecSQL;
    property InsertCommand;
    property InsertSQL;
    property SelectCommand;
    property SelectSQL;
    property UpdateCommand;
    property UpdateSQL;
    property KeyFields;
    property ProviderDataSet;
    property SpecParams;

    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;

{ IDesignDataBaseEh }

  IDesignDataBaseEh = interface
  ['{01F477A4-8417-4DC9-B93A-1F95D2FF2EB8}']
    function CreateDesignCopy(RTDataDriver: TCustomSQLDataDriverEh): TCustomSQLDataDriverEh;
    function Execute(Command: TCustomSQLCommandEh; var Cursor: TDataSet; var FreeOnEof: Boolean): Integer;
    function BuildUpdates(DataDriver: TCustomSQLDataDriverEh): Boolean;
    function BuildObjectTree(List: TList): Boolean;
    function GetFieldList(const TableName: string; DataSet: TDataSet): Boolean;
    procedure EditDatabaseParams;
    function GetConnected: Boolean;
    procedure SetConnected(const Value: Boolean);
  end;

{ TOracleSpecOperationsEh }

  TOracleSpecOperationsEh = class(TServerSpecOperationsEh)
    function UpdateRecord(SQLDataDriver: TCustomSQLDataDriverEh; MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh): Integer; override;
    procedure GetBackUpdatedValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet); override;
  end;

{ TMSSQLSpecOperationsEh }

  TMSSQLSpecOperationsEh = class(TServerSpecOperationsEh)
    procedure GetBackUpdatedValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet); override;
  public
    constructor Create; override;
  end;

{ TInterbaseSpecOperationsEh }

  TInterbaseSpecOperationsEh = class(TServerSpecOperationsEh)
    function UpdateRecord(SQLDataDriver: TCustomSQLDataDriverEh; MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh): Integer; override;
    procedure GetBackUpdatedValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet); override;
  end;

{ TInfromixSpecOperationsEh }

  TInfromixSpecOperationsEh = class(TServerSpecOperationsEh)
    procedure GetBackUpdatedValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet); override;
  public
    constructor Create; override;
  end;

{ TDB2SpecOperationsEh }

  TDB2SpecOperationsEh = class(TServerSpecOperationsEh)
    procedure GetBackUpdatedValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet); override;
  end;

{ TSybaseSpecOperationsEh }

  TSybaseSpecOperationsEh = class(TServerSpecOperationsEh)
    procedure GetBackUpdatedValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet); override;
  end;

{ TMSAccessSpecOperationsEh }

  TMSAccessSpecOperationsEh = class(TServerSpecOperationsEh)
    procedure GetBackUpdatedValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet); override;
  public
    constructor Create; override;
  end;

  TSetDesignDataBaseProcEh = procedure(DataDriver: TCustomSQLDataDriverEh);

function DefaultSQLDataDriverResolver: TSQLDataDriverResolver;
function RegisterDefaultSQLDataDriverResolver(ASQLDataDriverResolver: TSQLDataDriverResolver): TSQLDataDriverResolver;


procedure RegisterDesignDataBuilderProcEh(DataDriverClass: TSQLDataDriverEhClass;
  DesignDataBaseProc: TSetDesignDataBaseProcEh);
procedure UnregisterDesignDataBuilderProcEh(DataDriverClass: TSQLDataDriverEhClass);
function GetDesignDataBuilderProcEh(DataDriverClass: TSQLDataDriverEhClass):
  TSetDesignDataBaseProcEh;

procedure VarParamsToParams(VarParams: Variant; Params: TParams);

implementation

uses
  Dialogs,
{$IFDEF CIL}
  System.Runtime.InteropServices,
{$ENDIF}
  MemTableEh;

var
  AnsiServerSpecOperations: TServerSpecOperationsEh;
  DesignDataBuilderClasses: TList;
  DesignDataBuilderProcs: TList;

{$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;

{$ENDIF}

var
  FDefaultSQLDataDriverResolver: TSQLDataDriverResolver;

function DefaultSQLDataDriverResolver: TSQLDataDriverResolver;
begin
  Result := FDefaultSQLDataDriverResolver;
end;

function RegisterDefaultSQLDataDriverResolver(ASQLDataDriverResolver: TSQLDataDriverResolver): TSQLDataDriverResolver;
begin
  Result := FDefaultSQLDataDriverResolver;
  FDefaultSQLDataDriverResolver := ASQLDataDriverResolver;
end;

procedure InitializeUnit;
var
  Resolver: TSQLDataDriverResolver;
begin
  AnsiServerSpecOperations := TServerSpecOperationsEh.Create;
  Resolver := TSQLDataDriverResolver.Create;
//  Does add this to avoide automatic resolution for all SQLDataDriver.
//  Resolver.ServerSpecOperations := AnsiServerSpecOperations;
  RegisterDefaultSQLDataDriverResolver(Resolver);
end;

procedure FinalizaUnit;
begin
  FreeAndNil(FDefaultSQLDataDriverResolver);
  FreeAndNil(DesignDataBuilderClasses);
  FreeAndNil(DesignDataBuilderProcs);
  FreeAndNil(AnsiServerSpecOperations);
end;

procedure VarParamsToParams(VarParams: Variant; Params: TParams);
var
  i: Integer;
  dt: TFieldType;
  p: TParam;
begin
  if VarIsNull(VarParams) then
    Exit;
  if VarArrayHighBound(VarParams, 1) > VarArrayLowBound(VarParams, 1) then
    for i := VarArrayLowBound(VarParams, 1) to VarArrayHighBound(VarParams, 1) div 2 do
    begin
      dt := VarTypeToDataType(VarType(VarParams[i*2+1]));
      if dt = ftUnknown then
        dt := ftString;
      p := Params.FindParam(VarParams[i*2]);
      if not Assigned(p) then
        p := Params.CreateParam(dt, VarParams[i*2], ptInputOutput);
      p.Value := VarParams[i*2+1];
    end;
end;

{ TDataDriverEh }

constructor TDataDriverEh.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FResolveToDataSet := True;
end;

destructor TDataDriverEh.Destroy;
begin
  ProviderEof := True;
  inherited Destroy;
end;

{$IFNDEF CIL}
function AcquireExceptionObject: Pointer;
type
  PRaiseFrame = ^TRaiseFrame;
  TRaiseFrame = record
    NextRaise: PRaiseFrame;
    ExceptAddr: Pointer;
    ExceptObject: TObject;
    ExceptionRecord: PExceptionRecord;
  end;
begin
  if RaiseList <> nil then
  begin
    Result := Exception(PRaiseFrame(RaiseList)^.ExceptObject);
    PRaiseFrame(RaiseList)^.ExceptObject := nil;
  end
  else