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 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 107 by tony, Thu Jan 18 14:37:40 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 <  Windows, SysUtils, Classes, Forms, Controls, StdVCL,
51 <  IBExternals, IB, IBHeader, IBDatabase, IBSQL, Db,
52 <  IBUtils, IBBlob;
50 > {$IFDEF WINDOWS }
51 >  Windows,
52 > {$ELSE}
53 >  unix,
54 > {$ENDIF}
55 >  SysUtils, Classes, IBDatabase, IBExternals, IB,  IBSQL, Db,
56 >  IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo;
57  
58   const
59    BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
# Line 43 | Line 63 | type
63    TIBCustomDataSet = class;
64    TIBDataSet = class;
65  
66 +  { TIBDataSetUpdateObject }
67 +
68    TIBDataSetUpdateObject = class(TComponent)
69    private
70      FRefreshSQL: TStrings;
# Line 50 | 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 60 | Line 85 | type
85      property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
86    end;
87  
63  PDateTime = ^TDateTime;
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 85 | 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 97 | 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 117 | 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 125 | 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 142 | Line 304 | type
304      destructor Destroy; override;
305    end;
306  
307 +  TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord);
308 +
309 +  { TIBGenerator }
310 +
311 +  TIBGenerator = class(TPersistent)
312 +  private
313 +    FOwner: TIBCustomDataSet;
314 +    FApplyOnEvent: TIBGeneratorApplyOnEvent;
315 +    FFieldName: string;
316 +    FGeneratorName: string;
317 +    FIncrement: integer;
318 +    FQuery: TIBSQL;
319 +    function GetDatabase: TIBDatabase;
320 +    function GetTransaction: TIBTransaction;
321 +    procedure SetDatabase(AValue: TIBDatabase);
322 +    procedure SetGeneratorName(AValue: string);
323 +    procedure SetIncrement(const AValue: integer);
324 +    procedure SetTransaction(AValue: TIBTransaction);
325 +    procedure SetQuerySQL;
326 +  protected
327 +    function GetNextValue: integer;
328 +  public
329 +    constructor Create(Owner: TIBCustomDataSet);
330 +    destructor Destroy; override;
331 +    procedure Apply;
332 +    property Owner: TIBCustomDataSet read FOwner;
333 +    property Database: TIBDatabase read GetDatabase write SetDatabase;
334 +    property Transaction: TIBTransaction read GetTransaction write SetTransaction;
335 +  published
336 +    property Generator: string read FGeneratorName write SetGeneratorName;
337 +    property Field: string read FFieldName write FFieldName;
338 +    property Increment: integer read FIncrement write SetIncrement default 1;
339 +    property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
340 +  end;
341 +
342 +  {TIBControlLink - Allows IB Aware controls to react to dataset state changes}
343 +
344 +  TIBControlLink = class
345 +  private
346 +    FTIBDataSet: TIBCustomDataSet;
347 +    procedure SetIBDataSet(AValue: TIBCustomDataSet);
348 +  protected
349 +    procedure UpdateSQL(Sender: TObject); virtual;
350 +    procedure UpdateParams(Sender: TObject); virtual;
351 +  public
352 +    destructor Destroy; override;
353 +    property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
354 +  end;
355 +
356 +  TIBAutoCommit = (acDisabled, acCommitRetaining);
357 +
358    { TIBCustomDataSet }
359 +
360    TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
361  
362    TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
363 <                                 UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
363 >                                 UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
364                                   of object;
365    TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
366                                     var UpdateAction: TIBUpdateAction) of object;
367  
368    TIBUpdateRecordTypes = set of TCachedUpdateStatus;
369  
370 +  TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
371 +
372 +  TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
373 +
374    TIBCustomDataSet = class(TDataset)
375    private
376 +    FAllowAutoActivateTransaction: Boolean;
377 +    FArrayFieldCount: integer;
378 +    FArrayCacheOffset: integer;
379 +    FAutoCommit: TIBAutoCommit;
380 +    FGenerateParamNames: Boolean;
381 +    FGeneratorField: TIBGenerator;
382      FNeedsRefresh: Boolean;
383      FForcedRefresh: Boolean;
384      FDidActivate: Boolean;
161    FIBLoaded: Boolean;
385      FBase: TIBBase;
386      FBlobCacheOffset: Integer;
387      FBlobStreamList: TList;
388 +    FArrayList: TList;
389      FBufferChunks: Integer;
390      FBufferCache,
391      FOldBufferCache: PChar;
# Line 179 | Line 403 | type
403      FDeletedRecords: Long;
404      FModelBuffer,
405      FOldBuffer: PChar;
406 +    FOnValidatePost: TOnValidatePost;
407      FOpen: Boolean;
408      FInternalPrepared: Boolean;
409      FQDelete,
# Line 186 | Line 411 | type
411      FQRefresh,
412      FQSelect,
413      FQModify: TIBSQL;
414 +    FDatabaseInfo: TIBDatabaseInfo;
415      FRecordBufferSize: Integer;
416      FRecordCount: Integer;
417      FRecordSize: Integer;
418 +    FDataSetCloseAction: TDataSetCloseAction;
419      FUniDirectional: Boolean;
420      FUpdateMode: TUpdateMode;
421      FUpdateObject: TIBDataSetUpdateObject;
# Line 206 | Line 433 | type
433      FBeforeTransactionEnd,
434      FAfterTransactionEnd,
435      FTransactionFree: TNotifyEvent;
436 <
437 <    function GetSelectStmtHandle: TISC_STMT_HANDLE;
436 >    FAliasNameMap: array of string;
437 >    FAliasNameList: array of string;
438 >    FBaseSQLSelect: TStrings;
439 >    FParser: TSelectSQLParser;
440 >    FCloseAction: TTransactionAction;
441 >    FInTransactionEnd: boolean;
442 >    FIBLinks: TList;
443 >    FFieldColumns: PFieldColumns;
444 >    FBufferUpdatedOnQryReturn: boolean;
445 >    procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex,
446 >      FieldIndex: integer; Buffer: PChar);
447 >    procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
448 >    function GetSelectStmtIntf: IStatement;
449      procedure SetUpdateMode(const Value: TUpdateMode);
450      procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
451  
# Line 219 | Line 457 | type
457      function CanRefresh: Boolean;
458      procedure CheckEditState;
459      procedure ClearBlobCache;
460 +    procedure ClearArrayCache;
461 +    procedure ClearIBLinks;
462      procedure CopyRecordBuffer(Source, Dest: Pointer);
463      procedure DoBeforeDatabaseDisconnect(Sender: TObject);
464      procedure DoAfterDatabaseDisconnect(Sender: TObject);
465      procedure DoDatabaseFree(Sender: TObject);
466 <    procedure DoBeforeTransactionEnd(Sender: TObject);
466 >    procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
467      procedure DoAfterTransactionEnd(Sender: TObject);
468      procedure DoTransactionFree(Sender: TObject);
469      procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
470                                           Buffer: PChar);
471      function GetDatabase: TIBDatabase;
232    function GetDBHandle: PISC_DB_HANDLE;
472      function GetDeleteSQL: TStrings;
473      function GetInsertSQL: TStrings;
474 <    function GetSQLParams: TIBXSQLDA;
474 >    function GetSQLParams: ISQLParams;
475      function GetRefreshSQL: TStrings;
476      function GetSelectSQL: TStrings;
477 <    function GetStatementType: TIBSQLTypes;
477 >    function GetStatementType: TIBSQLStatementTypes;
478      function GetModifySQL: TStrings;
479      function GetTransaction: TIBTransaction;
480 <    function GetTRHandle: PISC_TR_HANDLE;
481 <    procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
480 >    function GetParser: TSelectSQLParser;
481 >    procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
482      function InternalLocate(const KeyFields: string; const KeyValues: Variant;
483                              Options: TLocateOptions): Boolean; virtual;
484 <    procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
485 <    procedure InternalRevertRecord(RecordNumber: Integer);
484 >    procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
485 >    procedure InternalRevertRecord(RecordNumber: Integer); virtual;
486      function IsVisible(Buffer: PChar): Boolean;
487 +    procedure RegisterIBLink(Sender: TIBControlLink);
488 +    procedure UnRegisterIBLink(Sender: TIBControlLink);
489      procedure SaveOldBuffer(Buffer: PChar);
490      procedure SetBufferChunks(Value: Integer);
491      procedure SetDatabase(Value: TIBDatabase);
492      procedure SetDeleteSQL(Value: TStrings);
493      procedure SetInsertSQL(Value: TStrings);
494 <    procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
494 >    procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
495      procedure SetRefreshSQL(Value: TStrings);
496      procedure SetSelectSQL(Value: TStrings);
497      procedure SetModifySQL(Value: TStrings);
498      procedure SetTransaction(Value: TIBTransaction);
499      procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
500      procedure SetUniDirectional(Value: Boolean);
501 +    procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
502      procedure RefreshParams;
261    procedure SQLChanging(Sender: TObject); virtual;
503      function AdjustPosition(FCache: PChar; Offset: DWORD;
504 <                            Origin: Integer): Integer;
504 >                            Origin: Integer): DWORD;
505      procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
506                         Buffer: PChar);
507      procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
# Line 269 | Line 510 | type
510                          Buffer: PChar);
511      procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
512      function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
513 <                       DoCheck: Boolean): TGetResult;
513 >                       DoCheck: Boolean): TGetResult; virtual;
514  
515    protected
516      procedure ActivateConnection;
# Line 277 | Line 518 | type
518      procedure DeactivateTransaction;
519      procedure CheckDatasetClosed;
520      procedure CheckDatasetOpen;
521 +    function CreateParser: TSelectSQLParser; virtual;
522 +    procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
523      function GetActiveBuf: PChar;
524 <    procedure InternalBatchInput(InputObject: TIBBatchInput);
525 <    procedure InternalBatchOutput(OutputObject: TIBBatchOutput);
524 >    procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
525 >    procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
526      procedure InternalPrepare; virtual;
527      procedure InternalUnPrepare; virtual;
528      procedure InternalExecQuery; virtual;
529      procedure InternalRefreshRow; virtual;
530 <    procedure InternalSetParamsFromCursor;
530 >    procedure InternalSetParamsFromCursor; virtual;
531      procedure CheckNotUniDirectional;
532 +    procedure SQLChanging(Sender: TObject); virtual;
533 +    procedure SQLChanged(Sender: TObject); virtual;
534  
535      { IProviderSupport }
536      procedure PSEndTransaction(Commit: Boolean); override;
# Line 309 | Line 554 | type
554      procedure ClearCalcFields(Buffer: PChar); override;
555      function AllocRecordBuffer: PChar; override;
556      procedure DoBeforeDelete; override;
557 +    procedure DoAfterDelete; override;
558      procedure DoBeforeEdit; override;
559 +    procedure DoAfterEdit; override;
560      procedure DoBeforeInsert; override;
561 +    procedure DoAfterInsert; override;
562 +    procedure DoBeforeClose; override;
563 +    procedure DoBeforeOpen; override;
564 +    procedure DoBeforePost; override;
565 +    procedure DoAfterPost; override;
566      procedure FreeRecordBuffer(var Buffer: PChar); override;
567      procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
568      function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
569      function GetCanModify: Boolean; override;
570      function GetDataSource: TDataSource; override;
571 +    function GetDBAliasName(FieldNo: integer): string;
572 +    function GetFieldDefFromAlias(aliasName: string): TFieldDef;
573      function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
574      function GetRecNo: Integer; override;
575      function GetRecord(Buffer: PChar; GetMode: TGetMode;
576                         DoCheck: Boolean): TGetResult; override;
577      function GetRecordCount: Integer; override;
578      function GetRecordSize: Word; override;
579 +    procedure InternalAutoCommit;
580      procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
581      procedure InternalCancel; override;
582      procedure InternalClose; override;
583      procedure InternalDelete; override;
584      procedure InternalFirst; override;
585 <    function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
585 >    function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual;
586      procedure InternalGotoBookmark(Bookmark: Pointer); override;
587      procedure InternalHandleException; override;
588      procedure InternalInitFieldDefs; override;
# Line 336 | Line 591 | type
591      procedure InternalOpen; override;
592      procedure InternalPost; override;
593      procedure InternalRefresh; override;
594 <    procedure InternalSetFieldData(Field: TField; Buffer: Pointer);
594 >    procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
595      procedure InternalSetToRecord(Buffer: PChar); override;
596      function IsCursorOpen: Boolean; override;
597 +    procedure Loaded; override;
598      procedure ReQuery;
599      procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
600      procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
601      procedure SetCachedUpdates(Value: Boolean);
602      procedure SetDataSource(Value: TDataSource);
603 +    procedure SetGenerateParamNames(AValue: Boolean); virtual;
604      procedure SetFieldData(Field : TField; Buffer : Pointer); override;
605      procedure SetFieldData(Field : TField; Buffer : Pointer;
606        NativeFormat : Boolean); overload; override;
# Line 351 | Line 608 | type
608  
609    protected
610      {Likely to be made public by descendant classes}
611 <    property SQLParams: TIBXSQLDA read GetSQLParams;
612 <    property Params: TIBXSQLDA read GetSQLParams;
611 >    property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
612 >    property SQLParams: ISQLParams read GetSQLParams;
613 >    property Params: ISQLParams read GetSQLParams;
614      property InternalPrepared: Boolean read FInternalPrepared;
615      property QDelete: TIBSQL read FQDelete;
616      property QInsert: TIBSQL read FQInsert;
617      property QRefresh: TIBSQL read FQRefresh;
618      property QSelect: TIBSQL read FQSelect;
619      property QModify: TIBSQL read FQModify;
620 <    property StatementType: TIBSQLTypes read GetStatementType;
621 <    property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
620 >    property StatementType: TIBSQLStatementTypes read GetStatementType;
621 >    property SelectStmtHandle: IStatement read GetSelectStmtIntf;
622  
623      {Likely to be made published by descendant classes}
624      property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
625      property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
626      property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
627 +    property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
628      property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
629      property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
630      property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
# Line 373 | Line 632 | type
632      property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
633      property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
634      property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
635 +    property Parser: TSelectSQLParser read GetParser;
636 +    property BaseSQLSelect: TStrings read FBaseSQLSelect;
637  
638      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
639                                                   write FBeforeDatabaseDisconnect;
# Line 386 | Line 647 | type
647                                              write FAfterTransactionEnd;
648      property TransactionFree: TNotifyEvent read FTransactionFree
649                                             write FTransactionFree;
650 +    property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
651  
652    public
653      constructor Create(AOwner: TComponent); override;
# Line 393 | Line 655 | type
655      procedure ApplyUpdates;
656      function CachedUpdateStatus: TCachedUpdateStatus;
657      procedure CancelUpdates;
658 +    function GetFieldPosition(AliasName: string): integer;
659      procedure FetchAll;
660      function LocateNext(const KeyFields: string; const KeyValues: Variant;
661                          Options: TLocateOptions): Boolean;
662      procedure RecordModified(Value: Boolean);
663      procedure RevertRecord;
664      procedure Undelete;
665 +    procedure ResetParser; virtual;
666 +    function HasParser: boolean;
667  
668      { TDataSet support methods }
669      function BookmarkValid(Bookmark: TBookmark): Boolean; override;
670      function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
671      function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
672 +    function GetArray(Field: TIBArrayField): IArray;
673 +    procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
674      function GetCurrentRecord(Buffer: PChar): Boolean; override;
675      function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
676 <    function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
676 >    function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
677      function GetFieldData(Field : TField; Buffer : Pointer;
678        NativeFormat : Boolean) : Boolean; overload; override;
679 +    property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
680      function Locate(const KeyFields: string; const KeyValues: Variant;
681                      Options: TLocateOptions): Boolean; override;
682      function Lookup(const KeyFields: string; const KeyValues: Variant;
683                      const ResultFields: string): Variant; override;
684      function UpdateStatus: TUpdateStatus; override;
685      function IsSequenced: Boolean; override;
686 <
687 <    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
688 <    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
686 >    procedure Post; override;
687 >    function ParamByName(ParamName: String): ISQLParam;
688 >    property ArrayFieldCount: integer read FArrayFieldCount;
689 >    property DatabaseInfo: TIBDatabaseInfo read FDatabaseInfo;
690      property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
691      property UpdatesPending: Boolean read FUpdatesPending;
692      property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
693                                                        write SetUpdateRecordTypes;
694 +    property DataSetCloseAction: TDataSetCloseAction
695 +               read FDataSetCloseAction write FDataSetCloseAction;
696  
697    published
698 +    property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
699 +                 write FAllowAutoActivateTransaction;
700      property Database: TIBDatabase read GetDatabase write SetDatabase;
701      property Transaction: TIBTransaction read GetTransaction
702                                            write SetTransaction;
703      property ForcedRefresh: Boolean read FForcedRefresh
704                                      write FForcedRefresh default False;
705      property AutoCalcFields;
433    property ObjectView default False;
706  
707      property AfterCancel;
708      property AfterClose;
# Line 461 | Line 733 | type
733                                                     write FOnUpdateRecord;
734    end;
735  
736 <  TIBDataSet = class(TIBCustomDataSet)
736 >  TIBParserDataSet = class(TIBCustomDataSet)
737 >  public
738 >    property Parser;
739 >  end;
740 >
741 >  TIBDataSet = class(TIBParserDataSet)
742    private
743      function GetPrepared: Boolean;
744  
# Line 486 | Line 763 | type
763      property QModify;
764      property StatementType;
765      property SelectStmtHandle;
766 +    property BaseSQLSelect;
767  
768    published
769      { TIBCustomDataSet }
770 +    property AutoCommit;
771      property BufferChunks;
772      property CachedUpdates;
773      property DeleteSQL;
# Line 496 | Line 775 | type
775      property RefreshSQL;
776      property SelectSQL;
777      property ModifySQL;
778 +    property GeneratorField;
779 +    property GenerateParamNames;
780      property ParamCheck;
781      property UniDirectional;
782      property Filtered;
783 +    property DataSetCloseAction;
784  
785      property BeforeDatabaseDisconnect;
786      property AfterDatabaseDisconnect;
# Line 534 | Line 816 | type
816      property OnFilterRecord;
817      property OnNewRecord;
818      property OnPostError;
819 +    property OnValidatePost;
820    end;
821  
822    { TIBDSBlobStream }
823    TIBDSBlobStream = class(TStream)
824 +  private
825 +    FHasWritten: boolean;
826    protected
827      FField: TField;
828      FBlobStream: TIBBlobStream;
829 +    function  GetSize: Int64; override;
830    public
831      constructor Create(AField: TField; ABlobStream: TIBBlobStream;
832                         Mode: TBlobStreamMode);
833 +    destructor Destroy; override;
834      function Read(var Buffer; Count: Longint): Longint; override;
835      function Seek(Offset: Longint; Origin: Word): Longint; override;
836      procedure SetSize(NewSize: Longint); override;
837      function Write(const Buffer; Count: Longint): Longint; override;
838    end;
839  
840 +  {Extended Field Def for character set info}
841 +
842 +  { TIBFieldDef }
843 +
844 +  TIBFieldDef = class(TFieldDef)
845 +  private
846 +    FArrayBounds: TArrayBounds;
847 +    FArrayDimensions: integer;
848 +    FCharacterSetName: RawByteString;
849 +    FCharacterSetSize: integer;
850 +    FCodePage: TSystemCodePage;
851 +    FIdentityColumn: boolean;
852 +    FRelationName: string;
853 +    FDataSize: integer;
854 +  published
855 +    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
856 +    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
857 +    property CodePage: TSystemCodePage read FCodePage write FCodePage;
858 +    property DataSize: integer read FDataSize write FDataSize;
859 +    property RelationName: string read FRelationName write FRelationName;
860 +    property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
861 +    property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
862 +    property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false;
863 +  end;
864 +
865   const
866   DefaultFieldClasses: array[TFieldType] of TFieldClass = (
867      nil,                { ftUnknown }
868      TIBStringField,     { ftString }
869 <    TSmallintField,     { ftSmallint }
870 <    TIntegerField,      { ftInteger }
869 >    TIBSmallintField,   { ftSmallint }
870 >    TIBIntegerField,      { ftInteger }
871      TWordField,         { ftWord }
872      TBooleanField,      { ftBoolean }
873      TFloatField,        { ftFloat }
# Line 568 | Line 880 | DefaultFieldClasses: array[TFieldType] o
880      TVarBytesField,     { ftVarBytes }
881      TAutoIncField,      { ftAutoInc }
882      TBlobField,         { ftBlob }
883 <    TMemoField,         { ftMemo }
883 >    TIBMemoField,       { ftMemo }
884      TGraphicField,      { ftGraphic }
885      TBlobField,         { ftFmtMemo }
886      TBlobField,         { ftParadoxOle }
# Line 576 | Line 888 | DefaultFieldClasses: array[TFieldType] o
888      TBlobField,         { ftTypedBinary }
889      nil,                { ftCursor }
890      TStringField,       { ftFixedChar }
891 <    nil, {TWideStringField } { ftWideString }
892 <    TLargeIntField,     { ftLargeInt }
891 >    nil,    { ftWideString }
892 >    TIBLargeIntField,     { ftLargeInt }
893 >    nil,          { ftADT }
894 >    TIBArrayField,        { ftArray }
895 >    nil,    { ftReference }
896 >    nil,     { ftDataSet }
897 >    TBlobField,         { ftOraBlob }
898 >    TMemoField,         { ftOraClob }
899 >    TVariantField,      { ftVariant }
900 >    nil,    { ftInterface }
901 >    nil,     { ftIDispatch }
902 >    TGuidField,        { ftGuid }
903 >    TDateTimeField,    {ftTimestamp}
904 >    TIBBCDField,       {ftFMTBcd}
905 >    nil,  {ftFixedWideChar}
906 >    nil);   {ftWideMemo}
907 > (*
908      TADTField,          { ftADT }
909      TArrayField,        { ftArray }
910      TReferenceField,    { ftReference }
# Line 587 | Line 914 | DefaultFieldClasses: array[TFieldType] o
914      TVariantField,      { ftVariant }
915      TInterfaceField,    { ftInterface }
916      TIDispatchField,     { ftIDispatch }
917 <    TGuidField);        { ftGuid }
918 < var
919 <  CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;
917 >    TGuidField);        { ftGuid } *)
918 > (*var
919 >  CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
920  
921   implementation
922  
923 < uses IBIntf, IBQuery;
923 > uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
924 >
925 > const FILE_BEGIN = 0;
926 >      FILE_CURRENT = 1;
927 >      FILE_END = 2;
928  
929   type
930  
# Line 602 | Line 933 | type
933      FieldName : String;
934      COMPUTED_BLR : Boolean;
935      DEFAULT_VALUE : boolean;
936 +    IDENTITY_COLUMN : boolean;
937      NextField : TFieldNode;
938    end;
939  
# Line 613 | Line 945 | type
945    end;
946  
947  
948 +  {  Copied from LCLProc in order to avoid LCL dependency
949 +
950 +    Ensures the covenient look of multiline string
951 +    when displaying it in the single line
952 +    * Replaces CR and LF with spaces
953 +    * Removes duplicate spaces
954 +  }
955 +  function TextToSingleLine(const AText: string): string;
956 +  var
957 +    str: string;
958 +    i, wstart, wlen: Integer;
959 +  begin
960 +    str := Trim(AText);
961 +    wstart := 0;
962 +    wlen := 0;
963 +    i := 1;
964 +    while i < Length(str) - 1 do
965 +    begin
966 +      if (str[i] in [' ', #13, #10]) then
967 +      begin
968 +        if (wstart = 0) then
969 +        begin
970 +          wstart := i;
971 +          wlen := 1;
972 +        end else
973 +          Inc(wlen);
974 +      end else
975 +      begin
976 +        if wstart > 0 then
977 +        begin
978 +          str[wstart] := ' ';
979 +          Delete(str, wstart+1, wlen-1);
980 +          Dec(i, wlen-1);
981 +          wstart := 0;
982 +        end;
983 +      end;
984 +      Inc(i);
985 +    end;
986 +    Result := str;
987 +  end;
988 +
989 + { TIBLargeIntField }
990 +
991 + procedure TIBLargeIntField.Bind(Binding: Boolean);
992 + begin
993 +  inherited Bind(Binding);
994 +  if Binding and (FieldDef <> nil) then
995 +     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
996 + end;
997 +
998 + { TIBIntegerField }
999 +
1000 + procedure TIBIntegerField.Bind(Binding: Boolean);
1001 + begin
1002 +  inherited Bind(Binding);
1003 +  if Binding and (FieldDef <> nil) then
1004 +     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1005 + end;
1006 +
1007 + { TIBSmallintField }
1008 +
1009 + procedure TIBSmallintField.Bind(Binding: Boolean);
1010 + begin
1011 +  inherited Bind(Binding);
1012 +  if Binding and (FieldDef <> nil) then
1013 +     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1014 + end;
1015 +
1016 + { TIBArray }
1017 +
1018 + procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
1019 + begin
1020 +  case Reason of
1021 +  arChanging:
1022 +    if FRecNo <> FField.Dataset.RecNo then
1023 +      IBError(ibxeNotCurrentArray,[nil]);
1024 +
1025 +  arChanged:
1026 +    FField.DataChanged;
1027 +  end;
1028 + end;
1029 +
1030 + constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
1031 + begin
1032 +  inherited Create;
1033 +  FField := aField;
1034 +  FArray := anArray;
1035 +  FRecNo := FField.Dataset.RecNo;
1036 +  FArray.AddEventHandler(EventHandler);
1037 + end;
1038 +
1039 + destructor TIBArray.Destroy;
1040 + begin
1041 +  FArray.RemoveEventHandler(EventHandler);
1042 +  inherited Destroy;
1043 + end;
1044 +
1045 + { TIBArrayField }
1046 +
1047 + function TIBArrayField.GetArrayIntf: IArray;
1048 + begin
1049 +  Result := TIBCustomDataSet(DataSet).GetArray(self);
1050 + end;
1051 +
1052 + function TIBArrayField.GetArrayID: TISC_QUAD;
1053 + begin
1054 +  GetData(@Result);
1055 + end;
1056 +
1057 + procedure TIBArrayField.SetArrayIntf(AValue: IArray);
1058 + begin
1059 +  TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
1060 +  DataChanged;
1061 + end;
1062 +
1063 + class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
1064 + begin
1065 +  //Ignore
1066 + end;
1067 +
1068 + function TIBArrayField.GetAsString: string;
1069 + begin
1070 +  Result := '(Array)';
1071 + end;
1072 +
1073 + function TIBArrayField.GetDataSize: Integer;
1074 + begin
1075 +  Result := sizeof(TISC_QUAD);
1076 + end;
1077 +
1078 + procedure TIBArrayField.Bind(Binding: Boolean);
1079 + begin
1080 +  inherited Bind(Binding);
1081 +  if Binding then
1082 +  begin
1083 +    FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
1084 +    Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
1085 +    if FieldDef <> nil then
1086 +    begin
1087 +      FRelationName := TIBFieldDef(FieldDef).FRelationName;
1088 +      FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
1089 +      FArrayBounds :=  TIBFieldDef(FieldDef).ArrayBounds;
1090 +    end;
1091 +  end;
1092 + end;
1093 +
1094 + constructor TIBArrayField.Create(AOwner: TComponent);
1095 + begin
1096 +  inherited Create(AOwner);
1097 +  SetDataType(ftArray);
1098 + end;
1099 +
1100 + function TIBArrayField.CreateArray: IArray;
1101 + begin
1102 + with DataSet as TIBCustomDataSet do
1103 +  Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1104 + end;
1105 +
1106 + { TIBMemoField }
1107 +
1108 + function TIBMemoField.GetTruncatedText: string;
1109 + begin
1110 +   Result := GetAsString;
1111 +
1112 +   if Result <> '' then
1113 +   begin
1114 +       case CharacterSetSize of
1115 +       1:
1116 +         if DisplayWidth = 0 then
1117 +           Result := TextToSingleLine(Result)
1118 +         else
1119 +         if Length(Result) > DisplayWidth then {Show truncation with elipses}
1120 +           Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
1121 +
1122 +       {2: case 2 ignored. This should be handled by TIBWideMemo}
1123 +
1124 +       3, {Assume UNICODE_FSS is really UTF8}
1125 +       4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1126 +         if DisplayWidth = 0 then
1127 +           Result := ValidUTF8String(TextToSingleLine(Result))
1128 +         else
1129 +         if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1130 +           Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1131 +       end;
1132 +   end
1133 + end;
1134 +
1135 + procedure TIBMemoField.Bind(Binding: Boolean);
1136 + var IBFieldDef: TIBFieldDef;
1137 + begin
1138 +  inherited Bind(Binding);
1139 +  if Binding and (FieldDef <> nil) then
1140 +  begin
1141 +    IBFieldDef := FieldDef as TIBFieldDef;
1142 +    CharacterSetSize := IBFieldDef.CharacterSetSize;
1143 +    CharacterSetName := IBFieldDef.CharacterSetName;
1144 +    CodePage := IBFieldDef.CodePage;
1145 +  end;
1146 + end;
1147 +
1148 + function TIBMemoField.GetAsString: string;
1149 + var s: RawByteString;
1150 + begin
1151 +  s := inherited GetAsString;
1152 +  SetCodePage(s,CodePage,false);
1153 +  if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1154 +    SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1155 +  Result := s;
1156 + end;
1157 +
1158 + function TIBMemoField.GetDefaultWidth: Longint;
1159 + begin
1160 +  if DisplayTextAsClassName then
1161 +    Result := inherited
1162 +  else
1163 +    Result := 128;
1164 + end;
1165 +
1166 + procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
1167 + begin
1168 +  if ADisplayText then
1169 +  begin
1170 +    if not DisplayTextAsClassName and (CharacterSetName <> '') then
1171 +      AText := GetTruncatedText
1172 +    else
1173 +      inherited GetText(AText, ADisplayText);
1174 +  end
1175 +  else
1176 +    AText := GetAsString;
1177 + end;
1178 +
1179 + procedure TIBMemoField.SetAsString(const AValue: string);
1180 + var s: RawByteString;
1181 + begin
1182 +  s := AValue;
1183 +  if StringCodePage(s) <> CodePage then
1184 +    SetCodePage(s,CodePage,CodePage<>CP_NONE);
1185 +  inherited SetAsString(s);
1186 + end;
1187 +
1188 + constructor TIBMemoField.Create(AOwner: TComponent);
1189 + begin
1190 +  inherited Create(AOwner);
1191 +  BlobType := ftMemo;
1192 +  FCodePage := CP_NONE;
1193 + end;
1194 +
1195 + { TIBControlLink }
1196 +
1197 + destructor TIBControlLink.Destroy;
1198 + begin
1199 +  IBDataSet := nil;
1200 +  inherited Destroy;
1201 + end;
1202 +
1203 + procedure TIBControlLink.UpdateParams(Sender: TObject);
1204 + begin
1205 +
1206 + end;
1207 +
1208 + procedure TIBControlLink.UpdateSQL(Sender: TObject);
1209 + begin
1210 +
1211 + end;
1212 +
1213 + procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1214 + begin
1215 +  if FTIBDataSet = AValue then Exit;
1216 +  if IBDataSet <> nil then
1217 +    IBDataSet.UnRegisterIBLink(self);
1218 +  FTIBDataSet := AValue;
1219 +  if IBDataSet <> nil then
1220 +    IBDataSet.RegisterIBLink(self);
1221 + end;
1222 +
1223 +
1224   { TIBStringField}
1225  
1226 < constructor TIBStringField.Create(AOwner: TComponent);
1226 > procedure TIBStringField.Bind(Binding: Boolean);
1227 > var IBFieldDef: TIBFieldDef;
1228 > begin
1229 >  inherited Bind(Binding);
1230 >  if Binding and (FieldDef <> nil) then
1231 >  begin
1232 >    IBFieldDef := FieldDef as TIBFieldDef;
1233 >    CharacterSetSize := IBFieldDef.CharacterSetSize;
1234 >    CharacterSetName := IBFieldDef.CharacterSetName;
1235 >    FDataSize := IBFieldDef.DataSize + 1;
1236 >    if AutoFieldSize then
1237 >      Size := IBFieldDef.Size;
1238 >    CodePage := IBFieldDef.CodePage;
1239 >  end;
1240 > end;
1241 >
1242 > function TIBStringField.GetDataSize: Integer;
1243 > begin
1244 >  Result := FDataSize;
1245 > end;
1246 >
1247 > constructor TIBStringField.Create(aOwner: TComponent);
1248   begin
1249 <  inherited;
1249 >  inherited Create(aOwner);
1250 >  FCharacterSetSize := 1;
1251 >  FCodePage := CP_NONE;
1252 >  FAutoFieldSize := true;
1253   end;
1254  
1255   class procedure TIBStringField.CheckTypeSize(Value: Integer);
# Line 640 | Line 1272 | end;
1272   function TIBStringField.GetValue(var Value: string): Boolean;
1273   var
1274    Buffer: PChar;
1275 +  s: RawByteString;
1276   begin
1277    Buffer := nil;
1278 <  IBAlloc(Buffer, 0, Size + 1);
1278 >  IBAlloc(Buffer, 0, DataSize);
1279    try
1280      Result := GetData(Buffer);
1281      if Result then
1282      begin
1283 <      Value := string(Buffer);
1283 >      s := strpas(Buffer);
1284 >      SetCodePage(s,CodePage,false);
1285 >      if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1286 >        SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1287 >      Value := s;
1288 > //      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1289        if Transliterate and (Value <> '') then
1290          DataSet.Translate(PChar(Value), PChar(Value), False);
1291      end
# Line 659 | Line 1297 | end;
1297   procedure TIBStringField.SetAsString(const Value: string);
1298   var
1299    Buffer: PChar;
1300 +  s: RawByteString;
1301   begin
1302    Buffer := nil;
1303 <  IBAlloc(Buffer, 0, Size + 1);
1303 >  IBAlloc(Buffer, 0, DataSize);
1304    try
1305 <    StrLCopy(Buffer, PChar(Value), Size);
1305 >    s := Value;
1306 >    if StringCodePage(s) <> CodePage then
1307 >      SetCodePage(s,CodePage,CodePage<>CP_NONE);
1308 >    StrLCopy(Buffer, PChar(s), DataSize-1);
1309      if Transliterate then
1310        DataSet.Translate(Buffer, Buffer, True);
1311      SetData(Buffer);
# Line 672 | Line 1314 | begin
1314    end;
1315   end;
1316  
1317 +
1318   { TIBBCDField }
1319  
1320   constructor TIBBCDField.Create(AOwner: TComponent);
# Line 681 | Line 1324 | begin
1324    Size := 8;
1325   end;
1326  
1327 + procedure TIBBCDField.Bind(Binding: Boolean);
1328 + begin
1329 +  inherited Bind(Binding);
1330 +  if Binding and (FieldDef <> nil) then
1331 +     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1332 + end;
1333 +
1334   class procedure TIBBCDField.CheckTypeSize(Value: Integer);
1335   begin
1336   { No need to check as the base type is currency, not BCD }
# Line 714 | Line 1364 | end;
1364  
1365   function TIBBCDField.GetDataSize: Integer;
1366   begin
1367 + {$IFDEF TBCDFIELD_IS_BCD}
1368    Result := 8;
1369 + {$ELSE}
1370 +  Result := inherited GetDataSize
1371 + {$ENDIF}
1372   end;
1373  
1374   { TIBDataLink }
# Line 728 | Line 1382 | end;
1382   destructor TIBDataLink.Destroy;
1383   begin
1384    FDataSet.FDataLink := nil;
1385 <  inherited;
1385 >  inherited Destroy;
1386   end;
1387  
1388  
# Line 760 | Line 1414 | end;
1414  
1415   constructor TIBCustomDataSet.Create(AOwner: TComponent);
1416   begin
1417 <  inherited;
764 <  FIBLoaded := False;
765 <  CheckIBLoaded;
766 <  FIBLoaded := True;
1417 >  inherited Create(AOwner);
1418    FBase := TIBBase.Create(Self);
1419 +  FDatabaseInfo := TIBDatabaseInfo.Create(self);
1420 +  FIBLinks := TList.Create;
1421    FCurrentRecord := -1;
1422    FDeletedRecords := 0;
1423    FUniDirectional := False;
1424    FBufferChunks := BufferCacheSize;
1425    FBlobStreamList := TList.Create;
1426 +  FArrayList := TList.Create;
1427 +  FGeneratorField := TIBGenerator.Create(self);
1428    FDataLink := TIBDataLink.Create(Self);
1429    FQDelete := TIBSQL.Create(Self);
1430    FQDelete.OnSQLChanging := SQLChanging;
# Line 782 | Line 1437 | begin
1437    FQRefresh.GoToFirstRecordOnExecute := False;
1438    FQSelect := TIBSQL.Create(Self);
1439    FQSelect.OnSQLChanging := SQLChanging;
1440 +  FQSelect.OnSQLChanged := SQLChanged;
1441    FQSelect.GoToFirstRecordOnExecute := False;
1442    FQModify := TIBSQL.Create(Self);
1443    FQModify.OnSQLChanging := SQLChanging;
1444    FQModify.GoToFirstRecordOnExecute := False;
1445    FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1446    FParamCheck := True;
1447 +  FGenerateParamNames := False;
1448    FForcedRefresh := False;
1449 +  FAutoCommit:= acDisabled;
1450 +  FDataSetCloseAction := dcDiscardChanges;
1451    {Bookmark Size is Integer for IBX}
1452    BookmarkSize := SizeOf(Integer);
1453    FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
# Line 802 | Line 1461 | begin
1461    else
1462      if AOwner is TIBTransaction then
1463        Transaction := TIBTransaction(AOwner);
1464 +  FBaseSQLSelect := TStringList.Create;
1465   end;
1466  
1467   destructor TIBCustomDataSet.Destroy;
1468   begin
1469 <  inherited;
1470 <  if FIBLoaded then
1471 <  begin
1472 <    FDataLink.Free;
1473 <    FBase.Free;
1474 <    ClearBlobCache;
1475 <    FBlobStreamList.Free;
1476 <    FreeMem(FBufferCache);
1477 <    FBufferCache := nil;
1478 <    FreeMem(FOldBufferCache);
1479 <    FOldBufferCache := nil;
1480 <    FCacheSize := 0;
1481 <    FOldCacheSize := 0;
1482 <    FMappedFieldPosition := nil;
1483 <  end;
1469 >  if Active then Active := false;
1470 >  if assigned(FGeneratorField) then FGeneratorField.Free;
1471 >  FDataLink.Free;
1472 >  FBase.Free;
1473 >  ClearBlobCache;
1474 >  ClearIBLinks;
1475 >  FIBLinks.Free;
1476 >  FBlobStreamList.Free;
1477 >  FArrayList.Free;
1478 >  FreeMem(FBufferCache);
1479 >  FBufferCache := nil;
1480 >  FreeMem(FOldBufferCache);
1481 >  FOldBufferCache := nil;
1482 >  FCacheSize := 0;
1483 >  FOldCacheSize := 0;
1484 >  FMappedFieldPosition := nil;
1485 >  if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1486 >  if assigned(FParser) then FParser.Free;
1487 >  inherited Destroy;
1488   end;
1489  
1490   function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
# Line 842 | Line 1506 | begin
1506        Inc(FCurrentRecord);
1507        if (FCurrentRecord = FRecordCount) then
1508        begin
1509 <        if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1509 >        if (not FQSelect.EOF) and FQSelect.Next  then
1510          begin
1511            FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1512            Inc(FRecordCount);
# Line 861 | Line 1525 | end;
1525  
1526   procedure TIBCustomDataSet.ApplyUpdates;
1527   var
1528 <  CurBookmark: string;
1528 >  CurBookmark: TBookmark;
1529    Buffer: PRecordData;
1530    CurUpdateTypes: TIBUpdateRecordTypes;
1531    UpdateAction: TIBUpdateAction;
# Line 921 | Line 1585 | var
1585    procedure UpdateUsingUpdateObject;
1586    begin
1587      try
1588 <      FUpdateObject.Apply(UpdateKind);
1588 >      FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1589        ResetBufferUpdateStatus;
1590      except
1591        on E: Exception do
# Line 1059 | Line 1723 | begin
1723    end;
1724   end;
1725  
1726 + function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1727 + var i: integer;
1728 +    Prepared: boolean;
1729 + begin
1730 +  Result := 0;
1731 +  Prepared := FInternalPrepared;
1732 +  if not Prepared then
1733 +    InternalPrepare;
1734 +  try
1735 +    for i := 0 to Length(FAliasNameList) - 1 do
1736 +      if FAliasNameList[i] = AliasName then
1737 +      begin
1738 +        Result := i + 1;
1739 +        Exit
1740 +      end;
1741 +  finally
1742 +    if not Prepared then
1743 +      InternalUnPrepare;
1744 +  end;
1745 + end;
1746 +
1747   procedure TIBCustomDataSet.ActivateConnection;
1748   begin
1749    if not Assigned(Database) then
# Line 1071 | Line 1756 | end;
1756   function TIBCustomDataSet.ActivateTransaction: Boolean;
1757   begin
1758    Result := False;
1759 <  if not Assigned(Transaction) then
1075 <    IBError(ibxeTransactionNotAssigned, [nil]);
1076 <  if not Transaction.Active then
1759 >  if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1760    begin
1761 <    Result := True;
1762 <    Transaction.StartTransaction;
1763 <    FDidActivate := True;
1761 >    if not Assigned(Transaction) then
1762 >      IBError(ibxeTransactionNotAssigned, [nil]);
1763 >    if not Transaction.Active then
1764 >    begin
1765 >      Result := True;
1766 >      Transaction.StartTransaction;
1767 >      FDidActivate := True;
1768 >    end;
1769    end;
1770   end;
1771  
# Line 1119 | Line 1807 | begin
1807      IBError(ibxeDatasetClosed, [nil]);
1808   end;
1809  
1810 + function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1811 + begin
1812 +  Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1813 +  Result.OnSQLChanging := SQLChanging
1814 + end;
1815 +
1816   procedure TIBCustomDataSet.CheckNotUniDirectional;
1817   begin
1818    if UniDirectional then
# Line 1196 | Line 1890 | begin
1890    FBlobStreamList.Pack;
1891   end;
1892  
1893 + procedure TIBCustomDataSet.ClearArrayCache;
1894 + var
1895 +  i: Integer;
1896 + begin
1897 +  for i := 0 to FArrayList.Count - 1 do
1898 +  begin
1899 +    TIBArray(FArrayList[i]).Free;
1900 +    FArrayList[i] := nil;
1901 +  end;
1902 +  FArrayList.Pack;
1903 + end;
1904 +
1905   procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1906   begin
1907    Move(Source^, Dest^, FRecordBufferSize);
# Line 1205 | Line 1911 | procedure TIBCustomDataSet.DoBeforeDatab
1911   begin
1912    if Active then
1913      Active := False;
1914 <  FInternalPrepared := False;
1914 >  InternalUnPrepare;
1915    if Assigned(FBeforeDatabaseDisconnect) then
1916      FBeforeDatabaseDisconnect(Sender);
1917   end;
# Line 1222 | Line 1928 | begin
1928      FDatabaseFree(Sender);
1929   end;
1930  
1931 < procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1931 > procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1932 >  Action: TTransactionAction);
1933   begin
1934 <  if Active then
1935 <    Active := False;
1934 >  FCloseAction := Action;
1935 >  FInTransactionEnd := true;
1936 >  try
1937 >    if Active then
1938 >      Active := False;
1939 >  finally
1940 >    FInTransactionEnd := false;
1941 >  end;
1942    if FQSelect <> nil then
1943      FQSelect.FreeHandle;
1944    if FQDelete <> nil then
# Line 1236 | Line 1949 | begin
1949      FQModify.FreeHandle;
1950    if FQRefresh <> nil then
1951      FQRefresh.FreeHandle;
1952 +  InternalUnPrepare;
1953    if Assigned(FBeforeTransactionEnd) then
1954      FBeforeTransactionEnd(Sender);
1955   end;
# Line 1252 | Line 1966 | begin
1966      FTransactionFree(Sender);
1967   end;
1968  
1969 < { Read the record from FQSelect.Current into the record buffer
1970 <  Then write the buffer to in memory cache }
1971 < procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1972 <  RecordNumber: Integer; Buffer: PChar);
1973 < var
1260 <  p: PRecordData;
1261 <  pbd: PBlobDataArray;
1262 <  i, j: Integer;
1263 <  LocalData: Pointer;
1264 <  LocalDate, LocalDouble: Double;
1265 <  LocalInt: Integer;
1266 <  LocalInt64: Int64;
1267 <  LocalCurrency: Currency;
1268 <  FieldsLoaded: Integer;
1969 > procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1970 > var i, j: Integer;
1971 >    FieldsLoaded: integer;
1972 >    p: PRecordData;
1973 >    colMetadata: IColumnMetaData;
1974   begin
1975    p := PRecordData(Buffer);
1271  { Make sure blob cache is empty }
1272  pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1273  if RecordNumber > -1 then
1274    for i := 0 to BlobFieldCount - 1 do
1275      pbd^[i] := nil;
1976    { Get record information }
1977    p^.rdBookmarkFlag := bfCurrent;
1978 <  p^.rdFieldCount := Qry.Current.Count;
1979 <  p^.rdRecordNumber := RecordNumber;
1978 >  p^.rdFieldCount := Qry.FieldCount;
1979 >  p^.rdRecordNumber := -1;
1980    p^.rdUpdateStatus := usUnmodified;
1981    p^.rdCachedUpdateStatus := cusUnmodified;
1982    p^.rdSavedOffset := $FFFFFFFF;
1983  
1984    { Load up the fields }
1985 <  FieldsLoaded := FQSelect.Current.Count;
1985 >  FieldsLoaded := FQSelect.MetaData.Count;
1986    j := 1;
1987 <  for i := 0 to Qry.Current.Count - 1 do
1987 >  for i := 0 to Qry.MetaData.Count - 1 do
1988    begin
1989      if (Qry = FQSelect) then
1990        j := i + 1
1991 <    else begin
1991 >    else
1992 >    begin
1993        if FieldsLoaded = 0 then
1994          break;
1995 <      j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
1995 >      j := FQSelect.FieldIndex[Qry[i].Name] + 1;
1996        if j < 1 then
1997          continue
1998        else
1999          Dec(FieldsLoaded);
2000      end;
2001 <    with FQSelect.Current[j - 1].Data^ do
2002 <      if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2001 >    if j > 0 then
2002 >    begin
2003 >      colMetadata := Qry.MetaData[i];
2004 >      with p^.rdFields[j], FFieldColumns^[j] do
2005        begin
2006 <        if sqllen <= 8 then
2007 <          p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
2008 <        continue;
2006 >        fdDataType := colMetadata.GetSQLType;
2007 >        if fdDataType = SQL_BLOB then
2008 >          fdDataScale := 0
2009 >        else
2010 >          fdDataScale := colMetadata.getScale;
2011 >        fdNullable := colMetadata.getIsNullable;
2012 >        fdIsNull := true;
2013 >        fdDataSize := colMetadata.GetSize;
2014 >        fdDataLength := 0;
2015 >        fdCodePage := CP_NONE;
2016 >
2017 >        case fdDataType of
2018 >        SQL_TIMESTAMP,
2019 >        SQL_TYPE_DATE,
2020 >        SQL_TYPE_TIME:
2021 >          fdDataSize := SizeOf(TDateTime);
2022 >        SQL_SHORT, SQL_LONG:
2023 >        begin
2024 >          if (fdDataScale = 0) then
2025 >            fdDataSize := SizeOf(Integer)
2026 >          else
2027 >          if (fdDataScale >= (-4)) then
2028 >            fdDataSize := SizeOf(Currency)
2029 >          else
2030 >            fdDataSize := SizeOf(Double);
2031 >        end;
2032 >        SQL_INT64:
2033 >        begin
2034 >          if (fdDataScale = 0) then
2035 >            fdDataSize := SizeOf(Int64)
2036 >          else
2037 >          if (fdDataScale >= (-4)) then
2038 >            fdDataSize := SizeOf(Currency)
2039 >          else
2040 >            fdDataSize := SizeOf(Double);
2041 >        end;
2042 >        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2043 >          fdDataSize := SizeOf(Double);
2044 >        SQL_BOOLEAN:
2045 >          fdDataSize := SizeOf(wordBool);
2046 >        SQL_VARYING,
2047 >        SQL_TEXT,
2048 >        SQL_BLOB:
2049 >          fdCodePage := Qry.Metadata[i].getCodePage;
2050 >        end;
2051 >        fdDataOfs := FRecordSize;
2052 >        Inc(FRecordSize, fdDataSize);
2053        end;
2054 <    if j > 0 then with p^ do
2054 >    end;
2055 >  end;
2056 > end;
2057 >
2058 > {Update Buffer Fields from Query Results}
2059 >
2060 > procedure TIBCustomDataSet.UpdateRecordFromQuery(QryResults: IResults;
2061 >  Buffer: PChar);
2062 > var i, j: integer;
2063 > begin
2064 >  for i := 0 to QryResults.Count - 1 do
2065 >  begin
2066 >    j := GetFieldPosition(QryResults[i].GetAliasName);
2067 >    if j > 0 then
2068 >    begin
2069 >      ColumnDataToBuffer(QryResults,i,j,Buffer);
2070 >      FBufferUpdatedOnQryReturn := true;
2071 >    end;
2072 >  end;
2073 > end;
2074 >
2075 >
2076 > {Move column data returned from query to row buffer}
2077 >
2078 > procedure TIBCustomDataSet.ColumnDataToBuffer(QryResults: IResults;
2079 >               ColumnIndex, FieldIndex: integer; Buffer: PChar);
2080 > var
2081 >  LocalData: PByte;
2082 >  LocalDate: TDateTime;
2083 >  LocalDouble: Double;
2084 >  LocalInt: Integer;
2085 >  LocalBool: wordBool;
2086 >  LocalInt64: Int64;
2087 >  LocalCurrency: Currency;
2088 >  ColData: ISQLData;
2089 > begin
2090 >  LocalData := nil;
2091 >  with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2092 >  begin
2093 >    QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData);
2094 >    if not fdIsNull then
2095      begin
2096 <      rdFields[j].fdDataType :=
2097 <        Qry.Current[i].Data^.sqltype and (not 1);
2098 <      rdFields[j].fdDataScale :=
2099 <        Qry.Current[i].Data^.sqlscale;
1313 <      rdFields[j].fdNullable :=
1314 <        (Qry.Current[i].Data^.sqltype and 1 = 1);
1315 <      rdFields[j].fdIsNull :=
1316 <        (rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1317 <      LocalData := Qry.Current[i].Data^.sqldata;
1318 <      case rdFields[j].fdDataType of
2096 >      ColData := QryResults[ColumnIndex];
2097 >      case fdDataType of  {Get Formatted data for column types that need formatting}
2098 >        SQL_TYPE_DATE,
2099 >        SQL_TYPE_TIME,
2100          SQL_TIMESTAMP:
2101          begin
2102 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
2103 <          if RecordNumber >= 0 then
2104 <            LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
1324 <          LocalData := PChar(@LocalDate);
1325 <        end;
1326 <        SQL_TYPE_DATE:
1327 <        begin
1328 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1329 <          if RecordNumber >= 0 then
1330 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
1331 <          LocalData := PChar(@LocalInt);
1332 <        end;
1333 <        SQL_TYPE_TIME:
1334 <        begin
1335 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1336 <          if RecordNumber >= 0 then
1337 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1338 <          LocalData := PChar(@LocalInt);
2102 >          {This is an IBX native format and not the TDataset approach. See also GetFieldData}
2103 >          LocalDate := ColData.AsDateTime;
2104 >          LocalData := PByte(@LocalDate);
2105          end;
2106          SQL_SHORT, SQL_LONG:
2107          begin
2108 <          if (rdFields[j].fdDataScale = 0) then
2108 >          if (fdDataScale = 0) then
2109            begin
2110 <            rdFields[j].fdDataSize := SizeOf(Integer);
2111 <            if RecordNumber >= 0 then
1346 <              LocalInt := Qry.Current[i].AsLong;
1347 <            LocalData := PChar(@LocalInt);
2110 >            LocalInt := ColData.AsLong;
2111 >            LocalData := PByte(@LocalInt);
2112            end
2113 <          else if (rdFields[j].fdDataScale >= (-4)) then
2114 <               begin
2115 <                 rdFields[j].fdDataSize := SizeOf(Currency);
2116 <                 if RecordNumber >= 0 then
2117 <                   LocalCurrency := Qry.Current[i].AsCurrency;
2118 <                 LocalData := PChar(@LocalCurrency);
2119 <               end
2120 <               else begin
2121 <                 rdFields[j].fdDataSize := SizeOf(Double);
2122 <                 if RecordNumber >= 0 then
2123 <                   LocalDouble := Qry.Current[i].AsDouble;
1360 <                LocalData := PChar(@LocalDouble);
1361 <              end;
2113 >          else
2114 >          if (fdDataScale >= (-4)) then
2115 >          begin
2116 >            LocalCurrency := ColData.AsCurrency;
2117 >            LocalData := PByte(@LocalCurrency);
2118 >          end
2119 >          else
2120 >          begin
2121 >           LocalDouble := ColData.AsDouble;
2122 >           LocalData := PByte(@LocalDouble);
2123 >          end;
2124          end;
2125          SQL_INT64:
2126          begin
2127 <          if (rdFields[j].fdDataScale = 0) then
2127 >          if (fdDataScale = 0) then
2128            begin
2129 <            rdFields[j].fdDataSize := SizeOf(Int64);
2130 <            if RecordNumber >= 0 then
1369 <              LocalInt64 := Qry.Current[i].AsInt64;
1370 <            LocalData := PChar(@LocalInt64);
2129 >            LocalInt64 := ColData.AsInt64;
2130 >            LocalData := PByte(@LocalInt64);
2131            end
2132 <          else if (rdFields[j].fdDataScale >= (-4)) then
2133 <               begin
2134 <                 rdFields[j].fdDataSize := SizeOf(Currency);
2135 <                 if RecordNumber >= 0 then
2136 <                   LocalCurrency := Qry.Current[i].AsCurrency;
2137 <                   LocalData := PChar(@LocalCurrency);
2138 <               end
2139 <               else begin
2140 <                  rdFields[j].fdDataSize := SizeOf(Double);
2141 <                  if RecordNumber >= 0 then
2142 <                    LocalDouble := Qry.Current[i].AsDouble;
1383 <                  LocalData := PChar(@LocalDouble);
1384 <               end
2132 >          else
2133 >          if (fdDataScale >= (-4)) then
2134 >          begin
2135 >            LocalCurrency := ColData.AsCurrency;
2136 >            LocalData := PByte(@LocalCurrency);
2137 >            end
2138 >            else
2139 >            begin
2140 >              LocalDouble := ColData.AsDouble;
2141 >              LocalData := PByte(@LocalDouble);
2142 >            end
2143          end;
2144          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2145          begin
2146 <          rdFields[j].fdDataSize := SizeOf(Double);
2147 <          if RecordNumber >= 0 then
1390 <            LocalDouble := Qry.Current[i].AsDouble;
1391 <          LocalData := PChar(@LocalDouble);
1392 <        end;
1393 <        SQL_VARYING:
1394 <        begin
1395 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1396 <          rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1397 <          if RecordNumber >= 0 then
1398 <          begin
1399 <            if (rdFields[j].fdDataLength = 0) then
1400 <              LocalData := nil
1401 <            else
1402 <              LocalData := @Qry.Current[i].Data^.sqldata[2];
1403 <          end;
2146 >          LocalDouble := ColData.AsDouble;
2147 >          LocalData := PByte(@LocalDouble);
2148          end;
2149 <        else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
2149 >        SQL_BOOLEAN:
2150          begin
2151 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
2152 <          if (rdFields[j].fdDataType = SQL_TEXT) then
1409 <            rdFields[j].fdDataLength := rdFields[j].fdDataSize;
2151 >          LocalBool := ColData.AsBoolean;
2152 >          LocalData := PByte(@LocalBool);
2153          end;
2154        end;
2155 <      if RecordNumber < 0 then
2155 >
2156 >      if fdDataType = SQL_VARYING then
2157 >        Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2158 >      else
2159 >        Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2160 >    end
2161 >    else {Null column}
2162 >    if fdDataType = SQL_VARYING then
2163 >      FillChar(Buffer[fdDataOfs],fdDataLength,0)
2164 >    else
2165 >      FillChar(Buffer[fdDataOfs],fdDataSize,0);
2166 >  end;
2167 > end;
2168 >
2169 > { Read the record from FQSelect.Current into the record buffer
2170 >  Then write the buffer to in memory cache }
2171 > procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
2172 >  RecordNumber: Integer; Buffer: PChar);
2173 > var
2174 >  pbd: PBlobDataArray;
2175 >  pda: PArrayDataArray;
2176 >  i, j: Integer;
2177 >  FieldsLoaded: Integer;
2178 >  p: PRecordData;
2179 > begin
2180 >  if RecordNumber = -1 then
2181 >  begin
2182 >    InitModelBuffer(Qry,Buffer);
2183 >    Exit;
2184 >  end;
2185 >  p := PRecordData(Buffer);
2186 >  { Make sure blob cache is empty }
2187 >  pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
2188 >  pda := PArrayDataArray(Buffer + FArrayCacheOffset);
2189 >  for i := 0 to BlobFieldCount - 1 do
2190 >    pbd^[i] := nil;
2191 >  for i := 0 to ArrayFieldCount - 1 do
2192 >    pda^[i] := nil;
2193 >
2194 >  { Get record information }
2195 >  p^.rdBookmarkFlag := bfCurrent;
2196 >  p^.rdFieldCount := Qry.FieldCount;
2197 >  p^.rdRecordNumber := RecordNumber;
2198 >  p^.rdUpdateStatus := usUnmodified;
2199 >  p^.rdCachedUpdateStatus := cusUnmodified;
2200 >  p^.rdSavedOffset := $FFFFFFFF;
2201 >
2202 >  { Load up the fields }
2203 >  FieldsLoaded := FQSelect.MetaData.Count;
2204 >  j := 1;
2205 >  for i := 0 to Qry.FieldCount - 1 do
2206 >  begin
2207 >    if (Qry = FQSelect) then
2208 >      j := i + 1
2209 >    else
2210 >    begin
2211 >      if FieldsLoaded = 0 then
2212 >        break;
2213 >      j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2214 >      if j < 1 then
2215 >        continue
2216 >      else
2217 >        Dec(FieldsLoaded);
2218 >    end;
2219 >    with FQSelect.MetaData[j - 1] do
2220 >      if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2221        begin
2222 <        rdFields[j].fdIsNull := True;
2223 <        rdFields[j].fdDataOfs := FRecordSize;
2224 <        Inc(FRecordSize, rdFields[j].fdDataSize);
1417 <      end
1418 <      else begin
1419 <        if rdFields[j].fdDataType = SQL_VARYING then
1420 <        begin
1421 <          if LocalData <> nil then
1422 <            Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)
1423 <        end
1424 <        else
1425 <          Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
2222 >        if (GetSize <= 8) then
2223 >          p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2224 >        continue;
2225        end;
2226 <    end;
2226 >    if j > 0 then
2227 >      ColumnDataToBuffer(Qry.Current,i,j,Buffer);
2228    end;
2229 <  WriteRecordCache(RecordNumber, PChar(p));
2229 >  WriteRecordCache(RecordNumber, Buffer);
2230   end;
2231  
2232   function TIBCustomDataSet.GetActiveBuf: PChar;
# Line 1471 | Line 2271 | begin
2271    result := FBase.Database;
2272   end;
2273  
1474 function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1475 begin
1476  result := FBase.DBHandle;
1477 end;
1478
2274   function TIBCustomDataSet.GetDeleteSQL: TStrings;
2275   begin
2276    result := FQDelete.SQL;
# Line 1486 | Line 2281 | begin
2281    result := FQInsert.SQL;
2282   end;
2283  
2284 < function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
2284 > function TIBCustomDataSet.GetSQLParams: ISQLParams;
2285   begin
2286    if not FInternalPrepared then
2287      InternalPrepare;
# Line 1503 | Line 2298 | begin
2298    result := FQSelect.SQL;
2299   end;
2300  
2301 < function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
2301 > function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2302   begin
2303 <  result := FQSelect.SQLType;
2303 >  result := FQSelect.SQLStatementType;
2304   end;
2305  
2306   function TIBCustomDataSet.GetModifySQL: TStrings;
# Line 1518 | Line 2313 | begin
2313    result := FBase.Transaction;
2314   end;
2315  
1521 function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1522 begin
1523  result := FBase.TRHandle;
1524 end;
1525
2316   procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2317   begin
2318    if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2319 <    FUpdateObject.Apply(ukDelete)
2319 >    FUpdateObject.Apply(ukDelete,Buff)
2320    else
2321    begin
2322 <    SetInternalSQLParams(FQDelete, Buff);
2322 >    SetInternalSQLParams(FQDelete.Params, Buff);
2323      FQDelete.ExecQuery;
2324    end;
2325    with PRecordData(Buff)^ do
# Line 1543 | Line 2333 | end;
2333   function TIBCustomDataSet.InternalLocate(const KeyFields: string;
2334    const KeyValues: Variant; Options: TLocateOptions): Boolean;
2335   var
2336 <  fl: TList;
2337 <  CurBookmark: string;
2338 <  fld, val: Variant;
2339 <  i, fld_cnt: Integer;
2336 >  keyFieldList: TList;
2337 >  CurBookmark: TBookmark;
2338 >  fieldValue: Variant;
2339 >  lookupValues: array of variant;
2340 >  i, fieldCount: Integer;
2341 >  fieldValueAsString: string;
2342 >  lookupValueAsString: string;
2343   begin
2344 <  fl := TList.Create;
2344 >  keyFieldList := TList.Create;
2345    try
2346 <    GetFieldList(fl, KeyFields);
2347 <    fld_cnt := fl.Count;
2346 >    GetFieldList(keyFieldList, KeyFields);
2347 >    fieldCount := keyFieldList.Count;
2348      CurBookmark := Bookmark;
2349 <    result := False;
2350 <    while ((not result) and (not EOF)) do
2349 >    result := false;
2350 >    SetLength(lookupValues, fieldCount);
2351 >    if not EOF then
2352      begin
2353 <      i := 0;
1560 <      result := True;
1561 <      while (result and (i < fld_cnt)) do
2353 >      for i := 0 to fieldCount - 1 do  {expand key values into lookupValues array}
2354        begin
2355 <        if fld_cnt > 1 then
2356 <          val := KeyValues[i]
2355 >        if VarIsArray(KeyValues) then
2356 >          lookupValues[i] := KeyValues[i]
2357          else
2358 <          val := KeyValues;
2359 <        fld := TField(fl[i]).Value;
2360 <        result := not (VarIsNull(val) xor VarIsNull(fld));
2361 <        if result and not VarIsNull(val) then
2358 >        if i > 0 then
2359 >          lookupValues[i] := NULL
2360 >        else
2361 >          lookupValues[0] := KeyValues;
2362 >
2363 >        {convert to upper case is case insensitive search}
2364 >        if (TField(keyFieldList[i]).DataType = ftString) and
2365 >           not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
2366 >            lookupValues[i] := UpperCase(lookupValues[i]);
2367 >      end;
2368 >    end;
2369 >    while not result and not EOF do   {search for a matching record}
2370 >    begin
2371 >      i := 0;
2372 >      result := true;
2373 >      while result and (i < fieldCount) do
2374 >      {see if all of the key fields matches}
2375 >      begin
2376 >        fieldValue := TField(keyFieldList[i]).Value;
2377 >        result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
2378 >        if result and not VarIsNull(fieldValue) then
2379          begin
2380            try
2381 <            fld := VarAsType(fld, VarType(val));
1573 <          except
1574 <            on E: EVariantError do result := False;
1575 <          end;
1576 <          if Result then
1577 <            if TField(fl[i]).DataType = ftString then
2381 >            if TField(keyFieldList[i]).DataType = ftString then
2382              begin
2383 +              {strings need special handling because of the locate options that
2384 +               apply to them}
2385 +              fieldValueAsString := TField(keyFieldList[i]).AsString;
2386 +              lookupValueAsString := lookupValues[i];
2387                if (loCaseInsensitive in Options) then
2388 <              begin
2389 <                fld := AnsiUpperCase(fld);
1582 <                val := AnsiUpperCase(val);
1583 <              end;
1584 <              fld := TrimRight(fld);
1585 <              val := TrimRight(val);
2388 >                fieldValueAsString := UpperCase(fieldValueAsString);
2389 >
2390                if (loPartialKey in Options) then
2391 <                result := result and (AnsiPos(val, fld) = 1)
2391 >                result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
2392                else
2393 <                result := result and (val = fld);
2394 <            end else
2395 <                result := result and (val = fld);
2393 >                result := result and (fieldValueAsString = lookupValueAsString);
2394 >            end
2395 >            else
2396 >              result := result and (lookupValues[i] =
2397 >                             VarAsType(fieldValue, VarType(lookupValues[i])));
2398 >          except on EVariantError do
2399 >            result := False;
2400 >          end;
2401          end;
2402          Inc(i);
2403        end;
2404        if not result then
2405 <        Next;
2405 >          Next;
2406      end;
2407      if not result then
2408        Bookmark := CurBookmark
2409      else
2410        CursorPosChanged;
2411    finally
2412 <    fl.Free;
2412 >    keyFieldList.Free;
2413 >    SetLength(lookupValues,0)
2414    end;
2415   end;
2416  
2417   procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2418   var
2419 <  i, j, k: Integer;
2419 >  i, j, k, arr: Integer;
2420    pbd: PBlobDataArray;
2421 +  pda: PArrayDataArray;
2422   begin
2423    pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2424 <  j := 0;
2424 >  pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2425 >  j := 0; arr := 0;
2426    for i := 0 to FieldCount - 1 do
2427      if Fields[i].IsBlob then
2428      begin
# Line 1619 | Line 2431 | begin
2431        begin
2432          pbd^[j].Finalize;
2433          PISC_QUAD(
2434 <          PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
2434 >          PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2435            pbd^[j].BlobID;
2436          PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2437 +      end
2438 +      else
2439 +      begin
2440 +        PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2441 +        with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2442 +        begin
2443 +          gds_quad_high := 0;
2444 +          gds_quad_low := 0;
2445 +        end;
2446        end;
2447        Inc(j);
2448 +    end
2449 +    else
2450 +    if Fields[i] is TIBArrayField then
2451 +    begin
2452 +      if pda^[arr] <> nil then
2453 +      begin
2454 +        k := FMappedFieldPosition[Fields[i].FieldNo -1];
2455 +        PISC_QUAD(
2456 +          PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=  pda^[arr].ArrayIntf.GetArrayID;
2457 +        PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2458 +      end;
2459 +      Inc(arr);
2460      end;
2461 +  FBufferUpdatedOnQryReturn := false;
2462    if Assigned(FUpdateObject) then
2463    begin
2464      if (Qry = FQDelete) then
2465 <      FUpdateObject.Apply(ukDelete)
2465 >      FUpdateObject.Apply(ukDelete,Buff)
2466      else if (Qry = FQInsert) then
2467 <      FUpdateObject.Apply(ukInsert)
2467 >      FUpdateObject.Apply(ukInsert,Buff)
2468      else
2469 <      FUpdateObject.Apply(ukModify);
2469 >      FUpdateObject.Apply(ukModify,Buff);
2470    end
2471    else begin
2472 <    SetInternalSQLParams(Qry, Buff);
2472 >    SetInternalSQLParams(Qry.Params, Buff);
2473      Qry.ExecQuery;
2474 +    if Qry.FieldCount > 0 then {Has RETURNING Clause}
2475 +      UpdateRecordFromQuery(Qry.Current,Buff);
2476    end;
2477    PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
2478    PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2479    SetModified(False);
2480    WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
2481 <  if (FForcedRefresh or FNeedsRefresh) and CanRefresh then
2481 >  if (FForcedRefresh or (FNeedsRefresh and not FBufferUpdatedOnQryReturn)) and CanRefresh then
2482      InternalRefreshRow;
2483   end;
2484  
2485   procedure TIBCustomDataSet.InternalRefreshRow;
2486   var
2487    Buff: PChar;
1652  SetCursor: Boolean;
2488    ofs: DWORD;
2489    Qry: TIBSQL;
2490   begin
2491 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1657 <  if SetCursor then
1658 <    Screen.Cursor := crHourGlass;
2491 >  FBase.SetCursor;
2492    try
2493      Buff := GetActiveBuf;
2494      if CanRefresh then
# Line 1672 | Line 2505 | begin
2505          end
2506          else
2507            Qry := FQRefresh;
2508 <        SetInternalSQLParams(Qry, Buff);
2508 >        SetInternalSQLParams(Qry.Params, Buff);
2509          Qry.ExecQuery;
2510          try
2511 <          if (Qry.SQLType = SQLExecProcedure) or
1679 <             (Qry.Next <> nil) then
2511 >          if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2512            begin
2513              ofs := PRecordData(Buff)^.rdSavedOffset;
2514              FetchCurrentRecordToBuffer(Qry,
# Line 1699 | Line 2531 | begin
2531      else
2532        IBError(ibxeCannotRefresh, [nil]);
2533    finally
2534 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1703 <      Screen.Cursor := crDefault;
2534 >    FBase.RestoreCursor;
2535    end;
2536   end;
2537  
# Line 1770 | Line 2601 | begin
2601   end;
2602  
2603   procedure TIBCustomDataSet.InternalPrepare;
1773 var
1774  SetCursor: Boolean;
1775  DidActivate: Boolean;
2604   begin
2605    if FInternalPrepared then
2606      Exit;
2607 <  DidActivate := False;
1780 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1781 <  if SetCursor then
1782 <    Screen.Cursor := crHourGlass;
2607 >  FBase.SetCursor;
2608    try
2609      ActivateConnection;
2610 <    DidActivate := ActivateTransaction;
2610 >    ActivateTransaction;
2611      FBase.CheckDatabase;
2612      FBase.CheckTransaction;
2613 +    if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2614 +    begin
2615 +      FQSelect.OnSQLChanged := nil; {Do not react to change}
2616 +      try
2617 +        FQSelect.SQL.Text := FParser.SQLText;
2618 +      finally
2619 +        FQSelect.OnSQLChanged := SQLChanged;
2620 +      end;
2621 +    end;
2622 + //   writeln( FQSelect.SQL.Text);
2623      if FQSelect.SQL.Text <> '' then
2624      begin
2625        if not FQSelect.Prepared then
2626        begin
2627 +        FQSelect.GenerateParamNames := FGenerateParamNames;
2628          FQSelect.ParamCheck := ParamCheck;
2629          FQSelect.Prepare;
2630        end;
2631 <      if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
2631 >      FQDelete.GenerateParamNames := FGenerateParamNames;
2632 >      if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2633          FQDelete.Prepare;
2634 <      if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
2634 >      FQInsert.GenerateParamNames := FGenerateParamNames;
2635 >      if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2636          FQInsert.Prepare;
2637 <      if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
2637 >      FQRefresh.GenerateParamNames := FGenerateParamNames;
2638 >      if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2639          FQRefresh.Prepare;
2640 <      if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
2640 >      FQModify.GenerateParamNames := FGenerateParamNames;
2641 >      if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2642          FQModify.Prepare;
2643        FInternalPrepared := True;
2644        InternalInitFieldDefs;
2645      end else
2646        IBError(ibxeEmptyQuery, [nil]);
2647    finally
2648 <    if DidActivate then
1809 <      DeactivateTransaction;
1810 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1811 <      Screen.Cursor := crDefault;
2648 >    FBase.RestoreCursor;
2649    end;
2650   end;
2651  
# Line 1837 | Line 2674 | var
2674    begin
2675      CopyRecordBuffer(Buffer, OldBuffer);
2676      if BlobFieldCount > 0 then
2677 <      FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2677 >      FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2678 >               BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2679                 0);
2680    end;
2681  
# Line 1879 | Line 2717 | begin
2717    if (FBase.Database <> Value) then
2718    begin
2719      CheckDatasetClosed;
2720 +    InternalUnPrepare;
2721      FBase.Database := Value;
2722      FQDelete.Database := Value;
2723      FQInsert.Database := Value;
2724      FQRefresh.Database := Value;
2725      FQSelect.Database := Value;
2726      FQModify.Database := Value;
2727 +    FDatabaseInfo.Database := Value;
2728 +    FGeneratorField.Database := Value;
2729    end;
2730   end;
2731  
# Line 1906 | Line 2747 | begin
2747    end;
2748   end;
2749  
2750 < procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
2750 > procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
2751   var
2752    i, j: Integer;
2753    cr, data: PChar;
2754 <  fn, st: string;
2754 >  fn: string;
2755 >  st: RawByteString;
2756    OldBuffer: Pointer;
2757    ts: TTimeStamp;
2758 +  Param: ISQLParam;
2759   begin
2760    if (Buffer = nil) then
2761      IBError(ibxeBufferNotSet, [nil]);
# Line 1920 | Line 2763 | begin
2763      InternalPrepare;
2764    OldBuffer := nil;
2765    try
2766 <    for i := 0 to Qry.Params.Count - 1 do
2766 >    for i := 0 to Params.GetCount - 1 do
2767      begin
2768 <      fn := Qry.Params[i].Name;
2768 >      Param := Params[i];
2769 >      fn := Param.Name;
2770        if (Pos('OLD_', fn) = 1) then {mbcs ok}
2771        begin
2772          fn := Copy(fn, 5, Length(fn));
# Line 1942 | Line 2786 | begin
2786               cr := Buffer;
2787        j := FQSelect.FieldIndex[fn] + 1;
2788        if (j > 0) then
2789 <        with PRecordData(cr)^ do
2789 >        with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2790          begin
2791 <          if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2791 >          if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2792            begin
2793 <            PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2793 >            PIBDBKey(Param.AsPointer)^ := rdDBKey;
2794              continue;
2795            end;
2796 <          if rdFields[j].fdIsNull then
2797 <            Qry.Params[i].IsNull := True
2796 >          if fdIsNull then
2797 >            Param.IsNull := True
2798            else begin
2799 <            Qry.Params[i].IsNull := False;
2800 <            data := cr + rdFields[j].fdDataOfs;
2801 <            case rdFields[j].fdDataType of
2799 >            Param.IsNull := False;
2800 >            data := cr + fdDataOfs;
2801 >            case fdDataType of
2802                SQL_TEXT, SQL_VARYING:
2803                begin
2804 <                SetString(st, data, rdFields[j].fdDataLength);
2805 <                Qry.Params[i].AsString := st;
2804 >                SetString(st, data, fdDataLength);
2805 >                SetCodePage(st,fdCodePage,false);
2806 >                Param.AsString := st;
2807                end;
2808              SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2809 <              Qry.Params[i].AsDouble := PDouble(data)^;
2809 >              Param.AsDouble := PDouble(data)^;
2810              SQL_SHORT, SQL_LONG:
2811              begin
2812 <              if rdFields[j].fdDataScale = 0 then
2813 <                Qry.Params[i].AsLong := PLong(data)^
2814 <              else if rdFields[j].fdDataScale >= (-4) then
2815 <                Qry.Params[i].AsCurrency := PCurrency(data)^
2812 >              if fdDataScale = 0 then
2813 >                Param.AsLong := PLong(data)^
2814 >              else
2815 >              if fdDataScale >= (-4) then
2816 >                Param.AsCurrency := PCurrency(data)^
2817                else
2818 <                Qry.Params[i].AsDouble := PDouble(data)^;
2818 >                Param.AsDouble := PDouble(data)^;
2819              end;
2820              SQL_INT64:
2821              begin
2822 <              if rdFields[j].fdDataScale = 0 then
2823 <                Qry.Params[i].AsInt64 := PInt64(data)^
1978 <              else if rdFields[j].fdDataScale >= (-4) then
1979 <                Qry.Params[i].AsCurrency := PCurrency(data)^
2822 >              if fdDataScale = 0 then
2823 >                Param.AsInt64 := PInt64(data)^
2824                else
2825 <                Qry.Params[i].AsDouble := PDouble(data)^;
2825 >              if fdDataScale >= (-4) then
2826 >                Param.AsCurrency := PCurrency(data)^
2827 >              else
2828 >                Param.AsDouble := PDouble(data)^;
2829              end;
2830              SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2831 <              Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2832 <            SQL_TYPE_DATE:
2833 <            begin
1987 <              ts.Date := PInt(data)^;
1988 <              ts.Time := 0;
1989 <              Qry.Params[i].AsDate :=
1990 <                TimeStampToDateTime(ts);
1991 <            end;
1992 <            SQL_TYPE_TIME:
1993 <            begin
1994 <              ts.Date := 0;
1995 <              ts.Time := PInt(data)^;
1996 <              Qry.Params[i].AsTime :=
1997 <                TimeStampToDateTime(ts);
1998 <            end;
2831 >              Param.AsQuad := PISC_QUAD(data)^;
2832 >            SQL_TYPE_DATE,
2833 >            SQL_TYPE_TIME,
2834              SQL_TIMESTAMP:
2835 <              Qry.Params[i].AsDateTime :=
2836 <                TimeStampToDateTime(
2837 <                  MSecsToTimeStamp(PDouble(data)^));
2835 >            {This is an IBX native format and not the TDataset approach. See also SetFieldData}
2836 >              Param.AsDateTime := PDateTime(data)^;
2837 >            SQL_BOOLEAN:
2838 >              Param.AsBoolean := PWordBool(data)^;
2839            end;
2840          end;
2841        end;
# Line 2048 | Line 2884 | begin
2884      FQRefresh.Transaction := Value;
2885      FQSelect.Transaction := Value;
2886      FQModify.Transaction := Value;
2887 +    FGeneratorField.Transaction := Value;
2888    end;
2889   end;
2890  
# Line 2085 | 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 2120 | 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 2136 | 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 2174 | 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 2211 | 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 2257 | 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 2276 | 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 2298 | 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 2330 | Line 3270 | begin
3270    if FCachedUpdates and
3271      (Buff^.rdCachedUpdateStatus in [cusUnmodified]) then
3272      SaveOldBuffer(PChar(Buff));
3273 <  inherited;
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;
# Line 2344 | Line 3291 | begin
3291    if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
3292      SaveOldBuffer(PChar(Buff));
3293    CopyRecordBuffer(GetActiveBuf, FOldBuffer);
3294 <  inherited;
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
3306      IBError(ibxeCannotInsert, [nil]);
3307 <  inherited;
3307 >  inherited DoBeforeInsert;
3308 > end;
3309 >
3310 > procedure TIBCustomDataSet.DoAfterInsert;
3311 > begin
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 >     (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;
2360 <  CurBookmark: string;
3363 >  CurBookmark: TBookmark;
3364   begin
3365 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3366 <  if SetCursor then
2364 <    Screen.Cursor := crHourGlass;
2365 <  try
3365 >  FBase.SetCursor;
3366 > try
3367      if FQSelect.EOF or not FQSelect.Open then
3368        exit;
3369      DisableControls;
# Line 2374 | Line 3375 | begin
3375        EnableControls;
3376      end;
3377    finally
3378 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2378 <      Screen.Cursor := crDefault;
3378 >    FBase.RestoreCursor;
3379    end;
3380   end;
3381  
# Line 2423 | 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 2441 | 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 2453 | 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
2461      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 2507 | 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 2526 | Line 3551 | begin
3551          if FCurrentRecord < FRecordCount then
3552            ReadRecordCache(FCurrentRecord, Buffer, False)
3553          else begin
3554 <          while (not FQSelect.EOF) and
2530 <                (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 2601 | 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 2628 | Line 3662 | procedure TIBCustomDataSet.InternalCance
3662   var
3663    Buff: PChar;
3664    CurRec: Integer;
3665 +  pda: PArrayDataArray;
3666 +  i: integer;
3667   begin
3668 <  inherited;
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 2654 | Line 3694 | begin
3694      DeactivateTransaction;
3695    FQSelect.Close;
3696    ClearBlobCache;
3697 +  ClearArrayCache;
3698    FreeRecordBuffer(FModelBuffer);
3699    FreeRecordBuffer(FOldBuffer);
3700    FCurrentRecord := -1;
# Line 2669 | 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;
2681  SetCursor: Boolean;
3725   begin
3726 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2684 <  if SetCursor then
2685 <    Screen.Cursor := crHourGlass;
3726 >  FBase.SetCursor;
3727    try
3728      Buff := GetActiveBuf;
3729      if CanDelete then
# Line 2707 | Line 3748 | begin
3748      end else
3749        IBError(ibxeCannotDelete, [nil]);
3750    finally
3751 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2711 <      Screen.Cursor := crDefault;
3751 >    FBase.RestoreCursor;
3752    end;
3753   end;
3754  
# Line 2724 | 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 2736 | 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 2768 | 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 2821 | 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 2841 | Line 3933 | var
3933    end;
3934  
3935   begin
2844  if not InternalPrepared then
2845  begin
2846    InternalPrepare;
2847    exit;
2848  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 2856 | 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 2883 | 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 2941 | 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;
2948 <            DataType := FieldType;
4076 >            Name := FieldAliasName;
4077 >            FAliasNameMap[FieldNo-1] := DBAliasName;
4078              Size := FieldSize;
4079 +            DataSize := FieldDataSize;
4080              Precision := FieldPrecision;
4081 <            Required := False;
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 2977 | Line 4114 | begin
4114      FreeNodes;
4115      Database.InternalTransaction.Commit;
4116      FieldDefs.EndUpdate;
4117 +    FieldDefs.Updated := true;
4118    end;
4119   end;
4120  
# Line 2994 | 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 3009 | 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 3017 | 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];
4164 <      if (cur_field <> nil) then begin
4163 >      if (cur_field <> nil) then
4164 >      begin
4165 >        cur_param := SQLParams[i];
4166          if (cur_field.IsNull) then
4167            cur_param.IsNull := True
4168 <        else case cur_field.DataType of
4168 >        else
4169 >        case cur_field.DataType of
4170            ftString:
4171              cur_param.AsString := cur_field.AsString;
4172 <          ftBoolean, ftSmallint, ftWord:
4172 >          ftBoolean:
4173 >            cur_param.AsBoolean := cur_field.AsBoolean;
4174 >          ftSmallint, ftWord:
4175              cur_param.AsShort := cur_field.AsInteger;
4176            ftInteger:
4177              cur_param.AsLong := cur_field.AsInteger;
4178            ftLargeInt:
4179 <            cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
4179 >            cur_param.AsInt64 := cur_field.AsLargeInt;
4180            ftFloat, ftCurrency:
4181             cur_param.AsDouble := cur_field.AsFloat;
4182            ftBCD:
# Line 3051 | Line 4193 | begin
4193              try
4194                s := DataSource.DataSet.
4195                       CreateBlobStream(cur_field, bmRead);
4196 <              cur_param.LoadFromStream(s);
4196 >              cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4197              finally
4198                s.free;
4199              end;
4200            end;
4201 +          ftArray:
4202 +            cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4203            else
4204              IBError(ibxeNotSupported, [nil]);
4205          end;
# Line 3082 | Line 4226 | begin
4226   end;
4227  
4228   procedure TIBCustomDataSet.InternalOpen;
3085 var
3086  SetCursor: Boolean;
4229  
4230    function RecordDataLength(n: Integer): Long;
4231    begin
# Line 3091 | Line 4233 | var
4233    end;
4234  
4235   begin
4236 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3095 <  if SetCursor then
3096 <    Screen.Cursor := crHourGlass;
4236 >  FBase.SetCursor;
4237    try
4238      ActivateConnection;
4239      ActivateTransaction;
# Line 3101 | Line 4241 | begin
4241        IBError(ibxeEmptyQuery, [nil]);
4242      if not FInternalPrepared then
4243        InternalPrepare;
4244 <   if FQSelect.SQLType = SQLSelect then
4244 >   if FQSelect.SQLStatementType = SQLSelect then
4245     begin
4246        if DefaultFields then
4247          CreateFields;
4248 +      FArrayFieldCount := 0;
4249        BindFields(True);
4250        FCurrentRecord := -1;
4251        FQSelect.ExecQuery;
# Line 3116 | Line 4257 | begin
4257          3. After the dummy fetch, FRecordSize will be appropriately
4258             adjusted to reflect the additional "weight" of the field
4259             data.
4260 <        4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4260 >        4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4261          5. Now, with the BufferSize available, allocate memory for chunks of records
4262          6. Re-allocate the model buffer, accounting for the new
4263             FRecordBufferSize.
4264          7. Finally, calls to AllocRecordBuffer will work!.
4265         }
4266        {Step 1}
4267 <      FRecordSize := RecordDataLength(FQSelect.Current.Count);
4267 >      FRecordSize := RecordDataLength(FQSelect.FieldCount);
4268        {Step 2, 3}
4269 +      GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4270        IBAlloc(FModelBuffer, 0, FRecordSize);
4271 <      FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4271 >      InitModelBuffer(FQSelect, FModelBuffer);
4272        {Step 4}
4273        FCalcFieldsOffset := FRecordSize;
4274        FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4275 <      FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4275 >      FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4276 >      FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4277        {Step 5}
4278        if UniDirectional then
4279          FBufferChunkSize := FRecordBufferSize * UniCache
# Line 3146 | Line 4289 | begin
4289        FCacheSize := FBufferChunkSize;
4290        FOldCacheSize := FBufferChunkSize;
4291        {Step 6}
4292 <      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4292 >      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4293                               FRecordBufferSize);
4294        {Step 7}
4295        FOldBuffer := AllocRecordBuffer;
# Line 3154 | Line 4297 | begin
4297      else
4298        FQSelect.ExecQuery;
4299    finally
4300 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3158 <      Screen.Cursor := crDefault;
4300 >    FBase.RestoreCursor;
4301    end;
4302   end;
4303  
# Line 3163 | Line 4305 | procedure TIBCustomDataSet.InternalPost;
4305   var
4306    Qry: TIBSQL;
4307    Buff: PChar;
3166  SetCursor: Boolean;
4308    bInserting: Boolean;
4309   begin
4310 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3170 <  if SetCursor then
3171 <    Screen.Cursor := crHourGlass;
4310 >  FBase.SetCursor;
4311    try
4312      Buff := GetActiveBuf;
4313      CheckEditState;
# Line 3206 | Line 4345 | begin
4345      if bInserting then
4346        Inc(FRecordCount);
4347    finally
4348 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3210 <      Screen.Cursor := crDefault;
4348 >    FBase.RestoreCursor;
4349    end;
4350   end;
4351  
4352   procedure TIBCustomDataSet.InternalRefresh;
4353   begin
4354 <  inherited;
4354 >  inherited InternalRefresh;
4355    InternalRefreshRow;
4356   end;
4357  
# Line 3227 | Line 4365 | begin
4365    result := FOpen;
4366   end;
4367  
4368 + procedure TIBCustomDataSet.Loaded;
4369 + begin
4370 +  if assigned(FQSelect) then
4371 +    FBaseSQLSelect.assign(FQSelect.SQL);
4372 +  inherited Loaded;
4373 + end;
4374 +
4375 + procedure TIBCustomDataSet.Post;
4376 + var CancelPost: boolean;
4377 + begin
4378 +  CancelPost := false;
4379 +  if assigned(FOnValidatePost) then
4380 +    OnValidatePost(self,CancelPost);
4381 +  if CancelPost then
4382 +    Cancel
4383 +  else
4384 +   inherited Post;
4385 + end;
4386 +
4387   function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4388                                   Options: TLocateOptions): Boolean;
4389   var
4390 <  CurBookmark: string;
4390 >  CurBookmark: TBookmark;
4391   begin
4392    DisableControls;
4393    try
# Line 3248 | Line 4405 | function TIBCustomDataSet.Lookup(const K
4405                                   const ResultFields: string): Variant;
4406   var
4407    fl: TList;
4408 <  CurBookmark: string;
4408 >  CurBookmark: TBookmark;
4409   begin
4410    DisableControls;
4411    fl := TList.Create;
# Line 3301 | Line 4458 | end;
4458   procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4459   var
4460    Buff, TmpBuff: PChar;
4461 +  MappedFieldPos: integer;
4462   begin
4463    Buff := GetActiveBuf;
4464    if Field.FieldNo < 0 then
# Line 3317 | Line 4475 | begin
4475      begin
4476        { If inserting, Adjust record position }
4477        AdjustRecordOnInsert(Buff);
4478 <      if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4479 <         (FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4478 >      MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4479 >      if (MappedFieldPos > 0) and
4480 >         (MappedFieldPos <= rdFieldCount) then
4481 >      with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4482        begin
4483          Field.Validate(Buffer);
4484          if (Buffer = nil) or
4485             (Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4486 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4487 <        else begin
4488 <          Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4489 <                 rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4490 <          if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4491 <             (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4492 <            rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
3333 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4486 >          fdIsNull := True
4487 >        else
4488 >        begin
4489 >          Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4490 >          if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4491 >            fdDataLength := StrLen(PChar(Buffer));
4492 >          fdIsNull := False;
4493            if rdUpdateStatus = usUnmodified then
4494            begin
4495              if CachedUpdates then
# Line 3354 | Line 4513 | begin
4513      end;
4514    end;
4515    if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
4516 <      DataEvent(deFieldChange, Longint(Field));
4516 >      DataEvent(deFieldChange, PtrInt(Field));
4517   end;
4518  
4519   procedure TIBCustomDataSet.SetRecNo(Value: Integer);
# Line 3418 | Line 4577 | begin
4577   FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4578   end;
4579  
4580 + procedure TIBCustomDataSet.ClearIBLinks;
4581 + var i: integer;
4582 + begin
4583 +  for i := FIBLinks.Count - 1 downto 0 do
4584 +    TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4585 + end;
4586 +
4587  
4588   procedure TIBCustomDataSet.InternalUnPrepare;
4589   begin
4590    if FInternalPrepared then
4591    begin
4592      CheckDatasetClosed;
4593 +    if FDidActivate then
4594 +      DeactivateTransaction;
4595      FieldDefs.Clear;
4596 +    FieldDefs.Updated := false;
4597      FInternalPrepared := False;
4598 +    Setlength(FAliasNameList,0);
4599    end;
4600   end;
4601  
4602   procedure TIBCustomDataSet.InternalExecQuery;
4603   var
4604    DidActivate: Boolean;
3435  SetCursor: Boolean;
4605   begin
4606    DidActivate := False;
4607 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3439 <  if SetCursor then
3440 <    Screen.Cursor := crHourGlass;
4607 >  FBase.SetCursor;
4608    try
4609      ActivateConnection;
4610      DidActivate := ActivateTransaction;
# Line 3445 | Line 4612 | begin
4612        IBError(ibxeEmptyQuery, [nil]);
4613      if not FInternalPrepared then
4614        InternalPrepare;
4615 <    if FQSelect.SQLType = SQLSelect then
4615 >    if FQSelect.SQLStatementType = SQLSelect then
4616      begin
4617        IBError(ibxeIsASelectStatement, [nil]);
4618      end
# Line 3454 | Line 4621 | begin
4621    finally
4622      if DidActivate then
4623        DeactivateTransaction;
4624 <    if SetCursor and (Screen.Cursor = crHourGlass) then
4625 <      Screen.Cursor := crDefault;
4624 >    FBase.RestoreCursor;
4625 >  end;
4626 > end;
4627 >
4628 > function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4629 > begin
4630 >  Result := FQSelect.Statement;
4631 > end;
4632 >
4633 > function TIBCustomDataSet.GetParser: TSelectSQLParser;
4634 > begin
4635 >  if not assigned(FParser) then
4636 >    FParser := CreateParser;
4637 >  Result := FParser
4638 > end;
4639 >
4640 > procedure TIBCustomDataSet.ResetParser;
4641 > begin
4642 >  if assigned(FParser) then
4643 >  begin
4644 >    FParser.Free;
4645 >    FParser := nil;
4646 >    FQSelect.OnSQLChanged := nil; {Do not react to change}
4647 >    try
4648 >      FQSelect.SQL.Assign(FBaseSQLSelect);
4649 >    finally
4650 >      FQSelect.OnSQLChanged := SQLChanged;
4651 >    end;
4652    end;
4653   end;
4654  
4655 < function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4655 > function TIBCustomDataSet.HasParser: boolean;
4656   begin
4657 <  Result := FQSelect.Handle;
4657 >  Result := not (csDesigning in ComponentState) and (FParser <> nil)
4658 > end;
4659 >
4660 > procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4661 > begin
4662 >  if FGenerateParamNames = AValue then Exit;
4663 >  FGenerateParamNames := AValue;
4664 >  Disconnect
4665   end;
4666  
4667   procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
# Line 3635 | Line 4835 | begin
4835    Transaction.StartTransaction;
4836   end;
4837  
4838 < function TIBCustomDataSet.PSGetTableName: string;
4838 > function TIBCustomDataSet.PsGetTableName: string;
4839   begin
4840   //  if not FInternalPrepared then
4841   //    InternalPrepare;
# Line 3682 | Line 4882 | begin
4882    ActivateConnection;
4883    ActivateTransaction;
4884    InternalSetParamsFromCursor;
4885 <  Inherited;
4885 >  Inherited InternalOpen;
4886   end;
4887  
4888   procedure TIBDataSet.SetFiltered(Value: Boolean);
# Line 3710 | Line 4910 | end;
4910  
4911   function TIBCustomDataSet.GetFieldData(Field: TField;
4912    Buffer: Pointer): Boolean;
4913 + {$IFDEF TBCDFIELD_IS_BCD}
4914   var
4915    lTempCurr : System.Currency;
4916   begin
# Line 3720 | Line 4921 | begin
4921        CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4922    end
4923    else
4924 + {$ELSE}
4925 + begin
4926 + {$ENDIF}
4927      Result := InternalGetFieldData(Field, Buffer);
4928   end;
4929  
4930   function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
4931    NativeFormat: Boolean): Boolean;
4932   begin
4933 <  if (Field.DataType = ftBCD) and not NativeFormat then
4933 >  {These datatypes use IBX conventions and not TDataset conventions}
4934 >  if (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) and not NativeFormat then
4935      Result := InternalGetFieldData(Field, Buffer)
4936    else
4937      Result := inherited GetFieldData(Field, Buffer, NativeFormat);
4938   end;
4939  
4940   procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4941 + {$IFDEF TDBDFIELD_IS_BCD}
4942   var
4943    lTempCurr : System.Currency;
4944   begin
4945 <  if Field.DataType = ftBCD then
4945 >  if (Field.DataType = ftBCD) and (Buffer <> nil) then
4946    begin
4947      BCDToCurr(TBCD(Buffer^), lTempCurr);
4948      InternalSetFieldData(Field, @lTempCurr);
4949    end
4950    else
4951 + {$ELSE}
4952 + begin
4953 + {$ENDIF}
4954      InternalSetFieldData(Field, Buffer);
4955   end;
4956  
4957   procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
4958    NativeFormat: Boolean);
4959   begin
4960 <  if (not NativeFormat) and (Field.DataType = ftBCD) then
4960 >  {These datatypes use IBX conventions and not TDataset conventions}
4961 >  if (not NativeFormat) and (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) then
4962      InternalSetfieldData(Field, Buffer)
4963    else
4964      inherited SetFieldData(Field, buffer, NativeFormat);
# Line 3765 | Line 4975 | end;
4975   destructor TIBDataSetUpdateObject.Destroy;
4976   begin
4977    FRefreshSQL.Free;
4978 <  inherited destroy;
4978 >  inherited Destroy;
4979   end;
4980  
4981 < procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
4981 > procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
4982   begin
4983    FRefreshSQL.Assign(Value);
4984   end;
4985  
4986 + procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
4987 +  buff: PChar);
4988 + begin
4989 +  if not Assigned(DataSet) then Exit;
4990 +  DataSet.SetInternalSQLParams(Params, buff);
4991 + end;
4992 +
4993 + procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4994 + begin
4995 +  InternalSetParams(Query.Params,buff);
4996 + end;
4997 +
4998 + procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(QryResults: IResults;
4999 +  Buffer: PChar);
5000 + begin
5001 +  if not Assigned(DataSet) then Exit;
5002 +  DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5003 + end;
5004 +
5005 + function TIBDSBlobStream.GetSize: Int64;
5006 + begin
5007 +  Result := FBlobStream.BlobSize;
5008 + end;
5009 +
5010   { TIBDSBlobStream }
5011   constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
5012                                      Mode: TBlobStreamMode);
# Line 3781 | Line 5015 | begin
5015    FBlobStream := ABlobStream;
5016    FBlobStream.Seek(0, soFromBeginning);
5017    if (Mode = bmWrite) then
5018 +  begin
5019      FBlobStream.Truncate;
5020 +    TIBCustomDataSet(FField.DataSet).RecordModified(True);
5021 +    TBlobField(FField).Modified := true;
5022 +    FHasWritten := true;
5023 +  end;
5024 + end;
5025 +
5026 + destructor TIBDSBlobStream.Destroy;
5027 + begin
5028 +  if FHasWritten then
5029 +     TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
5030 +  inherited Destroy;
5031   end;
5032  
5033   function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
# Line 3804 | Line 5050 | begin
5050    if not (FField.DataSet.State in [dsEdit, dsInsert]) then
5051      IBError(ibxeNotEditing, [nil]);
5052    TIBCustomDataSet(FField.DataSet).RecordModified(True);
5053 +  TBlobField(FField).Modified := true;
5054    result := FBlobStream.Write(Buffer, Count);
5055 <  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
5055 >  FHasWritten := true;
5056 > {  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
5057 >  Removed as this caused a seek to beginning of the blob stream thus corrupting
5058 >  the blob stream. Moved to the destructor i.e. called after blob written}
5059 > end;
5060 >
5061 > { TIBGenerator }
5062 >
5063 > procedure TIBGenerator.SetIncrement(const AValue: integer);
5064 > begin
5065 >  if FIncrement = AValue then Exit;
5066 >  if AValue < 0 then
5067 >    IBError(ibxeNegativeGenerator,[]);
5068 >  FIncrement := AValue;
5069 >  SetQuerySQL;
5070 > end;
5071 >
5072 > procedure TIBGenerator.SetTransaction(AValue: TIBTransaction);
5073 > begin
5074 >  FQuery.Transaction := AValue;
5075 > end;
5076 >
5077 > procedure TIBGenerator.SetQuerySQL;
5078 > begin
5079 >  FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5080 > end;
5081 >
5082 > function TIBGenerator.GetDatabase: TIBDatabase;
5083 > begin
5084 >  Result := FQuery.Database;
5085 > end;
5086 >
5087 > function TIBGenerator.GetTransaction: TIBTransaction;
5088 > begin
5089 >  Result := FQuery.Transaction;
5090 > end;
5091 >
5092 > procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5093 > begin
5094 >  FQuery.Database := AValue;
5095 > end;
5096 >
5097 > procedure TIBGenerator.SetGeneratorName(AValue: string);
5098 > begin
5099 >  if FGeneratorName = AValue then Exit;
5100 >  FGeneratorName := AValue;
5101 >  SetQuerySQL;
5102   end;
5103  
5104 + function TIBGenerator.GetNextValue: integer;
5105 + begin
5106 +  with FQuery do
5107 +  begin
5108 +    Transaction.Active := true;
5109 +    ExecQuery;
5110 +    try
5111 +      Result := Fields[0].AsInteger
5112 +    finally
5113 +      Close
5114 +    end;
5115 +  end;
5116 + end;
5117 +
5118 + constructor TIBGenerator.Create(Owner: TIBCustomDataSet);
5119 + begin
5120 +  FOwner := Owner;
5121 +  FIncrement := 1;
5122 +  FQuery := TIBSQL.Create(nil);
5123 + end;
5124 +
5125 + destructor TIBGenerator.Destroy;
5126 + begin
5127 +  if assigned(FQuery) then FQuery.Free;
5128 +  inherited Destroy;
5129 + end;
5130 +
5131 +
5132 + procedure TIBGenerator.Apply;
5133 + begin
5134 +  if assigned(Database) and assigned(Transaction) and
5135 +       (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5136 +    Owner.FieldByName(FFieldName).AsInteger := GetNextValue;
5137 + end;
5138 +
5139 +
5140   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines