ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBCustomDataSet.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 27 by tony, Tue Apr 14 13:10:23 2015 UTC

# Line 1 | Line 1
1 < {************************************************************************}
2 < {                                                                        }
3 < {       Borland Delphi Visual Component Library                          }
4 < {       InterBase Express core components                                }
5 < {                                                                        }
6 < {       Copyright (c) 1998-2000 Inprise 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            }
16 < {    may obtain a copy of the License at http://www.Inprise.com/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 Inprise Corporation are Copyright (C) Inprise   }
24 < {       Corporation. All Rights Reserved.                                }
25 < {    Contributor(s): Jeff Overcash                                       }
26 < {                                                                        }
27 < {************************************************************************}
28 <
29 < unit IBCustomDataSet;
30 <
31 < interface
32 <
33 < uses
34 <  Windows, SysUtils, Classes, Forms, Controls, StdVCL,
35 <  IBExternals, IB, IBHeader, IBDatabase, IBSQL, Db,
36 <  IBUtils, IBBlob;
37 <
38 < const
39 <  BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
40 <  UniCache           =  2;     { Uni-directional cache is 2 records big }
41 <
42 < type
43 <  TIBCustomDataSet = class;
44 <  TIBDataSet = class;
45 <
46 <  TIBDataSetUpdateObject = class(TComponent)
47 <  private
48 <    FRefreshSQL: TStrings;
49 <    procedure SetRefreshSQL(value: TStrings);
50 <  protected
51 <    function GetDataSet: TIBCustomDataSet; virtual; abstract;
52 <    procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
53 <    procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
54 <    function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
55 <    property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
56 <  public
57 <    constructor Create(AOwner: TComponent); override;
58 <    destructor Destroy; override;
59 <  published
60 <    property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
61 <  end;
62 <
63 <  PDateTime = ^TDateTime;
64 <  TBlobDataArray = array[0..0] of TIBBlobStream;
65 <  PBlobDataArray = ^TBlobDataArray;
66 <
67 <  { TIBCustomDataSet }
68 <  TFieldData = record
69 <    fdDataType: Short;
70 <    fdDataScale: Short;
71 <    fdNullable: Boolean;
72 <    fdIsNull: Boolean;
73 <    fdDataSize: Short;
74 <    fdDataLength: Short;
75 <    fdDataOfs: Integer;
76 <  end;
77 <  PFieldData = ^TFieldData;
78 <
79 <  TCachedUpdateStatus = (
80 <                         cusUnmodified, cusModified, cusInserted,
81 <                         cusDeleted, cusUninserted
82 <                        );
83 <  TIBDBKey = record
84 <    DBKey: array[0..7] of Byte;
85 <  end;
86 <  PIBDBKey = ^TIBDBKey;
87 <
88 <  TRecordData = record
89 <    rdBookmarkFlag: TBookmarkFlag;
90 <    rdFieldCount: Short;
91 <    rdRecordNumber: Long;
92 <    rdCachedUpdateStatus: TCachedUpdateStatus;
93 <    rdUpdateStatus: TUpdateStatus;
94 <    rdSavedOffset: DWORD;
95 <    rdDBKey: TIBDBKey;
96 <    rdFields: array[1..1] of TFieldData;
97 <  end;
98 <  PRecordData = ^TRecordData;
99 <
100 <  { TIBStringField allows us to have strings longer than 8196 }
101 <
102 <  TIBStringField = class(TStringField)
103 <  public
104 <    constructor create(AOwner: TComponent); override;
105 <    class procedure CheckTypeSize(Value: Integer); override;
106 <    function GetAsString: string; override;
107 <    function GetAsVariant: Variant; override;
108 <    function GetValue(var Value: string): Boolean;
109 <    procedure SetAsString(const Value: string); override;
110 <  end;
111 <
112 <  { TIBBCDField }
113 <  {  Actually, there is no BCD involved in this type,
114 <     instead it deals with currency types.
115 <     In IB, this is an encapsulation of Numeric (x, y)
116 <     where x < 18 and y <= 4.
117 <     Note: y > 4 will default to Floats
118 <  }
119 <  TIBBCDField = class(TBCDField)
120 <  protected
121 <    class procedure CheckTypeSize(Value: Integer); override;
122 <    function GetAsCurrency: Currency; override;
123 <    function GetAsString: string; override;
124 <    function GetAsVariant: Variant; override;
125 <    function GetDataSize: Integer; override;
126 <  public
127 <    constructor Create(AOwner: TComponent); override;
128 <  published
129 <    property Size default 8;
130 <  end;
131 <
132 <  TIBDataLink = class(TDetailDataLink)
133 <  private
134 <    FDataSet: TIBCustomDataSet;
135 <  protected
136 <    procedure ActiveChanged; override;
137 <    procedure RecordChanged(Field: TField); override;
138 <    function GetDetailDataSet: TDataSet; override;
139 <    procedure CheckBrowseMode; override;
140 <  public
141 <    constructor Create(ADataSet: TIBCustomDataSet);
142 <    destructor Destroy; override;
143 <  end;
144 <
145 <  { TIBCustomDataSet }
146 <  TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
147 <
148 <  TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
149 <                                 UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
150 <                                 of object;
151 <  TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
152 <                                   var UpdateAction: TIBUpdateAction) of object;
153 <
154 <  TIBUpdateRecordTypes = set of TCachedUpdateStatus;
155 <
156 <  TIBCustomDataSet = class(TDataset)
157 <  private
158 <    FNeedsRefresh: Boolean;
159 <    FForcedRefresh: Boolean;
160 <    FDidActivate: Boolean;
161 <    FIBLoaded: Boolean;
162 <    FBase: TIBBase;
163 <    FBlobCacheOffset: Integer;
164 <    FBlobStreamList: TList;
165 <    FBufferChunks: Integer;
166 <    FBufferCache,
167 <    FOldBufferCache: PChar;
168 <    FBufferChunkSize,
169 <    FCacheSize,
170 <    FOldCacheSize: Integer;
171 <    FFilterBuffer: PChar;
172 <    FBPos,
173 <    FOBPos,
174 <    FBEnd,
175 <    FOBEnd: DWord;
176 <    FCachedUpdates: Boolean;
177 <    FCalcFieldsOffset: Integer;
178 <    FCurrentRecord: Long;
179 <    FDeletedRecords: Long;
180 <    FModelBuffer,
181 <    FOldBuffer: PChar;
182 <    FOpen: Boolean;
183 <    FInternalPrepared: Boolean;
184 <    FQDelete,
185 <    FQInsert,
186 <    FQRefresh,
187 <    FQSelect,
188 <    FQModify: TIBSQL;
189 <    FRecordBufferSize: Integer;
190 <    FRecordCount: Integer;
191 <    FRecordSize: Integer;
192 <    FUniDirectional: Boolean;
193 <    FUpdateMode: TUpdateMode;
194 <    FUpdateObject: TIBDataSetUpdateObject;
195 <    FParamCheck: Boolean;
196 <    FUpdatesPending: Boolean;
197 <    FUpdateRecordTypes: TIBUpdateRecordTypes;
198 <    FMappedFieldPosition: array of Integer;
199 <    FDataLink: TIBDataLink;
200 <
201 <    FBeforeDatabaseDisconnect,
202 <    FAfterDatabaseDisconnect,
203 <    FDatabaseFree: TNotifyEvent;
204 <    FOnUpdateError: TIBUpdateErrorEvent;
205 <    FOnUpdateRecord: TIBUpdateRecordEvent;
206 <    FBeforeTransactionEnd,
207 <    FAfterTransactionEnd,
208 <    FTransactionFree: TNotifyEvent;
209 <
210 <    function GetSelectStmtHandle: TISC_STMT_HANDLE;
211 <    procedure SetUpdateMode(const Value: TUpdateMode);
212 <    procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
213 <
214 <    function AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode): TGetResult;
215 <    procedure AdjustRecordOnInsert(Buffer: Pointer);
216 <    function CanEdit: Boolean;
217 <    function CanInsert: Boolean;
218 <    function CanDelete: Boolean;
219 <    function CanRefresh: Boolean;
220 <    procedure CheckEditState;
221 <    procedure ClearBlobCache;
222 <    procedure CopyRecordBuffer(Source, Dest: Pointer);
223 <    procedure DoBeforeDatabaseDisconnect(Sender: TObject);
224 <    procedure DoAfterDatabaseDisconnect(Sender: TObject);
225 <    procedure DoDatabaseFree(Sender: TObject);
226 <    procedure DoBeforeTransactionEnd(Sender: TObject);
227 <    procedure DoAfterTransactionEnd(Sender: TObject);
228 <    procedure DoTransactionFree(Sender: TObject);
229 <    procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
230 <                                         Buffer: PChar);
231 <    function GetDatabase: TIBDatabase;
232 <    function GetDBHandle: PISC_DB_HANDLE;
233 <    function GetDeleteSQL: TStrings;
234 <    function GetInsertSQL: TStrings;
235 <    function GetSQLParams: TIBXSQLDA;
236 <    function GetRefreshSQL: TStrings;
237 <    function GetSelectSQL: TStrings;
238 <    function GetStatementType: TIBSQLTypes;
239 <    function GetModifySQL: TStrings;
240 <    function GetTransaction: TIBTransaction;
241 <    function GetTRHandle: PISC_TR_HANDLE;
242 <    procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
243 <    function InternalLocate(const KeyFields: string; const KeyValues: Variant;
244 <                            Options: TLocateOptions): Boolean; virtual;
245 <    procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
246 <    procedure InternalRevertRecord(RecordNumber: Integer);
247 <    function IsVisible(Buffer: PChar): Boolean;
248 <    procedure SaveOldBuffer(Buffer: PChar);
249 <    procedure SetBufferChunks(Value: Integer);
250 <    procedure SetDatabase(Value: TIBDatabase);
251 <    procedure SetDeleteSQL(Value: TStrings);
252 <    procedure SetInsertSQL(Value: TStrings);
253 <    procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
254 <    procedure SetRefreshSQL(Value: TStrings);
255 <    procedure SetSelectSQL(Value: TStrings);
256 <    procedure SetModifySQL(Value: TStrings);
257 <    procedure SetTransaction(Value: TIBTransaction);
258 <    procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
259 <    procedure SetUniDirectional(Value: Boolean);
260 <    procedure RefreshParams;
261 <    procedure SQLChanging(Sender: TObject); virtual;
262 <    function AdjustPosition(FCache: PChar; Offset: DWORD;
263 <                            Origin: Integer): Integer;
264 <    procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
265 <                       Buffer: PChar);
266 <    procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
267 <                              ReadOldBuffer: Boolean);
268 <    procedure WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer;
269 <                        Buffer: PChar);
270 <    procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
271 <    function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
272 <                       DoCheck: Boolean): TGetResult;
273 <
274 <  protected
275 <    procedure ActivateConnection;
276 <    function ActivateTransaction: Boolean;
277 <    procedure DeactivateTransaction;
278 <    procedure CheckDatasetClosed;
279 <    procedure CheckDatasetOpen;
280 <    function GetActiveBuf: PChar;
281 <    procedure InternalBatchInput(InputObject: TIBBatchInput);
282 <    procedure InternalBatchOutput(OutputObject: TIBBatchOutput);
283 <    procedure InternalPrepare; virtual;
284 <    procedure InternalUnPrepare; virtual;
285 <    procedure InternalExecQuery; virtual;
286 <    procedure InternalRefreshRow; virtual;
287 <    procedure InternalSetParamsFromCursor;
288 <    procedure CheckNotUniDirectional;
289 <
290 <    { IProviderSupport }
291 <    procedure PSEndTransaction(Commit: Boolean); override;
292 <    function PSExecuteStatement(const ASQL: string; AParams: TParams;
293 <      ResultSet: Pointer = nil): Integer; override;
294 <    function PsGetTableName: string; override;
295 <    function PSGetQuoteChar: string; override;
296 <    function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
297 <    function PSInTransaction: Boolean; override;
298 <    function PSIsSQLBased: Boolean; override;
299 <    function PSIsSQLSupported: Boolean; override;
300 <    procedure PSStartTransaction; override;
301 <    procedure PSReset; override;
302 <    function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
303 <
304 <    { TDataSet support }
305 <    procedure InternalInsert; override;
306 <    procedure InitRecord(Buffer: PChar); override;
307 <    procedure Disconnect; virtual;
308 <    function ConstraintsStored: Boolean;
309 <    procedure ClearCalcFields(Buffer: PChar); override;
310 <    function AllocRecordBuffer: PChar; override;
311 <    procedure DoBeforeDelete; override;
312 <    procedure DoBeforeEdit; override;
313 <    procedure DoBeforeInsert; override;
314 <    procedure FreeRecordBuffer(var Buffer: PChar); override;
315 <    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
316 <    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
317 <    function GetCanModify: Boolean; override;
318 <    function GetDataSource: TDataSource; override;
319 <    function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
320 <    function GetRecNo: Integer; override;
321 <    function GetRecord(Buffer: PChar; GetMode: TGetMode;
322 <                       DoCheck: Boolean): TGetResult; override;
323 <    function GetRecordCount: Integer; override;
324 <    function GetRecordSize: Word; override;
325 <    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
326 <    procedure InternalCancel; override;
327 <    procedure InternalClose; override;
328 <    procedure InternalDelete; override;
329 <    procedure InternalFirst; override;
330 <    function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
331 <    procedure InternalGotoBookmark(Bookmark: Pointer); override;
332 <    procedure InternalHandleException; override;
333 <    procedure InternalInitFieldDefs; override;
334 <    procedure InternalInitRecord(Buffer: PChar); override;
335 <    procedure InternalLast; override;
336 <    procedure InternalOpen; override;
337 <    procedure InternalPost; override;
338 <    procedure InternalRefresh; override;
339 <    procedure InternalSetFieldData(Field: TField; Buffer: Pointer);
340 <    procedure InternalSetToRecord(Buffer: PChar); override;
341 <    function IsCursorOpen: Boolean; override;
342 <    procedure ReQuery;
343 <    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
344 <    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
345 <    procedure SetCachedUpdates(Value: Boolean);
346 <    procedure SetDataSource(Value: TDataSource);
347 <    procedure SetFieldData(Field : TField; Buffer : Pointer); override;
348 <    procedure SetFieldData(Field : TField; Buffer : Pointer;
349 <      NativeFormat : Boolean); overload; override;
350 <    procedure SetRecNo(Value: Integer); override;
351 <
352 <  protected
353 <    {Likely to be made public by descendant classes}
354 <    property SQLParams: TIBXSQLDA read GetSQLParams;
355 <    property Params: TIBXSQLDA read GetSQLParams;
356 <    property InternalPrepared: Boolean read FInternalPrepared;
357 <    property QDelete: TIBSQL read FQDelete;
358 <    property QInsert: TIBSQL read FQInsert;
359 <    property QRefresh: TIBSQL read FQRefresh;
360 <    property QSelect: TIBSQL read FQSelect;
361 <    property QModify: TIBSQL read FQModify;
362 <    property StatementType: TIBSQLTypes read GetStatementType;
363 <    property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
364 <
365 <    {Likely to be made published by descendant classes}
366 <    property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
367 <    property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
368 <    property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
369 <    property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
370 <    property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
371 <    property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
372 <    property SelectSQL: TStrings read GetSelectSQL write SetSelectSQL;
373 <    property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
374 <    property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
375 <    property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
376 <
377 <    property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
378 <                                                 write FBeforeDatabaseDisconnect;
379 <    property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
380 <                                                write FAfterDatabaseDisconnect;
381 <    property DatabaseFree: TNotifyEvent read FDatabaseFree
382 <                                        write FDatabaseFree;
383 <    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
384 <                                             write FBeforeTransactionEnd;
385 <    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
386 <                                            write FAfterTransactionEnd;
387 <    property TransactionFree: TNotifyEvent read FTransactionFree
388 <                                           write FTransactionFree;
389 <
390 <  public
391 <    constructor Create(AOwner: TComponent); override;
392 <    destructor Destroy; override;
393 <    procedure ApplyUpdates;
394 <    function CachedUpdateStatus: TCachedUpdateStatus;
395 <    procedure CancelUpdates;
396 <    procedure FetchAll;
397 <    function LocateNext(const KeyFields: string; const KeyValues: Variant;
398 <                        Options: TLocateOptions): Boolean;
399 <    procedure RecordModified(Value: Boolean);
400 <    procedure RevertRecord;
401 <    procedure Undelete;
402 <
403 <    { TDataSet support methods }
404 <    function BookmarkValid(Bookmark: TBookmark): Boolean; override;
405 <    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
406 <    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
407 <    function GetCurrentRecord(Buffer: PChar): Boolean; override;
408 <    function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
409 <    function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
410 <    function GetFieldData(Field : TField; Buffer : Pointer;
411 <      NativeFormat : Boolean) : Boolean; overload; override;
412 <    function Locate(const KeyFields: string; const KeyValues: Variant;
413 <                    Options: TLocateOptions): Boolean; override;
414 <    function Lookup(const KeyFields: string; const KeyValues: Variant;
415 <                    const ResultFields: string): Variant; override;
416 <    function UpdateStatus: TUpdateStatus; override;
417 <    function IsSequenced: Boolean; override;
418 <
419 <    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
420 <    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
421 <    property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
422 <    property UpdatesPending: Boolean read FUpdatesPending;
423 <    property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
424 <                                                      write SetUpdateRecordTypes;
425 <
426 <  published
427 <    property Database: TIBDatabase read GetDatabase write SetDatabase;
428 <    property Transaction: TIBTransaction read GetTransaction
429 <                                          write SetTransaction;
430 <    property ForcedRefresh: Boolean read FForcedRefresh
431 <                                    write FForcedRefresh default False;
432 <    property AutoCalcFields;
433 <    property ObjectView default False;
434 <
435 <    property AfterCancel;
436 <    property AfterClose;
437 <    property AfterDelete;
438 <    property AfterEdit;
439 <    property AfterInsert;
440 <    property AfterOpen;
441 <    property AfterPost;
442 <    property AfterRefresh;
443 <    property AfterScroll;
444 <    property BeforeCancel;
445 <    property BeforeClose;
446 <    property BeforeDelete;
447 <    property BeforeEdit;
448 <    property BeforeInsert;
449 <    property BeforeOpen;
450 <    property BeforePost;
451 <    property BeforeRefresh;
452 <    property BeforeScroll;
453 <    property OnCalcFields;
454 <    property OnDeleteError;
455 <    property OnEditError;
456 <    property OnNewRecord;
457 <    property OnPostError;
458 <    property OnUpdateError: TIBUpdateErrorEvent read FOnUpdateError
459 <                                                 write FOnUpdateError;
460 <    property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord
461 <                                                   write FOnUpdateRecord;
462 <  end;
463 <
464 <  TIBDataSet = class(TIBCustomDataSet)
465 <  private
466 <    function GetPrepared: Boolean;
467 <
468 <  protected
469 <    procedure SetFiltered(Value: Boolean); override;
470 <    procedure InternalOpen; override;
471 <
472 <  public
473 <    procedure Prepare;
474 <    procedure UnPrepare;
475 <    procedure BatchInput(InputObject: TIBBatchInput);
476 <    procedure BatchOutput(OutputObject: TIBBatchOutput);
477 <    procedure ExecSQL;
478 <
479 <  public
480 <    property Params;
481 <    property Prepared : Boolean read GetPrepared;
482 <    property QDelete;
483 <    property QInsert;
484 <    property QRefresh;
485 <    property QSelect;
486 <    property QModify;
487 <    property StatementType;
488 <    property SelectStmtHandle;
489 <
490 <  published
491 <    { TIBCustomDataSet }
492 <    property BufferChunks;
493 <    property CachedUpdates;
494 <    property DeleteSQL;
495 <    property InsertSQL;
496 <    property RefreshSQL;
497 <    property SelectSQL;
498 <    property ModifySQL;
499 <    property ParamCheck;
500 <    property UniDirectional;
501 <    property Filtered;
502 <
503 <    property BeforeDatabaseDisconnect;
504 <    property AfterDatabaseDisconnect;
505 <    property DatabaseFree;
506 <    property BeforeTransactionEnd;
507 <    property AfterTransactionEnd;
508 <    property TransactionFree;
509 <
510 <    { TIBDataSet }
511 <    property Active;
512 <    property AutoCalcFields;
513 <    property DataSource read GetDataSource write SetDataSource;
514 <
515 <    property AfterCancel;
516 <    property AfterClose;
517 <    property AfterDelete;
518 <    property AfterEdit;
519 <    property AfterInsert;
520 <    property AfterOpen;
521 <    property AfterPost;
522 <    property AfterScroll;
523 <    property BeforeCancel;
524 <    property BeforeClose;
525 <    property BeforeDelete;
526 <    property BeforeEdit;
527 <    property BeforeInsert;
528 <    property BeforeOpen;
529 <    property BeforePost;
530 <    property BeforeScroll;
531 <    property OnCalcFields;
532 <    property OnDeleteError;
533 <    property OnEditError;
534 <    property OnFilterRecord;
535 <    property OnNewRecord;
536 <    property OnPostError;
537 <  end;
538 <
539 <  { TIBDSBlobStream }
540 <  TIBDSBlobStream = class(TStream)
541 <  protected
542 <    FField: TField;
543 <    FBlobStream: TIBBlobStream;
544 <  public
545 <    constructor Create(AField: TField; ABlobStream: TIBBlobStream;
546 <                       Mode: TBlobStreamMode);
547 <    function Read(var Buffer; Count: Longint): Longint; override;
548 <    function Seek(Offset: Longint; Origin: Word): Longint; override;
549 <    procedure SetSize(NewSize: Longint); override;
550 <    function Write(const Buffer; Count: Longint): Longint; override;
551 <  end;
552 <
553 < const
554 < DefaultFieldClasses: array[TFieldType] of TFieldClass = (
555 <    nil,                { ftUnknown }
556 <    TIBStringField,     { ftString }
557 <    TSmallintField,     { ftSmallint }
558 <    TIntegerField,      { ftInteger }
559 <    TWordField,         { ftWord }
560 <    TBooleanField,      { ftBoolean }
561 <    TFloatField,        { ftFloat }
562 <    TCurrencyField,     { ftCurrency }
563 <    TIBBCDField,        { ftBCD }
564 <    TDateField,         { ftDate }
565 <    TTimeField,         { ftTime }
566 <    TDateTimeField,     { ftDateTime }
567 <    TBytesField,        { ftBytes }
568 <    TVarBytesField,     { ftVarBytes }
569 <    TAutoIncField,      { ftAutoInc }
570 <    TBlobField,         { ftBlob }
571 <    TMemoField,         { ftMemo }
572 <    TGraphicField,      { ftGraphic }
573 <    TBlobField,         { ftFmtMemo }
574 <    TBlobField,         { ftParadoxOle }
575 <    TBlobField,         { ftDBaseOle }
576 <    TBlobField,         { ftTypedBinary }
577 <    nil,                { ftCursor }
578 <    TStringField,       { ftFixedChar }
579 <    nil, {TWideStringField } { ftWideString }
580 <    TLargeIntField,     { ftLargeInt }
581 <    TADTField,          { ftADT }
582 <    TArrayField,        { ftArray }
583 <    TReferenceField,    { ftReference }
584 <    TDataSetField,     { ftDataSet }
585 <    TBlobField,         { ftOraBlob }
586 <    TMemoField,         { ftOraClob }
587 <    TVariantField,      { ftVariant }
588 <    TInterfaceField,    { ftInterface }
589 <    TIDispatchField,     { ftIDispatch }
590 <    TGuidField);        { ftGuid }
591 < var
592 <  CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;
593 <
594 < implementation
595 <
596 < uses IBIntf, IBQuery;
597 <
598 < type
599 <
600 <  TFieldNode = class(TObject)
601 <  protected
602 <    FieldName : String;
603 <    COMPUTED_BLR : Boolean;
604 <    DEFAULT_VALUE : boolean;
605 <    NextField : TFieldNode;
606 <  end;
607 <
608 <  TRelationNode = class(TObject)
609 <  protected
610 <    RelationName : String;
611 <    FieldNodes : TFieldNode;
612 <    NextRelation : TRelationNode;
613 <  end;
614 <
615 <
616 < { TIBStringField}
617 <
618 < constructor TIBStringField.Create(AOwner: TComponent);
619 < begin
620 <  inherited;
621 < end;
622 <
623 < class procedure TIBStringField.CheckTypeSize(Value: Integer);
624 < begin
625 <  { don't check string size. all sizes valid }
626 < end;
627 <
628 < function TIBStringField.GetAsString: string;
629 < begin
630 <  if not GetValue(Result) then Result := '';
631 < end;
632 <
633 < function TIBStringField.GetAsVariant: Variant;
634 < var
635 <  S: string;
636 < begin
637 <  if GetValue(S) then Result := S else Result := Null;
638 < end;
639 <
640 < function TIBStringField.GetValue(var Value: string): Boolean;
641 < var
642 <  Buffer: PChar;
643 < begin
644 <  Buffer := nil;
645 <  IBAlloc(Buffer, 0, Size + 1);
646 <  try
647 <    Result := GetData(Buffer);
648 <    if Result then
649 <    begin
650 <      Value := string(Buffer);
651 <      if Transliterate and (Value <> '') then
652 <        DataSet.Translate(PChar(Value), PChar(Value), False);
653 <    end
654 <  finally
655 <    FreeMem(Buffer);
656 <  end;
657 < end;
658 <
659 < procedure TIBStringField.SetAsString(const Value: string);
660 < var
661 <  Buffer: PChar;
662 < begin
663 <  Buffer := nil;
664 <  IBAlloc(Buffer, 0, Size + 1);
665 <  try
666 <    StrLCopy(Buffer, PChar(Value), Size);
667 <    if Transliterate then
668 <      DataSet.Translate(Buffer, Buffer, True);
669 <    SetData(Buffer);
670 <  finally
671 <    FreeMem(Buffer);
672 <  end;
673 < end;
674 <
675 < { TIBBCDField }
676 <
677 < constructor TIBBCDField.Create(AOwner: TComponent);
678 < begin
679 <  inherited Create(AOwner);
680 <  SetDataType(ftBCD);
681 <  Size := 8;
682 < end;
683 <
684 < class procedure TIBBCDField.CheckTypeSize(Value: Integer);
685 < begin
686 < { No need to check as the base type is currency, not BCD }
687 < end;
688 <
689 < function TIBBCDField.GetAsCurrency: Currency;
690 < begin
691 <  if not GetValue(Result) then
692 <    Result := 0;
693 < end;
694 <
695 < function TIBBCDField.GetAsString: string;
696 < var
697 <  C: System.Currency;
698 < begin
699 <  if GetValue(C) then
700 <    Result := CurrToStr(C)
701 <  else
702 <    Result := '';
703 < end;
704 <
705 < function TIBBCDField.GetAsVariant: Variant;
706 < var
707 <  C: System.Currency;
708 < begin
709 <  if GetValue(C) then
710 <    Result := C
711 <  else
712 <    Result := Null;
713 < end;
714 <
715 < function TIBBCDField.GetDataSize: Integer;
716 < begin
717 <  Result := 8;
718 < end;
719 <
720 < { TIBDataLink }
721 <
722 < constructor TIBDataLink.Create(ADataSet: TIBCustomDataSet);
723 < begin
724 <  inherited Create;
725 <  FDataSet := ADataSet;
726 < end;
727 <
728 < destructor TIBDataLink.Destroy;
729 < begin
730 <  FDataSet.FDataLink := nil;
731 <  inherited;
732 < end;
733 <
734 <
735 < procedure TIBDataLink.ActiveChanged;
736 < begin
737 <  if FDataSet.Active then
738 <    FDataSet.RefreshParams;
739 < end;
740 <
741 <
742 < function TIBDataLink.GetDetailDataSet: TDataSet;
743 < begin
744 <  Result := FDataSet;
745 < end;
746 <
747 < procedure TIBDataLink.RecordChanged(Field: TField);
748 < begin
749 <  if (Field = nil) and FDataSet.Active then
750 <    FDataSet.RefreshParams;
751 < end;
752 <
753 < procedure TIBDataLink.CheckBrowseMode;
754 < begin
755 <  if FDataSet.Active then
756 <    FDataSet.CheckBrowseMode;
757 < end;
758 <
759 < { TIBCustomDataSet }
760 <
761 < constructor TIBCustomDataSet.Create(AOwner: TComponent);
762 < begin
763 <  inherited;
764 <  FIBLoaded := False;
765 <  CheckIBLoaded;
766 <  FIBLoaded := True;
767 <  FBase := TIBBase.Create(Self);
768 <  FCurrentRecord := -1;
769 <  FDeletedRecords := 0;
770 <  FUniDirectional := False;
771 <  FBufferChunks := BufferCacheSize;
772 <  FBlobStreamList := TList.Create;
773 <  FDataLink := TIBDataLink.Create(Self);
774 <  FQDelete := TIBSQL.Create(Self);
775 <  FQDelete.OnSQLChanging := SQLChanging;
776 <  FQDelete.GoToFirstRecordOnExecute := False;
777 <  FQInsert := TIBSQL.Create(Self);
778 <  FQInsert.OnSQLChanging := SQLChanging;
779 <  FQInsert.GoToFirstRecordOnExecute := False;
780 <  FQRefresh := TIBSQL.Create(Self);
781 <  FQRefresh.OnSQLChanging := SQLChanging;
782 <  FQRefresh.GoToFirstRecordOnExecute := False;
783 <  FQSelect := TIBSQL.Create(Self);
784 <  FQSelect.OnSQLChanging := SQLChanging;
785 <  FQSelect.GoToFirstRecordOnExecute := False;
786 <  FQModify := TIBSQL.Create(Self);
787 <  FQModify.OnSQLChanging := SQLChanging;
788 <  FQModify.GoToFirstRecordOnExecute := False;
789 <  FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
790 <  FParamCheck := True;
791 <  FForcedRefresh := False;
792 <  {Bookmark Size is Integer for IBX}
793 <  BookmarkSize := SizeOf(Integer);
794 <  FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
795 <  FBase.AfterDatabaseDisconnect := DoAfterDatabaseDisconnect;
796 <  FBase.OnDatabaseFree := DoDatabaseFree;
797 <  FBase.BeforeTransactionEnd := DoBeforeTransactionEnd;
798 <  FBase.AfterTransactionEnd := DoAfterTransactionEnd;
799 <  FBase.OnTransactionFree := DoTransactionFree;
800 <  if AOwner is TIBDatabase then
801 <    Database := TIBDatabase(AOwner)
802 <  else
803 <    if AOwner is TIBTransaction then
804 <      Transaction := TIBTransaction(AOwner);
805 < end;
806 <
807 < destructor TIBCustomDataSet.Destroy;
808 < begin
809 <  inherited;
810 <  if FIBLoaded then
811 <  begin
812 <    FDataLink.Free;
813 <    FBase.Free;
814 <    ClearBlobCache;
815 <    FBlobStreamList.Free;
816 <    FreeMem(FBufferCache);
817 <    FBufferCache := nil;
818 <    FreeMem(FOldBufferCache);
819 <    FOldBufferCache := nil;
820 <    FCacheSize := 0;
821 <    FOldCacheSize := 0;
822 <    FMappedFieldPosition := nil;
823 <  end;
824 < end;
825 <
826 < function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
827 <                                             TGetResult;
828 < begin
829 <  while not IsVisible(Buffer) do
830 <  begin
831 <    if GetMode = gmPrior then
832 <    begin
833 <      Dec(FCurrentRecord);
834 <      if FCurrentRecord = -1 then
835 <      begin
836 <        result := grBOF;
837 <        exit;
838 <      end;
839 <      ReadRecordCache(FCurrentRecord, Buffer, False);
840 <    end
841 <    else begin
842 <      Inc(FCurrentRecord);
843 <      if (FCurrentRecord = FRecordCount) then
844 <      begin
845 <        if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
846 <        begin
847 <          FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
848 <          Inc(FRecordCount);
849 <        end
850 <        else begin
851 <          result := grEOF;
852 <          exit;
853 <        end;
854 <      end
855 <      else
856 <        ReadRecordCache(FCurrentRecord, Buffer, False);
857 <    end;
858 <  end;
859 <  result := grOK;
860 < end;
861 <
862 < procedure TIBCustomDataSet.ApplyUpdates;
863 < var
864 <  CurBookmark: string;
865 <  Buffer: PRecordData;
866 <  CurUpdateTypes: TIBUpdateRecordTypes;
867 <  UpdateAction: TIBUpdateAction;
868 <  UpdateKind: TUpdateKind;
869 <  bRecordsSkipped: Boolean;
870 <
871 <  procedure GetUpdateKind;
872 <  begin
873 <    case Buffer^.rdCachedUpdateStatus of
874 <      cusModified:
875 <        UpdateKind := ukModify;
876 <      cusInserted:
877 <        UpdateKind := ukInsert;
878 <      else
879 <        UpdateKind := ukDelete;
880 <    end;
881 <  end;
882 <
883 <  procedure ResetBufferUpdateStatus;
884 <  begin
885 <    case Buffer^.rdCachedUpdateStatus of
886 <      cusModified:
887 <      begin
888 <        PRecordData(Buffer)^.rdUpdateStatus := usUnmodified;
889 <        PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
890 <      end;
891 <      cusInserted:
892 <      begin
893 <        PRecordData(Buffer)^.rdUpdateStatus := usUnmodified;
894 <        PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
895 <      end;
896 <      cusDeleted:
897 <      begin
898 <        PRecordData(Buffer)^.rdUpdateStatus := usDeleted;
899 <        PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
900 <      end;
901 <    end;
902 <    WriteRecordCache(PRecordData(Buffer)^.rdRecordNumber, Pointer(Buffer));
903 <  end;
904 <
905 <  procedure UpdateUsingOnUpdateRecord;
906 <  begin
907 <    UpdateAction := uaFail;
908 <    try
909 <      FOnUpdateRecord(Self, UpdateKind, UpdateAction);
910 <    except
911 <      on E: Exception do
912 <      begin
913 <        if (E is EDatabaseError) and Assigned(FOnUpdateError) then
914 <          FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);
915 <        if UpdateAction = uaFail then
916 <            raise;
917 <      end;
918 <    end;
919 <  end;
920 <
921 <  procedure UpdateUsingUpdateObject;
922 <  begin
923 <    try
924 <      FUpdateObject.Apply(UpdateKind);
925 <      ResetBufferUpdateStatus;
926 <    except
927 <      on E: Exception do
928 <        if (E is EDatabaseError) and Assigned(FOnUpdateError) then
929 <          FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);
930 <    end;
931 <  end;
932 <
933 <  procedure UpdateUsingInternalquery;
934 <  begin
935 <    try
936 <      case Buffer^.rdCachedUpdateStatus of
937 <        cusModified:
938 <          InternalPostRecord(FQModify, Buffer);
939 <        cusInserted:
940 <          InternalPostRecord(FQInsert, Buffer);
941 <        cusDeleted:
942 <          InternalDeleteRecord(FQDelete, Buffer);
943 <      end;
944 <    except
945 <      on E: EIBError do begin
946 <        UpdateAction := uaFail;
947 <        if Assigned(FOnUpdateError) then
948 <          FOnUpdateError(Self, E, UpdateKind, UpdateAction);
949 <        case UpdateAction of
950 <          uaFail: raise;
951 <          uaAbort: SysUtils.Abort;
952 <          uaSkip: bRecordsSkipped := True;
953 <        end;
954 <      end;
955 <    end;
956 <  end;
957 <
958 < begin
959 <  if State in [dsEdit, dsInsert] then
960 <    Post;
961 <  FBase.CheckDatabase;
962 <  FBase.CheckTransaction;
963 <  DisableControls;
964 <  CurBookmark := Bookmark;
965 <  CurUpdateTypes := FUpdateRecordTypes;
966 <  FUpdateRecordTypes := [cusModified, cusInserted, cusDeleted];
967 <  try
968 <    First;
969 <    bRecordsSkipped := False;
970 <    while not EOF do
971 <    begin
972 <      Buffer := PRecordData(GetActiveBuf);
973 <      GetUpdateKind;
974 <      UpdateAction := uaApply;
975 <      if Assigned(FUpdateObject) or Assigned(FOnUpdateRecord) then
976 <      begin
977 <        if (Assigned(FOnUpdateRecord)) then
978 <          UpdateUsingOnUpdateRecord
979 <        else
980 <          if Assigned(FUpdateObject) then
981 <            UpdateUsingUpdateObject;
982 <        case UpdateAction of
983 <          uaFail:
984 <            IBError(ibxeUserAbort, [nil]);
985 <          uaAbort:
986 <            SysUtils.Abort;
987 <          uaApplied:
988 <            ResetBufferUpdateStatus;
989 <          uaSkip:
990 <            bRecordsSkipped := True;
991 <          uaRetry:
992 <            Continue;
993 <        end;
994 <      end;
995 <      if (not Assigned(FUpdateObject)) and (UpdateAction = UaApply) then
996 <      begin
997 <        UpdateUsingInternalquery;
998 <        UpdateAction := uaApplied;
999 <      end;
1000 <      Next;
1001 <    end;
1002 <    FUpdatesPending := bRecordsSkipped;
1003 <  finally
1004 <    FUpdateRecordTypes := CurUpdateTypes;
1005 <    Bookmark := CurBookmark;
1006 <    EnableControls;
1007 <  end;
1008 < end;
1009 <
1010 < procedure TIBCustomDataSet.InternalBatchInput(InputObject: TIBBatchInput);
1011 < begin
1012 <  FQSelect.BatchInput(InputObject);
1013 < end;
1014 <
1015 < procedure TIBCustomDataSet.InternalBatchOutput(OutputObject: TIBBatchOutput);
1016 < var
1017 <  Qry: TIBSQL;
1018 < begin
1019 <  Qry := TIBSQL.Create(Self);
1020 <  try
1021 <    Qry.Database := FBase.Database;
1022 <    Qry.Transaction := FBase.Transaction;
1023 <    Qry.SQL.Assign(FQSelect.SQL);
1024 <    Qry.BatchOutput(OutputObject);
1025 <  finally
1026 <    Qry.Free;
1027 <  end;
1028 < end;
1029 <
1030 < procedure TIBCustomDataSet.CancelUpdates;
1031 < var
1032 <  CurUpdateTypes: TIBUpdateRecordTypes;
1033 < begin
1034 <  if State in [dsEdit, dsInsert] then
1035 <    Post;
1036 <  if FCachedUpdates and FUpdatesPending then
1037 <  begin
1038 <    DisableControls;
1039 <    CurUpdateTypes := UpdateRecordTypes;
1040 <    UpdateRecordTypes := [cusModified, cusInserted, cusDeleted];
1041 <    try
1042 <      First;
1043 <      while not EOF do
1044 <      begin
1045 <        if UpdateStatus = usInserted then
1046 <          RevertRecord
1047 <        else
1048 <        begin
1049 <          RevertRecord;
1050 <          Next;
1051 <        end;
1052 <      end;
1053 <    finally
1054 <      UpdateRecordTypes := CurUpdateTypes;
1055 <      First;
1056 <      FUpdatesPending := False;
1057 <      EnableControls;
1058 <    end;
1059 <  end;
1060 < end;
1061 <
1062 < procedure TIBCustomDataSet.ActivateConnection;
1063 < begin
1064 <  if not Assigned(Database) then
1065 <    IBError(ibxeDatabaseNotAssigned, [nil]);
1066 <  if not Assigned(Transaction) then
1067 <    IBError(ibxeTransactionNotAssigned, [nil]);
1068 <  if not Database.Connected then Database.Open;
1069 < end;
1070 <
1071 < function TIBCustomDataSet.ActivateTransaction: Boolean;
1072 < begin
1073 <  Result := False;
1074 <  if not Assigned(Transaction) then
1075 <    IBError(ibxeTransactionNotAssigned, [nil]);
1076 <  if not Transaction.Active then
1077 <  begin
1078 <    Result := True;
1079 <    Transaction.StartTransaction;
1080 <    FDidActivate := True;
1081 <  end;
1082 < end;
1083 <
1084 < procedure TIBCustomDataSet.DeactivateTransaction;
1085 < var
1086 <  i: Integer;
1087 < begin
1088 <  if not Assigned(Transaction) then
1089 <    IBError(ibxeTransactionNotAssigned, [nil]);
1090 <  with Transaction do
1091 <  begin
1092 <    for i := 0 to SQLObjectCount - 1 do
1093 <    begin
1094 <      if (SQLObjects[i] <> nil) and ((SQLObjects[i]).owner is TDataSet) then
1095 <      begin
1096 <        if TDataSet(SQLObjects[i].owner).Active then
1097 <        begin
1098 <          FDidActivate := False;
1099 <          exit;
1100 <        end;
1101 <      end;
1102 <    end;
1103 <  end;
1104 <  FInternalPrepared := False;
1105 <  if Transaction.InTransaction then
1106 <    Transaction.Commit;
1107 <  FDidActivate := False;
1108 < end;
1109 <
1110 < procedure TIBCustomDataSet.CheckDatasetClosed;
1111 < begin
1112 <  if FOpen then
1113 <    IBError(ibxeDatasetOpen, [nil]);
1114 < end;
1115 <
1116 < procedure TIBCustomDataSet.CheckDatasetOpen;
1117 < begin
1118 <  if not FOpen then
1119 <    IBError(ibxeDatasetClosed, [nil]);
1120 < end;
1121 <
1122 < procedure TIBCustomDataSet.CheckNotUniDirectional;
1123 < begin
1124 <  if UniDirectional then
1125 <    IBError(ibxeDataSetUniDirectional, [nil]);
1126 < end;
1127 <
1128 < procedure TIBCustomDataSet.AdjustRecordOnInsert(Buffer: Pointer);
1129 < begin
1130 <  with PRecordData(Buffer)^ do
1131 <    if (State = dsInsert) and (not Modified) then
1132 <    begin
1133 <      rdRecordNumber := FRecordCount;
1134 <      FCurrentRecord := FRecordCount;
1135 <    end;
1136 < end;
1137 <
1138 < function TIBCustomDataSet.CanEdit: Boolean;
1139 < var
1140 <  Buff: PRecordData;
1141 < begin
1142 <  Buff := PRecordData(GetActiveBuf);
1143 <  result := (FQModify.SQL.Text <> '') or
1144 <    (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukModify).Text <> '')) or
1145 <    ((Buff <> nil) and (Buff^.rdCachedUpdateStatus = cusInserted) and
1146 <      (FCachedUpdates));
1147 < end;
1148 <
1149 < function TIBCustomDataSet.CanInsert: Boolean;
1150 < begin
1151 <  result := (FQInsert.SQL.Text <> '') or
1152 <    (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukInsert).Text <> ''));
1153 < end;
1154 <
1155 < function TIBCustomDataSet.CanDelete: Boolean;
1156 < begin
1157 <  if (FQDelete.SQL.Text <> '') or
1158 <    (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
1159 <    result := True
1160 <  else
1161 <    result := False;
1162 < end;
1163 <
1164 < function TIBCustomDataSet.CanRefresh: Boolean;
1165 < begin
1166 <  result := (FQRefresh.SQL.Text <> '') or
1167 <    (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> ''));
1168 < end;
1169 <
1170 < procedure TIBCustomDataSet.CheckEditState;
1171 < begin
1172 <  case State of
1173 <    { Check all the wsEditMode types }
1174 <    dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter,
1175 <    dsNewValue, dsInternalCalc :
1176 <    begin
1177 <      if (State in [dsEdit]) and (not CanEdit) then
1178 <        IBError(ibxeCannotUpdate, [nil]);
1179 <      if (State in [dsInsert]) and (not CanInsert) then
1180 <        IBError(ibxeCannotInsert, [nil]);
1181 <    end;
1182 <  else
1183 <    IBError(ibxeNotEditing, [])
1184 <  end;
1185 < end;
1186 <
1187 < procedure TIBCustomDataSet.ClearBlobCache;
1188 < var
1189 <  i: Integer;
1190 < begin
1191 <  for i := 0 to FBlobStreamList.Count - 1 do
1192 <  begin
1193 <    TIBBlobStream(FBlobStreamList[i]).Free;
1194 <    FBlobStreamList[i] := nil;
1195 <  end;
1196 <  FBlobStreamList.Pack;
1197 < end;
1198 <
1199 < procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1200 < begin
1201 <  Move(Source^, Dest^, FRecordBufferSize);
1202 < end;
1203 <
1204 < procedure TIBCustomDataSet.DoBeforeDatabaseDisconnect(Sender: TObject);
1205 < begin
1206 <  if Active then
1207 <    Active := False;
1208 <  FInternalPrepared := False;
1209 <  if Assigned(FBeforeDatabaseDisconnect) then
1210 <    FBeforeDatabaseDisconnect(Sender);
1211 < end;
1212 <
1213 < procedure TIBCustomDataSet.DoAfterDatabaseDisconnect(Sender: TObject);
1214 < begin
1215 <  if Assigned(FAfterDatabaseDisconnect) then
1216 <    FAfterDatabaseDisconnect(Sender);
1217 < end;
1218 <
1219 < procedure TIBCustomDataSet.DoDatabaseFree(Sender: TObject);
1220 < begin
1221 <  if Assigned(FDatabaseFree) then
1222 <    FDatabaseFree(Sender);
1223 < end;
1224 <
1225 < procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1226 < begin
1227 <  if Active then
1228 <    Active := False;
1229 <  if FQSelect <> nil then
1230 <    FQSelect.FreeHandle;
1231 <  if FQDelete <> nil then
1232 <    FQDelete.FreeHandle;
1233 <  if FQInsert <> nil then
1234 <    FQInsert.FreeHandle;
1235 <  if FQModify <> nil then
1236 <    FQModify.FreeHandle;
1237 <  if FQRefresh <> nil then
1238 <    FQRefresh.FreeHandle;
1239 <  if Assigned(FBeforeTransactionEnd) then
1240 <    FBeforeTransactionEnd(Sender);
1241 < end;
1242 <
1243 < procedure TIBCustomDataSet.DoAfterTransactionEnd(Sender: TObject);
1244 < begin
1245 <  if Assigned(FAfterTransactionEnd) then
1246 <    FAfterTransactionEnd(Sender);
1247 < end;
1248 <
1249 < procedure TIBCustomDataSet.DoTransactionFree(Sender: TObject);
1250 < begin
1251 <  if Assigned(FTransactionFree) then
1252 <    FTransactionFree(Sender);
1253 < end;
1254 <
1255 < { Read the record from FQSelect.Current into the record buffer
1256 <  Then write the buffer to in memory cache }
1257 < procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1258 <  RecordNumber: Integer; Buffer: PChar);
1259 < var
1260 <  p: PRecordData;
1261 <  pbd: PBlobDataArray;
1262 <  i, j: Integer;
1263 <  LocalData: Pointer;
1264 <  LocalDate, LocalDouble: Double;
1265 <  LocalInt: Integer;
1266 <  LocalInt64: Int64;
1267 <  LocalCurrency: Currency;
1268 <  FieldsLoaded: Integer;
1269 < begin
1270 <  p := PRecordData(Buffer);
1271 <  { Make sure blob cache is empty }
1272 <  pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1273 <  if RecordNumber > -1 then
1274 <    for i := 0 to BlobFieldCount - 1 do
1275 <      pbd^[i] := nil;
1276 <  { Get record information }
1277 <  p^.rdBookmarkFlag := bfCurrent;
1278 <  p^.rdFieldCount := Qry.Current.Count;
1279 <  p^.rdRecordNumber := RecordNumber;
1280 <  p^.rdUpdateStatus := usUnmodified;
1281 <  p^.rdCachedUpdateStatus := cusUnmodified;
1282 <  p^.rdSavedOffset := $FFFFFFFF;
1283 <
1284 <  { Load up the fields }
1285 <  FieldsLoaded := FQSelect.Current.Count;
1286 <  j := 1;
1287 <  for i := 0 to Qry.Current.Count - 1 do
1288 <  begin
1289 <    if (Qry = FQSelect) then
1290 <      j := i + 1
1291 <    else begin
1292 <      if FieldsLoaded = 0 then
1293 <        break;
1294 <      j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
1295 <      if j < 1 then
1296 <        continue
1297 <      else
1298 <        Dec(FieldsLoaded);
1299 <    end;
1300 <    with FQSelect.Current[j - 1].Data^ do
1301 <      if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
1302 <      begin
1303 <        if sqllen <= 8 then
1304 <          p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
1305 <        continue;
1306 <      end;
1307 <    if j > 0 then with p^ do
1308 <    begin
1309 <      rdFields[j].fdDataType :=
1310 <        Qry.Current[i].Data^.sqltype and (not 1);
1311 <      rdFields[j].fdDataScale :=
1312 <        Qry.Current[i].Data^.sqlscale;
1313 <      rdFields[j].fdNullable :=
1314 <        (Qry.Current[i].Data^.sqltype and 1 = 1);
1315 <      rdFields[j].fdIsNull :=
1316 <        (rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1317 <      LocalData := Qry.Current[i].Data^.sqldata;
1318 <      case rdFields[j].fdDataType of
1319 <        SQL_TIMESTAMP:
1320 <        begin
1321 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1322 <          if RecordNumber >= 0 then
1323 <            LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
1324 <          LocalData := PChar(@LocalDate);
1325 <        end;
1326 <        SQL_TYPE_DATE:
1327 <        begin
1328 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1329 <          if RecordNumber >= 0 then
1330 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
1331 <          LocalData := PChar(@LocalInt);
1332 <        end;
1333 <        SQL_TYPE_TIME:
1334 <        begin
1335 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1336 <          if RecordNumber >= 0 then
1337 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1338 <          LocalData := PChar(@LocalInt);
1339 <        end;
1340 <        SQL_SHORT, SQL_LONG:
1341 <        begin
1342 <          if (rdFields[j].fdDataScale = 0) then
1343 <          begin
1344 <            rdFields[j].fdDataSize := SizeOf(Integer);
1345 <            if RecordNumber >= 0 then
1346 <              LocalInt := Qry.Current[i].AsLong;
1347 <            LocalData := PChar(@LocalInt);
1348 <          end
1349 <          else if (rdFields[j].fdDataScale >= (-4)) then
1350 <               begin
1351 <                 rdFields[j].fdDataSize := SizeOf(Currency);
1352 <                 if RecordNumber >= 0 then
1353 <                   LocalCurrency := Qry.Current[i].AsCurrency;
1354 <                 LocalData := PChar(@LocalCurrency);
1355 <               end
1356 <               else begin
1357 <                 rdFields[j].fdDataSize := SizeOf(Double);
1358 <                 if RecordNumber >= 0 then
1359 <                   LocalDouble := Qry.Current[i].AsDouble;
1360 <                LocalData := PChar(@LocalDouble);
1361 <              end;
1362 <        end;
1363 <        SQL_INT64:
1364 <        begin
1365 <          if (rdFields[j].fdDataScale = 0) then
1366 <          begin
1367 <            rdFields[j].fdDataSize := SizeOf(Int64);
1368 <            if RecordNumber >= 0 then
1369 <              LocalInt64 := Qry.Current[i].AsInt64;
1370 <            LocalData := PChar(@LocalInt64);
1371 <          end
1372 <          else if (rdFields[j].fdDataScale >= (-4)) then
1373 <               begin
1374 <                 rdFields[j].fdDataSize := SizeOf(Currency);
1375 <                 if RecordNumber >= 0 then
1376 <                   LocalCurrency := Qry.Current[i].AsCurrency;
1377 <                   LocalData := PChar(@LocalCurrency);
1378 <               end
1379 <               else begin
1380 <                  rdFields[j].fdDataSize := SizeOf(Double);
1381 <                  if RecordNumber >= 0 then
1382 <                    LocalDouble := Qry.Current[i].AsDouble;
1383 <                  LocalData := PChar(@LocalDouble);
1384 <               end
1385 <        end;
1386 <        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1387 <        begin
1388 <          rdFields[j].fdDataSize := SizeOf(Double);
1389 <          if RecordNumber >= 0 then
1390 <            LocalDouble := Qry.Current[i].AsDouble;
1391 <          LocalData := PChar(@LocalDouble);
1392 <        end;
1393 <        SQL_VARYING:
1394 <        begin
1395 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1396 <          rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1397 <          if RecordNumber >= 0 then
1398 <          begin
1399 <            if (rdFields[j].fdDataLength = 0) then
1400 <              LocalData := nil
1401 <            else
1402 <              LocalData := @Qry.Current[i].Data^.sqldata[2];
1403 <          end;
1404 <        end;
1405 <        else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1406 <        begin
1407 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1408 <          if (rdFields[j].fdDataType = SQL_TEXT) then
1409 <            rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1410 <        end;
1411 <      end;
1412 <      if RecordNumber < 0 then
1413 <      begin
1414 <        rdFields[j].fdIsNull := True;
1415 <        rdFields[j].fdDataOfs := FRecordSize;
1416 <        Inc(FRecordSize, rdFields[j].fdDataSize);
1417 <      end
1418 <      else begin
1419 <        if rdFields[j].fdDataType = SQL_VARYING then
1420 <        begin
1421 <          if LocalData <> nil then
1422 <            Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)
1423 <        end
1424 <        else
1425 <          Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
1426 <      end;
1427 <    end;
1428 <  end;
1429 <  WriteRecordCache(RecordNumber, PChar(p));
1430 < end;
1431 <
1432 < function TIBCustomDataSet.GetActiveBuf: PChar;
1433 < begin
1434 <  case State of
1435 <    dsBrowse:
1436 <      if IsEmpty then
1437 <        result := nil
1438 <      else
1439 <        result := ActiveBuffer;
1440 <    dsEdit, dsInsert:
1441 <      result := ActiveBuffer;
1442 <    dsCalcFields:
1443 <      result := CalcBuffer;
1444 <    dsFilter:
1445 <      result := FFilterBuffer;
1446 <    dsNewValue:
1447 <      result := ActiveBuffer;
1448 <    dsOldValue:
1449 <      if (PRecordData(ActiveBuffer)^.rdRecordNumber =
1450 <        PRecordData(FOldBuffer)^.rdRecordNumber) then
1451 <        result := FOldBuffer
1452 <      else
1453 <        result := ActiveBuffer;
1454 <  else if not FOpen then
1455 <    result := nil
1456 <  else
1457 <    result := ActiveBuffer;
1458 <  end;
1459 < end;
1460 <
1461 < function TIBCustomDataSet.CachedUpdateStatus: TCachedUpdateStatus;
1462 < begin
1463 <  if Active then
1464 <    result := PRecordData(GetActiveBuf)^.rdCachedUpdateStatus
1465 <  else
1466 <    result := cusUnmodified;
1467 < end;
1468 <
1469 < function TIBCustomDataSet.GetDatabase: TIBDatabase;
1470 < begin
1471 <  result := FBase.Database;
1472 < end;
1473 <
1474 < function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1475 < begin
1476 <  result := FBase.DBHandle;
1477 < end;
1478 <
1479 < function TIBCustomDataSet.GetDeleteSQL: TStrings;
1480 < begin
1481 <  result := FQDelete.SQL;
1482 < end;
1483 <
1484 < function TIBCustomDataSet.GetInsertSQL: TStrings;
1485 < begin
1486 <  result := FQInsert.SQL;
1487 < end;
1488 <
1489 < function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
1490 < begin
1491 <  if not FInternalPrepared then
1492 <    InternalPrepare;
1493 <  result := FQSelect.Params;
1494 < end;
1495 <
1496 < function TIBCustomDataSet.GetRefreshSQL: TStrings;
1497 < begin
1498 <  result := FQRefresh.SQL;
1499 < end;
1500 <
1501 < function TIBCustomDataSet.GetSelectSQL: TStrings;
1502 < begin
1503 <  result := FQSelect.SQL;
1504 < end;
1505 <
1506 < function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
1507 < begin
1508 <  result := FQSelect.SQLType;
1509 < end;
1510 <
1511 < function TIBCustomDataSet.GetModifySQL: TStrings;
1512 < begin
1513 <  result := FQModify.SQL;
1514 < end;
1515 <
1516 < function TIBCustomDataSet.GetTransaction: TIBTransaction;
1517 < begin
1518 <  result := FBase.Transaction;
1519 < end;
1520 <
1521 < function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1522 < begin
1523 <  result := FBase.TRHandle;
1524 < end;
1525 <
1526 < procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
1527 < begin
1528 <  if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
1529 <    FUpdateObject.Apply(ukDelete)
1530 <  else
1531 <  begin
1532 <    SetInternalSQLParams(FQDelete, Buff);
1533 <    FQDelete.ExecQuery;
1534 <  end;
1535 <  with PRecordData(Buff)^ do
1536 <  begin
1537 <    rdUpdateStatus := usDeleted;
1538 <    rdCachedUpdateStatus := cusUnmodified;
1539 <  end;
1540 <  WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
1541 < end;
1542 <
1543 < function TIBCustomDataSet.InternalLocate(const KeyFields: string;
1544 <  const KeyValues: Variant; Options: TLocateOptions): Boolean;
1545 < var
1546 <  fl: TList;
1547 <  CurBookmark: string;
1548 <  fld, val: Variant;
1549 <  i, fld_cnt: Integer;
1550 < begin
1551 <  fl := TList.Create;
1552 <  try
1553 <    GetFieldList(fl, KeyFields);
1554 <    fld_cnt := fl.Count;
1555 <    CurBookmark := Bookmark;
1556 <    result := False;
1557 <    while ((not result) and (not EOF)) do
1558 <    begin
1559 <      i := 0;
1560 <      result := True;
1561 <      while (result and (i < fld_cnt)) do
1562 <      begin
1563 <        if fld_cnt > 1 then
1564 <          val := KeyValues[i]
1565 <        else
1566 <          val := KeyValues;
1567 <        fld := TField(fl[i]).Value;
1568 <        result := not (VarIsNull(val) xor VarIsNull(fld));
1569 <        if result and not VarIsNull(val) then
1570 <        begin
1571 <          try
1572 <            fld := VarAsType(fld, VarType(val));
1573 <          except
1574 <            on E: EVariantError do result := False;
1575 <          end;
1576 <          if Result then
1577 <            if TField(fl[i]).DataType = ftString then
1578 <            begin
1579 <              if (loCaseInsensitive in Options) then
1580 <              begin
1581 <                fld := AnsiUpperCase(fld);
1582 <                val := AnsiUpperCase(val);
1583 <              end;
1584 <              fld := TrimRight(fld);
1585 <              val := TrimRight(val);
1586 <              if (loPartialKey in Options) then
1587 <                result := result and (AnsiPos(val, fld) = 1)
1588 <              else
1589 <                result := result and (val = fld);
1590 <            end else
1591 <                result := result and (val = fld);
1592 <        end;
1593 <        Inc(i);
1594 <      end;
1595 <      if not result then
1596 <        Next;
1597 <    end;
1598 <    if not result then
1599 <      Bookmark := CurBookmark
1600 <    else
1601 <      CursorPosChanged;
1602 <  finally
1603 <    fl.Free;
1604 <  end;
1605 < end;
1606 <
1607 < procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
1608 < var
1609 <  i, j, k: Integer;
1610 <  pbd: PBlobDataArray;
1611 < begin
1612 <  pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
1613 <  j := 0;
1614 <  for i := 0 to FieldCount - 1 do
1615 <    if Fields[i].IsBlob then
1616 <    begin
1617 <      k := FMappedFieldPosition[Fields[i].FieldNo -1];
1618 <      if pbd^[j] <> nil then
1619 <      begin
1620 <        pbd^[j].Finalize;
1621 <        PISC_QUAD(
1622 <          PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
1623 <          pbd^[j].BlobID;
1624 <        PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
1625 <      end;
1626 <      Inc(j);
1627 <    end;
1628 <  if Assigned(FUpdateObject) then
1629 <  begin
1630 <    if (Qry = FQDelete) then
1631 <      FUpdateObject.Apply(ukDelete)
1632 <    else if (Qry = FQInsert) then
1633 <      FUpdateObject.Apply(ukInsert)
1634 <    else
1635 <      FUpdateObject.Apply(ukModify);
1636 <  end
1637 <  else begin
1638 <    SetInternalSQLParams(Qry, Buff);
1639 <    Qry.ExecQuery;
1640 <  end;
1641 <  PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
1642 <  PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
1643 <  SetModified(False);
1644 <  WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
1645 <  if (FForcedRefresh or FNeedsRefresh) and CanRefresh then
1646 <    InternalRefreshRow;
1647 < end;
1648 <
1649 < procedure TIBCustomDataSet.InternalRefreshRow;
1650 < var
1651 <  Buff: PChar;
1652 <  SetCursor: Boolean;
1653 <  ofs: DWORD;
1654 <  Qry: TIBSQL;
1655 < begin
1656 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1657 <  if SetCursor then
1658 <    Screen.Cursor := crHourGlass;
1659 <  try
1660 <    Buff := GetActiveBuf;
1661 <    if CanRefresh then
1662 <    begin
1663 <      if Buff <> nil then
1664 <      begin
1665 <        if (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')) then
1666 <        begin
1667 <          Qry := TIBSQL.Create(self);
1668 <          Qry.Database := Database;
1669 <          Qry.Transaction := Transaction;
1670 <          Qry.GoToFirstRecordOnExecute := False;
1671 <          Qry.SQL.Text := FUpdateObject.RefreshSQL.Text;
1672 <        end
1673 <        else
1674 <          Qry := FQRefresh;
1675 <        SetInternalSQLParams(Qry, Buff);
1676 <        Qry.ExecQuery;
1677 <        try
1678 <          if (Qry.SQLType = SQLExecProcedure) or
1679 <             (Qry.Next <> nil) then
1680 <          begin
1681 <            ofs := PRecordData(Buff)^.rdSavedOffset;
1682 <            FetchCurrentRecordToBuffer(Qry,
1683 <                                       PRecordData(Buff)^.rdRecordNumber,
1684 <                                       Buff);
1685 <            if FCachedUpdates and (ofs <> $FFFFFFFF) then
1686 <            begin
1687 <              PRecordData(Buff)^.rdSavedOffset := ofs;
1688 <              WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
1689 <              SaveOldBuffer(Buff);
1690 <            end;
1691 <          end;
1692 <        finally
1693 <          Qry.Close;
1694 <        end;
1695 <        if Qry <> FQRefresh then
1696 <          Qry.Free;
1697 <      end
1698 <    end
1699 <    else
1700 <      IBError(ibxeCannotRefresh, [nil]);
1701 <  finally
1702 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1703 <      Screen.Cursor := crDefault;
1704 <  end;
1705 < end;
1706 <
1707 < procedure TIBCustomDataSet.InternalRevertRecord(RecordNumber: Integer);
1708 < var
1709 <  NewBuffer, OldBuffer: PRecordData;
1710 <
1711 < begin
1712 <  NewBuffer := nil;
1713 <  OldBuffer := nil;
1714 <  NewBuffer := PRecordData(AllocRecordBuffer);
1715 <  OldBuffer := PRecordData(AllocRecordBuffer);
1716 <  try
1717 <    ReadRecordCache(RecordNumber, PChar(NewBuffer), False);
1718 <    ReadRecordCache(RecordNumber, PChar(OldBuffer), True);
1719 <    case NewBuffer^.rdCachedUpdateStatus of
1720 <      cusInserted:
1721 <      begin
1722 <        NewBuffer^.rdCachedUpdateStatus := cusUninserted;
1723 <        Inc(FDeletedRecords);
1724 <      end;
1725 <      cusModified,
1726 <      cusDeleted:
1727 <      begin
1728 <        if (NewBuffer^.rdCachedUpdateStatus = cusDeleted) then
1729 <          Dec(FDeletedRecords);
1730 <        CopyRecordBuffer(OldBuffer, NewBuffer);
1731 <      end;
1732 <    end;
1733 <
1734 <    if State in dsEditModes then
1735 <      Cancel;
1736 <
1737 <    WriteRecordCache(RecordNumber, PChar(NewBuffer));
1738 <
1739 <    if (NewBuffer^.rdCachedUpdateStatus = cusUninserted ) then
1740 <      ReSync([]);
1741 <  finally
1742 <    FreeRecordBuffer(PChar(NewBuffer));
1743 <    FreeRecordBuffer(PChar(OldBuffer));
1744 <  end;
1745 < end;
1746 <
1747 < { A visible record is one that is not truly deleted,
1748 <  and it is also listed in the FUpdateRecordTypes set }
1749 <
1750 < function TIBCustomDataSet.IsVisible(Buffer: PChar): Boolean;
1751 < begin
1752 <  result := True;
1753 <  if not (State = dsOldValue) then
1754 <    result :=
1755 <      (PRecordData(Buffer)^.rdCachedUpdateStatus in FUpdateRecordTypes) and
1756 <      (not ((PRecordData(Buffer)^.rdCachedUpdateStatus = cusUnmodified) and
1757 <        (PRecordData(Buffer)^.rdUpdateStatus = usDeleted)));
1758 < end;
1759 <
1760 <
1761 < function TIBCustomDataSet.LocateNext(const KeyFields: string;
1762 <  const KeyValues: Variant; Options: TLocateOptions): Boolean;
1763 < begin
1764 <  DisableControls;
1765 <  try
1766 <    result := InternalLocate(KeyFields, KeyValues, Options);
1767 <  finally
1768 <    EnableControls;
1769 <  end;
1770 < end;
1771 <
1772 < procedure TIBCustomDataSet.InternalPrepare;
1773 < var
1774 <  SetCursor: Boolean;
1775 <  DidActivate: Boolean;
1776 < begin
1777 <  if FInternalPrepared then
1778 <    Exit;
1779 <  DidActivate := False;
1780 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1781 <  if SetCursor then
1782 <    Screen.Cursor := crHourGlass;
1783 <  try
1784 <    ActivateConnection;
1785 <    DidActivate := ActivateTransaction;
1786 <    FBase.CheckDatabase;
1787 <    FBase.CheckTransaction;
1788 <    if FQSelect.SQL.Text <> '' then
1789 <    begin
1790 <      if not FQSelect.Prepared then
1791 <      begin
1792 <        FQSelect.ParamCheck := ParamCheck;
1793 <        FQSelect.Prepare;
1794 <      end;
1795 <      if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
1796 <        FQDelete.Prepare;
1797 <      if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
1798 <        FQInsert.Prepare;
1799 <      if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
1800 <        FQRefresh.Prepare;
1801 <      if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
1802 <        FQModify.Prepare;
1803 <      FInternalPrepared := True;
1804 <      InternalInitFieldDefs;
1805 <    end else
1806 <      IBError(ibxeEmptyQuery, [nil]);
1807 <  finally
1808 <    if DidActivate then
1809 <      DeactivateTransaction;
1810 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1811 <      Screen.Cursor := crDefault;
1812 <  end;
1813 < end;
1814 <
1815 < procedure TIBCustomDataSet.RecordModified(Value: Boolean);
1816 < begin
1817 <  SetModified(Value);
1818 < end;
1819 <
1820 < procedure TIBCustomDataSet.RevertRecord;
1821 < var
1822 <  Buff: PRecordData;
1823 < begin
1824 <  if FCachedUpdates and FUpdatesPending then
1825 <  begin
1826 <    Buff := PRecordData(GetActiveBuf);
1827 <    InternalRevertRecord(Buff^.rdRecordNumber);
1828 <    ReadRecordCache(Buff^.rdRecordNumber, PChar(Buff), False);
1829 <    DataEvent(deRecordChange, 0);
1830 <  end;
1831 < end;
1832 <
1833 < procedure TIBCustomDataSet.SaveOldBuffer(Buffer: PChar);
1834 < var
1835 <  OldBuffer: Pointer;
1836 <  procedure CopyOldBuffer;
1837 <  begin
1838 <    CopyRecordBuffer(Buffer, OldBuffer);
1839 <    if BlobFieldCount > 0 then
1840 <      FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
1841 <               0);
1842 <  end;
1843 <
1844 < begin
1845 <  if (Buffer <> nil) and (PRecordData(Buffer)^.rdRecordNumber >= 0) then
1846 <  begin
1847 <    OldBuffer := AllocRecordBuffer;
1848 <    try
1849 <      if (PRecordData(Buffer)^.rdSavedOffset = $FFFFFFFF) then
1850 <      begin
1851 <        PRecordData(Buffer)^.rdSavedOffset := AdjustPosition(FOldBufferCache, 0,
1852 <                                                             FILE_END);
1853 <        CopyOldBuffer;
1854 <          WriteCache(FOldBufferCache, 0, FILE_CURRENT, OldBuffer);
1855 <          WriteCache(FBufferCache, PRecordData(Buffer)^.rdRecordNumber * FRecordBufferSize,
1856 <                     FILE_BEGIN, Buffer);
1857 <      end
1858 <      else begin
1859 <        CopyOldBuffer;
1860 <        WriteCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN,
1861 <                   OldBuffer);
1862 <      end;
1863 <    finally
1864 <      FreeRecordBuffer(PChar(OldBuffer));
1865 <    end;
1866 <  end;
1867 < end;
1868 <
1869 < procedure TIBCustomDataSet.SetBufferChunks(Value: Integer);
1870 < begin
1871 <  if (Value <= 0) then
1872 <    FBufferChunks := BufferCacheSize
1873 <  else
1874 <    FBufferChunks := Value;
1875 < end;
1876 <
1877 < procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase);
1878 < begin
1879 <  if (FBase.Database <> Value) then
1880 <  begin
1881 <    CheckDatasetClosed;
1882 <    FBase.Database := Value;
1883 <    FQDelete.Database := Value;
1884 <    FQInsert.Database := Value;
1885 <    FQRefresh.Database := Value;
1886 <    FQSelect.Database := Value;
1887 <    FQModify.Database := Value;
1888 <  end;
1889 < end;
1890 <
1891 < procedure TIBCustomDataSet.SetDeleteSQL(Value: TStrings);
1892 < begin
1893 <  if FQDelete.SQL.Text <> Value.Text then
1894 <  begin
1895 <    Disconnect;
1896 <    FQDelete.SQL.Assign(Value);
1897 <  end;
1898 < end;
1899 <
1900 < procedure TIBCustomDataSet.SetInsertSQL(Value: TStrings);
1901 < begin
1902 <  if FQInsert.SQL.Text <> Value.Text then
1903 <  begin
1904 <    Disconnect;
1905 <    FQInsert.SQL.Assign(Value);
1906 <  end;
1907 < end;
1908 <
1909 < procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
1910 < var
1911 <  i, j: Integer;
1912 <  cr, data: PChar;
1913 <  fn, st: string;
1914 <  OldBuffer: Pointer;
1915 <  ts: TTimeStamp;
1916 < begin
1917 <  if (Buffer = nil) then
1918 <    IBError(ibxeBufferNotSet, [nil]);
1919 <  if (not FInternalPrepared) then
1920 <    InternalPrepare;
1921 <  OldBuffer := nil;
1922 <  try
1923 <    for i := 0 to Qry.Params.Count - 1 do
1924 <    begin
1925 <      fn := Qry.Params[i].Name;
1926 <      if (Pos('OLD_', fn) = 1) then {mbcs ok}
1927 <      begin
1928 <        fn := Copy(fn, 5, Length(fn));
1929 <        if not Assigned(OldBuffer) then
1930 <        begin
1931 <          OldBuffer := AllocRecordBuffer;
1932 <          ReadRecordCache(PRecordData(Buffer)^.rdRecordNumber, OldBuffer, True);
1933 <        end;
1934 <        cr := OldBuffer;
1935 <      end
1936 <      else if (Pos('NEW_', fn) = 1) then {mbcs ok}
1937 <           begin
1938 <             fn := Copy(fn, 5, Length(fn));
1939 <             cr := Buffer;
1940 <            end
1941 <            else
1942 <             cr := Buffer;
1943 <      j := FQSelect.FieldIndex[fn] + 1;
1944 <      if (j > 0) then
1945 <        with PRecordData(cr)^ do
1946 <        begin
1947 <          if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
1948 <          begin
1949 <            PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
1950 <            continue;
1951 <          end;
1952 <          if rdFields[j].fdIsNull then
1953 <            Qry.Params[i].IsNull := True
1954 <          else begin
1955 <            Qry.Params[i].IsNull := False;
1956 <            data := cr + rdFields[j].fdDataOfs;
1957 <            case rdFields[j].fdDataType of
1958 <              SQL_TEXT, SQL_VARYING:
1959 <              begin
1960 <                SetString(st, data, rdFields[j].fdDataLength);
1961 <                Qry.Params[i].AsString := st;
1962 <              end;
1963 <            SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
1964 <              Qry.Params[i].AsDouble := PDouble(data)^;
1965 <            SQL_SHORT, SQL_LONG:
1966 <            begin
1967 <              if rdFields[j].fdDataScale = 0 then
1968 <                Qry.Params[i].AsLong := PLong(data)^
1969 <              else if rdFields[j].fdDataScale >= (-4) then
1970 <                Qry.Params[i].AsCurrency := PCurrency(data)^
1971 <              else
1972 <                Qry.Params[i].AsDouble := PDouble(data)^;
1973 <            end;
1974 <            SQL_INT64:
1975 <            begin
1976 <              if rdFields[j].fdDataScale = 0 then
1977 <                Qry.Params[i].AsInt64 := PInt64(data)^
1978 <              else if rdFields[j].fdDataScale >= (-4) then
1979 <                Qry.Params[i].AsCurrency := PCurrency(data)^
1980 <              else
1981 <                Qry.Params[i].AsDouble := PDouble(data)^;
1982 <            end;
1983 <            SQL_BLOB, SQL_ARRAY, SQL_QUAD:
1984 <              Qry.Params[i].AsQuad := PISC_QUAD(data)^;
1985 <            SQL_TYPE_DATE:
1986 <            begin
1987 <              ts.Date := PInt(data)^;
1988 <              ts.Time := 0;
1989 <              Qry.Params[i].AsDate :=
1990 <                TimeStampToDateTime(ts);
1991 <            end;
1992 <            SQL_TYPE_TIME:
1993 <            begin
1994 <              ts.Date := 0;
1995 <              ts.Time := PInt(data)^;
1996 <              Qry.Params[i].AsTime :=
1997 <                TimeStampToDateTime(ts);
1998 <            end;
1999 <            SQL_TIMESTAMP:
2000 <              Qry.Params[i].AsDateTime :=
2001 <                TimeStampToDateTime(
2002 <                  MSecsToTimeStamp(PDouble(data)^));
2003 <          end;
2004 <        end;
2005 <      end;
2006 <    end;
2007 <  finally
2008 <    if (OldBuffer <> nil) then
2009 <      FreeRecordBuffer(PChar(OldBuffer));
2010 <  end;
2011 < end;
2012 <
2013 < procedure TIBCustomDataSet.SetRefreshSQL(Value: TStrings);
2014 < begin
2015 <  if FQRefresh.SQL.Text <> Value.Text then
2016 <  begin
2017 <    Disconnect;
2018 <    FQRefresh.SQL.Assign(Value);
2019 <  end;
2020 < end;
2021 <
2022 < procedure TIBCustomDataSet.SetSelectSQL(Value: TStrings);
2023 < begin
2024 <  if FQSelect.SQL.Text <> Value.Text then
2025 <  begin
2026 <    Disconnect;
2027 <    FQSelect.SQL.Assign(Value);
2028 <  end;
2029 < end;
2030 <
2031 < procedure TIBCustomDataSet.SetModifySQL(Value: TStrings);
2032 < begin
2033 <  if FQModify.SQL.Text <> Value.Text then
2034 <  begin
2035 <    Disconnect;
2036 <    FQModify.SQL.Assign(Value);
2037 <  end;
2038 < end;
2039 <
2040 < procedure TIBCustomDataSet.SetTransaction(Value: TIBTransaction);
2041 < begin
2042 <  if (FBase.Transaction <> Value) then
2043 <  begin
2044 <    CheckDatasetClosed;
2045 <    FBase.Transaction := Value;
2046 <    FQDelete.Transaction := Value;
2047 <    FQInsert.Transaction := Value;
2048 <    FQRefresh.Transaction := Value;
2049 <    FQSelect.Transaction := Value;
2050 <    FQModify.Transaction := Value;
2051 <  end;
2052 < end;
2053 <
2054 < procedure TIBCustomDataSet.SetUniDirectional(Value: Boolean);
2055 < begin
2056 <  CheckDatasetClosed;
2057 <  FUniDirectional := Value;
2058 < end;
2059 <
2060 < procedure TIBCustomDataSet.SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
2061 < begin
2062 <  FUpdateRecordTypes := Value;
2063 <  if Active then
2064 <    First;
2065 < end;
2066 <
2067 < procedure TIBCustomDataSet.RefreshParams;
2068 < var
2069 <  DataSet: TDataSet;
2070 < begin
2071 <  DisableControls;
2072 <  try
2073 <    if FDataLink.DataSource <> nil then
2074 <    begin
2075 <      DataSet := FDataLink.DataSource.DataSet;
2076 <      if DataSet <> nil then
2077 <        if DataSet.Active and (DataSet.State <> dsSetKey) then
2078 <        begin
2079 <          Close;
2080 <          Open;
2081 <        end;
2082 <    end;
2083 <  finally
2084 <    EnableControls;
2085 <  end;
2086 < end;
2087 <
2088 <
2089 < procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2090 < begin
2091 <  if FOpen then
2092 <    InternalClose;
2093 <  if FInternalPrepared then
2094 <    InternalUnPrepare;
2095 < end;
2096 <
2097 < { I can "undelete" uninserted records (make them "inserted" again).
2098 <  I can "undelete" cached deleted (the deletion hasn't yet occurred) }
2099 < procedure TIBCustomDataSet.Undelete;
2100 < var
2101 <  Buff: PRecordData;
2102 < begin
2103 <  CheckActive;
2104 <  Buff := PRecordData(GetActiveBuf);
2105 <  with Buff^ do
2106 <  begin
2107 <    if rdCachedUpdateStatus = cusUninserted then
2108 <    begin
2109 <      rdCachedUpdateStatus := cusInserted;
2110 <      Dec(FDeletedRecords);
2111 <    end
2112 <    else if (rdUpdateStatus = usDeleted) and
2113 <            (rdCachedUpdateStatus = cusDeleted) then
2114 <    begin
2115 <      rdCachedUpdateStatus := cusUnmodified;
2116 <      rdUpdateStatus := usUnmodified;
2117 <      Dec(FDeletedRecords);
2118 <    end;
2119 <    WriteRecordCache(rdRecordNumber, PChar(Buff));
2120 <  end;
2121 < end;
2122 <
2123 < function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2124 < begin
2125 <  if Active then
2126 <    if GetActiveBuf <> nil then
2127 <      result := PRecordData(GetActiveBuf)^.rdUpdateStatus
2128 <    else
2129 <      result := usUnmodified
2130 <  else
2131 <    result := usUnmodified;
2132 < end;
2133 <
2134 < function TIBCustomDataSet.IsSequenced: Boolean;
2135 < begin
2136 <  Result := Assigned( FQSelect ) and FQSelect.EOF;
2137 < end;
2138 <
2139 < function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
2140 <                                        Origin: Integer): Integer;
2141 < var
2142 <  OldCacheSize: Integer;
2143 < begin
2144 <  if (FCache = FBufferCache) then
2145 <  begin
2146 <    case Origin of
2147 <      FILE_BEGIN:    FBPos := Offset;
2148 <      FILE_CURRENT:  FBPos := FBPos + Offset;
2149 <      FILE_END:      FBPos := DWORD(FBEnd) + Offset;
2150 <    end;
2151 <    OldCacheSize := FCacheSize;
2152 <    while (FBPos >= DWORD(FCacheSize)) do
2153 <      Inc(FCacheSize, FBufferChunkSize);
2154 <    if FCacheSize > OldCacheSize then
2155 <      IBAlloc(FBufferCache, FCacheSize, FCacheSize);
2156 <    result := FBPos;
2157 <  end
2158 <  else begin
2159 <    case Origin of
2160 <      FILE_BEGIN:    FOBPos := Offset;
2161 <      FILE_CURRENT:  FOBPos := FOBPos + Offset;
2162 <      FILE_END:      FOBPos := DWORD(FOBEnd) + Offset;
2163 <    end;
2164 <    OldCacheSize := FOldCacheSize;
2165 <    while (FBPos >= DWORD(FOldCacheSize)) do
2166 <      Inc(FOldCacheSize, FBufferChunkSize);
2167 <    if FOldCacheSize > OldCacheSize then
2168 <      IBAlloc(FOldBufferCache, FOldCacheSize, FOldCacheSize);
2169 <    result := FOBPos;
2170 <  end;
2171 < end;
2172 <
2173 < procedure TIBCustomDataSet.ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
2174 <                                    Buffer: PChar);
2175 < var
2176 <  pCache: PChar;
2177 <  bOld: Boolean;
2178 < begin
2179 <  bOld := (FCache = FOldBufferCache);
2180 <  pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2181 <  if not bOld then
2182 <    pCache := FBufferCache + Integer(pCache)
2183 <  else
2184 <    pCache := FOldBufferCache + Integer(pCache);
2185 <  Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
2186 <  AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2187 < end;
2188 <
2189 < procedure TIBCustomDataSet.ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
2190 <                                          ReadOldBuffer: Boolean);
2191 < begin
2192 <  if FUniDirectional then
2193 <    RecordNumber := RecordNumber mod UniCache;
2194 <  if (ReadOldBuffer) then
2195 <  begin
2196 <    ReadRecordCache(RecordNumber, Buffer, False);
2197 <    if FCachedUpdates and
2198 <      (PRecordData(Buffer)^.rdSavedOffset <> $FFFFFFFF) then
2199 <      ReadCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN,
2200 <                Buffer)
2201 <    else
2202 <      if ReadOldBuffer and
2203 <         (PRecordData(FOldBuffer)^.rdRecordNumber = RecordNumber) then
2204 <         CopyRecordBuffer( FOldBuffer, Buffer )
2205 <  end
2206 <  else
2207 <    ReadCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer);
2208 < end;
2209 <
2210 < procedure TIBCustomDataSet.WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer;
2211 <                                     Buffer: PChar);
2212 < var
2213 <  pCache: PChar;
2214 <  bOld: Boolean;
2215 <  dwEnd: DWORD;
2216 < begin
2217 <  bOld := (FCache = FOldBufferCache);
2218 <  pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2219 <  if not bOld then
2220 <    pCache := FBufferCache + Integer(pCache)
2221 <  else
2222 <    pCache := FOldBufferCache + Integer(pCache);
2223 <  Move(Buffer^, pCache^, FRecordBufferSize);
2224 <  dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2225 <  if not bOld then
2226 <  begin
2227 <    if (dwEnd > FBEnd) then
2228 <      FBEnd := dwEnd;
2229 <  end
2230 <  else begin
2231 <    if (dwEnd > FOBEnd) then
2232 <      FOBEnd := dwEnd;
2233 <  end;
2234 < end;
2235 <
2236 < procedure TIBCustomDataSet.WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
2237 < begin
2238 <  if RecordNumber >= 0 then
2239 <  begin
2240 <    if FUniDirectional then
2241 <      RecordNumber := RecordNumber mod UniCache;
2242 <    WriteCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer);
2243 <  end;
2244 < end;
2245 <
2246 < function TIBCustomDataSet.AllocRecordBuffer: PChar;
2247 < begin
2248 <  result := nil;
2249 <  IBAlloc(result, FRecordBufferSize, FRecordBufferSize);
2250 <  Move(FModelBuffer^, result^, FRecordBufferSize);
2251 < end;
2252 <
2253 < function TIBCustomDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
2254 < var
2255 <  pb: PBlobDataArray;
2256 <  fs: TIBBlobStream;
2257 <  Buff: PChar;
2258 <  bTr, bDB: Boolean;
2259 < begin
2260 <  Buff := GetActiveBuf;
2261 <  if Buff = nil then
2262 <  begin
2263 <    fs := TIBBlobStream.Create;
2264 <    fs.Mode := bmReadWrite;
2265 <    FBlobStreamList.Add(Pointer(fs));
2266 <    result := TIBDSBlobStream.Create(Field, fs, Mode);
2267 <    exit;
2268 <  end;
2269 <  pb := PBlobDataArray(Buff + FBlobCacheOffset);
2270 <  if pb^[Field.Offset] = nil then
2271 <  begin
2272 <    AdjustRecordOnInsert(Buff);
2273 <    pb^[Field.Offset] := TIBBlobStream.Create;
2274 <    fs := pb^[Field.Offset];
2275 <    FBlobStreamList.Add(Pointer(fs));
2276 <    fs.Mode := bmReadWrite;
2277 <    fs.Database := Database;
2278 <    fs.Transaction := Transaction;
2279 <    fs.BlobID :=
2280 <      PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
2281 <    if (CachedUpdates) then
2282 <    begin
2283 <      bTr := not Transaction.InTransaction;
2284 <      bDB := not Database.Connected;
2285 <      if bDB then
2286 <        Database.Open;
2287 <      if bTr then
2288 <        Transaction.StartTransaction;
2289 <      fs.Seek(0, soFromBeginning);
2290 <      if bTr then
2291 <        Transaction.Commit;
2292 <      if bDB then
2293 <        Database.Close;
2294 <    end;
2295 <    WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
2296 <  end else
2297 <    fs := pb^[Field.Offset];
2298 <  result := TIBDSBlobStream.Create(Field, fs, Mode);
2299 < end;
2300 <
2301 < function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
2302 < const
2303 <  CMPLess = -1;
2304 <  CMPEql  =  0;
2305 <  CMPGtr  =  1;
2306 <  RetCodes: array[Boolean, Boolean] of ShortInt = ((2, CMPLess),
2307 <                                                   (CMPGtr, CMPEql));
2308 < begin
2309 <  result := RetCodes[Bookmark1 = nil, Bookmark2 = nil];
2310 <
2311 <  if Result = 2 then
2312 <  begin
2313 <    if PInteger(Bookmark1)^ < PInteger(Bookmark2)^ then
2314 <      Result := CMPLess
2315 <    else
2316 <    if PInteger(Bookmark1)^ > PInteger(Bookmark2)^ then
2317 <      Result := CMPGtr
2318 <    else
2319 <      Result := CMPEql;
2320 <  end;
2321 < end;
2322 <
2323 < procedure TIBCustomDataSet.DoBeforeDelete;
2324 < var
2325 <  Buff: PRecordData;
2326 < begin
2327 <  if not CanDelete then
2328 <    IBError(ibxeCannotDelete, [nil]);
2329 <  Buff := PRecordData(GetActiveBuf);
2330 <  if FCachedUpdates and
2331 <    (Buff^.rdCachedUpdateStatus in [cusUnmodified]) then
2332 <    SaveOldBuffer(PChar(Buff));
2333 <  inherited;
2334 < end;
2335 <
2336 < procedure TIBCustomDataSet.DoBeforeEdit;
2337 < var
2338 <  Buff: PRecordData;
2339 < begin
2340 <  Buff := PRecordData(GetActiveBuf);
2341 <  if not(CanEdit or (FQModify.SQL.Count <> 0) or
2342 <    (FCachedUpdates and Assigned(FOnUpdateRecord))) then
2343 <    IBError(ibxeCannotUpdate, [nil]);
2344 <  if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
2345 <    SaveOldBuffer(PChar(Buff));
2346 <  CopyRecordBuffer(GetActiveBuf, FOldBuffer);
2347 <  inherited;
2348 < end;
2349 <
2350 < procedure TIBCustomDataSet.DoBeforeInsert;
2351 < begin
2352 <  if not CanInsert then
2353 <    IBError(ibxeCannotInsert, [nil]);
2354 <  inherited;
2355 < end;
2356 <
2357 < procedure TIBCustomDataSet.FetchAll;
2358 < var
2359 <  SetCursor: Boolean;
2360 <  CurBookmark: string;
2361 < begin
2362 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2363 <  if SetCursor then
2364 <    Screen.Cursor := crHourGlass;
2365 <  try
2366 <    if FQSelect.EOF or not FQSelect.Open then
2367 <      exit;
2368 <    DisableControls;
2369 <    try
2370 <      CurBookmark := Bookmark;
2371 <      Last;
2372 <      Bookmark := CurBookmark;
2373 <    finally
2374 <      EnableControls;
2375 <    end;
2376 <  finally
2377 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2378 <      Screen.Cursor := crDefault;
2379 <  end;
2380 < end;
2381 <
2382 < procedure TIBCustomDataSet.FreeRecordBuffer(var Buffer: PChar);
2383 < begin
2384 <  FreeMem(Buffer);
2385 <  Buffer := nil;
2386 < end;
2387 <
2388 < procedure TIBCustomDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
2389 < begin
2390 <  Move(PRecordData(Buffer)^.rdRecordNumber, Data^, BookmarkSize);
2391 < end;
2392 <
2393 < function TIBCustomDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
2394 < begin
2395 <  result := PRecordData(Buffer)^.rdBookmarkFlag;
2396 < end;
2397 <
2398 < function TIBCustomDataSet.GetCanModify: Boolean;
2399 < begin
2400 <  result := (FQInsert.SQL.Text <> '') or
2401 <    (FQModify.SQL.Text <> '') or
2402 <    (FQDelete.SQL.Text <> '') or
2403 <    (Assigned(FUpdateObject));
2404 < end;
2405 <
2406 < function TIBCustomDataSet.GetCurrentRecord(Buffer: PChar): Boolean;
2407 < begin
2408 <  if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then
2409 <  begin
2410 <    UpdateCursorPos;
2411 <    ReadRecordCache(PRecordData(ActiveBuffer)^.rdRecordNumber, Buffer, False);
2412 <    result := True;
2413 <  end
2414 <  else
2415 <    result := False;
2416 < end;
2417 <
2418 < function TIBCustomDataSet.GetDataSource: TDataSource;
2419 < begin
2420 <  if FDataLink = nil then
2421 <    result := nil
2422 <  else
2423 <    result := FDataLink.DataSource;
2424 < end;
2425 <
2426 < function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
2427 < begin
2428 <  Result := DefaultFieldClasses[FieldType];
2429 < end;
2430 <
2431 < function TIBCustomDataSet.GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean;
2432 < begin
2433 <  result := GetFieldData(FieldByNumber(FieldNo), buffer);
2434 < end;
2435 <
2436 < function TIBCustomDataSet.InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
2437 < var
2438 <  Buff, Data: PChar;
2439 <  CurrentRecord: PRecordData;
2440 < begin
2441 <  result := False;
2442 <  Buff := GetActiveBuf;
2443 <  if (Buff = nil) or
2444 <     (not IsVisible(Buff)) then
2445 <    exit;
2446 <  { The intention here is to stuff the buffer with the data for the
2447 <   referenced field for the current record }
2448 <  CurrentRecord := PRecordData(Buff);
2449 <  if (Field.FieldNo < 0) then
2450 <  begin
2451 <    Inc(Buff, FRecordSize + Field.Offset);
2452 <    result := Boolean(Buff[0]);
2453 <    if result and (Buffer <> nil) then
2454 <      Move(Buff[1], Buffer^, Field.DataSize);
2455 <  end
2456 <  else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
2457 <     (FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
2458 <  begin
2459 <    result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
2460 <    if result and (Buffer <> nil) then
2461 <      with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
2462 <      begin
2463 <        Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
2464 <        if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
2465 <        begin
2466 <          Move(Data^, Buffer^, fdDataLength);
2467 <          PChar(Buffer)[fdDataLength] := #0;
2468 <        end
2469 <        else
2470 <          Move(Data^, Buffer^, Field.DataSize);
2471 <      end;
2472 <  end;
2473 < end;
2474 <
2475 < { GetRecNo and SetRecNo both operate off of 1-based indexes as
2476 < opposed to 0-based indexes.
2477 < This is because we want LastRecordNumber/RecordCount = 1 }
2478 <
2479 < function TIBCustomDataSet.GetRecNo: Integer;
2480 < begin
2481 <  if GetActiveBuf = nil then
2482 <    result := 0
2483 <  else
2484 <    result := PRecordData(GetActiveBuf)^.rdRecordNumber + 1;
2485 < end;
2486 <
2487 < function TIBCustomDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
2488 <  DoCheck: Boolean): TGetResult;
2489 < var
2490 <  Accept: Boolean;
2491 <  SaveState: TDataSetState;
2492 < begin
2493 <  Result := grOK;
2494 <  if Filtered and Assigned(OnFilterRecord) then
2495 <  begin
2496 <    Accept := False;
2497 <    SaveState := SetTempState(dsFilter);
2498 <    while not Accept do
2499 <    begin
2500 <      Result := InternalGetRecord(Buffer, GetMode, DoCheck);
2501 <      if Result <> grOK then
2502 <        break;
2503 <      FFilterBuffer := Buffer;
2504 <      try
2505 <        Accept := True;
2506 <        OnFilterRecord(Self, Accept);
2507 <        if not Accept and (GetMode = gmCurrent) then
2508 <          GetMode := gmPrior;
2509 <      except
2510 < //        Application.HandleException(Self);
2511 <      end;
2512 <    end;
2513 <    RestoreState(SaveState);
2514 <  end
2515 <  else
2516 <    Result := InternalGetRecord(Buffer, GetMode, DoCheck);
2517 < end;
2518 <
2519 < function TIBCustomDataSet.InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
2520 <  DoCheck: Boolean): TGetResult;
2521 < begin
2522 <  result := grError;
2523 <  case GetMode of
2524 <    gmCurrent: begin
2525 <      if (FCurrentRecord >= 0) then begin
2526 <        if FCurrentRecord < FRecordCount then
2527 <          ReadRecordCache(FCurrentRecord, Buffer, False)
2528 <        else begin
2529 <          while (not FQSelect.EOF) and
2530 <                (FQSelect.Next <> nil) and
2531 <                (FCurrentRecord >= FRecordCount) do begin
2532 <            FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
2533 <            Inc(FRecordCount);
2534 <          end;
2535 <          FCurrentRecord := FRecordCount - 1;
2536 <          if (FCurrentRecord >= 0) then
2537 <            ReadRecordCache(FCurrentRecord, Buffer, False);
2538 <        end;
2539 <        result := grOk;
2540 <      end else
2541 <        result := grBOF;
2542 <    end;
2543 <    gmNext: begin
2544 <      result := grOk;
2545 <      if FCurrentRecord = FRecordCount then
2546 <        result := grEOF
2547 <      else if FCurrentRecord = FRecordCount - 1 then begin
2548 <        if (not FQSelect.EOF) then begin
2549 <          FQSelect.Next;
2550 <          Inc(FCurrentRecord);
2551 <        end;
2552 <        if (FQSelect.EOF) then begin
2553 <          result := grEOF;
2554 <        end else begin
2555 <          Inc(FRecordCount);
2556 <          FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
2557 <        end;
2558 <      end else if (FCurrentRecord < FRecordCount) then begin
2559 <        Inc(FCurrentRecord);
2560 <        ReadRecordCache(FCurrentRecord, Buffer, False);
2561 <      end;
2562 <    end;
2563 <    else { gmPrior }
2564 <    begin
2565 <      if (FCurrentRecord = 0) then begin
2566 <        Dec(FCurrentRecord);
2567 <        result := grBOF;
2568 <      end else if (FCurrentRecord > 0) and
2569 <                  (FCurrentRecord <= FRecordCount) then begin
2570 <        Dec(FCurrentRecord);
2571 <        ReadRecordCache(FCurrentRecord, Buffer, False);
2572 <        result := grOk;
2573 <      end else if (FCurrentRecord = -1) then
2574 <        result := grBOF;
2575 <    end;
2576 <  end;
2577 <  if result = grOk then
2578 <    result := AdjustCurrentRecord(Buffer, GetMode);
2579 <  if result = grOk then with PRecordData(Buffer)^ do begin
2580 <    rdBookmarkFlag := bfCurrent;
2581 <    GetCalcFields(Buffer);
2582 <  end else if (result = grEOF) then begin
2583 <    CopyRecordBuffer(FModelBuffer, Buffer);
2584 <    PRecordData(Buffer)^.rdBookmarkFlag := bfEOF;
2585 <  end else if (result = grBOF) then begin
2586 <    CopyRecordBuffer(FModelBuffer, Buffer);
2587 <    PRecordData(Buffer)^.rdBookmarkFlag := bfBOF;
2588 <  end else if (result = grError) then begin
2589 <    CopyRecordBuffer(FModelBuffer, Buffer);
2590 <    PRecordData(Buffer)^.rdBookmarkFlag := bfEOF;
2591 <  end;;
2592 < end;
2593 <
2594 < function TIBCustomDataSet.GetRecordCount: Integer;
2595 < begin
2596 <  result := FRecordCount - FDeletedRecords;
2597 < end;
2598 <
2599 < function TIBCustomDataSet.GetRecordSize: Word;
2600 < begin
2601 <  result := FRecordBufferSize;
2602 < end;
2603 <
2604 < procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
2605 < begin
2606 <  CheckEditState;
2607 <  begin
2608 <     { When adding records, we *always* append.
2609 <       Insertion is just too costly }
2610 <    AdjustRecordOnInsert(Buffer);
2611 <    with PRecordData(Buffer)^ do
2612 <    begin
2613 <      rdUpdateStatus := usInserted;
2614 <      rdCachedUpdateStatus := cusInserted;
2615 <    end;
2616 <    if not CachedUpdates then
2617 <      InternalPostRecord(FQInsert, Buffer)
2618 <    else begin
2619 <      WriteRecordCache(FCurrentRecord, Buffer);
2620 <      FUpdatesPending := True;
2621 <    end;
2622 <    Inc(FRecordCount);
2623 <    InternalSetToRecord(Buffer);
2624 <  end
2625 < end;
2626 <
2627 < procedure TIBCustomDataSet.InternalCancel;
2628 < var
2629 <  Buff: PChar;
2630 <  CurRec: Integer;
2631 < begin
2632 <  inherited;
2633 <  Buff := GetActiveBuf;
2634 <  if Buff <> nil then begin
2635 <    CurRec := FCurrentRecord;
2636 <    AdjustRecordOnInsert(Buff);
2637 <    if (State = dsEdit) then begin
2638 <      CopyRecordBuffer(FOldBuffer, Buff);
2639 <      WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
2640 <    end else begin
2641 <      CopyRecordBuffer(FModelBuffer, Buff);
2642 <      PRecordData(Buff)^.rdUpdateStatus := usDeleted;
2643 <      PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2644 <      PRecordData(Buff)^.rdBookmarkFlag := bfEOF;
2645 <      FCurrentRecord := CurRec;
2646 <    end;
2647 <  end;
2648 < end;
2649 <
2650 <
2651 < procedure TIBCustomDataSet.InternalClose;
2652 < begin
2653 <  if FDidActivate then
2654 <    DeactivateTransaction;
2655 <  FQSelect.Close;
2656 <  ClearBlobCache;
2657 <  FreeRecordBuffer(FModelBuffer);
2658 <  FreeRecordBuffer(FOldBuffer);
2659 <  FCurrentRecord := -1;
2660 <  FOpen := False;
2661 <  FRecordCount := 0;
2662 <  FDeletedRecords := 0;
2663 <  FRecordSize := 0;
2664 <  FBPos := 0;
2665 <  FOBPos := 0;
2666 <  FCacheSize := 0;
2667 <  FOldCacheSize := 0;
2668 <  FBEnd := 0;
2669 <  FOBEnd := 0;
2670 <  FreeMem(FBufferCache);
2671 <  FBufferCache := nil;
2672 <  FreeMem(FOldBufferCache);
2673 <  FOldBufferCache := nil;
2674 <  BindFields(False);
2675 <  if DefaultFields then DestroyFields;
2676 < end;
2677 <
2678 < procedure TIBCustomDataSet.InternalDelete;
2679 < var
2680 <  Buff: PChar;
2681 <  SetCursor: Boolean;
2682 < begin
2683 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2684 <  if SetCursor then
2685 <    Screen.Cursor := crHourGlass;
2686 <  try
2687 <    Buff := GetActiveBuf;
2688 <    if CanDelete then
2689 <    begin
2690 <      if not CachedUpdates then
2691 <        InternalDeleteRecord(FQDelete, Buff)
2692 <      else
2693 <      begin
2694 <        with PRecordData(Buff)^ do
2695 <        begin
2696 <          if rdCachedUpdateStatus = cusInserted then
2697 <            rdCachedUpdateStatus := cusUninserted
2698 <          else begin
2699 <            rdUpdateStatus := usDeleted;
2700 <            rdCachedUpdateStatus := cusDeleted;
2701 <          end;
2702 <        end;
2703 <        WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
2704 <      end;
2705 <      Inc(FDeletedRecords);
2706 <      FUpdatesPending := True;
2707 <    end else
2708 <      IBError(ibxeCannotDelete, [nil]);
2709 <  finally
2710 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2711 <      Screen.Cursor := crDefault;
2712 <  end;
2713 < end;
2714 <
2715 < procedure TIBCustomDataSet.InternalFirst;
2716 < begin
2717 <  FCurrentRecord := -1;
2718 < end;
2719 <
2720 < procedure TIBCustomDataSet.InternalGotoBookmark(Bookmark: Pointer);
2721 < begin
2722 <  FCurrentRecord := PInteger(Bookmark)^;
2723 < end;
2724 <
2725 < procedure TIBCustomDataSet.InternalHandleException;
2726 < begin
2727 <  Application.HandleException(Self)
2728 < end;
2729 <
2730 < procedure TIBCustomDataSet.InternalInitFieldDefs;
2731 < const
2732 <  DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
2733 <               'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
2734 <               'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
2735 <               'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
2736 <               'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
2737 <               'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
2738 <               '     (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
2739 < var
2740 <  FieldType: TFieldType;
2741 <  FieldSize: Word;
2742 <  FieldNullable : Boolean;
2743 <  i, FieldPosition, FieldPrecision: Integer;
2744 <  FieldAliasName: string;
2745 <  RelationName, FieldName: string;
2746 <  Query : TIBSQL;
2747 <  FieldIndex: Integer;
2748 <  FRelationNodes : TRelationNode;
2749 <
2750 <  function Add_Node(Relation, Field : String) : TRelationNode;
2751 <  var
2752 <    FField : TFieldNode;
2753 <  begin
2754 <    if FRelationNodes.RelationName = '' then
2755 <      Result := FRelationNodes
2756 <    else
2757 <    begin
2758 <      Result := TRelationNode.Create;
2759 <      Result.NextRelation := FRelationNodes;
2760 <    end;
2761 <    Result.RelationName := Relation;
2762 <    FRelationNodes := Result;
2763 <    Query.Params[0].AsString := Relation;
2764 <    Query.ExecQuery;
2765 <    while not Query.Eof do
2766 <    begin
2767 <      FField := TFieldNode.Create;
2768 <      FField.FieldName := Query.Fields[2].AsString;
2769 <      FField.DEFAULT_VALUE := not Query.Fields[1].IsNull;
2770 <      FField.COMPUTED_BLR := not Query.Fields[0].IsNull;
2771 <      FField.NextField := Result.FieldNodes;
2772 <      Result.FieldNodes := FField;
2773 <      Query.Next;
2774 <    end;
2775 <    Query.Close;
2776 <  end;
2777 <
2778 <  function Has_COMPUTED_BLR(Relation, Field : String) : Boolean;
2779 <  var
2780 <    FRelation : TRelationNode;
2781 <    FField : TFieldNode;
2782 <  begin
2783 <    FRelation := FRelationNodes;
2784 <    while Assigned(FRelation) and
2785 <         (FRelation.RelationName <> Relation) do
2786 <      FRelation := FRelation.NextRelation;
2787 <    if not Assigned(FRelation) then
2788 <      FRelation := Add_Node(Relation, Field);
2789 <    Result := false;
2790 <    FField := FRelation.FieldNodes;
2791 <    while Assigned(FField) do
2792 <      if FField.FieldName = Field then
2793 <      begin
2794 <        Result := Ffield.COMPUTED_BLR;
2795 <        Exit;
2796 <      end
2797 <      else
2798 <        FField := Ffield.NextField;
2799 <  end;
2800 <
2801 <  function Has_DEFAULT_VALUE(Relation, Field : String) : Boolean;
2802 <  var
2803 <    FRelation : TRelationNode;
2804 <    FField : TFieldNode;
2805 <  begin
2806 <    FRelation := FRelationNodes;
2807 <    while Assigned(FRelation) and
2808 <         (FRelation.RelationName <> Relation) do
2809 <      FRelation := FRelation.NextRelation;
2810 <    if not Assigned(FRelation) then
2811 <      FRelation := Add_Node(Relation, Field);
2812 <    Result := false;
2813 <    FField := FRelation.FieldNodes;
2814 <    while Assigned(FField) do
2815 <      if FField.FieldName = Field then
2816 <      begin
2817 <        Result := Ffield.DEFAULT_VALUE;
2818 <        Exit;
2819 <      end
2820 <      else
2821 <        FField := Ffield.NextField;
2822 <  end;
2823 <
2824 <  Procedure FreeNodes;
2825 <  var
2826 <    FRelation : TRelationNode;
2827 <    FField : TFieldNode;
2828 <  begin
2829 <    while Assigned(FRelationNodes) do
2830 <    begin
2831 <      While Assigned(FRelationNodes.FieldNodes) do
2832 <      begin
2833 <        FField := FRelationNodes.FieldNodes.NextField;
2834 <        FRelationNodes.FieldNodes.Free;
2835 <        FRelationNodes.FieldNodes := FField;
2836 <      end;
2837 <      FRelation := FRelationNodes.NextRelation;
2838 <      FRelationNodes.Free;
2839 <      FRelationNodes := FRelation;
2840 <    end;
2841 <  end;
2842 <
2843 < begin
2844 <  if not InternalPrepared then
2845 <  begin
2846 <    InternalPrepare;
2847 <    exit;
2848 <  end;
2849 <  FRelationNodes := TRelationNode.Create;
2850 <  FNeedsRefresh := False;
2851 <  Database.InternalTransaction.StartTransaction;
2852 <  Query := TIBSQL.Create(self);
2853 <  try
2854 <    Query.Database := DataBase;
2855 <    Query.Transaction := Database.InternalTransaction;
2856 <    FieldDefs.BeginUpdate;
2857 <    FieldDefs.Clear;
2858 <    FieldIndex := 0;
2859 <    if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
2860 <      SetLength(FMappedFieldPosition, FQSelect.Current.Count);
2861 <    Query.SQL.Text := DefaultSQL;
2862 <    Query.Prepare;
2863 <    for i := 0 to FQSelect.Current.Count - 1 do
2864 <      with FQSelect.Current[i].Data^ do
2865 <      begin
2866 <        { Get the field name }
2867 <        SetString(FieldAliasName, aliasname, aliasname_length);
2868 <        SetString(RelationName, relname, relname_length);
2869 <        SetString(FieldName, sqlname, sqlname_length);
2870 <        FieldSize := 0;
2871 <        FieldPrecision := 0;
2872 <        FieldNullable := FQSelect.Current[i].IsNullable;
2873 <        case sqltype and not 1 of
2874 <          { All VARCHAR's must be converted to strings before recording
2875 <           their values }
2876 <          SQL_VARYING, SQL_TEXT:
2877 <          begin
2878 <            FieldSize := sqllen;
2879 <            FieldType := ftString;
2880 <          end;
2881 <          { All Doubles/Floats should be cast to doubles }
2882 <          SQL_DOUBLE, SQL_FLOAT:
2883 <            FieldType := ftFloat;
2884 <          SQL_SHORT:
2885 <          begin
2886 <            if (sqlscale = 0) then
2887 <              FieldType := ftSmallInt
2888 <            else begin
2889 <              FieldType := ftBCD;
2890 <              FieldPrecision := 4;
2891 <              FieldSize := -sqlscale;
2892 <            end;
2893 <          end;
2894 <          SQL_LONG:
2895 <          begin
2896 <            if (sqlscale = 0) then
2897 <              FieldType := ftInteger
2898 <            else if (sqlscale >= (-4)) then
2899 <            begin
2900 <              FieldType := ftBCD;
2901 <              FieldPrecision := 9;
2902 <              FieldSize := -sqlscale;
2903 <            end
2904 <            else
2905 <              FieldType := ftFloat;
2906 <            end;
2907 <          SQL_INT64:
2908 <          begin
2909 <            if (sqlscale = 0) then
2910 <              FieldType := ftLargeInt
2911 <            else if (sqlscale >= (-4)) then
2912 <            begin
2913 <              FieldType := ftBCD;
2914 <              FieldPrecision := 18;
2915 <              FieldSize := -sqlscale;
2916 <            end
2917 <            else
2918 <              FieldType := ftFloat;
2919 <            end;
2920 <          SQL_TIMESTAMP: FieldType := ftDateTime;
2921 <          SQL_TYPE_TIME: FieldType := ftTime;
2922 <          SQL_TYPE_DATE: FieldType := ftDate;
2923 <          SQL_BLOB:
2924 <          begin
2925 <            FieldSize := sizeof (TISC_QUAD);
2926 <            if (sqlsubtype = 1) then
2927 <              FieldType := ftmemo
2928 <            else
2929 <              FieldType := ftBlob;
2930 <          end;
2931 <          SQL_ARRAY:
2932 <          begin
2933 <            FieldSize := sizeof (TISC_QUAD);
2934 <            FieldType := ftUnknown;
2935 <          end;
2936 <          else
2937 <            FieldType := ftUnknown;
2938 <        end;
2939 <        FieldPosition := i + 1;
2940 <        if (FieldType <> ftUnknown) and (FieldAliasName <> 'IBX_INTERNAL_DBKEY') then {do not localize}
2941 <        begin
2942 <          FMappedFieldPosition[FieldIndex] := FieldPosition;
2943 <          Inc(FieldIndex);
2944 <          with FieldDefs.AddFieldDef do
2945 <          begin
2946 <            Name := string( FieldAliasName );
2947 <            FieldNo := FieldPosition;
2948 <            DataType := FieldType;
2949 <            Size := FieldSize;
2950 <            Precision := FieldPrecision;
2951 <            Required := False;
2952 <            InternalCalcField := False;
2953 <            if (FieldName <> '') and (RelationName <> '') then
2954 <            begin
2955 <              if Has_COMPUTED_BLR(RelationName, FieldName) then
2956 <              begin
2957 <                Attributes := [faReadOnly];
2958 <                InternalCalcField := True;
2959 <                FNeedsRefresh := True;
2960 <              end
2961 <              else
2962 <              begin
2963 <                if Has_DEFAULT_VALUE(RelationName, FieldName) then
2964 <                begin
2965 <                  if not FieldNullable then
2966 <                    Attributes := [faRequired];
2967 <                end
2968 <                else
2969 <                  FNeedsRefresh := True;
2970 <              end;
2971 <            end;
2972 <          end;
2973 <        end;
2974 <      end;
2975 <  finally
2976 <    Query.free;
2977 <    FreeNodes;
2978 <    Database.InternalTransaction.Commit;
2979 <    FieldDefs.EndUpdate;
2980 <  end;
2981 < end;
2982 <
2983 < procedure TIBCustomDataSet.InternalInitRecord(Buffer: PChar);
2984 < begin
2985 <  CopyRecordBuffer(FModelBuffer, Buffer);
2986 < end;
2987 <
2988 < procedure TIBCustomDataSet.InternalLast;
2989 < var
2990 <  Buffer: PChar;
2991 < begin
2992 <  if (FQSelect.EOF) then
2993 <    FCurrentRecord := FRecordCount
2994 <  else begin
2995 <    Buffer := AllocRecordBuffer;
2996 <    try
2997 <      while FQSelect.Next <> nil do
2998 <      begin
2999 <        FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3000 <        Inc(FRecordCount);
3001 <      end;
3002 <      FCurrentRecord := FRecordCount;
3003 <    finally
3004 <      FreeRecordBuffer(Buffer);
3005 <    end;
3006 <  end;
3007 < end;
3008 <
3009 < procedure TIBCustomDataSet.InternalSetParamsFromCursor;
3010 < var
3011 <  i: Integer;
3012 <  cur_param: TIBXSQLVAR;
3013 <  cur_field: TField;
3014 <  s: TStream;
3015 < begin
3016 <  if FQSelect.SQL.Text = '' then
3017 <    IBError(ibxeEmptyQuery, [nil]);
3018 <  if not FInternalPrepared then
3019 <    InternalPrepare;
3020 <  if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
3021 <  begin
3022 <    for i := 0 to SQLParams.Count - 1 do
3023 <    begin
3024 <      cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
3025 <      cur_param := SQLParams[i];
3026 <      if (cur_field <> nil) then begin
3027 <        if (cur_field.IsNull) then
3028 <          cur_param.IsNull := True
3029 <        else case cur_field.DataType of
3030 <          ftString:
3031 <            cur_param.AsString := cur_field.AsString;
3032 <          ftBoolean, ftSmallint, ftWord:
3033 <            cur_param.AsShort := cur_field.AsInteger;
3034 <          ftInteger:
3035 <            cur_param.AsLong := cur_field.AsInteger;
3036 <          ftLargeInt:
3037 <            cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
3038 <          ftFloat, ftCurrency:
3039 <           cur_param.AsDouble := cur_field.AsFloat;
3040 <          ftBCD:
3041 <            cur_param.AsCurrency := cur_field.AsCurrency;
3042 <          ftDate:
3043 <            cur_param.AsDate := cur_field.AsDateTime;
3044 <          ftTime:
3045 <            cur_param.AsTime := cur_field.AsDateTime;
3046 <          ftDateTime:
3047 <            cur_param.AsDateTime := cur_field.AsDateTime;
3048 <          ftBlob, ftMemo:
3049 <          begin
3050 <            s := nil;
3051 <            try
3052 <              s := DataSource.DataSet.
3053 <                     CreateBlobStream(cur_field, bmRead);
3054 <              cur_param.LoadFromStream(s);
3055 <            finally
3056 <              s.free;
3057 <            end;
3058 <          end;
3059 <          else
3060 <            IBError(ibxeNotSupported, [nil]);
3061 <        end;
3062 <      end;
3063 <    end;
3064 <  end;
3065 < end;
3066 <
3067 < procedure TIBCustomDataSet.ReQuery;
3068 < begin
3069 <  FQSelect.Close;
3070 <  ClearBlobCache;
3071 <  FCurrentRecord := -1;
3072 <  FRecordCount := 0;
3073 <  FDeletedRecords := 0;
3074 <  FBPos := 0;
3075 <  FOBPos := 0;
3076 <  FBEnd := 0;
3077 <  FOBEnd := 0;
3078 <  FQSelect.Close;
3079 <  FQSelect.ExecQuery;
3080 <  FOpen := FQSelect.Open;
3081 <  First;
3082 < end;
3083 <
3084 < procedure TIBCustomDataSet.InternalOpen;
3085 < var
3086 <  SetCursor: Boolean;
3087 <
3088 <  function RecordDataLength(n: Integer): Long;
3089 <  begin
3090 <    result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3091 <  end;
3092 <
3093 < begin
3094 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3095 <  if SetCursor then
3096 <    Screen.Cursor := crHourGlass;
3097 <  try
3098 <    ActivateConnection;
3099 <    ActivateTransaction;
3100 <    if FQSelect.SQL.Text = '' then
3101 <      IBError(ibxeEmptyQuery, [nil]);
3102 <    if not FInternalPrepared then
3103 <      InternalPrepare;
3104 <   if FQSelect.SQLType = SQLSelect then
3105 <   begin
3106 <      if DefaultFields then
3107 <        CreateFields;
3108 <      BindFields(True);
3109 <      FCurrentRecord := -1;
3110 <      FQSelect.ExecQuery;
3111 <      FOpen := FQSelect.Open;
3112 <
3113 <      { Initialize offsets, buffer sizes, etc...
3114 <        1. Initially FRecordSize is just the "RecordDataLength".
3115 <        2. Allocate a "model" buffer and do a dummy fetch
3116 <        3. After the dummy fetch, FRecordSize will be appropriately
3117 <           adjusted to reflect the additional "weight" of the field
3118 <           data.
3119 <        4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
3120 <        5. Now, with the BufferSize available, allocate memory for chunks of records
3121 <        6. Re-allocate the model buffer, accounting for the new
3122 <           FRecordBufferSize.
3123 <        7. Finally, calls to AllocRecordBuffer will work!.
3124 <       }
3125 <      {Step 1}
3126 <      FRecordSize := RecordDataLength(FQSelect.Current.Count);
3127 <      {Step 2, 3}
3128 <      IBAlloc(FModelBuffer, 0, FRecordSize);
3129 <      FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
3130 <      {Step 4}
3131 <      FCalcFieldsOffset := FRecordSize;
3132 <      FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
3133 <      FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
3134 <      {Step 5}
3135 <      if UniDirectional then
3136 <        FBufferChunkSize := FRecordBufferSize * UniCache
3137 <      else
3138 <        FBufferChunkSize := FRecordBufferSize * BufferChunks;
3139 <      IBAlloc(FBufferCache, FBufferChunkSize, FBufferChunkSize);
3140 <      if FCachedUpdates or (csReading in ComponentState) then
3141 <        IBAlloc(FOldBufferCache, FBufferChunkSize, FBufferChunkSize);
3142 <      FBPos := 0;
3143 <      FOBPos := 0;
3144 <      FBEnd := 0;
3145 <      FOBEnd := 0;
3146 <      FCacheSize := FBufferChunkSize;
3147 <      FOldCacheSize := FBufferChunkSize;
3148 <      {Step 6}
3149 <      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
3150 <                             FRecordBufferSize);
3151 <      {Step 7}
3152 <      FOldBuffer := AllocRecordBuffer;
3153 <    end
3154 <    else
3155 <      FQSelect.ExecQuery;
3156 <  finally
3157 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3158 <      Screen.Cursor := crDefault;
3159 <  end;
3160 < end;
3161 <
3162 < procedure TIBCustomDataSet.InternalPost;
3163 < var
3164 <  Qry: TIBSQL;
3165 <  Buff: PChar;
3166 <  SetCursor: Boolean;
3167 <  bInserting: Boolean;
3168 < begin
3169 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3170 <  if SetCursor then
3171 <    Screen.Cursor := crHourGlass;
3172 <  try
3173 <    Buff := GetActiveBuf;
3174 <    CheckEditState;
3175 <    AdjustRecordOnInsert(Buff);
3176 <    if (State = dsInsert) then
3177 <    begin
3178 <      bInserting := True;
3179 <      Qry := FQInsert;
3180 <      PRecordData(Buff)^.rdUpdateStatus := usInserted;
3181 <      PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted;
3182 <      WriteRecordCache(FRecordCount, Buff);
3183 <      FCurrentRecord := FRecordCount;
3184 <    end
3185 <    else begin
3186 <      bInserting := False;
3187 <      Qry := FQModify;
3188 <      if PRecordData(Buff)^.rdCachedUpdateStatus = cusUnmodified then
3189 <      begin
3190 <        PRecordData(Buff)^.rdUpdateStatus := usModified;
3191 <        PRecordData(Buff)^.rdCachedUpdateStatus := cusModified;
3192 <      end
3193 <      else if PRecordData(Buff)^.
3194 <                    rdCachedUpdateStatus = cusUninserted then
3195 <            begin
3196 <              PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted;
3197 <              Dec(FDeletedRecords);
3198 <            end;
3199 <    end;
3200 <    if (not CachedUpdates) then
3201 <      InternalPostRecord(Qry, Buff)
3202 <    else begin
3203 <      WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
3204 <      FUpdatesPending := True;
3205 <    end;
3206 <    if bInserting then
3207 <      Inc(FRecordCount);
3208 <  finally
3209 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3210 <      Screen.Cursor := crDefault;
3211 <  end;
3212 < end;
3213 <
3214 < procedure TIBCustomDataSet.InternalRefresh;
3215 < begin
3216 <  inherited;
3217 <  InternalRefreshRow;
3218 < end;
3219 <
3220 < procedure TIBCustomDataSet.InternalSetToRecord(Buffer: PChar);
3221 < begin
3222 <  InternalGotoBookmark(@(PRecordData(Buffer)^.rdRecordNumber));
3223 < end;
3224 <
3225 < function TIBCustomDataSet.IsCursorOpen: Boolean;
3226 < begin
3227 <  result := FOpen;
3228 < end;
3229 <
3230 < function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3231 <                                 Options: TLocateOptions): Boolean;
3232 < var
3233 <  CurBookmark: string;
3234 < begin
3235 <  DisableControls;
3236 <  try
3237 <    CurBookmark := Bookmark;
3238 <    First;
3239 <    result := InternalLocate(KeyFields, KeyValues, Options);
3240 <    if not result then
3241 <      Bookmark := CurBookmark;
3242 <  finally
3243 <    EnableControls;
3244 <  end;
3245 < end;
3246 <
3247 < function TIBCustomDataSet.Lookup(const KeyFields: string; const KeyValues: Variant;
3248 <                                 const ResultFields: string): Variant;
3249 < var
3250 <  fl: TList;
3251 <  CurBookmark: string;
3252 < begin
3253 <  DisableControls;
3254 <  fl := TList.Create;
3255 <  CurBookmark := Bookmark;
3256 <  try
3257 <    First;
3258 <    if InternalLocate(KeyFields, KeyValues, []) then
3259 <    begin
3260 <      if (ResultFields <> '') then
3261 <        result := FieldValues[ResultFields]
3262 <      else
3263 <        result := NULL;
3264 <    end
3265 <    else
3266 <      result := Null;
3267 <  finally
3268 <    Bookmark := CurBookmark;
3269 <    fl.Free;
3270 <    EnableControls;
3271 <  end;
3272 < end;
3273 <
3274 < procedure TIBCustomDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
3275 < begin
3276 <  PRecordData(Buffer)^.rdRecordNumber := PInteger(Data)^;
3277 < end;
3278 <
3279 < procedure TIBCustomDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
3280 < begin
3281 <  PRecordData(Buffer)^.rdBookmarkFlag := Value;
3282 < end;
3283 <
3284 < procedure TIBCustomDataSet.SetCachedUpdates(Value: Boolean);
3285 < begin
3286 <  if not Value and FCachedUpdates then
3287 <    CancelUpdates;
3288 <  if (not (csReading in ComponentState)) and Value then
3289 <    CheckDatasetClosed;
3290 <  FCachedUpdates := Value;
3291 < end;
3292 <
3293 < procedure TIBCustomDataSet.SetDataSource(Value: TDataSource);
3294 < begin
3295 <  if IsLinkedTo(Value) then
3296 <    IBError(ibxeCircularReference, [nil]);
3297 <  if FDataLink <> nil then
3298 <    FDataLink.DataSource := Value;
3299 < end;
3300 <
3301 < procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
3302 < var
3303 <  Buff, TmpBuff: PChar;
3304 < begin
3305 <  Buff := GetActiveBuf;
3306 <  if Field.FieldNo < 0 then
3307 <  begin
3308 <    TmpBuff := Buff + FRecordSize + Field.Offset;
3309 <    Boolean(TmpBuff[0]) := LongBool(Buffer);
3310 <    if Boolean(TmpBuff[0]) then
3311 <      Move(Buffer^, TmpBuff[1], Field.DataSize);
3312 <    WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
3313 <  end
3314 <  else begin
3315 <    CheckEditState;
3316 <    with PRecordData(Buff)^ do
3317 <    begin
3318 <      { If inserting, Adjust record position }
3319 <      AdjustRecordOnInsert(Buff);
3320 <      if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3321 <         (FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
3322 <      begin
3323 <        Field.Validate(Buffer);
3324 <        if (Buffer = nil) or
3325 <           (Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
3326 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
3327 <        else begin
3328 <          Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
3329 <                 rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
3330 <          if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
3331 <             (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
3332 <            rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
3333 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
3334 <          if rdUpdateStatus = usUnmodified then
3335 <          begin
3336 <            if CachedUpdates then
3337 <            begin
3338 <              FUpdatesPending := True;
3339 <              if State = dsInsert then
3340 <                rdCachedUpdateStatus := cusInserted
3341 <              else if State = dsEdit then
3342 <                rdCachedUpdateStatus := cusModified;
3343 <            end;
3344 <
3345 <            if State = dsInsert then
3346 <              rdUpdateStatus := usInserted
3347 <            else
3348 <              rdUpdateStatus := usModified;
3349 <          end;
3350 <          WriteRecordCache(rdRecordNumber, Buff);
3351 <          SetModified(True);
3352 <        end;
3353 <      end;
3354 <    end;
3355 <  end;
3356 <  if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
3357 <      DataEvent(deFieldChange, Longint(Field));
3358 < end;
3359 <
3360 < procedure TIBCustomDataSet.SetRecNo(Value: Integer);
3361 < begin
3362 <  CheckBrowseMode;
3363 <  if (Value < 1) then
3364 <    Value := 1
3365 <  else if Value > FRecordCount then
3366 <  begin
3367 <    InternalLast;
3368 <    Value := Min(FRecordCount, Value);
3369 <  end;
3370 <  if (Value <> RecNo) then
3371 <  begin
3372 <    DoBeforeScroll;
3373 <    FCurrentRecord := Value - 1;
3374 <    Resync([]);
3375 <    DoAfterScroll;
3376 <  end;
3377 < end;
3378 <
3379 < procedure TIBCustomDataSet.Disconnect;
3380 < begin
3381 < Close;
3382 < InternalUnPrepare;
3383 < end;
3384 <
3385 < procedure TIBCustomDataSet.SetUpdateMode(const Value: TUpdateMode);
3386 < begin
3387 <  if not CanModify then
3388 <    IBError(ibxeCannotUpdate, [nil])
3389 <  else
3390 <    FUpdateMode := Value;
3391 < end;
3392 <
3393 <
3394 < procedure TIBCustomDataSet.SetUpdateObject(Value: TIBDataSetUpdateObject);
3395 < begin
3396 <  if Value <> FUpdateObject then
3397 <  begin
3398 <    if Assigned(FUpdateObject) and (FUpdateObject.DataSet = Self) then
3399 <      FUpdateObject.DataSet := nil;
3400 <    FUpdateObject := Value;
3401 <    if Assigned(FUpdateObject) then
3402 <    begin
3403 <      if Assigned(FUpdateObject.DataSet) and
3404 <        (FUpdateObject.DataSet <> Self) then
3405 <        FUpdateObject.DataSet.UpdateObject := nil;
3406 <      FUpdateObject.DataSet := Self;
3407 <    end;
3408 <  end;
3409 < end;
3410 <
3411 < function TIBCustomDataSet.ConstraintsStored: Boolean;
3412 < begin
3413 <  Result := Constraints.Count > 0;
3414 < end;
3415 <
3416 < procedure TIBCustomDataSet.ClearCalcFields(Buffer: PChar);
3417 < begin
3418 < FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
3419 < end;
3420 <
3421 <
3422 < procedure TIBCustomDataSet.InternalUnPrepare;
3423 < begin
3424 <  if FInternalPrepared then
3425 <  begin
3426 <    CheckDatasetClosed;
3427 <    FieldDefs.Clear;
3428 <    FInternalPrepared := False;
3429 <  end;
3430 < end;
3431 <
3432 < procedure TIBCustomDataSet.InternalExecQuery;
3433 < var
3434 <  DidActivate: Boolean;
3435 <  SetCursor: Boolean;
3436 < begin
3437 <  DidActivate := False;
3438 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3439 <  if SetCursor then
3440 <    Screen.Cursor := crHourGlass;
3441 <  try
3442 <    ActivateConnection;
3443 <    DidActivate := ActivateTransaction;
3444 <    if FQSelect.SQL.Text = '' then
3445 <      IBError(ibxeEmptyQuery, [nil]);
3446 <    if not FInternalPrepared then
3447 <      InternalPrepare;
3448 <    if FQSelect.SQLType = SQLSelect then
3449 <    begin
3450 <      IBError(ibxeIsASelectStatement, [nil]);
3451 <    end
3452 <    else
3453 <      FQSelect.ExecQuery;
3454 <  finally
3455 <    if DidActivate then
3456 <      DeactivateTransaction;
3457 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3458 <      Screen.Cursor := crDefault;
3459 <  end;
3460 < end;
3461 <
3462 < function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
3463 < begin
3464 <  Result := FQSelect.Handle;
3465 < end;
3466 <
3467 < procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
3468 < begin
3469 <  inherited InitRecord(Buffer);
3470 <  with PRecordData(Buffer)^ do
3471 <  begin
3472 <    rdUpdateStatus := TUpdateStatus(usInserted);
3473 <    rdBookMarkFlag := bfInserted;
3474 <    rdRecordNumber := -1;
3475 <  end;
3476 < end;
3477 <
3478 < procedure TIBCustomDataSet.InternalInsert;
3479 < begin
3480 <  CursorPosChanged;
3481 < end;
3482 <
3483 < { TIBDataSet IProviderSupport }
3484 <
3485 < procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
3486 < begin
3487 <  if Commit then
3488 <    Transaction.Commit else
3489 <    Transaction.Rollback;
3490 < end;
3491 <
3492 < function TIBCustomDataSet.PSExecuteStatement(const ASQL: string; AParams: TParams;
3493 <  ResultSet: Pointer = nil): Integer;
3494 < var
3495 <  FQuery: TIBQuery;
3496 < begin
3497 <  if Assigned(ResultSet) then
3498 <  begin
3499 <    TDataSet(ResultSet^) := TIBQuery.Create(nil);
3500 <    with TIBQuery(ResultSet^) do
3501 <    begin
3502 <      SQL.Text := ASQL;
3503 <      Params.Assign(AParams);
3504 <      Open;
3505 <      Result := RowsAffected;
3506 <    end;
3507 <  end
3508 <  else
3509 <  begin
3510 <    FQuery := TIBQuery.Create(nil);
3511 <    try
3512 <      FQuery.Database := Database;
3513 <      FQuery.Transaction := Transaction;
3514 <      FQuery.GenerateParamNames := True;
3515 <      FQuery.SQL.Text := ASQL;
3516 <      FQuery.Params.Assign(AParams);
3517 <      FQuery.ExecSQL;
3518 <      Result := FQuery.RowsAffected;
3519 <    finally
3520 <      FQuery.Free;
3521 <    end;
3522 <  end;
3523 < end;
3524 <
3525 < function TIBCustomDataSet.PSGetQuoteChar: string;
3526 < begin
3527 <  if Database.SQLDialect = 3 then
3528 <    Result := '"' else
3529 <    Result := '';
3530 < end;
3531 <
3532 < function TIBCustomDataSet.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError;
3533 < var
3534 <  PrevErr: Integer;
3535 < begin
3536 <  if Prev <> nil then
3537 <    PrevErr := Prev.ErrorCode else
3538 <    PrevErr := 0;
3539 <  if E is EIBError then
3540 <    with EIBError(E) do
3541 <      Result := EUpdateError.Create(E.Message, '', SQLCode, PrevErr, E) else
3542 <      Result := inherited PSGetUpdateException(E, Prev);
3543 < end;
3544 <
3545 < function TIBCustomDataSet.PSInTransaction: Boolean;
3546 < begin
3547 <  Result := Transaction.InTransaction;
3548 < end;
3549 <
3550 < function TIBCustomDataSet.PSIsSQLBased: Boolean;
3551 < begin
3552 <  Result := True;
3553 < end;
3554 <
3555 < function TIBCustomDataSet.PSIsSQLSupported: Boolean;
3556 < begin
3557 <  Result := True;
3558 < end;
3559 <
3560 < procedure TIBCustomDataSet.PSReset;
3561 < begin
3562 <  inherited PSReset;
3563 <  if Active then
3564 <  begin
3565 <    Close;
3566 <    Open;
3567 <  end;
3568 < end;
3569 <
3570 < function TIBCustomDataSet.PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean;
3571 < var
3572 <  UpdateAction: TIBUpdateAction;
3573 <  SQL: string;
3574 <  Params: TParams;
3575 <
3576 <  procedure AssignParams(DataSet: TDataSet; Params: TParams);
3577 <  var
3578 <    I: Integer;
3579 <    Old: Boolean;
3580 <    Param: TParam;
3581 <    PName: string;
3582 <    Field: TField;
3583 <    Value: Variant;
3584 <  begin
3585 <    for I := 0 to Params.Count - 1 do
3586 <    begin
3587 <      Param := Params[I];
3588 <      PName := Param.Name;
3589 <      Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize}
3590 <      if Old then System.Delete(PName, 1, 4);
3591 <      Field := DataSet.FindField(PName);
3592 <      if not Assigned(Field) then Continue;
3593 <      if Old then Param.AssignFieldValue(Field, Field.OldValue) else
3594 <      begin
3595 <        Value := Field.NewValue;
3596 <        if VarIsEmpty(Value) then Value := Field.OldValue;
3597 <        Param.AssignFieldValue(Field, Value);
3598 <      end;
3599 <    end;
3600 <  end;
3601 <
3602 < begin
3603 <  Result := False;
3604 <  if Assigned(OnUpdateRecord) then
3605 <  begin
3606 <    UpdateAction := uaFail;
3607 <    if Assigned(FOnUpdateRecord) then
3608 <    begin
3609 <      FOnUpdateRecord(Delta, UpdateKind, UpdateAction);
3610 <      Result := UpdateAction = uaApplied;
3611 <    end;
3612 <  end
3613 <  else if Assigned(FUpdateObject) then
3614 <  begin
3615 <    SQL := FUpdateObject.GetSQL(UpdateKind).Text;
3616 <    if SQL <> '' then
3617 <    begin
3618 <      Params := TParams.Create;
3619 <      try
3620 <        Params.ParseSQL(SQL, True);
3621 <        AssignParams(Delta, Params);
3622 <        if PSExecuteStatement(SQL, Params) = 0 then
3623 <          IBError(ibxeNoRecordsAffected, [nil]);
3624 <        Result := True;
3625 <      finally
3626 <        Params.Free;
3627 <      end;
3628 <    end;
3629 <  end;
3630 < end;
3631 <
3632 < procedure TIBCustomDataSet.PSStartTransaction;
3633 < begin
3634 <  ActivateConnection;
3635 <  Transaction.StartTransaction;
3636 < end;
3637 <
3638 < function TIBCustomDataSet.PSGetTableName: string;
3639 < begin
3640 < //  if not FInternalPrepared then
3641 < //    InternalPrepare;
3642 <  { It is possible for the FQSelectSQL to be unprepared
3643 <    with FInternalPreprepared being true (see DoBeforeTransactionEnd).
3644 <    So check the Prepared of the SelectSQL instead }
3645 <  if not FQSelect.Prepared then
3646 <    FQSelect.Prepare;
3647 <  Result := FQSelect.UniqueRelationName;
3648 < end;
3649 <
3650 < procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
3651 < begin
3652 <  InternalBatchInput(InputObject);
3653 < end;
3654 <
3655 < procedure TIBDataSet.BatchOutput(OutputObject: TIBBatchOutput);
3656 < begin
3657 <  InternalBatchOutput(OutputObject);
3658 < end;
3659 <
3660 < procedure TIBDataSet.ExecSQL;
3661 < begin
3662 <  InternalExecQuery;
3663 < end;
3664 <
3665 < procedure TIBDataSet.Prepare;
3666 < begin
3667 <  InternalPrepare;
3668 < end;
3669 <
3670 < procedure TIBDataSet.UnPrepare;
3671 < begin
3672 <  InternalUnPrepare;
3673 < end;
3674 <
3675 < function TIBDataSet.GetPrepared: Boolean;
3676 < begin
3677 <  Result := InternalPrepared;
3678 < end;
3679 <
3680 < procedure TIBDataSet.InternalOpen;
3681 < begin
3682 <  ActivateConnection;
3683 <  ActivateTransaction;
3684 <  InternalSetParamsFromCursor;
3685 <  Inherited;
3686 < end;
3687 <
3688 < procedure TIBDataSet.SetFiltered(Value: Boolean);
3689 < begin
3690 <  if(Filtered <> Value) then
3691 <  begin
3692 <    inherited SetFiltered(value);
3693 <    if Active then
3694 <    begin
3695 <      Close;
3696 <      Open;
3697 <    end;
3698 <  end
3699 <  else
3700 <    inherited SetFiltered(value);
3701 < end;
3702 <
3703 < function TIBCustomDataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
3704 < begin
3705 <  Result := false;
3706 <  if not Assigned(Bookmark) then
3707 <    exit;
3708 <  Result := PInteger(Bookmark)^ < FRecordCount;
3709 < end;
3710 <
3711 < function TIBCustomDataSet.GetFieldData(Field: TField;
3712 <  Buffer: Pointer): Boolean;
3713 < var
3714 <  lTempCurr : System.Currency;
3715 < begin
3716 <  if (Field.DataType = ftBCD) and (Buffer <> nil) then
3717 <  begin
3718 <    Result := InternalGetFieldData(Field, @lTempCurr);
3719 <    if Result then
3720 <      CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
3721 <  end
3722 <  else
3723 <    Result := InternalGetFieldData(Field, Buffer);
3724 < end;
3725 <
3726 < function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
3727 <  NativeFormat: Boolean): Boolean;
3728 < begin
3729 <  if (Field.DataType = ftBCD) and not NativeFormat then
3730 <    Result := InternalGetFieldData(Field, Buffer)
3731 <  else
3732 <    Result := inherited GetFieldData(Field, Buffer, NativeFormat);
3733 < end;
3734 <
3735 < procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
3736 < var
3737 <  lTempCurr : System.Currency;
3738 < begin
3739 <  if Field.DataType = ftBCD then
3740 <  begin
3741 <    BCDToCurr(TBCD(Buffer^), lTempCurr);
3742 <    InternalSetFieldData(Field, @lTempCurr);
3743 <  end
3744 <  else
3745 <    InternalSetFieldData(Field, Buffer);
3746 < end;
3747 <
3748 < procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
3749 <  NativeFormat: Boolean);
3750 < begin
3751 <  if (not NativeFormat) and (Field.DataType = ftBCD) then
3752 <    InternalSetfieldData(Field, Buffer)
3753 <  else
3754 <    inherited SetFieldData(Field, buffer, NativeFormat);
3755 < end;
3756 <
3757 < { TIBDataSetUpdateObject }
3758 <
3759 < constructor TIBDataSetUpdateObject.Create(AOwner: TComponent);
3760 < begin
3761 <  inherited Create(AOwner);
3762 <  FRefreshSQL := TStringList.Create;
3763 < end;
3764 <
3765 < destructor TIBDataSetUpdateObject.Destroy;
3766 < begin
3767 <  FRefreshSQL.Free;
3768 <  inherited destroy;
3769 < end;
3770 <
3771 < procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
3772 < begin
3773 <  FRefreshSQL.Assign(Value);
3774 < end;
3775 <
3776 < { TIBDSBlobStream }
3777 < constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
3778 <                                    Mode: TBlobStreamMode);
3779 < begin
3780 <  FField := AField;
3781 <  FBlobStream := ABlobStream;
3782 <  FBlobStream.Seek(0, soFromBeginning);
3783 <  if (Mode = bmWrite) then
3784 <    FBlobStream.Truncate;
3785 < end;
3786 <
3787 < function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
3788 < begin
3789 <  result := FBlobStream.Read(Buffer, Count);
3790 < end;
3791 <
3792 < function TIBDSBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
3793 < begin
3794 <  result := FBlobStream.Seek(Offset, Origin);
3795 < end;
3796 <
3797 < procedure TIBDSBlobStream.SetSize(NewSize: Longint);
3798 < begin
3799 <  FBlobStream.SetSize(NewSize);
3800 < end;
3801 <
3802 < function TIBDSBlobStream.Write(const Buffer; Count: Longint): Longint;
3803 < begin
3804 <  if not (FField.DataSet.State in [dsEdit, dsInsert]) then
3805 <    IBError(ibxeNotEditing, [nil]);
3806 <  TIBCustomDataSet(FField.DataSet).RecordModified(True);
3807 <  result := FBlobStream.Write(Buffer, Count);
3808 <  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
3809 < end;
3810 <
3811 < end.
1 > {************************************************************************}
2 > {                                                                        }
3 > {       Borland Delphi Visual Component Library                          }
4 > {       InterBase Express core components                                }
5 > {                                                                        }
6 > {       Copyright (c) 1998-2000 Inprise 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            }
16 > {    may obtain a copy of the License at http://www.Inprise.com/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 Inprise Corporation are Copyright (C) Inprise   }
24 > {       Corporation. All Rights Reserved.                                }
25 > {    Contributor(s): Jeff Overcash                                       }
26 > {                                                                        }
27 > {    IBX For Lazarus (Firebird Express)                                  }
28 > {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 > {    Portions created by MWA Software are copyright McCallum Whyman      }
30 > {    Associates Ltd 2011 - 2015                                                }
31 > {                                                                        }
32 > {************************************************************************}
33 >
34 > unit IBCustomDataSet;
35 >
36 > {$R-}
37 >
38 > {$Mode Delphi}
39 >
40 > {$IFDEF DELPHI}
41 > {$DEFINE TDBDFIELD_IS_BCD}
42 > {$ENDIF}
43 >
44 > interface
45 >
46 > uses
47 > {$IFDEF WINDOWS }
48 >  Windows,
49 > {$ELSE}
50 >  unix,
51 > {$ENDIF}
52 >  SysUtils, Classes, Forms, Controls, IBDatabase,
53 >  IBExternals, IB, IBHeader,  IBSQL, Db,
54 >  IBUtils, IBBlob, IBSQLParser;
55 >
56 > const
57 >  BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
58 >  UniCache           =  2;     { Uni-directional cache is 2 records big }
59 >
60 > type
61 >  TIBCustomDataSet = class;
62 >  TIBDataSet = class;
63 >
64 >  { TIBDataSetUpdateObject }
65 >
66 >  TIBDataSetUpdateObject = class(TComponent)
67 >  private
68 >    FRefreshSQL: TStrings;
69 >    procedure SetRefreshSQL(value: TStrings);
70 >  protected
71 >    function GetDataSet: TIBCustomDataSet; virtual; abstract;
72 >    procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
73 >    procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract;
74 >    function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
75 >    procedure InternalSetParams(Query: TIBSQL; buff: PChar);
76 >    property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
77 >  public
78 >    constructor Create(AOwner: TComponent); override;
79 >    destructor Destroy; override;
80 >  published
81 >    property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
82 >  end;
83 >
84 >  TBlobDataArray = array[0..0] of TIBBlobStream;
85 >  PBlobDataArray = ^TBlobDataArray;
86 >
87 >  { TIBCustomDataSet }
88 >  TFieldData = record
89 >    fdDataType: Short;
90 >    fdDataScale: Short;
91 >    fdNullable: Boolean;
92 >    fdIsNull: Boolean;
93 >    fdDataSize: Short;
94 >    fdDataLength: Short;
95 >    fdDataOfs: Integer;
96 >  end;
97 >  PFieldData = ^TFieldData;
98 >
99 >  TCachedUpdateStatus = (
100 >                         cusUnmodified, cusModified, cusInserted,
101 >                         cusDeleted, cusUninserted
102 >                        );
103 >  TIBDBKey = record
104 >    DBKey: array[0..7] of Byte;
105 >  end;
106 >  PIBDBKey = ^TIBDBKey;
107 >
108 >  TRecordData = record
109 >    rdBookmarkFlag: TBookmarkFlag;
110 >    rdFieldCount: Short;
111 >    rdRecordNumber: Integer;
112 >    rdCachedUpdateStatus: TCachedUpdateStatus;
113 >    rdUpdateStatus: TUpdateStatus;
114 >    rdSavedOffset: DWORD;
115 >    rdDBKey: TIBDBKey;
116 >    rdFields: array[1..1] of TFieldData;
117 >  end;
118 >  PRecordData = ^TRecordData;
119 >
120 >  { TIBStringField allows us to have strings longer than 8196 }
121 >
122 >  TIBStringField = class(TStringField)
123 >  private
124 >    FInitialised: boolean;
125 >  protected
126 >    procedure SetSize(AValue: Integer); override;
127 >  public
128 >    constructor create(AOwner: TComponent); override;
129 >    class procedure CheckTypeSize(Value: Integer); override;
130 >    function GetAsString: string; override;
131 >    function GetAsVariant: Variant; override;
132 >    function GetValue(var Value: string): Boolean;
133 >    procedure SetAsString(const Value: string); override;
134 >  end;
135 >
136 >  { TIBBCDField }
137 >  {  Actually, there is no BCD involved in this type,
138 >     instead it deals with currency types.
139 >     In IB, this is an encapsulation of Numeric (x, y)
140 >     where x < 18 and y <= 4.
141 >     Note: y > 4 will default to Floats
142 >  }
143 >  TIBBCDField = class(TBCDField)
144 >  protected
145 >    class procedure CheckTypeSize(Value: Integer); override;
146 >    function GetAsCurrency: Currency; override;
147 >    function GetAsString: string; override;
148 >    function GetAsVariant: Variant; override;
149 >    function GetDataSize: Integer; override;
150 >  public
151 >    constructor Create(AOwner: TComponent); override;
152 >  published
153 >    property Size default 8;
154 >  end;
155 >
156 >  TIBDataLink = class(TDetailDataLink)
157 >  private
158 >    FDataSet: TIBCustomDataSet;
159 >  protected
160 >    procedure ActiveChanged; override;
161 >    procedure RecordChanged(Field: TField); override;
162 >    function GetDetailDataSet: TDataSet; override;
163 >    procedure CheckBrowseMode; override;
164 >  public
165 >    constructor Create(ADataSet: TIBCustomDataSet);
166 >    destructor Destroy; override;
167 >  end;
168 >
169 >  TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord);
170 >
171 >  { TIBGenerator }
172 >
173 >  TIBGenerator = class(TPersistent)
174 >  private
175 >    FOwner: TIBCustomDataSet;
176 >    FApplyOnEvent: TIBGeneratorApplyOnEvent;
177 >    FFieldName: string;
178 >    FGeneratorName: string;
179 >    FIncrement: integer;
180 >    procedure SetIncrement(const AValue: integer);
181 >  protected
182 >    function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
183 >  public
184 >    constructor Create(Owner: TIBCustomDataSet);
185 >    procedure Apply;
186 >    property Owner: TIBCustomDataSet read FOwner;
187 >  published
188 >    property Generator: string read FGeneratorName write FGeneratorName;
189 >    property Field: string read FFieldName write FFieldName;
190 >    property Increment: integer read FIncrement write SetIncrement default 1;
191 >    property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
192 >  end;
193 >
194 >  {TIBControlLink - Allows IB Aware controls to react to dataset state changes}
195 >
196 >  TIBControlLink = class
197 >  private
198 >    FTIBDataSet: TIBCustomDataSet;
199 >    procedure SetIBDataSet(AValue: TIBCustomDataSet);
200 >  protected
201 >    procedure UpdateSQL(Sender: TObject); virtual;
202 >    procedure UpdateParams(Sender: TObject); virtual;
203 >  public
204 >    destructor Destroy; override;
205 >    property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
206 >  end;
207 >
208 >  TIBAutoCommit = (acDisabled, acCommitRetaining);
209 >
210 >  { TIBCustomDataSet }
211 >  TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
212 >
213 >  TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
214 >                                 UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
215 >                                 of object;
216 >  TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
217 >                                   var UpdateAction: TIBUpdateAction) of object;
218 >
219 >  TIBUpdateRecordTypes = set of TCachedUpdateStatus;
220 >
221 >  TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
222 >
223 >  TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
224 >
225 >  TIBCustomDataSet = class(TDataset)
226 >  private
227 >    FAutoCommit: TIBAutoCommit;
228 >    FGenerateParamNames: Boolean;
229 >    FGeneratorField: TIBGenerator;
230 >    FNeedsRefresh: Boolean;
231 >    FForcedRefresh: Boolean;
232 >    FDidActivate: Boolean;
233 >    FIBLoaded: Boolean;
234 >    FBase: TIBBase;
235 >    FBlobCacheOffset: Integer;
236 >    FBlobStreamList: TList;
237 >    FBufferChunks: Integer;
238 >    FBufferCache,
239 >    FOldBufferCache: PChar;
240 >    FBufferChunkSize,
241 >    FCacheSize,
242 >    FOldCacheSize: Integer;
243 >    FFilterBuffer: PChar;
244 >    FBPos,
245 >    FOBPos,
246 >    FBEnd,
247 >    FOBEnd: DWord;
248 >    FCachedUpdates: Boolean;
249 >    FCalcFieldsOffset: Integer;
250 >    FCurrentRecord: Long;
251 >    FDeletedRecords: Long;
252 >    FModelBuffer,
253 >    FOldBuffer: PChar;
254 >    FOnValidatePost: TOnValidatePost;
255 >    FOpen: Boolean;
256 >    FInternalPrepared: Boolean;
257 >    FQDelete,
258 >    FQInsert,
259 >    FQRefresh,
260 >    FQSelect,
261 >    FQModify: TIBSQL;
262 >    FRecordBufferSize: Integer;
263 >    FRecordCount: Integer;
264 >    FRecordSize: Integer;
265 >    FDataSetCloseAction: TDataSetCloseAction;
266 >    FUniDirectional: Boolean;
267 >    FUpdateMode: TUpdateMode;
268 >    FUpdateObject: TIBDataSetUpdateObject;
269 >    FParamCheck: Boolean;
270 >    FUpdatesPending: Boolean;
271 >    FUpdateRecordTypes: TIBUpdateRecordTypes;
272 >    FMappedFieldPosition: array of Integer;
273 >    FDataLink: TIBDataLink;
274 >
275 >    FBeforeDatabaseDisconnect,
276 >    FAfterDatabaseDisconnect,
277 >    FDatabaseFree: TNotifyEvent;
278 >    FOnUpdateError: TIBUpdateErrorEvent;
279 >    FOnUpdateRecord: TIBUpdateRecordEvent;
280 >    FBeforeTransactionEnd,
281 >    FAfterTransactionEnd,
282 >    FTransactionFree: TNotifyEvent;
283 >    FAliasNameMap: array of string;
284 >    FAliasNameList: array of string;
285 >    FBaseSQLSelect: TStrings;
286 >    FParser: TSelectSQLParser;
287 >    FCloseAction: TTransactionAction;
288 >    FInTransactionEnd: boolean;
289 >    FIBLinks: TList;
290 >    function GetSelectStmtHandle: TISC_STMT_HANDLE;
291 >    procedure SetUpdateMode(const Value: TUpdateMode);
292 >    procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
293 >
294 >    function AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode): TGetResult;
295 >    procedure AdjustRecordOnInsert(Buffer: Pointer);
296 >    function CanEdit: Boolean;
297 >    function CanInsert: Boolean;
298 >    function CanDelete: Boolean;
299 >    function CanRefresh: Boolean;
300 >    procedure CheckEditState;
301 >    procedure ClearBlobCache;
302 >    procedure ClearIBLinks;
303 >    procedure CopyRecordBuffer(Source, Dest: Pointer);
304 >    procedure DoBeforeDatabaseDisconnect(Sender: TObject);
305 >    procedure DoAfterDatabaseDisconnect(Sender: TObject);
306 >    procedure DoDatabaseFree(Sender: TObject);
307 >    procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
308 >    procedure DoAfterTransactionEnd(Sender: TObject);
309 >    procedure DoTransactionFree(Sender: TObject);
310 >    procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
311 >                                         Buffer: PChar);
312 >    function GetDatabase: TIBDatabase;
313 >    function GetDBHandle: PISC_DB_HANDLE;
314 >    function GetDeleteSQL: TStrings;
315 >    function GetInsertSQL: TStrings;
316 >    function GetSQLParams: TIBXSQLDA;
317 >    function GetRefreshSQL: TStrings;
318 >    function GetSelectSQL: TStrings;
319 >    function GetStatementType: TIBSQLTypes;
320 >    function GetModifySQL: TStrings;
321 >    function GetTransaction: TIBTransaction;
322 >    function GetTRHandle: PISC_TR_HANDLE;
323 >    function GetParser: TSelectSQLParser;
324 >    procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
325 >    function InternalLocate(const KeyFields: string; const KeyValues: Variant;
326 >                            Options: TLocateOptions): Boolean; virtual;
327 >    procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
328 >    procedure InternalRevertRecord(RecordNumber: Integer); virtual;
329 >    function IsVisible(Buffer: PChar): Boolean;
330 >    procedure RegisterIBLink(Sender: TIBControlLink);
331 >    procedure UnRegisterIBLink(Sender: TIBControlLink);
332 >    procedure SaveOldBuffer(Buffer: PChar);
333 >    procedure SetBufferChunks(Value: Integer);
334 >    procedure SetDatabase(Value: TIBDatabase);
335 >    procedure SetDeleteSQL(Value: TStrings);
336 >    procedure SetInsertSQL(Value: TStrings);
337 >    procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
338 >    procedure SetRefreshSQL(Value: TStrings);
339 >    procedure SetSelectSQL(Value: TStrings);
340 >    procedure SetModifySQL(Value: TStrings);
341 >    procedure SetTransaction(Value: TIBTransaction);
342 >    procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
343 >    procedure SetUniDirectional(Value: Boolean);
344 >    procedure RefreshParams;
345 >    procedure SQLChanging(Sender: TObject); virtual;
346 >    function AdjustPosition(FCache: PChar; Offset: DWORD;
347 >                            Origin: Integer): DWORD;
348 >    procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
349 >                       Buffer: PChar);
350 >    procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
351 >                              ReadOldBuffer: Boolean);
352 >    procedure WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer;
353 >                        Buffer: PChar);
354 >    procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
355 >    function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
356 >                       DoCheck: Boolean): TGetResult; virtual;
357 >
358 >  protected
359 >    procedure ActivateConnection;
360 >    function ActivateTransaction: Boolean;
361 >    procedure DeactivateTransaction;
362 >    procedure CheckDatasetClosed;
363 >    procedure CheckDatasetOpen;
364 >    function CreateParser: TSelectSQLParser; virtual;
365 >    procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
366 >    function GetActiveBuf: PChar;
367 >    procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
368 >    procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
369 >    procedure InternalPrepare; virtual;
370 >    procedure InternalUnPrepare; virtual;
371 >    procedure InternalExecQuery; virtual;
372 >    procedure InternalRefreshRow; virtual;
373 >    procedure InternalSetParamsFromCursor; virtual;
374 >    procedure CheckNotUniDirectional;
375 >
376 > (*    { IProviderSupport }
377 >    procedure PSEndTransaction(Commit: Boolean); override;
378 >    function PSExecuteStatement(const ASQL: string; AParams: TParams;
379 >      ResultSet: Pointer = nil): Integer; override;
380 >    function PsGetTableName: string; override;
381 >    function PSGetQuoteChar: string; override;
382 >    function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
383 >    function PSInTransaction: Boolean; override;
384 >    function PSIsSQLBased: Boolean; override;
385 >    function PSIsSQLSupported: Boolean; override;
386 >    procedure PSStartTransaction; override;
387 >    procedure PSReset; override;
388 >    function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
389 > *)
390 >    { TDataSet support }
391 >    procedure InternalInsert; override;
392 >    procedure InitRecord(Buffer: PChar); override;
393 >    procedure Disconnect; virtual;
394 >    function ConstraintsStored: Boolean;
395 >    procedure ClearCalcFields(Buffer: PChar); override;
396 >    function AllocRecordBuffer: PChar; override;
397 >    procedure DoBeforeDelete; override;
398 >    procedure DoAfterDelete; override;
399 >    procedure DoBeforeEdit; override;
400 >    procedure DoAfterEdit; override;
401 >    procedure DoBeforeInsert; override;
402 >    procedure DoAfterInsert; override;
403 >    procedure DoBeforeClose; override;
404 >    procedure DoBeforeOpen; override;
405 >    procedure DoBeforePost; override;
406 >    procedure DoAfterPost; override;
407 >    procedure FreeRecordBuffer(var Buffer: PChar); override;
408 >    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
409 >    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
410 >    function GetCanModify: Boolean; override;
411 >    function GetDataSource: TDataSource; override;
412 >    function GetDBAliasName(FieldNo: integer): string;
413 >    function GetFieldDefFromAlias(aliasName: string): TFieldDef;
414 >    function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
415 >    function GetRecNo: Integer; override;
416 >    function GetRecord(Buffer: PChar; GetMode: TGetMode;
417 >                       DoCheck: Boolean): TGetResult; override;
418 >    function GetRecordCount: Integer; override;
419 >    function GetRecordSize: Word; override;
420 >    procedure InternalAutoCommit;
421 >    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
422 >    procedure InternalCancel; override;
423 >    procedure InternalClose; override;
424 >    procedure InternalDelete; override;
425 >    procedure InternalFirst; override;
426 >    function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual;
427 >    procedure InternalGotoBookmark(Bookmark: Pointer); override;
428 >    procedure InternalHandleException; override;
429 >    procedure InternalInitFieldDefs; override;
430 >    procedure InternalInitRecord(Buffer: PChar); override;
431 >    procedure InternalLast; override;
432 >    procedure InternalOpen; override;
433 >    procedure InternalPost; override;
434 >    procedure InternalRefresh; override;
435 >    procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
436 >    procedure InternalSetToRecord(Buffer: PChar); override;
437 >    function IsCursorOpen: Boolean; override;
438 >    procedure Loaded; override;
439 >    procedure ReQuery;
440 >    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
441 >    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
442 >    procedure SetCachedUpdates(Value: Boolean);
443 >    procedure SetDataSource(Value: TDataSource);
444 >    procedure SetGenerateParamNames(AValue: Boolean); virtual;
445 >    procedure SetFieldData(Field : TField; Buffer : Pointer); override;
446 >    procedure SetFieldData(Field : TField; Buffer : Pointer;
447 >      NativeFormat : Boolean); overload; override;
448 >    procedure SetRecNo(Value: Integer); override;
449 >
450 >  protected
451 >    {Likely to be made public by descendant classes}
452 >    property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
453 >    property SQLParams: TIBXSQLDA read GetSQLParams;
454 >    property Params: TIBXSQLDA read GetSQLParams;
455 >    property InternalPrepared: Boolean read FInternalPrepared;
456 >    property QDelete: TIBSQL read FQDelete;
457 >    property QInsert: TIBSQL read FQInsert;
458 >    property QRefresh: TIBSQL read FQRefresh;
459 >    property QSelect: TIBSQL read FQSelect;
460 >    property QModify: TIBSQL read FQModify;
461 >    property StatementType: TIBSQLTypes read GetStatementType;
462 >    property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
463 >
464 >    {Likely to be made published by descendant classes}
465 >    property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
466 >    property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
467 >    property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
468 >    property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
469 >    property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
470 >    property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
471 >    property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
472 >    property SelectSQL: TStrings read GetSelectSQL write SetSelectSQL;
473 >    property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
474 >    property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
475 >    property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
476 >    property Parser: TSelectSQLParser read GetParser;
477 >    property BaseSQLSelect: TStrings read FBaseSQLSelect;
478 >
479 >    property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
480 >                                                 write FBeforeDatabaseDisconnect;
481 >    property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
482 >                                                write FAfterDatabaseDisconnect;
483 >    property DatabaseFree: TNotifyEvent read FDatabaseFree
484 >                                        write FDatabaseFree;
485 >    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
486 >                                             write FBeforeTransactionEnd;
487 >    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
488 >                                            write FAfterTransactionEnd;
489 >    property TransactionFree: TNotifyEvent read FTransactionFree
490 >                                           write FTransactionFree;
491 >    property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
492 >
493 >  public
494 >    constructor Create(AOwner: TComponent); override;
495 >    destructor Destroy; override;
496 >    procedure ApplyUpdates;
497 >    function CachedUpdateStatus: TCachedUpdateStatus;
498 >    procedure CancelUpdates;
499 >    function GetFieldPosition(AliasName: string): integer;
500 >    procedure FetchAll;
501 >    function LocateNext(const KeyFields: string; const KeyValues: Variant;
502 >                        Options: TLocateOptions): Boolean;
503 >    procedure RecordModified(Value: Boolean);
504 >    procedure RevertRecord;
505 >    procedure Undelete;
506 >    procedure ResetParser;
507 >    function HasParser: boolean;
508 >
509 >    { TDataSet support methods }
510 >    function BookmarkValid(Bookmark: TBookmark): Boolean; override;
511 >    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
512 >    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
513 >    function GetCurrentRecord(Buffer: PChar): Boolean; override;
514 >    function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
515 >    function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
516 >    function GetFieldData(Field : TField; Buffer : Pointer;
517 >      NativeFormat : Boolean) : Boolean; overload; override;
518 >    property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
519 >    function Locate(const KeyFields: string; const KeyValues: Variant;
520 >                    Options: TLocateOptions): Boolean; override;
521 >    function Lookup(const KeyFields: string; const KeyValues: Variant;
522 >                    const ResultFields: string): Variant; override;
523 >    function UpdateStatus: TUpdateStatus; override;
524 >    function IsSequenced: Boolean; override;
525 >    procedure Post; override;
526 >    function ParamByName(ParamName: String): TIBXSQLVAR;
527 >    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
528 >    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
529 >    property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
530 >    property UpdatesPending: Boolean read FUpdatesPending;
531 >    property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
532 >                                                      write SetUpdateRecordTypes;
533 >    property DataSetCloseAction: TDataSetCloseAction
534 >               read FDataSetCloseAction write FDataSetCloseAction;
535 >
536 >  published
537 >    property Database: TIBDatabase read GetDatabase write SetDatabase;
538 >    property Transaction: TIBTransaction read GetTransaction
539 >                                          write SetTransaction;
540 >    property ForcedRefresh: Boolean read FForcedRefresh
541 >                                    write FForcedRefresh default False;
542 >    property AutoCalcFields;
543 >
544 >    property AfterCancel;
545 >    property AfterClose;
546 >    property AfterDelete;
547 >    property AfterEdit;
548 >    property AfterInsert;
549 >    property AfterOpen;
550 >    property AfterPost;
551 >    property AfterRefresh;
552 >    property AfterScroll;
553 >    property BeforeCancel;
554 >    property BeforeClose;
555 >    property BeforeDelete;
556 >    property BeforeEdit;
557 >    property BeforeInsert;
558 >    property BeforeOpen;
559 >    property BeforePost;
560 >    property BeforeRefresh;
561 >    property BeforeScroll;
562 >    property OnCalcFields;
563 >    property OnDeleteError;
564 >    property OnEditError;
565 >    property OnNewRecord;
566 >    property OnPostError;
567 >    property OnUpdateError: TIBUpdateErrorEvent read FOnUpdateError
568 >                                                 write FOnUpdateError;
569 >    property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord
570 >                                                   write FOnUpdateRecord;
571 >  end;
572 >
573 >  TIBParserDataSet = class(TIBCustomDataSet)
574 >  public
575 >    property Parser;
576 >  end;
577 >
578 >  TIBDataSet = class(TIBParserDataSet)
579 >  private
580 >    function GetPrepared: Boolean;
581 >
582 >  protected
583 >    procedure SetFiltered(Value: Boolean); override;
584 >    procedure InternalOpen; override;
585 >
586 >  public
587 >    procedure Prepare;
588 >    procedure UnPrepare;
589 >    procedure BatchInput(InputObject: TIBBatchInput);
590 >    procedure BatchOutput(OutputObject: TIBBatchOutput);
591 >    procedure ExecSQL;
592 >
593 >  public
594 >    property Params;
595 >    property Prepared : Boolean read GetPrepared;
596 >    property QDelete;
597 >    property QInsert;
598 >    property QRefresh;
599 >    property QSelect;
600 >    property QModify;
601 >    property StatementType;
602 >    property SelectStmtHandle;
603 >    property BaseSQLSelect;
604 >
605 >  published
606 >    { TIBCustomDataSet }
607 >    property AutoCommit;
608 >    property BufferChunks;
609 >    property CachedUpdates;
610 >    property DeleteSQL;
611 >    property InsertSQL;
612 >    property RefreshSQL;
613 >    property SelectSQL;
614 >    property ModifySQL;
615 >    property GeneratorField;
616 >    property GenerateParamNames;
617 >    property ParamCheck;
618 >    property UniDirectional;
619 >    property Filtered;
620 >    property DataSetCloseAction;
621 >
622 >    property BeforeDatabaseDisconnect;
623 >    property AfterDatabaseDisconnect;
624 >    property DatabaseFree;
625 >    property BeforeTransactionEnd;
626 >    property AfterTransactionEnd;
627 >    property TransactionFree;
628 >
629 >    { TIBDataSet }
630 >    property Active;
631 >    property AutoCalcFields;
632 >    property DataSource read GetDataSource write SetDataSource;
633 >
634 >    property AfterCancel;
635 >    property AfterClose;
636 >    property AfterDelete;
637 >    property AfterEdit;
638 >    property AfterInsert;
639 >    property AfterOpen;
640 >    property AfterPost;
641 >    property AfterScroll;
642 >    property BeforeCancel;
643 >    property BeforeClose;
644 >    property BeforeDelete;
645 >    property BeforeEdit;
646 >    property BeforeInsert;
647 >    property BeforeOpen;
648 >    property BeforePost;
649 >    property BeforeScroll;
650 >    property OnCalcFields;
651 >    property OnDeleteError;
652 >    property OnEditError;
653 >    property OnFilterRecord;
654 >    property OnNewRecord;
655 >    property OnPostError;
656 >    property OnValidatePost;
657 >  end;
658 >
659 >  { TIBDSBlobStream }
660 >  TIBDSBlobStream = class(TStream)
661 >  protected
662 >    FField: TField;
663 >    FBlobStream: TIBBlobStream;
664 >  public
665 >    constructor Create(AField: TField; ABlobStream: TIBBlobStream;
666 >                       Mode: TBlobStreamMode);
667 >    function Read(var Buffer; Count: Longint): Longint; override;
668 >    function Seek(Offset: Longint; Origin: Word): Longint; override;
669 >    procedure SetSize(NewSize: Longint); override;
670 >    function Write(const Buffer; Count: Longint): Longint; override;
671 >  end;
672 >
673 > const
674 > DefaultFieldClasses: array[TFieldType] of TFieldClass = (
675 >    nil,                { ftUnknown }
676 >    TIBStringField,     { ftString }
677 >    TSmallintField,     { ftSmallint }
678 >    TIntegerField,      { ftInteger }
679 >    TWordField,         { ftWord }
680 >    TBooleanField,      { ftBoolean }
681 >    TFloatField,        { ftFloat }
682 >    TCurrencyField,     { ftCurrency }
683 >    TIBBCDField,        { ftBCD }
684 >    TDateField,         { ftDate }
685 >    TTimeField,         { ftTime }
686 >    TDateTimeField,     { ftDateTime }
687 >    TBytesField,        { ftBytes }
688 >    TVarBytesField,     { ftVarBytes }
689 >    TAutoIncField,      { ftAutoInc }
690 >    TBlobField,         { ftBlob }
691 >    TMemoField,         { ftMemo }
692 >    TGraphicField,      { ftGraphic }
693 >    TBlobField,         { ftFmtMemo }
694 >    TBlobField,         { ftParadoxOle }
695 >    TBlobField,         { ftDBaseOle }
696 >    TBlobField,         { ftTypedBinary }
697 >    nil,                { ftCursor }
698 >    TStringField,       { ftFixedChar }
699 >    TWideStringField,    { ftWideString }
700 >    TLargeIntField,     { ftLargeInt }
701 >    nil,          { ftADT }
702 >    nil,        { ftArray }
703 >    nil,    { ftReference }
704 >    nil,     { ftDataSet }
705 >    TBlobField,         { ftOraBlob }
706 >    TMemoField,         { ftOraClob }
707 >    TVariantField,      { ftVariant }
708 >    nil,    { ftInterface }
709 >    nil,     { ftIDispatch }
710 >    TGuidField,        { ftGuid }
711 >    TDateTimeField,    {ftTimestamp}
712 >    TIBBCDField,       {ftFMTBcd}
713 >    nil,  {ftFixedWideChar}
714 >    TWideMemoField);   {ftWideMemo}
715 > (*
716 >    TADTField,          { ftADT }
717 >    TArrayField,        { ftArray }
718 >    TReferenceField,    { ftReference }
719 >    TDataSetField,     { ftDataSet }
720 >    TBlobField,         { ftOraBlob }
721 >    TMemoField,         { ftOraClob }
722 >    TVariantField,      { ftVariant }
723 >    TInterfaceField,    { ftInterface }
724 >    TIDispatchField,     { ftIDispatch }
725 >    TGuidField);        { ftGuid } *)
726 > (*var
727 >  CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
728 >
729 > implementation
730 >
731 > uses IBIntf, Variants, FmtBCD;
732 >
733 > const FILE_BEGIN = 0;
734 >      FILE_CURRENT = 1;
735 >      FILE_END = 2;
736 >
737 > type
738 >
739 >  TFieldNode = class(TObject)
740 >  protected
741 >    FieldName : String;
742 >    COMPUTED_BLR : Boolean;
743 >    DEFAULT_VALUE : boolean;
744 >    NextField : TFieldNode;
745 >  end;
746 >
747 >  TRelationNode = class(TObject)
748 >  protected
749 >    RelationName : String;
750 >    FieldNodes : TFieldNode;
751 >    NextRelation : TRelationNode;
752 >  end;
753 >
754 > { TIBControlLink }
755 >
756 > destructor TIBControlLink.Destroy;
757 > begin
758 >  IBDataSet := nil;
759 >  inherited Destroy;
760 > end;
761 >
762 > procedure TIBControlLink.UpdateParams(Sender: TObject);
763 > begin
764 >
765 > end;
766 >
767 > procedure TIBControlLink.UpdateSQL(Sender: TObject);
768 > begin
769 >
770 > end;
771 >
772 > procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
773 > begin
774 >  if FTIBDataSet = AValue then Exit;
775 >  if IBDataSet <> nil then
776 >    IBDataSet.UnRegisterIBLink(self);
777 >  FTIBDataSet := AValue;
778 >  if IBDataSet <> nil then
779 >    IBDataSet.RegisterIBLink(self);
780 > end;
781 >
782 >
783 > { TIBStringField}
784 >
785 > constructor TIBStringField.create(AOwner: TComponent);
786 > begin
787 >  inherited Create(AOwner);
788 > end;
789 >
790 > class procedure TIBStringField.CheckTypeSize(Value: Integer);
791 > begin
792 >  { don't check string size. all sizes valid }
793 > end;
794 >
795 > function TIBStringField.GetAsString: string;
796 > begin
797 >  if not GetValue(Result) then Result := '';
798 > end;
799 >
800 > function TIBStringField.GetAsVariant: Variant;
801 > var
802 >  S: string;
803 > begin
804 >  if GetValue(S) then Result := S else Result := Null;
805 > end;
806 >
807 > function TIBStringField.GetValue(var Value: string): Boolean;
808 > var
809 >  Buffer: PChar;
810 > begin
811 >  Buffer := nil;
812 >  IBAlloc(Buffer, 0, Size + 1);
813 >  try
814 >    Result := GetData(Buffer);
815 >    if Result then
816 >    begin
817 >      Value := string(Buffer);
818 >      if Transliterate and (Value <> '') then
819 >        DataSet.Translate(PChar(Value), PChar(Value), False);
820 >    end
821 >  finally
822 >    FreeMem(Buffer);
823 >  end;
824 > end;
825 >
826 > procedure TIBStringField.SetAsString(const Value: string);
827 > var
828 >  Buffer: PChar;
829 > begin
830 >  Buffer := nil;
831 >  IBAlloc(Buffer, 0, Size + 1);
832 >  try
833 >    StrLCopy(Buffer, PChar(Value), Size);
834 >    if Transliterate then
835 >      DataSet.Translate(Buffer, Buffer, True);
836 >    SetData(Buffer);
837 >  finally
838 >    FreeMem(Buffer);
839 >  end;
840 > end;
841 >
842 > procedure TIBStringField.SetSize(AValue: Integer);
843 > var FieldSize: integer;
844 > begin
845 >  if csLoading in ComponentState then
846 >    FInitialised := true;
847 >  if FInitialised then
848 >    inherited SetSize(AValue)
849 >  else
850 >  begin
851 >    {IBCustomDataSet encodes the CharWidth size in the size}
852 >    FieldSize := AValue div 4;
853 >    inherited SetSize(FieldSize);
854 >    DisplayWidth := FieldSize div ((AValue mod 4) + 1);
855 >    FInitialised := true;
856 >  end;
857 > end;
858 >
859 > { TIBBCDField }
860 >
861 > constructor TIBBCDField.Create(AOwner: TComponent);
862 > begin
863 >  inherited Create(AOwner);
864 >  SetDataType(ftBCD);
865 >  Size := 8;
866 > end;
867 >
868 > class procedure TIBBCDField.CheckTypeSize(Value: Integer);
869 > begin
870 > { No need to check as the base type is currency, not BCD }
871 > end;
872 >
873 > function TIBBCDField.GetAsCurrency: Currency;
874 > begin
875 >  if not GetValue(Result) then
876 >    Result := 0;
877 > end;
878 >
879 > function TIBBCDField.GetAsString: string;
880 > var
881 >  C: System.Currency;
882 > begin
883 >  if GetValue(C) then
884 >    Result := CurrToStr(C)
885 >  else
886 >    Result := '';
887 > end;
888 >
889 > function TIBBCDField.GetAsVariant: Variant;
890 > var
891 >  C: System.Currency;
892 > begin
893 >  if GetValue(C) then
894 >    Result := C
895 >  else
896 >    Result := Null;
897 > end;
898 >
899 > function TIBBCDField.GetDataSize: Integer;
900 > begin
901 > {$IFDEF TBCDFIELD_IS_BCD}
902 >  Result := 8;
903 > {$ELSE}
904 >  Result := inherited GetDataSize
905 > {$ENDIF}
906 > end;
907 >
908 > { TIBDataLink }
909 >
910 > constructor TIBDataLink.Create(ADataSet: TIBCustomDataSet);
911 > begin
912 >  inherited Create;
913 >  FDataSet := ADataSet;
914 > end;
915 >
916 > destructor TIBDataLink.Destroy;
917 > begin
918 >  FDataSet.FDataLink := nil;
919 >  inherited Destroy;
920 > end;
921 >
922 >
923 > procedure TIBDataLink.ActiveChanged;
924 > begin
925 >  if FDataSet.Active then
926 >    FDataSet.RefreshParams;
927 > end;
928 >
929 >
930 > function TIBDataLink.GetDetailDataSet: TDataSet;
931 > begin
932 >  Result := FDataSet;
933 > end;
934 >
935 > procedure TIBDataLink.RecordChanged(Field: TField);
936 > begin
937 >  if (Field = nil) and FDataSet.Active then
938 >    FDataSet.RefreshParams;
939 > end;
940 >
941 > procedure TIBDataLink.CheckBrowseMode;
942 > begin
943 >  if FDataSet.Active then
944 >    FDataSet.CheckBrowseMode;
945 > end;
946 >
947 > { TIBCustomDataSet }
948 >
949 > constructor TIBCustomDataSet.Create(AOwner: TComponent);
950 > begin
951 >  inherited Create(AOwner);
952 >  FIBLoaded := False;
953 >  CheckIBLoaded;
954 >  FIBLoaded := True;
955 >  FBase := TIBBase.Create(Self);
956 >  FIBLinks := TList.Create;
957 >  FCurrentRecord := -1;
958 >  FDeletedRecords := 0;
959 >  FUniDirectional := False;
960 >  FBufferChunks := BufferCacheSize;
961 >  FBlobStreamList := TList.Create;
962 >  FGeneratorField := TIBGenerator.Create(self);
963 >  FDataLink := TIBDataLink.Create(Self);
964 >  FQDelete := TIBSQL.Create(Self);
965 >  FQDelete.OnSQLChanging := SQLChanging;
966 >  FQDelete.GoToFirstRecordOnExecute := False;
967 >  FQInsert := TIBSQL.Create(Self);
968 >  FQInsert.OnSQLChanging := SQLChanging;
969 >  FQInsert.GoToFirstRecordOnExecute := False;
970 >  FQRefresh := TIBSQL.Create(Self);
971 >  FQRefresh.OnSQLChanging := SQLChanging;
972 >  FQRefresh.GoToFirstRecordOnExecute := False;
973 >  FQSelect := TIBSQL.Create(Self);
974 >  FQSelect.OnSQLChanging := SQLChanging;
975 >  FQSelect.GoToFirstRecordOnExecute := False;
976 >  FQModify := TIBSQL.Create(Self);
977 >  FQModify.OnSQLChanging := SQLChanging;
978 >  FQModify.GoToFirstRecordOnExecute := False;
979 >  FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
980 >  FParamCheck := True;
981 >  FGenerateParamNames := False;
982 >  FForcedRefresh := False;
983 >  FAutoCommit:= acDisabled;
984 >  FDataSetCloseAction := dcDiscardChanges;
985 >  {Bookmark Size is Integer for IBX}
986 >  BookmarkSize := SizeOf(Integer);
987 >  FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
988 >  FBase.AfterDatabaseDisconnect := DoAfterDatabaseDisconnect;
989 >  FBase.OnDatabaseFree := DoDatabaseFree;
990 >  FBase.BeforeTransactionEnd := DoBeforeTransactionEnd;
991 >  FBase.AfterTransactionEnd := DoAfterTransactionEnd;
992 >  FBase.OnTransactionFree := DoTransactionFree;
993 >  if AOwner is TIBDatabase then
994 >    Database := TIBDatabase(AOwner)
995 >  else
996 >    if AOwner is TIBTransaction then
997 >      Transaction := TIBTransaction(AOwner);
998 >  FBaseSQLSelect := TStringList.Create;
999 > end;
1000 >
1001 > destructor TIBCustomDataSet.Destroy;
1002 > begin
1003 >  if Active then Active := false;
1004 >  if FIBLoaded then
1005 >  begin
1006 >    if assigned(FGeneratorField) then FGeneratorField.Free;
1007 >    FDataLink.Free;
1008 >    FBase.Free;
1009 >    ClearBlobCache;
1010 >    ClearIBLinks;
1011 >    FIBLinks.Free;
1012 >    FBlobStreamList.Free;
1013 >    FreeMem(FBufferCache);
1014 >    FBufferCache := nil;
1015 >    FreeMem(FOldBufferCache);
1016 >    FOldBufferCache := nil;
1017 >    FCacheSize := 0;
1018 >    FOldCacheSize := 0;
1019 >    FMappedFieldPosition := nil;
1020 >  end;
1021 >  if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1022 >  if assigned(FParser) then FParser.Free;
1023 >  inherited Destroy;
1024 > end;
1025 >
1026 > function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
1027 >                                             TGetResult;
1028 > begin
1029 >  while not IsVisible(Buffer) do
1030 >  begin
1031 >    if GetMode = gmPrior then
1032 >    begin
1033 >      Dec(FCurrentRecord);
1034 >      if FCurrentRecord = -1 then
1035 >      begin
1036 >        result := grBOF;
1037 >        exit;
1038 >      end;
1039 >      ReadRecordCache(FCurrentRecord, Buffer, False);
1040 >    end
1041 >    else begin
1042 >      Inc(FCurrentRecord);
1043 >      if (FCurrentRecord = FRecordCount) then
1044 >      begin
1045 >        if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1046 >        begin
1047 >          FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1048 >          Inc(FRecordCount);
1049 >        end
1050 >        else begin
1051 >          result := grEOF;
1052 >          exit;
1053 >        end;
1054 >      end
1055 >      else
1056 >        ReadRecordCache(FCurrentRecord, Buffer, False);
1057 >    end;
1058 >  end;
1059 >  result := grOK;
1060 > end;
1061 >
1062 > procedure TIBCustomDataSet.ApplyUpdates;
1063 > var
1064 >  {$IF FPC_FULLVERSION >= 20700 }
1065 >  CurBookmark: TBookmark;
1066 >  {$ELSE}
1067 >  CurBookmark: string;
1068 >  {$ENDIF}
1069 >  Buffer: PRecordData;
1070 >  CurUpdateTypes: TIBUpdateRecordTypes;
1071 >  UpdateAction: TIBUpdateAction;
1072 >  UpdateKind: TUpdateKind;
1073 >  bRecordsSkipped: Boolean;
1074 >
1075 >  procedure GetUpdateKind;
1076 >  begin
1077 >    case Buffer^.rdCachedUpdateStatus of
1078 >      cusModified:
1079 >        UpdateKind := ukModify;
1080 >      cusInserted:
1081 >        UpdateKind := ukInsert;
1082 >      else
1083 >        UpdateKind := ukDelete;
1084 >    end;
1085 >  end;
1086 >
1087 >  procedure ResetBufferUpdateStatus;
1088 >  begin
1089 >    case Buffer^.rdCachedUpdateStatus of
1090 >      cusModified:
1091 >      begin
1092 >        PRecordData(Buffer)^.rdUpdateStatus := usUnmodified;
1093 >        PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
1094 >      end;
1095 >      cusInserted:
1096 >      begin
1097 >        PRecordData(Buffer)^.rdUpdateStatus := usUnmodified;
1098 >        PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
1099 >      end;
1100 >      cusDeleted:
1101 >      begin
1102 >        PRecordData(Buffer)^.rdUpdateStatus := usDeleted;
1103 >        PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
1104 >      end;
1105 >    end;
1106 >    WriteRecordCache(PRecordData(Buffer)^.rdRecordNumber, Pointer(Buffer));
1107 >  end;
1108 >
1109 >  procedure UpdateUsingOnUpdateRecord;
1110 >  begin
1111 >    UpdateAction := uaFail;
1112 >    try
1113 >      FOnUpdateRecord(Self, UpdateKind, UpdateAction);
1114 >    except
1115 >      on E: Exception do
1116 >      begin
1117 >        if (E is EDatabaseError) and Assigned(FOnUpdateError) then
1118 >          FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);
1119 >        if UpdateAction = uaFail then
1120 >            raise;
1121 >      end;
1122 >    end;
1123 >  end;
1124 >
1125 >  procedure UpdateUsingUpdateObject;
1126 >  begin
1127 >    try
1128 >      FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1129 >      ResetBufferUpdateStatus;
1130 >    except
1131 >      on E: Exception do
1132 >        if (E is EDatabaseError) and Assigned(FOnUpdateError) then
1133 >          FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);
1134 >    end;
1135 >  end;
1136 >
1137 >  procedure UpdateUsingInternalquery;
1138 >  begin
1139 >    try
1140 >      case Buffer^.rdCachedUpdateStatus of
1141 >        cusModified:
1142 >          InternalPostRecord(FQModify, Buffer);
1143 >        cusInserted:
1144 >          InternalPostRecord(FQInsert, Buffer);
1145 >        cusDeleted:
1146 >          InternalDeleteRecord(FQDelete, Buffer);
1147 >      end;
1148 >    except
1149 >      on E: EIBError do begin
1150 >        UpdateAction := uaFail;
1151 >        if Assigned(FOnUpdateError) then
1152 >          FOnUpdateError(Self, E, UpdateKind, UpdateAction);
1153 >        case UpdateAction of
1154 >          uaFail: raise;
1155 >          uaAbort: SysUtils.Abort;
1156 >          uaSkip: bRecordsSkipped := True;
1157 >        end;
1158 >      end;
1159 >    end;
1160 >  end;
1161 >
1162 > begin
1163 >  if State in [dsEdit, dsInsert] then
1164 >    Post;
1165 >  FBase.CheckDatabase;
1166 >  FBase.CheckTransaction;
1167 >  DisableControls;
1168 >  CurBookmark := Bookmark;
1169 >  CurUpdateTypes := FUpdateRecordTypes;
1170 >  FUpdateRecordTypes := [cusModified, cusInserted, cusDeleted];
1171 >  try
1172 >    First;
1173 >    bRecordsSkipped := False;
1174 >    while not EOF do
1175 >    begin
1176 >      Buffer := PRecordData(GetActiveBuf);
1177 >      GetUpdateKind;
1178 >      UpdateAction := uaApply;
1179 >      if Assigned(FUpdateObject) or Assigned(FOnUpdateRecord) then
1180 >      begin
1181 >        if (Assigned(FOnUpdateRecord)) then
1182 >          UpdateUsingOnUpdateRecord
1183 >        else
1184 >          if Assigned(FUpdateObject) then
1185 >            UpdateUsingUpdateObject;
1186 >        case UpdateAction of
1187 >          uaFail:
1188 >            IBError(ibxeUserAbort, [nil]);
1189 >          uaAbort:
1190 >            SysUtils.Abort;
1191 >          uaApplied:
1192 >            ResetBufferUpdateStatus;
1193 >          uaSkip:
1194 >            bRecordsSkipped := True;
1195 >          uaRetry:
1196 >            Continue;
1197 >        end;
1198 >      end;
1199 >      if (not Assigned(FUpdateObject)) and (UpdateAction = UaApply) then
1200 >      begin
1201 >        UpdateUsingInternalquery;
1202 >        UpdateAction := uaApplied;
1203 >      end;
1204 >      Next;
1205 >    end;
1206 >    FUpdatesPending := bRecordsSkipped;
1207 >  finally
1208 >    FUpdateRecordTypes := CurUpdateTypes;
1209 >    Bookmark := CurBookmark;
1210 >    EnableControls;
1211 >  end;
1212 > end;
1213 >
1214 > procedure TIBCustomDataSet.InternalBatchInput(InputObject: TIBBatchInput);
1215 > begin
1216 >  FQSelect.BatchInput(InputObject);
1217 > end;
1218 >
1219 > procedure TIBCustomDataSet.InternalBatchOutput(OutputObject: TIBBatchOutput);
1220 > var
1221 >  Qry: TIBSQL;
1222 > begin
1223 >  Qry := TIBSQL.Create(Self);
1224 >  try
1225 >    Qry.Database := FBase.Database;
1226 >    Qry.Transaction := FBase.Transaction;
1227 >    Qry.SQL.Assign(FQSelect.SQL);
1228 >    Qry.BatchOutput(OutputObject);
1229 >  finally
1230 >    Qry.Free;
1231 >  end;
1232 > end;
1233 >
1234 > procedure TIBCustomDataSet.CancelUpdates;
1235 > var
1236 >  CurUpdateTypes: TIBUpdateRecordTypes;
1237 > begin
1238 >  if State in [dsEdit, dsInsert] then
1239 >    Post;
1240 >  if FCachedUpdates and FUpdatesPending then
1241 >  begin
1242 >    DisableControls;
1243 >    CurUpdateTypes := UpdateRecordTypes;
1244 >    UpdateRecordTypes := [cusModified, cusInserted, cusDeleted];
1245 >    try
1246 >      First;
1247 >      while not EOF do
1248 >      begin
1249 >        if UpdateStatus = usInserted then
1250 >          RevertRecord
1251 >        else
1252 >        begin
1253 >          RevertRecord;
1254 >          Next;
1255 >        end;
1256 >      end;
1257 >    finally
1258 >      UpdateRecordTypes := CurUpdateTypes;
1259 >      First;
1260 >      FUpdatesPending := False;
1261 >      EnableControls;
1262 >    end;
1263 >  end;
1264 > end;
1265 >
1266 > function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1267 > var i: integer;
1268 >    Prepared: boolean;
1269 > begin
1270 >  Result := 0;
1271 >  Prepared := FInternalPrepared;
1272 >  if not Prepared then
1273 >    InternalPrepare;
1274 >  try
1275 >    for i := 0 to Length(FAliasNameList) - 1 do
1276 >      if FAliasNameList[i] = AliasName then
1277 >      begin
1278 >        Result := i + 1;
1279 >        Exit
1280 >      end;
1281 >  finally
1282 >    if not Prepared then
1283 >      InternalUnPrepare;
1284 >  end;
1285 > end;
1286 >
1287 > procedure TIBCustomDataSet.ActivateConnection;
1288 > begin
1289 >  if not Assigned(Database) then
1290 >    IBError(ibxeDatabaseNotAssigned, [nil]);
1291 >  if not Assigned(Transaction) then
1292 >    IBError(ibxeTransactionNotAssigned, [nil]);
1293 >  if not Database.Connected then Database.Open;
1294 > end;
1295 >
1296 > function TIBCustomDataSet.ActivateTransaction: Boolean;
1297 > begin
1298 >  Result := False;
1299 >  if not Assigned(Transaction) then
1300 >    IBError(ibxeTransactionNotAssigned, [nil]);
1301 >  if not Transaction.Active then
1302 >  begin
1303 >    Result := True;
1304 >    Transaction.StartTransaction;
1305 >    FDidActivate := True;
1306 >  end;
1307 > end;
1308 >
1309 > procedure TIBCustomDataSet.DeactivateTransaction;
1310 > var
1311 >  i: Integer;
1312 > begin
1313 >  if not Assigned(Transaction) then
1314 >    IBError(ibxeTransactionNotAssigned, [nil]);
1315 >  with Transaction do
1316 >  begin
1317 >    for i := 0 to SQLObjectCount - 1 do
1318 >    begin
1319 >      if (SQLObjects[i] <> nil) and ((SQLObjects[i]).owner is TDataSet) then
1320 >      begin
1321 >        if TDataSet(SQLObjects[i].owner).Active then
1322 >        begin
1323 >          FDidActivate := False;
1324 >          exit;
1325 >        end;
1326 >      end;
1327 >    end;
1328 >  end;
1329 >  FInternalPrepared := False;
1330 >  if Transaction.InTransaction then
1331 >    Transaction.Commit;
1332 >  FDidActivate := False;
1333 > end;
1334 >
1335 > procedure TIBCustomDataSet.CheckDatasetClosed;
1336 > begin
1337 >  if FOpen then
1338 >    IBError(ibxeDatasetOpen, [nil]);
1339 > end;
1340 >
1341 > procedure TIBCustomDataSet.CheckDatasetOpen;
1342 > begin
1343 >  if not FOpen then
1344 >    IBError(ibxeDatasetClosed, [nil]);
1345 > end;
1346 >
1347 > function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1348 > begin
1349 >  Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1350 >  Result.OnSQLChanging := SQLChanging
1351 > end;
1352 >
1353 > procedure TIBCustomDataSet.CheckNotUniDirectional;
1354 > begin
1355 >  if UniDirectional then
1356 >    IBError(ibxeDataSetUniDirectional, [nil]);
1357 > end;
1358 >
1359 > procedure TIBCustomDataSet.AdjustRecordOnInsert(Buffer: Pointer);
1360 > begin
1361 >  with PRecordData(Buffer)^ do
1362 >    if (State = dsInsert) and (not Modified) then
1363 >    begin
1364 >      rdRecordNumber := FRecordCount;
1365 >      FCurrentRecord := FRecordCount;
1366 >    end;
1367 > end;
1368 >
1369 > function TIBCustomDataSet.CanEdit: Boolean;
1370 > var
1371 >  Buff: PRecordData;
1372 > begin
1373 >  Buff := PRecordData(GetActiveBuf);
1374 >  result := (FQModify.SQL.Text <> '') or
1375 >    (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukModify).Text <> '')) or
1376 >    ((Buff <> nil) and (Buff^.rdCachedUpdateStatus = cusInserted) and
1377 >      (FCachedUpdates));
1378 > end;
1379 >
1380 > function TIBCustomDataSet.CanInsert: Boolean;
1381 > begin
1382 >  result := (FQInsert.SQL.Text <> '') or
1383 >    (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukInsert).Text <> ''));
1384 > end;
1385 >
1386 > function TIBCustomDataSet.CanDelete: Boolean;
1387 > begin
1388 >  if (FQDelete.SQL.Text <> '') or
1389 >    (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
1390 >    result := True
1391 >  else
1392 >    result := False;
1393 > end;
1394 >
1395 > function TIBCustomDataSet.CanRefresh: Boolean;
1396 > begin
1397 >  result := (FQRefresh.SQL.Text <> '') or
1398 >    (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> ''));
1399 > end;
1400 >
1401 > procedure TIBCustomDataSet.CheckEditState;
1402 > begin
1403 >  case State of
1404 >    { Check all the wsEditMode types }
1405 >    dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter,
1406 >    dsNewValue, dsInternalCalc :
1407 >    begin
1408 >      if (State in [dsEdit]) and (not CanEdit) then
1409 >        IBError(ibxeCannotUpdate, [nil]);
1410 >      if (State in [dsInsert]) and (not CanInsert) then
1411 >        IBError(ibxeCannotInsert, [nil]);
1412 >    end;
1413 >  else
1414 >    IBError(ibxeNotEditing, [])
1415 >  end;
1416 > end;
1417 >
1418 > procedure TIBCustomDataSet.ClearBlobCache;
1419 > var
1420 >  i: Integer;
1421 > begin
1422 >  for i := 0 to FBlobStreamList.Count - 1 do
1423 >  begin
1424 >    TIBBlobStream(FBlobStreamList[i]).Free;
1425 >    FBlobStreamList[i] := nil;
1426 >  end;
1427 >  FBlobStreamList.Pack;
1428 > end;
1429 >
1430 > procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1431 > begin
1432 >  Move(Source^, Dest^, FRecordBufferSize);
1433 > end;
1434 >
1435 > procedure TIBCustomDataSet.DoBeforeDatabaseDisconnect(Sender: TObject);
1436 > begin
1437 >  if Active then
1438 >    Active := False;
1439 >  FInternalPrepared := False;
1440 >  if Assigned(FBeforeDatabaseDisconnect) then
1441 >    FBeforeDatabaseDisconnect(Sender);
1442 > end;
1443 >
1444 > procedure TIBCustomDataSet.DoAfterDatabaseDisconnect(Sender: TObject);
1445 > begin
1446 >  if Assigned(FAfterDatabaseDisconnect) then
1447 >    FAfterDatabaseDisconnect(Sender);
1448 > end;
1449 >
1450 > procedure TIBCustomDataSet.DoDatabaseFree(Sender: TObject);
1451 > begin
1452 >  if Assigned(FDatabaseFree) then
1453 >    FDatabaseFree(Sender);
1454 > end;
1455 >
1456 > procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1457 >  Action: TTransactionAction);
1458 > begin
1459 >  FCloseAction := Action;
1460 >  FInTransactionEnd := true;
1461 >  try
1462 >    if Active then
1463 >      Active := False;
1464 >  finally
1465 >    FInTransactionEnd := false;
1466 >  end;
1467 >  if FQSelect <> nil then
1468 >    FQSelect.FreeHandle;
1469 >  if FQDelete <> nil then
1470 >    FQDelete.FreeHandle;
1471 >  if FQInsert <> nil then
1472 >    FQInsert.FreeHandle;
1473 >  if FQModify <> nil then
1474 >    FQModify.FreeHandle;
1475 >  if FQRefresh <> nil then
1476 >    FQRefresh.FreeHandle;
1477 >  if Assigned(FBeforeTransactionEnd) then
1478 >    FBeforeTransactionEnd(Sender);
1479 > end;
1480 >
1481 > procedure TIBCustomDataSet.DoAfterTransactionEnd(Sender: TObject);
1482 > begin
1483 >  if Assigned(FAfterTransactionEnd) then
1484 >    FAfterTransactionEnd(Sender);
1485 > end;
1486 >
1487 > procedure TIBCustomDataSet.DoTransactionFree(Sender: TObject);
1488 > begin
1489 >  if Assigned(FTransactionFree) then
1490 >    FTransactionFree(Sender);
1491 > end;
1492 >
1493 > { Read the record from FQSelect.Current into the record buffer
1494 >  Then write the buffer to in memory cache }
1495 > procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1496 >  RecordNumber: Integer; Buffer: PChar);
1497 > var
1498 >  p: PRecordData;
1499 >  pbd: PBlobDataArray;
1500 >  i, j: Integer;
1501 >  LocalData: Pointer;
1502 >  LocalDate, LocalDouble: Double;
1503 >  LocalInt: Integer;
1504 >  LocalBool: wordBool;
1505 >  LocalInt64: Int64;
1506 >  LocalCurrency: Currency;
1507 >  FieldsLoaded: Integer;
1508 >  temp: TIBXSQLVAR;
1509 > begin
1510 >  p := PRecordData(Buffer);
1511 >  { Make sure blob cache is empty }
1512 >  pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1513 >  if RecordNumber > -1 then
1514 >    for i := 0 to BlobFieldCount - 1 do
1515 >      pbd^[i] := nil;
1516 >  { Get record information }
1517 >  p^.rdBookmarkFlag := bfCurrent;
1518 >  p^.rdFieldCount := Qry.Current.Count;
1519 >  p^.rdRecordNumber := RecordNumber;
1520 >  p^.rdUpdateStatus := usUnmodified;
1521 >  p^.rdCachedUpdateStatus := cusUnmodified;
1522 >  p^.rdSavedOffset := $FFFFFFFF;
1523 >
1524 >  { Load up the fields }
1525 >  FieldsLoaded := FQSelect.Current.Count;
1526 >  j := 1;
1527 >  for i := 0 to Qry.Current.Count - 1 do
1528 >  begin
1529 >    if (Qry = FQSelect) then
1530 >      j := i + 1
1531 >    else begin
1532 >      if FieldsLoaded = 0 then
1533 >        break;
1534 >      j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
1535 >      if j < 1 then
1536 >        continue
1537 >      else
1538 >        Dec(FieldsLoaded);
1539 >    end;
1540 >    with FQSelect.Current[j - 1].Data^ do
1541 >      if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
1542 >      begin
1543 >        if sqllen <= 8 then
1544 >          p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
1545 >        continue;
1546 >      end;
1547 >    if j > 0 then with p^ do
1548 >    begin
1549 >      rdFields[j].fdDataType :=
1550 >        Qry.Current[i].Data^.sqltype and (not 1);
1551 >      rdFields[j].fdDataScale :=
1552 >        Qry.Current[i].Data^.sqlscale;
1553 >      rdFields[j].fdNullable :=
1554 >        (Qry.Current[i].Data^.sqltype and 1 = 1);
1555 >      rdFields[j].fdIsNull :=
1556 >        (rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1557 >      LocalData := Qry.Current[i].Data^.sqldata;
1558 >      case rdFields[j].fdDataType of
1559 >        SQL_TIMESTAMP:
1560 >        begin
1561 >          rdFields[j].fdDataSize := SizeOf(TDateTime);
1562 >          if RecordNumber >= 0 then
1563 >            LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
1564 >          LocalData := PChar(@LocalDate);
1565 >        end;
1566 >        SQL_TYPE_DATE:
1567 >        begin
1568 >          rdFields[j].fdDataSize := SizeOf(TDateTime);
1569 >          if RecordNumber >= 0 then
1570 >            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
1571 >          LocalData := PChar(@LocalInt);
1572 >        end;
1573 >        SQL_TYPE_TIME:
1574 >        begin
1575 >          rdFields[j].fdDataSize := SizeOf(TDateTime);
1576 >          if RecordNumber >= 0 then
1577 >            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1578 >          LocalData := PChar(@LocalInt);
1579 >        end;
1580 >        SQL_SHORT, SQL_LONG:
1581 >        begin
1582 >          if (rdFields[j].fdDataScale = 0) then
1583 >          begin
1584 >            rdFields[j].fdDataSize := SizeOf(Integer);
1585 >            if RecordNumber >= 0 then
1586 >              LocalInt := Qry.Current[i].AsLong;
1587 >            LocalData := PChar(@LocalInt);
1588 >          end
1589 >          else if (rdFields[j].fdDataScale >= (-4)) then
1590 >               begin
1591 >                 rdFields[j].fdDataSize := SizeOf(Currency);
1592 >                 if RecordNumber >= 0 then
1593 >                   LocalCurrency := Qry.Current[i].AsCurrency;
1594 >                 LocalData := PChar(@LocalCurrency);
1595 >               end
1596 >               else begin
1597 >                 rdFields[j].fdDataSize := SizeOf(Double);
1598 >                 if RecordNumber >= 0 then
1599 >                   LocalDouble := Qry.Current[i].AsDouble;
1600 >                LocalData := PChar(@LocalDouble);
1601 >              end;
1602 >        end;
1603 >        SQL_INT64:
1604 >        begin
1605 >          if (rdFields[j].fdDataScale = 0) then
1606 >          begin
1607 >            rdFields[j].fdDataSize := SizeOf(Int64);
1608 >            if RecordNumber >= 0 then
1609 >              LocalInt64 := Qry.Current[i].AsInt64;
1610 >            LocalData := PChar(@LocalInt64);
1611 >          end
1612 >          else if (rdFields[j].fdDataScale >= (-4)) then
1613 >               begin
1614 >                 rdFields[j].fdDataSize := SizeOf(Currency);
1615 >                 if RecordNumber >= 0 then
1616 >                   LocalCurrency := Qry.Current[i].AsCurrency;
1617 >                   LocalData := PChar(@LocalCurrency);
1618 >               end
1619 >               else begin
1620 >                  rdFields[j].fdDataSize := SizeOf(Double);
1621 >                  if RecordNumber >= 0 then
1622 >                    LocalDouble := Qry.Current[i].AsDouble;
1623 >                  LocalData := PChar(@LocalDouble);
1624 >               end
1625 >        end;
1626 >        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1627 >        begin
1628 >          rdFields[j].fdDataSize := SizeOf(Double);
1629 >          if RecordNumber >= 0 then
1630 >            LocalDouble := Qry.Current[i].AsDouble;
1631 >          LocalData := PChar(@LocalDouble);
1632 >        end;
1633 >        SQL_VARYING:
1634 >        begin
1635 >          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1636 >          rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1637 >          if RecordNumber >= 0 then
1638 >          begin
1639 >            if (rdFields[j].fdDataLength = 0) then
1640 >              LocalData := nil
1641 >            else
1642 >            begin
1643 >              temp :=  Qry.Current[i];
1644 >              LocalData := @temp.Data^.sqldata[2];
1645 > (*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
1646 >            end;
1647 >          end;
1648 >        end;
1649 >        SQL_BOOLEAN:
1650 >        begin
1651 >          LocalBool:= false;
1652 >          rdFields[j].fdDataSize := SizeOf(wordBool);
1653 >          if RecordNumber >= 0 then
1654 >            LocalBool := Qry.Current[i].AsBoolean;
1655 >          LocalData := PChar(@LocalBool);
1656 >        end;
1657 >        else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1658 >        begin
1659 >          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1660 >          if (rdFields[j].fdDataType = SQL_TEXT) then
1661 >            rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1662 >        end;
1663 >      end;
1664 >      if RecordNumber < 0 then
1665 >      begin
1666 >        rdFields[j].fdIsNull := True;
1667 >        rdFields[j].fdDataOfs := FRecordSize;
1668 >        Inc(FRecordSize, rdFields[j].fdDataSize);
1669 >      end
1670 >      else begin
1671 >        if rdFields[j].fdDataType = SQL_VARYING then
1672 >        begin
1673 >          if LocalData <> nil then
1674 >            Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)
1675 >        end
1676 >        else
1677 >          Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
1678 >      end;
1679 >    end;
1680 >  end;
1681 >  WriteRecordCache(RecordNumber, PChar(p));
1682 > end;
1683 >
1684 > function TIBCustomDataSet.GetActiveBuf: PChar;
1685 > begin
1686 >  case State of
1687 >    dsBrowse:
1688 >      if IsEmpty then
1689 >        result := nil
1690 >      else
1691 >        result := ActiveBuffer;
1692 >    dsEdit, dsInsert:
1693 >      result := ActiveBuffer;
1694 >    dsCalcFields:
1695 >      result := CalcBuffer;
1696 >    dsFilter:
1697 >      result := FFilterBuffer;
1698 >    dsNewValue:
1699 >      result := ActiveBuffer;
1700 >    dsOldValue:
1701 >      if (PRecordData(ActiveBuffer)^.rdRecordNumber =
1702 >        PRecordData(FOldBuffer)^.rdRecordNumber) then
1703 >        result := FOldBuffer
1704 >      else
1705 >        result := ActiveBuffer;
1706 >  else if not FOpen then
1707 >    result := nil
1708 >  else
1709 >    result := ActiveBuffer;
1710 >  end;
1711 > end;
1712 >
1713 > function TIBCustomDataSet.CachedUpdateStatus: TCachedUpdateStatus;
1714 > begin
1715 >  if Active then
1716 >    result := PRecordData(GetActiveBuf)^.rdCachedUpdateStatus
1717 >  else
1718 >    result := cusUnmodified;
1719 > end;
1720 >
1721 > function TIBCustomDataSet.GetDatabase: TIBDatabase;
1722 > begin
1723 >  result := FBase.Database;
1724 > end;
1725 >
1726 > function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1727 > begin
1728 >  result := FBase.DBHandle;
1729 > end;
1730 >
1731 > function TIBCustomDataSet.GetDeleteSQL: TStrings;
1732 > begin
1733 >  result := FQDelete.SQL;
1734 > end;
1735 >
1736 > function TIBCustomDataSet.GetInsertSQL: TStrings;
1737 > begin
1738 >  result := FQInsert.SQL;
1739 > end;
1740 >
1741 > function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
1742 > begin
1743 >  if not FInternalPrepared then
1744 >    InternalPrepare;
1745 >  result := FQSelect.Params;
1746 > end;
1747 >
1748 > function TIBCustomDataSet.GetRefreshSQL: TStrings;
1749 > begin
1750 >  result := FQRefresh.SQL;
1751 > end;
1752 >
1753 > function TIBCustomDataSet.GetSelectSQL: TStrings;
1754 > begin
1755 >  result := FQSelect.SQL;
1756 > end;
1757 >
1758 > function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
1759 > begin
1760 >  result := FQSelect.SQLType;
1761 > end;
1762 >
1763 > function TIBCustomDataSet.GetModifySQL: TStrings;
1764 > begin
1765 >  result := FQModify.SQL;
1766 > end;
1767 >
1768 > function TIBCustomDataSet.GetTransaction: TIBTransaction;
1769 > begin
1770 >  result := FBase.Transaction;
1771 > end;
1772 >
1773 > function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1774 > begin
1775 >  result := FBase.TRHandle;
1776 > end;
1777 >
1778 > procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
1779 > begin
1780 >  if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
1781 >    FUpdateObject.Apply(ukDelete,Buff)
1782 >  else
1783 >  begin
1784 >    SetInternalSQLParams(FQDelete, Buff);
1785 >    FQDelete.ExecQuery;
1786 >  end;
1787 >  with PRecordData(Buff)^ do
1788 >  begin
1789 >    rdUpdateStatus := usDeleted;
1790 >    rdCachedUpdateStatus := cusUnmodified;
1791 >  end;
1792 >  WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
1793 > end;
1794 >
1795 > function TIBCustomDataSet.InternalLocate(const KeyFields: string;
1796 >  const KeyValues: Variant; Options: TLocateOptions): Boolean;
1797 > var
1798 >  keyFieldList: TList;
1799 >  {$IF FPC_FULLVERSION >= 20700 }
1800 >  CurBookmark: TBookmark;
1801 >  {$ELSE}
1802 >  CurBookmark: string;
1803 >  {$ENDIF}
1804 >  fieldValue: Variant;
1805 >  lookupValues: array of variant;
1806 >  i, fieldCount: Integer;
1807 >  fieldValueAsString: string;
1808 >  lookupValueAsString: string;
1809 > begin
1810 >  keyFieldList := TList.Create;
1811 >  try
1812 >    GetFieldList(keyFieldList, KeyFields);
1813 >    fieldCount := keyFieldList.Count;
1814 >    CurBookmark := Bookmark;
1815 >    result := false;
1816 >    SetLength(lookupValues, fieldCount);
1817 >    if not EOF then
1818 >    begin
1819 >      for i := 0 to fieldCount - 1 do  {expand key values into lookupValues array}
1820 >      begin
1821 >        if VarIsArray(KeyValues) then
1822 >          lookupValues[i] := KeyValues[i]
1823 >        else
1824 >        if i > 0 then
1825 >          lookupValues[i] := NULL
1826 >        else
1827 >          lookupValues[0] := KeyValues;
1828 >
1829 >        {convert to upper case is case insensitive search}
1830 >        if (TField(keyFieldList[i]).DataType = ftString) and
1831 >           not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
1832 >            lookupValues[i] := UpperCase(lookupValues[i]);
1833 >      end;
1834 >    end;
1835 >    while not result and not EOF do   {search for a matching record}
1836 >    begin
1837 >      i := 0;
1838 >      result := true;
1839 >      while result and (i < fieldCount) do
1840 >      {see if all of the key fields matches}
1841 >      begin
1842 >        fieldValue := TField(keyFieldList[i]).Value;
1843 >        result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
1844 >        if result and not VarIsNull(fieldValue) then
1845 >        begin
1846 >          try
1847 >            if TField(keyFieldList[i]).DataType = ftString then
1848 >            begin
1849 >              {strings need special handling because of the locate options that
1850 >               apply to them}
1851 >              fieldValueAsString := TField(keyFieldList[i]).AsString;
1852 >              lookupValueAsString := lookupValues[i];
1853 >              if (loCaseInsensitive in Options) then
1854 >                fieldValueAsString := UpperCase(fieldValueAsString);
1855 >
1856 >              if (loPartialKey in Options) then
1857 >                result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
1858 >              else
1859 >                result := result and (fieldValueAsString = lookupValueAsString);
1860 >            end
1861 >            else
1862 >              result := result and (lookupValues[i] =
1863 >                             VarAsType(fieldValue, VarType(lookupValues[i])));
1864 >          except on EVariantError do
1865 >            result := False;
1866 >          end;
1867 >        end;
1868 >        Inc(i);
1869 >      end;
1870 >      if not result then
1871 >          Next;
1872 >    end;
1873 >    if not result then
1874 >      Bookmark := CurBookmark
1875 >    else
1876 >      CursorPosChanged;
1877 >  finally
1878 >    keyFieldList.Free;
1879 >    SetLength(lookupValues,0)
1880 >  end;
1881 > end;
1882 >
1883 > procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
1884 > var
1885 >  i, j, k: Integer;
1886 >  pbd: PBlobDataArray;
1887 > begin
1888 >  pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
1889 >  j := 0;
1890 >  for i := 0 to FieldCount - 1 do
1891 >    if Fields[i].IsBlob then
1892 >    begin
1893 >      k := FMappedFieldPosition[Fields[i].FieldNo -1];
1894 >      if pbd^[j] <> nil then
1895 >      begin
1896 >        pbd^[j].Finalize;
1897 >        PISC_QUAD(
1898 >          PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
1899 >          pbd^[j].BlobID;
1900 >        PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
1901 >      end;
1902 >      Inc(j);
1903 >    end;
1904 >  if Assigned(FUpdateObject) then
1905 >  begin
1906 >    if (Qry = FQDelete) then
1907 >      FUpdateObject.Apply(ukDelete,Buff)
1908 >    else if (Qry = FQInsert) then
1909 >      FUpdateObject.Apply(ukInsert,Buff)
1910 >    else
1911 >      FUpdateObject.Apply(ukModify,Buff);
1912 >  end
1913 >  else begin
1914 >    SetInternalSQLParams(Qry, Buff);
1915 >    Qry.ExecQuery;
1916 >  end;
1917 >  PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
1918 >  PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
1919 >  SetModified(False);
1920 >  WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
1921 >  if (FForcedRefresh or FNeedsRefresh) and CanRefresh then
1922 >    InternalRefreshRow;
1923 > end;
1924 >
1925 > procedure TIBCustomDataSet.InternalRefreshRow;
1926 > var
1927 >  Buff: PChar;
1928 >  SetCursor: Boolean;
1929 >  ofs: DWORD;
1930 >  Qry: TIBSQL;
1931 > begin
1932 >  if Assigned(Database) and not Database.SQLHourGlass then
1933 >     SetCursor := False
1934 >  else
1935 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1936 >  if SetCursor then
1937 >    Screen.Cursor := crHourGlass;
1938 >  try
1939 >    Buff := GetActiveBuf;
1940 >    if CanRefresh then
1941 >    begin
1942 >      if Buff <> nil then
1943 >      begin
1944 >        if (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')) then
1945 >        begin
1946 >          Qry := TIBSQL.Create(self);
1947 >          Qry.Database := Database;
1948 >          Qry.Transaction := Transaction;
1949 >          Qry.GoToFirstRecordOnExecute := False;
1950 >          Qry.SQL.Text := FUpdateObject.RefreshSQL.Text;
1951 >        end
1952 >        else
1953 >          Qry := FQRefresh;
1954 >        SetInternalSQLParams(Qry, Buff);
1955 >        Qry.ExecQuery;
1956 >        try
1957 >          if (Qry.SQLType = SQLExecProcedure) or
1958 >             (Qry.Next <> nil) then
1959 >          begin
1960 >            ofs := PRecordData(Buff)^.rdSavedOffset;
1961 >            FetchCurrentRecordToBuffer(Qry,
1962 >                                       PRecordData(Buff)^.rdRecordNumber,
1963 >                                       Buff);
1964 >            if FCachedUpdates and (ofs <> $FFFFFFFF) then
1965 >            begin
1966 >              PRecordData(Buff)^.rdSavedOffset := ofs;
1967 >              WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
1968 >              SaveOldBuffer(Buff);
1969 >            end;
1970 >          end;
1971 >        finally
1972 >          Qry.Close;
1973 >        end;
1974 >        if Qry <> FQRefresh then
1975 >          Qry.Free;
1976 >      end
1977 >    end
1978 >    else
1979 >      IBError(ibxeCannotRefresh, [nil]);
1980 >  finally
1981 >    if SetCursor and (Screen.Cursor = crHourGlass) then
1982 >      Screen.Cursor := crDefault;
1983 >  end;
1984 > end;
1985 >
1986 > procedure TIBCustomDataSet.InternalRevertRecord(RecordNumber: Integer);
1987 > var
1988 >  NewBuffer, OldBuffer: PRecordData;
1989 >
1990 > begin
1991 >  NewBuffer := nil;
1992 >  OldBuffer := nil;
1993 >  NewBuffer := PRecordData(AllocRecordBuffer);
1994 >  OldBuffer := PRecordData(AllocRecordBuffer);
1995 >  try
1996 >    ReadRecordCache(RecordNumber, PChar(NewBuffer), False);
1997 >    ReadRecordCache(RecordNumber, PChar(OldBuffer), True);
1998 >    case NewBuffer^.rdCachedUpdateStatus of
1999 >      cusInserted:
2000 >      begin
2001 >        NewBuffer^.rdCachedUpdateStatus := cusUninserted;
2002 >        Inc(FDeletedRecords);
2003 >      end;
2004 >      cusModified,
2005 >      cusDeleted:
2006 >      begin
2007 >        if (NewBuffer^.rdCachedUpdateStatus = cusDeleted) then
2008 >          Dec(FDeletedRecords);
2009 >        CopyRecordBuffer(OldBuffer, NewBuffer);
2010 >      end;
2011 >    end;
2012 >
2013 >    if State in dsEditModes then
2014 >      Cancel;
2015 >
2016 >    WriteRecordCache(RecordNumber, PChar(NewBuffer));
2017 >
2018 >    if (NewBuffer^.rdCachedUpdateStatus = cusUninserted ) then
2019 >      ReSync([]);
2020 >  finally
2021 >    FreeRecordBuffer(PChar(NewBuffer));
2022 >    FreeRecordBuffer(PChar(OldBuffer));
2023 >  end;
2024 > end;
2025 >
2026 > { A visible record is one that is not truly deleted,
2027 >  and it is also listed in the FUpdateRecordTypes set }
2028 >
2029 > function TIBCustomDataSet.IsVisible(Buffer: PChar): Boolean;
2030 > begin
2031 >  result := True;
2032 >  if not (State = dsOldValue) then
2033 >    result :=
2034 >      (PRecordData(Buffer)^.rdCachedUpdateStatus in FUpdateRecordTypes) and
2035 >      (not ((PRecordData(Buffer)^.rdCachedUpdateStatus = cusUnmodified) and
2036 >        (PRecordData(Buffer)^.rdUpdateStatus = usDeleted)));
2037 > end;
2038 >
2039 >
2040 > function TIBCustomDataSet.LocateNext(const KeyFields: string;
2041 >  const KeyValues: Variant; Options: TLocateOptions): Boolean;
2042 > begin
2043 >  DisableControls;
2044 >  try
2045 >    result := InternalLocate(KeyFields, KeyValues, Options);
2046 >  finally
2047 >    EnableControls;
2048 >  end;
2049 > end;
2050 >
2051 > procedure TIBCustomDataSet.InternalPrepare;
2052 > var
2053 >  SetCursor: Boolean;
2054 >  DidActivate: Boolean;
2055 > begin
2056 >  if FInternalPrepared then
2057 >    Exit;
2058 >  DidActivate := False;
2059 >  if Assigned(Database) and not Database.SQLHourGlass then
2060 >    SetCursor := False
2061 >  else
2062 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2063 >  if SetCursor then
2064 >    Screen.Cursor := crHourGlass;
2065 >  try
2066 >    ActivateConnection;
2067 >    DidActivate := ActivateTransaction;
2068 >    FBase.CheckDatabase;
2069 >    FBase.CheckTransaction;
2070 >    if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2071 >      FQSelect.SQL.Text := FParser.SQLText;
2072 > //   writeln( FQSelect.SQL.Text);
2073 >    if FQSelect.SQL.Text <> '' then
2074 >    begin
2075 >      if not FQSelect.Prepared then
2076 >      begin
2077 >        FQSelect.GenerateParamNames := FGenerateParamNames;
2078 >        FQSelect.ParamCheck := ParamCheck;
2079 >        FQSelect.Prepare;
2080 >      end;
2081 >      FQDelete.GenerateParamNames := FGenerateParamNames;
2082 >      if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2083 >        FQDelete.Prepare;
2084 >      FQInsert.GenerateParamNames := FGenerateParamNames;
2085 >      if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2086 >        FQInsert.Prepare;
2087 >      FQRefresh.GenerateParamNames := FGenerateParamNames;
2088 >      if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2089 >        FQRefresh.Prepare;
2090 >      FQModify.GenerateParamNames := FGenerateParamNames;
2091 >      if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2092 >        FQModify.Prepare;
2093 >      FInternalPrepared := True;
2094 >      InternalInitFieldDefs;
2095 >    end else
2096 >      IBError(ibxeEmptyQuery, [nil]);
2097 >  finally
2098 >    if DidActivate then
2099 >      DeactivateTransaction;
2100 >    if SetCursor and (Screen.Cursor = crHourGlass) then
2101 >      Screen.Cursor := crDefault;
2102 >  end;
2103 > end;
2104 >
2105 > procedure TIBCustomDataSet.RecordModified(Value: Boolean);
2106 > begin
2107 >  SetModified(Value);
2108 > end;
2109 >
2110 > procedure TIBCustomDataSet.RevertRecord;
2111 > var
2112 >  Buff: PRecordData;
2113 > begin
2114 >  if FCachedUpdates and FUpdatesPending then
2115 >  begin
2116 >    Buff := PRecordData(GetActiveBuf);
2117 >    InternalRevertRecord(Buff^.rdRecordNumber);
2118 >    ReadRecordCache(Buff^.rdRecordNumber, PChar(Buff), False);
2119 >    DataEvent(deRecordChange, 0);
2120 >  end;
2121 > end;
2122 >
2123 > procedure TIBCustomDataSet.SaveOldBuffer(Buffer: PChar);
2124 > var
2125 >  OldBuffer: Pointer;
2126 >  procedure CopyOldBuffer;
2127 >  begin
2128 >    CopyRecordBuffer(Buffer, OldBuffer);
2129 >    if BlobFieldCount > 0 then
2130 >      FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2131 >               0);
2132 >  end;
2133 >
2134 > begin
2135 >  if (Buffer <> nil) and (PRecordData(Buffer)^.rdRecordNumber >= 0) then
2136 >  begin
2137 >    OldBuffer := AllocRecordBuffer;
2138 >    try
2139 >      if (PRecordData(Buffer)^.rdSavedOffset = $FFFFFFFF) then
2140 >      begin
2141 >        PRecordData(Buffer)^.rdSavedOffset := AdjustPosition(FOldBufferCache, 0,
2142 >                                                             FILE_END);
2143 >        CopyOldBuffer;
2144 >          WriteCache(FOldBufferCache, 0, FILE_CURRENT, OldBuffer);
2145 >          WriteCache(FBufferCache, PRecordData(Buffer)^.rdRecordNumber * FRecordBufferSize,
2146 >                     FILE_BEGIN, Buffer);
2147 >      end
2148 >      else begin
2149 >        CopyOldBuffer;
2150 >        WriteCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN,
2151 >                   OldBuffer);
2152 >      end;
2153 >    finally
2154 >      FreeRecordBuffer(PChar(OldBuffer));
2155 >    end;
2156 >  end;
2157 > end;
2158 >
2159 > procedure TIBCustomDataSet.SetBufferChunks(Value: Integer);
2160 > begin
2161 >  if (Value <= 0) then
2162 >    FBufferChunks := BufferCacheSize
2163 >  else
2164 >    FBufferChunks := Value;
2165 > end;
2166 >
2167 > procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase);
2168 > begin
2169 >  if (FBase.Database <> Value) then
2170 >  begin
2171 >    CheckDatasetClosed;
2172 >    FBase.Database := Value;
2173 >    FQDelete.Database := Value;
2174 >    FQInsert.Database := Value;
2175 >    FQRefresh.Database := Value;
2176 >    FQSelect.Database := Value;
2177 >    FQModify.Database := Value;
2178 >  end;
2179 > end;
2180 >
2181 > procedure TIBCustomDataSet.SetDeleteSQL(Value: TStrings);
2182 > begin
2183 >  if FQDelete.SQL.Text <> Value.Text then
2184 >  begin
2185 >    Disconnect;
2186 >    FQDelete.SQL.Assign(Value);
2187 >  end;
2188 > end;
2189 >
2190 > procedure TIBCustomDataSet.SetInsertSQL(Value: TStrings);
2191 > begin
2192 >  if FQInsert.SQL.Text <> Value.Text then
2193 >  begin
2194 >    Disconnect;
2195 >    FQInsert.SQL.Assign(Value);
2196 >  end;
2197 > end;
2198 >
2199 > procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
2200 > var
2201 >  i, j: Integer;
2202 >  cr, data: PChar;
2203 >  fn, st: string;
2204 >  OldBuffer: Pointer;
2205 >  ts: TTimeStamp;
2206 > begin
2207 >  if (Buffer = nil) then
2208 >    IBError(ibxeBufferNotSet, [nil]);
2209 >  if (not FInternalPrepared) then
2210 >    InternalPrepare;
2211 >  OldBuffer := nil;
2212 >  try
2213 >    for i := 0 to Qry.Params.Count - 1 do
2214 >    begin
2215 >      fn := Qry.Params[i].Name;
2216 >      if (Pos('OLD_', fn) = 1) then {mbcs ok}
2217 >      begin
2218 >        fn := Copy(fn, 5, Length(fn));
2219 >        if not Assigned(OldBuffer) then
2220 >        begin
2221 >          OldBuffer := AllocRecordBuffer;
2222 >          ReadRecordCache(PRecordData(Buffer)^.rdRecordNumber, OldBuffer, True);
2223 >        end;
2224 >        cr := OldBuffer;
2225 >      end
2226 >      else if (Pos('NEW_', fn) = 1) then {mbcs ok}
2227 >           begin
2228 >             fn := Copy(fn, 5, Length(fn));
2229 >             cr := Buffer;
2230 >            end
2231 >            else
2232 >             cr := Buffer;
2233 >      j := FQSelect.FieldIndex[fn] + 1;
2234 >      if (j > 0) then
2235 >        with PRecordData(cr)^ do
2236 >        begin
2237 >          if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2238 >          begin
2239 >            PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2240 >            continue;
2241 >          end;
2242 >          if rdFields[j].fdIsNull then
2243 >            Qry.Params[i].IsNull := True
2244 >          else begin
2245 >            Qry.Params[i].IsNull := False;
2246 >            data := cr + rdFields[j].fdDataOfs;
2247 >            case rdFields[j].fdDataType of
2248 >              SQL_TEXT, SQL_VARYING:
2249 >              begin
2250 >                SetString(st, data, rdFields[j].fdDataLength);
2251 >                Qry.Params[i].AsString := st;
2252 >              end;
2253 >            SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2254 >              Qry.Params[i].AsDouble := PDouble(data)^;
2255 >            SQL_SHORT, SQL_LONG:
2256 >            begin
2257 >              if rdFields[j].fdDataScale = 0 then
2258 >                Qry.Params[i].AsLong := PLong(data)^
2259 >              else if rdFields[j].fdDataScale >= (-4) then
2260 >                Qry.Params[i].AsCurrency := PCurrency(data)^
2261 >              else
2262 >                Qry.Params[i].AsDouble := PDouble(data)^;
2263 >            end;
2264 >            SQL_INT64:
2265 >            begin
2266 >              if rdFields[j].fdDataScale = 0 then
2267 >                Qry.Params[i].AsInt64 := PInt64(data)^
2268 >              else if rdFields[j].fdDataScale >= (-4) then
2269 >                Qry.Params[i].AsCurrency := PCurrency(data)^
2270 >              else
2271 >                Qry.Params[i].AsDouble := PDouble(data)^;
2272 >            end;
2273 >            SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2274 >              Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2275 >            SQL_TYPE_DATE:
2276 >            begin
2277 >              ts.Date := PInt(data)^;
2278 >              ts.Time := 0;
2279 >              Qry.Params[i].AsDate :=
2280 >                TimeStampToDateTime(ts);
2281 >            end;
2282 >            SQL_TYPE_TIME:
2283 >            begin
2284 >              ts.Date := 0;
2285 >              ts.Time := PInt(data)^;
2286 >              Qry.Params[i].AsTime :=
2287 >                TimeStampToDateTime(ts);
2288 >            end;
2289 >            SQL_TIMESTAMP:
2290 >              Qry.Params[i].AsDateTime :=
2291 >                       TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2292 >            SQL_BOOLEAN:
2293 >              Qry.Params[i].AsBoolean := PWordBool(data)^;
2294 >          end;
2295 >        end;
2296 >      end;
2297 >    end;
2298 >  finally
2299 >    if (OldBuffer <> nil) then
2300 >      FreeRecordBuffer(PChar(OldBuffer));
2301 >  end;
2302 > end;
2303 >
2304 > procedure TIBCustomDataSet.SetRefreshSQL(Value: TStrings);
2305 > begin
2306 >  if FQRefresh.SQL.Text <> Value.Text then
2307 >  begin
2308 >    Disconnect;
2309 >    FQRefresh.SQL.Assign(Value);
2310 >  end;
2311 > end;
2312 >
2313 > procedure TIBCustomDataSet.SetSelectSQL(Value: TStrings);
2314 > begin
2315 >  if FQSelect.SQL.Text <> Value.Text then
2316 >  begin
2317 >    Disconnect;
2318 >    FQSelect.SQL.Assign(Value);
2319 >    FBaseSQLSelect.assign(Value);
2320 >  end;
2321 > end;
2322 >
2323 > procedure TIBCustomDataSet.SetModifySQL(Value: TStrings);
2324 > begin
2325 >  if FQModify.SQL.Text <> Value.Text then
2326 >  begin
2327 >    Disconnect;
2328 >    FQModify.SQL.Assign(Value);
2329 >  end;
2330 > end;
2331 >
2332 > procedure TIBCustomDataSet.SetTransaction(Value: TIBTransaction);
2333 > begin
2334 >  if (FBase.Transaction <> Value) then
2335 >  begin
2336 >    CheckDatasetClosed;
2337 >    FBase.Transaction := Value;
2338 >    FQDelete.Transaction := Value;
2339 >    FQInsert.Transaction := Value;
2340 >    FQRefresh.Transaction := Value;
2341 >    FQSelect.Transaction := Value;
2342 >    FQModify.Transaction := Value;
2343 >  end;
2344 > end;
2345 >
2346 > procedure TIBCustomDataSet.SetUniDirectional(Value: Boolean);
2347 > begin
2348 >  CheckDatasetClosed;
2349 >  FUniDirectional := Value;
2350 > end;
2351 >
2352 > procedure TIBCustomDataSet.SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
2353 > begin
2354 >  FUpdateRecordTypes := Value;
2355 >  if Active then
2356 >    First;
2357 > end;
2358 >
2359 > procedure TIBCustomDataSet.RefreshParams;
2360 > var
2361 >  DataSet: TDataSet;
2362 > begin
2363 >  DisableControls;
2364 >  try
2365 >    if FDataLink.DataSource <> nil then
2366 >    begin
2367 >      DataSet := FDataLink.DataSource.DataSet;
2368 >      if DataSet <> nil then
2369 >        if DataSet.Active and (DataSet.State <> dsSetKey) then
2370 >        begin
2371 >          Close;
2372 >          Open;
2373 >        end;
2374 >    end;
2375 >  finally
2376 >    EnableControls;
2377 >  end;
2378 > end;
2379 >
2380 > procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2381 > begin
2382 >  if FIBLinks.IndexOf(Sender) = -1 then
2383 >    FIBLinks.Add(Sender);
2384 > end;
2385 >
2386 >
2387 > procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2388 > begin
2389 >  Active := false;
2390 > {  if FOpen then
2391 >    InternalClose;}
2392 >  if FInternalPrepared then
2393 >    InternalUnPrepare;
2394 >  FieldDefs.Clear;
2395 >  FieldDefs.Updated := false;
2396 > end;
2397 >
2398 > { I can "undelete" uninserted records (make them "inserted" again).
2399 >  I can "undelete" cached deleted (the deletion hasn't yet occurred) }
2400 > procedure TIBCustomDataSet.Undelete;
2401 > var
2402 >  Buff: PRecordData;
2403 > begin
2404 >  CheckActive;
2405 >  Buff := PRecordData(GetActiveBuf);
2406 >  with Buff^ do
2407 >  begin
2408 >    if rdCachedUpdateStatus = cusUninserted then
2409 >    begin
2410 >      rdCachedUpdateStatus := cusInserted;
2411 >      Dec(FDeletedRecords);
2412 >    end
2413 >    else if (rdUpdateStatus = usDeleted) and
2414 >            (rdCachedUpdateStatus = cusDeleted) then
2415 >    begin
2416 >      rdCachedUpdateStatus := cusUnmodified;
2417 >      rdUpdateStatus := usUnmodified;
2418 >      Dec(FDeletedRecords);
2419 >    end;
2420 >    WriteRecordCache(rdRecordNumber, PChar(Buff));
2421 >  end;
2422 > end;
2423 >
2424 > procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2425 > begin
2426 >  FIBLinks.Remove(Sender);
2427 > end;
2428 >
2429 > function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2430 > begin
2431 >  if Active then
2432 >    if GetActiveBuf <> nil then
2433 >      result := PRecordData(GetActiveBuf)^.rdUpdateStatus
2434 >    else
2435 >      result := usUnmodified
2436 >  else
2437 >    result := usUnmodified;
2438 > end;
2439 >
2440 > function TIBCustomDataSet.IsSequenced: Boolean;
2441 > begin
2442 >  Result := Assigned( FQSelect ) and FQSelect.EOF;
2443 > end;
2444 >
2445 > function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2446 > begin
2447 >  ActivateConnection;
2448 >  ActivateTransaction;
2449 >  if not FInternalPrepared then
2450 >    InternalPrepare;
2451 >  Result := Params.ByName(ParamName);
2452 > end;
2453 >
2454 > {Beware: the parameter FCache is used as an identifier to determine which
2455 > cache is being operated on and is not referenced in the computation.
2456 > The result is an adjusted offset into the identified cache, either the
2457 > Buffer Cache or the old Buffer Cache.}
2458 >
2459 > function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
2460 >                                        Origin: Integer): DWORD;
2461 > var
2462 >  OldCacheSize: Integer;
2463 > begin
2464 >  if (FCache = FBufferCache) then
2465 >  begin
2466 >    case Origin of
2467 >      FILE_BEGIN:    FBPos := Offset;
2468 >      FILE_CURRENT:  FBPos := FBPos + Offset;
2469 >      FILE_END:      FBPos := DWORD(FBEnd) + Offset;
2470 >    end;
2471 >    OldCacheSize := FCacheSize;
2472 >    while (FBPos >= DWORD(FCacheSize)) do
2473 >      Inc(FCacheSize, FBufferChunkSize);
2474 >    if FCacheSize > OldCacheSize then
2475 >      IBAlloc(FBufferCache, FCacheSize, FCacheSize);
2476 >    result := FBPos;
2477 >  end
2478 >  else begin
2479 >    case Origin of
2480 >      FILE_BEGIN:    FOBPos := Offset;
2481 >      FILE_CURRENT:  FOBPos := FOBPos + Offset;
2482 >      FILE_END:      FOBPos := DWORD(FOBEnd) + Offset;
2483 >    end;
2484 >    OldCacheSize := FOldCacheSize;
2485 >    while (FBPos >= DWORD(FOldCacheSize)) do
2486 >      Inc(FOldCacheSize, FBufferChunkSize);
2487 >    if FOldCacheSize > OldCacheSize then
2488 >      IBAlloc(FOldBufferCache, FOldCacheSize, FOldCacheSize);
2489 >    result := FOBPos;
2490 >  end;
2491 > end;
2492 >
2493 > procedure TIBCustomDataSet.ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
2494 >                                    Buffer: PChar);
2495 > var
2496 >  pCache: PChar;
2497 >  AdjustedOffset: DWORD;
2498 >  bOld: Boolean;
2499 > begin
2500 >  bOld := (FCache = FOldBufferCache);
2501 >  AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2502 >  if not bOld then
2503 >    pCache := FBufferCache + AdjustedOffset
2504 >  else
2505 >    pCache := FOldBufferCache + AdjustedOffset;
2506 >  Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
2507 >  AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2508 > end;
2509 >
2510 > procedure TIBCustomDataSet.ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
2511 >                                          ReadOldBuffer: Boolean);
2512 > begin
2513 >  if FUniDirectional then
2514 >    RecordNumber := RecordNumber mod UniCache;
2515 >  if (ReadOldBuffer) then
2516 >  begin
2517 >    ReadRecordCache(RecordNumber, Buffer, False);
2518 >    if FCachedUpdates and
2519 >      (PRecordData(Buffer)^.rdSavedOffset <> $FFFFFFFF) then
2520 >      ReadCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN,
2521 >                Buffer)
2522 >    else
2523 >      if ReadOldBuffer and
2524 >         (PRecordData(FOldBuffer)^.rdRecordNumber = RecordNumber) then
2525 >         CopyRecordBuffer( FOldBuffer, Buffer )
2526 >  end
2527 >  else
2528 >    ReadCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer);
2529 > end;
2530 >
2531 > procedure TIBCustomDataSet.WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer;
2532 >                                     Buffer: PChar);
2533 > var
2534 >  pCache: PChar;
2535 >  AdjustedOffset: DWORD;
2536 >  bOld: Boolean;
2537 >  dwEnd: DWORD;
2538 > begin
2539 >  bOld := (FCache = FOldBufferCache);
2540 >  AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2541 >  if not bOld then
2542 >    pCache := FBufferCache + AdjustedOffset
2543 >  else
2544 >    pCache := FOldBufferCache + AdjustedOffset;
2545 >  Move(Buffer^, pCache^, FRecordBufferSize);
2546 >  dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2547 >  if not bOld then
2548 >  begin
2549 >    if (dwEnd > FBEnd) then
2550 >      FBEnd := dwEnd;
2551 >  end
2552 >  else begin
2553 >    if (dwEnd > FOBEnd) then
2554 >      FOBEnd := dwEnd;
2555 >  end;
2556 > end;
2557 >
2558 > procedure TIBCustomDataSet.WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
2559 > begin
2560 >  if RecordNumber >= 0 then
2561 >  begin
2562 >    if FUniDirectional then
2563 >      RecordNumber := RecordNumber mod UniCache;
2564 >    WriteCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer);
2565 >  end;
2566 > end;
2567 >
2568 > function TIBCustomDataSet.AllocRecordBuffer: PChar;
2569 > begin
2570 >  result := nil;
2571 >  IBAlloc(result, FRecordBufferSize, FRecordBufferSize);
2572 >  Move(FModelBuffer^, result^, FRecordBufferSize);
2573 > end;
2574 >
2575 > function TIBCustomDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
2576 > var
2577 >  pb: PBlobDataArray;
2578 >  fs: TIBBlobStream;
2579 >  Buff: PChar;
2580 >  bTr, bDB: Boolean;
2581 > begin
2582 >  Buff := GetActiveBuf;
2583 >  if Buff = nil then
2584 >  begin
2585 >    fs := TIBBlobStream.Create;
2586 >    fs.Mode := bmReadWrite;
2587 >    FBlobStreamList.Add(Pointer(fs));
2588 >    result := TIBDSBlobStream.Create(Field, fs, Mode);
2589 >    exit;
2590 >  end;
2591 >  pb := PBlobDataArray(Buff + FBlobCacheOffset);
2592 >  if pb^[Field.Offset] = nil then
2593 >  begin
2594 >    AdjustRecordOnInsert(Buff);
2595 >    pb^[Field.Offset] := TIBBlobStream.Create;
2596 >    fs := pb^[Field.Offset];
2597 >    FBlobStreamList.Add(Pointer(fs));
2598 >    fs.Mode := bmReadWrite;
2599 >    fs.Database := Database;
2600 >    fs.Transaction := Transaction;
2601 >    fs.BlobID :=
2602 >      PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
2603 >    if (CachedUpdates) then
2604 >    begin
2605 >      bTr := not Transaction.InTransaction;
2606 >      bDB := not Database.Connected;
2607 >      if bDB then
2608 >        Database.Open;
2609 >      if bTr then
2610 >        Transaction.StartTransaction;
2611 >      fs.Seek(0, soFromBeginning);
2612 >      if bTr then
2613 >        Transaction.Commit;
2614 >      if bDB then
2615 >        Database.Close;
2616 >    end;
2617 >    WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
2618 >  end else
2619 >    fs := pb^[Field.Offset];
2620 >  result := TIBDSBlobStream.Create(Field, fs, Mode);
2621 > end;
2622 >
2623 > function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
2624 > const
2625 >  CMPLess = -1;
2626 >  CMPEql  =  0;
2627 >  CMPGtr  =  1;
2628 >  RetCodes: array[Boolean, Boolean] of ShortInt = ((2, CMPLess),
2629 >                                                   (CMPGtr, CMPEql));
2630 > begin
2631 >  result := RetCodes[Bookmark1 = nil, Bookmark2 = nil];
2632 >
2633 >  if Result = 2 then
2634 >  begin
2635 >    if PInteger(Bookmark1)^ < PInteger(Bookmark2)^ then
2636 >      Result := CMPLess
2637 >    else
2638 >    if PInteger(Bookmark1)^ > PInteger(Bookmark2)^ then
2639 >      Result := CMPGtr
2640 >    else
2641 >      Result := CMPEql;
2642 >  end;
2643 > end;
2644 >
2645 > procedure TIBCustomDataSet.DoBeforeDelete;
2646 > var
2647 >  Buff: PRecordData;
2648 > begin
2649 >  if not CanDelete then
2650 >    IBError(ibxeCannotDelete, [nil]);
2651 >  Buff := PRecordData(GetActiveBuf);
2652 >  if FCachedUpdates and
2653 >    (Buff^.rdCachedUpdateStatus in [cusUnmodified]) then
2654 >    SaveOldBuffer(PChar(Buff));
2655 >  inherited DoBeforeDelete;
2656 > end;
2657 >
2658 > procedure TIBCustomDataSet.DoAfterDelete;
2659 > begin
2660 >  inherited DoAfterDelete;
2661 >  FBase.DoAfterDelete(self);
2662 >  InternalAutoCommit;
2663 > end;
2664 >
2665 > procedure TIBCustomDataSet.DoBeforeEdit;
2666 > var
2667 >  Buff: PRecordData;
2668 > begin
2669 >  Buff := PRecordData(GetActiveBuf);
2670 >  if not(CanEdit or (FQModify.SQL.Count <> 0) or
2671 >    (FCachedUpdates and Assigned(FOnUpdateRecord))) then
2672 >    IBError(ibxeCannotUpdate, [nil]);
2673 >  if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
2674 >    SaveOldBuffer(PChar(Buff));
2675 >  CopyRecordBuffer(GetActiveBuf, FOldBuffer);
2676 >  inherited DoBeforeEdit;
2677 > end;
2678 >
2679 > procedure TIBCustomDataSet.DoAfterEdit;
2680 > begin
2681 >  inherited DoAfterEdit;
2682 >  FBase.DoAfterEdit(self);
2683 > end;
2684 >
2685 > procedure TIBCustomDataSet.DoBeforeInsert;
2686 > begin
2687 >  if not CanInsert then
2688 >    IBError(ibxeCannotInsert, [nil]);
2689 >  inherited DoBeforeInsert;
2690 > end;
2691 >
2692 > procedure TIBCustomDataSet.DoAfterInsert;
2693 > begin
2694 >  if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2695 >    GeneratorField.Apply;
2696 >  inherited DoAfterInsert;
2697 >  FBase.DoAfterInsert(self);
2698 > end;
2699 >
2700 > procedure TIBCustomDataSet.DoBeforeClose;
2701 > begin
2702 >  inherited DoBeforeClose;
2703 >  if State in [dsInsert,dsEdit] then
2704 >  begin
2705 >    if FInTransactionEnd and (FCloseAction = TARollback) then
2706 >       Exit;
2707 >
2708 >    if DataSetCloseAction = dcSaveChanges then
2709 >      Post;
2710 >      {Note this can fail with an exception e.g. due to
2711 >       database validation error. In which case the dataset remains open }
2712 >  end;
2713 > end;
2714 >
2715 > procedure TIBCustomDataSet.DoBeforeOpen;
2716 > var i: integer;
2717 > begin
2718 >  if assigned(FParser) then
2719 >     FParser.Reset;
2720 >  for i := 0 to FIBLinks.Count - 1 do
2721 >    TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2722 >  inherited DoBeforeOpen;
2723 >  for i := 0 to FIBLinks.Count - 1 do
2724 >    TIBControlLink(FIBLinks[i]).UpdateParams(self);
2725 > end;
2726 >
2727 > procedure TIBCustomDataSet.DoBeforePost;
2728 > begin
2729 >  inherited DoBeforePost;
2730 >  if (State = dsInsert) and
2731 >     (GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
2732 >     GeneratorField.Apply
2733 > end;
2734 >
2735 > procedure TIBCustomDataSet.DoAfterPost;
2736 > begin
2737 >  inherited DoAfterPost;
2738 >  FBase.DoAfterPost(self);
2739 >  InternalAutoCommit;
2740 > end;
2741 >
2742 > procedure TIBCustomDataSet.FetchAll;
2743 > var
2744 >  SetCursor: Boolean;
2745 >  {$IF FPC_FULLVERSION >= 20700 }
2746 >  CurBookmark: TBookmark;
2747 >  {$ELSE}
2748 >  CurBookmark: string;
2749 >  {$ENDIF}
2750 > begin
2751 >  if Assigned(Database) and not Database.SQLHourGlass then
2752 >    SetCursor := False
2753 >  else
2754 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2755 >  if SetCursor then
2756 >    Screen.Cursor := crHourGlass;
2757 >  try
2758 >    if FQSelect.EOF or not FQSelect.Open then
2759 >      exit;
2760 >    DisableControls;
2761 >    try
2762 >      CurBookmark := Bookmark;
2763 >      Last;
2764 >      Bookmark := CurBookmark;
2765 >    finally
2766 >      EnableControls;
2767 >    end;
2768 >  finally
2769 >    if SetCursor and (Screen.Cursor = crHourGlass) then
2770 >      Screen.Cursor := crDefault;
2771 >  end;
2772 > end;
2773 >
2774 > procedure TIBCustomDataSet.FreeRecordBuffer(var Buffer: PChar);
2775 > begin
2776 >  FreeMem(Buffer);
2777 >  Buffer := nil;
2778 > end;
2779 >
2780 > procedure TIBCustomDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
2781 > begin
2782 >  Move(PRecordData(Buffer)^.rdRecordNumber, Data^, BookmarkSize);
2783 > end;
2784 >
2785 > function TIBCustomDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
2786 > begin
2787 >  result := PRecordData(Buffer)^.rdBookmarkFlag;
2788 > end;
2789 >
2790 > function TIBCustomDataSet.GetCanModify: Boolean;
2791 > begin
2792 >  result := (FQInsert.SQL.Text <> '') or
2793 >    (FQModify.SQL.Text <> '') or
2794 >    (FQDelete.SQL.Text <> '') or
2795 >    (Assigned(FUpdateObject));
2796 > end;
2797 >
2798 > function TIBCustomDataSet.GetCurrentRecord(Buffer: PChar): Boolean;
2799 > begin
2800 >  if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then
2801 >  begin
2802 >    UpdateCursorPos;
2803 >    ReadRecordCache(PRecordData(ActiveBuffer)^.rdRecordNumber, Buffer, False);
2804 >    result := True;
2805 >  end
2806 >  else
2807 >    result := False;
2808 > end;
2809 >
2810 > function TIBCustomDataSet.GetDataSource: TDataSource;
2811 > begin
2812 >  if FDataLink = nil then
2813 >    result := nil
2814 >  else
2815 >    result := FDataLink.DataSource;
2816 > end;
2817 >
2818 > function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
2819 > begin
2820 >  Result := FAliasNameMap[FieldNo-1]
2821 > end;
2822 >
2823 > function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
2824 > var
2825 >   i: integer;
2826 > begin
2827 >   Result := nil;
2828 >   for i := 0 to Length(FAliasNameMap) - 1 do
2829 >       if FAliasNameMap[i] = aliasName then
2830 >       begin
2831 >         Result := FieldDefs[i+1];
2832 >         Exit
2833 >       end;
2834 > end;
2835 >
2836 > function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
2837 > begin
2838 >  Result := DefaultFieldClasses[FieldType];
2839 > end;
2840 >
2841 > function TIBCustomDataSet.GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean;
2842 > begin
2843 >  result := GetFieldData(FieldByNumber(FieldNo), buffer);
2844 > end;
2845 >
2846 > function TIBCustomDataSet.InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
2847 > var
2848 >  Buff, Data: PChar;
2849 >  CurrentRecord: PRecordData;
2850 > begin
2851 >  result := False;
2852 >  Buff := GetActiveBuf;
2853 >  if (Buff = nil) or
2854 >     (not IsVisible(Buff)) or not assigned(Field.DataSet) then
2855 >    exit;
2856 >  { The intention here is to stuff the buffer with the data for the
2857 >   referenced field for the current record }
2858 >  CurrentRecord := PRecordData(Buff);
2859 >  if (Field.FieldNo < 0) then
2860 >  begin
2861 >    Inc(Buff, FRecordSize + Field.Offset);
2862 >    result := Boolean(Buff[0]);
2863 >    if result and (Buffer <> nil) then
2864 >      Move(Buff[1], Buffer^, Field.DataSize);
2865 >  end
2866 >  else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
2867 >     (FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
2868 >  begin
2869 >    result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
2870 >    if result and (Buffer <> nil) then
2871 >      with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
2872 >      begin
2873 >        Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
2874 >        if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
2875 >        begin
2876 >          if fdDataLength < Field.DataSize then
2877 >          begin
2878 >            Move(Data^, Buffer^, fdDataLength);
2879 >            PChar(Buffer)[fdDataLength] := #0;
2880 >          end
2881 >          else
2882 >            IBError(ibxeFieldSizeError,[Field.FieldName])
2883 >        end
2884 >        else
2885 >          Move(Data^, Buffer^, Field.DataSize);
2886 >      end;
2887 >  end;
2888 > end;
2889 >
2890 > { GetRecNo and SetRecNo both operate off of 1-based indexes as
2891 > opposed to 0-based indexes.
2892 > This is because we want LastRecordNumber/RecordCount = 1 }
2893 >
2894 > function TIBCustomDataSet.GetRecNo: Integer;
2895 > begin
2896 >  if GetActiveBuf = nil then
2897 >    result := 0
2898 >  else
2899 >    result := PRecordData(GetActiveBuf)^.rdRecordNumber + 1;
2900 > end;
2901 >
2902 > function TIBCustomDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
2903 >  DoCheck: Boolean): TGetResult;
2904 > var
2905 >  Accept: Boolean;
2906 >  SaveState: TDataSetState;
2907 > begin
2908 >  Result := grOK;
2909 >  if Filtered and Assigned(OnFilterRecord) then
2910 >  begin
2911 >    Accept := False;
2912 >    SaveState := SetTempState(dsFilter);
2913 >    while not Accept do
2914 >    begin
2915 >      Result := InternalGetRecord(Buffer, GetMode, DoCheck);
2916 >      if Result <> grOK then
2917 >        break;
2918 >      FFilterBuffer := Buffer;
2919 >      try
2920 >        Accept := True;
2921 >        OnFilterRecord(Self, Accept);
2922 >        if not Accept and (GetMode = gmCurrent) then
2923 >          GetMode := gmPrior;
2924 >      except
2925 > //        Application.HandleException(Self);
2926 >      end;
2927 >    end;
2928 >    RestoreState(SaveState);
2929 >  end
2930 >  else
2931 >    Result := InternalGetRecord(Buffer, GetMode, DoCheck);
2932 > end;
2933 >
2934 > function TIBCustomDataSet.InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
2935 >  DoCheck: Boolean): TGetResult;
2936 > begin
2937 >  result := grError;
2938 >  case GetMode of
2939 >    gmCurrent: begin
2940 >      if (FCurrentRecord >= 0) then begin
2941 >        if FCurrentRecord < FRecordCount then
2942 >          ReadRecordCache(FCurrentRecord, Buffer, False)
2943 >        else begin
2944 >          while (not FQSelect.EOF) and
2945 >                (FQSelect.Next <> nil) and
2946 >                (FCurrentRecord >= FRecordCount) do begin
2947 >            FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
2948 >            Inc(FRecordCount);
2949 >          end;
2950 >          FCurrentRecord := FRecordCount - 1;
2951 >          if (FCurrentRecord >= 0) then
2952 >            ReadRecordCache(FCurrentRecord, Buffer, False);
2953 >        end;
2954 >        result := grOk;
2955 >      end else
2956 >        result := grBOF;
2957 >    end;
2958 >    gmNext: begin
2959 >      result := grOk;
2960 >      if FCurrentRecord = FRecordCount then
2961 >        result := grEOF
2962 >      else if FCurrentRecord = FRecordCount - 1 then begin
2963 >        if (not FQSelect.EOF) then begin
2964 >          FQSelect.Next;
2965 >          Inc(FCurrentRecord);
2966 >        end;
2967 >        if (FQSelect.EOF) then begin
2968 >          result := grEOF;
2969 >        end else begin
2970 >          Inc(FRecordCount);
2971 >          FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
2972 >        end;
2973 >      end else if (FCurrentRecord < FRecordCount) then begin
2974 >        Inc(FCurrentRecord);
2975 >        ReadRecordCache(FCurrentRecord, Buffer, False);
2976 >      end;
2977 >    end;
2978 >    else { gmPrior }
2979 >    begin
2980 >      if (FCurrentRecord = 0) then begin
2981 >        Dec(FCurrentRecord);
2982 >        result := grBOF;
2983 >      end else if (FCurrentRecord > 0) and
2984 >                  (FCurrentRecord <= FRecordCount) then begin
2985 >        Dec(FCurrentRecord);
2986 >        ReadRecordCache(FCurrentRecord, Buffer, False);
2987 >        result := grOk;
2988 >      end else if (FCurrentRecord = -1) then
2989 >        result := grBOF;
2990 >    end;
2991 >  end;
2992 >  if result = grOk then
2993 >    result := AdjustCurrentRecord(Buffer, GetMode);
2994 >  if result = grOk then with PRecordData(Buffer)^ do begin
2995 >    rdBookmarkFlag := bfCurrent;
2996 >    GetCalcFields(Buffer);
2997 >  end else if (result = grEOF) then begin
2998 >    CopyRecordBuffer(FModelBuffer, Buffer);
2999 >    PRecordData(Buffer)^.rdBookmarkFlag := bfEOF;
3000 >  end else if (result = grBOF) then begin
3001 >    CopyRecordBuffer(FModelBuffer, Buffer);
3002 >    PRecordData(Buffer)^.rdBookmarkFlag := bfBOF;
3003 >  end else if (result = grError) then begin
3004 >    CopyRecordBuffer(FModelBuffer, Buffer);
3005 >    PRecordData(Buffer)^.rdBookmarkFlag := bfEOF;
3006 >  end;;
3007 > end;
3008 >
3009 > function TIBCustomDataSet.GetRecordCount: Integer;
3010 > begin
3011 >  result := FRecordCount - FDeletedRecords;
3012 > end;
3013 >
3014 > function TIBCustomDataSet.GetRecordSize: Word;
3015 > begin
3016 >  result := FRecordBufferSize;
3017 > end;
3018 >
3019 > procedure TIBCustomDataSet.InternalAutoCommit;
3020 > begin
3021 >  with Transaction do
3022 >    if InTransaction and (FAutoCommit = acCommitRetaining) then
3023 >    begin
3024 >      if CachedUpdates then ApplyUpdates;
3025 >      CommitRetaining;
3026 >    end;
3027 > end;
3028 >
3029 > procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3030 > begin
3031 >  CheckEditState;
3032 >  begin
3033 >     { When adding records, we *always* append.
3034 >       Insertion is just too costly }
3035 >    AdjustRecordOnInsert(Buffer);
3036 >    with PRecordData(Buffer)^ do
3037 >    begin
3038 >      rdUpdateStatus := usInserted;
3039 >      rdCachedUpdateStatus := cusInserted;
3040 >    end;
3041 >    if not CachedUpdates then
3042 >      InternalPostRecord(FQInsert, Buffer)
3043 >    else begin
3044 >      WriteRecordCache(FCurrentRecord, Buffer);
3045 >      FUpdatesPending := True;
3046 >    end;
3047 >    Inc(FRecordCount);
3048 >    InternalSetToRecord(Buffer);
3049 >  end
3050 > end;
3051 >
3052 > procedure TIBCustomDataSet.InternalCancel;
3053 > var
3054 >  Buff: PChar;
3055 >  CurRec: Integer;
3056 > begin
3057 >  inherited InternalCancel;
3058 >  Buff := GetActiveBuf;
3059 >  if Buff <> nil then begin
3060 >    CurRec := FCurrentRecord;
3061 >    AdjustRecordOnInsert(Buff);
3062 >    if (State = dsEdit) then begin
3063 >      CopyRecordBuffer(FOldBuffer, Buff);
3064 >      WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
3065 >    end else begin
3066 >      CopyRecordBuffer(FModelBuffer, Buff);
3067 >      PRecordData(Buff)^.rdUpdateStatus := usDeleted;
3068 >      PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
3069 >      PRecordData(Buff)^.rdBookmarkFlag := bfEOF;
3070 >      FCurrentRecord := CurRec;
3071 >    end;
3072 >  end;
3073 > end;
3074 >
3075 >
3076 > procedure TIBCustomDataSet.InternalClose;
3077 > begin
3078 >  if FDidActivate then
3079 >    DeactivateTransaction;
3080 >  FQSelect.Close;
3081 >  ClearBlobCache;
3082 >  FreeRecordBuffer(FModelBuffer);
3083 >  FreeRecordBuffer(FOldBuffer);
3084 >  FCurrentRecord := -1;
3085 >  FOpen := False;
3086 >  FRecordCount := 0;
3087 >  FDeletedRecords := 0;
3088 >  FRecordSize := 0;
3089 >  FBPos := 0;
3090 >  FOBPos := 0;
3091 >  FCacheSize := 0;
3092 >  FOldCacheSize := 0;
3093 >  FBEnd := 0;
3094 >  FOBEnd := 0;
3095 >  FreeMem(FBufferCache);
3096 >  FBufferCache := nil;
3097 >  FreeMem(FOldBufferCache);
3098 >  FOldBufferCache := nil;
3099 >  BindFields(False);
3100 >  if DefaultFields then DestroyFields;
3101 > end;
3102 >
3103 > procedure TIBCustomDataSet.InternalDelete;
3104 > var
3105 >  Buff: PChar;
3106 >  SetCursor: Boolean;
3107 > begin
3108 >  if Assigned(Database) and not Database.SQLHourGlass then
3109 >    SetCursor := False
3110 >  else
3111 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3112 >  if SetCursor then
3113 >    Screen.Cursor := crHourGlass;
3114 >  try
3115 >    Buff := GetActiveBuf;
3116 >    if CanDelete then
3117 >    begin
3118 >      if not CachedUpdates then
3119 >        InternalDeleteRecord(FQDelete, Buff)
3120 >      else
3121 >      begin
3122 >        with PRecordData(Buff)^ do
3123 >        begin
3124 >          if rdCachedUpdateStatus = cusInserted then
3125 >            rdCachedUpdateStatus := cusUninserted
3126 >          else begin
3127 >            rdUpdateStatus := usDeleted;
3128 >            rdCachedUpdateStatus := cusDeleted;
3129 >          end;
3130 >        end;
3131 >        WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
3132 >      end;
3133 >      Inc(FDeletedRecords);
3134 >      FUpdatesPending := True;
3135 >    end else
3136 >      IBError(ibxeCannotDelete, [nil]);
3137 >  finally
3138 >    if SetCursor and (Screen.Cursor = crHourGlass) then
3139 >      Screen.Cursor := crDefault;
3140 >  end;
3141 > end;
3142 >
3143 > procedure TIBCustomDataSet.InternalFirst;
3144 > begin
3145 >  FCurrentRecord := -1;
3146 > end;
3147 >
3148 > procedure TIBCustomDataSet.InternalGotoBookmark(Bookmark: Pointer);
3149 > begin
3150 >  FCurrentRecord := PInteger(Bookmark)^;
3151 > end;
3152 >
3153 > procedure TIBCustomDataSet.InternalHandleException;
3154 > begin
3155 >  Application.HandleException(Self)
3156 > end;
3157 >
3158 > procedure TIBCustomDataSet.InternalInitFieldDefs;
3159 > begin
3160 >  if not InternalPrepared then
3161 >  begin
3162 >    InternalPrepare;
3163 >    exit;
3164 >  end;
3165 >   FieldDefsFromQuery(FQSelect);
3166 > end;
3167 >
3168 > procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3169 > const
3170 >  DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3171 >               'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
3172 >               'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3173 >               'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
3174 >               'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3175 >               'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3176 >               '     (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3177 > var
3178 >  FieldType: TFieldType;
3179 >  FieldSize: Word;
3180 >  CharSetSize: integer;
3181 >  FieldNullable : Boolean;
3182 >  i, FieldPosition, FieldPrecision: Integer;
3183 >  FieldAliasName, DBAliasName: string;
3184 >  RelationName, FieldName: string;
3185 >  Query : TIBSQL;
3186 >  FieldIndex: Integer;
3187 >  FRelationNodes : TRelationNode;
3188 >
3189 >  function Add_Node(Relation, Field : String) : TRelationNode;
3190 >  var
3191 >    FField : TFieldNode;
3192 >  begin
3193 >    if FRelationNodes.RelationName = '' then
3194 >      Result := FRelationNodes
3195 >    else
3196 >    begin
3197 >      Result := TRelationNode.Create;
3198 >      Result.NextRelation := FRelationNodes;
3199 >    end;
3200 >    Result.RelationName := Relation;
3201 >    FRelationNodes := Result;
3202 >    Query.Params[0].AsString := Relation;
3203 >    Query.ExecQuery;
3204 >    while not Query.Eof do
3205 >    begin
3206 >      FField := TFieldNode.Create;
3207 >      FField.FieldName := Query.Fields[2].AsString;
3208 >      FField.DEFAULT_VALUE := not Query.Fields[1].IsNull;
3209 >      FField.COMPUTED_BLR := not Query.Fields[0].IsNull;
3210 >      FField.NextField := Result.FieldNodes;
3211 >      Result.FieldNodes := FField;
3212 >      Query.Next;
3213 >    end;
3214 >    Query.Close;
3215 >  end;
3216 >
3217 >  function Has_COMPUTED_BLR(Relation, Field : String) : Boolean;
3218 >  var
3219 >    FRelation : TRelationNode;
3220 >    FField : TFieldNode;
3221 >  begin
3222 >    FRelation := FRelationNodes;
3223 >    while Assigned(FRelation) and
3224 >         (FRelation.RelationName <> Relation) do
3225 >      FRelation := FRelation.NextRelation;
3226 >    if not Assigned(FRelation) then
3227 >      FRelation := Add_Node(Relation, Field);
3228 >    Result := false;
3229 >    FField := FRelation.FieldNodes;
3230 >    while Assigned(FField) do
3231 >      if FField.FieldName = Field then
3232 >      begin
3233 >        Result := Ffield.COMPUTED_BLR;
3234 >        Exit;
3235 >      end
3236 >      else
3237 >        FField := Ffield.NextField;
3238 >  end;
3239 >
3240 >  function Has_DEFAULT_VALUE(Relation, Field : String) : Boolean;
3241 >  var
3242 >    FRelation : TRelationNode;
3243 >    FField : TFieldNode;
3244 >  begin
3245 >    FRelation := FRelationNodes;
3246 >    while Assigned(FRelation) and
3247 >         (FRelation.RelationName <> Relation) do
3248 >      FRelation := FRelation.NextRelation;
3249 >    if not Assigned(FRelation) then
3250 >      FRelation := Add_Node(Relation, Field);
3251 >    Result := false;
3252 >    FField := FRelation.FieldNodes;
3253 >    while Assigned(FField) do
3254 >      if FField.FieldName = Field then
3255 >      begin
3256 >        Result := Ffield.DEFAULT_VALUE;
3257 >        Exit;
3258 >      end
3259 >      else
3260 >        FField := Ffield.NextField;
3261 >  end;
3262 >
3263 >  Procedure FreeNodes;
3264 >  var
3265 >    FRelation : TRelationNode;
3266 >    FField : TFieldNode;
3267 >  begin
3268 >    while Assigned(FRelationNodes) do
3269 >    begin
3270 >      While Assigned(FRelationNodes.FieldNodes) do
3271 >      begin
3272 >        FField := FRelationNodes.FieldNodes.NextField;
3273 >        FRelationNodes.FieldNodes.Free;
3274 >        FRelationNodes.FieldNodes := FField;
3275 >      end;
3276 >      FRelation := FRelationNodes.NextRelation;
3277 >      FRelationNodes.Free;
3278 >      FRelationNodes := FRelation;
3279 >    end;
3280 >  end;
3281 >
3282 > begin
3283 >  FRelationNodes := TRelationNode.Create;
3284 >  FNeedsRefresh := False;
3285 >  Database.InternalTransaction.StartTransaction;
3286 >  Query := TIBSQL.Create(self);
3287 >  try
3288 >    Query.Database := DataBase;
3289 >    Query.Transaction := Database.InternalTransaction;
3290 >    FieldDefs.BeginUpdate;
3291 >    FieldDefs.Clear;
3292 >    FieldIndex := 0;
3293 >    if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3294 >      SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3295 >    Query.SQL.Text := DefaultSQL;
3296 >    Query.Prepare;
3297 >    SetLength(FAliasNameMap, SourceQuery.Current.Count);
3298 >    SetLength(FAliasNameList, SourceQuery.Current.Count);
3299 >    for i := 0 to SourceQuery.Current.Count - 1 do
3300 >      with SourceQuery.Current[i].Data^ do
3301 >      begin
3302 >        { Get the field name }
3303 >        FieldAliasName := SourceQuery.Current[i].Name;
3304 >        SetString(DBAliasName, aliasname, aliasname_length);
3305 >        SetString(RelationName, relname, relname_length);
3306 >        SetString(FieldName, sqlname, sqlname_length);
3307 >        FAliasNameList[i] := DBAliasName;
3308 >        FieldSize := 0;
3309 >        FieldPrecision := 0;
3310 >        FieldNullable := SourceQuery.Current[i].IsNullable;
3311 >        case sqltype and not 1 of
3312 >          { All VARCHAR's must be converted to strings before recording
3313 >           their values }
3314 >          SQL_VARYING, SQL_TEXT:
3315 >          begin
3316 >            CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3317 >            {FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3318 >            FieldSize := sqllen * 4 + (CharSetSize - 1);
3319 >            FieldType := ftString;
3320 >          end;
3321 >          { All Doubles/Floats should be cast to doubles }
3322 >          SQL_DOUBLE, SQL_FLOAT:
3323 >            FieldType := ftFloat;
3324 >          SQL_SHORT:
3325 >          begin
3326 >            if (sqlscale = 0) then
3327 >              FieldType := ftSmallInt
3328 >            else begin
3329 >              FieldType := ftBCD;
3330 >              FieldPrecision := 4;
3331 >              FieldSize := -sqlscale;
3332 >            end;
3333 >          end;
3334 >          SQL_LONG:
3335 >          begin
3336 >            if (sqlscale = 0) then
3337 >              FieldType := ftInteger
3338 >            else if (sqlscale >= (-4)) then
3339 >            begin
3340 >              FieldType := ftBCD;
3341 >              FieldPrecision := 9;
3342 >              FieldSize := -sqlscale;
3343 >            end
3344 >            else
3345 >            if Database.SQLDialect = 1 then
3346 >              FieldType := ftFloat
3347 >            else
3348 >            if (FieldCount > i) and (Fields[i] is TFloatField) then
3349 >              FieldType := ftFloat
3350 >            else
3351 >            begin
3352 >              FieldType := ftFMTBCD;
3353 >              FieldPrecision := 9;
3354 >              FieldSize := -sqlscale;
3355 >            end;
3356 >          end;
3357 >
3358 >          SQL_INT64:
3359 >          begin
3360 >            if (sqlscale = 0) then
3361 >              FieldType := ftLargeInt
3362 >            else if (sqlscale >= (-4)) then
3363 >            begin
3364 >              FieldType := ftBCD;
3365 >              FieldPrecision := 18;
3366 >              FieldSize := -sqlscale;
3367 >            end
3368 >            else
3369 >              FieldType := ftFloat
3370 >          end;
3371 >          SQL_TIMESTAMP: FieldType := ftDateTime;
3372 >          SQL_TYPE_TIME: FieldType := ftTime;
3373 >          SQL_TYPE_DATE: FieldType := ftDate;
3374 >          SQL_BLOB:
3375 >          begin
3376 >            FieldSize := sizeof (TISC_QUAD);
3377 >            if (sqlsubtype = 1) then
3378 >              FieldType := ftmemo
3379 >            else
3380 >              FieldType := ftBlob;
3381 >          end;
3382 >          SQL_ARRAY:
3383 >          begin
3384 >            FieldSize := sizeof (TISC_QUAD);
3385 >            FieldType := ftUnknown;
3386 >          end;
3387 >          SQL_BOOLEAN:
3388 >             FieldType:= ftBoolean;
3389 >          else
3390 >            FieldType := ftUnknown;
3391 >        end;
3392 >        FieldPosition := i + 1;
3393 >        if (FieldType <> ftUnknown) and (FieldAliasName <> 'IBX_INTERNAL_DBKEY') then {do not localize}
3394 >        begin
3395 >          FMappedFieldPosition[FieldIndex] := FieldPosition;
3396 >          Inc(FieldIndex);
3397 >          with FieldDefs.AddFieldDef do
3398 >          begin
3399 >            Name := FieldAliasName;
3400 >            FAliasNameMap[FieldNo-1] := DBAliasName;
3401 >            DataType := FieldType;
3402 >            Size := FieldSize;
3403 >            Precision := FieldPrecision;
3404 >            Required := not FieldNullable;
3405 >            InternalCalcField := False;
3406 >            if (FieldName <> '') and (RelationName <> '') then
3407 >            begin
3408 >              if Has_COMPUTED_BLR(RelationName, FieldName) then
3409 >              begin
3410 >                Attributes := [faReadOnly];
3411 >                InternalCalcField := True;
3412 >                FNeedsRefresh := True;
3413 >              end
3414 >              else
3415 >              begin
3416 >                if Has_DEFAULT_VALUE(RelationName, FieldName) then
3417 >                begin
3418 >                  if not FieldNullable then
3419 >                    Attributes := [faRequired];
3420 >                end
3421 >                else
3422 >                  FNeedsRefresh := True;
3423 >              end;
3424 >            end;
3425 >          end;
3426 >        end;
3427 >      end;
3428 >  finally
3429 >    Query.free;
3430 >    FreeNodes;
3431 >    Database.InternalTransaction.Commit;
3432 >    FieldDefs.EndUpdate;
3433 >  end;
3434 > end;
3435 >
3436 > procedure TIBCustomDataSet.InternalInitRecord(Buffer: PChar);
3437 > begin
3438 >  CopyRecordBuffer(FModelBuffer, Buffer);
3439 > end;
3440 >
3441 > procedure TIBCustomDataSet.InternalLast;
3442 > var
3443 >  Buffer: PChar;
3444 > begin
3445 >  if (FQSelect.EOF) then
3446 >    FCurrentRecord := FRecordCount
3447 >  else begin
3448 >    Buffer := AllocRecordBuffer;
3449 >    try
3450 >      while FQSelect.Next <> nil do
3451 >      begin
3452 >        FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3453 >        Inc(FRecordCount);
3454 >      end;
3455 >      FCurrentRecord := FRecordCount;
3456 >    finally
3457 >      FreeRecordBuffer(Buffer);
3458 >    end;
3459 >  end;
3460 > end;
3461 >
3462 > procedure TIBCustomDataSet.InternalSetParamsFromCursor;
3463 > var
3464 >  i: Integer;
3465 >  cur_param: TIBXSQLVAR;
3466 >  cur_field: TField;
3467 >  s: TStream;
3468 > begin
3469 >  if FQSelect.SQL.Text = '' then
3470 >    IBError(ibxeEmptyQuery, [nil]);
3471 >  if not FInternalPrepared then
3472 >    InternalPrepare;
3473 >  if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
3474 >  begin
3475 >    for i := 0 to SQLParams.Count - 1 do
3476 >    begin
3477 >      cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
3478 >      cur_param := SQLParams[i];
3479 >      if (cur_field <> nil) then begin
3480 >        if (cur_field.IsNull) then
3481 >          cur_param.IsNull := True
3482 >        else case cur_field.DataType of
3483 >          ftString:
3484 >            cur_param.AsString := cur_field.AsString;
3485 >          ftBoolean:
3486 >            cur_param.AsBoolean := cur_field.AsBoolean;
3487 >          ftSmallint, ftWord:
3488 >            cur_param.AsShort := cur_field.AsInteger;
3489 >          ftInteger:
3490 >            cur_param.AsLong := cur_field.AsInteger;
3491 >          ftLargeInt:
3492 >            cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
3493 >          ftFloat, ftCurrency:
3494 >           cur_param.AsDouble := cur_field.AsFloat;
3495 >          ftBCD:
3496 >            cur_param.AsCurrency := cur_field.AsCurrency;
3497 >          ftDate:
3498 >            cur_param.AsDate := cur_field.AsDateTime;
3499 >          ftTime:
3500 >            cur_param.AsTime := cur_field.AsDateTime;
3501 >          ftDateTime:
3502 >            cur_param.AsDateTime := cur_field.AsDateTime;
3503 >          ftBlob, ftMemo:
3504 >          begin
3505 >            s := nil;
3506 >            try
3507 >              s := DataSource.DataSet.
3508 >                     CreateBlobStream(cur_field, bmRead);
3509 >              cur_param.LoadFromStream(s);
3510 >            finally
3511 >              s.free;
3512 >            end;
3513 >          end;
3514 >          else
3515 >            IBError(ibxeNotSupported, [nil]);
3516 >        end;
3517 >      end;
3518 >    end;
3519 >  end;
3520 > end;
3521 >
3522 > procedure TIBCustomDataSet.ReQuery;
3523 > begin
3524 >  FQSelect.Close;
3525 >  ClearBlobCache;
3526 >  FCurrentRecord := -1;
3527 >  FRecordCount := 0;
3528 >  FDeletedRecords := 0;
3529 >  FBPos := 0;
3530 >  FOBPos := 0;
3531 >  FBEnd := 0;
3532 >  FOBEnd := 0;
3533 >  FQSelect.Close;
3534 >  FQSelect.ExecQuery;
3535 >  FOpen := FQSelect.Open;
3536 >  First;
3537 > end;
3538 >
3539 > procedure TIBCustomDataSet.InternalOpen;
3540 > var
3541 >  SetCursor: Boolean;
3542 >
3543 >  function RecordDataLength(n: Integer): Long;
3544 >  begin
3545 >    result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3546 >  end;
3547 >
3548 > begin
3549 >  if Assigned(Database) and not Database.SQLHourGlass then
3550 >    SetCursor := False
3551 >  else
3552 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3553 >  if SetCursor then
3554 >    Screen.Cursor := crHourGlass;
3555 >  try
3556 >    ActivateConnection;
3557 >    ActivateTransaction;
3558 >    if FQSelect.SQL.Text = '' then
3559 >      IBError(ibxeEmptyQuery, [nil]);
3560 >    if not FInternalPrepared then
3561 >      InternalPrepare;
3562 >   if FQSelect.SQLType = SQLSelect then
3563 >   begin
3564 >      if DefaultFields then
3565 >        CreateFields;
3566 >      BindFields(True);
3567 >      FCurrentRecord := -1;
3568 >      FQSelect.ExecQuery;
3569 >      FOpen := FQSelect.Open;
3570 >
3571 >      { Initialize offsets, buffer sizes, etc...
3572 >        1. Initially FRecordSize is just the "RecordDataLength".
3573 >        2. Allocate a "model" buffer and do a dummy fetch
3574 >        3. After the dummy fetch, FRecordSize will be appropriately
3575 >           adjusted to reflect the additional "weight" of the field
3576 >           data.
3577 >        4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
3578 >        5. Now, with the BufferSize available, allocate memory for chunks of records
3579 >        6. Re-allocate the model buffer, accounting for the new
3580 >           FRecordBufferSize.
3581 >        7. Finally, calls to AllocRecordBuffer will work!.
3582 >       }
3583 >      {Step 1}
3584 >      FRecordSize := RecordDataLength(FQSelect.Current.Count);
3585 >      {Step 2, 3}
3586 >      IBAlloc(FModelBuffer, 0, FRecordSize);
3587 >      FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
3588 >      {Step 4}
3589 >      FCalcFieldsOffset := FRecordSize;
3590 >      FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
3591 >      FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
3592 >      {Step 5}
3593 >      if UniDirectional then
3594 >        FBufferChunkSize := FRecordBufferSize * UniCache
3595 >      else
3596 >        FBufferChunkSize := FRecordBufferSize * BufferChunks;
3597 >      IBAlloc(FBufferCache, FBufferChunkSize, FBufferChunkSize);
3598 >      if FCachedUpdates or (csReading in ComponentState) then
3599 >        IBAlloc(FOldBufferCache, FBufferChunkSize, FBufferChunkSize);
3600 >      FBPos := 0;
3601 >      FOBPos := 0;
3602 >      FBEnd := 0;
3603 >      FOBEnd := 0;
3604 >      FCacheSize := FBufferChunkSize;
3605 >      FOldCacheSize := FBufferChunkSize;
3606 >      {Step 6}
3607 >      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
3608 >                             FRecordBufferSize);
3609 >      {Step 7}
3610 >      FOldBuffer := AllocRecordBuffer;
3611 >    end
3612 >    else
3613 >      FQSelect.ExecQuery;
3614 >  finally
3615 >    if SetCursor and (Screen.Cursor = crHourGlass) then
3616 >      Screen.Cursor := crDefault;
3617 >  end;
3618 > end;
3619 >
3620 > procedure TIBCustomDataSet.InternalPost;
3621 > var
3622 >  Qry: TIBSQL;
3623 >  Buff: PChar;
3624 >  SetCursor: Boolean;
3625 >  bInserting: Boolean;
3626 > begin
3627 >  if Assigned(Database) and not Database.SQLHourGlass then
3628 >    SetCursor := False
3629 >  else
3630 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3631 >  if SetCursor then
3632 >    Screen.Cursor := crHourGlass;
3633 >  try
3634 >    Buff := GetActiveBuf;
3635 >    CheckEditState;
3636 >    AdjustRecordOnInsert(Buff);
3637 >    if (State = dsInsert) then
3638 >    begin
3639 >      bInserting := True;
3640 >      Qry := FQInsert;
3641 >      PRecordData(Buff)^.rdUpdateStatus := usInserted;
3642 >      PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted;
3643 >      WriteRecordCache(FRecordCount, Buff);
3644 >      FCurrentRecord := FRecordCount;
3645 >    end
3646 >    else begin
3647 >      bInserting := False;
3648 >      Qry := FQModify;
3649 >      if PRecordData(Buff)^.rdCachedUpdateStatus = cusUnmodified then
3650 >      begin
3651 >        PRecordData(Buff)^.rdUpdateStatus := usModified;
3652 >        PRecordData(Buff)^.rdCachedUpdateStatus := cusModified;
3653 >      end
3654 >      else if PRecordData(Buff)^.
3655 >                    rdCachedUpdateStatus = cusUninserted then
3656 >            begin
3657 >              PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted;
3658 >              Dec(FDeletedRecords);
3659 >            end;
3660 >    end;
3661 >    if (not CachedUpdates) then
3662 >      InternalPostRecord(Qry, Buff)
3663 >    else begin
3664 >      WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
3665 >      FUpdatesPending := True;
3666 >    end;
3667 >    if bInserting then
3668 >      Inc(FRecordCount);
3669 >  finally
3670 >    if SetCursor and (Screen.Cursor = crHourGlass) then
3671 >      Screen.Cursor := crDefault;
3672 >  end;
3673 > end;
3674 >
3675 > procedure TIBCustomDataSet.InternalRefresh;
3676 > begin
3677 >  inherited InternalRefresh;
3678 >  InternalRefreshRow;
3679 > end;
3680 >
3681 > procedure TIBCustomDataSet.InternalSetToRecord(Buffer: PChar);
3682 > begin
3683 >  InternalGotoBookmark(@(PRecordData(Buffer)^.rdRecordNumber));
3684 > end;
3685 >
3686 > function TIBCustomDataSet.IsCursorOpen: Boolean;
3687 > begin
3688 >  result := FOpen;
3689 > end;
3690 >
3691 > procedure TIBCustomDataSet.Loaded;
3692 > begin
3693 >  if assigned(FQSelect) then
3694 >    FBaseSQLSelect.assign(FQSelect.SQL);
3695 >  inherited Loaded;
3696 > end;
3697 >
3698 > procedure TIBCustomDataSet.Post;
3699 > var CancelPost: boolean;
3700 > begin
3701 >  CancelPost := false;
3702 >  if assigned(FOnValidatePost) then
3703 >    OnValidatePost(self,CancelPost);
3704 >  if CancelPost then
3705 >    Cancel
3706 >  else
3707 >   inherited Post;
3708 > end;
3709 >
3710 > function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3711 >                                 Options: TLocateOptions): Boolean;
3712 > var
3713 >  {$IF FPC_FULLVERSION >= 20700 }
3714 >  CurBookmark: TBookmark;
3715 >  {$ELSE}
3716 >  CurBookmark: string;
3717 >  {$ENDIF}
3718 > begin
3719 >  DisableControls;
3720 >  try
3721 >    CurBookmark := Bookmark;
3722 >    First;
3723 >    result := InternalLocate(KeyFields, KeyValues, Options);
3724 >    if not result then
3725 >      Bookmark := CurBookmark;
3726 >  finally
3727 >    EnableControls;
3728 >  end;
3729 > end;
3730 >
3731 > function TIBCustomDataSet.Lookup(const KeyFields: string; const KeyValues: Variant;
3732 >                                 const ResultFields: string): Variant;
3733 > var
3734 >  fl: TList;
3735 >  {$IF FPC_FULLVERSION >= 20700 }
3736 >  CurBookmark: TBookmark;
3737 >  {$ELSE}
3738 >  CurBookmark: string;
3739 >  {$ENDIF}
3740 > begin
3741 >  DisableControls;
3742 >  fl := TList.Create;
3743 >  CurBookmark := Bookmark;
3744 >  try
3745 >    First;
3746 >    if InternalLocate(KeyFields, KeyValues, []) then
3747 >    begin
3748 >      if (ResultFields <> '') then
3749 >        result := FieldValues[ResultFields]
3750 >      else
3751 >        result := NULL;
3752 >    end
3753 >    else
3754 >      result := Null;
3755 >  finally
3756 >    Bookmark := CurBookmark;
3757 >    fl.Free;
3758 >    EnableControls;
3759 >  end;
3760 > end;
3761 >
3762 > procedure TIBCustomDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
3763 > begin
3764 >  PRecordData(Buffer)^.rdRecordNumber := PInteger(Data)^;
3765 > end;
3766 >
3767 > procedure TIBCustomDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
3768 > begin
3769 >  PRecordData(Buffer)^.rdBookmarkFlag := Value;
3770 > end;
3771 >
3772 > procedure TIBCustomDataSet.SetCachedUpdates(Value: Boolean);
3773 > begin
3774 >  if not Value and FCachedUpdates then
3775 >    CancelUpdates;
3776 >  if (not (csReading in ComponentState)) and Value then
3777 >    CheckDatasetClosed;
3778 >  FCachedUpdates := Value;
3779 > end;
3780 >
3781 > procedure TIBCustomDataSet.SetDataSource(Value: TDataSource);
3782 > begin
3783 >  if IsLinkedTo(Value) then
3784 >    IBError(ibxeCircularReference, [nil]);
3785 >  if FDataLink <> nil then
3786 >    FDataLink.DataSource := Value;
3787 > end;
3788 >
3789 > procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
3790 > var
3791 >  Buff, TmpBuff: PChar;
3792 >  MappedFieldPos: integer;
3793 > begin
3794 >  Buff := GetActiveBuf;
3795 >  if Field.FieldNo < 0 then
3796 >  begin
3797 >    TmpBuff := Buff + FRecordSize + Field.Offset;
3798 >    Boolean(TmpBuff[0]) := LongBool(Buffer);
3799 >    if Boolean(TmpBuff[0]) then
3800 >      Move(Buffer^, TmpBuff[1], Field.DataSize);
3801 >    WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
3802 >  end
3803 >  else begin
3804 >    CheckEditState;
3805 >    with PRecordData(Buff)^ do
3806 >    begin
3807 >      { If inserting, Adjust record position }
3808 >      AdjustRecordOnInsert(Buff);
3809 >      MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
3810 >      if (MappedFieldPos > 0) and
3811 >         (MappedFieldPos <= rdFieldCount) then
3812 >      begin
3813 >        Field.Validate(Buffer);
3814 >        if (Buffer = nil) or
3815 >           (Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
3816 >          rdFields[MappedFieldPos].fdIsNull := True
3817 >        else begin
3818 >          Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
3819 >                 rdFields[MappedFieldPos].fdDataSize);
3820 >          if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
3821 >             (rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
3822 >            rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
3823 >          rdFields[MappedFieldPos].fdIsNull := False;
3824 >          if rdUpdateStatus = usUnmodified then
3825 >          begin
3826 >            if CachedUpdates then
3827 >            begin
3828 >              FUpdatesPending := True;
3829 >              if State = dsInsert then
3830 >                rdCachedUpdateStatus := cusInserted
3831 >              else if State = dsEdit then
3832 >                rdCachedUpdateStatus := cusModified;
3833 >            end;
3834 >
3835 >            if State = dsInsert then
3836 >              rdUpdateStatus := usInserted
3837 >            else
3838 >              rdUpdateStatus := usModified;
3839 >          end;
3840 >          WriteRecordCache(rdRecordNumber, Buff);
3841 >          SetModified(True);
3842 >        end;
3843 >      end;
3844 >    end;
3845 >  end;
3846 >  if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
3847 >      DataEvent(deFieldChange, PtrInt(Field));
3848 > end;
3849 >
3850 > procedure TIBCustomDataSet.SetRecNo(Value: Integer);
3851 > begin
3852 >  CheckBrowseMode;
3853 >  if (Value < 1) then
3854 >    Value := 1
3855 >  else if Value > FRecordCount then
3856 >  begin
3857 >    InternalLast;
3858 >    Value := Min(FRecordCount, Value);
3859 >  end;
3860 >  if (Value <> RecNo) then
3861 >  begin
3862 >    DoBeforeScroll;
3863 >    FCurrentRecord := Value - 1;
3864 >    Resync([]);
3865 >    DoAfterScroll;
3866 >  end;
3867 > end;
3868 >
3869 > procedure TIBCustomDataSet.Disconnect;
3870 > begin
3871 > Close;
3872 > InternalUnPrepare;
3873 > end;
3874 >
3875 > procedure TIBCustomDataSet.SetUpdateMode(const Value: TUpdateMode);
3876 > begin
3877 >  if not CanModify then
3878 >    IBError(ibxeCannotUpdate, [nil])
3879 >  else
3880 >    FUpdateMode := Value;
3881 > end;
3882 >
3883 >
3884 > procedure TIBCustomDataSet.SetUpdateObject(Value: TIBDataSetUpdateObject);
3885 > begin
3886 >  if Value <> FUpdateObject then
3887 >  begin
3888 >    if Assigned(FUpdateObject) and (FUpdateObject.DataSet = Self) then
3889 >      FUpdateObject.DataSet := nil;
3890 >    FUpdateObject := Value;
3891 >    if Assigned(FUpdateObject) then
3892 >    begin
3893 >      if Assigned(FUpdateObject.DataSet) and
3894 >        (FUpdateObject.DataSet <> Self) then
3895 >        FUpdateObject.DataSet.UpdateObject := nil;
3896 >      FUpdateObject.DataSet := Self;
3897 >    end;
3898 >  end;
3899 > end;
3900 >
3901 > function TIBCustomDataSet.ConstraintsStored: Boolean;
3902 > begin
3903 >  Result := Constraints.Count > 0;
3904 > end;
3905 >
3906 > procedure TIBCustomDataSet.ClearCalcFields(Buffer: PChar);
3907 > begin
3908 > FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
3909 > end;
3910 >
3911 > procedure TIBCustomDataSet.ClearIBLinks;
3912 > var i: integer;
3913 > begin
3914 >  for i := FIBLinks.Count - 1 downto 0 do
3915 >    TIBControlLink(FIBLinks[i]).IBDataSet := nil;
3916 > end;
3917 >
3918 >
3919 > procedure TIBCustomDataSet.InternalUnPrepare;
3920 > begin
3921 >  if FInternalPrepared then
3922 >  begin
3923 >    CheckDatasetClosed;
3924 >    FieldDefs.Clear;
3925 >    FieldDefs.Updated := false;
3926 >    FInternalPrepared := False;
3927 >    Setlength(FAliasNameList,0);
3928 >  end;
3929 > end;
3930 >
3931 > procedure TIBCustomDataSet.InternalExecQuery;
3932 > var
3933 >  DidActivate: Boolean;
3934 >  SetCursor: Boolean;
3935 > begin
3936 >  DidActivate := False;
3937 >  if Assigned(Database) and not Database.SQLHourGlass then
3938 >    SetCursor := False
3939 >  else
3940 >    SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3941 >  if SetCursor then
3942 >    Screen.Cursor := crHourGlass;
3943 >  try
3944 >    ActivateConnection;
3945 >    DidActivate := ActivateTransaction;
3946 >    if FQSelect.SQL.Text = '' then
3947 >      IBError(ibxeEmptyQuery, [nil]);
3948 >    if not FInternalPrepared then
3949 >      InternalPrepare;
3950 >    if FQSelect.SQLType = SQLSelect then
3951 >    begin
3952 >      IBError(ibxeIsASelectStatement, [nil]);
3953 >    end
3954 >    else
3955 >      FQSelect.ExecQuery;
3956 >  finally
3957 >    if DidActivate then
3958 >      DeactivateTransaction;
3959 >    if SetCursor and (Screen.Cursor = crHourGlass) then
3960 >      Screen.Cursor := crDefault;
3961 >  end;
3962 > end;
3963 >
3964 > function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
3965 > begin
3966 >  Result := FQSelect.Handle;
3967 > end;
3968 >
3969 > function TIBCustomDataSet.GetParser: TSelectSQLParser;
3970 > begin
3971 >  if not assigned(FParser) then
3972 >    FParser := CreateParser;
3973 >  Result := FParser
3974 > end;
3975 >
3976 > procedure TIBCustomDataSet.ResetParser;
3977 > begin
3978 >  if assigned(FParser) then
3979 >  begin
3980 >    FParser.Free;
3981 >    FParser := nil;
3982 >    SQLChanging(nil)
3983 >  end;
3984 > end;
3985 >
3986 > function TIBCustomDataSet.HasParser: boolean;
3987 > begin
3988 >  Result := not (csDesigning in ComponentState) and (FParser <> nil)
3989 > end;
3990 >
3991 > procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
3992 > begin
3993 >  if FGenerateParamNames = AValue then Exit;
3994 >  FGenerateParamNames := AValue;
3995 >  Disconnect
3996 > end;
3997 >
3998 > procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
3999 > begin
4000 >  inherited InitRecord(Buffer);
4001 >  with PRecordData(Buffer)^ do
4002 >  begin
4003 >    rdUpdateStatus := TUpdateStatus(usInserted);
4004 >    rdBookMarkFlag := bfInserted;
4005 >    rdRecordNumber := -1;
4006 >  end;
4007 > end;
4008 >
4009 > procedure TIBCustomDataSet.InternalInsert;
4010 > begin
4011 >  CursorPosChanged;
4012 > end;
4013 >
4014 > { TIBDataSet IProviderSupport }
4015 >
4016 > (*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4017 > begin
4018 >  if Commit then
4019 >    Transaction.Commit else
4020 >    Transaction.Rollback;
4021 > end;
4022 >
4023 > function TIBCustomDataSet.PSExecuteStatement(const ASQL: string; AParams: TParams;
4024 >  ResultSet: Pointer = nil): Integer;
4025 > var
4026 >  FQuery: TIBQuery;
4027 > begin
4028 >  if Assigned(ResultSet) then
4029 >  begin
4030 >    TDataSet(ResultSet^) := TIBQuery.Create(nil);
4031 >    with TIBQuery(ResultSet^) do
4032 >    begin
4033 >      SQL.Text := ASQL;
4034 >      Params.Assign(AParams);
4035 >      Open;
4036 >      Result := RowsAffected;
4037 >    end;
4038 >  end
4039 >  else
4040 >  begin
4041 >    FQuery := TIBQuery.Create(nil);
4042 >    try
4043 >      FQuery.Database := Database;
4044 >      FQuery.Transaction := Transaction;
4045 >      FQuery.GenerateParamNames := True;
4046 >      FQuery.SQL.Text := ASQL;
4047 >      FQuery.Params.Assign(AParams);
4048 >      FQuery.ExecSQL;
4049 >      Result := FQuery.RowsAffected;
4050 >    finally
4051 >      FQuery.Free;
4052 >    end;
4053 >  end;
4054 > end;
4055 >
4056 > function TIBCustomDataSet.PSGetQuoteChar: string;
4057 > begin
4058 >  if Database.SQLDialect = 3 then
4059 >    Result := '"' else
4060 >    Result := '';
4061 > end;
4062 >
4063 > function TIBCustomDataSet.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError;
4064 > var
4065 >  PrevErr: Integer;
4066 > begin
4067 >  if Prev <> nil then
4068 >    PrevErr := Prev.ErrorCode else
4069 >    PrevErr := 0;
4070 >  if E is EIBError then
4071 >    with EIBError(E) do
4072 >      Result := EUpdateError.Create(E.Message, '', SQLCode, PrevErr, E) else
4073 >      Result := inherited PSGetUpdateException(E, Prev);
4074 > end;
4075 >
4076 > function TIBCustomDataSet.PSInTransaction: Boolean;
4077 > begin
4078 >  Result := Transaction.InTransaction;
4079 > end;
4080 >
4081 > function TIBCustomDataSet.PSIsSQLBased: Boolean;
4082 > begin
4083 >  Result := True;
4084 > end;
4085 >
4086 > function TIBCustomDataSet.PSIsSQLSupported: Boolean;
4087 > begin
4088 >  Result := True;
4089 > end;
4090 >
4091 > procedure TIBCustomDataSet.PSReset;
4092 > begin
4093 >  inherited PSReset;
4094 >  if Active then
4095 >  begin
4096 >    Close;
4097 >    Open;
4098 >  end;
4099 > end;
4100 >
4101 > function TIBCustomDataSet.PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean;
4102 > var
4103 >  UpdateAction: TIBUpdateAction;
4104 >  SQL: string;
4105 >  Params: TParams;
4106 >
4107 >  procedure AssignParams(DataSet: TDataSet; Params: TParams);
4108 >  var
4109 >    I: Integer;
4110 >    Old: Boolean;
4111 >    Param: TParam;
4112 >    PName: string;
4113 >    Field: TField;
4114 >    Value: Variant;
4115 >  begin
4116 >    for I := 0 to Params.Count - 1 do
4117 >    begin
4118 >      Param := Params[I];
4119 >      PName := Param.Name;
4120 >      Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize}
4121 >      if Old then System.Delete(PName, 1, 4);
4122 >      Field := DataSet.FindField(PName);
4123 >      if not Assigned(Field) then Continue;
4124 >      if Old then Param.AssignFieldValue(Field, Field.OldValue) else
4125 >      begin
4126 >        Value := Field.NewValue;
4127 >        if VarIsEmpty(Value) then Value := Field.OldValue;
4128 >        Param.AssignFieldValue(Field, Value);
4129 >      end;
4130 >    end;
4131 >  end;
4132 >
4133 > begin
4134 >  Result := False;
4135 >  if Assigned(OnUpdateRecord) then
4136 >  begin
4137 >    UpdateAction := uaFail;
4138 >    if Assigned(FOnUpdateRecord) then
4139 >    begin
4140 >      FOnUpdateRecord(Delta, UpdateKind, UpdateAction);
4141 >      Result := UpdateAction = uaApplied;
4142 >    end;
4143 >  end
4144 >  else if Assigned(FUpdateObject) then
4145 >  begin
4146 >    SQL := FUpdateObject.GetSQL(UpdateKind).Text;
4147 >    if SQL <> '' then
4148 >    begin
4149 >      Params := TParams.Create;
4150 >      try
4151 >        Params.ParseSQL(SQL, True);
4152 >        AssignParams(Delta, Params);
4153 >        if PSExecuteStatement(SQL, Params) = 0 then
4154 >          IBError(ibxeNoRecordsAffected, [nil]);
4155 >        Result := True;
4156 >      finally
4157 >        Params.Free;
4158 >      end;
4159 >    end;
4160 >  end;
4161 > end;
4162 >
4163 > procedure TIBCustomDataSet.PSStartTransaction;
4164 > begin
4165 >  ActivateConnection;
4166 >  Transaction.StartTransaction;
4167 > end;
4168 >
4169 > function TIBCustomDataSet.PSGetTableName: string;
4170 > begin
4171 > //  if not FInternalPrepared then
4172 > //    InternalPrepare;
4173 >  { It is possible for the FQSelectSQL to be unprepared
4174 >    with FInternalPreprepared being true (see DoBeforeTransactionEnd).
4175 >    So check the Prepared of the SelectSQL instead }
4176 >  if not FQSelect.Prepared then
4177 >    FQSelect.Prepare;
4178 >  Result := FQSelect.UniqueRelationName;
4179 > end;*)
4180 >
4181 > procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4182 > begin
4183 >  InternalBatchInput(InputObject);
4184 > end;
4185 >
4186 > procedure TIBDataSet.BatchOutput(OutputObject: TIBBatchOutput);
4187 > begin
4188 >  InternalBatchOutput(OutputObject);
4189 > end;
4190 >
4191 > procedure TIBDataSet.ExecSQL;
4192 > begin
4193 >  InternalExecQuery;
4194 > end;
4195 >
4196 > procedure TIBDataSet.Prepare;
4197 > begin
4198 >  InternalPrepare;
4199 > end;
4200 >
4201 > procedure TIBDataSet.UnPrepare;
4202 > begin
4203 >  InternalUnPrepare;
4204 > end;
4205 >
4206 > function TIBDataSet.GetPrepared: Boolean;
4207 > begin
4208 >  Result := InternalPrepared;
4209 > end;
4210 >
4211 > procedure TIBDataSet.InternalOpen;
4212 > begin
4213 >  ActivateConnection;
4214 >  ActivateTransaction;
4215 >  InternalSetParamsFromCursor;
4216 >  Inherited InternalOpen;
4217 > end;
4218 >
4219 > procedure TIBDataSet.SetFiltered(Value: Boolean);
4220 > begin
4221 >  if(Filtered <> Value) then
4222 >  begin
4223 >    inherited SetFiltered(value);
4224 >    if Active then
4225 >    begin
4226 >      Close;
4227 >      Open;
4228 >    end;
4229 >  end
4230 >  else
4231 >    inherited SetFiltered(value);
4232 > end;
4233 >
4234 > function TIBCustomDataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
4235 > begin
4236 >  Result := false;
4237 >  if not Assigned(Bookmark) then
4238 >    exit;
4239 >  Result := PInteger(Bookmark)^ < FRecordCount;
4240 > end;
4241 >
4242 > function TIBCustomDataSet.GetFieldData(Field: TField;
4243 >  Buffer: Pointer): Boolean;
4244 > {$IFDEF TBCDFIELD_IS_BCD}
4245 > var
4246 >  lTempCurr : System.Currency;
4247 > begin
4248 >  if (Field.DataType = ftBCD) and (Buffer <> nil) then
4249 >  begin
4250 >    Result := InternalGetFieldData(Field, @lTempCurr);
4251 >    if Result then
4252 >      CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4253 >  end
4254 >  else
4255 > {$ELSE}
4256 > begin
4257 > {$ENDIF}
4258 >    Result := InternalGetFieldData(Field, Buffer);
4259 > end;
4260 >
4261 > function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
4262 >  NativeFormat: Boolean): Boolean;
4263 > begin
4264 >  if (Field.DataType = ftBCD) and not NativeFormat then
4265 >    Result := InternalGetFieldData(Field, Buffer)
4266 >  else
4267 >    Result := inherited GetFieldData(Field, Buffer, NativeFormat);
4268 > end;
4269 >
4270 > procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4271 > {$IFDEF TDBDFIELD_IS_BCD}
4272 > var
4273 >  lTempCurr : System.Currency;
4274 > begin
4275 >  if (Field.DataType = ftBCD) and (Buffer <> nil) then
4276 >  begin
4277 >    BCDToCurr(TBCD(Buffer^), lTempCurr);
4278 >    InternalSetFieldData(Field, @lTempCurr);
4279 >  end
4280 >  else
4281 > {$ELSE}
4282 > begin
4283 > {$ENDIF}
4284 >    InternalSetFieldData(Field, Buffer);
4285 > end;
4286 >
4287 > procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
4288 >  NativeFormat: Boolean);
4289 > begin
4290 >  if (not NativeFormat) and (Field.DataType = ftBCD) then
4291 >    InternalSetfieldData(Field, Buffer)
4292 >  else
4293 >    inherited SetFieldData(Field, buffer, NativeFormat);
4294 > end;
4295 >
4296 > { TIBDataSetUpdateObject }
4297 >
4298 > constructor TIBDataSetUpdateObject.Create(AOwner: TComponent);
4299 > begin
4300 >  inherited Create(AOwner);
4301 >  FRefreshSQL := TStringList.Create;
4302 > end;
4303 >
4304 > destructor TIBDataSetUpdateObject.Destroy;
4305 > begin
4306 >  FRefreshSQL.Free;
4307 >  inherited Destroy;
4308 > end;
4309 >
4310 > procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
4311 > begin
4312 >  FRefreshSQL.Assign(Value);
4313 > end;
4314 >
4315 > procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4316 > begin
4317 >  if not Assigned(DataSet) then Exit;
4318 >  DataSet.SetInternalSQLParams(Query, buff);
4319 > end;
4320 >
4321 > { TIBDSBlobStream }
4322 > constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4323 >                                    Mode: TBlobStreamMode);
4324 > begin
4325 >  FField := AField;
4326 >  FBlobStream := ABlobStream;
4327 >  FBlobStream.Seek(0, soFromBeginning);
4328 >  if (Mode = bmWrite) then
4329 >    FBlobStream.Truncate;
4330 > end;
4331 >
4332 > function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
4333 > begin
4334 >  result := FBlobStream.Read(Buffer, Count);
4335 > end;
4336 >
4337 > function TIBDSBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
4338 > begin
4339 >  result := FBlobStream.Seek(Offset, Origin);
4340 > end;
4341 >
4342 > procedure TIBDSBlobStream.SetSize(NewSize: Longint);
4343 > begin
4344 >  FBlobStream.SetSize(NewSize);
4345 > end;
4346 >
4347 > function TIBDSBlobStream.Write(const Buffer; Count: Longint): Longint;
4348 > begin
4349 >  if not (FField.DataSet.State in [dsEdit, dsInsert]) then
4350 >    IBError(ibxeNotEditing, [nil]);
4351 >  TIBCustomDataSet(FField.DataSet).RecordModified(True);
4352 >  TBlobField(FField).Modified := true;
4353 >  result := FBlobStream.Write(Buffer, Count);
4354 >  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4355 > end;
4356 >
4357 > { TIBGenerator }
4358 >
4359 > procedure TIBGenerator.SetIncrement(const AValue: integer);
4360 > begin
4361 >  if AValue < 0 then
4362 >     raise Exception.Create('A Generator Increment cannot be negative');
4363 >  FIncrement := AValue
4364 > end;
4365 >
4366 > function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4367 >  ATransaction: TIBTransaction): integer;
4368 > begin
4369 >  with TIBSQL.Create(nil) do
4370 >  try
4371 >    Database := ADatabase;
4372 >    Transaction := ATransaction;
4373 >    if not assigned(Database) then
4374 >       IBError(ibxeCannotSetDatabase,[]);
4375 >    if not assigned(Transaction) then
4376 >       IBError(ibxeCannotSetTransaction,[]);
4377 >    with Transaction do
4378 >      if not InTransaction then StartTransaction;
4379 >    SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
4380 >    Prepare;
4381 >    ExecQuery;
4382 >    try
4383 >      Result := FieldByName('ID').AsInteger
4384 >    finally
4385 >      Close
4386 >    end;
4387 >  finally
4388 >    Free
4389 >  end;
4390 > end;
4391 >
4392 > constructor TIBGenerator.Create(Owner: TIBCustomDataSet);
4393 > begin
4394 >  FOwner := Owner;
4395 >  FIncrement := 1;
4396 > end;
4397 >
4398 >
4399 > procedure TIBGenerator.Apply;
4400 > begin
4401 >  if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4402 >    Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4403 > end;
4404 >
4405 > end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines