fibdataset.pas

FIBPlus version 6-96. This is somewhat usefull interbase database components. TFIBDatabase, TFIBTab

    procedure InternalDoBeforeOpen; virtual;
    procedure DoBeforeOpen; override;
    procedure DoAfterOpen; override;
    procedure DoBeforeClose; override;
    procedure DoAfterClose; override;
    procedure DoBeforeCancel; override;
    procedure DoAfterCancel; override;
    procedure DoBeforeDelete; override;
    procedure DoBeforeEdit; override;
    procedure DoBeforeInsert; override;
    procedure DoBeforeScroll; override;
    procedure DoAfterScroll; override;
    procedure DoBeforePost; override;
    procedure DoAfterInsert; override;
    procedure DoAfterPost; override;
    procedure DoAfterDelete; override;
    procedure DoOnEndScroll(Sender:TObject);
    procedure DoOnPostError(DataSet:TDataSet; E:EDatabaseError; var Action:TDataAction); virtual;
    procedure FreeRecordBuffer(var Buffer:dbPChar); override; (* abstract *)
    procedure GetBookmarkData(Buffer:dbPChar; Data:Pointer); override; (* abstract *)
    function GetBookmarkFlag(Buffer:dbPChar):TBookmarkFlag; override; (* abstract *)
    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:dbPChar); override;
    procedure GetCalcFields(Buffer:dbPChar); override;
    function GetRecord(Buffer:dbPChar; 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:dbPChar); 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:dbPChar); override; (* abstract *)
    function IsCursorOpen:Boolean; override; (* abstract *)

    procedure SetBookmarkFlag(Buffer:dbPChar; Value:TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer:dbPChar; 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:PAnsiChar):boolean;
   procedure PackMemory(var FCache:PAnsiChar);
   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;
    procedure Loaded; 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:dbPChar):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:PAnsiChar; 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;