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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines