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 31 by tony, Tue Jul 14 15:31:25 2015 UTC vs.
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines