//////////////////////////////////////////////////
//  DB Access Components
//  Copyright © 1998-2014 Devart. All right reserved.
//  Virtual DataSet
//  Created:            20.02.98
//////////////////////////////////////////////////

{$IFNDEF CLR}
{$IFNDEF EntityDAC}
{$I Dac.inc}
unit VirtualDataset;
{$ENDIF}
{$ENDIF}

interface

uses
  Classes, SysUtils, Variants, DB,
{$IFNDEF EntityDAC}
  CRTypes, MemData, MemDS;
{$ELSE}
  EntityDAC.Common.Types, EntityDAC.Common.MemData, EntityDAC.Common.MemDS;
{$ENDIF}

const
  SNotSupportFieldType = 'Field type is not supported by TVirtualTable. '#13 +
    'Valid types is String, WideString, Smallint, Integer, Word, Boolean, Largeint, Float,' + {$IFDEF VER14P}' ftSingle,' +{$ENDIF}{$IFDEF VER12P}' ftExtended,' +{$ENDIF} ' Currency, Date, Time, DateTime,' + {$IFDEF VER6P}{$IFNDEF FPC}' SQLTimeStamp,' + {$ENDIF}{$ENDIF} ' Blob, Memo, Guid, Bcd, ' + {$IFDEF VER6P} 'FmtBcd, ' + {$ENDIF} 'Bytes, VarBytes, Variant';

type
  TCustomVirtualDataSet = class;

  TOnGetRecordCountEvent = procedure(Sender: TObject; var Count: Integer) of object;
  TOnGetFieldValueEvent = procedure(Sender: TObject; Field: TField; RecNo: Integer; var Value: Variant) of object;
  TOnMidifyRecordEvent = procedure(Sender: TObject; var RecNo: Integer) of object;
  TOnDeleteRecordEvent = procedure(Sender: TObject; RecNo: Integer) of object;

  TVirtualDataSetData = class (TData)
  private
    FOwner: TCustomVirtualDataSet;
    FRecordNo: Integer;
  protected
    procedure InitData; override;
    procedure InternalOpen(DisableInitFields: boolean = False); override;
    procedure CreateFieldDescs; override;

    function GetRecordCount: Integer; override;
    function GetRecordNo: integer; override;
    procedure SetRecordNo(Value: integer); override;

    procedure GetRecordField(RecBuf: IntPtr; Field: TFieldDesc);
  public
    constructor Create;
    destructor Destroy; override;

    procedure GetRecord(RecBuf: IntPtr); override;
    procedure GetNextRecord(RecBuf: IntPtr); override;
    procedure GetPriorRecord(RecBuf: IntPtr); override;
    procedure PutRecord(RecBuf: IntPtr); override;

    procedure SetToBegin; override;
    procedure SetToEnd; override;

    procedure AppendRecord(RecBuf: IntPtr); override;
    procedure InsertRecord(RecBuf: IntPtr); override;
    procedure UpdateRecord(RecBuf: IntPtr); override;
    procedure DeleteRecord; override;

    property Owner: TCustomVirtualDataSet read FOwner;
    property RecordNo: Integer read GetRecordNo write SetRecordNo;
  end;

  TVirtualDataSetUpdater = class (TDataSetUpdater)
  protected
    function DataSet: TCustomVirtualDataSet;

    function PerformAppend: boolean; override;
    function PerformUpdate: boolean; override;
    function PerformDelete: boolean; override;
    function PerformCancel: boolean;
  end;

  TVirtualDataSetService = class (TDataSetService)
  protected
    function Updater: TVirtualDataSetUpdater;

    procedure CreateDataSetUpdater; override;
  end;

  TCustomVirtualDataSet = class({$IFNDEF EntityDAC}TMemDataSet{$ELSE}TEDMemDataSet{$ENDIF})
  private
    FIsCursorOpen: boolean;
  protected
    function DataSetService: TVirtualDataSetService;

    function GetDataSetServiceClass: TDataSetServiceClass; override;
    procedure CreateIRecordSet; override;
    procedure SetIRecordSet(Value: TData); override;

    procedure InternalOpen; override;
    procedure InternalClose; override;
    function IsCursorOpen: boolean; override;

    procedure InternalCancel; override;

    function GetField(FieldDesc: TFieldDesc): TField;

    procedure PerformInsertRecord;
    procedure PerformEditRecord;
    procedure PerformDeleteRecord;
    procedure PerformCancelRecord;

    procedure DoGetRecordCount(var Count: Integer); virtual; abstract;
    procedure DoGetFieldValue(Field: TFieldDesc; Index: Integer; var Value: Variant); virtual; abstract;
    procedure DoInsertRecord(var RecordNo: Integer); virtual; abstract;
    procedure DoEditRecord(var RecordNo: Integer); virtual; abstract;
    procedure DoDeleteRecord(RecordNo: Integer); virtual; abstract;
    procedure DoCancelRecord(RecordNo: Integer); virtual; abstract;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TVirtualDataSet = class (TCustomVirtualDataSet)
  private
    FOnGetRecordCount: TOnGetRecordCountEvent;
    FOnGetFieldValue: TOnGetFieldValueEvent;
    FOnInsertRecord: TOnMidifyRecordEvent;
    FOnEditRecord: TOnMidifyRecordEvent;
    FOnDeleteRecord: TOnDeleteRecordEvent;
  protected
    procedure DoGetRecordCount(var Count: Integer); override;
    procedure DoGetFieldValue(Field: TFieldDesc; RecNo: Integer; var Value: Variant); override;
    procedure DoInsertRecord(var RecordNo: Integer); override;
    procedure DoEditRecord(var RecordNo: Integer); override;
    procedure DoDeleteRecord(RecordNo: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    // TO-DO: remove
    procedure CreateFields; override;

    property OnGetRecordCount: TOnGetRecordCountEvent read FOnGetRecordCount write FOnGetRecordCount;
    property OnGetFieldValue: TOnGetFieldValueEvent read FOnGetFieldValue write FOnGetFieldValue;
    property OnInsertRecord: TOnMidifyRecordEvent read FOnInsertRecord write FOnInsertRecord;
    property OnEditRecord: TOnMidifyRecordEvent read FOnEditRecord write FOnEditRecord;
    property OnDeleteRecord: TOnDeleteRecordEvent read FOnDeleteRecord write FOnDeleteRecord;
  end;

implementation

uses
  SqlTimSt;

{ TVirtualDataSetData }

constructor TVirtualDataSetData.Create;
begin
  inherited;

  FOwner := nil;
end;

destructor TVirtualDataSetData.Destroy;
begin

  inherited;
end;

procedure TVirtualDataSetData.InitData;
begin
  inherited;
  FRecordNo := 0;
end;

procedure TVirtualDataSetData.InternalOpen(DisableInitFields: boolean);
begin
  InitFields;

  inherited;

  FEOF := RecordCount = 0;
end;

procedure TVirtualDataSetData.CreateFieldDescs;

  procedure AddFieldDesc(const FieldName: string; const FieldType: TFieldType;
    const FieldSize: integer; const Precision: integer; const Scale: integer;
    const Required: boolean; const Fixed: boolean);
  var
    Field: TFieldDesc;
  begin
    Field := CreateFieldDesc;
    try
      Field.FieldNo := FFields.Count + 1;
      Field.Name := FieldName;
      Field.DataType := TFieldTypeMap.GetDataType(FieldType);

      case FieldType of
        ftString: begin
          Field.Size := FieldSize + 1;
          Field.Length := FieldSize;
        end;
        ftWideString: begin
          Field.Size := (FieldSize + 1) * sizeof(WideChar);
          Field.Length := FieldSize;
        end;
        ftSmallint{$IFDEF VER12P}, ftShortInt{$ENDIF}:
          if (Precision <= 4) and (Precision <> 0) then begin
            Field.DataType := dtInt8;
            Field.Size := sizeof(SmallInt);
            Field.Length := Precision;
          end
          else
            Field.Size := sizeof(SmallInt);
      {$IFDEF VER12P}
        ftByte:
          Field.Size := sizeof(SmallInt);
      {$ENDIF}
        ftInteger, ftAutoInc:
          Field.Size := sizeof(Integer);
        ftWord:
          Field.Size := sizeof(word);
        ftBoolean:
          Field.Size := sizeof(Wordbool);
        ftLargeint{$IFDEF VER12P}, ftLongWord{$ENDIF}:
          if (Precision <= 10) and (Precision <> 0) then begin
            Field.DataType := dtUInt32;
            Field.Size := sizeof(Integer);
            Field.Length := Precision;
          end
          else
            Field.Size := sizeof(Largeint);
        ftFloat: begin
          Field.Size := sizeof(Double);
          Field.Length := Precision;
        end;
      {$IFDEF VER14P}
        ftSingle: begin
          Field.Size := sizeof(Single);
          Field.Length := Precision;
        end;
      {$ENDIF}
      {$IFDEF VER12P}
        ftExtended: begin
          Field.Size := sizeof(Extended);
          Field.Length := Precision;
        end;
      {$ENDIF}
        ftCurrency:
          Field.Size := sizeof(Double);
        ftDate, ftTime, ftDateTime: begin
          Field.Size := sizeof(TDateTime);
          Field.Length := Precision;
        end;
      {$IFDEF VER6P}{$IFNDEF FPC}
        ftTimeStamp: begin
          Field.Size := sizeof(TSQLTimeStamp);
          Field.Length := Precision;
        end;
      {$ENDIF}{$ENDIF}
        ftBlob, ftMemo{$IFDEF VER10P}, ftWideMemo{$ENDIF}:
          Field.Size := sizeof(Pointer);
        ftGuid: begin
          Field.Size := FieldSize + 1;
          Field.Length := FieldSize;
        end;
        ftBCD: begin
          Field.Size := sizeof(Currency);
          Field.Scale := Scale;
          Field.Length := Precision;
        end;
      {$IFDEF VER6P}
        ftFmtBcd: begin
          if Precision < SizeOfTBcd then
            Field.Size := SizeOfTBcd
          else
            Field.Size := Precision + 1{'.'} + 1 {#0}; // To right notation of large NUMERIC values
          Field.Scale := Scale;
          Field.Length := Precision;
        end;
      {$ENDIF}
        ftBytes: begin
          Field.Size := FieldSize;
          Field.Length := FieldSize;
        end;
        ftVarbytes: begin
          Field.Size := sizeof(word) + FieldSize;
          Field.Length := FieldSize;
        end;
      {$IFDEF VER5P}
        ftVariant: begin
          Field.Size := sizeof(TVariantObject);
        end;
      {$ENDIF}
{    ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
    ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,
    ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,
    ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, ftVariant
 }
      else
        DatabaseError(SNotSupportFieldType);
      end;
      Field.Required := Required;
      Field.Fixed := Fixed;
      FFields.Add(Field);
    except
      Field.Free;
    end;
  end;

var
  i: integer;
  OwnerField: TField;
  OwnerFieldDef: TFieldDef;
  DataFieldCount: integer;
begin
  DataFieldCount := 0;
  for i := 0 to FOwner.FieldCount - 1 do
    if FOwner.Fields[i].FieldKind = fkData then
      Inc(DataFieldCount);

{$IFDEF VER20P}
  if (lcPersistent in  FOwner.Fields.LifeCycles) and
{$ELSE}
  if not FOwner.DefaultFields and
{$ENDIF}
     ((DataFieldCount > FOwner.FieldDefs.Count) {or (TVirtualDataSet(FOwner).FFieldDefsByField and not VTOldBehavior)}) 
  then
  // From fields
    for i := 0 to FOwner.FieldCount - 1 do begin
      if FOwner.Fields[i].FieldKind = fkData then begin
        OwnerField := FOwner.Fields[i];
        AddFieldDesc(OwnerField.FieldName, OwnerField.DataType, OwnerField.Size, 0, 0, False, False);
      end
    end
  else
  // From FieldDefs
    for i := 0 to FOwner.FieldDefs.Count - 1 do begin
      OwnerFieldDef := FOwner.FieldDefs[i];

      AddFieldDesc(OwnerFieldDef.Name, OwnerFieldDef.DataType, OwnerFieldDef.Size, OwnerFieldDef.Precision,
        OwnerFieldDef.Size, faRequired in OwnerFieldDef.Attributes, faFixed in OwnerFieldDef.Attributes);
    end
end;

function TVirtualDataSetData.GetRecordCount: Integer;
begin
  FOwner.DoGetRecordCount(Result);
end;

function TVirtualDataSetData.GetRecordNo: integer;
begin
  Result := FRecordNo;
end;

procedure TVirtualDataSetData.SetRecordNo(Value: integer);
begin
  FRecordNo := Value;
  if FRecordNo > 0 then
    FBOF := False
  else
    FBOF := True;
  if FRecordNo <= GetRecordCount then
    FEOF := False
  else
    FEOF := True;
end;

procedure TVirtualDataSetData.GetRecordField(RecBuf: IntPtr; Field: TFieldDesc);
var
  Value: Variant;
begin
  FOwner.DoGetFieldValue(Field, RecordNo, Value);
  PutFieldAsVariant(Field, RecBuf, Value, True);
end;

procedure TVirtualDataSetData.GetRecord(RecBuf: IntPtr);
var
  i: Integer;
begin
  if (not BOF ) and (not EOF) and (RecordNo > 0) and (RecordNo <= GetRecordCount) then
    for i := 0 to Fields.Count - 1 do
      GetRecordField(RecBuf, Fields[i]);
end;

procedure TVirtualDataSetData.GetNextRecord(RecBuf: IntPtr);
begin
  if not EOF then begin
    if BOF then
      FBOF := False;

    if RecordNo > 0 then
      RecordNo := RecordNo + 1
    else
      RecordNo := 1;

    if RecordNo > GetRecordCount then begin
      FEOF := True;
      RecordNo := GetRecordCount + 1;
    end
    else if RecBuf <> nil then
      GetRecord(RecBuf);
  end;
end;

procedure TVirtualDataSetData.GetPriorRecord(RecBuf: IntPtr);
begin
  if not BOF then begin
    if EOF then
      FEOF := False;

    if (RecordNo > 0) and (RecordNo < GetRecordCount + 1) then
      RecordNo := RecordNo - 1
    else
      RecordNo := GetRecordCount;

    if RecordNo < 1 then begin
      FBOF := True;
      RecordNo := 0;
    end
    else if RecBuf <> nil then
      GetRecord(RecBuf);
  end;
end;

procedure TVirtualDataSetData.PutRecord(RecBuf: IntPtr);
begin
  // Empty
end;

procedure TVirtualDataSetData.SetToBegin;
begin
  RecordNo := 0; //FirstItem;
  FBOF := True;
  if GetRecordCount > 1 then
    FEOF := False;
end;

procedure TVirtualDataSetData.SetToEnd;
begin
  RecordNo := 0; //LastItem;
  FEOF := True;
  if GetRecordCount > 0 then
    FBOF := False;
end;

procedure TVirtualDataSetData.AppendRecord(RecBuf: IntPtr);
begin
  SetToEnd;
  InternalAppend(RecBuf);
end;

procedure TVirtualDataSetData.InsertRecord(RecBuf: IntPtr);
begin
  InternalAppend(RecBuf);
end;

procedure TVirtualDataSetData.UpdateRecord(RecBuf: IntPtr);
begin
  Assert((RecordNo > 0) and (RecordNo <= GetRecordCount));

  InternalUpdate(RecBuf)
end;

procedure TVirtualDataSetData.DeleteRecord;
begin
  Assert((RecordNo > 0) and (RecordNo <= GetRecordCount));

  InternalDelete;

  if RecordNo > GetRecordCount then
    RecordNo := GetRecordCount;
end;

{ TVirtualDataSetUpdater }

function TVirtualDataSetUpdater.DataSet: TCustomVirtualDataSet;
begin
  Result := TCustomVirtualDataSet(FDataSet);
end;

function TVirtualDataSetUpdater.PerformAppend: boolean;
begin
  DataSet.PerformInsertRecord;
  Result := True;
end;

function TVirtualDataSetUpdater.PerformUpdate: boolean;
begin
  DataSet.PerformEditRecord;
  Result := True;
end;

function TVirtualDataSetUpdater.PerformDelete: boolean;
begin
  DataSet.PerformDeleteRecord;
  Result := True;
end;

function TVirtualDataSetUpdater.PerformCancel: boolean;
begin
  DataSet.PerformCancelRecord;
  Result := True;
end;

{ TVirtualDataSetService }

function TVirtualDataSetService.Updater: TVirtualDataSetUpdater;
begin
  Result := TVirtualDataSetUpdater(FUpdater);
end;

procedure TVirtualDataSetService.CreateDataSetUpdater;
begin
  SetDataSetUpdater(TVirtualDataSetUpdater.Create(Self));
end;

{ TCustomVirtualDataSet }

constructor TCustomVirtualDataSet.Create(AOwner: TComponent);
begin
  inherited;

  CreateIRecordSet;
end;

destructor TCustomVirtualDataSet.Destroy;
begin

  inherited;
end;

function TCustomVirtualDataSet.DataSetService: TVirtualDataSetService;
begin
  Result := TVirtualDataSetService(FDataSetService);
end;

function TCustomVirtualDataSet.GetDataSetServiceClass: TDataSetServiceClass;
begin
  Result := TVirtualDataSetService;
end;

procedure TCustomVirtualDataSet.CreateIRecordSet;
begin
  SetIRecordSet(TVirtualDataSetData.Create);
end;

procedure TCustomVirtualDataSet.SetIRecordSet(Value: TData);
begin
  inherited;

  (Data as TVirtualDataSetData).FOwner := Self;
end;

procedure TCustomVirtualDataSet.InternalOpen;
begin
  inherited;

  FIsCursorOpen := True;
end;

procedure TCustomVirtualDataSet.InternalClose;
begin
  inherited;
  FIsCursorOpen := False;
end;

function TCustomVirtualDataSet.IsCursorOpen: boolean;
begin
  Result := FIsCursorOpen;
end;

procedure TCustomVirtualDataSet.InternalCancel;
begin
  inherited;

  DataSetService.Updater.PerformCancel;
end;

function TCustomVirtualDataSet.GetField(FieldDesc: TFieldDesc): TField;
var
  i: integer;
begin
  Assert(FieldDesc <> nil);
  Result := nil;
  for i := 0 to Fields.Count - 1 do
    if Fields[i].FieldNo = FieldDesc.FieldNo then begin
      Result := Fields[i];
      Break;
    end;
end;

procedure TCustomVirtualDataSet.PerformInsertRecord;
var
  RecordNo: Integer;
begin
  if TVirtualDataSetData(Data).RecordNo > 0 then
    RecordNo := TVirtualDataSetData(Data).RecordNo
  else
    RecordNo := TVirtualDataSetData(Data).GetRecordCount + 1;
  DoInsertRecord(RecordNo);
  TVirtualDataSetData(Data).RecordNo := RecordNo;
end;

procedure TCustomVirtualDataSet.PerformEditRecord;
var
  NewRecordNo: Integer;
begin
  NewRecordNo := TVirtualDataSetData(Data).RecordNo;
  DoEditRecord(NewRecordNo);
  TVirtualDataSetData(Data).RecordNo := NewRecordNo;
end;

procedure TCustomVirtualDataSet.PerformDeleteRecord;
begin
  DoDeleteRecord(TVirtualDataSetData(Data).RecordNo);
end;

procedure TCustomVirtualDataSet.PerformCancelRecord;
begin
  DoCancelRecord(TVirtualDataSetData(Data).RecordNo);
end;

{ TVirtualDataSet }

constructor TVirtualDataSet.Create(AOwner: TComponent);
begin
  inherited;

end;

destructor TVirtualDataSet.Destroy;
begin

  inherited;
end;

procedure TVirtualDataSet.DoGetRecordCount(var Count: Integer);
begin
  if Assigned(FOnGetRecordCount) then
    FOnGetRecordCount(self, Count)
  else
    raise Exception.Create('Error Message');
end;

procedure TVirtualDataSet.DoGetFieldValue(Field: TFieldDesc; RecNo: Integer; var Value: Variant);
begin
  if Assigned(FOnGetFieldValue) then begin
    Value := Unassigned;
    FOnGetFieldValue(Self, GetField(Field), RecNo, Value);
  end
  else
    raise Exception.Create('Error Message');
end;

procedure TVirtualDataSet.DoInsertRecord(var RecordNo: Integer);
begin
  if Assigned(FOnInsertRecord) then
    FOnInsertRecord(Self, RecordNo)
  else
    raise Exception.Create('Error Message');
end;

procedure TVirtualDataSet.DoEditRecord(var RecordNo: Integer);
begin
  if Assigned(FOnInsertRecord) then
    FOnEditRecord(Self, RecordNo)
  else
    raise Exception.Create('Error Message');
end;

procedure TVirtualDataSet.DoDeleteRecord(RecordNo: Integer);
begin
  if Assigned(FOnInsertRecord) then
    FOnDeleteRecord(Self, RecordNo)
  else
    raise Exception.Create('Error Message');
end;

procedure TVirtualDataSet.CreateFields;
begin
  inherited;
end;

end.
