fibdataset.pas

FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter

    function GetCanModify: Boolean; override;
    function GetDataSource: TDataSource; override;
    function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
    function GetRecNo: Integer; override;
    function GetRealRecNo: Integer;
    procedure TryDesignPrepare;
   protected
    procedure PrepareQuery(KindQuery: TpSQLKind);
    procedure PrepareBookMarkSize;
    procedure ClearCalcFields(Buffer: PChar); override;
    procedure GetCalcFields(Buffer: PChar); override;
    function GetRecord(Buffer: PChar; GetMode: TGetMode;
      DoCheck: Boolean): TGetResult; override; (* abstract *)
    function GetRecordCount: Integer; override;
    function GetRecordSize: Word; override; (* abstract *)

    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override; (* abstract *)
    procedure InternalCancel; override;
    procedure InternalClose; override; (* abstract *)
    procedure CloseCursor; override;
    procedure InternalDelete; override; (* abstract *)
    procedure InternalFirst; override; (* abstract *)
    procedure InternalGotoBookmark(Bookmark: Pointer); override; (* abstract *)
    procedure InternalHandleException; override; (* abstract *)
    procedure InternalInitFieldDefs; override; (* abstract *)
    procedure InternalInitRecord(Buffer: PChar); override; (* abstract *)
    procedure InternalLast; override; (* abstract *)
    procedure InternalOpen; override; (* abstract *)
    procedure InternalPost; override; (* abstract *)
    procedure DoInternalRefresh(Qry: TFIBQuery; Buff:Pointer;ForceFullRefresh:boolean); virtual;
    procedure InternalRefresh; override;
    procedure InternalSetToRecord(Buffer: PChar); override; (* abstract *)
    function  IsCursorOpen: Boolean; override; (* abstract *)
    
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; (* abstract *)
    procedure SetCachedUpdates(Value: Boolean);
    procedure SetDataSource(Value: TDataSource);
    procedure SetOptions(Value:TpFIBDsOptions);
    procedure SetFieldData(Field: TField; Buffer: Pointer); override; (* abstract *)

    procedure SetRealRecNo(Value: Integer;ToCenter:boolean =False);
    procedure SetRecNo(Value: Integer); override;
    function  MasterFieldsChanged :boolean; virtual;
    procedure SetParamsFromMaster ;
    procedure ForceEndWaitMaster;

// Filter works
    procedure SetFiltered(Value: Boolean); override;
    procedure ExprParserCreate(const Text: string; Options: TFilterOptions);
    procedure SetFilterData(const Text: string; Options: TFilterOptions);
    procedure SetFilterOptions(Value: TFilterOptions); override;
    procedure SetFilterText(const Value: string); override;
//

  protected
   FIsClientSorting:boolean;

   FBeforeFetchRecord: TOnFetchRecord;
   FAfterFetchRecord : TOnFetchRecord;
   FRelationTables : TStringList;
   FCountUpdatesPending:integer;
  {$IFNDEF NO_GUI}
   FSQLScreenCursor    :TCursor;
  {$ENDIF}
   FSQLs               :TSQLs;
   procedure SetBeforeFetchRecord(Value:TOnFetchRecord);
   function  IsValidBuffer(FCache: PChar):boolean;
   procedure PackMemory(var FCache: PChar);
   function  GetAllFetched:boolean;
   procedure OpenByTimer(Sender:TObject);
   procedure DoCloseOpen(Sender:TObject);
   function  GetWaitEndMasterScroll:boolean;
   procedure SetWaitEndMasterScroll(Value:boolean);
   function  GetDetailConditions:TDetailConditions;
   procedure SetDetailConditions(Value:TDetailConditions);

   function  IsSorted :boolean;
   procedure DoOnSelectFetch(RecordNumber:integer;   var StopFetching:boolean);
   procedure PrepareAdditionalInfo;
   procedure RefreshMasterDS;
   procedure AutoStartUpdateTransaction;
   procedure AutoCommitUpdateTransaction;
    (*
     * Properties that are protected in TFIBCustomDataSet, but should be,
     * at some level, made visible. These are good candidates for
     * being made *public*.

     *)


    property Params: TFIBXSQLDA read GetParams;
    property Prepared: Boolean read FPrepared;
    property QDelete: TFIBQuery read FQDelete;
    property QInsert: TFIBQuery read FQInsert;
    property QRefresh: TFIBQuery read FQRefresh;
    property QSelect: TFIBQuery read FQSelect;
    property QUpdate: TFIBQuery read FQUpdate;
    property StatementType: TFIBSQLTypes read GetStatementType;
    property UpdatesPending: Boolean read FUpdatesPending;

    property BufferChunks: Integer read GetBufferChunks write SetBufferChunks;

    property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates default False;
    property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
    property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
    property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
    property SelectSQL: TStrings read GetSelectSQL write SetSelectSQL;
    property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
    property UpdateRecordTypes: TFIBUpdateRecordTypes read FUpdateRecordTypes
         write SetUpdateRecordTypes default [cusUnmodified, cusModified, cusInserted];
    property UpdateSQL: TStrings read GetUpdateSQL write SetUpdateSQL;
    (* -- Events *)
    property DatabaseDisconnecting: TNotifyEvent read FDatabaseDisconnecting
                                                 write FDatabaseDisconnecting;
    property DatabaseDisconnected: TNotifyEvent read FDatabaseDisconnected
                                                write FDatabaseDisconnected;
    property DatabaseFree: TNotifyEvent read FDatabaseFree
                                        write FDatabaseFree;
    property OnUpdateError: TFIBUpdateErrorEvent read FOnUpdateError
                                                 write FOnUpdateError;
    property OnUpdateRecord: TFIBUpdateRecordEvent read FOnUpdateRecord
                                                   write FOnUpdateRecord;
    property AfterUpdateRecord: TFIBAfterUpdateRecordEvent read FAfterUpdateRecord
     write FAfterUpdateRecord
    ;
    property TransactionEnding: TNotifyEvent read FTransactionEnding
                                             write FTransactionEnding;
    property TransactionEnded: TNotifyEvent read FTransactionEnded
                                            write FTransactionEnded;
    property TransactionFree: TNotifyEvent read FTransactionFree
                                           write FTransactionFree;
    property DisableCOCount:integer read FDisableCOCount;
    property CacheModelOptions:TCacheModelOptions  read FCacheModelOptions write SetCacheModelOptions;
 private


    function  GetConditions:TConditions;
    procedure SetConditions(Value:TConditions);
    function  GetOrderString:string;
    procedure SetOrderString(const OrderTxt:string);
    function  GetFieldsString:string;
    procedure SetFieldsString(const Value:string);

 public
    function FN(const FieldName: string): TField; //FindField
    function FBN(const FieldName: string): TField; //FieldByName
    procedure SwapRecords(Recno1,Recno2:integer);
    function  GetCacheSize:integer;
    procedure ApplyConditions(Reopen :boolean = False);
    procedure CancelConditions;

    property  OrderClause:string read GetOrderString write SetOrderString;
    property  FieldsClause:string read GetFieldsString write SetFieldsString;
    property  GroupByClause:string read GetGroupByString  write SetGroupByString;
    property  MainWhereClause:string read GetMainWhereClause write SetMainWhereClause;
    property  PlanClause:string read GetPlanClause write SetPlanClause;

    property  Conditions:TConditions read GetConditions write SetConditions;
 public
    (* public declarations *)

    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    property AutoUpdateOptions: TAutoUpdateOptions read FAutoUpdateOptions write
      FAutoUpdateOptions;

 private
    vLockResync    :Integer;
    function  NeedMoveRecordToOrderPos:boolean;
    procedure MoveRecordToOrderPos;
    procedure CreateDetailTimer;
    procedure CreateScrollTimer;
 protected
    procedure ChangeScreenCursor(var OldCursor:integer);
    procedure RestoreScreenCursor(const OldCursor:integer);
 public
    property  RunState:TDataSetRunState read FRunState;
    procedure Resync(Mode: TResyncMode); override;
    function  BookmarkValid(Bookmark: TBookmark): Boolean; override;
    procedure Post; override;
    function  SetRecordPosInBuffer(NewPos:integer):integer;

    procedure CloseOpen(const DoFetchAll:boolean);
    procedure StartTransaction;
    procedure BatchInput(InputObject: TFIBBatchInputStream;SQLKind:TpSQLKind =skInsert);
    procedure BatchOutput(OutputObject: TFIBBatchOutputStream);
    function  CachedUpdateStatus: TCachedUpdateStatus;
    procedure CancelUpdates;virtual;
    procedure CheckDatasetClosed(const Reason:string);
    procedure CheckDatasetOpen(const Reason:string);
    procedure CheckNotUniDirectional;
    procedure FetchAll;
    procedure Prepare; virtual;
    procedure UnPrepare;
    procedure RecordModified(Value: Boolean);


    procedure RevertRecord;
    procedure Undelete;
    procedure DisableScrollEvents;
    procedure EnableScrollEvents;
    procedure DisableCloseOpenEvents;
    procedure EnableCloseOpenEvents;

    procedure DisableCalcFields;
    procedure EnableCalcFields;


{$IFDEF SUPPORT_ARRAY_FIELD}
    function  ArrayFieldValue(Field:TField):Variant;
    procedure SetArrayValue(Field:TField;Value:Variant);
    function  GetElementFromValue( Field:TField;
               Indexes:array of integer):Variant;

    procedure SetArrayElementValue(Field:TField;Value:Variant;
     Indexes:array of integer
    );
{$ENDIF}
    function  GetRelationTableName(Field:TObject):string;
    function  GetRelationFieldName(Field:TObject):string;


    procedure MoveRecord(OldRecno,NewRecno:integer); virtual;


    procedure DoSortEx(Fields: array of integer; Ordering: array of Boolean); overload;
    procedure DoSortEx(Fields: TStrings; Ordering: array of Boolean); overload;

    procedure DoSort(Fields: array of const; Ordering: array of Boolean); virtual;

    function  CreateCalcField(FieldClass:TFieldClass; const aName,aFieldName:string;aSize:integer):TField;
    function  CreateLookUpField(FieldClass:TFieldClass; const aName,aFieldName:string;aSize:integer;
     aLookupDataSet: TDataSet; const aKeyFields, aLookupKeyFields, aLookupResultField: string
    ):TField;
    function  GetFieldOrigin(Fld:TField):string;
    function  FieldByOrigin(const aOrigin:string):TField; overload;
    function  FieldByOrigin(const TableName,FieldName:string):TField; overload;
    function  FieldByRelName(const FName:string):TField;
    function  ReadySelectText:string;
    function  TableAliasForField(const aFieldName:string):string;
    function  SQLFieldName(const aFieldName:string):string;
    procedure RestoreMacroDefaultValues;

    function  IsComputedField(Fld:Variant):boolean;
    function  DomainForField(Fld:Variant):string;
