PageRenderTime 35ms CodeModel.GetById 16ms app.highlight 9ms RepoModel.GetById 1ms app.codeStats 1ms

/Gedemin/IBX/IBCustomDataSet.2

http://gedemin.googlecode.com/
Unknown | 2046 lines | 1871 code | 175 blank | 0 comment | 0 complexity | 8c120e0ae32d5e12e473126c5ffc711c MD5 | raw file

Large files files are truncated, but you can click here to view the full file

   1{************************************************************************}
   2{                                                                        }
   3{       Borland Delphi Visual Component Library                          }
   4{       InterBase Express core components                                }
   5{                                                                        }
   6{       Copyright (c) 1998-2001 Borland Software Corporation             }
   7{                                                                        }
   8{    InterBase Express is based in part on the product                   }
   9{    Free IB Components, written by Gregory H. Deatz for                 }
  10{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
  11{    Free IB Components is used under license.                           }
  12{                                                                        }
  13{    The contents of this file are subject to the InterBase              }
  14{    Public License Version 1.0 (the "License"); you may not             }
  15{    use this file except in compliance with the License. You may obtain }
  16{    a copy of the License at http://www.borland.com/interbase/IPL.html  }
  17{    Software distributed under the License is distributed on            }
  18{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
  19{    express or implied. See the License for the specific language       }
  20{    governing rights and limitations under the License.                 }
  21{    The Original Code was created by InterBase Software Corporation     }
  22{       and its successors.                                              }
  23{    Portions created by Borland Software Corporation are Copyright      }
  24{       (C) Borland Software Corporation. All Rights Reserved.           }
  25{    Contributor(s): Jeff Overcash                                       }
  26{                                                                        }
  27{************************************************************************}
  28
  29unit IBCustomDataSet;
  30
  31interface
  32
  33// ?????????? ???? ??????, ????? ??????? ?????? ???????????
  34// ? ?????? ???????????, ? ?? ? ?????? ??????
  35{_$_DEFINE HEAP_STRING_FIELD}
  36
  37uses
  38  Windows, SysUtils, Classes, Controls, IBExternals, IB, IBHeader, StdVcl,
  39  IBDatabase, IBSQL, Db, IBUtils, IBBlob
  40  //!!!b
  41  , DBGrids
  42  //!!!e
  43  ;
  44
  45const
  46  BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
  47  UniCache           =  2;     { Uni-directional cache is 2 records big }
  48
  49type
  50  TIBCustomDataSet = class;
  51  TIBDataSet = class;
  52
  53  //!!!b
  54  //////////////////////////////////////////////////////////
  55  // ????????? -- ????????, ??????????? ?? ?????? ???????
  56  //
  57  TgdcAggregate = class;
  58  TgdcAggregates = class;
  59  TgdcAggUpdateEvent = procedure(Agg: TgdcAggregate) of object;
  60
  61  TgdcAggregate = class(TCollectionItem)
  62  private
  63    FVisible: Boolean;
  64    FActive: Boolean;
  65    FInUse: Boolean;
  66    FDataSize: Integer;
  67    FIndexName: String;
  68    FAggregateName: String;
  69    FExpression: String;
  70    FDataType: TFieldType;
  71    FOnUpdate: TgdcAggUpdateEvent;
  72    FDataSet: TIBCustomDataSet;
  73    FValue: Variant;
  74
  75    procedure SetActive(const Value: Boolean);
  76    procedure SetExpression(const Value: String);
  77    procedure SetIndexName(const Value: String);
  78    procedure SetVisible(const Value: Boolean);
  79
  80  public
  81    constructor Create(AnAggregates: TgdcAggregates; ADataSet: TIBCustomDataSet); reintroduce;
  82
  83    function Value: Variant;
  84    function GetDisplayName: String; override;
  85    procedure SetValue(AValue: Variant);
  86
  87    property Active: Boolean read FActive write SetActive;
  88    property AggregateName: String read FAggregateName write FAggregateName;
  89    property DataSet: TIBCustomDataSet read FDataSet;
  90    property DataSize: Integer read FDataSize;
  91    property DataType: TFieldType read FDataType write FDataType;
  92    property Expression: String read FExpression write SetExpression;
  93    property IndexName: String read FIndexName write SetIndexName;
  94    property InUse: Boolean read FInUse;
  95    property OnUpdate: TgdcAggUpdateEvent read FOnUpdate write FOnUpdate;
  96    property Visible: Boolean read FVisible write SetVisible;
  97  end;
  98
  99  TgdcAggregates = class(TCollection)
 100  private
 101    FOwner: TPersistent;
 102
 103    function GetItem(Index: Integer): TgdcAggregate;
 104    procedure SetItem(Index: Integer; const Value: TgdcAggregate);
 105
 106  protected
 107    function GetOwner: TPersistent; override;
 108
 109  public
 110    constructor Create(Owner: TPersistent);
 111
 112    function Add: TgdcAggregate;
 113    procedure Clear;
 114    function Find(const DisplayName: string): TgdcAggregate;
 115    function IndexOf(const DisplayName: string): Integer;
 116    property Items[Index: Integer]: TgdcAggregate read GetItem write SetItem; default;
 117  end;
 118
 119
 120  //!!!e
 121
 122  TIBDataSetUpdateObject = class(TComponent)
 123  private
 124    FRefreshSQL: TStrings;
 125    procedure SetRefreshSQL(value: TStrings);
 126  protected
 127    function GetDataSet: TIBCustomDataSet; virtual; abstract;
 128    procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
 129    {
 130    procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
 131    function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
 132    }
 133    property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
 134  public
 135    constructor Create(AOwner: TComponent); override;
 136    destructor Destroy; override;
 137    //!!!!
 138    //?????????? Andreik
 139    procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
 140    function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
 141    //!!!!
 142  published
 143    property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
 144  end;
 145
 146  PDateTime = ^TDateTime;
 147  TBlobDataArray = array[0..0] of TIBBlobStream;
 148  PBlobDataArray = ^TBlobDataArray;
 149
 150  { TIBCustomDataSet }
 151  TFieldData = record
 152    fdDataType: Short;
 153    fdDataScale: Short;
 154    fdNullable: Boolean;
 155    fdIsNull: Boolean;
 156    fdDataSize: Short;
 157    fdDataLength: Short;
 158    fdDataOfs: Integer;
 159  end;
 160  PFieldData = ^TFieldData;
 161
 162  TCachedUpdateStatus = (
 163                         cusUnmodified, cusModified, cusInserted,
 164                         cusDeleted, cusUninserted
 165                        );
 166  TIBDBKey = record
 167    DBKey: array[0..7] of Byte;
 168  end;
 169  PIBDBKey = ^TIBDBKey;
 170
 171  TRecordData = record
 172    rdBookmarkFlag: TBookmarkFlag;
 173    rdFieldCount: Short;
 174    rdRecordNumber: Long;
 175    rdCachedUpdateStatus: TCachedUpdateStatus;
 176    rdUpdateStatus: TUpdateStatus;
 177    rdSavedOffset: DWORD;
 178    rdDBKey: TIBDBKey;
 179    rdFields: array[1..1] of TFieldData;
 180  end;
 181  PRecordData = ^TRecordData;
 182
 183  { TIBStringField allows us to have strings longer than 8196 }
 184
 185  TIBStringField = class(TStringField)
 186  public
 187    constructor create(AOwner: TComponent); override;
 188    class procedure CheckTypeSize(Value: Integer); override;
 189    function GetAsString: string; override;
 190    function GetAsVariant: Variant; override;
 191    function GetValue(var Value: string): Boolean;
 192    procedure SetAsString(const Value: string); override;
 193  end;
 194
 195  { TIBBCDField }
 196  {  Actually, there is no BCD involved in this type,
 197     instead it deals with currency types.
 198     In IB, this is an encapsulation of Numeric (x, y)
 199     where x < 18 and y <= 4.
 200     Note: y > 4 will default to Floats
 201  }
 202  TIBBCDField = class(TBCDField)
 203  protected
 204    class procedure CheckTypeSize(Value: Integer); override;
 205    function GetAsCurrency: Currency; override;
 206    function GetAsString: string; override;
 207    function GetAsVariant: Variant; override;
 208    function GetDataSize: Integer; override;
 209  public
 210    constructor Create(AOwner: TComponent); override;
 211  published
 212    property Size default 8;
 213  end;
 214
 215  TIBDataLink = class(TDetailDataLink)
 216  private
 217    FDataSet: TIBCustomDataSet;
 218  protected
 219    procedure ActiveChanged; override;
 220    procedure RecordChanged(Field: TField); override;
 221    function GetDetailDataSet: TDataSet; override;
 222    procedure CheckBrowseMode; override;
 223  public
 224    constructor Create(ADataSet: TIBCustomDataSet);
 225    destructor Destroy; override;
 226  end;
 227
 228  TIBGeneratorApplyEvent = (gamOnNewRecord, gamOnPost, gamOnServer);
 229
 230  TIBGeneratorField = class(TPersistent)
 231  private
 232    FField: string;
 233    FGenerator: string;
 234    FIncrementBy: Integer;
 235    DataSet: TIBCustomDataSet;
 236    
 237    FApplyEvent: TIBGeneratorApplyEvent;
 238    function  IsComplete: Boolean;
 239  public
 240    constructor Create(ADataSet: TIBCustomDataSet);
 241    function  ValueName: string;
 242    procedure Apply;
 243    procedure Assign(Source: TPersistent); override;
 244  published
 245    property Field : string read FField write FField;
 246    property Generator : string read FGenerator write FGenerator;
 247    property IncrementBy : Integer read FIncrementBy write FIncrementBy default 1;
 248    property ApplyEvent : TIBGeneratorApplyEvent read FApplyEvent write FApplyEvent default  gamOnNewRecord;
 249  end;
 250
 251  { TIBCustomDataSet }
 252  TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
 253
 254  TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
 255                                 UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
 256                                 of object;
 257  TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
 258                                   var UpdateAction: TIBUpdateAction) of object;
 259
 260  TIBUpdateRecordTypes = set of TCachedUpdateStatus;
 261
 262  TLiveMode = (lmInsert, lmModify, lmDelete, lmRefresh);
 263  TLiveModes = Set of TLiveMode;
 264
 265  TIBCustomDataSet = class(TDataset)
 266  private
 267    //FNeedsRefresh: Boolean;
 268    FForcedRefresh: Boolean;
 269    FIBLoaded: Boolean;
 270    FBase: TIBBase;
 271    //!!!b
 272    FAggregatesActive: Boolean;
 273    FAggregates: TgdcAggregates;
 274    FReadBase: TIBBase;
 275    FBeforeInternalPostRecord: TDataSetNotifyEvent;
 276    FAfterInternalPostRecord: TDataSetNotifyEvent;
 277    FBeforeInternalDeleteRecord: TDataSetNotifyEvent;
 278    FAfterInternalDeleteRecord: TDataSetNotifyEvent;
 279    //!!!e
 280    //FBlobCacheOffset: Integer;
 281    FBlobStreamList: TList;
 282    FBufferChunks: Integer;
 283    //FBufferCache,
 284    FOldBufferCache: PChar;
 285    FBufferChunkSize,
 286    FCacheSize,
 287    FOldCacheSize: Integer;
 288    //FFilterBuffer: PChar;
 289    FBPos,
 290    FOBPos,
 291    FBEnd,
 292    FOBEnd: DWord;
 293    FCachedUpdates: Boolean;
 294    FCalcFieldsOffset: Integer;
 295    FCurrentRecord: Long;
 296    FDeletedRecords: Long;
 297    //FModelBuffer,
 298    FOldBuffer: PChar;
 299    FOpen: Boolean;
 300    FInternalPrepared: Boolean;
 301    //FQDelete,
 302    FQInsert,
 303    FQRefresh,
 304    //FQSelect,
 305    FQModify: TIBSQL;
 306    FRecordBufferSize: Integer;
 307    //FRecordCount: Integer;
 308    FRecordSize: Integer;
 309    FUniDirectional: Boolean;
 310    FUpdateMode: TUpdateMode;
 311    //FUpdateObject: TIBDataSetUpdateObject;
 312    FParamCheck: Boolean;
 313    FUpdatesPending: Boolean;
 314    FUpdateRecordTypes: TIBUpdateRecordTypes;
 315    //FMappedFieldPosition: array of Integer;
 316    FDataLink: TIBDataLink;
 317    FStreamedActive : Boolean;
 318    FLiveMode: TLiveModes;
 319    FGeneratorField: TIBGeneratorField;
 320    //FRowsAffected: Integer;
 321
 322    FBeforeDatabaseDisconnect,
 323    FAfterDatabaseDisconnect,
 324    FDatabaseFree: TNotifyEvent;
 325    FOnUpdateError: TIBUpdateErrorEvent;
 326    FOnUpdateRecord: TIBUpdateRecordEvent;
 327    FBeforeTransactionEnd,
 328    FAfterTransactionEnd,
 329    FTransactionFree: TNotifyEvent;
 330    //!!!
 331    FReadTransactionSet: Boolean;
 332    FInsertedAt: Integer;
 333    FAllowStreamedActive: Boolean;
 334    FSavedRecordCount: Integer;
 335    //!!!
 336
 337    function GetSelectStmtHandle: TISC_STMT_HANDLE;
 338    procedure SetUpdateMode(const Value: TUpdateMode);
 339    procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
 340
 341    function AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode): TGetResult;
 342    procedure AdjustRecordOnInsert(Buffer: Pointer);
 343    function CanEdit: Boolean;
 344    function CanInsert: Boolean;
 345    function CanDelete: Boolean;
 346    //function CanRefresh: Boolean;
 347    procedure CheckEditState;
 348    procedure ClearBlobCache;
 349    //b!!!
 350    //procedure CopyRecordBuffer(Source, Dest: Pointer);
 351    //e!!!
 352    procedure DoBeforeDatabaseDisconnect(Sender: TObject);
 353    procedure DoAfterDatabaseDisconnect(Sender: TObject);
 354    procedure DoDatabaseFree(Sender: TObject);
 355    procedure DoBeforeTransactionEnd(Sender: TObject);
 356    //procedure DoAfterTransactionEnd(Sender: TObject);
 357    procedure DoTransactionFree(Sender: TObject);
 358    procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
 359                                         Buffer: PChar);
 360    function GetDatabase: TIBDatabase;
 361    function GetDBHandle: PISC_DB_HANDLE;
 362    function GetDeleteSQL: TStrings;
 363    function GetInsertSQL: TStrings;
 364    function GetSQLParams: TIBXSQLDA;
 365    function GetRefreshSQL: TStrings;
 366    function GetSelectSQL: TStrings;
 367    function GetStatementType: TIBSQLTypes;
 368    function GetModifySQL: TStrings;
 369    function GetTransaction: TIBTransaction;
 370    function GetTRHandle: PISC_TR_HANDLE;
 371    //procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
 372    function InternalLocate(const KeyFields: string; const KeyValues: Variant;
 373                            Options: TLocateOptions): Boolean;
 374    //procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
 375    procedure InternalRevertRecord(RecordNumber: Integer);
 376    function IsVisible(Buffer: PChar): Boolean;
 377    procedure SaveOldBuffer(Buffer: PChar);
 378    procedure SetBufferChunks(Value: Integer);
 379    procedure SetDatabase(Value: TIBDatabase);
 380    procedure SetDeleteSQL(Value: TStrings);
 381    procedure SetInsertSQL(Value: TStrings);
 382    //procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
 383    procedure SetRefreshSQL(Value: TStrings);
 384    procedure SetSelectSQL(Value: TStrings);
 385    procedure SetModifySQL(Value: TStrings);
 386    //procedure SetTransaction(Value: TIBTransaction);
 387    procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
 388    procedure SetUniDirectional(Value: Boolean);
 389    procedure RefreshParams;
 390    procedure SQLChanging(Sender: TObject);
 391    function AdjustPosition(FCache: PChar; Offset: DWORD;
 392                            Origin: Integer): Integer;
 393    procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
 394                       Buffer: PChar);
 395    //procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
 396    //                          ReadOldBuffer: Boolean);
 397    procedure WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer;
 398                        Buffer: PChar);
 399    //procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
 400    function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
 401                       DoCheck: Boolean): TGetResult;
 402    procedure SetGeneratorField(const Value: TIBGeneratorField);
 403    {!!!}
 404    {
 405    function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
 406    procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
 407    }
 408    {!!!}
 409    function GetPlan: String;
 410
 411    //!!!
 412    function GetReadTransaction: TIBTransaction;
 413
 414    procedure SetAggregatesActive(const Value: Boolean);
 415
 416    {$IFDEF HEAP_STRING_FIELD}
 417
 418    // ?? ????? ????????? ??? ???? ? ???? ??? ???????????
 419    // ??????????? ???????
 420    function IsHeapField(FD: TFieldData): Boolean;
 421
 422    // ???? ???? ????, ??????????? ? ????, ?? ??????? ??? ???
 423    // ?????? ? ???????? ?? ?????????? ?? ?????????
 424    // ?.?. ???????? ????? ???????????? ?????
 425    // ????? ????????????? ????? ???? ???? ???????????
 426    // ??????????????!
 427    procedure InitializeRecordBuffer(Source, Dest: Pointer);
 428
 429    // ??? ???????? ????????? ??????? ???????
 430    // ?????????????? ??? ???????? ???????? ?? ???? ?
 431    // ??? ???? ???????, ??? ??????? ? ?????? ?????????? ????????????
 432    // ?????? ?????????? ??????
 433    procedure FinalizeCacheBuffer(Buffer: PChar; const Size: Integer);
 434
 435    {$ENDIF}
 436    //!!!
 437
 438
 439  protected
 440    {andreik}
 441    //!!!
 442    // ?????????? ?? ??????
 443    FRowsAffected: Integer;
 444    FUpdateObject: TIBDataSetUpdateObject;
 445    FQSelect, FQDelete: TIBSQL;
 446    FBlobCacheOffset: Integer;
 447    FMappedFieldPosition: array of Integer;
 448    FNeedsRefresh: Boolean;
 449    FFilterBuffer: PChar;
 450    FBufferCache: PChar;
 451    FRecordCount: Integer;
 452    FDataTransfer: Boolean; // ?????????!
 453    FAggregatesObsolete: Boolean; // !!!
 454    FPeekBuffer: PChar; // !!!
 455    FOpenCounter: Integer; //!!!
 456    FModelBuffer: PChar; //!!!
 457    FOnCalcAggregates: TFilterRecordEvent; //?????????
 458    function CanRefresh: Boolean;
 459    procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
 460    procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
 461    procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
 462    procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
 463                              ReadOldBuffer: Boolean);
 464    procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
 465    procedure DoAfterTransactionEnd(Sender: TObject); virtual;
 466    function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
 467    procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
 468    procedure SetTransaction(Value: TIBTransaction); virtual;
 469    procedure SetFiltered(Value: Boolean); override;
 470
 471    //b!!!
 472    procedure CopyRecordBuffer(Source, Dest: Pointer);
 473    //e!!!
 474
 475    //!!!
 476    // ???? ???? ????, ??????????? ? ????, ????????? ??????
 477    // ??????? ??? ?? ?????????, ??? ??? ????????? ?????
 478    // ?? ???????? ? ????????? ????????????
 479    procedure FinalizeRecordBuffer(Buffer: Pointer);
 480    //!!!
 481
 482    // ?????????
 483    procedure DoBeforeReadDatabaseDisconnect(Sender: TObject);
 484    procedure DoAfterReadDatabaseDisconnect(Sender: TObject);
 485    procedure DoReadDatabaseFree(Sender: TObject);
 486    procedure DoBeforeReadTransactionEnd(Sender: TObject);
 487    procedure DoAfterReadTransactionEnd(Sender: TObject);
 488    procedure DoReadTransactionFree(Sender: TObject);
 489
 490    function AllowCloseTransaction: Boolean;
 491
 492    procedure CheckOperation(Operation: TDataOperation;
 493      ErrorEvent: TDataSetErrorEvent);
 494
 495    procedure SetReadTransaction(const Value: TIBTransaction); virtual;
 496    //!!!
 497
 498    procedure ActivateConnection;
 499    function ActivateTransaction: Boolean;
 500    function ActivateReadTransaction: Boolean;
 501    procedure DeactivateTransaction;
 502    procedure DeactivateReadTransaction;
 503    procedure CheckDatasetClosed;
 504    procedure CheckDatasetOpen;
 505    function GetActiveBuf: PChar;
 506    procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
 507    procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
 508    procedure InternalPrepare; virtual;
 509    procedure InternalUnPrepare; virtual;
 510    procedure InternalExecQuery; virtual;
 511    procedure InternalRefreshRow; virtual;
 512    procedure InternalSetParamsFromCursor; virtual;
 513    procedure CheckNotUniDirectional;
 514    procedure SetActive(Value: Boolean); override;
 515
 516    { IProviderSupport }
 517    procedure PSEndTransaction(Commit: Boolean); override;
 518    function PSExecuteStatement(const ASQL: string; AParams: TParams;
 519      ResultSet: Pointer = nil): Integer; override;
 520    function PsGetTableName: string; override;
 521    function PSGetQuoteChar: string; override;
 522    function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
 523    function PSInTransaction: Boolean; override;
 524    function PSIsSQLBased: Boolean; override;
 525    function PSIsSQLSupported: Boolean; override;
 526    procedure PSStartTransaction; override;
 527    procedure PSReset; override;
 528    function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
 529
 530    { TDataSet support }
 531    procedure InternalInsert; override;
 532    procedure InitRecord(Buffer: PChar); override;
 533    procedure Disconnect; virtual;
 534    function ConstraintsStored: Boolean;
 535    procedure ClearCalcFields(Buffer: PChar); override;
 536    procedure CreateFields; override;
 537    function AllocRecordBuffer: PChar; override;
 538    procedure DoBeforeDelete; override;
 539    procedure DoBeforeEdit; override;
 540    procedure DoBeforeInsert; override;
 541    procedure FreeRecordBuffer(var Buffer: PChar); override;
 542    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
 543    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
 544    function GetCanModify: Boolean; override;
 545    function GetDataSource: TDataSource; override;
 546    function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
 547    function GetRecNo: Integer; override;
 548    function GetRecord(Buffer: PChar; GetMode: TGetMode;
 549                       DoCheck: Boolean): TGetResult; override;
 550    function GetRecordCount: Integer; override;
 551    function GetRecordSize: Word; override;
 552    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
 553    procedure InternalCancel; override;
 554    procedure InternalClose; override;
 555    procedure InternalDelete; override;
 556    procedure InternalFirst; override;
 557    procedure InternalGotoBookmark(Bookmark: Pointer); override;
 558    procedure InternalHandleException; override;
 559    procedure InternalInitFieldDefs; override;
 560    procedure InternalInitRecord(Buffer: PChar); override;
 561    procedure InternalLast; override;
 562    procedure InternalOpen; override;
 563    procedure InternalPost; override;
 564    procedure InternalRefresh; override;
 565    procedure InternalSetToRecord(Buffer: PChar); override;
 566    function IsCursorOpen: Boolean; override;
 567    procedure ReQuery;
 568    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
 569    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
 570    procedure SetCachedUpdates(Value: Boolean);
 571    procedure SetDataSource(Value: TDataSource);
 572    procedure SetFieldData(Field : TField; Buffer : Pointer); override;
 573    procedure SetFieldData(Field : TField; Buffer : Pointer;
 574      NativeFormat : Boolean); overload; override;
 575    procedure SetRecNo(Value: Integer); override;
 576    procedure DoOnNewRecord; override;
 577    procedure Loaded; override;
 578
 579    //!!!b
 580    procedure DoAfterDelete; override;
 581    procedure DoAfterPost; override;
 582    procedure DoAfterRefresh; override;
 583    //!!!e
 584
 585  protected
 586    {Likely to be made public by descendant classes}
 587    property SQLParams: TIBXSQLDA read GetSQLParams;
 588    property Params: TIBXSQLDA read GetSQLParams;
 589    property InternalPrepared: Boolean read FInternalPrepared;
 590    property QDelete: TIBSQL read FQDelete;
 591    property QInsert: TIBSQL read FQInsert;
 592    property QRefresh: TIBSQL read FQRefresh;
 593    //property QSelect: TIBSQL read FQSelect;
 594    property QModify: TIBSQL read FQModify;
 595    property StatementType: TIBSQLTypes read GetStatementType;
 596    property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
 597    property LiveMode : TLiveModes read FLiveMode;
 598
 599    {Likely to be made published by descendant classes}
 600    property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
 601    property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
 602    property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
 603    property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
 604    property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
 605    property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
 606    property SelectSQL: TStrings read GetSelectSQL write SetSelectSQL;
 607    property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
 608    property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
 609    property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
 610    property GeneratorField : TIBGeneratorField read FGeneratorField write SetGeneratorField;
 611
 612    property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
 613                                                 write FBeforeDatabaseDisconnect;
 614    property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
 615                                                write FAfterDatabaseDisconnect;
 616    property DatabaseFree: TNotifyEvent read FDatabaseFree
 617                                        write FDatabaseFree;
 618    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
 619                                             write FBeforeTransactionEnd;
 620    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
 621                                            write FAfterTransactionEnd;
 622    property TransactionFree: TNotifyEvent read FTransactionFree
 623                                           write FTransactionFree;
 624
 625    //
 626    property _RecordBufferSize: Integer read FRecordBufferSize;
 627    property _CurrentRecord: Integer read FCurrentRecord;
 628    //
 629
 630  public
 631    constructor Create(AOwner: TComponent); override;
 632    destructor Destroy; override;
 633    procedure ApplyUpdates;
 634    function CachedUpdateStatus: TCachedUpdateStatus;
 635    procedure CancelUpdates;
 636    procedure FetchAll;
 637    function LocateNext(const KeyFields: string; const KeyValues: Variant;
 638                        Options: TLocateOptions): Boolean;
 639    procedure RecordModified(Value: Boolean);
 640    procedure RevertRecord;
 641    procedure Undelete;
 642    procedure Post; override;
 643    function Current : TIBXSQLDA;
 644    function SQLType : TIBSQLTypes;
 645
 646    //!!!b
 647    procedure Cancel; override;
 648    procedure CheckRequiredFields;
 649    //!!!e
 650
 651    //!!!b
 652    procedure Sort(F: TField; const Ascending: Boolean = True);
 653    //!!!e
 654
 655    //!!!b
 656    //
 657    procedure ResetAllAggs(AnActive: Boolean; BL: TBookmarkList);
 658    //!!!e
 659
 660    { TDataSet support methods }
 661    function BookmarkValid(Bookmark: TBookmark): Boolean; override;
 662    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
 663    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
 664    function GetCurrentRecord(Buffer: PChar): Boolean; override;
 665    function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
 666    function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;
 667    function Locate(const KeyFields: string; const KeyValues: Variant;
 668                    Options: TLocateOptions): Boolean; override;
 669    function Lookup(const KeyFields: string; const KeyValues: Variant;
 670                    const ResultFields: string): Variant; override;
 671    function UpdateStatus: TUpdateStatus; override;
 672    function IsSequenced: Boolean; override;
 673    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
 674    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
 675    property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
 676    property UpdatesPending: Boolean read FUpdatesPending;
 677    property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
 678                                                      write SetUpdateRecordTypes;
 679    property RowsAffected : Integer read FRowsAffected;
 680    property Plan: String read GetPlan;
 681
 682    //!!!b
 683    property QSelect: TIBSQL read FQSelect;
 684
 685    property ReadTransaction: TIBTransaction read GetReadTransaction write SetReadTransaction;
 686    property CacheSize: Integer read FCacheSize;
 687
 688    //
 689    property AggregatesActive: Boolean read FAggregatesActive write SetAggregatesActive;
 690    property Aggregates: TgdcAggregates read FAggregates;
 691    property AggregatesObsolete: Boolean read FAggregatesObsolete;
 692
 693    property OpenCounter: Integer read FOpenCounter;
 694
 695    property OnCalcAggregates: TFilterRecordEvent read FOnCalcAggregates write FOnCalcAggregates;
 696    //!!!e
 697
 698  published
 699    property Database: TIBDatabase read GetDatabase write SetDatabase;
 700    property Transaction: TIBTransaction read GetTransaction
 701                                          write SetTransaction;
 702    property ForcedRefresh: Boolean read FForcedRefresh
 703                                    write FForcedRefresh default False;
 704    property AutoCalcFields;
 705    property ObjectView default False;
 706
 707    property AfterCancel;
 708    property AfterClose;
 709    property AfterDelete;
 710    property AfterEdit;
 711    property AfterInsert;
 712    property AfterOpen;
 713    property AfterPost;
 714    property AfterRefresh;
 715    property AfterScroll;
 716    property BeforeCancel;
 717    property BeforeClose;
 718    property BeforeDelete;
 719    property BeforeEdit;
 720    property BeforeInsert;
 721    property BeforeOpen;
 722    property BeforePost;
 723    property BeforeRefresh;
 724    property BeforeScroll;
 725    property OnCalcFields;
 726    property OnDeleteError;
 727    property OnEditError;
 728    property OnNewRecord;
 729    property OnPostError;
 730    property OnUpdateError: TIBUpdateErrorEvent read FOnUpdateError
 731                                                 write FOnUpdateError;
 732    property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord
 733                                                   write FOnUpdateRecord;
 734
 735    //!!!
 736    property BeforeInternalPostRecord: TDataSetNotifyEvent read FBeforeInternalPostRecord
 737      write FBeforeInternalPostRecord;
 738    property AfterInternalPostRecord: TDataSetNotifyEvent read FAfterInternalPostRecord
 739      write FAfterInternalPostRecord;
 740    property BeforeInternalDeleteRecord: TDataSetNotifyEvent read FBeforeInternalDeleteRecord
 741      write FBeforeInternalDeleteRecord;
 742    property AfterInternalDeleteRecord: TDataSetNotifyEvent read FAfterInternalDeleteRecord
 743      write FAfterInternalDeleteRecord;
 744    //!!!
 745
 746    //!!!
 747    property AllowStreamedActive: Boolean read FAllowStreamedActive write FAllowStreamedActive
 748      default False;
 749    //!!!
 750  end;
 751
 752  TIBDataSet = class(TIBCustomDataSet)
 753  private
 754    function GetPrepared: Boolean;
 755
 756  protected
 757    procedure PSSetCommandText(const CommandText: string); override;
 758    procedure SetFiltered(Value: Boolean); override;
 759    procedure InternalOpen; override;
 760
 761  public
 762    procedure Prepare;
 763    procedure UnPrepare;
 764    procedure BatchInput(InputObject: TIBBatchInput);
 765    procedure BatchOutput(OutputObject: TIBBatchOutput);
 766    procedure ExecSQL;
 767
 768  public
 769    function ParamByName(Idx : String) : TIBXSQLVAR;
 770    property Params;
 771    property Prepared : Boolean read GetPrepared;
 772    property StatementType;
 773    property SelectStmtHandle;
 774    property LiveMode;
 775
 776  { by andreik!!! }  
 777  public
 778    property QDelete;
 779    property QInsert;
 780    property QRefresh;
 781    property QSelect;
 782    property QModify;
 783
 784  published
 785    { TIBCustomDataSet }
 786    property BufferChunks;
 787    property CachedUpdates;
 788    property DeleteSQL;
 789    property InsertSQL;
 790    property RefreshSQL;
 791    property SelectSQL;
 792    property ModifySQL;
 793    property ParamCheck;
 794    property UniDirectional;
 795    property Filtered;
 796    property GeneratorField;
 797    property BeforeDatabaseDisconnect;
 798    property AfterDatabaseDisconnect;
 799    property DatabaseFree;
 800    property BeforeTransactionEnd;
 801    property AfterTransactionEnd;
 802    property TransactionFree;
 803    property UpdateObject;
 804    ///!!!!b
 805    property OnCalcAggregates;
 806    //!!!!e
 807    { TIBDataSet }
 808    property Active;
 809    property AutoCalcFields;
 810    property DataSource read GetDataSource write SetDataSource;
 811
 812    property AfterCancel;
 813    property AfterClose;
 814    property AfterDelete;
 815    property AfterEdit;
 816    property AfterInsert;
 817    property AfterOpen;
 818    property AfterPost;
 819    property AfterScroll;
 820    property BeforeCancel;
 821    property BeforeClose;
 822    property BeforeDelete;
 823    property BeforeEdit;
 824    property BeforeInsert;
 825    property BeforeOpen;
 826    property BeforePost;
 827    property BeforeScroll;
 828    property OnCalcFields;
 829    property OnDeleteError;
 830    property OnEditError;
 831    property OnFilterRecord;
 832    property OnNewRecord;
 833    property OnPostError;
 834  end;
 835
 836  { TIBDSBlobStream }
 837  TIBDSBlobStream = class(TStream)
 838  protected
 839    FField: TField;
 840    FBlobStream: TIBBlobStream;
 841    FModified : Boolean;
 842  public
 843    constructor Create(AField: TField; ABlobStream: TIBBlobStream;
 844                       Mode: TBlobStreamMode);
 845    destructor Destroy; override;
 846    function Read(var Buffer; Count: Longint): Longint; override;
 847    function Seek(Offset: Longint; Origin: Word): Longint; override;
 848    procedure SetSize(NewSize: Longint); override;
 849    function Write(const Buffer; Count: Longint): Longint; override;
 850  end;
 851
 852  //!!!b
 853
 854{ TgsMemoField }
 855
 856  TgsMemoField = class(TMemoField)
 857  private
 858    //??????????? ?????????? OnSetText
 859    procedure InsideSetText(Sender: TField; const Text: string);
 860
 861  protected
 862    procedure SetText(const Value: string); override;
 863  public
 864    constructor Create(AOwner: TComponent); override;
 865  end;
 866
 867  //!!!e
 868
 869const
 870DefaultFieldClasses: array[TFieldType] of TFieldClass = (
 871    nil,                { ftUnknown }
 872    TIBStringField,     { ftString }
 873    TSmallintField,     { ftSmallint }
 874    TIntegerField,      { ftInteger }
 875    TWordField,         { ftWord }
 876    TBooleanField,      { ftBoolean }
 877    TFloatField,        { ftFloat }
 878    TCurrencyField,     { ftCurrency }
 879    TIBBCDField,        { ftBCD }
 880    TDateField,         { ftDate }
 881    TTimeField,         { ftTime }
 882    TDateTimeField,     { ftDateTime }
 883    TBytesField,        { ftBytes }
 884    TVarBytesField,     { ftVarBytes }
 885    TAutoIncField,      { ftAutoInc }
 886    TBlobField,         { ftBlob }
 887    TgsMemoField,         { ftMemo }
 888    //TMemoField,         { ftMemo }
 889    TGraphicField,      { ftGraphic }
 890    TBlobField,         { ftFmtMemo }
 891    TBlobField,         { ftParadoxOle }
 892    TBlobField,         { ftDBaseOle }
 893    TBlobField,         { ftTypedBinary }
 894    nil,                { ftCursor }
 895    TStringField,       { ftFixedChar }
 896    nil, {TWideStringField } { ftWideString }
 897    TLargeIntField,     { ftLargeInt }
 898    TADTField,          { ftADT }
 899    TArrayField,        { ftArray }
 900    TReferenceField,    { ftReference }
 901    TDataSetField,     { ftDataSet }
 902    TBlobField,         { ftOraBlob }
 903    TgsMemoField,         { ftOraClob }
 904    //TMemoField,         { ftOraClob }
 905    TVariantField,      { ftVariant }
 906    TInterfaceField,    { ftInterface }
 907    TIDispatchField,     { ftIDispatch }
 908    TGuidField);        { ftGuid }
 909var
 910  CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;
 911
 912implementation
 913
 914uses
 915  IBIntf, DBConsts,
 916  dlgRecordFetch_unit, Forms, flt_sql_parser; //!!! added by Andreik
 917
 918
 919{ TIBStringField}
 920
 921constructor TIBStringField.Create(AOwner: TComponent);
 922begin
 923  inherited Create(AOwner);
 924end;
 925
 926class procedure TIBStringField.CheckTypeSize(Value: Integer);
 927begin
 928  { don't check string size. all sizes valid }
 929end;
 930
 931function TIBStringField.GetAsString: string;
 932begin
 933  if not GetValue(Result) then Result := '';
 934end;
 935
 936function TIBStringField.GetAsVariant: Variant;
 937var
 938  S: string;
 939begin
 940  if GetValue(S) then Result := S else Result := Null;
 941end;
 942
 943function TIBStringField.GetValue(var Value: string): Boolean;
 944var
 945  Buffer: PChar;
 946begin
 947  Buffer := nil;
 948  IBAlloc(Buffer, 0, Size + 1);
 949  try
 950    Result := GetData(Buffer);
 951    if Result then
 952    begin
 953      Value := string(Buffer);
 954      if Transliterate and (Value <> '') then
 955        DataSet.Translate(PChar(Value), PChar(Value), False);
 956    end
 957  finally
 958    FreeMem(Buffer);
 959  end;
 960end;
 961
 962procedure TIBStringField.SetAsString(const Value: string);
 963var
 964  Buffer: PChar;
 965begin
 966  Buffer := nil;
 967  IBAlloc(Buffer, 0, Size + 1);
 968  try
 969    StrLCopy(Buffer, PChar(Value), Size);
 970    if Transliterate then
 971      DataSet.Translate(Buffer, Buffer, True);
 972    SetData(Buffer);
 973  finally
 974    FreeMem(Buffer);
 975  end;
 976end;
 977
 978{ TIBBCDField }
 979
 980constructor TIBBCDField.Create(AOwner: TComponent);
 981begin
 982  inherited Create(AOwner);
 983  SetDataType(ftBCD);
 984  Size := 8;
 985end;
 986
 987class procedure TIBBCDField.CheckTypeSize(Value: Integer);
 988begin
 989{ No need to check as the base type is currency, not BCD }
 990end;
 991
 992function TIBBCDField.GetAsCurrency: Currency;
 993begin
 994  if not GetValue(Result) then
 995    Result := 0;
 996end;
 997
 998function TIBBCDField.GetAsString: string;
 999var
1000  C: System.Currency;
1001begin
1002  if GetValue(C) then
1003    Result := CurrToStr(C)
1004  else
1005    Result := '';
1006end;
1007
1008function TIBBCDField.GetAsVariant: Variant;
1009var
1010  C: System.Currency;
1011begin
1012  if GetValue(C) then
1013    Result := C
1014  else
1015    Result := Null;
1016end;
1017
1018function TIBBCDField.GetDataSize: Integer;
1019begin
1020  Result := 8;
1021end;
1022
1023{ TIBDataLink }
1024
1025constructor TIBDataLink.Create(ADataSet: TIBCustomDataSet);
1026begin
1027  inherited Create;
1028  FDataSet := ADataSet;
1029end;
1030
1031destructor TIBDataLink.Destroy;
1032begin
1033  FDataSet.FDataLink := nil;
1034  inherited Destroy;
1035end;
1036
1037
1038procedure TIBDataLink.ActiveChanged;
1039begin
1040  if FDataSet.Active then
1041    FDataSet.RefreshParams;
1042end;
1043
1044
1045function TIBDataLink.GetDetailDataSet: TDataSet;
1046begin
1047  Result := FDataSet;
1048end;
1049
1050procedure TIBDataLink.RecordChanged(Field: TField);
1051begin
1052  if (Field = nil) and FDataSet.Active then
1053    FDataSet.RefreshParams;
1054end;
1055
1056procedure TIBDataLink.CheckBrowseMode;
1057begin
1058  if FDataSet.Active then
1059    FDataSet.CheckBrowseMode;
1060end;
1061
1062{ TIBCustomDataSet }
1063
1064constructor TIBCustomDataSet.Create(AOwner: TComponent);
1065begin
1066  inherited Create(AOwner);
1067  FIBLoaded := False;
1068  CheckIBLoaded;
1069  FIBLoaded := True;
1070  FBase := TIBBase.Create(Self);
1071  //!!!
1072  FReadBase := TIBBase.Create(Self);
1073  FReadTransactionSet := False;
1074  FDataTransfer := False;
1075  FAggregatesObsolete := True;
1076  FAllowStreamedActive := False;
1077  FSavedRecordCount := -1;
1078  //!!!
1079  FCurrentRecord := -1;
1080  FDeletedRecords := 0;
1081  FUniDirectional := False;
1082  FBufferChunks := BufferCacheSize;
1083  FBlobStreamList := TList.Create;
1084  FDataLink := TIBDataLink.Create(Self);
1085  FQDelete := TIBSQL.Create(Self);
1086  FQDelete.OnSQLChanging := SQLChanging;
1087  FQDelete.GoToFirstRecordOnExecute := False;
1088  FQInsert := TIBSQL.Create(Self);
1089  FQInsert.OnSQLChanging := SQLChanging;
1090  FQInsert.GoToFirstRecordOnExecute := False;
1091  FQRefresh := TIBSQL.Create(Self);
1092  FQRefresh.OnSQLChanging := SQLChanging;
1093  FQRefresh.GoToFirstRecordOnExecute := False;
1094  FQSelect := TIBSQL.Create(Self);
1095  FQSelect.OnSQLChanging := SQLChanging;
1096  FQSelect.GoToFirstRecordOnExecute := False;
1097  FQModify := TIBSQL.Create(Self);
1098  FQModify.OnSQLChanging := SQLChanging;
1099  FQModify.GoToFirstRecordOnExecute := False;
1100  FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1101  FParamCheck := True;
1102  FForcedRefresh := False;
1103  FGeneratorField := TIBGeneratorField.Create(Self);
1104  {Bookmark Size is Integer for IBX}
1105  BookmarkSize := SizeOf(Integer);
1106  FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
1107  FBase.AfterDatabaseDisconnect := DoAfterDatabaseDisconnect;
1108  FBase.OnDatabaseFree := DoDatabaseFree;
1109  FBase.BeforeTransactionEnd := DoBeforeTransactionEnd;
1110  FBase.AfterTransactionEnd := DoAfterTransactionEnd;
1111  FBase.OnTransactionFree := DoTransactionFree;
1112  //!!!b
1113  FReadBase.BeforeDatabaseDisconnect := DoBeforeReadDatabaseDisconnect;
1114  FReadBase.AfterDatabaseDisconnect := DoAfterReadDatabaseDisconnect;
1115  FReadBase.OnDatabaseFree := DoReadDatabaseFree;
1116  FReadBase.BeforeTransactionEnd := DoBeforeReadTransactionEnd;
1117  FReadBase.AfterTransactionEnd := DoAfterReadTransactionEnd;
1118  FReadBase.OnTransactionFree := DoReadTransactionFree;
1119
1120  FAggregates := TgdcAggregates.Create(Self);
1121  FAggregatesActive := False;
1122
1123  FOpenCounter := 0;
1124  //!!!e
1125  FLiveMode := [];
1126  FRowsAffected := 0;
1127  FStreamedActive := false;
1128  if AOwner is TIBDatabase then
1129    Database := TIBDatabase(AOwner)
1130  else
1131    if AOwner is TIBTransaction then
1132      Transaction := TIBTransaction(AOwner);
1133end;
1134
1135destructor TIBCustomDataSet.Destroy;
1136begin
1137  if FIBLoaded then
1138  begin
1139    Close;
1140    FreeAndNil(FDataLink);
1141    FreeAndNil(FBase);
1142    //!!!b
1143    FreeAndNil(FReadBase);
1144    FreeAndNil(FAggregates);
1145    //!!!e
1146    ClearBlobCache;
1147    FreeAndNil(FBlobStreamList);
1148    {$IFDEF HEAP_STRING_FIELD}
1149    FinalizeCacheBuffer(FBufferCache, FCacheSize);
1150    {$ENDIF}
1151    FreeMem(FBufferCache, 0);
1152    FBufferCache := nil;
1153    {$IFDEF HEAP_STRING_FIELD}
1154    FinalizeCacheBuffer(FOldBufferCache, FOldCacheSize);
1155    {$ENDIF}
1156    FreeMem(FOldBufferCache, 0);
1157    FreeAndNil(FGeneratorField);
1158    FOldBufferCache := nil;
1159    FCacheSize := 0;
1160    FOldCacheSize := 0;
1161    FMappedFieldPosition := nil;
1162  end;
1163  inherited Destroy;
1164end;
1165
1166function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
1167                                             TGetResult;
1168begin
1169  while not IsVisible(Buffer) do
1170  begin
1171    if GetMode = gmPrior then
1172    begin
1173      Dec(FCurrentRecord);
1174      if FCurrentRecord = -1 then
1175      begin
1176        result := grBOF;
1177        exit;
1178      end;
1179      ReadRecordCache(FCurrentRecord, Buffer, False);
1180    end
1181    else
1182    begin
1183      Inc(FCurrentRecord);
1184      if (FCurrentRecord = FRecordCount) then
1185      begin
1186        if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1187        begin
1188          FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1189          Inc(FRecordCount);
1190        end
1191        else
1192        begin
1193          //!!!
1194          //FAggregatesObsolete := True;
1195          //!!!
1196          result := grEOF;
1197          exit;
1198        end;
1199      end
1200      else
1201        ReadRecordCache(FCurrentRecord, Buffer, False);
1202    end;
1203  end;
1204  result := grOK;
1205end;
1206
1207procedure TIBCustomDataSet.ApplyUpdates;
1208var
1209  CurBookmark: string;
1210  Buffer: PRecordData;
1211  CurUpdateTypes: TIBUpdateRecordTypes;
1212  UpdateAction: TIBUpdateAction;
1213  UpdateKind: TUpdateKind;
1214  bRecordsSkipped: Boolean;
1215  R: Boolean;
1216  //TempCurrent: Integer;
1217  Buff: PChar;
1218
1219  procedure GetUpdateKind;
1220  begin
1221    case Buffer^.rdCachedUpdateStatus of
1222      cusModified:
1223        UpdateKind := ukModify;
1224      cusInserted:
1225        UpdateKind := ukInsert;
1226      else
1227        UpdateKind := ukDelete;
1228    end;
1229  end;
1230
1231  procedure ResetBufferUpdateStatus;
1232  begin
1233    case Buffer^.rdCachedUpdateStatus of
1234      cusModified:
1235      begin
1236        PRecordData(Buffer)^.rdUpdateStatus := usUnmodified;
1237        PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
1238      end;
1239      cusInserted:
1240      begin
1241        PRecordData(Buffer)^.rdUpdateStatus := usUnmodified;
1242        PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
1243      end;
1244      cusDeleted:
1245      begin
1246        PRecordData(Buffer)^.rdUpdateStatus := usDeleted;
1247        PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
1248      end;
1249    end;
1250    WriteRecordCache(PRecordData(Buffer)^.rdRecordNumber, Pointer(Buffer));
1251  end;
1252
1253  procedure UpdateUsingOnUpdateRecord;
1254  begin
1255    UpdateAction := uaFail;
1256    try
1257      FOnUpdateRecord(Self, UpdateKind, UpdateAction);
1258    except
1259      on E: Exception do
1260      begin
1261        if (E is EDatabaseError) and Assigned(FOnUpdateError) then
1262          FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);
1263        if UpdateAction = uaFail then
1264          raise;
1265      end;
1266    end;
1267  end;
1268
1269  procedure UpdateUsingUpdateObject;
1270  begin
1271    UpdateAction := uaApply;
1272    try
1273      FUpdateObject.Apply(UpdateKind);
1274      ResetBufferUpdateStatus;
1275    except
1276      on E: Exception do
1277      begin
1278        UpdateAction := uaFail;
1279        if (E is EDatabaseError) and Assigned(FOnUpdateError) then
1280          FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);
1281        if UpdateAction = uaFail then
1282          raise;
1283      end;
1284    end;
1285  end;
1286
1287  procedure UpdateUsingInternalquery;
1288  begin
1289    try
1290      case Buffer^.rdCachedUpdateStatus of
1291        cusModified:
1292          InternalPostRecord(FQModify, Buffer);
1293        cusInserted:
1294          InternalPostRecord(FQInsert, Buffer);
1295        cusDeleted:
1296          InternalDeleteRecord(FQDelete, Buffer);
1297      end;
1298    except
1299      on E: EIBError do begin
1300        UpdateAction := uaFail;
1301        if Assigned(FOnUpdateError) then
1302          FOnUpdateError(Self, E, UpdateKind, UpdateAction);
1303        case UpdateAction of
1304          uaFail: raise;
1305          uaAbort: SysUtils.Abort;
1306          uaSkip: bRecordsSkipped := True;
1307        end;
1308      end;
1309    end;
1310  end;
1311
1312begin
1313  if State in [dsEdit, dsInsert] then
1314    Post;
1315  FBase.CheckDatabase;
1316  //!!!
1317  //FBase.CheckTransaction;
1318  //!!!
1319  DisableControls;
1320  CurBookmark := Bookmark;
1321  CurUpdateTypes := FUpdateRecordTypes;
1322  FUpdateRecordTypes := [cusModified, cusInserted, cusDeleted];
1323  try
1324    First;
1325    bRecordsSkipped := False;
1326    while not EOF do
1327    begin
1328      Buffer := PRecordData(GetActiveBuf);
1329      GetUpdateKind;
1330      UpdateAction := uaApply;
1331      if Assigned(FUpdateObject) or Assigned(FOnUpdateRecord) then
1332      begin
1333        if (Assigned(FOnUpdateRecord)) then
1334          UpdateUsingOnUpdateRecord
1335        else
1336          if Assigned(FUpdateObject) then
1337            UpdateUsingUpdateObject;
1338        case UpdateAction of
1339          uaFail:
1340            IBError(ibxeUserAbort, [nil]);
1341          uaAbort:
1342            SysUtils.Abort;
1343          uaApplied:
1344            ResetBufferUpdateStatus;
1345          uaSkip:
1346            bRecordsSkipped := True;
1347          uaRetry:
1348            Continue;
1349        end;
1350      end;
1351      if (not Assigned(FUpdateObject)) and (UpdateAction = UaApply) then
1352      begin
1353        UpdateUsingInternalquery;
1354        UpdateAction := uaApplied;
1355      end;
1356      Next;
1357    end;
1358    FUpdatesPending := bRecordsSkipped;
1359  finally
1360    FUpdateRecordTypes := CurUpdateTypes;
1361
1362    if BookmarkValid(Pointer(CurBookmark)) then
1363    begin
1364      {TempCurrent := FCurrentRecord;
1365      FCurrentRecord := PInteger(CurBookmark)^;
1366      Buff := ActiveBuffer;}
1367      Buff := FBufferCache + _RecordBufferSize * PInteger(CurBookmark)^;
1368      R := PRecordData(Buff)^.rdCachedUpdateStatus <> cusDeleted;
1369      {FCurrentRecord := TempCurrent;}
1370
1371      if R then
1372        Bookmark := CurBookmark
1373      else
1374        First;
1375    end else
1376      First;
1377      
1378    EnableControls;
1379  end;
1380end;
1381
1382procedure TIBCustomDataSet.InternalBatchInput(InputObject: TIBBatchInput);
1383begin
1384  FQSelect.BatchInput(InputObject);
1385end;
1386
1387procedure TIBCustomDataSet.InternalBatchOutput(OutputObject: TIBBatchOutput);
1388var
1389  Qry: TIBSQL;
1390begin
1391  Qry := TIBSQL.Create(Self);
1392  try
1393    Qry.Database := FBase.Database;
1394    Qry.Transaction := FBase.Transaction;
1395    Qry.SQL.Assign(FQSelect.SQL);
1396    Qry.BatchOutput(OutputObject);
1397  finally
1398    Qry.Free;
1399  end;
1400end;
1401
1402procedure TIBCustomDataSet.CancelUpdates;
1403var
1404  CurUpdateTypes: TIBUpdateRecordTypes;
1405begin
1406  if State in [dsEdit, dsInsert] then
1407    Cancel;
1408  if FCachedUpdates and FUpdatesPending then
1409  begin
1410    DisableControls;
1411    CurUpdateTypes := UpdateRecordTypes;
1412    UpdateRecordTypes := [cusModified, cusInserted, cusDeleted];
1413    try
1414      First;
1415      while not EOF do
1416      begin
1417        if UpdateStatus = usInserted then
1418        //!!!
1419          begin
1420        //!!!
1421            RevertRecord;
1422        //!!!    
1423            First;
1424          end
1425        //!!!
1426        else
1427        begin
1428          RevertRecord;
1429          Next;
1430        end;
1431      end;
1432    finally
1433      UpdateRecordTypes := CurUpdateTypes;
1434      First;
1435      FUpdatesPending := False;
1436      EnableControls;
1437    end;
1438  end;
1439end;
1440
1441procedure TIBCustomDataSet.ActivateConnection;
1442begin
1443  if not Assigned(Database) then
1444    IBError(ibxeDatabaseNotAssigned, [nil]);
1445  if not Assigned(Transaction) then
1446    IBError(ibxeTransactionNotAssigned, [nil]);
1447  if not Database.Connected then Database.Open;
1448end;
1449
1450function TIBCustomDataSet.ActivateTransaction: Boolean;
1451begin
1452  Result := False;
1453  if not Assigned(Transaction) then
1454    IBError(ibxeTransactionNotAssigned, [nil]);
1455  if not Transaction.Active then
1456  begin
1457    Result := True;
1458    Transaction.StartTransaction;
1459  end;
1460end;
1461
1462procedure TIBCustomDataSet.DeactivateTransaction;
1463begin
1464  if not Assigned(Transaction) then
1465    IBError(ibxeTransactionNotAssigned, [nil]);
1466  Transaction.CheckAutoStop;
1467end;
1468
1469procedure TIBCustomDataSet.CheckDatasetClosed;
1470begin
1471  if FOpen then
1472    IBError(ibxeDatasetOpen, [nil]);
1473end;
1474
1475procedure TIBCustomDataSet.CheckDatasetOpen;
1476begin
1477  if not FOpen then
1478    IBError(ibxeDatasetClosed, [nil]);
1479end;
1480
1481procedure TIBCustomDataSet.CheckNotUniDirectional;
1482begin
1483  if UniDirectional then
1484    IBError(ibxeDataSetUniDirectional, [nil]);
1485end;
1486
1487procedure TIBCustomDataSet.AdjustRecordOnInsert(Buffer: Pointer);
1488begin
1489  with PRecordData(Buffer)^ do
1490    if (State = dsInsert) and (not Modified) then
1491    begin
1492      rdRecordNumber := FRecordCount;
1493      FCurrentRecord := FRecordCount;
1494    end;
1495end;
1496
1497function TIBCustomDataSet.CanEdit: Boolean;
1498var
1499  Buff: PRecordData;
1500begin
1501  Buff := PRecordData(GetActiveBuf);
1502  result := ((FQModify.SQL.Text <> '') and (lmModify in FLiveMode)) or
1503    (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukModify).Text <> '')) or
1504    ((Buff <> nil) and (Buff^.rdCachedUpdateStatus = cusInserted) and
1505      (FCachedUpdates));
1506end;
1507
1508function TIBCustomDataSet.CanInsert: Boolean;
1509begin
1510  result := ((FQInsert.SQL.Text <> '') and (lmInsert in FLiveMode)…

Large files files are truncated, but you can click here to view the full file