unit uDADatasetWrapper; {----------------------------------------------------------------------------} { Data Abstract Library - Core Library } { } { compiler: Delphi 6 and up, Kylix 3 and up } { platform: Win32, Linux } { } { (c)opyright RemObjects Software. all rights reserved. } { } { Using this code requires a valid license of the Data Abstract } { which can be obtained at http://www.remobjects.com. } {----------------------------------------------------------------------------} {$I DataAbstract.inc} interface uses Classes, DB, {$IFDEF MSWINDOWS}ActiveX,{$ENDIF} uDAInterfaces; type TDatasetWrapper = class(TInterfacedObject, {$IFDEF MSWINDOWS}ISupportErrorInfo,{$ENDIF} IDADataset, IDAEditableDataset) private FDataset: TDataset; FLogicalName: string; fFields: TDAFieldCollection; fParams: TDAParamCollection; fAfterOpenIDataset: TDAAfterOpenDatasetEvent; fBeforeOpenIDataset: TDABeforeOpenDatasetEvent; FOld_BeforeClose: TDataSetNotifyEvent; FOld_BeforeOpen: TDataSetNotifyEvent; FOld_AfterOpen: TDataSetNotifyEvent; procedure DatasetBeforeOpen(DataSet: TDataSet); procedure DatasetBeforeClose(DataSet: TDataSet); procedure DatasetAfterOpen(DataSet: TDataSet); procedure AttachEventHooks(aDataset: TDataset); procedure DetachEventHooks(aDataset: TDataset); procedure BindFields; procedure UnbindFields; protected function GetParams: TDAParamCollection; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetPrepared: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure SetPrepared(Value: boolean); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetWhere: TDAWhere; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetDynamicWhere: TDAWhereBuilder; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure SetDynamicWhere(const Value: TDAWhereBuilder); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetSQL: string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure SetSQL(const Value: string); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function SQLContainsDynamicWhere: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetDataset: TDataset; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetName: string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetOnAfterExecute: TDAAfterExecuteCommandEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetOnBeforeExecute: TDABeforeExecuteCommandEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure SetOnAfterExecute(const Value: TDAAfterExecuteCommandEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure SetOnBeforeExecute(const Value: TDABeforeExecuteCommandEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetOnExecuteError: TDAExecuteCommandErrorEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure SetOnExecuteError(const Value: TDAExecuteCommandErrorEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} // Methods procedure RefreshParams; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function Execute: integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function ParamByName(const aName: string): TDAParam; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} // Properties readers/writers function GetRecordCount: integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetFieldCount: integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetFields: TDAFieldCollection; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetActive: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure SetActive(Value: boolean); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetBOF: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetEOF: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetFieldValues(Index: integer): Variant; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetNames(Index: integer): string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetIsEmpty: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetState: TDatasetState; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetLogicalName: string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure SetLogicalName(aName: string); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetOnAfterOpen: TDAAfterOpenDatasetEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetOnBeforeOpen: TDABeforeOpenDatasetEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure SetOnAfterOpen(const Value: TDAAfterOpenDatasetEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure SetOnBeforeOpen(const Value: TDABeforeOpenDatasetEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetOnOpenError: TDAOpenDatasetErrorEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure SetOnOpenError(const Value: TDAOpenDatasetErrorEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} // Methods procedure Open; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure Close; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure EnableControls; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure DisableControls; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure Refresh; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure Next; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function FieldByName(const aName: string): TDAField; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function FindField(const aName: string): TDAField; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetBookMark: pointer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure GotoBookmark(Bookmark: TBookmark); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure FreeBookmark(Bookmark: TBookmark); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function BookmarkValid(Bookmark: TBookmark): Boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetCurrentRecIdValue: integer; procedure SetCurrentRecIdValue(Value: integer); function GetRowRecIDValue: integer; procedure EnableConstraints; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure DisableConstraints; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure Edit; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure Insert; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure Post; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure Cancel; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure Append; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure Delete; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure Prior; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure First; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure Last; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure AddRecord(const FieldNames: array of string; const FieldValues: array of Variant); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure EnableEventHandlers; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure DisableEventHandlers; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function ControlsDisabled: Boolean;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} {$IFDEF MSWINDOWS} protected function InterfaceSupportsErrorInfo(const iid: TGUID): HResult; stdcall; public function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override; {$ENDIF} public constructor Create(ADataset: TDataset); destructor Destroy; override; property RowRecIdValue: integer read GetRowRecIdValue; property CurrentRecIdValue: integer read GetCurrentRecIdValue write SetCurrentRecIdValue; // Properties property IsEmpty: boolean read GetIsEmpty; property State: TDatasetState read GetState; property BOF: boolean read GetBOF; property EOF: boolean read GetEOF; property RecordCount: integer read GetRecordCount; property Fields: TDAFieldCollection read GetFields; property Active: boolean read GetActive write SetActive; property FieldCount: integer read GetFieldCount; property FieldValues[Index: integer]: Variant read GetFieldValues; property Names[Index: integer]: string read GetNames; property LogicalName: string read GetLogicalName write SetLogicalName; property OnBeforeOpen: TDABeforeOpenDatasetEvent read GetOnBeforeOpen write SetOnBeforeOpen; property OnAfterOpen: TDAAfterOpenDatasetEvent read GetOnAfterOpen write SetOnAfterOpen; property OnOpenError: TDAOpenDatasetErrorEvent read GetOnOpenError write SetOnOpenError; property Name: string read GetName; property Dataset: TDataSet read GetDataset; property SQL: string read GetSQL write SetSQL; property Params: TDAParamCollection read GetParams; property Prepared: boolean read GetPrepared write SetPrepared; property Where: TDAWhere read GetWhere; property OnBeforeExecute: TDABeforeExecuteCommandEvent read GetOnBeforeExecute write SetOnBeforeExecute; property OnAfterExecute: TDAAfterExecuteCommandEvent read GetOnAfterExecute write SetOnAfterExecute; property OnExecuteError: TDAExecuteCommandErrorEvent read GetOnExecuteError write SetOnExecuteError; end; implementation uses SysUtils, uROClasses, uDARes, uDAEngine; { TDatasetWrapper } procedure TDatasetWrapper.AddRecord(const FieldNames: array of string; const FieldValues: array of Variant); var i: integer; begin Insert; for i := 0 to Length(FieldNames) - 1 do FieldByName(FieldNames[i]).Value := FieldValues[i]; Post; end; procedure TDatasetWrapper.Append; begin FDataset.Append; end; procedure TDatasetWrapper.AttachEventHooks(aDataset: TDataset); begin fFields.FieldEventsDisabled := FALSE; end; procedure TDatasetWrapper.BindFields; var i: integer; fld: TField; daFld: TDAField; l: TDABlobType; begin fFields.Clear; for i := 0 to (Fdataset.FieldCount - 1) do begin fld := Fdataset.Fields[i]; daFld := fFields.Add; with daFld do begin Name := fld.FieldName; Size := fld.Size; DataType := VCLTypeToDAType(fld.DataType); for l := dabtBlob to High(TDABlobType) do begin if fld.DataType = BlobTypeMappings[l] then begin BlobType:=l; Break; end; end; end; dafld.Bind(fld); end; end; procedure TDatasetWrapper.Cancel; begin FDataset.Cancel; end; procedure TDatasetWrapper.Close; begin FDataset.Close; end; constructor TDatasetWrapper.Create(ADataset: TDataset); begin Check(ADataset = nil, err_InvalidDataset); inherited Create; FDataset := ADataset; fFields := TDAFieldCollection.Create(nil); fParams := TDAParamCollection.Create(nil); FOld_BeforeClose := FDataset.BeforeClose; FOld_BeforeOpen := FDataset.BeforeOpen; FOld_AfterOpen := FDataset.AfterOpen; FDataset.BeforeClose := DatasetBeforeClose; FDataset.BeforeOpen := DatasetBeforeOpen; FDataset.AfterOpen := DatasetAfterOpen; if FDataset.Active then BindFields; end; procedure TDatasetWrapper.DatasetAfterOpen(DataSet: TDataSet); begin BindFields; if Assigned(fAfterOpenIDataset) then fAfterOpenIDataset(Self, '', 0); if Assigned(FOld_AfterOpen) then FOld_AfterOpen(Dataset); end; procedure TDatasetWrapper.DatasetBeforeClose(DataSet: TDataSet); begin UnbindFields; if Assigned(FOld_BeforeClose) then FOld_BeforeClose(DataSet); end; procedure TDatasetWrapper.DatasetBeforeOpen(DataSet: TDataSet); begin if Assigned(fBeforeOpenIDataset) then fBeforeOpenIDataset(Self); if Assigned(FOld_BeforeOpen) then FOld_BeforeOpen(DataSet); end; procedure TDatasetWrapper.Delete; begin FDataset.Delete; end; destructor TDatasetWrapper.Destroy; begin UnbindFields; if FDataset <> nil then begin FDataset.BeforeClose := FOld_BeforeClose; FDataset.BeforeOpen := FOld_BeforeOpen; FDataset.AfterOpen := FOld_AfterOpen; end; fFields.Free; fParams.Free; inherited; end; procedure TDatasetWrapper.DetachEventHooks(aDataset: TDataset); begin fFields.FieldEventsDisabled := TRUE; end; procedure TDatasetWrapper.DisableConstraints; begin // nothing end; procedure TDatasetWrapper.DisableControls; begin FDataset.DisableControls; end; procedure TDatasetWrapper.DisableEventHandlers; begin DetachEventHooks(Dataset); end; procedure TDatasetWrapper.Edit; begin FDataset.Edit; end; procedure TDatasetWrapper.EnableConstraints; begin // nothing end; procedure TDatasetWrapper.EnableControls; begin FDataset.EnableControls; end; procedure TDatasetWrapper.EnableEventHandlers; begin AttachEventHooks(Dataset); end; function TDatasetWrapper.Execute: integer; begin // Not implemented result := -1; end; function TDatasetWrapper.FieldByName(const aName: string): TDAField; begin Result := fFields.FieldByName(aName); end; function TDatasetWrapper.FindField(const aName: string): TDAField; begin result := fFields.FindField(aName); end; procedure TDatasetWrapper.First; begin FDataset.First; end; procedure TDatasetWrapper.FreeBookmark(Bookmark: TBookmark); begin FDataset.FreeBookmark(Bookmark); end; function TDatasetWrapper.GetActive: boolean; begin Result := FDataset.Active; end; function TDatasetWrapper.GetBOF: boolean; begin Result := FDataset.Bof; end; function TDatasetWrapper.GetBookMark: pointer; begin Result := FDataset.GetBookmark; end; function TDatasetWrapper.GetCurrentRecIdValue: integer; begin Result := FDataset.RecNo; end; function TDatasetWrapper.GetDataset: TDataset; begin Result := FDataset; end; function TDatasetWrapper.GetEOF: boolean; begin Result := FDataset.Eof; end; function TDatasetWrapper.GetFieldCount: integer; begin Result := fFields.Count; end; function TDatasetWrapper.GetFields: TDAFieldCollection; begin result := fFields; end; function TDatasetWrapper.GetFieldValues(Index: integer): Variant; begin Result := fFields[Index].Value; end; function TDatasetWrapper.GetIsEmpty: boolean; begin Result := FDataset.IsEmpty; end; function TDatasetWrapper.GetLogicalName: string; begin Result := FLogicalName; end; function TDatasetWrapper.GetName: string; begin if (LogicalName = '') then result := Fdataset.Name else result := LogicalName; end; function TDatasetWrapper.GetNames(Index: integer): string; begin Result := Fields[Index].Name; end; function TDatasetWrapper.GetOnAfterExecute: TDAAfterExecuteCommandEvent; begin Result := nil; NotSupported(); end; function TDatasetWrapper.GetOnAfterOpen: TDAAfterOpenDatasetEvent; begin result := fAfterOpenIDataset; end; function TDatasetWrapper.GetOnBeforeExecute: TDABeforeExecuteCommandEvent; begin Result := nil; NotSupported(); end; function TDatasetWrapper.GetOnBeforeOpen: TDABeforeOpenDatasetEvent; begin result := fBeforeOpenIDataset; end; function TDatasetWrapper.GetOnExecuteError: TDAExecuteCommandErrorEvent; begin Result := nil; NotSupported(); end; function TDatasetWrapper.GetOnOpenError: TDAOpenDatasetErrorEvent; begin Result := nil; NotSupported(); end; function TDatasetWrapper.GetParams: TDAParamCollection; begin Result := fParams; end; function TDatasetWrapper.GetPrepared: boolean; begin Result := False; NotSupported(); end; function TDatasetWrapper.GetRecordCount: integer; begin Result := FDataset.RecordCount; end; function TDatasetWrapper.GetRowRecIDValue: integer; begin result := -1; end; function TDatasetWrapper.GetSQL: string; begin // Not implemented result := ''; end; function TDatasetWrapper.GetState: TDatasetState; begin Result := FDataset.State; end; function TDatasetWrapper.GetWhere: TDAWhere; begin Result := nil; end; procedure TDatasetWrapper.GotoBookmark(Bookmark: TBookmark); begin FDataset.GotoBookmark(Bookmark); end; procedure TDatasetWrapper.Insert; begin FDataset.Insert; end; procedure TDatasetWrapper.Last; begin FDataset.Last; end; function TDatasetWrapper.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; begin Result := FDataset.Locate(KeyFields, KeyValues, Options); end; function TDatasetWrapper.Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; begin Result := FDataset.Lookup(KeyFields, KeyValues, ResultFields); end; procedure TDatasetWrapper.Next; begin FDataset.Next; end; procedure TDatasetWrapper.Open; begin Dataset.Open; end; function TDatasetWrapper.ParamByName(const aName: string): TDAParam; begin Result := nil; NotSupported(); end; procedure TDatasetWrapper.Post; begin FDataset.Post; end; procedure TDatasetWrapper.Prior; begin FDataset.Prior; end; procedure TDatasetWrapper.Refresh; begin FDataset.Refresh; end; procedure TDatasetWrapper.RefreshParams; begin // Not implemented NotSupported(); end; procedure TDatasetWrapper.SetActive(Value: boolean); begin FDataset.Active := Value; end; procedure TDatasetWrapper.SetCurrentRecIdValue(Value: integer); begin FDataset.RecNo := Value; end; procedure TDatasetWrapper.SetLogicalName(aName: string); begin FLogicalName := AName; end; procedure TDatasetWrapper.SetOnAfterExecute( const Value: TDAAfterExecuteCommandEvent); begin NotSupported(); end; procedure TDatasetWrapper.SetOnAfterOpen( const Value: TDAAfterOpenDatasetEvent); begin fAfterOpenIDataset := Value; end; procedure TDatasetWrapper.SetOnBeforeExecute( const Value: TDABeforeExecuteCommandEvent); begin NotSupported(); end; procedure TDatasetWrapper.SetOnBeforeOpen( const Value: TDABeforeOpenDatasetEvent); begin fBeforeOpenIDataset := Value; end; procedure TDatasetWrapper.SetOnExecuteError( const Value: TDAExecuteCommandErrorEvent); begin NotSupported(); end; procedure TDatasetWrapper.SetOnOpenError( const Value: TDAOpenDatasetErrorEvent); begin NotSupported(); end; procedure TDatasetWrapper.SetPrepared(Value: boolean); begin NotSupported(); end; procedure TDatasetWrapper.SetSQL(const Value: string); begin // Not implemented end; procedure TDatasetWrapper.UnbindFields; var i: integer; begin for i := 0 to (FFields.Count - 1) do fFields[i].Unbind; end; {$IFDEF MSWINDOWS} function TDatasetWrapper.InterfaceSupportsErrorInfo(const iid: TGUID): HResult; begin if GetInterfaceEntry(iid) <> nil then Result := S_OK else Result := S_FALSE; end; function TDatasetWrapper.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; begin Result := uDAEngine.DAHandleSafeCallException(self,ExceptObject, ExceptAddr); end; {$ENDIF} function TDatasetWrapper.GetDynamicWhere: TDAWhereBuilder; begin Result:=nil; end; procedure TDatasetWrapper.SetDynamicWhere(const Value: TDAWhereBuilder); begin // nothing end; function TDatasetWrapper.SQLContainsDynamicWhere: boolean; begin Result:=False; // Not implemented end; function TDatasetWrapper.BookmarkValid(Bookmark: TBookmark): Boolean; begin Result := FDataset.BookmarkValid(Bookmark); end; function TDatasetWrapper.ControlsDisabled: Boolean; begin Result := FDataset.ControlsDisabled; end; end.