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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines