ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBCustomDataSet.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 101 by tony, Thu Jan 18 14:37:18 2018 UTC

# Line 24 | Line 24
24   {       Corporation. All Rights Reserved.                                }
25   {    Contributor(s): Jeff Overcash                                       }
26   {                                                                        }
27 + {    IBX For Lazarus (Firebird Express)                                  }
28 + {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 + {    Portions created by MWA Software are copyright McCallum Whyman      }
30 + {    Associates Ltd 2011 - 2015                                                }
31 + {                                                                        }
32   {************************************************************************}
33  
34   unit IBCustomDataSet;
35  
36 + {$R-}
37 +
38 + {$IFDEF FPC}
39   {$Mode Delphi}
40 + {$codepage UTF8}
41 + {$ENDIF}
42 +
43 + {$IFDEF DELPHI}
44 + {$DEFINE TDBDFIELD_IS_BCD}
45 + {$ENDIF}
46  
47   interface
48  
49   uses
50 < {$IFDEF LINUX }
37 <  unix,
38 < {$ELSE}
50 > {$IFDEF WINDOWS }
51    Windows,
52 + {$ELSE}
53 +  unix,
54   {$ENDIF}
55 <  SysUtils, Classes, Forms, Controls, IBDatabase,
56 <  IBExternals, IB, IBHeader,  IBSQL, Db,
43 <  IBUtils, IBBlob;
55 >  SysUtils, Classes, IBDatabase, IBExternals, IB,  IBSQL, Db,
56 >  IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo;
57  
58   const
59    BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
# Line 50 | Line 63 | type
63    TIBCustomDataSet = class;
64    TIBDataSet = class;
65  
66 +  { TIBDataSetUpdateObject }
67 +
68    TIBDataSetUpdateObject = class(TComponent)
69    private
70      FRefreshSQL: TStrings;
# Line 57 | Line 72 | type
72    protected
73      function GetDataSet: TIBCustomDataSet; virtual; abstract;
74      procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
75 <    procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
75 >    procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract;
76      function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
77 +    procedure InternalSetParams(Params: ISQLParams; buff: PChar); overload;
78 +    procedure InternalSetParams(Query: TIBSQL; buff: PChar); overload;
79 +    procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
80      property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
81    public
82      constructor Create(AOwner: TComponent); override;
# Line 69 | Line 87 | type
87  
88    TBlobDataArray = array[0..0] of TIBBlobStream;
89    PBlobDataArray = ^TBlobDataArray;
90 +  TIBArrayField = class;
91  
92 <  { TIBCustomDataSet }
93 <  TFieldData = record
94 <    fdDataType: Short;
95 <    fdDataScale: Short;
96 <    fdNullable: Boolean;
97 <    fdIsNull: Boolean;
98 <    fdDataSize: Short;
99 <    fdDataLength: Short;
100 <    fdDataOfs: Integer;
92 >  { TIBArray }
93 >
94 >  {Wrapper class to support array cache in TIBCustomDataset and event handling}
95 >
96 >  TIBArray = class
97 >  private
98 >    FArray: IArray;
99 >    FRecNo: integer;
100 >    FField: TIBArrayField;
101 >    procedure EventHandler(Sender: IArray; Reason: TArrayEventReason);
102 >  public
103 >    constructor Create(aField: TIBArrayField; anArray: IArray);
104 >    destructor Destroy; override;
105 >    property ArrayIntf: IArray read FArray;
106    end;
107 <  PFieldData = ^TFieldData;
107 >
108 >  TArrayDataArray = array [0..0] of TIBArray;
109 >  PArrayDataArray = ^TArrayDataArray;
110 >
111 >  { TIBCustomDataSet }
112  
113    TCachedUpdateStatus = (
114                           cusUnmodified, cusModified, cusInserted,
# Line 91 | Line 119 | type
119    end;
120    PIBDBKey = ^TIBDBKey;
121  
122 +  PFieldData = ^TFieldData;
123 +  TFieldData = record
124 +   fdIsNull: Boolean;
125 +   fdDataLength: Short;
126 + end;
127 +
128 + PColumnData = ^TColumnData;
129 + TColumnData = record
130 +  fdDataType: Short;
131 +  fdDataScale: Short;
132 +  fdNullable: Boolean;
133 +  fdDataSize: Short;
134 +  fdDataOfs: Integer;
135 +  fdCodePage: TSystemCodePage;
136 + end;
137 +
138 + PFieldColumns = ^TFieldColumns;
139 + TFieldColumns =  array[1..1] of TColumnData;
140 +
141    TRecordData = record
142      rdBookmarkFlag: TBookmarkFlag;
143      rdFieldCount: Short;
144 <    rdRecordNumber: Long;
144 >    rdRecordNumber: Integer;
145      rdCachedUpdateStatus: TCachedUpdateStatus;
146      rdUpdateStatus: TUpdateStatus;
147      rdSavedOffset: DWORD;
# Line 103 | Line 150 | type
150    end;
151    PRecordData = ^TRecordData;
152  
153 +  { TIBArrayField }
154 +
155 +  TIBArrayField = class(TField)
156 +  private
157 +    FArrayBounds: TArrayBounds;
158 +    FArrayDimensions: integer;
159 +    FRelationName: string;
160 +    FCacheOffset: word;
161 +    function GetArrayID: TISC_QUAD;
162 +    function GetArrayIntf: IArray;
163 +    procedure SetArrayIntf(AValue: IArray);
164 +  protected
165 +    class procedure CheckTypeSize(AValue: Longint); override;
166 +    function GetAsString: string; override;
167 +    function GetDataSize: Integer; override;
168 +    procedure Bind(Binding: Boolean); override;
169 +  public
170 +    constructor Create(AOwner: TComponent); override;
171 +    function CreateArray: IArray;
172 +    property ArrayID: TISC_QUAD read GetArrayID;
173 +    property ArrayIntf: IArray read GetArrayIntf write SetArrayIntf;
174 +    property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
175 +    property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
176 +  end;
177 +
178    { TIBStringField allows us to have strings longer than 8196 }
179  
180    TIBStringField = class(TStringField)
181 +  private
182 +    FCharacterSetName: RawByteString;
183 +    FCharacterSetSize: integer;
184 +    FAutoFieldSize: boolean;
185 +    FCodePage: TSystemCodePage;
186 +    FDataSize: integer;
187 +  protected
188 +    procedure Bind(Binding: Boolean); override;
189 +    function GetDataSize: Integer; override;
190    public
191 <    constructor create(AOwner: TComponent); override;
191 >    constructor Create(aOwner: TComponent); override;
192      class procedure CheckTypeSize(Value: Integer); override;
193      function GetAsString: string; override;
194      function GetAsVariant: Variant; override;
195      function GetValue(var Value: string): Boolean;
196      procedure SetAsString(const Value: string); override;
197 +    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
198 +    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
199 +    property CodePage: TSystemCodePage read FCodePage write FCodePage;
200 +  published
201 +    property AutoFieldSize: boolean read FAutoFieldSize write FAutoFieldSize default true;
202    end;
203  
204    { TIBBCDField }
# Line 123 | Line 209 | type
209       Note: y > 4 will default to Floats
210    }
211    TIBBCDField = class(TBCDField)
212 +  private
213 +    FIdentityColumn: boolean;
214    protected
215 +    procedure Bind(Binding: Boolean); override;
216      class procedure CheckTypeSize(Value: Integer); override;
217      function GetAsCurrency: Currency; override;
218      function GetAsString: string; override;
# Line 131 | Line 220 | type
220      function GetDataSize: Integer; override;
221    public
222      constructor Create(AOwner: TComponent); override;
223 +    property IdentityColumn: boolean read FIdentityColumn;
224    published
225      property Size default 8;
226    end;
227  
228 +  {The following integer field types extend the built in versions to enable IBX appplications
229 +   to check for an Identity column}
230 +
231 +  { TIBSmallintField }
232 +
233 +  TIBSmallintField = class(TSmallintField)
234 +  private
235 +    FIdentityColumn: boolean;
236 +  protected
237 +    procedure Bind(Binding: Boolean); override;
238 +  public
239 +    property IdentityColumn: boolean read FIdentityColumn;
240 +  end;
241 +
242 +  { TIBIntegerField }
243 +
244 +  TIBIntegerField = class(TIntegerField)
245 +  private
246 +    FIdentityColumn: boolean;
247 +  protected
248 +    procedure Bind(Binding: Boolean); override;
249 +  public
250 +    property IdentityColumn: boolean read FIdentityColumn;
251 +  end;
252 +
253 +  { TIBLargeIntField }
254 +
255 +  TIBLargeIntField = class(TLargeIntField)
256 +  private
257 +    FIdentityColumn: boolean;
258 +  protected
259 +    procedure Bind(Binding: Boolean); override;
260 +  public
261 +    property IdentityColumn: boolean read FIdentityColumn;
262 +  end;
263 +
264 +  {TIBMemoField}
265 +  {Allows us to show truncated text in DBGrids and anything else that uses
266 +   DisplayText}
267 +
268 +   TIBMemoField = class(TMemoField)
269 +   private
270 +     FCharacterSetName: RawByteString;
271 +     FCharacterSetSize: integer;
272 +     FDisplayTextAsClassName: boolean;
273 +     function GetTruncatedText: string;
274 +   protected
275 +     procedure Bind(Binding: Boolean); override;
276 +     function GetAsString: string; override;
277 +     function GetDefaultWidth: Longint; override;
278 +     procedure GetText(var AText: string; ADisplayText: Boolean); override;
279 +     procedure SetAsString(const AValue: string); override;
280 +   public
281 +     constructor Create(AOwner: TComponent); override;
282 +     property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
283 +     property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
284 +   published
285 +     property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
286 +                                            write FDisplayTextAsClassName;
287 +   private
288 +     FCodePage: TSystemCodePage;
289 +     FFCodePage: TSystemCodePage;
290 +   public
291 +     property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
292 +   end;
293 +
294    TIBDataLink = class(TDetailDataLink)
295    private
296      FDataSet: TIBCustomDataSet;
# Line 159 | Line 315 | type
315      FFieldName: string;
316      FGeneratorName: string;
317      FIncrement: integer;
162    function GetSelectSQL: string;
318      procedure SetIncrement(const AValue: integer);
319    protected
320      function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
# Line 167 | Line 322 | type
322      constructor Create(Owner: TIBCustomDataSet);
323      procedure Apply;
324      property Owner: TIBCustomDataSet read FOwner;
170    property SelectSQL: string read GetSelectSQL;
325    published
326 <    property GeneratorName: string read FGeneratorName write FGeneratorName;
327 <    property FieldName: string read FFieldName write FFieldName;
326 >    property Generator: string read FGeneratorName write FGeneratorName;
327 >    property Field: string read FFieldName write FFieldName;
328      property Increment: integer read FIncrement write SetIncrement default 1;
329      property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
330    end;
331  
332 +  {TIBControlLink - Allows IB Aware controls to react to dataset state changes}
333 +
334 +  TIBControlLink = class
335 +  private
336 +    FTIBDataSet: TIBCustomDataSet;
337 +    procedure SetIBDataSet(AValue: TIBCustomDataSet);
338 +  protected
339 +    procedure UpdateSQL(Sender: TObject); virtual;
340 +    procedure UpdateParams(Sender: TObject); virtual;
341 +  public
342 +    destructor Destroy; override;
343 +    property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
344 +  end;
345 +
346 +  TIBAutoCommit = (acDisabled, acCommitRetaining);
347 +
348    { TIBCustomDataSet }
349 +
350    TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
351  
352    TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
353 <                                 UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
353 >                                 UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
354                                   of object;
355    TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
356                                     var UpdateAction: TIBUpdateAction) of object;
357  
358    TIBUpdateRecordTypes = set of TCachedUpdateStatus;
359  
360 +  TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
361 +
362 +  TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
363 +
364    TIBCustomDataSet = class(TDataset)
365    private
366 <    FGenerator: TIBGenerator;
366 >    FAllowAutoActivateTransaction: Boolean;
367 >    FArrayFieldCount: integer;
368 >    FArrayCacheOffset: integer;
369 >    FAutoCommit: TIBAutoCommit;
370 >    FGenerateParamNames: Boolean;
371 >    FGeneratorField: TIBGenerator;
372      FNeedsRefresh: Boolean;
373      FForcedRefresh: Boolean;
374      FDidActivate: Boolean;
195    FIBLoaded: Boolean;
375      FBase: TIBBase;
376      FBlobCacheOffset: Integer;
377      FBlobStreamList: TList;
378 +    FArrayList: TList;
379      FBufferChunks: Integer;
380      FBufferCache,
381      FOldBufferCache: PChar;
# Line 213 | Line 393 | type
393      FDeletedRecords: Long;
394      FModelBuffer,
395      FOldBuffer: PChar;
396 +    FOnValidatePost: TOnValidatePost;
397      FOpen: Boolean;
398      FInternalPrepared: Boolean;
399      FQDelete,
# Line 220 | Line 401 | type
401      FQRefresh,
402      FQSelect,
403      FQModify: TIBSQL;
404 +    FDatabaseInfo: TIBDatabaseInfo;
405      FRecordBufferSize: Integer;
406      FRecordCount: Integer;
407      FRecordSize: Integer;
408 +    FDataSetCloseAction: TDataSetCloseAction;
409      FUniDirectional: Boolean;
410      FUpdateMode: TUpdateMode;
411      FUpdateObject: TIBDataSetUpdateObject;
# Line 240 | Line 423 | type
423      FBeforeTransactionEnd,
424      FAfterTransactionEnd,
425      FTransactionFree: TNotifyEvent;
426 <
427 <    function GetSelectStmtHandle: TISC_STMT_HANDLE;
426 >    FAliasNameMap: array of string;
427 >    FAliasNameList: array of string;
428 >    FBaseSQLSelect: TStrings;
429 >    FParser: TSelectSQLParser;
430 >    FCloseAction: TTransactionAction;
431 >    FInTransactionEnd: boolean;
432 >    FIBLinks: TList;
433 >    FFieldColumns: PFieldColumns;
434 >    procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex,
435 >      FieldIndex: integer; Buffer: PChar);
436 >    procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
437 >    function GetSelectStmtIntf: IStatement;
438      procedure SetUpdateMode(const Value: TUpdateMode);
439      procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
440  
# Line 253 | Line 446 | type
446      function CanRefresh: Boolean;
447      procedure CheckEditState;
448      procedure ClearBlobCache;
449 +    procedure ClearArrayCache;
450 +    procedure ClearIBLinks;
451      procedure CopyRecordBuffer(Source, Dest: Pointer);
452      procedure DoBeforeDatabaseDisconnect(Sender: TObject);
453      procedure DoAfterDatabaseDisconnect(Sender: TObject);
454      procedure DoDatabaseFree(Sender: TObject);
455 <    procedure DoBeforeTransactionEnd(Sender: TObject);
455 >    procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
456      procedure DoAfterTransactionEnd(Sender: TObject);
457      procedure DoTransactionFree(Sender: TObject);
458      procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
459                                           Buffer: PChar);
460      function GetDatabase: TIBDatabase;
266    function GetDBHandle: PISC_DB_HANDLE;
461      function GetDeleteSQL: TStrings;
462      function GetInsertSQL: TStrings;
463 <    function GetSQLParams: TIBXSQLDA;
463 >    function GetSQLParams: ISQLParams;
464      function GetRefreshSQL: TStrings;
465      function GetSelectSQL: TStrings;
466 <    function GetStatementType: TIBSQLTypes;
466 >    function GetStatementType: TIBSQLStatementTypes;
467      function GetModifySQL: TStrings;
468      function GetTransaction: TIBTransaction;
469 <    function GetTRHandle: PISC_TR_HANDLE;
469 >    function GetParser: TSelectSQLParser;
470      procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
471      function InternalLocate(const KeyFields: string; const KeyValues: Variant;
472                              Options: TLocateOptions): Boolean; virtual;
473      procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
474      procedure InternalRevertRecord(RecordNumber: Integer); virtual;
475      function IsVisible(Buffer: PChar): Boolean;
476 +    procedure RegisterIBLink(Sender: TIBControlLink);
477 +    procedure UnRegisterIBLink(Sender: TIBControlLink);
478      procedure SaveOldBuffer(Buffer: PChar);
479      procedure SetBufferChunks(Value: Integer);
480      procedure SetDatabase(Value: TIBDatabase);
481      procedure SetDeleteSQL(Value: TStrings);
482      procedure SetInsertSQL(Value: TStrings);
483 <    procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
483 >    procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
484      procedure SetRefreshSQL(Value: TStrings);
485      procedure SetSelectSQL(Value: TStrings);
486      procedure SetModifySQL(Value: TStrings);
487      procedure SetTransaction(Value: TIBTransaction);
488      procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
489      procedure SetUniDirectional(Value: Boolean);
490 +    procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
491      procedure RefreshParams;
295    procedure SQLChanging(Sender: TObject); virtual;
492      function AdjustPosition(FCache: PChar; Offset: DWORD;
493 <                            Origin: Integer): Integer;
493 >                            Origin: Integer): DWORD;
494      procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
495                         Buffer: PChar);
496      procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
# Line 311 | Line 507 | type
507      procedure DeactivateTransaction;
508      procedure CheckDatasetClosed;
509      procedure CheckDatasetOpen;
510 +    function CreateParser: TSelectSQLParser; virtual;
511 +    procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
512      function GetActiveBuf: PChar;
513      procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
514      procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
# Line 320 | Line 518 | type
518      procedure InternalRefreshRow; virtual;
519      procedure InternalSetParamsFromCursor; virtual;
520      procedure CheckNotUniDirectional;
521 +    procedure SQLChanging(Sender: TObject); virtual;
522 +    procedure SQLChanged(Sender: TObject); virtual;
523  
524 < (*    { IProviderSupport }
524 >    { IProviderSupport }
525      procedure PSEndTransaction(Commit: Boolean); override;
526      function PSExecuteStatement(const ASQL: string; AParams: TParams;
527        ResultSet: Pointer = nil): Integer; override;
# Line 334 | Line 534 | type
534      procedure PSStartTransaction; override;
535      procedure PSReset; override;
536      function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
537 < *)
537 >
538      { TDataSet support }
539      procedure InternalInsert; override;
540      procedure InitRecord(Buffer: PChar); override;
# Line 343 | Line 543 | type
543      procedure ClearCalcFields(Buffer: PChar); override;
544      function AllocRecordBuffer: PChar; override;
545      procedure DoBeforeDelete; override;
546 +    procedure DoAfterDelete; override;
547      procedure DoBeforeEdit; override;
548 +    procedure DoAfterEdit; override;
549      procedure DoBeforeInsert; override;
550      procedure DoAfterInsert; override;
551 +    procedure DoBeforeClose; override;
552 +    procedure DoBeforeOpen; override;
553      procedure DoBeforePost; override;
554 +    procedure DoAfterPost; override;
555      procedure FreeRecordBuffer(var Buffer: PChar); override;
556      procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
557      function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
558      function GetCanModify: Boolean; override;
559      function GetDataSource: TDataSource; override;
560 +    function GetDBAliasName(FieldNo: integer): string;
561 +    function GetFieldDefFromAlias(aliasName: string): TFieldDef;
562      function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
563      function GetRecNo: Integer; override;
564      function GetRecord(Buffer: PChar; GetMode: TGetMode;
565                         DoCheck: Boolean): TGetResult; override;
566      function GetRecordCount: Integer; override;
567      function GetRecordSize: Word; override;
568 +    procedure InternalAutoCommit;
569      procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
570      procedure InternalCancel; override;
571      procedure InternalClose; override;
# Line 375 | Line 583 | type
583      procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
584      procedure InternalSetToRecord(Buffer: PChar); override;
585      function IsCursorOpen: Boolean; override;
586 +    procedure Loaded; override;
587      procedure ReQuery;
588      procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
589      procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
590      procedure SetCachedUpdates(Value: Boolean);
591      procedure SetDataSource(Value: TDataSource);
592 +    procedure SetGenerateParamNames(AValue: Boolean); virtual;
593      procedure SetFieldData(Field : TField; Buffer : Pointer); override;
594      procedure SetFieldData(Field : TField; Buffer : Pointer;
595        NativeFormat : Boolean); overload; override;
# Line 387 | Line 597 | type
597  
598    protected
599      {Likely to be made public by descendant classes}
600 <    property SQLParams: TIBXSQLDA read GetSQLParams;
601 <    property Params: TIBXSQLDA read GetSQLParams;
600 >    property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
601 >    property SQLParams: ISQLParams read GetSQLParams;
602 >    property Params: ISQLParams read GetSQLParams;
603      property InternalPrepared: Boolean read FInternalPrepared;
604      property QDelete: TIBSQL read FQDelete;
605      property QInsert: TIBSQL read FQInsert;
606      property QRefresh: TIBSQL read FQRefresh;
607      property QSelect: TIBSQL read FQSelect;
608      property QModify: TIBSQL read FQModify;
609 <    property StatementType: TIBSQLTypes read GetStatementType;
610 <    property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
609 >    property StatementType: TIBSQLStatementTypes read GetStatementType;
610 >    property SelectStmtHandle: IStatement read GetSelectStmtIntf;
611  
612      {Likely to be made published by descendant classes}
613      property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
614      property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
615      property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
616 <    property Generator: TIBGenerator read FGenerator write FGenerator;
616 >    property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
617      property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
618      property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
619      property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
# Line 410 | Line 621 | type
621      property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
622      property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
623      property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
624 +    property Parser: TSelectSQLParser read GetParser;
625 +    property BaseSQLSelect: TStrings read FBaseSQLSelect;
626  
627      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
628                                                   write FBeforeDatabaseDisconnect;
# Line 423 | Line 636 | type
636                                              write FAfterTransactionEnd;
637      property TransactionFree: TNotifyEvent read FTransactionFree
638                                             write FTransactionFree;
639 +    property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
640  
641    public
642      constructor Create(AOwner: TComponent); override;
# Line 430 | Line 644 | type
644      procedure ApplyUpdates;
645      function CachedUpdateStatus: TCachedUpdateStatus;
646      procedure CancelUpdates;
647 +    function GetFieldPosition(AliasName: string): integer;
648      procedure FetchAll;
649      function LocateNext(const KeyFields: string; const KeyValues: Variant;
650                          Options: TLocateOptions): Boolean;
651      procedure RecordModified(Value: Boolean);
652      procedure RevertRecord;
653      procedure Undelete;
654 +    procedure ResetParser; virtual;
655 +    function HasParser: boolean;
656  
657      { TDataSet support methods }
658      function BookmarkValid(Bookmark: TBookmark): Boolean; override;
659      function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
660      function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
661 +    function GetArray(Field: TIBArrayField): IArray;
662 +    procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
663      function GetCurrentRecord(Buffer: PChar): Boolean; override;
664      function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
665      function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
666      function GetFieldData(Field : TField; Buffer : Pointer;
667        NativeFormat : Boolean) : Boolean; overload; override;
668 +    property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
669      function Locate(const KeyFields: string; const KeyValues: Variant;
670                      Options: TLocateOptions): Boolean; override;
671      function Lookup(const KeyFields: string; const KeyValues: Variant;
672                      const ResultFields: string): Variant; override;
673      function UpdateStatus: TUpdateStatus; override;
674      function IsSequenced: Boolean; override;
675 <
676 <    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
677 <    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
675 >    procedure Post; override;
676 >    function ParamByName(ParamName: String): ISQLParam;
677 >    property ArrayFieldCount: integer read FArrayFieldCount;
678      property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
679      property UpdatesPending: Boolean read FUpdatesPending;
680      property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
681                                                        write SetUpdateRecordTypes;
682 +    property DataSetCloseAction: TDataSetCloseAction
683 +               read FDataSetCloseAction write FDataSetCloseAction;
684  
685    published
686 +    property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
687 +                 write FAllowAutoActivateTransaction;
688      property Database: TIBDatabase read GetDatabase write SetDatabase;
689      property Transaction: TIBTransaction read GetTransaction
690                                            write SetTransaction;
# Line 497 | Line 721 | type
721                                                     write FOnUpdateRecord;
722    end;
723  
724 <  TIBDataSet = class(TIBCustomDataSet)
724 >  TIBParserDataSet = class(TIBCustomDataSet)
725 >  public
726 >    property Parser;
727 >  end;
728 >
729 >  TIBDataSet = class(TIBParserDataSet)
730    private
731      function GetPrepared: Boolean;
732  
# Line 522 | Line 751 | type
751      property QModify;
752      property StatementType;
753      property SelectStmtHandle;
754 +    property BaseSQLSelect;
755  
756    published
757      { TIBCustomDataSet }
758 +    property AutoCommit;
759      property BufferChunks;
760      property CachedUpdates;
761      property DeleteSQL;
# Line 532 | Line 763 | type
763      property RefreshSQL;
764      property SelectSQL;
765      property ModifySQL;
766 <    property Generator;
766 >    property GeneratorField;
767 >    property GenerateParamNames;
768      property ParamCheck;
769      property UniDirectional;
770      property Filtered;
771 +    property DataSetCloseAction;
772  
773      property BeforeDatabaseDisconnect;
774      property AfterDatabaseDisconnect;
# Line 571 | Line 804 | type
804      property OnFilterRecord;
805      property OnNewRecord;
806      property OnPostError;
807 +    property OnValidatePost;
808    end;
809  
810    { TIBDSBlobStream }
811    TIBDSBlobStream = class(TStream)
812 +  private
813 +    FHasWritten: boolean;
814    protected
815      FField: TField;
816      FBlobStream: TIBBlobStream;
817 +    function  GetSize: Int64; override;
818    public
819      constructor Create(AField: TField; ABlobStream: TIBBlobStream;
820                         Mode: TBlobStreamMode);
821 +    destructor Destroy; override;
822      function Read(var Buffer; Count: Longint): Longint; override;
823      function Seek(Offset: Longint; Origin: Word): Longint; override;
824      procedure SetSize(NewSize: Longint); override;
825      function Write(const Buffer; Count: Longint): Longint; override;
826    end;
827  
828 +  {Extended Field Def for character set info}
829 +
830 +  { TIBFieldDef }
831 +
832 +  TIBFieldDef = class(TFieldDef)
833 +  private
834 +    FArrayBounds: TArrayBounds;
835 +    FArrayDimensions: integer;
836 +    FCharacterSetName: RawByteString;
837 +    FCharacterSetSize: integer;
838 +    FCodePage: TSystemCodePage;
839 +    FIdentityColumn: boolean;
840 +    FRelationName: string;
841 +    FDataSize: integer;
842 +  published
843 +    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
844 +    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
845 +    property CodePage: TSystemCodePage read FCodePage write FCodePage;
846 +    property DataSize: integer read FDataSize write FDataSize;
847 +    property RelationName: string read FRelationName write FRelationName;
848 +    property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
849 +    property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
850 +    property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false;
851 +  end;
852 +
853   const
854   DefaultFieldClasses: array[TFieldType] of TFieldClass = (
855      nil,                { ftUnknown }
856      TIBStringField,     { ftString }
857 <    TSmallintField,     { ftSmallint }
858 <    TIntegerField,      { ftInteger }
857 >    TIBSmallintField,   { ftSmallint }
858 >    TIBIntegerField,      { ftInteger }
859      TWordField,         { ftWord }
860      TBooleanField,      { ftBoolean }
861      TFloatField,        { ftFloat }
# Line 605 | Line 868 | DefaultFieldClasses: array[TFieldType] o
868      TVarBytesField,     { ftVarBytes }
869      TAutoIncField,      { ftAutoInc }
870      TBlobField,         { ftBlob }
871 <    TMemoField,         { ftMemo }
871 >    TIBMemoField,       { ftMemo }
872      TGraphicField,      { ftGraphic }
873      TBlobField,         { ftFmtMemo }
874      TBlobField,         { ftParadoxOle }
# Line 613 | Line 876 | DefaultFieldClasses: array[TFieldType] o
876      TBlobField,         { ftTypedBinary }
877      nil,                { ftCursor }
878      TStringField,       { ftFixedChar }
879 <    TWideStringField,    { ftWideString }
880 <    TLargeIntField,     { ftLargeInt }
879 >    nil,    { ftWideString }
880 >    TIBLargeIntField,     { ftLargeInt }
881      nil,          { ftADT }
882 <    nil,        { ftArray }
882 >    TIBArrayField,        { ftArray }
883      nil,    { ftReference }
884      nil,     { ftDataSet }
885      TBlobField,         { ftOraBlob }
# Line 628 | Line 891 | DefaultFieldClasses: array[TFieldType] o
891      TDateTimeField,    {ftTimestamp}
892      TIBBCDField,       {ftFMTBcd}
893      nil,  {ftFixedWideChar}
894 <    TWideMemoField);   {ftWideMemo}
895 <
896 < (*    TADTField,          { ftADT }
894 >    nil);   {ftWideMemo}
895 > (*
896 >    TADTField,          { ftADT }
897      TArrayField,        { ftArray }
898      TReferenceField,    { ftReference }
899      TDataSetField,     { ftDataSet }
# Line 639 | Line 902 | DefaultFieldClasses: array[TFieldType] o
902      TVariantField,      { ftVariant }
903      TInterfaceField,    { ftInterface }
904      TIDispatchField,     { ftIDispatch }
905 <    TGuidField);        { ftGuid }*)
905 >    TGuidField);        { ftGuid } *)
906   (*var
907    CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
908  
909   implementation
910  
911 < uses IBIntf, Variants, FmtBCD;
911 > uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
912  
913   const FILE_BEGIN = 0;
914        FILE_CURRENT = 1;
# Line 658 | Line 921 | type
921      FieldName : String;
922      COMPUTED_BLR : Boolean;
923      DEFAULT_VALUE : boolean;
924 +    IDENTITY_COLUMN : boolean;
925      NextField : TFieldNode;
926    end;
927  
# Line 669 | Line 933 | type
933    end;
934  
935  
936 < { TIBStringField}
936 >  {  Copied from LCLProc in order to avoid LCL dependency
937 >
938 >    Ensures the covenient look of multiline string
939 >    when displaying it in the single line
940 >    * Replaces CR and LF with spaces
941 >    * Removes duplicate spaces
942 >  }
943 >  function TextToSingleLine(const AText: string): string;
944 >  var
945 >    str: string;
946 >    i, wstart, wlen: Integer;
947 >  begin
948 >    str := Trim(AText);
949 >    wstart := 0;
950 >    wlen := 0;
951 >    i := 1;
952 >    while i < Length(str) - 1 do
953 >    begin
954 >      if (str[i] in [' ', #13, #10]) then
955 >      begin
956 >        if (wstart = 0) then
957 >        begin
958 >          wstart := i;
959 >          wlen := 1;
960 >        end else
961 >          Inc(wlen);
962 >      end else
963 >      begin
964 >        if wstart > 0 then
965 >        begin
966 >          str[wstart] := ' ';
967 >          Delete(str, wstart+1, wlen-1);
968 >          Dec(i, wlen-1);
969 >          wstart := 0;
970 >        end;
971 >      end;
972 >      Inc(i);
973 >    end;
974 >    Result := str;
975 >  end;
976 >
977 > { TIBLargeIntField }
978 >
979 > procedure TIBLargeIntField.Bind(Binding: Boolean);
980 > begin
981 >  inherited Bind(Binding);
982 >  if Binding and (FieldDef <> nil) then
983 >     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
984 > end;
985 >
986 > { TIBIntegerField }
987 >
988 > procedure TIBIntegerField.Bind(Binding: Boolean);
989 > begin
990 >  inherited Bind(Binding);
991 >  if Binding and (FieldDef <> nil) then
992 >     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
993 > end;
994 >
995 > { TIBSmallintField }
996 >
997 > procedure TIBSmallintField.Bind(Binding: Boolean);
998 > begin
999 >  inherited Bind(Binding);
1000 >  if Binding and (FieldDef <> nil) then
1001 >     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1002 > end;
1003 >
1004 > { TIBArray }
1005 >
1006 > procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
1007 > begin
1008 >  case Reason of
1009 >  arChanging:
1010 >    if FRecNo <> FField.Dataset.RecNo then
1011 >      IBError(ibxeNotCurrentArray,[nil]);
1012 >
1013 >  arChanged:
1014 >    FField.DataChanged;
1015 >  end;
1016 > end;
1017 >
1018 > constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
1019 > begin
1020 >  inherited Create;
1021 >  FField := aField;
1022 >  FArray := anArray;
1023 >  FRecNo := FField.Dataset.RecNo;
1024 >  FArray.AddEventHandler(EventHandler);
1025 > end;
1026 >
1027 > destructor TIBArray.Destroy;
1028 > begin
1029 >  FArray.RemoveEventHandler(EventHandler);
1030 >  inherited Destroy;
1031 > end;
1032 >
1033 > { TIBArrayField }
1034 >
1035 > function TIBArrayField.GetArrayIntf: IArray;
1036 > begin
1037 >  Result := TIBCustomDataSet(DataSet).GetArray(self);
1038 > end;
1039 >
1040 > function TIBArrayField.GetArrayID: TISC_QUAD;
1041 > begin
1042 >  GetData(@Result);
1043 > end;
1044 >
1045 > procedure TIBArrayField.SetArrayIntf(AValue: IArray);
1046 > begin
1047 >  TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
1048 >  DataChanged;
1049 > end;
1050 >
1051 > class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
1052 > begin
1053 >  //Ignore
1054 > end;
1055 >
1056 > function TIBArrayField.GetAsString: string;
1057 > begin
1058 >  Result := '(Array)';
1059 > end;
1060 >
1061 > function TIBArrayField.GetDataSize: Integer;
1062 > begin
1063 >  Result := sizeof(TISC_QUAD);
1064 > end;
1065 >
1066 > procedure TIBArrayField.Bind(Binding: Boolean);
1067 > begin
1068 >  inherited Bind(Binding);
1069 >  if Binding then
1070 >  begin
1071 >    FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
1072 >    Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
1073 >    if FieldDef <> nil then
1074 >    begin
1075 >      FRelationName := TIBFieldDef(FieldDef).FRelationName;
1076 >      FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
1077 >      FArrayBounds :=  TIBFieldDef(FieldDef).ArrayBounds;
1078 >    end;
1079 >  end;
1080 > end;
1081 >
1082 > constructor TIBArrayField.Create(AOwner: TComponent);
1083 > begin
1084 >  inherited Create(AOwner);
1085 >  SetDataType(ftArray);
1086 > end;
1087 >
1088 > function TIBArrayField.CreateArray: IArray;
1089 > begin
1090 > with DataSet as TIBCustomDataSet do
1091 >  Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1092 > end;
1093 >
1094 > { TIBMemoField }
1095 >
1096 > function TIBMemoField.GetTruncatedText: string;
1097 > begin
1098 >   Result := GetAsString;
1099 >
1100 >   if Result <> '' then
1101 >   begin
1102 >       case CharacterSetSize of
1103 >       1:
1104 >         if DisplayWidth = 0 then
1105 >           Result := TextToSingleLine(Result)
1106 >         else
1107 >         if Length(Result) > DisplayWidth then {Show truncation with elipses}
1108 >           Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
1109 >
1110 >       {2: case 2 ignored. This should be handled by TIBWideMemo}
1111 >
1112 >       3, {Assume UNICODE_FSS is really UTF8}
1113 >       4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1114 >         if DisplayWidth = 0 then
1115 >           Result := ValidUTF8String(TextToSingleLine(Result))
1116 >         else
1117 >         if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1118 >           Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1119 >       end;
1120 >   end
1121 > end;
1122 >
1123 > procedure TIBMemoField.Bind(Binding: Boolean);
1124 > var IBFieldDef: TIBFieldDef;
1125 > begin
1126 >  inherited Bind(Binding);
1127 >  if Binding and (FieldDef <> nil) then
1128 >  begin
1129 >    IBFieldDef := FieldDef as TIBFieldDef;
1130 >    CharacterSetSize := IBFieldDef.CharacterSetSize;
1131 >    CharacterSetName := IBFieldDef.CharacterSetName;
1132 >    CodePage := IBFieldDef.CodePage;
1133 >  end;
1134 > end;
1135 >
1136 > function TIBMemoField.GetAsString: string;
1137 > var s: RawByteString;
1138 > begin
1139 >  s := inherited GetAsString;
1140 >  SetCodePage(s,CodePage,false);
1141 >  if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1142 >    SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1143 >  Result := s;
1144 > end;
1145 >
1146 > function TIBMemoField.GetDefaultWidth: Longint;
1147 > begin
1148 >  if DisplayTextAsClassName then
1149 >    Result := inherited
1150 >  else
1151 >    Result := 128;
1152 > end;
1153 >
1154 > procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
1155 > begin
1156 >  if ADisplayText then
1157 >  begin
1158 >    if not DisplayTextAsClassName and (CharacterSetName <> '') then
1159 >      AText := GetTruncatedText
1160 >    else
1161 >      inherited GetText(AText, ADisplayText);
1162 >  end
1163 >  else
1164 >    AText := GetAsString;
1165 > end;
1166 >
1167 > procedure TIBMemoField.SetAsString(const AValue: string);
1168 > var s: RawByteString;
1169 > begin
1170 >  s := AValue;
1171 >  if StringCodePage(s) <> CodePage then
1172 >    SetCodePage(s,CodePage,CodePage<>CP_NONE);
1173 >  inherited SetAsString(s);
1174 > end;
1175  
1176 < constructor TIBStringField.Create(AOwner: TComponent);
1176 > constructor TIBMemoField.Create(AOwner: TComponent);
1177   begin
1178    inherited Create(AOwner);
1179 +  BlobType := ftMemo;
1180 +  FCodePage := CP_NONE;
1181 + end;
1182 +
1183 + { TIBControlLink }
1184 +
1185 + destructor TIBControlLink.Destroy;
1186 + begin
1187 +  IBDataSet := nil;
1188 +  inherited Destroy;
1189 + end;
1190 +
1191 + procedure TIBControlLink.UpdateParams(Sender: TObject);
1192 + begin
1193 +
1194 + end;
1195 +
1196 + procedure TIBControlLink.UpdateSQL(Sender: TObject);
1197 + begin
1198 +
1199 + end;
1200 +
1201 + procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1202 + begin
1203 +  if FTIBDataSet = AValue then Exit;
1204 +  if IBDataSet <> nil then
1205 +    IBDataSet.UnRegisterIBLink(self);
1206 +  FTIBDataSet := AValue;
1207 +  if IBDataSet <> nil then
1208 +    IBDataSet.RegisterIBLink(self);
1209 + end;
1210 +
1211 +
1212 + { TIBStringField}
1213 +
1214 + procedure TIBStringField.Bind(Binding: Boolean);
1215 + var IBFieldDef: TIBFieldDef;
1216 + begin
1217 +  inherited Bind(Binding);
1218 +  if Binding and (FieldDef <> nil) then
1219 +  begin
1220 +    IBFieldDef := FieldDef as TIBFieldDef;
1221 +    CharacterSetSize := IBFieldDef.CharacterSetSize;
1222 +    CharacterSetName := IBFieldDef.CharacterSetName;
1223 +    FDataSize := IBFieldDef.DataSize + 1;
1224 +    if AutoFieldSize then
1225 +      Size := IBFieldDef.Size;
1226 +    CodePage := IBFieldDef.CodePage;
1227 +  end;
1228 + end;
1229 +
1230 + function TIBStringField.GetDataSize: Integer;
1231 + begin
1232 +  Result := FDataSize;
1233 + end;
1234 +
1235 + constructor TIBStringField.Create(aOwner: TComponent);
1236 + begin
1237 +  inherited Create(aOwner);
1238 +  FCharacterSetSize := 1;
1239 +  FCodePage := CP_NONE;
1240 +  FAutoFieldSize := true;
1241   end;
1242  
1243   class procedure TIBStringField.CheckTypeSize(Value: Integer);
# Line 696 | Line 1260 | end;
1260   function TIBStringField.GetValue(var Value: string): Boolean;
1261   var
1262    Buffer: PChar;
1263 +  s: RawByteString;
1264   begin
1265    Buffer := nil;
1266 <  IBAlloc(Buffer, 0, Size + 1);
1266 >  IBAlloc(Buffer, 0, DataSize);
1267    try
1268      Result := GetData(Buffer);
1269      if Result then
1270      begin
1271 <      Value := string(Buffer);
1271 >      s := strpas(Buffer);
1272 >      SetCodePage(s,CodePage,false);
1273 >      if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1274 >        SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1275 >      Value := s;
1276 > //      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1277        if Transliterate and (Value <> '') then
1278          DataSet.Translate(PChar(Value), PChar(Value), False);
1279      end
# Line 715 | Line 1285 | end;
1285   procedure TIBStringField.SetAsString(const Value: string);
1286   var
1287    Buffer: PChar;
1288 +  s: RawByteString;
1289   begin
1290    Buffer := nil;
1291 <  IBAlloc(Buffer, 0, Size + 1);
1291 >  IBAlloc(Buffer, 0, DataSize);
1292    try
1293 <    StrLCopy(Buffer, PChar(Value), Size);
1293 >    s := Value;
1294 >    if StringCodePage(s) <> CodePage then
1295 >      SetCodePage(s,CodePage,CodePage<>CP_NONE);
1296 >    StrLCopy(Buffer, PChar(s), DataSize-1);
1297      if Transliterate then
1298        DataSet.Translate(Buffer, Buffer, True);
1299      SetData(Buffer);
# Line 728 | Line 1302 | begin
1302    end;
1303   end;
1304  
1305 +
1306   { TIBBCDField }
1307  
1308   constructor TIBBCDField.Create(AOwner: TComponent);
# Line 737 | Line 1312 | begin
1312    Size := 8;
1313   end;
1314  
1315 + procedure TIBBCDField.Bind(Binding: Boolean);
1316 + begin
1317 +  inherited Bind(Binding);
1318 +  if Binding and (FieldDef <> nil) then
1319 +     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1320 + end;
1321 +
1322   class procedure TIBBCDField.CheckTypeSize(Value: Integer);
1323   begin
1324   { No need to check as the base type is currency, not BCD }
# Line 770 | Line 1352 | end;
1352  
1353   function TIBBCDField.GetDataSize: Integer;
1354   begin
1355 + {$IFDEF TBCDFIELD_IS_BCD}
1356    Result := 8;
1357 + {$ELSE}
1358 +  Result := inherited GetDataSize
1359 + {$ENDIF}
1360   end;
1361  
1362   { TIBDataLink }
# Line 817 | Line 1403 | end;
1403   constructor TIBCustomDataSet.Create(AOwner: TComponent);
1404   begin
1405    inherited Create(AOwner);
820  FIBLoaded := False;
821  CheckIBLoaded;
822  FIBLoaded := True;
1406    FBase := TIBBase.Create(Self);
1407 +  FDatabaseInfo := TIBDatabaseInfo.Create(self);
1408 +  FIBLinks := TList.Create;
1409    FCurrentRecord := -1;
1410    FDeletedRecords := 0;
1411    FUniDirectional := False;
1412    FBufferChunks := BufferCacheSize;
1413    FBlobStreamList := TList.Create;
1414 <  FGenerator := TIBGenerator.Create(self);
1414 >  FArrayList := TList.Create;
1415 >  FGeneratorField := TIBGenerator.Create(self);
1416    FDataLink := TIBDataLink.Create(Self);
1417    FQDelete := TIBSQL.Create(Self);
1418    FQDelete.OnSQLChanging := SQLChanging;
# Line 839 | Line 1425 | begin
1425    FQRefresh.GoToFirstRecordOnExecute := False;
1426    FQSelect := TIBSQL.Create(Self);
1427    FQSelect.OnSQLChanging := SQLChanging;
1428 +  FQSelect.OnSQLChanged := SQLChanged;
1429    FQSelect.GoToFirstRecordOnExecute := False;
1430    FQModify := TIBSQL.Create(Self);
1431    FQModify.OnSQLChanging := SQLChanging;
1432    FQModify.GoToFirstRecordOnExecute := False;
1433    FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1434    FParamCheck := True;
1435 +  FGenerateParamNames := False;
1436    FForcedRefresh := False;
1437 +  FAutoCommit:= acDisabled;
1438 +  FDataSetCloseAction := dcDiscardChanges;
1439    {Bookmark Size is Integer for IBX}
1440    BookmarkSize := SizeOf(Integer);
1441    FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
# Line 859 | Line 1449 | begin
1449    else
1450      if AOwner is TIBTransaction then
1451        Transaction := TIBTransaction(AOwner);
1452 +  FBaseSQLSelect := TStringList.Create;
1453   end;
1454  
1455   destructor TIBCustomDataSet.Destroy;
1456   begin
1457 <  if FIBLoaded then
1458 <  begin
1459 <    if assigned(FGenerator) then FGenerator.Free;
1460 <    FDataLink.Free;
1461 <    FBase.Free;
1462 <    ClearBlobCache;
1463 <    FBlobStreamList.Free;
1464 <    FreeMem(FBufferCache);
1465 <    FBufferCache := nil;
1466 <    FreeMem(FOldBufferCache);
1467 <    FOldBufferCache := nil;
1468 <    FCacheSize := 0;
1469 <    FOldCacheSize := 0;
1470 <    FMappedFieldPosition := nil;
1471 <  end;
1457 >  if Active then Active := false;
1458 >  if assigned(FGeneratorField) then FGeneratorField.Free;
1459 >  FDataLink.Free;
1460 >  FBase.Free;
1461 >  ClearBlobCache;
1462 >  ClearIBLinks;
1463 >  FIBLinks.Free;
1464 >  FBlobStreamList.Free;
1465 >  FArrayList.Free;
1466 >  FreeMem(FBufferCache);
1467 >  FBufferCache := nil;
1468 >  FreeMem(FOldBufferCache);
1469 >  FOldBufferCache := nil;
1470 >  FCacheSize := 0;
1471 >  FOldCacheSize := 0;
1472 >  FMappedFieldPosition := nil;
1473 >  if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1474 >  if assigned(FParser) then FParser.Free;
1475    inherited Destroy;
1476   end;
1477  
# Line 900 | Line 1494 | begin
1494        Inc(FCurrentRecord);
1495        if (FCurrentRecord = FRecordCount) then
1496        begin
1497 <        if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1497 >        if (not FQSelect.EOF) and FQSelect.Next  then
1498          begin
1499            FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1500            Inc(FRecordCount);
# Line 919 | Line 1513 | end;
1513  
1514   procedure TIBCustomDataSet.ApplyUpdates;
1515   var
1516 <  CurBookmark: string;
1516 >  CurBookmark: TBookmark;
1517    Buffer: PRecordData;
1518    CurUpdateTypes: TIBUpdateRecordTypes;
1519    UpdateAction: TIBUpdateAction;
# Line 979 | Line 1573 | var
1573    procedure UpdateUsingUpdateObject;
1574    begin
1575      try
1576 <      FUpdateObject.Apply(UpdateKind);
1576 >      FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1577        ResetBufferUpdateStatus;
1578      except
1579        on E: Exception do
# Line 1117 | Line 1711 | begin
1711    end;
1712   end;
1713  
1714 + function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1715 + var i: integer;
1716 +    Prepared: boolean;
1717 + begin
1718 +  Result := 0;
1719 +  Prepared := FInternalPrepared;
1720 +  if not Prepared then
1721 +    InternalPrepare;
1722 +  try
1723 +    for i := 0 to Length(FAliasNameList) - 1 do
1724 +      if FAliasNameList[i] = AliasName then
1725 +      begin
1726 +        Result := i + 1;
1727 +        Exit
1728 +      end;
1729 +  finally
1730 +    if not Prepared then
1731 +      InternalUnPrepare;
1732 +  end;
1733 + end;
1734 +
1735   procedure TIBCustomDataSet.ActivateConnection;
1736   begin
1737    if not Assigned(Database) then
# Line 1129 | Line 1744 | end;
1744   function TIBCustomDataSet.ActivateTransaction: Boolean;
1745   begin
1746    Result := False;
1747 <  if not Assigned(Transaction) then
1133 <    IBError(ibxeTransactionNotAssigned, [nil]);
1134 <  if not Transaction.Active then
1747 >  if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1748    begin
1749 <    Result := True;
1750 <    Transaction.StartTransaction;
1751 <    FDidActivate := True;
1749 >    if not Assigned(Transaction) then
1750 >      IBError(ibxeTransactionNotAssigned, [nil]);
1751 >    if not Transaction.Active then
1752 >    begin
1753 >      Result := True;
1754 >      Transaction.StartTransaction;
1755 >      FDidActivate := True;
1756 >    end;
1757    end;
1758   end;
1759  
# Line 1177 | Line 1795 | begin
1795      IBError(ibxeDatasetClosed, [nil]);
1796   end;
1797  
1798 + function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1799 + begin
1800 +  Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1801 +  Result.OnSQLChanging := SQLChanging
1802 + end;
1803 +
1804   procedure TIBCustomDataSet.CheckNotUniDirectional;
1805   begin
1806    if UniDirectional then
# Line 1254 | Line 1878 | begin
1878    FBlobStreamList.Pack;
1879   end;
1880  
1881 + procedure TIBCustomDataSet.ClearArrayCache;
1882 + var
1883 +  i: Integer;
1884 + begin
1885 +  for i := 0 to FArrayList.Count - 1 do
1886 +  begin
1887 +    TIBArray(FArrayList[i]).Free;
1888 +    FArrayList[i] := nil;
1889 +  end;
1890 +  FArrayList.Pack;
1891 + end;
1892 +
1893   procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1894   begin
1895    Move(Source^, Dest^, FRecordBufferSize);
# Line 1263 | Line 1899 | procedure TIBCustomDataSet.DoBeforeDatab
1899   begin
1900    if Active then
1901      Active := False;
1902 <  FInternalPrepared := False;
1902 >  InternalUnPrepare;
1903    if Assigned(FBeforeDatabaseDisconnect) then
1904      FBeforeDatabaseDisconnect(Sender);
1905   end;
# Line 1280 | Line 1916 | begin
1916      FDatabaseFree(Sender);
1917   end;
1918  
1919 < procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1919 > procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1920 >  Action: TTransactionAction);
1921   begin
1922 <  if Active then
1923 <    Active := False;
1922 >  FCloseAction := Action;
1923 >  FInTransactionEnd := true;
1924 >  try
1925 >    if Active then
1926 >      Active := False;
1927 >  finally
1928 >    FInTransactionEnd := false;
1929 >  end;
1930    if FQSelect <> nil then
1931      FQSelect.FreeHandle;
1932    if FQDelete <> nil then
# Line 1294 | Line 1937 | begin
1937      FQModify.FreeHandle;
1938    if FQRefresh <> nil then
1939      FQRefresh.FreeHandle;
1940 +  InternalUnPrepare;
1941    if Assigned(FBeforeTransactionEnd) then
1942      FBeforeTransactionEnd(Sender);
1943   end;
# Line 1310 | Line 1954 | begin
1954      FTransactionFree(Sender);
1955   end;
1956  
1957 < { Read the record from FQSelect.Current into the record buffer
1958 <  Then write the buffer to in memory cache }
1959 < procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1960 <  RecordNumber: Integer; Buffer: PChar);
1961 < var
1318 <  p: PRecordData;
1319 <  pbd: PBlobDataArray;
1320 <  i, j: Integer;
1321 <  LocalData: Pointer;
1322 <  LocalDate, LocalDouble: Double;
1323 <  LocalInt: Integer;
1324 <  LocalInt64: Int64;
1325 <  LocalCurrency: Currency;
1326 <  FieldsLoaded: Integer;
1327 <  temp: TIBXSQLVAR;
1957 > procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1958 > var i, j: Integer;
1959 >    FieldsLoaded: integer;
1960 >    p: PRecordData;
1961 >    colMetadata: IColumnMetaData;
1962   begin
1963    p := PRecordData(Buffer);
1330  { Make sure blob cache is empty }
1331  pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1332  if RecordNumber > -1 then
1333    for i := 0 to BlobFieldCount - 1 do
1334      pbd^[i] := nil;
1964    { Get record information }
1965    p^.rdBookmarkFlag := bfCurrent;
1966 <  p^.rdFieldCount := Qry.Current.Count;
1967 <  p^.rdRecordNumber := RecordNumber;
1966 >  p^.rdFieldCount := Qry.FieldCount;
1967 >  p^.rdRecordNumber := -1;
1968    p^.rdUpdateStatus := usUnmodified;
1969    p^.rdCachedUpdateStatus := cusUnmodified;
1970    p^.rdSavedOffset := $FFFFFFFF;
1971  
1972    { Load up the fields }
1973 <  FieldsLoaded := FQSelect.Current.Count;
1973 >  FieldsLoaded := FQSelect.MetaData.Count;
1974    j := 1;
1975 <  for i := 0 to Qry.Current.Count - 1 do
1975 >  for i := 0 to Qry.MetaData.Count - 1 do
1976    begin
1977      if (Qry = FQSelect) then
1978        j := i + 1
1979 <    else begin
1979 >    else
1980 >    begin
1981        if FieldsLoaded = 0 then
1982          break;
1983 <      j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
1983 >      j := FQSelect.FieldIndex[Qry[i].Name] + 1;
1984        if j < 1 then
1985          continue
1986        else
1987          Dec(FieldsLoaded);
1988      end;
1989 <    with FQSelect.Current[j - 1].Data^ do
1990 <      if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
1989 >    if j > 0 then
1990 >    begin
1991 >      colMetadata := Qry.MetaData[i];
1992 >      with p^.rdFields[j], FFieldColumns^[j] do
1993        begin
1994 <        if sqllen <= 8 then
1995 <          p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
1996 <        continue;
1994 >        fdDataType := colMetadata.GetSQLType;
1995 >        if fdDataType = SQL_BLOB then
1996 >          fdDataScale := 0
1997 >        else
1998 >          fdDataScale := colMetadata.getScale;
1999 >        fdNullable := colMetadata.getIsNullable;
2000 >        fdIsNull := true;
2001 >        fdDataSize := colMetadata.GetSize;
2002 >        fdDataLength := 0;
2003 >        fdCodePage := CP_NONE;
2004 >
2005 >        case fdDataType of
2006 >        SQL_TIMESTAMP,
2007 >        SQL_TYPE_DATE,
2008 >        SQL_TYPE_TIME:
2009 >          fdDataSize := SizeOf(TDateTime);
2010 >        SQL_SHORT, SQL_LONG:
2011 >        begin
2012 >          if (fdDataScale = 0) then
2013 >            fdDataSize := SizeOf(Integer)
2014 >          else
2015 >          if (fdDataScale >= (-4)) then
2016 >            fdDataSize := SizeOf(Currency)
2017 >          else
2018 >            fdDataSize := SizeOf(Double);
2019 >        end;
2020 >        SQL_INT64:
2021 >        begin
2022 >          if (fdDataScale = 0) then
2023 >            fdDataSize := SizeOf(Int64)
2024 >          else
2025 >          if (fdDataScale >= (-4)) then
2026 >            fdDataSize := SizeOf(Currency)
2027 >          else
2028 >            fdDataSize := SizeOf(Double);
2029 >        end;
2030 >        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2031 >          fdDataSize := SizeOf(Double);
2032 >        SQL_BOOLEAN:
2033 >          fdDataSize := SizeOf(wordBool);
2034 >        SQL_VARYING,
2035 >        SQL_TEXT,
2036 >        SQL_BLOB:
2037 >          fdCodePage := Qry.Metadata[i].getCodePage;
2038 >        end;
2039 >        fdDataOfs := FRecordSize;
2040 >        Inc(FRecordSize, fdDataSize);
2041        end;
2042 <    if j > 0 then with p^ do
2042 >    end;
2043 >  end;
2044 > end;
2045 >
2046 > {Update Buffer Fields from Query Results}
2047 >
2048 > procedure TIBCustomDataSet.UpdateRecordFromQuery(QryResults: IResults;
2049 >  Buffer: PChar);
2050 > var i, j: integer;
2051 > begin
2052 >  for i := 0 to QryResults.Count - 1 do
2053 >  begin
2054 >    j := GetFieldPosition(QryResults[i].GetAliasName);
2055 >    if j > 0 then
2056 >      ColumnDataToBuffer(QryResults,i,j,Buffer);
2057 >  end;
2058 > end;
2059 >
2060 >
2061 > {Move column data returned from query to row buffer}
2062 >
2063 > procedure TIBCustomDataSet.ColumnDataToBuffer(QryResults: IResults;
2064 >               ColumnIndex, FieldIndex: integer; Buffer: PChar);
2065 > var
2066 >  LocalData: PByte;
2067 >  LocalDate, LocalDouble: Double;
2068 >  LocalInt: Integer;
2069 >  LocalBool: wordBool;
2070 >  LocalInt64: Int64;
2071 >  LocalCurrency: Currency;
2072 >  p: PRecordData;
2073 >  ColData: ISQLData;
2074 > begin
2075 >  p := PRecordData(Buffer);
2076 >  LocalData := nil;
2077 >  with p^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2078 >  begin
2079 >    QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData);
2080 >    if not fdIsNull then
2081      begin
2082 <      rdFields[j].fdDataType :=
2083 <        Qry.Current[i].Data^.sqltype and (not 1);
1370 <      rdFields[j].fdDataScale :=
1371 <        Qry.Current[i].Data^.sqlscale;
1372 <      rdFields[j].fdNullable :=
1373 <        (Qry.Current[i].Data^.sqltype and 1 = 1);
1374 <      rdFields[j].fdIsNull :=
1375 <        (rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1376 <      LocalData := Qry.Current[i].Data^.sqldata;
1377 <      case rdFields[j].fdDataType of
2082 >      ColData := QryResults[ColumnIndex];
2083 >      case fdDataType of  {Get Formatted data for column types that need formatting}
2084          SQL_TIMESTAMP:
2085          begin
2086 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
2087 <          if RecordNumber >= 0 then
1382 <            LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
1383 <          LocalData := PChar(@LocalDate);
2086 >          LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(ColData.AsDateTime));
2087 >          LocalData := PByte(@LocalDate);
2088          end;
2089          SQL_TYPE_DATE:
2090          begin
2091 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
2092 <          if RecordNumber >= 0 then
1389 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
1390 <          LocalData := PChar(@LocalInt);
2091 >          LocalInt := DateTimeToTimeStamp(ColData.AsDateTime).Date;
2092 >          LocalData := PByte(@LocalInt);
2093          end;
2094          SQL_TYPE_TIME:
2095          begin
2096 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
2097 <          if RecordNumber >= 0 then
1396 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1397 <          LocalData := PChar(@LocalInt);
2096 >          LocalInt := DateTimeToTimeStamp(ColData.AsDateTime).Time;
2097 >          LocalData := PByte(@LocalInt);
2098          end;
2099          SQL_SHORT, SQL_LONG:
2100          begin
2101 <          if (rdFields[j].fdDataScale = 0) then
2101 >          if (fdDataScale = 0) then
2102            begin
2103 <            rdFields[j].fdDataSize := SizeOf(Integer);
2104 <            if RecordNumber >= 0 then
1405 <              LocalInt := Qry.Current[i].AsLong;
1406 <            LocalData := PChar(@LocalInt);
2103 >            LocalInt := ColData.AsLong;
2104 >            LocalData := PByte(@LocalInt);
2105            end
2106 <          else if (rdFields[j].fdDataScale >= (-4)) then
2107 <               begin
2108 <                 rdFields[j].fdDataSize := SizeOf(Currency);
2109 <                 if RecordNumber >= 0 then
2110 <                   LocalCurrency := Qry.Current[i].AsCurrency;
2111 <                 LocalData := PChar(@LocalCurrency);
2112 <               end
2113 <               else begin
2114 <                 rdFields[j].fdDataSize := SizeOf(Double);
2115 <                 if RecordNumber >= 0 then
2116 <                   LocalDouble := Qry.Current[i].AsDouble;
1419 <                LocalData := PChar(@LocalDouble);
1420 <              end;
2106 >          else
2107 >          if (fdDataScale >= (-4)) then
2108 >          begin
2109 >            LocalCurrency := ColData.AsCurrency;
2110 >            LocalData := PByte(@LocalCurrency);
2111 >          end
2112 >          else
2113 >          begin
2114 >           LocalDouble := ColData.AsDouble;
2115 >           LocalData := PByte(@LocalDouble);
2116 >          end;
2117          end;
2118          SQL_INT64:
2119          begin
2120 <          if (rdFields[j].fdDataScale = 0) then
2120 >          if (fdDataScale = 0) then
2121            begin
2122 <            rdFields[j].fdDataSize := SizeOf(Int64);
2123 <            if RecordNumber >= 0 then
1428 <              LocalInt64 := Qry.Current[i].AsInt64;
1429 <            LocalData := PChar(@LocalInt64);
2122 >            LocalInt64 := ColData.AsInt64;
2123 >            LocalData := PByte(@LocalInt64);
2124            end
2125 <          else if (rdFields[j].fdDataScale >= (-4)) then
2126 <               begin
1433 <                 rdFields[j].fdDataSize := SizeOf(Currency);
1434 <                 if RecordNumber >= 0 then
1435 <                   LocalCurrency := Qry.Current[i].AsCurrency;
1436 <                   LocalData := PChar(@LocalCurrency);
1437 <               end
1438 <               else begin
1439 <                  rdFields[j].fdDataSize := SizeOf(Double);
1440 <                  if RecordNumber >= 0 then
1441 <                    LocalDouble := Qry.Current[i].AsDouble;
1442 <                  LocalData := PChar(@LocalDouble);
1443 <               end
1444 <        end;
1445 <        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1446 <        begin
1447 <          rdFields[j].fdDataSize := SizeOf(Double);
1448 <          if RecordNumber >= 0 then
1449 <            LocalDouble := Qry.Current[i].AsDouble;
1450 <          LocalData := PChar(@LocalDouble);
1451 <        end;
1452 <        SQL_VARYING:
1453 <        begin
1454 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1455 <          rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1456 <          if RecordNumber >= 0 then
2125 >          else
2126 >          if (fdDataScale >= (-4)) then
2127            begin
2128 <            if (rdFields[j].fdDataLength = 0) then
2129 <              LocalData := nil
2128 >            LocalCurrency := ColData.AsCurrency;
2129 >            LocalData := PByte(@LocalCurrency);
2130 >            end
2131              else
2132              begin
2133 <              temp :=  Qry.Current[i];
2134 <              LocalData := @temp.Data^.sqldata[2];
2135 < (*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
1465 <            end;
1466 <          end;
2133 >              LocalDouble := ColData.AsDouble;
2134 >              LocalData := PByte(@LocalDouble);
2135 >            end
2136          end;
2137 <        else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
2137 >        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2138          begin
2139 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
2140 <          if (rdFields[j].fdDataType = SQL_TEXT) then
1472 <            rdFields[j].fdDataLength := rdFields[j].fdDataSize;
2139 >          LocalDouble := ColData.AsDouble;
2140 >          LocalData := PByte(@LocalDouble);
2141          end;
2142 <      end;
1475 <      if RecordNumber < 0 then
1476 <      begin
1477 <        rdFields[j].fdIsNull := True;
1478 <        rdFields[j].fdDataOfs := FRecordSize;
1479 <        Inc(FRecordSize, rdFields[j].fdDataSize);
1480 <      end
1481 <      else begin
1482 <        if rdFields[j].fdDataType = SQL_VARYING then
2142 >        SQL_BOOLEAN:
2143          begin
2144 <          if LocalData <> nil then
2145 <            Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)
2146 <        end
1487 <        else
1488 <          Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
2144 >          LocalBool := ColData.AsBoolean;
2145 >          LocalData := PByte(@LocalBool);
2146 >        end;
2147        end;
2148 +
2149 +      if fdDataType = SQL_VARYING then
2150 +        Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2151 +      else
2152 +        Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2153 +    end
2154 +    else {Null column}
2155 +    if fdDataType = SQL_VARYING then
2156 +      FillChar(Buffer[fdDataOfs],fdDataLength,0)
2157 +    else
2158 +      FillChar(Buffer[fdDataOfs],fdDataSize,0);
2159 +  end;
2160 + end;
2161 +
2162 + { Read the record from FQSelect.Current into the record buffer
2163 +  Then write the buffer to in memory cache }
2164 + procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
2165 +  RecordNumber: Integer; Buffer: PChar);
2166 + var
2167 +  pbd: PBlobDataArray;
2168 +  pda: PArrayDataArray;
2169 +  i, j: Integer;
2170 +  FieldsLoaded: Integer;
2171 +  p: PRecordData;
2172 + begin
2173 +  if RecordNumber = -1 then
2174 +  begin
2175 +    InitModelBuffer(Qry,Buffer);
2176 +    Exit;
2177 +  end;
2178 +  p := PRecordData(Buffer);
2179 +  { Make sure blob cache is empty }
2180 +  pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
2181 +  pda := PArrayDataArray(Buffer + FArrayCacheOffset);
2182 +  for i := 0 to BlobFieldCount - 1 do
2183 +    pbd^[i] := nil;
2184 +  for i := 0 to ArrayFieldCount - 1 do
2185 +    pda^[i] := nil;
2186 +
2187 +  { Get record information }
2188 +  p^.rdBookmarkFlag := bfCurrent;
2189 +  p^.rdFieldCount := Qry.FieldCount;
2190 +  p^.rdRecordNumber := RecordNumber;
2191 +  p^.rdUpdateStatus := usUnmodified;
2192 +  p^.rdCachedUpdateStatus := cusUnmodified;
2193 +  p^.rdSavedOffset := $FFFFFFFF;
2194 +
2195 +  { Load up the fields }
2196 +  FieldsLoaded := FQSelect.MetaData.Count;
2197 +  j := 1;
2198 +  for i := 0 to Qry.FieldCount - 1 do
2199 +  begin
2200 +    if (Qry = FQSelect) then
2201 +      j := i + 1
2202 +    else
2203 +    begin
2204 +      if FieldsLoaded = 0 then
2205 +        break;
2206 +      j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2207 +      if j < 1 then
2208 +        continue
2209 +      else
2210 +        Dec(FieldsLoaded);
2211      end;
2212 +    with FQSelect.MetaData[j - 1] do
2213 +      if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2214 +      begin
2215 +        if (GetSize <= 8) then
2216 +          p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2217 +        continue;
2218 +      end;
2219 +    if j > 0 then
2220 +      ColumnDataToBuffer(Qry.Current,i,j,Buffer);
2221    end;
2222 <  WriteRecordCache(RecordNumber, PChar(p));
2222 >  WriteRecordCache(RecordNumber, Buffer);
2223   end;
2224  
2225   function TIBCustomDataSet.GetActiveBuf: PChar;
# Line 1534 | Line 2264 | begin
2264    result := FBase.Database;
2265   end;
2266  
1537 function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1538 begin
1539  result := FBase.DBHandle;
1540 end;
1541
2267   function TIBCustomDataSet.GetDeleteSQL: TStrings;
2268   begin
2269    result := FQDelete.SQL;
# Line 1549 | Line 2274 | begin
2274    result := FQInsert.SQL;
2275   end;
2276  
2277 < function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
2277 > function TIBCustomDataSet.GetSQLParams: ISQLParams;
2278   begin
2279    if not FInternalPrepared then
2280      InternalPrepare;
# Line 1566 | Line 2291 | begin
2291    result := FQSelect.SQL;
2292   end;
2293  
2294 < function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
2294 > function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2295   begin
2296 <  result := FQSelect.SQLType;
2296 >  result := FQSelect.SQLStatementType;
2297   end;
2298  
2299   function TIBCustomDataSet.GetModifySQL: TStrings;
# Line 1581 | Line 2306 | begin
2306    result := FBase.Transaction;
2307   end;
2308  
1584 function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1585 begin
1586  result := FBase.TRHandle;
1587 end;
1588
2309   procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2310   begin
2311    if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2312 <    FUpdateObject.Apply(ukDelete)
2312 >    FUpdateObject.Apply(ukDelete,Buff)
2313    else
2314    begin
2315 <    SetInternalSQLParams(FQDelete, Buff);
2315 >    SetInternalSQLParams(FQDelete.Params, Buff);
2316      FQDelete.ExecQuery;
2317    end;
2318    with PRecordData(Buff)^ do
# Line 1606 | Line 2326 | end;
2326   function TIBCustomDataSet.InternalLocate(const KeyFields: string;
2327    const KeyValues: Variant; Options: TLocateOptions): Boolean;
2328   var
2329 <  fl: TList;
2330 <  CurBookmark: string;
2331 <  fld, val: Variant;
2332 <  i, fld_cnt: Integer;
2329 >  keyFieldList: TList;
2330 >  CurBookmark: TBookmark;
2331 >  fieldValue: Variant;
2332 >  lookupValues: array of variant;
2333 >  i, fieldCount: Integer;
2334 >  fieldValueAsString: string;
2335 >  lookupValueAsString: string;
2336   begin
2337 <  fl := TList.Create;
2337 >  keyFieldList := TList.Create;
2338    try
2339 <    GetFieldList(fl, KeyFields);
2340 <    fld_cnt := fl.Count;
2339 >    GetFieldList(keyFieldList, KeyFields);
2340 >    fieldCount := keyFieldList.Count;
2341      CurBookmark := Bookmark;
2342 <    result := False;
2343 <    while ((not result) and (not EOF)) do
2342 >    result := false;
2343 >    SetLength(lookupValues, fieldCount);
2344 >    if not EOF then
2345      begin
2346 <      i := 0;
1623 <      result := True;
1624 <      while (result and (i < fld_cnt)) do
2346 >      for i := 0 to fieldCount - 1 do  {expand key values into lookupValues array}
2347        begin
2348 <        if fld_cnt > 1 then
2349 <          val := KeyValues[i]
2348 >        if VarIsArray(KeyValues) then
2349 >          lookupValues[i] := KeyValues[i]
2350          else
2351 <          val := KeyValues;
2352 <        fld := TField(fl[i]).Value;
2353 <        result := not (VarIsNull(val) xor VarIsNull(fld));
2354 <        if result and not VarIsNull(val) then
2351 >        if i > 0 then
2352 >          lookupValues[i] := NULL
2353 >        else
2354 >          lookupValues[0] := KeyValues;
2355 >
2356 >        {convert to upper case is case insensitive search}
2357 >        if (TField(keyFieldList[i]).DataType = ftString) and
2358 >           not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
2359 >            lookupValues[i] := UpperCase(lookupValues[i]);
2360 >      end;
2361 >    end;
2362 >    while not result and not EOF do   {search for a matching record}
2363 >    begin
2364 >      i := 0;
2365 >      result := true;
2366 >      while result and (i < fieldCount) do
2367 >      {see if all of the key fields matches}
2368 >      begin
2369 >        fieldValue := TField(keyFieldList[i]).Value;
2370 >        result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
2371 >        if result and not VarIsNull(fieldValue) then
2372          begin
2373            try
2374 <            fld := VarAsType(fld, VarType(val));
1636 <          except
1637 <            on E: EVariantError do result := False;
1638 <          end;
1639 <          if Result then
1640 <            if TField(fl[i]).DataType = ftString then
2374 >            if TField(keyFieldList[i]).DataType = ftString then
2375              begin
2376 +              {strings need special handling because of the locate options that
2377 +               apply to them}
2378 +              fieldValueAsString := TField(keyFieldList[i]).AsString;
2379 +              lookupValueAsString := lookupValues[i];
2380                if (loCaseInsensitive in Options) then
2381 <              begin
2382 <                fld := AnsiUpperCase(fld);
1645 <                val := AnsiUpperCase(val);
1646 <              end;
1647 <              fld := TrimRight(fld);
1648 <              val := TrimRight(val);
2381 >                fieldValueAsString := UpperCase(fieldValueAsString);
2382 >
2383                if (loPartialKey in Options) then
2384 <                result := result and (AnsiPos(val, fld) = 1)
2384 >                result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
2385                else
2386 <                result := result and (val = fld);
2387 <            end else
2388 <                result := result and (val = fld);
2386 >                result := result and (fieldValueAsString = lookupValueAsString);
2387 >            end
2388 >            else
2389 >              result := result and (lookupValues[i] =
2390 >                             VarAsType(fieldValue, VarType(lookupValues[i])));
2391 >          except on EVariantError do
2392 >            result := False;
2393 >          end;
2394          end;
2395          Inc(i);
2396        end;
2397        if not result then
2398 <        Next;
2398 >          Next;
2399      end;
2400      if not result then
2401        Bookmark := CurBookmark
2402      else
2403        CursorPosChanged;
2404    finally
2405 <    fl.Free;
2405 >    keyFieldList.Free;
2406 >    SetLength(lookupValues,0)
2407    end;
2408   end;
2409  
2410   procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2411   var
2412 <  i, j, k: Integer;
2412 >  i, j, k, arr: Integer;
2413    pbd: PBlobDataArray;
2414 +  pda: PArrayDataArray;
2415   begin
2416    pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2417 <  j := 0;
2417 >  pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2418 >  j := 0; arr := 0;
2419    for i := 0 to FieldCount - 1 do
2420      if Fields[i].IsBlob then
2421      begin
# Line 1682 | Line 2424 | begin
2424        begin
2425          pbd^[j].Finalize;
2426          PISC_QUAD(
2427 <          PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
2427 >          PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2428            pbd^[j].BlobID;
2429          PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2430 +      end
2431 +      else
2432 +      begin
2433 +        PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2434 +        with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2435 +        begin
2436 +          gds_quad_high := 0;
2437 +          gds_quad_low := 0;
2438 +        end;
2439        end;
2440        Inc(j);
2441 +    end
2442 +    else
2443 +    if Fields[i] is TIBArrayField then
2444 +    begin
2445 +      if pda^[arr] <> nil then
2446 +      begin
2447 +        k := FMappedFieldPosition[Fields[i].FieldNo -1];
2448 +        PISC_QUAD(
2449 +          PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=  pda^[arr].ArrayIntf.GetArrayID;
2450 +        PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2451 +      end;
2452 +      Inc(arr);
2453      end;
2454    if Assigned(FUpdateObject) then
2455    begin
2456      if (Qry = FQDelete) then
2457 <      FUpdateObject.Apply(ukDelete)
2457 >      FUpdateObject.Apply(ukDelete,Buff)
2458      else if (Qry = FQInsert) then
2459 <      FUpdateObject.Apply(ukInsert)
2459 >      FUpdateObject.Apply(ukInsert,Buff)
2460      else
2461 <      FUpdateObject.Apply(ukModify);
2461 >      FUpdateObject.Apply(ukModify,Buff);
2462    end
2463    else begin
2464 <    SetInternalSQLParams(Qry, Buff);
2464 >    SetInternalSQLParams(Qry.Params, Buff);
2465      Qry.ExecQuery;
2466    end;
2467 +  if Qry.FieldCount > 0 then {Has RETURNING Clause}
2468 +    UpdateRecordFromQuery(Qry.Current,Buff);
2469    PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
2470    PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2471    SetModified(False);
# Line 1712 | Line 2477 | end;
2477   procedure TIBCustomDataSet.InternalRefreshRow;
2478   var
2479    Buff: PChar;
1715  SetCursor: Boolean;
2480    ofs: DWORD;
2481    Qry: TIBSQL;
2482   begin
2483 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1720 <  if SetCursor then
1721 <    Screen.Cursor := crHourGlass;
2483 >  FBase.SetCursor;
2484    try
2485      Buff := GetActiveBuf;
2486      if CanRefresh then
# Line 1735 | Line 2497 | begin
2497          end
2498          else
2499            Qry := FQRefresh;
2500 <        SetInternalSQLParams(Qry, Buff);
2500 >        SetInternalSQLParams(Qry.Params, Buff);
2501          Qry.ExecQuery;
2502          try
2503 <          if (Qry.SQLType = SQLExecProcedure) or
1742 <             (Qry.Next <> nil) then
2503 >          if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2504            begin
2505              ofs := PRecordData(Buff)^.rdSavedOffset;
2506              FetchCurrentRecordToBuffer(Qry,
# Line 1762 | Line 2523 | begin
2523      else
2524        IBError(ibxeCannotRefresh, [nil]);
2525    finally
2526 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1766 <      Screen.Cursor := crDefault;
2526 >    FBase.RestoreCursor;
2527    end;
2528   end;
2529  
# Line 1833 | Line 2593 | begin
2593   end;
2594  
2595   procedure TIBCustomDataSet.InternalPrepare;
1836 var
1837  SetCursor: Boolean;
1838  DidActivate: Boolean;
2596   begin
2597    if FInternalPrepared then
2598      Exit;
2599 <  DidActivate := False;
1843 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1844 <  if SetCursor then
1845 <    Screen.Cursor := crHourGlass;
2599 >  FBase.SetCursor;
2600    try
2601      ActivateConnection;
2602 <    DidActivate := ActivateTransaction;
2602 >    ActivateTransaction;
2603      FBase.CheckDatabase;
2604      FBase.CheckTransaction;
2605 +    if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2606 +    begin
2607 +      FQSelect.OnSQLChanged := nil; {Do not react to change}
2608 +      try
2609 +        FQSelect.SQL.Text := FParser.SQLText;
2610 +      finally
2611 +        FQSelect.OnSQLChanged := SQLChanged;
2612 +      end;
2613 +    end;
2614 + //   writeln( FQSelect.SQL.Text);
2615      if FQSelect.SQL.Text <> '' then
2616      begin
2617        if not FQSelect.Prepared then
2618        begin
2619 +        FQSelect.GenerateParamNames := FGenerateParamNames;
2620          FQSelect.ParamCheck := ParamCheck;
2621          FQSelect.Prepare;
2622        end;
2623 <      if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
2623 >      FQDelete.GenerateParamNames := FGenerateParamNames;
2624 >      if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2625          FQDelete.Prepare;
2626 <      if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
2626 >      FQInsert.GenerateParamNames := FGenerateParamNames;
2627 >      if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2628          FQInsert.Prepare;
2629 <      if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
2629 >      FQRefresh.GenerateParamNames := FGenerateParamNames;
2630 >      if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2631          FQRefresh.Prepare;
2632 <      if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
2632 >      FQModify.GenerateParamNames := FGenerateParamNames;
2633 >      if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2634          FQModify.Prepare;
2635        FInternalPrepared := True;
2636        InternalInitFieldDefs;
2637      end else
2638        IBError(ibxeEmptyQuery, [nil]);
2639    finally
2640 <    if DidActivate then
1872 <      DeactivateTransaction;
1873 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1874 <      Screen.Cursor := crDefault;
2640 >    FBase.RestoreCursor;
2641    end;
2642   end;
2643  
# Line 1900 | Line 2666 | var
2666    begin
2667      CopyRecordBuffer(Buffer, OldBuffer);
2668      if BlobFieldCount > 0 then
2669 <      FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2669 >      FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2670 >               BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2671                 0);
2672    end;
2673  
# Line 1942 | Line 2709 | begin
2709    if (FBase.Database <> Value) then
2710    begin
2711      CheckDatasetClosed;
2712 +    InternalUnPrepare;
2713      FBase.Database := Value;
2714      FQDelete.Database := Value;
2715      FQInsert.Database := Value;
2716      FQRefresh.Database := Value;
2717      FQSelect.Database := Value;
2718      FQModify.Database := Value;
2719 +    FDatabaseInfo.Database := Value;
2720    end;
2721   end;
2722  
# Line 1969 | Line 2738 | begin
2738    end;
2739   end;
2740  
2741 < procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
2741 > procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
2742   var
2743    i, j: Integer;
2744    cr, data: PChar;
2745 <  fn, st: string;
2745 >  fn: string;
2746 >  st: RawByteString;
2747    OldBuffer: Pointer;
2748    ts: TTimeStamp;
2749 +  Param: ISQLParam;
2750   begin
2751    if (Buffer = nil) then
2752      IBError(ibxeBufferNotSet, [nil]);
# Line 1983 | Line 2754 | begin
2754      InternalPrepare;
2755    OldBuffer := nil;
2756    try
2757 <    for i := 0 to Qry.Params.Count - 1 do
2757 >    for i := 0 to Params.GetCount - 1 do
2758      begin
2759 <      fn := Qry.Params[i].Name;
2759 >      Param := Params[i];
2760 >      fn := Param.Name;
2761        if (Pos('OLD_', fn) = 1) then {mbcs ok}
2762        begin
2763          fn := Copy(fn, 5, Length(fn));
# Line 2005 | Line 2777 | begin
2777               cr := Buffer;
2778        j := FQSelect.FieldIndex[fn] + 1;
2779        if (j > 0) then
2780 <        with PRecordData(cr)^ do
2780 >        with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2781          begin
2782 <          if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2782 >          if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2783            begin
2784 <            PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2784 >            PIBDBKey(Param.AsPointer)^ := rdDBKey;
2785              continue;
2786            end;
2787 <          if rdFields[j].fdIsNull then
2788 <            Qry.Params[i].IsNull := True
2787 >          if fdIsNull then
2788 >            Param.IsNull := True
2789            else begin
2790 <            Qry.Params[i].IsNull := False;
2791 <            data := cr + rdFields[j].fdDataOfs;
2792 <            case rdFields[j].fdDataType of
2790 >            Param.IsNull := False;
2791 >            data := cr + fdDataOfs;
2792 >            case fdDataType of
2793                SQL_TEXT, SQL_VARYING:
2794                begin
2795 <                SetString(st, data, rdFields[j].fdDataLength);
2796 <                Qry.Params[i].AsString := st;
2795 >                SetString(st, data, fdDataLength);
2796 >                SetCodePage(st,fdCodePage,false);
2797 >                Param.AsString := st;
2798                end;
2799              SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2800 <              Qry.Params[i].AsDouble := PDouble(data)^;
2800 >              Param.AsDouble := PDouble(data)^;
2801              SQL_SHORT, SQL_LONG:
2802              begin
2803 <              if rdFields[j].fdDataScale = 0 then
2804 <                Qry.Params[i].AsLong := PLong(data)^
2032 <              else if rdFields[j].fdDataScale >= (-4) then
2033 <                Qry.Params[i].AsCurrency := PCurrency(data)^
2803 >              if fdDataScale = 0 then
2804 >                Param.AsLong := PLong(data)^
2805                else
2806 <                Qry.Params[i].AsDouble := PDouble(data)^;
2806 >              if fdDataScale >= (-4) then
2807 >                Param.AsCurrency := PCurrency(data)^
2808 >              else
2809 >                Param.AsDouble := PDouble(data)^;
2810              end;
2811              SQL_INT64:
2812              begin
2813 <              if rdFields[j].fdDataScale = 0 then
2814 <                Qry.Params[i].AsInt64 := PInt64(data)^
2815 <              else if rdFields[j].fdDataScale >= (-4) then
2816 <                Qry.Params[i].AsCurrency := PCurrency(data)^
2813 >              if fdDataScale = 0 then
2814 >                Param.AsInt64 := PInt64(data)^
2815 >              else
2816 >              if fdDataScale >= (-4) then
2817 >                Param.AsCurrency := PCurrency(data)^
2818                else
2819 <                Qry.Params[i].AsDouble := PDouble(data)^;
2819 >                Param.AsDouble := PDouble(data)^;
2820              end;
2821              SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2822 <              Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2822 >              Param.AsQuad := PISC_QUAD(data)^;
2823              SQL_TYPE_DATE:
2824              begin
2825                ts.Date := PInt(data)^;
2826                ts.Time := 0;
2827 <              Qry.Params[i].AsDate :=
2053 <                TimeStampToDateTime(ts);
2827 >              Param.AsDate := TimeStampToDateTime(ts);
2828              end;
2829              SQL_TYPE_TIME:
2830              begin
2831                ts.Date := 0;
2832                ts.Time := PInt(data)^;
2833 <              Qry.Params[i].AsTime :=
2060 <                TimeStampToDateTime(ts);
2833 >              Param.AsTime := TimeStampToDateTime(ts);
2834              end;
2835              SQL_TIMESTAMP:
2836 <              Qry.Params[i].AsDateTime :=
2837 <                TimeStampToDateTime(
2838 <                  MSecsToTimeStamp(PDouble(data)^));
2836 >              Param.AsDateTime :=
2837 >                       TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2838 >            SQL_BOOLEAN:
2839 >              Param.AsBoolean := PWordBool(data)^;
2840            end;
2841          end;
2842        end;
# Line 2148 | Line 2922 | begin
2922    end;
2923   end;
2924  
2925 + procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2926 + begin
2927 +  if FIBLinks.IndexOf(Sender) = -1 then
2928 +    FIBLinks.Add(Sender);
2929 + end;
2930 +
2931  
2932   procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2933   begin
2934 <  if FOpen then
2935 <    InternalClose;
2934 >  Active := false;
2935 > {  if FOpen then
2936 >    InternalClose;}
2937    if FInternalPrepared then
2938      InternalUnPrepare;
2939 +  FieldDefs.Clear;
2940 +  FieldDefs.Updated := false;
2941 + end;
2942 +
2943 + procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2944 + begin
2945 +  FBaseSQLSelect.assign(FQSelect.SQL);
2946   end;
2947  
2948   { I can "undelete" uninserted records (make them "inserted" again).
# Line 2183 | Line 2971 | begin
2971    end;
2972   end;
2973  
2974 + procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2975 + begin
2976 +  FIBLinks.Remove(Sender);
2977 + end;
2978 +
2979   function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2980   begin
2981    if Active then
# Line 2199 | Line 2992 | begin
2992    Result := Assigned( FQSelect ) and FQSelect.EOF;
2993   end;
2994  
2995 + function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
2996 + begin
2997 +  ActivateConnection;
2998 +  ActivateTransaction;
2999 +  if not FInternalPrepared then
3000 +    InternalPrepare;
3001 +  Result := Params.ByName(ParamName);
3002 + end;
3003 +
3004 + {Beware: the parameter FCache is used as an identifier to determine which
3005 + cache is being operated on and is not referenced in the computation.
3006 + The result is an adjusted offset into the identified cache, either the
3007 + Buffer Cache or the old Buffer Cache.}
3008 +
3009   function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
3010 <                                        Origin: Integer): Integer;
3010 >                                        Origin: Integer): DWORD;
3011   var
3012    OldCacheSize: Integer;
3013   begin
# Line 2237 | Line 3044 | procedure TIBCustomDataSet.ReadCache(FCa
3044                                      Buffer: PChar);
3045   var
3046    pCache: PChar;
3047 +  AdjustedOffset: DWORD;
3048    bOld: Boolean;
3049   begin
3050    bOld := (FCache = FOldBufferCache);
3051 <  pCache := PChar(AdjustPosition(FCache, Offset, Origin));
3051 >  AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
3052    if not bOld then
3053 <    pCache := FBufferCache + Integer(pCache)
3053 >    pCache := FBufferCache + AdjustedOffset
3054    else
3055 <    pCache := FOldBufferCache + Integer(pCache);
3055 >    pCache := FOldBufferCache + AdjustedOffset;
3056    Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
3057    AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
3058   end;
# Line 2274 | Line 3082 | procedure TIBCustomDataSet.WriteCache(FC
3082                                       Buffer: PChar);
3083   var
3084    pCache: PChar;
3085 +  AdjustedOffset: DWORD;
3086    bOld: Boolean;
3087    dwEnd: DWORD;
3088   begin
3089    bOld := (FCache = FOldBufferCache);
3090 <  pCache := PChar(AdjustPosition(FCache, Offset, Origin));
3090 >  AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
3091    if not bOld then
3092 <    pCache := FBufferCache + Integer(pCache)
3092 >    pCache := FBufferCache + AdjustedOffset
3093    else
3094 <    pCache := FOldBufferCache + Integer(pCache);
3094 >    pCache := FOldBufferCache + AdjustedOffset;
3095    Move(Buffer^, pCache^, FRecordBufferSize);
3096    dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
3097    if not bOld then
# Line 2320 | Line 3129 | var
3129    Buff: PChar;
3130    bTr, bDB: Boolean;
3131   begin
3132 +  if (Field = nil) or (Field.DataSet <> self) then
3133 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3134    Buff := GetActiveBuf;
3135    if Buff = nil then
3136    begin
3137      fs := TIBBlobStream.Create;
3138      fs.Mode := bmReadWrite;
3139 +    fs.Database := Database;
3140 +    fs.Transaction := Transaction;
3141 +    fs.SetField(Field);
3142      FBlobStreamList.Add(Pointer(fs));
3143      result := TIBDSBlobStream.Create(Field, fs, Mode);
3144      exit;
# Line 2339 | Line 3153 | begin
3153      fs.Mode := bmReadWrite;
3154      fs.Database := Database;
3155      fs.Transaction := Transaction;
3156 +    fs.SetField(Field);
3157      fs.BlobID :=
3158 <      PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3158 >      PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3159      if (CachedUpdates) then
3160      begin
3161        bTr := not Transaction.InTransaction;
# Line 2361 | Line 3176 | begin
3176    result := TIBDSBlobStream.Create(Field, fs, Mode);
3177   end;
3178  
3179 + function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3180 + var Buff: PChar;
3181 +    pda: PArrayDataArray;
3182 +    bTr, bDB: Boolean;
3183 + begin
3184 +  if (Field = nil) or (Field.DataSet <> self) then
3185 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3186 +  Buff := GetActiveBuf;
3187 +  if Buff = nil then
3188 +    Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3189 +                              Field.FRelationName,Field.FieldName)
3190 +  else
3191 +  begin
3192 +    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3193 +    if pda^[Field.FCacheOffset] = nil then
3194 +    begin
3195 +      AdjustRecordOnInsert(Buff);
3196 +      if Field.IsNull then
3197 +        Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3198 +                                Field.FRelationName,Field.FieldName)
3199 +      else
3200 +        Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3201 +                            Field.FRelationName,Field.FieldName,Field.ArrayID);
3202 +      pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3203 +      FArrayList.Add(pda^[Field.FCacheOffset]);
3204 +      if (CachedUpdates) then
3205 +      begin
3206 +        bTr := not Transaction.InTransaction;
3207 +        bDB := not Database.Connected;
3208 +        if bDB then
3209 +          Database.Open;
3210 +        if bTr then
3211 +          Transaction.StartTransaction;
3212 +         pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3213 +        if bTr then
3214 +          Transaction.Commit;
3215 +        if bDB then
3216 +          Database.Close;
3217 +      end;
3218 +      WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3219 +    end
3220 +    else
3221 +      Result := pda^[Field.FCacheOffset].ArrayIntf;
3222 +  end;
3223 + end;
3224 +
3225 + procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3226 + var Buff: PChar;
3227 +    pda: PArrayDataArray;
3228 + begin
3229 +  if (Field = nil) or (Field.DataSet <> self) then
3230 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3231 +  Buff := GetActiveBuf;
3232 +  if Buff <> nil then
3233 +  begin
3234 +    AdjustRecordOnInsert(Buff);
3235 +    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3236 +    pda^[Field.FCacheOffset].FArray := AnArray;
3237 +    WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3238 +  end;
3239 + end;
3240 +
3241   function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3242   const
3243    CMPLess = -1;
# Line 2396 | Line 3273 | begin
3273    inherited DoBeforeDelete;
3274   end;
3275  
3276 + procedure TIBCustomDataSet.DoAfterDelete;
3277 + begin
3278 +  inherited DoAfterDelete;
3279 +  FBase.DoAfterDelete(self);
3280 +  InternalAutoCommit;
3281 + end;
3282 +
3283   procedure TIBCustomDataSet.DoBeforeEdit;
3284   var
3285    Buff: PRecordData;
# Line 2410 | Line 3294 | begin
3294    inherited DoBeforeEdit;
3295   end;
3296  
3297 + procedure TIBCustomDataSet.DoAfterEdit;
3298 + begin
3299 +  inherited DoAfterEdit;
3300 +  FBase.DoAfterEdit(self);
3301 + end;
3302 +
3303   procedure TIBCustomDataSet.DoBeforeInsert;
3304   begin
3305    if not CanInsert then
# Line 2419 | Line 3309 | end;
3309  
3310   procedure TIBCustomDataSet.DoAfterInsert;
3311   begin
3312 <  if Generator.ApplyOnEvent = gaeOnNewRecord then
3313 <    Generator.Apply;
3312 >  if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
3313 >    GeneratorField.Apply;
3314    inherited DoAfterInsert;
3315 +  FBase.DoAfterInsert(self);
3316 + end;
3317 +
3318 + procedure TIBCustomDataSet.DoBeforeClose;
3319 + begin
3320 +  inherited DoBeforeClose;
3321 +  if FInTransactionEnd and (FCloseAction = TARollback) then
3322 +     Exit;
3323 +  if State in [dsInsert,dsEdit] then
3324 +  begin
3325 +    if DataSetCloseAction = dcSaveChanges then
3326 +      Post;
3327 +      {Note this can fail with an exception e.g. due to
3328 +       database validation error. In which case the dataset remains open }
3329 +  end;
3330 +  if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3331 +    ApplyUpdates;
3332 + end;
3333 +
3334 + procedure TIBCustomDataSet.DoBeforeOpen;
3335 + var i: integer;
3336 + begin
3337 +  if assigned(FParser) then
3338 +     FParser.Reset;
3339 +  for i := 0 to FIBLinks.Count - 1 do
3340 +    TIBControlLink(FIBLinks[i]).UpdateSQL(self);
3341 +  inherited DoBeforeOpen;
3342 +  for i := 0 to FIBLinks.Count - 1 do
3343 +    TIBControlLink(FIBLinks[i]).UpdateParams(self);
3344   end;
3345  
3346   procedure TIBCustomDataSet.DoBeforePost;
3347   begin
3348    inherited DoBeforePost;
3349    if (State = dsInsert) and
3350 <     (Generator.ApplyOnEvent = gaeOnPostRecord) then
3351 <     Generator.Apply
3350 >     (GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
3351 >     GeneratorField.Apply
3352 > end;
3353 >
3354 > procedure TIBCustomDataSet.DoAfterPost;
3355 > begin
3356 >  inherited DoAfterPost;
3357 >  FBase.DoAfterPost(self);
3358 >  InternalAutoCommit;
3359   end;
3360  
3361   procedure TIBCustomDataSet.FetchAll;
3362   var
3363 <  SetCursor: Boolean;
2438 <  CurBookmark: string;
3363 >  CurBookmark: TBookmark;
3364   begin
3365 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3366 <  if SetCursor then
2442 <    Screen.Cursor := crHourGlass;
2443 <  try
3365 >  FBase.SetCursor;
3366 > try
3367      if FQSelect.EOF or not FQSelect.Open then
3368        exit;
3369      DisableControls;
# Line 2452 | Line 3375 | begin
3375        EnableControls;
3376      end;
3377    finally
3378 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2456 <      Screen.Cursor := crDefault;
3378 >    FBase.RestoreCursor;
3379    end;
3380   end;
3381  
# Line 2501 | Line 3423 | begin
3423      result := FDataLink.DataSource;
3424   end;
3425  
3426 + function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3427 + begin
3428 +  Result := FAliasNameMap[FieldNo-1]
3429 + end;
3430 +
3431 + function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3432 + var
3433 +   i: integer;
3434 + begin
3435 +   Result := nil;
3436 +   for i := 0 to Length(FAliasNameMap) - 1 do
3437 +       if FAliasNameMap[i] = aliasName then
3438 +       begin
3439 +         Result := FieldDefs[i];
3440 +         Exit
3441 +       end;
3442 + end;
3443 +
3444   function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3445   begin
3446    Result := DefaultFieldClasses[FieldType];
# Line 2519 | Line 3459 | begin
3459    result := False;
3460    Buff := GetActiveBuf;
3461    if (Buff = nil) or
3462 <     (not IsVisible(Buff)) then
3462 >     (not IsVisible(Buff)) or not assigned(Field.DataSet) then
3463      exit;
3464    { The intention here is to stuff the buffer with the data for the
3465     referenced field for the current record }
# Line 2531 | Line 3471 | begin
3471      if result and (Buffer <> nil) then
3472        Move(Buff[1], Buffer^, Field.DataSize);
3473    end
3474 <  else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3474 >  else
3475 >  if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3476       (FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3477 +  with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3478 +                         FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3479    begin
3480 <    result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
3480 >    result := not fdIsNull;
3481      if result and (Buffer <> nil) then
2539      with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
3482        begin
3483 <        Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3483 >        Data := Buff + fdDataOfs;
3484          if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3485          begin
3486 <          Move(Data^, Buffer^, fdDataLength);
3487 <          PChar(Buffer)[fdDataLength] := #0;
3486 >          if fdDataLength < Field.DataSize then
3487 >          begin
3488 >            Move(Data^, Buffer^, fdDataLength);
3489 >            PChar(Buffer)[fdDataLength] := #0;
3490 >          end
3491 >          else
3492 >            IBError(ibxeFieldSizeError,[Field.FieldName])
3493          end
3494          else
3495            Move(Data^, Buffer^, Field.DataSize);
# Line 2585 | Line 3532 | begin
3532          if not Accept and (GetMode = gmCurrent) then
3533            GetMode := gmPrior;
3534        except
3535 < //        Application.HandleException(Self);
3535 > //        FBase.HandleException(Self);
3536        end;
3537      end;
3538      RestoreState(SaveState);
# Line 2604 | Line 3551 | begin
3551          if FCurrentRecord < FRecordCount then
3552            ReadRecordCache(FCurrentRecord, Buffer, False)
3553          else begin
3554 <          while (not FQSelect.EOF) and
2608 <                (FQSelect.Next <> nil) and
3554 >          while (not FQSelect.EOF) and FQSelect.Next  and
3555                  (FCurrentRecord >= FRecordCount) do begin
3556              FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3557              Inc(FRecordCount);
# Line 2679 | Line 3625 | begin
3625    result := FRecordBufferSize;
3626   end;
3627  
3628 + procedure TIBCustomDataSet.InternalAutoCommit;
3629 + begin
3630 +  with Transaction do
3631 +    if InTransaction and (FAutoCommit = acCommitRetaining) then
3632 +    begin
3633 +      if CachedUpdates then ApplyUpdates;
3634 +      CommitRetaining;
3635 +    end;
3636 + end;
3637 +
3638   procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3639   begin
3640    CheckEditState;
# Line 2706 | Line 3662 | procedure TIBCustomDataSet.InternalCance
3662   var
3663    Buff: PChar;
3664    CurRec: Integer;
3665 +  pda: PArrayDataArray;
3666 +  i: integer;
3667   begin
3668    inherited InternalCancel;
3669    Buff := GetActiveBuf;
3670 <  if Buff <> nil then begin
3670 >  if Buff <> nil then
3671 >  begin
3672 >    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3673 >    for i := 0 to ArrayFieldCount - 1 do
3674 >      pda^[i].ArrayIntf.CancelChanges;
3675      CurRec := FCurrentRecord;
3676      AdjustRecordOnInsert(Buff);
3677      if (State = dsEdit) then begin
# Line 2732 | Line 3694 | begin
3694      DeactivateTransaction;
3695    FQSelect.Close;
3696    ClearBlobCache;
3697 +  ClearArrayCache;
3698    FreeRecordBuffer(FModelBuffer);
3699    FreeRecordBuffer(FOldBuffer);
3700    FCurrentRecord := -1;
# Line 2747 | Line 3710 | begin
3710    FOBEnd := 0;
3711    FreeMem(FBufferCache);
3712    FBufferCache := nil;
3713 +  FreeMem(FFieldColumns);
3714 +  FFieldColumns := nil;
3715    FreeMem(FOldBufferCache);
3716    FOldBufferCache := nil;
3717    BindFields(False);
3718 +  ResetParser;
3719    if DefaultFields then DestroyFields;
3720   end;
3721  
3722   procedure TIBCustomDataSet.InternalDelete;
3723   var
3724    Buff: PChar;
2759  SetCursor: Boolean;
3725   begin
3726 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2762 <  if SetCursor then
2763 <    Screen.Cursor := crHourGlass;
3726 >  FBase.SetCursor;
3727    try
3728      Buff := GetActiveBuf;
3729      if CanDelete then
# Line 2785 | Line 3748 | begin
3748      end else
3749        IBError(ibxeCannotDelete, [nil]);
3750    finally
3751 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2789 <      Screen.Cursor := crDefault;
3751 >    FBase.RestoreCursor;
3752    end;
3753   end;
3754  
# Line 2802 | Line 3764 | end;
3764  
3765   procedure TIBCustomDataSet.InternalHandleException;
3766   begin
3767 <  Application.HandleException(Self)
3767 >  FBase.HandleException(Self)
3768   end;
3769  
3770   procedure TIBCustomDataSet.InternalInitFieldDefs;
3771 + begin
3772 +  if not InternalPrepared then
3773 +  begin
3774 +    InternalPrepare;
3775 +    exit;
3776 +  end;
3777 +   FieldDefsFromQuery(FQSelect);
3778 + end;
3779 +
3780 + procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3781   const
3782    DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3783                 'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
# Line 2814 | Line 3786 | const
3786                 'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3787                 'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3788                 '     (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3789 +
3790 +  DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3791 +               'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3792 +               'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3793 +               'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
3794 +               'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3795 +               'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3796 +               '     (not F.RDB$DEFAULT_VALUE is NULL) or ' + {do not localize}
3797 +               '     ( not R.RDB$IDENTITY_TYPE is NULL))' ; {do not localize}
3798 +
3799   var
3800    FieldType: TFieldType;
3801    FieldSize: Word;
3802 +  FieldDataSize: integer;
3803 +  charSetID: short;
3804 +  CharSetSize: integer;
3805 +  CharSetName: RawByteString;
3806 +  FieldCodePage: TSystemCodePage;
3807    FieldNullable : Boolean;
3808    i, FieldPosition, FieldPrecision: Integer;
3809 <  FieldAliasName: string;
3810 <  RelationName, FieldName: string;
3809 >  FieldAliasName, DBAliasName: string;
3810 >  aRelationName, FieldName: string;
3811    Query : TIBSQL;
3812    FieldIndex: Integer;
3813    FRelationNodes : TRelationNode;
3814 +  aArrayDimensions: integer;
3815 +  aArrayBounds: TArrayBounds;
3816 +  ArrayMetaData: IArrayMetaData;
3817  
3818    function Add_Node(Relation, Field : String) : TRelationNode;
3819    var
# Line 2846 | Line 3836 | var
3836        FField.FieldName := Query.Fields[2].AsString;
3837        FField.DEFAULT_VALUE := not Query.Fields[1].IsNull;
3838        FField.COMPUTED_BLR := not Query.Fields[0].IsNull;
3839 +      FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull;
3840        FField.NextField := Result.FieldNodes;
3841        Result.FieldNodes := FField;
3842        Query.Next;
# Line 2899 | Line 3890 | var
3890          FField := Ffield.NextField;
3891    end;
3892  
3893 +  function Is_IDENTITY_COLUMN(Relation, Field : String) : Boolean;
3894 +  var
3895 +    FRelation : TRelationNode;
3896 +    FField : TFieldNode;
3897 +  begin
3898 +    FRelation := FRelationNodes;
3899 +    while Assigned(FRelation) and
3900 +         (FRelation.RelationName <> Relation) do
3901 +      FRelation := FRelation.NextRelation;
3902 +    if not Assigned(FRelation) then
3903 +      FRelation := Add_Node(Relation, Field);
3904 +    Result := false;
3905 +    FField := FRelation.FieldNodes;
3906 +    while Assigned(FField) do
3907 +      if FField.FieldName = Field then
3908 +      begin
3909 +        Result := Ffield.IDENTITY_COLUMN;
3910 +        Exit;
3911 +      end
3912 +      else
3913 +        FField := Ffield.NextField;
3914 +  end;
3915 +
3916    Procedure FreeNodes;
3917    var
3918      FRelation : TRelationNode;
# Line 2919 | Line 3933 | var
3933    end;
3934  
3935   begin
2922  if not InternalPrepared then
2923  begin
2924    InternalPrepare;
2925    exit;
2926  end;
3936    FRelationNodes := TRelationNode.Create;
3937    FNeedsRefresh := False;
3938 <  Database.InternalTransaction.StartTransaction;
3938 >  if not Database.InternalTransaction.InTransaction then
3939 >    Database.InternalTransaction.StartTransaction;
3940    Query := TIBSQL.Create(self);
3941    try
3942      Query.Database := DataBase;
# Line 2934 | Line 3944 | begin
3944      FieldDefs.BeginUpdate;
3945      FieldDefs.Clear;
3946      FieldIndex := 0;
3947 <    if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3948 <      SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3949 <    Query.SQL.Text := DefaultSQL;
3947 >    if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3948 >      SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3949 >    if FDatabaseInfo.ODSMajorVersion >= 12 then
3950 >      Query.SQL.Text := DefaultSQLODS12
3951 >    else
3952 >      Query.SQL.Text := DefaultSQL;
3953      Query.Prepare;
3954 <    for i := 0 to FQSelect.Current.Count - 1 do
3955 <      with FQSelect.Current[i].Data^ do
3954 >    SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3955 >    SetLength(FAliasNameList, SourceQuery.MetaData.Count);
3956 >    for i := 0 to SourceQuery.MetaData.GetCount - 1 do
3957 >      with SourceQuery.MetaData[i] do
3958        begin
3959          { Get the field name }
3960 <        SetString(FieldAliasName, aliasname, aliasname_length);
3961 <        SetString(RelationName, relname, relname_length);
3962 <        SetString(FieldName, sqlname, sqlname_length);
3960 >        FieldAliasName := GetName;
3961 >        DBAliasName := GetAliasname;
3962 >        aRelationName := getRelationName;
3963 >        FieldName := getSQLName;
3964 >        FAliasNameList[i] := DBAliasName;
3965          FieldSize := 0;
3966 +        FieldDataSize := GetSize;
3967          FieldPrecision := 0;
3968 <        FieldNullable := FQSelect.Current[i].IsNullable;
3969 <        case sqltype and not 1 of
3968 >        FieldNullable := IsNullable;
3969 >        CharSetSize := 0;
3970 >        CharSetName := '';
3971 >        FieldCodePage := CP_NONE;
3972 >        aArrayDimensions := 0;
3973 >        SetLength(aArrayBounds,0);
3974 >        case SQLType of
3975            { All VARCHAR's must be converted to strings before recording
3976             their values }
3977            SQL_VARYING, SQL_TEXT:
3978            begin
3979 <            FieldSize := sqllen;
3979 >            if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3980 >              CharSetSize := 1;
3981 >            CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3982 >            Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3983 >            FieldSize := FieldDataSize div CharSetSize;
3984              FieldType := ftString;
3985            end;
3986            { All Doubles/Floats should be cast to doubles }
# Line 2961 | Line 3988 | begin
3988              FieldType := ftFloat;
3989            SQL_SHORT:
3990            begin
3991 <            if (sqlscale = 0) then
3991 >            if (getScale = 0) then
3992                FieldType := ftSmallInt
3993              else begin
3994                FieldType := ftBCD;
3995                FieldPrecision := 4;
3996 <              FieldSize := -sqlscale;
3996 >              FieldSize := -getScale;
3997              end;
3998            end;
3999            SQL_LONG:
4000            begin
4001 <            if (sqlscale = 0) then
4001 >            if (getScale = 0) then
4002                FieldType := ftInteger
4003 <            else if (sqlscale >= (-4)) then
4003 >            else if (getScale >= (-4)) then
4004              begin
4005                FieldType := ftBCD;
4006                FieldPrecision := 9;
4007 <              FieldSize := -sqlscale;
4007 >              FieldSize := -getScale;
4008              end
4009              else
4010 <              FieldType := ftFloat;
4010 >            if Database.SQLDialect = 1 then
4011 >              FieldType := ftFloat
4012 >            else
4013 >            if (FieldCount > i) and (Fields[i] is TFloatField) then
4014 >              FieldType := ftFloat
4015 >            else
4016 >            begin
4017 >              FieldType := ftFMTBCD;
4018 >              FieldPrecision := 9;
4019 >              FieldSize := -getScale;
4020              end;
4021 +          end;
4022 +
4023            SQL_INT64:
4024            begin
4025 <            if (sqlscale = 0) then
4025 >            if (getScale = 0) then
4026                FieldType := ftLargeInt
4027 <            else if (sqlscale >= (-4)) then
4027 >            else if (getScale >= (-4)) then
4028              begin
4029                FieldType := ftBCD;
4030                FieldPrecision := 18;
4031 <              FieldSize := -sqlscale;
4031 >              FieldSize := -getScale;
4032              end
4033              else
4034                FieldType := ftFloat;
4035 <            end;
4035 >          end;
4036            SQL_TIMESTAMP: FieldType := ftDateTime;
4037            SQL_TYPE_TIME: FieldType := ftTime;
4038            SQL_TYPE_DATE: FieldType := ftDate;
4039            SQL_BLOB:
4040            begin
4041              FieldSize := sizeof (TISC_QUAD);
4042 <            if (sqlsubtype = 1) then
4043 <              FieldType := ftmemo
4042 >            if (getSubtype = 1) then
4043 >            begin
4044 >              if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4045 >                CharSetSize := 1;
4046 >              CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4047 >              Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4048 >              FieldType := ftMemo;
4049 >            end
4050              else
4051                FieldType := ftBlob;
4052            end;
4053            SQL_ARRAY:
4054            begin
4055              FieldSize := sizeof (TISC_QUAD);
4056 <            FieldType := ftUnknown;
4056 >            FieldType := ftArray;
4057 >            ArrayMetaData := GetArrayMetaData;
4058 >            if ArrayMetaData <> nil then
4059 >            begin
4060 >              aArrayDimensions := ArrayMetaData.GetDimensions;
4061 >              aArrayBounds := ArrayMetaData.GetBounds;
4062 >            end;
4063            end;
4064 +          SQL_BOOLEAN:
4065 +             FieldType:= ftBoolean;
4066            else
4067              FieldType := ftUnknown;
4068          end;
# Line 3019 | Line 4071 | begin
4071          begin
4072            FMappedFieldPosition[FieldIndex] := FieldPosition;
4073            Inc(FieldIndex);
4074 <          with FieldDefs.AddFieldDef do
4074 >          with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
4075            begin
4076 <            Name := string( FieldAliasName );
4077 < (*           FieldNo := FieldPosition;*)
3026 <            DataType := FieldType;
4076 >            Name := FieldAliasName;
4077 >            FAliasNameMap[FieldNo-1] := DBAliasName;
4078              Size := FieldSize;
4079 +            DataSize := FieldDataSize;
4080              Precision := FieldPrecision;
4081              Required := not FieldNullable;
4082 +            RelationName := aRelationName;
4083              InternalCalcField := False;
4084 +            CharacterSetSize := CharSetSize;
4085 +            CharacterSetName := CharSetName;
4086 +            CodePage := FieldCodePage;
4087 +            ArrayDimensions := aArrayDimensions;
4088 +            ArrayBounds := aArrayBounds;
4089              if (FieldName <> '') and (RelationName <> '') then
4090              begin
4091 +              IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName);
4092                if Has_COMPUTED_BLR(RelationName, FieldName) then
4093                begin
4094                  Attributes := [faReadOnly];
# Line 3055 | Line 4114 | begin
4114      FreeNodes;
4115      Database.InternalTransaction.Commit;
4116      FieldDefs.EndUpdate;
4117 +    FieldDefs.Updated := true;
4118    end;
4119   end;
4120  
# Line 3072 | Line 4132 | begin
4132    else begin
4133      Buffer := AllocRecordBuffer;
4134      try
4135 <      while FQSelect.Next <> nil do
4135 >      while FQSelect.Next do
4136        begin
4137          FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
4138          Inc(FRecordCount);
# Line 3087 | Line 4147 | end;
4147   procedure TIBCustomDataSet.InternalSetParamsFromCursor;
4148   var
4149    i: Integer;
4150 <  cur_param: TIBXSQLVAR;
4150 >  cur_param: ISQLParam;
4151    cur_field: TField;
4152    s: TStream;
4153   begin
# Line 3095 | Line 4155 | begin
4155      IBError(ibxeEmptyQuery, [nil]);
4156    if not FInternalPrepared then
4157      InternalPrepare;
4158 <  if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4158 >  if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4159    begin
4160 <    for i := 0 to SQLParams.Count - 1 do
4160 >    for i := 0 to SQLParams.GetCount - 1 do
4161      begin
4162        cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4163        cur_param := SQLParams[i];
# Line 3107 | Line 4167 | begin
4167          else case cur_field.DataType of
4168            ftString:
4169              cur_param.AsString := cur_field.AsString;
4170 <          ftBoolean, ftSmallint, ftWord:
4170 >          ftBoolean:
4171 >            cur_param.AsBoolean := cur_field.AsBoolean;
4172 >          ftSmallint, ftWord:
4173              cur_param.AsShort := cur_field.AsInteger;
4174            ftInteger:
4175              cur_param.AsLong := cur_field.AsInteger;
# Line 3129 | Line 4191 | begin
4191              try
4192                s := DataSource.DataSet.
4193                       CreateBlobStream(cur_field, bmRead);
4194 <              cur_param.LoadFromStream(s);
4194 >              cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4195              finally
4196                s.free;
4197              end;
4198            end;
4199 +          ftArray:
4200 +            cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4201            else
4202              IBError(ibxeNotSupported, [nil]);
4203          end;
# Line 3160 | Line 4224 | begin
4224   end;
4225  
4226   procedure TIBCustomDataSet.InternalOpen;
3163 var
3164  SetCursor: Boolean;
4227  
4228    function RecordDataLength(n: Integer): Long;
4229    begin
# Line 3169 | Line 4231 | var
4231    end;
4232  
4233   begin
4234 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3173 <  if SetCursor then
3174 <    Screen.Cursor := crHourGlass;
4234 >  FBase.SetCursor;
4235    try
4236      ActivateConnection;
4237      ActivateTransaction;
# Line 3179 | Line 4239 | begin
4239        IBError(ibxeEmptyQuery, [nil]);
4240      if not FInternalPrepared then
4241        InternalPrepare;
4242 <   if FQSelect.SQLType = SQLSelect then
4242 >   if FQSelect.SQLStatementType = SQLSelect then
4243     begin
4244        if DefaultFields then
4245          CreateFields;
4246 +      FArrayFieldCount := 0;
4247        BindFields(True);
4248        FCurrentRecord := -1;
4249        FQSelect.ExecQuery;
# Line 3194 | Line 4255 | begin
4255          3. After the dummy fetch, FRecordSize will be appropriately
4256             adjusted to reflect the additional "weight" of the field
4257             data.
4258 <        4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4258 >        4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4259          5. Now, with the BufferSize available, allocate memory for chunks of records
4260          6. Re-allocate the model buffer, accounting for the new
4261             FRecordBufferSize.
4262          7. Finally, calls to AllocRecordBuffer will work!.
4263         }
4264        {Step 1}
4265 <      FRecordSize := RecordDataLength(FQSelect.Current.Count);
4265 >      FRecordSize := RecordDataLength(FQSelect.FieldCount);
4266        {Step 2, 3}
4267 +      GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4268        IBAlloc(FModelBuffer, 0, FRecordSize);
4269 <      FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4269 >      InitModelBuffer(FQSelect, FModelBuffer);
4270        {Step 4}
4271        FCalcFieldsOffset := FRecordSize;
4272        FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4273 <      FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4273 >      FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4274 >      FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4275        {Step 5}
4276        if UniDirectional then
4277          FBufferChunkSize := FRecordBufferSize * UniCache
# Line 3224 | Line 4287 | begin
4287        FCacheSize := FBufferChunkSize;
4288        FOldCacheSize := FBufferChunkSize;
4289        {Step 6}
4290 <      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4290 >      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4291                               FRecordBufferSize);
4292        {Step 7}
4293        FOldBuffer := AllocRecordBuffer;
# Line 3232 | Line 4295 | begin
4295      else
4296        FQSelect.ExecQuery;
4297    finally
4298 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3236 <      Screen.Cursor := crDefault;
4298 >    FBase.RestoreCursor;
4299    end;
4300   end;
4301  
# Line 3241 | Line 4303 | procedure TIBCustomDataSet.InternalPost;
4303   var
4304    Qry: TIBSQL;
4305    Buff: PChar;
3244  SetCursor: Boolean;
4306    bInserting: Boolean;
4307   begin
4308 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3248 <  if SetCursor then
3249 <    Screen.Cursor := crHourGlass;
4308 >  FBase.SetCursor;
4309    try
4310      Buff := GetActiveBuf;
4311      CheckEditState;
# Line 3284 | Line 4343 | begin
4343      if bInserting then
4344        Inc(FRecordCount);
4345    finally
4346 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3288 <      Screen.Cursor := crDefault;
4346 >    FBase.RestoreCursor;
4347    end;
4348   end;
4349  
# Line 3305 | Line 4363 | begin
4363    result := FOpen;
4364   end;
4365  
4366 + procedure TIBCustomDataSet.Loaded;
4367 + begin
4368 +  if assigned(FQSelect) then
4369 +    FBaseSQLSelect.assign(FQSelect.SQL);
4370 +  inherited Loaded;
4371 + end;
4372 +
4373 + procedure TIBCustomDataSet.Post;
4374 + var CancelPost: boolean;
4375 + begin
4376 +  CancelPost := false;
4377 +  if assigned(FOnValidatePost) then
4378 +    OnValidatePost(self,CancelPost);
4379 +  if CancelPost then
4380 +    Cancel
4381 +  else
4382 +   inherited Post;
4383 + end;
4384 +
4385   function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4386                                   Options: TLocateOptions): Boolean;
4387   var
4388 <  CurBookmark: string;
4388 >  CurBookmark: TBookmark;
4389   begin
4390    DisableControls;
4391    try
# Line 3326 | Line 4403 | function TIBCustomDataSet.Lookup(const K
4403                                   const ResultFields: string): Variant;
4404   var
4405    fl: TList;
4406 <  CurBookmark: string;
4406 >  CurBookmark: TBookmark;
4407   begin
4408    DisableControls;
4409    fl := TList.Create;
# Line 3379 | Line 4456 | end;
4456   procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4457   var
4458    Buff, TmpBuff: PChar;
4459 +  MappedFieldPos: integer;
4460   begin
4461    Buff := GetActiveBuf;
4462    if Field.FieldNo < 0 then
# Line 3395 | Line 4473 | begin
4473      begin
4474        { If inserting, Adjust record position }
4475        AdjustRecordOnInsert(Buff);
4476 <      if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4477 <         (FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4476 >      MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4477 >      if (MappedFieldPos > 0) and
4478 >         (MappedFieldPos <= rdFieldCount) then
4479 >      with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4480        begin
4481          Field.Validate(Buffer);
4482          if (Buffer = nil) or
4483             (Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4484 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4485 <        else begin
4486 <          Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4487 <                 rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4488 <          if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4489 <             (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4490 <            rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
3411 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4484 >          fdIsNull := True
4485 >        else
4486 >        begin
4487 >          Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4488 >          if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4489 >            fdDataLength := StrLen(PChar(Buffer));
4490 >          fdIsNull := False;
4491            if rdUpdateStatus = usUnmodified then
4492            begin
4493              if CachedUpdates then
# Line 3432 | Line 4511 | begin
4511      end;
4512    end;
4513    if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
4514 <      DataEvent(deFieldChange, Longint(Field));
4514 >      DataEvent(deFieldChange, PtrInt(Field));
4515   end;
4516  
4517   procedure TIBCustomDataSet.SetRecNo(Value: Integer);
# Line 3496 | Line 4575 | begin
4575   FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4576   end;
4577  
4578 + procedure TIBCustomDataSet.ClearIBLinks;
4579 + var i: integer;
4580 + begin
4581 +  for i := FIBLinks.Count - 1 downto 0 do
4582 +    TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4583 + end;
4584 +
4585  
4586   procedure TIBCustomDataSet.InternalUnPrepare;
4587   begin
4588    if FInternalPrepared then
4589    begin
4590      CheckDatasetClosed;
4591 +    if FDidActivate then
4592 +      DeactivateTransaction;
4593      FieldDefs.Clear;
4594 +    FieldDefs.Updated := false;
4595      FInternalPrepared := False;
4596 +    Setlength(FAliasNameList,0);
4597    end;
4598   end;
4599  
4600   procedure TIBCustomDataSet.InternalExecQuery;
4601   var
4602    DidActivate: Boolean;
3513  SetCursor: Boolean;
4603   begin
4604    DidActivate := False;
4605 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3517 <  if SetCursor then
3518 <    Screen.Cursor := crHourGlass;
4605 >  FBase.SetCursor;
4606    try
4607      ActivateConnection;
4608      DidActivate := ActivateTransaction;
# Line 3523 | Line 4610 | begin
4610        IBError(ibxeEmptyQuery, [nil]);
4611      if not FInternalPrepared then
4612        InternalPrepare;
4613 <    if FQSelect.SQLType = SQLSelect then
4613 >    if FQSelect.SQLStatementType = SQLSelect then
4614      begin
4615        IBError(ibxeIsASelectStatement, [nil]);
4616      end
# Line 3532 | Line 4619 | begin
4619    finally
4620      if DidActivate then
4621        DeactivateTransaction;
4622 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3536 <      Screen.Cursor := crDefault;
4622 >    FBase.RestoreCursor;
4623    end;
4624   end;
4625  
4626 < function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4626 > function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4627 > begin
4628 >  Result := FQSelect.Statement;
4629 > end;
4630 >
4631 > function TIBCustomDataSet.GetParser: TSelectSQLParser;
4632   begin
4633 <  Result := FQSelect.Handle;
4633 >  if not assigned(FParser) then
4634 >    FParser := CreateParser;
4635 >  Result := FParser
4636 > end;
4637 >
4638 > procedure TIBCustomDataSet.ResetParser;
4639 > begin
4640 >  if assigned(FParser) then
4641 >  begin
4642 >    FParser.Free;
4643 >    FParser := nil;
4644 >    FQSelect.OnSQLChanged := nil; {Do not react to change}
4645 >    try
4646 >      FQSelect.SQL.Assign(FBaseSQLSelect);
4647 >    finally
4648 >      FQSelect.OnSQLChanged := SQLChanged;
4649 >    end;
4650 >  end;
4651 > end;
4652 >
4653 > function TIBCustomDataSet.HasParser: boolean;
4654 > begin
4655 >  Result := not (csDesigning in ComponentState) and (FParser <> nil)
4656 > end;
4657 >
4658 > procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4659 > begin
4660 >  if FGenerateParamNames = AValue then Exit;
4661 >  FGenerateParamNames := AValue;
4662 >  Disconnect
4663   end;
4664  
4665   procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
# Line 3560 | Line 4680 | end;
4680  
4681   { TIBDataSet IProviderSupport }
4682  
4683 < (*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4683 > procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4684   begin
4685    if Commit then
4686      Transaction.Commit else
# Line 3713 | Line 4833 | begin
4833    Transaction.StartTransaction;
4834   end;
4835  
4836 < function TIBCustomDataSet.PSGetTableName: string;
4836 > function TIBCustomDataSet.PsGetTableName: string;
4837   begin
4838   //  if not FInternalPrepared then
4839   //    InternalPrepare;
# Line 3723 | Line 4843 | begin
4843    if not FQSelect.Prepared then
4844      FQSelect.Prepare;
4845    Result := FQSelect.UniqueRelationName;
4846 < end;*)
4846 > end;
4847  
4848   procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4849   begin
# Line 3788 | Line 4908 | end;
4908  
4909   function TIBCustomDataSet.GetFieldData(Field: TField;
4910    Buffer: Pointer): Boolean;
4911 + {$IFDEF TBCDFIELD_IS_BCD}
4912   var
4913    lTempCurr : System.Currency;
4914   begin
# Line 3798 | Line 4919 | begin
4919        CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4920    end
4921    else
4922 + {$ELSE}
4923 + begin
4924 + {$ENDIF}
4925      Result := InternalGetFieldData(Field, Buffer);
4926   end;
4927  
# Line 3811 | Line 4935 | begin
4935   end;
4936  
4937   procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4938 + {$IFDEF TDBDFIELD_IS_BCD}
4939   var
4940    lTempCurr : System.Currency;
4941   begin
# Line 3820 | Line 4945 | begin
4945      InternalSetFieldData(Field, @lTempCurr);
4946    end
4947    else
4948 + {$ELSE}
4949 + begin
4950 + {$ENDIF}
4951      InternalSetFieldData(Field, Buffer);
4952   end;
4953  
# Line 3846 | Line 4974 | begin
4974    inherited Destroy;
4975   end;
4976  
4977 < procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
4977 > procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
4978   begin
4979    FRefreshSQL.Assign(Value);
4980   end;
4981  
4982 + procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
4983 +  buff: PChar);
4984 + begin
4985 +  if not Assigned(DataSet) then Exit;
4986 +  DataSet.SetInternalSQLParams(Params, buff);
4987 + end;
4988 +
4989 + procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4990 + begin
4991 +  InternalSetParams(Query.Params,buff);
4992 + end;
4993 +
4994 + procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(QryResults: IResults;
4995 +  Buffer: PChar);
4996 + begin
4997 +  if not Assigned(DataSet) then Exit;
4998 +  DataSet.UpdateRecordFromQuery(QryResults, Buffer);
4999 + end;
5000 +
5001 + function TIBDSBlobStream.GetSize: Int64;
5002 + begin
5003 +  Result := FBlobStream.BlobSize;
5004 + end;
5005 +
5006   { TIBDSBlobStream }
5007   constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
5008                                      Mode: TBlobStreamMode);
# Line 3859 | Line 5011 | begin
5011    FBlobStream := ABlobStream;
5012    FBlobStream.Seek(0, soFromBeginning);
5013    if (Mode = bmWrite) then
5014 +  begin
5015      FBlobStream.Truncate;
5016 +    TIBCustomDataSet(FField.DataSet).RecordModified(True);
5017 +    TBlobField(FField).Modified := true;
5018 +    FHasWritten := true;
5019 +  end;
5020 + end;
5021 +
5022 + destructor TIBDSBlobStream.Destroy;
5023 + begin
5024 +  if FHasWritten then
5025 +     TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
5026 +  inherited Destroy;
5027   end;
5028  
5029   function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
# Line 3884 | Line 5048 | begin
5048    TIBCustomDataSet(FField.DataSet).RecordModified(True);
5049    TBlobField(FField).Modified := true;
5050    result := FBlobStream.Write(Buffer, Count);
5051 <  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
5051 >  FHasWritten := true;
5052 > {  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
5053 >  Removed as this caused a seek to beginning of the blob stream thus corrupting
5054 >  the blob stream. Moved to the destructor i.e. called after blob written}
5055   end;
5056  
5057   { TIBGenerator }
# Line 3896 | Line 5063 | begin
5063    FIncrement := AValue
5064   end;
5065  
3899 function TIBGenerator.GetSelectSQL: string;
3900 begin
3901  Result := FOwner.SelectSQL.Text
3902 end;
3903
5066   function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
5067    ATransaction: TIBTransaction): integer;
5068   begin
# Line 3914 | Line 5076 | begin
5076         IBError(ibxeCannotSetTransaction,[]);
5077      with Transaction do
5078        if not InTransaction then StartTransaction;
5079 <    SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[GeneratorName,Increment]);
5079 >    SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
5080      Prepare;
5081      ExecQuery;
5082      try
# Line 3936 | Line 5098 | end;
5098  
5099   procedure TIBGenerator.Apply;
5100   begin
5101 <  if (GeneratorName <> '') and (FieldName <> '')  then
5102 <    Owner.FieldByName(FieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
5101 >  if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5102 >    Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
5103   end;
5104  
5105 +
5106   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines