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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines