Componentes.Terceros.RemObjects/internal/5.0.23.613/1/Data Abstract for Delphi/Source/uDADatasetWrapper.pas

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; safecall;
    function GetPrepared: boolean; safecall;
    procedure SetPrepared(Value: boolean); safecall;
    function GetWhere: TDAWhere; safecall; 
    function GetDynamicWhere: TDAWhereBuilder; safecall;
    procedure SetDynamicWhere(const Value: TDAWhereBuilder);safecall;
    function GetSQL: string; safecall;
    procedure SetSQL(const Value: string); safecall;
    function SQLContainsDynamicWhere: boolean; safecall;
    function GetDataset: TDataset; safecall;
    function GetName: string; safecall;
    function GetOnAfterExecute: TDAAfterExecuteCommandEvent; safecall;
    function GetOnBeforeExecute: TDABeforeExecuteCommandEvent; safecall;
    procedure SetOnAfterExecute(const Value: TDAAfterExecuteCommandEvent); safecall;
    procedure SetOnBeforeExecute(const Value: TDABeforeExecuteCommandEvent); safecall;
    function GetOnExecuteError: TDAExecuteCommandErrorEvent; safecall;
    procedure SetOnExecuteError(const Value: TDAExecuteCommandErrorEvent); safecall;

    // Methods
    procedure RefreshParams; safecall;
    function Execute: integer; safecall;

    function ParamByName(const aName: string): TDAParam; safecall;

    // Properties readers/writers
    function GetRecordCount: integer; safecall;
    function GetFieldCount: integer; safecall;
    function GetFields: TDAFieldCollection; safecall;
    function GetActive: boolean; safecall;
    procedure SetActive(Value: boolean); safecall;
    function GetBOF: boolean; safecall;
    function GetEOF: boolean; safecall;
    function GetFieldValues(Index: integer): Variant; safecall;
    function GetNames(Index: integer): string; safecall;
    function GetIsEmpty: boolean; safecall;
    function GetState: TDatasetState; safecall;
    function GetLogicalName: string; safecall;
    procedure SetLogicalName(aName: string); safecall;

    function GetOnAfterOpen: TDAAfterOpenDatasetEvent; safecall;
    function GetOnBeforeOpen: TDABeforeOpenDatasetEvent; safecall;
    procedure SetOnAfterOpen(const Value: TDAAfterOpenDatasetEvent); safecall;
    procedure SetOnBeforeOpen(const Value: TDABeforeOpenDatasetEvent); safecall;
    function GetOnOpenError: TDAOpenDatasetErrorEvent; safecall;
    procedure SetOnOpenError(const Value: TDAOpenDatasetErrorEvent); safecall;

    // Methods
    procedure Open; safecall;
    procedure Close; safecall;

    procedure EnableControls; safecall;
    procedure DisableControls; safecall;

    procedure Refresh; safecall;

    procedure Next; safecall;

    function FieldByName(const aName: string): TDAField; safecall;
    function FindField(const aName: string): TDAField; safecall;

    function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; safecall;
    function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; safecall;

    function GetBookMark: pointer; safecall;
    procedure GotoBookmark(Bookmark: TBookmark); safecall;
    procedure FreeBookmark(Bookmark: TBookmark); safecall;

    function GetCurrentRecIdValue: integer;
    procedure SetCurrentRecIdValue(Value: integer);

    function GetRowRecIDValue: integer;

    procedure EnableConstraints; safecall;
    procedure DisableConstraints; safecall;

    procedure Edit; safecall;
    procedure Insert; safecall;
    procedure Post; safecall;
    procedure Cancel; safecall;
    procedure Append; safecall;
    procedure Delete; safecall;

    procedure Prior; safecall;
    procedure First; safecall;
    procedure Last; safecall;

    procedure AddRecord(const FieldNames: array of string; const FieldValues: array of Variant); safecall;

    procedure EnableEventHandlers; safecall;
    procedure DisableEventHandlers; safecall;
    {$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;
begin
  fFields.Clear;
  for i := 0 to (Fdataset.FieldCount - 1) do begin
    fld := Fdataset.Fields[i];
    fFields.Add(fld.FieldName, VCLTypeToDAType(fld.DataType), fld.Size).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
  NotSupported();
end;

function TDatasetWrapper.GetOnAfterOpen: TDAAfterOpenDatasetEvent;
begin
  result := fAfterOpenIDataset;
end;

function TDatasetWrapper.GetOnBeforeExecute: TDABeforeExecuteCommandEvent;
begin
  NotSupported();
end;

function TDatasetWrapper.GetOnBeforeOpen: TDABeforeOpenDatasetEvent;
begin
  result := fBeforeOpenIDataset;
end;

function TDatasetWrapper.GetOnExecuteError: TDAExecuteCommandErrorEvent;
begin
  NotSupported();
end;

function TDatasetWrapper.GetOnOpenError: TDAOpenDatasetErrorEvent;
begin
  NotSupported();
end;

function TDatasetWrapper.GetParams: TDAParamCollection;
begin
  Result := fParams;
end;

function TDatasetWrapper.GetPrepared: boolean;
begin
  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;

end.