// Sort Info     
    function  SortInfoIsValid:boolean;
    function  IsSortedField(Field:TField; var FieldSortOrder:TSortFieldInfo):boolean;
    function  SortFieldsCount:integer;
    function  SortFieldInfo(OrderIndex:integer):TSortFieldInfo;
    function  SortedFields:string;
    property  SortFields:Variant read FSortFields;
    property  Sorted:boolean read IsSorted;
    property  RelationTables : TStringList read FRelationTables;
    property  CachedActive   :boolean read FCachedActive;
  public
    (* public routines overridden from TDataSet *)
    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
    function BlobModified(Field: TField): boolean;
    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
    function GetRecordFieldInfo(Field: TField;
      var TableName,FieldName:string; var RecordKeyValues:TDynArray
    ):boolean;

    function GetCurrentRecord(Buffer: PChar): Boolean; override;
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override; (* abstract *)
    procedure DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean); override;
    function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; override;

 
    function  RecordFieldValue(Field:TField;RecNumber:integer):Variant; overload;
    function  RecordFieldValue(Field:TField;aBookmark:TBookmark):Variant; overload;

    function ExtLocate(const KeyFields: String; const KeyValues: Variant;
      Options: TExtLocateOptions): Boolean;

    function Locate(const KeyFields: String; const KeyValues: Variant;
      Options: TLocateOptions): Boolean; override;

    function LocatePrior(const KeyFields: String; const KeyValues: Variant;
      Options: TLocateOptions): Boolean; // Sister function to Locate

    function LocateNext(const KeyFields: String; const KeyValues: Variant;
      Options: TLocateOptions): Boolean; // Sister function to Locate
    function ExtLocateNext(const KeyFields: String; const KeyValues: Variant;
      Options: TExtLocateOptions): Boolean; // Sister function to ExtLocate

    function ExtLocatePrior(const KeyFields: String; const KeyValues: Variant;
      Options: TExtLocateOptions): Boolean; // Sister function to ExtLocate

    procedure RefreshFilters;

    function Lookup(const KeyFields: string; const KeyValues: Variant;
      const ResultFields: string): Variant; override;
    function Translate(Src, Dest: PChar; ToOem: Boolean): Integer; override;
    function UpdateStatus: TUpdateStatus; override;
    function IsSequenced: Boolean; override;        // Scroll bar
    property  DefaultFields:boolean read GetDefaultFields ;
  public
{$IFDEF CSMonitor}
    procedure SetCSMonitorSupportToQ;
{$ENDIF}    
    procedure CacheDelete;
    procedure CacheOpen;
    procedure RefreshClientFields(ForceCalc:boolean=True);
    function  CreateCalcFieldAs(Field:TField):TField;
    procedure CopyFieldsStructure(Source:TFIBCustomDataSet;RecreateFields:boolean);
    procedure CopyFieldsProperties(Source,Destination:TFIBCustomDataSet);
    procedure AssignProperties(Source:TFIBCustomDataSet);

    procedure OpenAsClone(DataSet:TFIBCustomDataSet);
    procedure Clone(DataSet:TFIBCustomDataSet; RecreateFields:boolean);
    function  CanCloneFromDataSet(DataSet:TFIBCustomDataSet):boolean;



    function  PrimaryKeyFields(const TableName: string): string;
    function  FetchNext(FetchCount:Dword):integer;
    procedure ReopenLocate(const LocateFieldNames:string);
    function  AllFieldValues:variant;
  protected
    procedure InternalFullRefresh(NeedResync:boolean = True;ReopenRefreshSQL:boolean=True);
  public
    procedure FullRefresh;
  private
    FMasSourceDisableCount:integer;
  public
    procedure DisableMasterSource;
    procedure EnableMasterSource;
    function  MasterSourceDisabled:boolean;

    property  CacheSize:integer read GetCacheSize;
    (* Public properties *)
    property  DBHandle: PISC_DB_HANDLE read GetDBHandle;
    property  TRHandle: PISC_TR_HANDLE read GetTRHandle;
    property  AllFetched:boolean read GetAllFetched;
    property  WaitEndMasterInterval:integer read FWaitEndMasterInterval
     write FWaitEndMasterInterval;
    property WaitEndMasterScroll:boolean read GetWaitEndMasterScroll write
     SetWaitEndMasterScroll;
    property CountUpdatesPending: integer read FCountUpdatesPending;
  public
{  ISQLObject }
   function  ParamCount:integer;
   function  ParamName(ParamIndex:integer):string;
   function  FieldsCount:integer;
   function  FieldName(FieldIndex:integer):string;
   function  FieldExist(const FieldName:string; var FieldIndex:integer):boolean;
   function  ParamExist(const ParamName:string; var ParamIndex:integer):boolean;
   function  FieldValue(const FieldName:string; Old:boolean):variant;   overload;
   function  FieldValue(const FieldIndex:integer;Old:boolean):variant; overload;
   function  ParamValue(const ParamName:string):variant;   overload;
   function  ParamValue(const ParamIndex:integer):variant; overload;
   procedure SetParamValue(const ParamIndex:integer; aValue:Variant);
   function  IEof:boolean;
   procedure INext;


{END  ISQLObject }

  public
    (*
     * Published properties implemented in TFIBCustomDataSet
     *)
    (* -- Properties *)

    property Transaction: TFIBTransaction read GetTransaction
                                             write SetTransaction;
    property Database: TFIBDatabase read GetDatabase write SetDatabase;
    property BeforeFetchRecord: TOnFetchRecord read FBeforeFetchRecord
     write SetBeforeFetchRecord;
    property AfterFetchRecord : TOnFetchRecord read FAfterFetchRecord
     write FAfterFetchRecord;
    property OnGetRecordError:TDataSetErrorEvent
     read FOnGetRecordError write FOnGetRecordError;
    property Options:TpFIBDsOptions read FOptions write SetOptions
    {$IFDEF DFM_VERSION1}
    default
     [poTrimCharFields,poStartTransaction,poAutoFormatFields,poRefreshAfterPost];
    {$ELSE}
     stored False;
    {$ENDIF}

    property FieldOriginRule:TFieldOriginRule read FFieldOriginRule write FFieldOriginRule default forTableAndFieldName;

    property DetailConditions:TDetailConditions read
     GetDetailConditions write SetDetailConditions
    stored False;

    property  UpdateTransaction:TFIBTransaction read GetUpdateTransaction
     write   SetUpdateTransaction stored StoreUpdTransaction;
    property  PrepareOptions:TpPrepareOptions read FPrepareOptions
              write SetPrepareOptions  stored False;
    property AutoCommit:boolean read FAutoCommit write FAutoCommit default False;
    property OnFieldChange:TFieldNotifyEvent read FOnFieldChange write FOnFieldChange;
    property OnEnableControls:TDataSetNotifyEvent read FOnEnableControls write FOnEnableControls;
    property OnDisableControls:TDataSetNotifyEvent read FOnDisableControls write FOnDisableControls;