fibdataset.pas

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

    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;
    property OnEndScroll:TDataSetNotifyEvent read FOnEndScroll write SetOnEndScroll;
    property OnFillClientBlob:TOnFillClientBlob read FOnFillClientBlob write FOnFillClientBlob;
    property OnReadBlobField:TOnBlobFieldProcessing read FOnBlobFieldRead write FOnBlobFieldRead;
    property OnWriteBlobField:TOnBlobFieldProcessing read FOnBlobFieldWrite write FOnBlobFieldWrite;

  {$IFNDEF NO_GUI}
    property SQLScreenCursor:TCursor read FSQLScreenCursor write FSQLScreenCursor default crDefault;
  {$ENDIF}
    property SQLs:TSQLs read FSQLs write FSQLs stored False;
    property RefreshTransactionKind:TTransactionKind read FRefreshTransactionKind
     write SetRefreshTransactionKind default tkReadTransaction;

    property BeforeStartTransaction:TNotifyEvent read FBeforeStartTr write FBeforeStartTr;
    property AfterStartTransaction:TNotifyEvent read FAfterStartTr write FAfterStartTr;
    property BeforeEndTransaction:TEndTrEvent read FBeforeEndTr write FBeforeEndTr;
    property AfterEndTransaction:TEndTrEvent read FAfterEndTr write FAfterEndTr;

    property BeforeStartUpdateTransaction:TNotifyEvent read FBeforeStartUpdTr write FBeforeStartUpdTr;
    property AfterStartUpdateTransaction:TNotifyEvent read FAfterStartUpdTr write FAfterStartUpdTr;
    property BeforeEndUpdateTransaction:TEndTrEvent read FBeforeEndUpdTr write FBeforeEndUpdTr;
    property AfterEndUpdateTransaction:TEndTrEvent read FAfterEndUpdTr write FAfterEndUpdTr;

    property AllowedUpdateKinds:TUpdateKinds read FAllowedUpdateKinds write
      FAllowedUpdateKinds default [ukModify, ukInsert, ukDelete];
{$IFDEF CSMonitor}
    property CSMonitorSupport:TCSMonitorSupport read FCSMonitorSupport write SetCSMonitorSupport;
{$ENDIF}

  end;

  TFIBDataSet = class(TFIBCustomDataSet)
  private
    function DoStoreActive:boolean;
  public
    property Params;
    property Prepared;
    property QDelete;
    property QInsert;
    property QRefresh;
    property QSelect;
    property QUpdate;
    property StatementType;
    property UpdatesPending;
  public
    property Bof;
    property Bookmark;
    property Designer;
    property Eof;
    property FieldCount;
    property FieldDefs;
    property Fields;
    property FieldValues;
    property Modified;
    property RecordCount;
    property State;
    property BufferChunks;
  published
    property CachedUpdates;
    property UniDirectional;
    property UpdateRecordTypes;

    property UpdateSQL;
    property DeleteSQL;
    property InsertSQL;
    property RefreshSQL;
    property SelectSQL;
    property Filter;
    property FilterOptions;
    property CacheModelOptions;
    property DatabaseDisconnecting;
    property DatabaseDisconnected;
    property DatabaseFree;
    property OnUpdateError;
    property OnUpdateRecord;
    property AfterUpdateRecord;
    property TransactionEnding;
    property TransactionEnded;
    property TransactionFree;
    property AutoUpdateOptions;

    property Conditions;
  published
    (*
     * Published out of TDataset
     *)

    property Active stored DoStoreActive;
    property AutoCalcFields;
// property DataSource read GetDataSource write SetDataSource;
    property AfterCancel;
    property AfterClose;
    property AfterDelete;
    property AfterEdit;
    property AfterInsert;
    property AfterOpen;
    property AfterPost;
    property AfterScroll;
    property BeforeCancel;
    property BeforeClose;
    property BeforeDelete;
    property BeforeEdit;
    property BeforeInsert;
    property BeforeOpen;
    property BeforePost;
    property BeforeScroll;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnNewRecord;
    property OnPostError;

    property BeforeRefresh;
    property AfterRefresh;
{TFIBCustomDataSet}
    property AllowedUpdateKinds;
    property Transaction;
    property Database;
    property BeforeFetchRecord;
    property AfterFetchRecord;
    property OnGetRecordError;
    property Options;
    property DetailConditions;

    property UpdateTransaction;
    property PrepareOptions;
    property FieldOriginRule;
    property AutoCommit;
    property OnFieldChange;
    property OnEnableControls;
    property OnDisableControls;
    property OnEndScroll;
    property OnFillClientBlob;
 {$IFNDEF NO_GUI}
    property SQLScreenCursor;
 {$ENDIF}
    property SQLs;
    property RefreshTransactionKind;

    property BeforeStartTransaction;
    property AfterStartTransaction;
    property BeforeEndTransaction;
    property AfterEndTransaction;

    property BeforeStartUpdateTransaction;
    property AfterStartUpdateTransaction;
    property BeforeEndUpdateTransaction;
    property AfterEndUpdateTransaction;
    property DataSource read GetDataSource write SetDataSource;
{$IFDEF CSMonitor}
    property CSMonitorSupport;
{$ENDIF}

  end;

  (* TFIBDSBlobStream *)
  TFIBDSBlobStream = class(TStream)
  protected
    FBlobDataArray:PBlobDataArray;
    FBlobID:TISC_QUAD;
    FModified:boolean;
    FField:TField;
    FBlobStream:TFIBBlobStream;
    FOnBlobFieldRead:TOnBlobFieldProcessing;
    procedure DoCallBack(BlobSize:integer; BytesProcessing:integer; var Stop:boolean);
  public
    constructor Create(AField:TField; ABlobStream:TFIBBlobStream;
      Mode:TBlobStreamMode; ABlobID:TISC_QUAD;aBlobDataArray:PBlobDataArray);
    destructor Destroy; override;
    function Read(var Buffer; Count:Longint):Longint; override;
    function Seek(Offset:Longint; Origin:Word):Longint; override;
    procedure SetSize(NewSize:Longint); override;
    function Write(const Buffer; Count:Longint):Longint; override;
  end;

(*
 * Support routines
 *)
function RecordDataLength(n:Integer):Long;
function IsDBKeyField(Field:TObject):boolean;
function LocateOptionsToExtLocateOptions(LocateOptions:TLocateOptions):TExtLocateOptions;

type
  TFIBFilterType = (ftByField, ftCopy);

procedure FilterOut(FromDS:TFIBCustomDataSet);
(* Clear the entire record cache, and do everything short of
   closing the data set--but don't delete anything, etc.. *)

procedure Sort(DataSet:TFIBCustomDataSet; aFields:array of const;
  Ordering:array of Boolean);

(*
 * More constants
 *)
const
  DefaultFieldClasses:array[ftUnknown..ftTypedBinary] of TFieldClass = (
    nil, (* ftUnknown *)
    TFIBStringField, (* ftString *)
    TFIBSmallIntField, (* ftSmallint *)
    TFIBIntegerField, (* ftInteger *)
    TWordField, (* ftWord *)
    TFIBBooleanField, (* ftBoolean *)
    TFIBFloatField, (* ftFloat *)
    TCurrencyField, (* ftCurrency *)
    TFIBBCDField, (* ftBCD *)

    TFIBDateField, (* ftDate *)
    TFIBTimeField, (* ftTime *)
    TFIBDateTimeField, (* ftDateTime *)
  {$IFDEF SUPPORT_ARRAY_FIELD}
    TFIBArrayField,
  {$ELSE}
    TBytesField, (* ftBytes *)
  {$ENDIF}
    TVarBytesField, (* ftVarBytes *)
    TAutoIncField, (* ftAutoInc *)

    TFIBBlobField, (* ftBlob *)
    TFIBMemoField, (* ftMemo *)
    TGraphicField, (* ftGraphic *)

    TFIBBlobField, (* ftFmtMemo *)
    TFIBBlobField, (* ftParadoxOle *)
    TFIBBlobField, (* ftDBaseOle *)
    TFIBBlobField (* ftTypedBinary *)
   );

{$IFDEF LINUX}
const
  FILE_BEGIN = 0;
  FILE_CURRENT = 1;
  FILE_END = 2;
{$ENDIF}
const
  SNoAction = 'No Action';

procedure Register;

implementation
 uses StrUtil,FIBConsts,pFIBDataInfo,VariantRtn,IB_ErrorCodes,pFIBCacheQueries,DSContainer;

const
      DiffSizesRecData=SizeOf(TRecordData)-SizeOf(TSavedRecordData);
      LocateParamPrefix='LOCATE_';

procedure Register;
begin
  RegisterClass(TFIBStringField);
  RegisterClass(TFIBIntegerField);
  RegisterClass(TFIBSmallIntField);
  RegisterClass(TFIBFloatField);
  RegisterClass(TFIBBCDField);
  RegisterClass(TFIBBooleanField);

  {$IFDEF SUPPORT_ARRAY_FIELD}
   RegisterClass(TFIBArrayField);
  {$ENDIF}
   RegisterClass(TFIBLargeIntField);
   RegisterClass(TFIBGuidField);
   RegisterClass(TFIBDateField);
   RegisterClass(TFIBTimeField);
   RegisterClass(TFIBDateTimeField);
   RegisterClass(TFIBBlobField);
   RegisterClass(TFIBWideStringField);
   RegisterClass(TFIBMemoField);
end;

function IsDBKeyField(Field:TObject):boolean;
begin
   Result:=((Field is TFIBStringField) and(TFIBStringField(Field).IsDBKey))
    or
    ((Field is TFieldDef) and (TFieldDef(Field).DataType=ftString)
     and
      (TFieldDef(Field).Name='DB_KEY')
    )
end;

(*
 * TFIBStringField-implementation
 *)

constructor TFIBStringField.Create(AOwner:TComponent);
begin
   inherited;
   FSqlSubType:=-1;
   FDefaultValueEmptyString:=False;
end;

destructor TFIBStringField.Destroy;
begin
 if Assigned(FReservedBuffer) then
  FreeMem(FReservedBuffer);
 inherited;
end;

class procedure TFIBStringField.CheckTypeSize(Value:Integer);
begin
  (*
   * Just don't check. Any Ansistring size is valid.
   *)
end;

procedure TFIBStringField.SetDataSet(ADataSet:TDataSet);
begin
  inherited SetDataSet(ADataSet);
  if Assigned(ADataSet) and (ADataSet is TFIBCustomDataSet) then
  begin
    FEmptyStrToNull:=
     psSetEmptyStrToNull in TFIBCustomDataSet(ADataSet).FPrepareOptions;
  end;
end;

function TFIBStringField.GetAsDB_KEY:string;
var
  i:Integer;
  p:Pointer;
begin
  if Dataset.IsEmpty then
  begin
    Result:=''; Exit;
  end;
  if not Assigned(FReservedBuffer) then
  begin
     GetMem(FReservedBuffer, Size+1);
     FReservedBuffer[Size]:=#0;
  end;
  if not GetData(FReservedBuffer) then
     Result:=''
  else
  for i:= 0 to (Size div 4)-1 do
  begin
      p:= Pointer(Integer(FReservedBuffer)+i * 4);
      Result:= Result+Format('%-8.8x', [Integer(p^)]);
  end;
end;

function TFIBStringField.IsDBKey:boolean;
begin
  with TFIBDataSet(DataSet) do
  if (FieldKind=fkData) and Assigned(vFieldDescrList) and (vFieldDescrList.Capacity>0) then
  begin
   Result:=vFieldDescrList[FieldNo-1]^.fdIsDBKey;
  end
  else
   Result:=False;
end;

function TFIBStringField.SqlSubType:integer;
var
 F:TFIBXSQLVAR;
begin
 Result:=-1;
 if FieldKind<>fkData then
  Exit;
 if FSqlSubType=-1 then
 begin
   with TFibDataSet(DataSet),TFibDataSet(DataSet).QSelect do
   begin
    F:=QSelect[Self.FieldName];
   end;
   if F<>nil then
   begin
     FSqlSubType:=F.SQLSubtype;