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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines