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 41 by tony, Sat Jul 16 12:25:48 2016 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

# Line 27 | Line 27
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                                                }
30 > {    Associates Ltd 2011 - 2015                                          }
31   {                                                                        }
32   {************************************************************************}
33  
34   unit IBCustomDataSet;
35  
36 {$IF FPC_FULLVERSION >= 20700 }
37 {$codepage UTF8}
38 {$DEFINE HAS_ANSISTRING_CODEPAGE}
39 {$DEFINE NEW_TBOOKMARK}
40 {$ENDIF}
41
36   {$R-}
37  
38 + {$IFDEF FPC}
39   {$Mode Delphi}
40 + {$codepage UTF8}
41 + {$ENDIF}
42  
43   {$IFDEF DELPHI}
44   {$DEFINE TDBDFIELD_IS_BCD}
# Line 55 | Line 52 | uses
52   {$ELSE}
53    unix,
54   {$ENDIF}
55 <  SysUtils, Classes, IBDatabase, IBExternals, IB, IBHeader,  IBSQL, Db,
56 <  IBUtils, IBBlob, IBSQLParser;
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 77 | Line 74 | type
74      procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
75      procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract;
76      function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
77 <    procedure InternalSetParams(Query: TIBSQL; buff: PChar);
77 >    procedure InternalSetParams(Params: ISQLParams; buff: PChar); overload;
78 >    procedure InternalSetParams(Query: TIBSQL; buff: PChar); overload;
79 >    procedure UpdateRecordFromQuery(UpdateKind: TUpdateKind; QryResults: IResults; Buffer: PChar);
80      property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
81    public
82      constructor Create(AOwner: TComponent); override;
# Line 88 | Line 87 | type
87  
88    TBlobDataArray = array[0..0] of TIBBlobStream;
89    PBlobDataArray = ^TBlobDataArray;
90 +  TIBArrayField = class;
91  
92 <  { TIBCustomDataSet }
93 <  TFieldData = record
94 <    fdDataType: Short;
95 <    fdDataScale: Short;
96 <    fdNullable: Boolean;
97 <    fdIsNull: Boolean;
98 <    fdDataSize: Short;
99 <    fdDataLength: Short;
100 <    fdDataOfs: Integer;
92 >  { TIBArray }
93 >
94 >  {Wrapper class to support array cache in TIBCustomDataset and event handling}
95 >
96 >  TIBArray = class
97 >  private
98 >    FArray: IArray;
99 >    FRecNo: integer;
100 >    FField: TIBArrayField;
101 >    procedure EventHandler(Sender: IArray; Reason: TArrayEventReason);
102 >  public
103 >    constructor Create(aField: TIBArrayField; anArray: IArray);
104 >    destructor Destroy; override;
105 >    property ArrayIntf: IArray read FArray;
106    end;
107 <  PFieldData = ^TFieldData;
107 >
108 >  TArrayDataArray = array [0..0] of TIBArray;
109 >  PArrayDataArray = ^TArrayDataArray;
110 >
111 >  { TIBCustomDataSet }
112  
113    TCachedUpdateStatus = (
114                           cusUnmodified, cusModified, cusInserted,
# Line 110 | 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;
# Line 122 | 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 <    function GetDefaultWidth: Longint; override;
188 >    procedure Bind(Binding: Boolean); override;
189 >    function GetDataSize: Integer; override;
190    public
191      constructor Create(aOwner: TComponent); override;
192      class procedure CheckTypeSize(Value: Integer); override;
# Line 139 | Line 196 | type
196      procedure SetAsString(const Value: string); override;
197      property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
198      property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
199 <    {$IFDEF HAS_ANSISTRING_CODEPAGE}
200 <    private
201 <      FCodePage: TSystemCodePage;
145 <    public
146 <      property CodePage: TSystemCodePage read FCodePage write FCodePage;
147 <    {$ENDIF}
148 <  end;
149 <
150 <  { TIBWideStringField }
151 <
152 <  TIBWideStringField = class(TWideStringField)
153 <  private
154 <    FCharacterSetName: RawByteString;
155 <    FCharacterSetSize: integer;
156 <  public
157 <    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
158 <    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
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 166 | 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 174 | 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}
# Line 189 | Line 272 | type
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;
# Line 200 | Line 284 | type
284     published
285       property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
286                                              write FDisplayTextAsClassName;
203   {$IFDEF HAS_ANSISTRING_CODEPAGE}
287     private
288       FCodePage: TSystemCodePage;
289       FFCodePage: TSystemCodePage;
290     public
291       property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
209   {$ENDIF}
210   end;
211
212   { TIBWideMemoField }
213
214   TIBWideMemoField = class(TWideMemoField)
215   private
216     FCharacterSetName: RawByteString;
217     FCharacterSetSize: integer;
218     FDisplayTextAsClassName: boolean;
219     function GetTruncatedText: string;
220   protected
221     function GetDefaultWidth: Longint; override;
222     procedure GetText(var AText: string; ADisplayText: Boolean); override;
223   public
224     constructor Create(AOwner: TComponent); override;
225     property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
226     property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
227   published
228      property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
229                                             write FDisplayTextAsClassName;
292     end;
293  
294    TIBDataLink = class(TDetailDataLink)
# Line 253 | Line 315 | type
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(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
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 FGeneratorName;
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;
# Line 284 | Line 356 | type
356    TIBAutoCommit = (acDisabled, acCommitRetaining);
357  
358    { TIBCustomDataSet }
359 +
360    TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
361  
362    TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
# Line 298 | Line 371 | type
371  
372    TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
373  
374 +  TOnDeleteReturning = procedure (Sender: TObject; QryResults: IResults) of object;
375 +
376    TIBCustomDataSet = class(TDataset)
377    private
378 +    FAllowAutoActivateTransaction: Boolean;
379 +    FArrayFieldCount: integer;
380 +    FArrayCacheOffset: integer;
381      FAutoCommit: TIBAutoCommit;
382      FGenerateParamNames: Boolean;
383      FGeneratorField: TIBGenerator;
384      FNeedsRefresh: Boolean;
385      FForcedRefresh: Boolean;
386      FDidActivate: Boolean;
309    FIBLoaded: Boolean;
387      FBase: TIBBase;
388      FBlobCacheOffset: Integer;
389      FBlobStreamList: TList;
390 +    FArrayList: TList;
391      FBufferChunks: Integer;
392      FBufferCache,
393      FOldBufferCache: PChar;
# Line 327 | Line 405 | type
405      FDeletedRecords: Long;
406      FModelBuffer,
407      FOldBuffer: PChar;
408 +    FOnDeleteReturning: TOnDeleteReturning;
409      FOnValidatePost: TOnValidatePost;
410      FOpen: Boolean;
411      FInternalPrepared: Boolean;
# Line 335 | Line 414 | type
414      FQRefresh,
415      FQSelect,
416      FQModify: TIBSQL;
417 +    FDatabaseInfo: TIBDatabaseInfo;
418      FRecordBufferSize: Integer;
419      FRecordCount: Integer;
420      FRecordSize: Integer;
# Line 363 | Line 443 | type
443      FCloseAction: TTransactionAction;
444      FInTransactionEnd: boolean;
445      FIBLinks: TList;
446 <    function GetSelectStmtHandle: TISC_STMT_HANDLE;
446 >    FFieldColumns: PFieldColumns;
447 >    FBufferUpdatedOnQryReturn: boolean;
448 >    procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex,
449 >      FieldIndex: integer; Buffer: PChar);
450 >    procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
451 >    function GetSelectStmtIntf: IStatement;
452      procedure SetUpdateMode(const Value: TUpdateMode);
453      procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
454  
# Line 375 | Line 460 | type
460      function CanRefresh: Boolean;
461      procedure CheckEditState;
462      procedure ClearBlobCache;
463 +    procedure ClearArrayCache;
464      procedure ClearIBLinks;
465      procedure CopyRecordBuffer(Source, Dest: Pointer);
466      procedure DoBeforeDatabaseDisconnect(Sender: TObject);
# Line 383 | Line 469 | type
469      procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
470      procedure DoAfterTransactionEnd(Sender: TObject);
471      procedure DoTransactionFree(Sender: TObject);
472 +    procedure DoDeleteReturning(QryResults: IResults);
473      procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
474                                           Buffer: PChar);
475      function GetDatabase: TIBDatabase;
389    function GetDBHandle: PISC_DB_HANDLE;
476      function GetDeleteSQL: TStrings;
477      function GetInsertSQL: TStrings;
478 <    function GetSQLParams: TIBXSQLDA;
478 >    function GetSQLParams: ISQLParams;
479      function GetRefreshSQL: TStrings;
480      function GetSelectSQL: TStrings;
481 <    function GetStatementType: TIBSQLTypes;
481 >    function GetStatementType: TIBSQLStatementTypes;
482      function GetModifySQL: TStrings;
483      function GetTransaction: TIBTransaction;
398    function GetTRHandle: PISC_TR_HANDLE;
484      function GetParser: TSelectSQLParser;
485      procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
486      function InternalLocate(const KeyFields: string; const KeyValues: Variant;
# Line 410 | Line 495 | type
495      procedure SetDatabase(Value: TIBDatabase);
496      procedure SetDeleteSQL(Value: TStrings);
497      procedure SetInsertSQL(Value: TStrings);
498 <    procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
498 >    procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
499      procedure SetRefreshSQL(Value: TStrings);
500      procedure SetSelectSQL(Value: TStrings);
501      procedure SetModifySQL(Value: TStrings);
502      procedure SetTransaction(Value: TIBTransaction);
503      procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
504      procedure SetUniDirectional(Value: Boolean);
505 +    procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
506      procedure RefreshParams;
507      function AdjustPosition(FCache: PChar; Offset: DWORD;
508                              Origin: Integer): DWORD;
# Line 450 | Line 536 | type
536      procedure SQLChanging(Sender: TObject); virtual;
537      procedure SQLChanged(Sender: TObject); virtual;
538  
539 < (*    { IProviderSupport }
539 >    { IProviderSupport }
540      procedure PSEndTransaction(Commit: Boolean); override;
541      function PSExecuteStatement(const ASQL: string; AParams: TParams;
542        ResultSet: Pointer = nil): Integer; override;
# Line 463 | Line 549 | type
549      procedure PSStartTransaction; override;
550      procedure PSReset; override;
551      function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
552 < *)
552 >
553      { TDataSet support }
554      procedure InternalInsert; override;
555      procedure InitRecord(Buffer: PChar); override;
# Line 527 | Line 613 | type
613    protected
614      {Likely to be made public by descendant classes}
615      property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
616 <    property SQLParams: TIBXSQLDA read GetSQLParams;
617 <    property Params: TIBXSQLDA read GetSQLParams;
616 >    property SQLParams: ISQLParams read GetSQLParams;
617 >    property Params: ISQLParams read GetSQLParams;
618      property InternalPrepared: Boolean read FInternalPrepared;
619      property QDelete: TIBSQL read FQDelete;
620      property QInsert: TIBSQL read FQInsert;
621      property QRefresh: TIBSQL read FQRefresh;
622      property QSelect: TIBSQL read FQSelect;
623      property QModify: TIBSQL read FQModify;
624 <    property StatementType: TIBSQLTypes read GetStatementType;
625 <    property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
624 >    property StatementType: TIBSQLStatementTypes read GetStatementType;
625 >    property SelectStmtHandle: IStatement read GetSelectStmtIntf;
626  
627      {Likely to be made published by descendant classes}
628      property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
# Line 587 | Line 673 | type
673      function BookmarkValid(Bookmark: TBookmark): Boolean; override;
674      function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
675      function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
676 +    function GetArray(Field: TIBArrayField): IArray;
677 +    procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
678      function GetCurrentRecord(Buffer: PChar): Boolean; override;
679      function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
680      function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
# Line 600 | Line 688 | type
688      function UpdateStatus: TUpdateStatus; override;
689      function IsSequenced: Boolean; override;
690      procedure Post; override;
691 <    function ParamByName(ParamName: String): TIBXSQLVAR;
692 <    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
693 <    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
691 >    function ParamByName(ParamName: String): ISQLParam;
692 >    property ArrayFieldCount: integer read FArrayFieldCount;
693 >    property DatabaseInfo: TIBDatabaseInfo read FDatabaseInfo;
694      property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
695      property UpdatesPending: Boolean read FUpdatesPending;
696      property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
# Line 611 | Line 699 | type
699                 read FDataSetCloseAction write FDataSetCloseAction;
700  
701    published
702 +    property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
703 +                 write FAllowAutoActivateTransaction;
704      property Database: TIBDatabase read GetDatabase write SetDatabase;
705      property Transaction: TIBTransaction read GetTransaction
706                                            write SetTransaction;
# Line 645 | Line 735 | type
735                                                   write FOnUpdateError;
736      property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord
737                                                     write FOnUpdateRecord;
738 +    property OnDeleteReturning: TOnDeleteReturning read FOnDeleteReturning
739 +                                                   write FOnDeleteReturning;
740    end;
741  
742    TIBParserDataSet = class(TIBCustomDataSet)
# Line 731 | Line 823 | type
823      property OnNewRecord;
824      property OnPostError;
825      property OnValidatePost;
826 +    property OnDeleteReturning;
827    end;
828  
829    { TIBDSBlobStream }
# Line 751 | Line 844 | type
844      function Write(const Buffer; Count: Longint): Longint; override;
845    end;
846  
847 +  {Extended Field Def for character set info}
848 +
849 +  { TIBFieldDef }
850 +
851 +  TIBFieldDef = class(TFieldDef)
852 +  private
853 +    FArrayBounds: TArrayBounds;
854 +    FArrayDimensions: integer;
855 +    FCharacterSetName: RawByteString;
856 +    FCharacterSetSize: integer;
857 +    FCodePage: TSystemCodePage;
858 +    FIdentityColumn: boolean;
859 +    FRelationName: string;
860 +    FDataSize: integer;
861 +  published
862 +    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
863 +    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
864 +    property CodePage: TSystemCodePage read FCodePage write FCodePage;
865 +    property DataSize: integer read FDataSize write FDataSize;
866 +    property RelationName: string read FRelationName write FRelationName;
867 +    property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
868 +    property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
869 +    property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false;
870 +  end;
871 +
872   const
873   DefaultFieldClasses: array[TFieldType] of TFieldClass = (
874      nil,                { ftUnknown }
875      TIBStringField,     { ftString }
876 <    TSmallintField,     { ftSmallint }
877 <    TIntegerField,      { ftInteger }
876 >    TIBSmallintField,   { ftSmallint }
877 >    TIBIntegerField,      { ftInteger }
878      TWordField,         { ftWord }
879      TBooleanField,      { ftBoolean }
880      TFloatField,        { ftFloat }
# Line 777 | Line 895 | DefaultFieldClasses: array[TFieldType] o
895      TBlobField,         { ftTypedBinary }
896      nil,                { ftCursor }
897      TStringField,       { ftFixedChar }
898 <    TIBWideStringField,    { ftWideString }
899 <    TLargeIntField,     { ftLargeInt }
898 >    nil,    { ftWideString }
899 >    TIBLargeIntField,     { ftLargeInt }
900      nil,          { ftADT }
901 <    nil,        { ftArray }
901 >    TIBArrayField,        { ftArray }
902      nil,    { ftReference }
903      nil,     { ftDataSet }
904      TBlobField,         { ftOraBlob }
# Line 792 | Line 910 | DefaultFieldClasses: array[TFieldType] o
910      TDateTimeField,    {ftTimestamp}
911      TIBBCDField,       {ftFMTBcd}
912      nil,  {ftFixedWideChar}
913 <    TIBWideMemoField);   {ftWideMemo}
913 >    nil);   {ftWideMemo}
914   (*
915      TADTField,          { ftADT }
916      TArrayField,        { ftArray }
# Line 809 | Line 927 | DefaultFieldClasses: array[TFieldType] o
927  
928   implementation
929  
930 < uses IBIntf, Variants, FmtBCD, LazUTF8;
930 > uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
931  
932   const FILE_BEGIN = 0;
933        FILE_CURRENT = 1;
# Line 822 | Line 940 | type
940      FieldName : String;
941      COMPUTED_BLR : Boolean;
942      DEFAULT_VALUE : boolean;
943 +    IDENTITY_COLUMN : boolean;
944      NextField : TFieldNode;
945    end;
946  
# Line 832 | Line 951 | type
951      NextRelation : TRelationNode;
952    end;
953  
835  {Extended Field Def for character set info}
836
837  { TIBFieldDef }
838
839  TIBFieldDef = class(TFieldDef)
840  private
841    FCharacterSetName: RawByteString;
842    FCharacterSetSize: integer;
843    {$IFDEF HAS_ANSISTRING_CODEPAGE}
844    FCodePage: TSystemCodePage;
845    {$ENDIF}
846  published
847    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
848    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
849    {$IFDEF HAS_ANSISTRING_CODEPAGE}
850    property CodePage: TSystemCodePage read FCodePage write FCodePage;
851    {$ENDIF}
852  end;
853
954  
955    {  Copied from LCLProc in order to avoid LCL dependency
956  
# Line 893 | Line 993 | type
993      Result := str;
994    end;
995  
996 < { TIBWideMemoField }
996 > { TIBLargeIntField }
997  
998 < function TIBWideMemoField.GetTruncatedText: string;
998 > procedure TIBLargeIntField.Bind(Binding: Boolean);
999   begin
1000 <  Result := GetAsString;
1000 >  inherited Bind(Binding);
1001 >  if Binding and (FieldDef <> nil) then
1002 >     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1003 > end;
1004  
1005 <  if Result <> '' then
1006 <    if DisplayWidth = 0 then
1007 <      Result := TextToSingleLine(Result)
1008 <    else
1009 <    if Length(Result) > DisplayWidth then {Show truncation with elipses}
1010 <      Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
1005 > { TIBIntegerField }
1006 >
1007 > procedure TIBIntegerField.Bind(Binding: Boolean);
1008 > begin
1009 >  inherited Bind(Binding);
1010 >  if Binding and (FieldDef <> nil) then
1011 >     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1012   end;
1013  
1014 < function TIBWideMemoField.GetDefaultWidth: Longint;
1014 > { TIBSmallintField }
1015 >
1016 > procedure TIBSmallintField.Bind(Binding: Boolean);
1017   begin
1018 <  Result := 128;
1018 >  inherited Bind(Binding);
1019 >  if Binding and (FieldDef <> nil) then
1020 >     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1021   end;
1022  
1023 < procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
1023 > { TIBArray }
1024 >
1025 > procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
1026   begin
1027 <  if ADisplayText then
1027 >  case Reason of
1028 >  arChanging:
1029 >    if FRecNo <> FField.Dataset.RecNo then
1030 >      IBError(ibxeNotCurrentArray,[nil]);
1031 >
1032 >  arChanged:
1033 >    FField.DataChanged;
1034 >  end;
1035 > end;
1036 >
1037 > constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
1038 > begin
1039 >  inherited Create;
1040 >  FField := aField;
1041 >  FArray := anArray;
1042 >  FRecNo := FField.Dataset.RecNo;
1043 >  FArray.AddEventHandler(EventHandler);
1044 > end;
1045 >
1046 > destructor TIBArray.Destroy;
1047 > begin
1048 >  FArray.RemoveEventHandler(EventHandler);
1049 >  inherited Destroy;
1050 > end;
1051 >
1052 > { TIBArrayField }
1053 >
1054 > function TIBArrayField.GetArrayIntf: IArray;
1055 > begin
1056 >  Result := TIBCustomDataSet(DataSet).GetArray(self);
1057 > end;
1058 >
1059 > function TIBArrayField.GetArrayID: TISC_QUAD;
1060 > begin
1061 >  GetData(@Result);
1062 > end;
1063 >
1064 > procedure TIBArrayField.SetArrayIntf(AValue: IArray);
1065 > begin
1066 >  TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
1067 >  DataChanged;
1068 > end;
1069 >
1070 > class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
1071 > begin
1072 >  //Ignore
1073 > end;
1074 >
1075 > function TIBArrayField.GetAsString: string;
1076 > begin
1077 >  Result := '(Array)';
1078 > end;
1079 >
1080 > function TIBArrayField.GetDataSize: Integer;
1081 > begin
1082 >  Result := sizeof(TISC_QUAD);
1083 > end;
1084 >
1085 > procedure TIBArrayField.Bind(Binding: Boolean);
1086 > begin
1087 >  inherited Bind(Binding);
1088 >  if Binding then
1089    begin
1090 <    if not DisplayTextAsClassName and (CharacterSetName<> '') then
1091 <      AText := GetTruncatedText
1092 <    else
1093 <      inherited GetText(AText, ADisplayText);
1094 <  end
1095 <  else
1096 <    AText := GetAsString;
1090 >    FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
1091 >    Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
1092 >    if FieldDef <> nil then
1093 >    begin
1094 >      FRelationName := TIBFieldDef(FieldDef).FRelationName;
1095 >      FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
1096 >      FArrayBounds :=  TIBFieldDef(FieldDef).ArrayBounds;
1097 >    end;
1098 >  end;
1099   end;
1100  
1101 < constructor TIBWideMemoField.Create(AOwner: TComponent);
1101 > constructor TIBArrayField.Create(AOwner: TComponent);
1102   begin
1103    inherited Create(AOwner);
1104 <  BlobType := ftWideMemo;
1104 >  SetDataType(ftArray);
1105 > end;
1106 >
1107 > function TIBArrayField.CreateArray: IArray;
1108 > begin
1109 > with DataSet as TIBCustomDataSet do
1110 >  Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1111   end;
1112  
1113   { TIBMemoField }
# Line 950 | Line 1129 | begin
1129         {2: case 2 ignored. This should be handled by TIBWideMemo}
1130  
1131         3, {Assume UNICODE_FSS is really UTF8}
1132 <       4: {Include GB18030 - assuming UTF8 routine work for this codeset}
1132 >       4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1133           if DisplayWidth = 0 then
1134             Result := ValidUTF8String(TextToSingleLine(Result))
1135           else
# Line 960 | Line 1139 | begin
1139     end
1140   end;
1141  
1142 + procedure TIBMemoField.Bind(Binding: Boolean);
1143 + var IBFieldDef: TIBFieldDef;
1144 + begin
1145 +  inherited Bind(Binding);
1146 +  if Binding and (FieldDef <> nil) then
1147 +  begin
1148 +    IBFieldDef := FieldDef as TIBFieldDef;
1149 +    CharacterSetSize := IBFieldDef.CharacterSetSize;
1150 +    CharacterSetName := IBFieldDef.CharacterSetName;
1151 +    CodePage := IBFieldDef.CodePage;
1152 +  end;
1153 + end;
1154 +
1155   function TIBMemoField.GetAsString: string;
1156   var s: RawByteString;
1157   begin
1158    s := inherited GetAsString;
967  {$IFDEF HAS_ANSISTRING_CODEPAGE}
1159    SetCodePage(s,CodePage,false);
1160 <  {$ENDIF}
1160 >  if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1161 >    SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1162    Result := s;
1163   end;
1164  
# Line 995 | Line 1187 | procedure TIBMemoField.SetAsString(const
1187   var s: RawByteString;
1188   begin
1189    s := AValue;
1190 <  {$IFDEF HAS_ANSISTRING_CODEPAGE}
1191 <  if StringCodePage(Value) <> CodePage then
1000 <    SetCodePage(s,CodePage,true);
1001 <  {$ENDIF}
1190 >  if StringCodePage(s) <> CodePage then
1191 >    SetCodePage(s,CodePage,CodePage<>CP_NONE);
1192    inherited SetAsString(s);
1193   end;
1194  
# Line 1006 | Line 1196 | constructor TIBMemoField.Create(AOwner:
1196   begin
1197    inherited Create(AOwner);
1198    BlobType := ftMemo;
1009  {$IFDEF HAS_ANSISTRING_CODEPAGE}
1199    FCodePage := CP_NONE;
1011  {$ENDIF}
1200   end;
1201  
1202   { TIBControlLink }
# Line 1042 | Line 1230 | end;
1230  
1231   { TIBStringField}
1232  
1233 < function TIBStringField.GetDefaultWidth: Longint;
1233 > procedure TIBStringField.Bind(Binding: Boolean);
1234 > var IBFieldDef: TIBFieldDef;
1235 > begin
1236 >  inherited Bind(Binding);
1237 >  if Binding and (FieldDef <> nil) then
1238 >  begin
1239 >    IBFieldDef := FieldDef as TIBFieldDef;
1240 >    CharacterSetSize := IBFieldDef.CharacterSetSize;
1241 >    CharacterSetName := IBFieldDef.CharacterSetName;
1242 >    FDataSize := IBFieldDef.DataSize + 1;
1243 >    if AutoFieldSize then
1244 >      Size := IBFieldDef.Size;
1245 >    CodePage := IBFieldDef.CodePage;
1246 >  end;
1247 > end;
1248 >
1249 > function TIBStringField.GetDataSize: Integer;
1250   begin
1251 <  Result := Size div CharacterSetSize;
1251 >  Result := FDataSize;
1252   end;
1253  
1254   constructor TIBStringField.Create(aOwner: TComponent);
1255   begin
1256    inherited Create(aOwner);
1257    FCharacterSetSize := 1;
1054  {$IFDEF HAS_ANSISTRING_CODEPAGE}
1258    FCodePage := CP_NONE;
1259 <  {$ENDIF}
1259 >  FAutoFieldSize := true;
1260   end;
1261  
1262   class procedure TIBStringField.CheckTypeSize(Value: Integer);
# Line 1079 | Line 1282 | var
1282    s: RawByteString;
1283   begin
1284    Buffer := nil;
1285 <  IBAlloc(Buffer, 0, Size + 1);
1285 >  IBAlloc(Buffer, 0, DataSize);
1286    try
1287      Result := GetData(Buffer);
1288      if Result then
1289      begin
1290 <      {$IFDEF HAS_ANSISTRING_CODEPAGE}
1088 <      s := string(Buffer);
1290 >      s := strpas(Buffer);
1291        SetCodePage(s,CodePage,false);
1292 +      if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1293 +        SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1294        Value := s;
1295   //      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1092      {$ELSE}
1093      Value := string(Buffer);
1094      {$ENDIF}
1296        if Transliterate and (Value <> '') then
1297          DataSet.Translate(PChar(Value), PChar(Value), False);
1298      end
# Line 1106 | Line 1307 | var
1307    s: RawByteString;
1308   begin
1309    Buffer := nil;
1310 <  IBAlloc(Buffer, 0, Size + 1);
1310 >  IBAlloc(Buffer, 0, DataSize);
1311    try
1312      s := Value;
1112    {$IFDEF HAS_ANSISTRING_CODEPAGE}
1313      if StringCodePage(s) <> CodePage then
1314 <      SetCodePage(s,CodePage,true);
1315 <    {$ENDIF}
1116 <    StrLCopy(Buffer, PChar(s), Size);
1314 >      SetCodePage(s,CodePage,CodePage<>CP_NONE);
1315 >    StrLCopy(Buffer, PChar(s), DataSize-1);
1316      if Transliterate then
1317        DataSet.Translate(Buffer, Buffer, True);
1318      SetData(Buffer);
# Line 1132 | Line 1331 | begin
1331    Size := 8;
1332   end;
1333  
1334 + procedure TIBBCDField.Bind(Binding: Boolean);
1335 + begin
1336 +  inherited Bind(Binding);
1337 +  if Binding and (FieldDef <> nil) then
1338 +     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1339 + end;
1340 +
1341   class procedure TIBBCDField.CheckTypeSize(Value: Integer);
1342   begin
1343   { No need to check as the base type is currency, not BCD }
# Line 1216 | Line 1422 | end;
1422   constructor TIBCustomDataSet.Create(AOwner: TComponent);
1423   begin
1424    inherited Create(AOwner);
1219  FIBLoaded := False;
1220  CheckIBLoaded;
1221  FIBLoaded := True;
1425    FBase := TIBBase.Create(Self);
1426 +  FDatabaseInfo := TIBDatabaseInfo.Create(self);
1427    FIBLinks := TList.Create;
1428    FCurrentRecord := -1;
1429    FDeletedRecords := 0;
1430    FUniDirectional := False;
1431    FBufferChunks := BufferCacheSize;
1432    FBlobStreamList := TList.Create;
1433 +  FArrayList := TList.Create;
1434    FGeneratorField := TIBGenerator.Create(self);
1435    FDataLink := TIBDataLink.Create(Self);
1436    FQDelete := TIBSQL.Create(Self);
# Line 1269 | Line 1474 | end;
1474   destructor TIBCustomDataSet.Destroy;
1475   begin
1476    if Active then Active := false;
1477 <  if FIBLoaded then
1478 <  begin
1479 <    if assigned(FGeneratorField) then FGeneratorField.Free;
1480 <    FDataLink.Free;
1481 <    FBase.Free;
1482 <    ClearBlobCache;
1483 <    ClearIBLinks;
1484 <    FIBLinks.Free;
1485 <    FBlobStreamList.Free;
1486 <    FreeMem(FBufferCache);
1487 <    FBufferCache := nil;
1488 <    FreeMem(FOldBufferCache);
1489 <    FOldBufferCache := nil;
1490 <    FCacheSize := 0;
1491 <    FOldCacheSize := 0;
1287 <    FMappedFieldPosition := nil;
1288 <  end;
1477 >  if assigned(FGeneratorField) then FGeneratorField.Free;
1478 >  FDataLink.Free;
1479 >  FBase.Free;
1480 >  ClearBlobCache;
1481 >  ClearIBLinks;
1482 >  FIBLinks.Free;
1483 >  FBlobStreamList.Free;
1484 >  FArrayList.Free;
1485 >  FreeMem(FBufferCache);
1486 >  FBufferCache := nil;
1487 >  FreeMem(FOldBufferCache);
1488 >  FOldBufferCache := nil;
1489 >  FCacheSize := 0;
1490 >  FOldCacheSize := 0;
1491 >  FMappedFieldPosition := nil;
1492    if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1493    if assigned(FParser) then FParser.Free;
1494    inherited Destroy;
# Line 1310 | Line 1513 | begin
1513        Inc(FCurrentRecord);
1514        if (FCurrentRecord = FRecordCount) then
1515        begin
1516 <        if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1516 >        if (not FQSelect.EOF) and FQSelect.Next  then
1517          begin
1518            FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1519            Inc(FRecordCount);
# Line 1329 | Line 1532 | end;
1532  
1533   procedure TIBCustomDataSet.ApplyUpdates;
1534   var
1332  {$IFDEF NEW_TBOOKMARK }
1535    CurBookmark: TBookmark;
1334  {$ELSE}
1335  CurBookmark: string;
1336  {$ENDIF}
1536    Buffer: PRecordData;
1537    CurUpdateTypes: TIBUpdateRecordTypes;
1538    UpdateAction: TIBUpdateAction;
# Line 1564 | Line 1763 | end;
1763   function TIBCustomDataSet.ActivateTransaction: Boolean;
1764   begin
1765    Result := False;
1766 <  if not Assigned(Transaction) then
1568 <    IBError(ibxeTransactionNotAssigned, [nil]);
1569 <  if not Transaction.Active then
1766 >  if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1767    begin
1768 <    Result := True;
1769 <    Transaction.StartTransaction;
1770 <    FDidActivate := True;
1768 >    if not Assigned(Transaction) then
1769 >      IBError(ibxeTransactionNotAssigned, [nil]);
1770 >    if not Transaction.Active then
1771 >    begin
1772 >      Result := True;
1773 >      Transaction.StartTransaction;
1774 >      FDidActivate := True;
1775 >    end;
1776    end;
1777   end;
1778  
# Line 1695 | Line 1897 | begin
1897    FBlobStreamList.Pack;
1898   end;
1899  
1900 + procedure TIBCustomDataSet.ClearArrayCache;
1901 + var
1902 +  i: Integer;
1903 + begin
1904 +  for i := 0 to FArrayList.Count - 1 do
1905 +  begin
1906 +    TIBArray(FArrayList[i]).Free;
1907 +    FArrayList[i] := nil;
1908 +  end;
1909 +  FArrayList.Pack;
1910 + end;
1911 +
1912   procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1913   begin
1914    Move(Source^, Dest^, FRecordBufferSize);
# Line 1704 | Line 1918 | procedure TIBCustomDataSet.DoBeforeDatab
1918   begin
1919    if Active then
1920      Active := False;
1921 <  FInternalPrepared := False;
1921 >  InternalUnPrepare;
1922    if Assigned(FBeforeDatabaseDisconnect) then
1923      FBeforeDatabaseDisconnect(Sender);
1924   end;
# Line 1742 | Line 1956 | begin
1956      FQModify.FreeHandle;
1957    if FQRefresh <> nil then
1958      FQRefresh.FreeHandle;
1959 +  InternalUnPrepare;
1960    if Assigned(FBeforeTransactionEnd) then
1961      FBeforeTransactionEnd(Sender);
1962   end;
# Line 1758 | Line 1973 | begin
1973      FTransactionFree(Sender);
1974   end;
1975  
1976 < { Read the record from FQSelect.Current into the record buffer
1977 <  Then write the buffer to in memory cache }
1978 < procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1979 <  RecordNumber: Integer; Buffer: PChar);
1980 < var
1981 <  p: PRecordData;
1982 <  pbd: PBlobDataArray;
1983 <  i, j: Integer;
1984 <  LocalData: Pointer;
1985 <  LocalDate, LocalDouble: Double;
1986 <  LocalInt: Integer;
1772 <  LocalBool: wordBool;
1773 <  LocalInt64: Int64;
1774 <  LocalCurrency: Currency;
1775 <  FieldsLoaded: Integer;
1776 <  temp: TIBXSQLVAR;
1976 > procedure TIBCustomDataSet.DoDeleteReturning(QryResults: IResults);
1977 > begin
1978 >  if assigned(FOnDeleteReturning) then
1979 >     OnDeleteReturning(self,QryResults);
1980 > end;
1981 >
1982 > procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1983 > var i, j: Integer;
1984 >    FieldsLoaded: integer;
1985 >    p: PRecordData;
1986 >    colMetadata: IColumnMetaData;
1987   begin
1988    p := PRecordData(Buffer);
1779  { Make sure blob cache is empty }
1780  pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1781  if RecordNumber > -1 then
1782    for i := 0 to BlobFieldCount - 1 do
1783      pbd^[i] := nil;
1989    { Get record information }
1990    p^.rdBookmarkFlag := bfCurrent;
1991 <  p^.rdFieldCount := Qry.Current.Count;
1992 <  p^.rdRecordNumber := RecordNumber;
1991 >  p^.rdFieldCount := Qry.FieldCount;
1992 >  p^.rdRecordNumber := -1;
1993    p^.rdUpdateStatus := usUnmodified;
1994    p^.rdCachedUpdateStatus := cusUnmodified;
1995    p^.rdSavedOffset := $FFFFFFFF;
1996  
1997    { Load up the fields }
1998 <  FieldsLoaded := FQSelect.Current.Count;
1998 >  FieldsLoaded := FQSelect.MetaData.Count;
1999    j := 1;
2000 <  for i := 0 to Qry.Current.Count - 1 do
2000 >  for i := 0 to Qry.MetaData.Count - 1 do
2001    begin
2002      if (Qry = FQSelect) then
2003        j := i + 1
2004 <    else begin
2004 >    else
2005 >    begin
2006        if FieldsLoaded = 0 then
2007          break;
2008 <      j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
2008 >      j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2009        if j < 1 then
2010          continue
2011        else
2012          Dec(FieldsLoaded);
2013      end;
2014 <    with FQSelect.Current[j - 1].Data^ do
1809 <      if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
1810 <      begin
1811 <        if sqllen <= 8 then
1812 <          p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
1813 <        continue;
1814 <      end;
1815 <    if j > 0 then with p^ do
2014 >    if j > 0 then
2015      begin
2016 <      rdFields[j].fdDataType :=
2017 <        Qry.Current[i].Data^.sqltype and (not 1);
2018 <      rdFields[j].fdDataScale :=
2019 <        Qry.Current[i].Data^.sqlscale;
2020 <      rdFields[j].fdNullable :=
2021 <        (Qry.Current[i].Data^.sqltype and 1 = 1);
2022 <      rdFields[j].fdIsNull :=
2023 <        (rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
2024 <      LocalData := Qry.Current[i].Data^.sqldata;
2025 <      case rdFields[j].fdDataType of
2026 <        SQL_TIMESTAMP:
2016 >      colMetadata := Qry.MetaData[i];
2017 >      with p^.rdFields[j], FFieldColumns^[j] do
2018 >      begin
2019 >        fdDataType := colMetadata.GetSQLType;
2020 >        if fdDataType = SQL_BLOB then
2021 >          fdDataScale := 0
2022 >        else
2023 >          fdDataScale := colMetadata.getScale;
2024 >        fdNullable := colMetadata.getIsNullable;
2025 >        fdIsNull := true;
2026 >        fdDataSize := colMetadata.GetSize;
2027 >        fdDataLength := 0;
2028 >        fdCodePage := CP_NONE;
2029 >
2030 >        case fdDataType of
2031 >        SQL_TIMESTAMP,
2032 >        SQL_TYPE_DATE,
2033 >        SQL_TYPE_TIME:
2034 >          fdDataSize := SizeOf(TDateTime);
2035 >        SQL_SHORT, SQL_LONG:
2036          begin
2037 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
2038 <          if RecordNumber >= 0 then
2039 <            LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
2040 <          LocalData := PChar(@LocalDate);
2037 >          if (fdDataScale = 0) then
2038 >            fdDataSize := SizeOf(Integer)
2039 >          else
2040 >          if (fdDataScale >= (-4)) then
2041 >            fdDataSize := SizeOf(Currency)
2042 >          else
2043 >            fdDataSize := SizeOf(Double);
2044          end;
2045 <        SQL_TYPE_DATE:
2045 >        SQL_INT64:
2046          begin
2047 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
2048 <          if RecordNumber >= 0 then
2049 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
2050 <          LocalData := PChar(@LocalInt);
2047 >          if (fdDataScale = 0) then
2048 >            fdDataSize := SizeOf(Int64)
2049 >          else
2050 >          if (fdDataScale >= (-4)) then
2051 >            fdDataSize := SizeOf(Currency)
2052 >          else
2053 >            fdDataSize := SizeOf(Double);
2054          end;
2055 <        SQL_TYPE_TIME:
2055 >        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2056 >          fdDataSize := SizeOf(Double);
2057 >        SQL_BOOLEAN:
2058 >          fdDataSize := SizeOf(wordBool);
2059 >        SQL_VARYING,
2060 >        SQL_TEXT,
2061 >        SQL_BLOB:
2062 >          fdCodePage := Qry.Metadata[i].getCodePage;
2063 >        end;
2064 >        fdDataOfs := FRecordSize;
2065 >        Inc(FRecordSize, fdDataSize);
2066 >      end;
2067 >    end;
2068 >  end;
2069 > end;
2070 >
2071 > {Update Buffer Fields from Query Results}
2072 >
2073 > procedure TIBCustomDataSet.UpdateRecordFromQuery(QryResults: IResults;
2074 >  Buffer: PChar);
2075 > var i, j: integer;
2076 > begin
2077 >  for i := 0 to QryResults.Count - 1 do
2078 >  begin
2079 >    j := GetFieldPosition(QryResults[i].GetAliasName);
2080 >    if j > 0 then
2081 >    begin
2082 >      ColumnDataToBuffer(QryResults,i,j,Buffer);
2083 >      FBufferUpdatedOnQryReturn := true;
2084 >    end;
2085 >  end;
2086 > end;
2087 >
2088 >
2089 > {Move column data returned from query to row buffer}
2090 >
2091 > procedure TIBCustomDataSet.ColumnDataToBuffer(QryResults: IResults;
2092 >               ColumnIndex, FieldIndex: integer; Buffer: PChar);
2093 > var
2094 >  LocalData: PByte;
2095 >  LocalDate: TDateTime;
2096 >  LocalDouble: Double;
2097 >  LocalInt: Integer;
2098 >  LocalBool: wordBool;
2099 >  LocalInt64: Int64;
2100 >  LocalCurrency: Currency;
2101 >  ColData: ISQLData;
2102 > begin
2103 >  LocalData := nil;
2104 >  with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2105 >  begin
2106 >    QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData);
2107 >    if not fdIsNull then
2108 >    begin
2109 >      ColData := QryResults[ColumnIndex];
2110 >      case fdDataType of  {Get Formatted data for column types that need formatting}
2111 >        SQL_TYPE_DATE,
2112 >        SQL_TYPE_TIME,
2113 >        SQL_TIMESTAMP:
2114          begin
2115 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
2116 <          if RecordNumber >= 0 then
2117 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1846 <          LocalData := PChar(@LocalInt);
2115 >          {This is an IBX native format and not the TDataset approach. See also GetFieldData}
2116 >          LocalDate := ColData.AsDateTime;
2117 >          LocalData := PByte(@LocalDate);
2118          end;
2119          SQL_SHORT, SQL_LONG:
2120          begin
2121 <          if (rdFields[j].fdDataScale = 0) then
2121 >          if (fdDataScale = 0) then
2122            begin
2123 <            rdFields[j].fdDataSize := SizeOf(Integer);
2124 <            if RecordNumber >= 0 then
1854 <              LocalInt := Qry.Current[i].AsLong;
1855 <            LocalData := PChar(@LocalInt);
2123 >            LocalInt := ColData.AsLong;
2124 >            LocalData := PByte(@LocalInt);
2125            end
2126 <          else if (rdFields[j].fdDataScale >= (-4)) then
2127 <               begin
2128 <                 rdFields[j].fdDataSize := SizeOf(Currency);
2129 <                 if RecordNumber >= 0 then
2130 <                   LocalCurrency := Qry.Current[i].AsCurrency;
2131 <                 LocalData := PChar(@LocalCurrency);
2132 <               end
2133 <               else begin
2134 <                 rdFields[j].fdDataSize := SizeOf(Double);
2135 <                 if RecordNumber >= 0 then
2136 <                   LocalDouble := Qry.Current[i].AsDouble;
1868 <                LocalData := PChar(@LocalDouble);
1869 <              end;
2126 >          else
2127 >          if (fdDataScale >= (-4)) then
2128 >          begin
2129 >            LocalCurrency := ColData.AsCurrency;
2130 >            LocalData := PByte(@LocalCurrency);
2131 >          end
2132 >          else
2133 >          begin
2134 >           LocalDouble := ColData.AsDouble;
2135 >           LocalData := PByte(@LocalDouble);
2136 >          end;
2137          end;
2138          SQL_INT64:
2139          begin
2140 <          if (rdFields[j].fdDataScale = 0) then
2140 >          if (fdDataScale = 0) then
2141            begin
2142 <            rdFields[j].fdDataSize := SizeOf(Int64);
2143 <            if RecordNumber >= 0 then
1877 <              LocalInt64 := Qry.Current[i].AsInt64;
1878 <            LocalData := PChar(@LocalInt64);
2142 >            LocalInt64 := ColData.AsInt64;
2143 >            LocalData := PByte(@LocalInt64);
2144            end
2145 <          else if (rdFields[j].fdDataScale >= (-4)) then
2146 <               begin
1882 <                 rdFields[j].fdDataSize := SizeOf(Currency);
1883 <                 if RecordNumber >= 0 then
1884 <                   LocalCurrency := Qry.Current[i].AsCurrency;
1885 <                   LocalData := PChar(@LocalCurrency);
1886 <               end
1887 <               else begin
1888 <                  rdFields[j].fdDataSize := SizeOf(Double);
1889 <                  if RecordNumber >= 0 then
1890 <                    LocalDouble := Qry.Current[i].AsDouble;
1891 <                  LocalData := PChar(@LocalDouble);
1892 <               end
1893 <        end;
1894 <        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1895 <        begin
1896 <          rdFields[j].fdDataSize := SizeOf(Double);
1897 <          if RecordNumber >= 0 then
1898 <            LocalDouble := Qry.Current[i].AsDouble;
1899 <          LocalData := PChar(@LocalDouble);
1900 <        end;
1901 <        SQL_VARYING:
1902 <        begin
1903 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1904 <          rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1905 <          if RecordNumber >= 0 then
2145 >          else
2146 >          if (fdDataScale >= (-4)) then
2147            begin
2148 <            if (rdFields[j].fdDataLength = 0) then
2149 <              LocalData := nil
2148 >            LocalCurrency := ColData.AsCurrency;
2149 >            LocalData := PByte(@LocalCurrency);
2150 >            end
2151              else
2152              begin
2153 <              temp :=  Qry.Current[i];
2154 <              LocalData := @temp.Data^.sqldata[2];
2155 < (*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
1914 <            end;
1915 <          end;
2153 >              LocalDouble := ColData.AsDouble;
2154 >              LocalData := PByte(@LocalDouble);
2155 >            end
2156          end;
2157 <        SQL_BOOLEAN:
2157 >        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2158          begin
2159 <          LocalBool:= false;
2160 <          rdFields[j].fdDataSize := SizeOf(wordBool);
1921 <          if RecordNumber >= 0 then
1922 <            LocalBool := Qry.Current[i].AsBoolean;
1923 <          LocalData := PChar(@LocalBool);
2159 >          LocalDouble := ColData.AsDouble;
2160 >          LocalData := PByte(@LocalDouble);
2161          end;
2162 <        else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
2162 >        SQL_BOOLEAN:
2163          begin
2164 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
2165 <          if (rdFields[j].fdDataType = SQL_TEXT) then
1929 <            rdFields[j].fdDataLength := rdFields[j].fdDataSize;
2164 >          LocalBool := ColData.AsBoolean;
2165 >          LocalData := PByte(@LocalBool);
2166          end;
2167        end;
2168 <      if RecordNumber < 0 then
2168 >
2169 >      if fdDataType = SQL_VARYING then
2170 >        Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2171 >      else
2172 >        Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2173 >    end
2174 >    else {Null column}
2175 >    if fdDataType = SQL_VARYING then
2176 >      FillChar(Buffer[fdDataOfs],fdDataLength,0)
2177 >    else
2178 >      FillChar(Buffer[fdDataOfs],fdDataSize,0);
2179 >  end;
2180 > end;
2181 >
2182 > { Read the record from FQSelect.Current into the record buffer
2183 >  Then write the buffer to in memory cache }
2184 > procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
2185 >  RecordNumber: Integer; Buffer: PChar);
2186 > var
2187 >  pbd: PBlobDataArray;
2188 >  pda: PArrayDataArray;
2189 >  i, j: Integer;
2190 >  FieldsLoaded: Integer;
2191 >  p: PRecordData;
2192 > begin
2193 >  if RecordNumber = -1 then
2194 >  begin
2195 >    InitModelBuffer(Qry,Buffer);
2196 >    Exit;
2197 >  end;
2198 >  p := PRecordData(Buffer);
2199 >  { Make sure blob cache is empty }
2200 >  pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
2201 >  pda := PArrayDataArray(Buffer + FArrayCacheOffset);
2202 >  for i := 0 to BlobFieldCount - 1 do
2203 >    pbd^[i] := nil;
2204 >  for i := 0 to ArrayFieldCount - 1 do
2205 >    pda^[i] := nil;
2206 >
2207 >  { Get record information }
2208 >  p^.rdBookmarkFlag := bfCurrent;
2209 >  p^.rdFieldCount := Qry.FieldCount;
2210 >  p^.rdRecordNumber := RecordNumber;
2211 >  p^.rdUpdateStatus := usUnmodified;
2212 >  p^.rdCachedUpdateStatus := cusUnmodified;
2213 >  p^.rdSavedOffset := $FFFFFFFF;
2214 >
2215 >  { Load up the fields }
2216 >  FieldsLoaded := FQSelect.MetaData.Count;
2217 >  j := 1;
2218 >  for i := 0 to Qry.FieldCount - 1 do
2219 >  begin
2220 >    if (Qry = FQSelect) then
2221 >      j := i + 1
2222 >    else
2223 >    begin
2224 >      if FieldsLoaded = 0 then
2225 >        break;
2226 >      j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2227 >      if j < 1 then
2228 >        continue
2229 >      else
2230 >        Dec(FieldsLoaded);
2231 >    end;
2232 >    with FQSelect.MetaData[j - 1] do
2233 >      if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2234        begin
2235 <        rdFields[j].fdIsNull := True;
2236 <        rdFields[j].fdDataOfs := FRecordSize;
2237 <        Inc(FRecordSize, rdFields[j].fdDataSize);
1937 <      end
1938 <      else begin
1939 <        if rdFields[j].fdDataType = SQL_VARYING then
1940 <        begin
1941 <          if LocalData <> nil then
1942 <            Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)
1943 <        end
1944 <        else
1945 <          Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
2235 >        if (GetSize <= 8) then
2236 >          p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2237 >        continue;
2238        end;
2239 <    end;
2239 >    if j > 0 then
2240 >      ColumnDataToBuffer(Qry.Current,i,j,Buffer);
2241    end;
2242 <  WriteRecordCache(RecordNumber, PChar(p));
2242 >  WriteRecordCache(RecordNumber, Buffer);
2243   end;
2244  
2245   function TIBCustomDataSet.GetActiveBuf: PChar;
# Line 1991 | Line 2284 | begin
2284    result := FBase.Database;
2285   end;
2286  
1994 function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1995 begin
1996  result := FBase.DBHandle;
1997 end;
1998
2287   function TIBCustomDataSet.GetDeleteSQL: TStrings;
2288   begin
2289    result := FQDelete.SQL;
# Line 2006 | Line 2294 | begin
2294    result := FQInsert.SQL;
2295   end;
2296  
2297 < function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
2297 > function TIBCustomDataSet.GetSQLParams: ISQLParams;
2298   begin
2299    if not FInternalPrepared then
2300      InternalPrepare;
# Line 2023 | Line 2311 | begin
2311    result := FQSelect.SQL;
2312   end;
2313  
2314 < function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
2314 > function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2315   begin
2316 <  result := FQSelect.SQLType;
2316 >  result := FQSelect.SQLStatementType;
2317   end;
2318  
2319   function TIBCustomDataSet.GetModifySQL: TStrings;
# Line 2038 | Line 2326 | begin
2326    result := FBase.Transaction;
2327   end;
2328  
2041 function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
2042 begin
2043  result := FBase.TRHandle;
2044 end;
2045
2329   procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2330   begin
2331    if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2332      FUpdateObject.Apply(ukDelete,Buff)
2333    else
2334    begin
2335 <    SetInternalSQLParams(FQDelete, Buff);
2335 >    SetInternalSQLParams(FQDelete.Params, Buff);
2336      FQDelete.ExecQuery;
2337 +    if (FQDelete.FieldCount > 0)  then
2338 +      DoDeleteReturning(FQDelete.Current);
2339    end;
2340    with PRecordData(Buff)^ do
2341    begin
# Line 2064 | Line 2349 | function TIBCustomDataSet.InternalLocate
2349    const KeyValues: Variant; Options: TLocateOptions): Boolean;
2350   var
2351    keyFieldList: TList;
2067  {$IFDEF NEW_TBOOKMARK }
2352    CurBookmark: TBookmark;
2069  {$ELSE}
2070  CurBookmark: string;
2071  {$ENDIF}
2353    fieldValue: Variant;
2354    lookupValues: array of variant;
2355    i, fieldCount: Integer;
# Line 2150 | Line 2431 | end;
2431  
2432   procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2433   var
2434 <  i, j, k: Integer;
2434 >  i, j, k, arr: Integer;
2435    pbd: PBlobDataArray;
2436 +  pda: PArrayDataArray;
2437   begin
2438    pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2439 <  j := 0;
2439 >  pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2440 >  j := 0; arr := 0;
2441    for i := 0 to FieldCount - 1 do
2442      if Fields[i].IsBlob then
2443      begin
# Line 2163 | Line 2446 | begin
2446        begin
2447          pbd^[j].Finalize;
2448          PISC_QUAD(
2449 <          PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
2449 >          PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2450            pbd^[j].BlobID;
2451          PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2452 +      end
2453 +      else
2454 +      begin
2455 +        PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2456 +        with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2457 +        begin
2458 +          gds_quad_high := 0;
2459 +          gds_quad_low := 0;
2460 +        end;
2461        end;
2462        Inc(j);
2463 +    end
2464 +    else
2465 +    if Fields[i] is TIBArrayField then
2466 +    begin
2467 +      if pda^[arr] <> nil then
2468 +      begin
2469 +        k := FMappedFieldPosition[Fields[i].FieldNo -1];
2470 +        PISC_QUAD(
2471 +          PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=  pda^[arr].ArrayIntf.GetArrayID;
2472 +        PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2473 +      end;
2474 +      Inc(arr);
2475      end;
2476 +  FBufferUpdatedOnQryReturn := false;
2477    if Assigned(FUpdateObject) then
2478    begin
2479      if (Qry = FQDelete) then
# Line 2179 | Line 2484 | begin
2484        FUpdateObject.Apply(ukModify,Buff);
2485    end
2486    else begin
2487 <    SetInternalSQLParams(Qry, Buff);
2487 >    SetInternalSQLParams(Qry.Params, Buff);
2488      Qry.ExecQuery;
2489 +    if Qry.FieldCount > 0 then {Has RETURNING Clause}
2490 +      UpdateRecordFromQuery(Qry.Current,Buff);
2491    end;
2492    PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
2493    PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2494    SetModified(False);
2495    WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
2496 <  if (FForcedRefresh or FNeedsRefresh) and CanRefresh then
2496 >  if (FForcedRefresh or (FNeedsRefresh and not FBufferUpdatedOnQryReturn)) and CanRefresh then
2497      InternalRefreshRow;
2498   end;
2499  
# Line 2213 | Line 2520 | begin
2520          end
2521          else
2522            Qry := FQRefresh;
2523 <        SetInternalSQLParams(Qry, Buff);
2523 >        SetInternalSQLParams(Qry.Params, Buff);
2524          Qry.ExecQuery;
2525          try
2526 <          if (Qry.SQLType = SQLExecProcedure) or
2220 <             (Qry.Next <> nil) then
2526 >          if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2527            begin
2528              ofs := PRecordData(Buff)^.rdSavedOffset;
2529              FetchCurrentRecordToBuffer(Qry,
# Line 2310 | Line 2616 | begin
2616   end;
2617  
2618   procedure TIBCustomDataSet.InternalPrepare;
2313 var
2314  DidActivate: Boolean;
2619   begin
2620    if FInternalPrepared then
2621      Exit;
2318  DidActivate := False;
2622    FBase.SetCursor;
2623    try
2624      ActivateConnection;
2625 <    DidActivate := ActivateTransaction;
2625 >    ActivateTransaction;
2626      FBase.CheckDatabase;
2627      FBase.CheckTransaction;
2628      if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
# Line 2357 | Line 2660 | begin
2660      end else
2661        IBError(ibxeEmptyQuery, [nil]);
2662    finally
2360    if DidActivate then
2361      DeactivateTransaction;
2663      FBase.RestoreCursor;
2664    end;
2665   end;
# Line 2388 | Line 2689 | var
2689    begin
2690      CopyRecordBuffer(Buffer, OldBuffer);
2691      if BlobFieldCount > 0 then
2692 <      FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2692 >      FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2693 >               BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2694                 0);
2695    end;
2696  
# Line 2427 | Line 2729 | end;
2729  
2730   procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase);
2731   begin
2732 <  if (FBase.Database <> Value) then
2732 >  if (csLoading in ComponentState) or (FBase.Database <> Value) then
2733    begin
2734      CheckDatasetClosed;
2735 +    InternalUnPrepare;
2736      FBase.Database := Value;
2737      FQDelete.Database := Value;
2738      FQInsert.Database := Value;
2739      FQRefresh.Database := Value;
2740      FQSelect.Database := Value;
2741      FQModify.Database := Value;
2742 +    FDatabaseInfo.Database := Value;
2743 +    FGeneratorField.Database := Value;
2744    end;
2745   end;
2746  
# Line 2457 | Line 2762 | begin
2762    end;
2763   end;
2764  
2765 < procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
2765 > procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
2766   var
2767    i, j: Integer;
2768    cr, data: PChar;
2769 <  fn, st: string;
2769 >  fn: string;
2770 >  st: RawByteString;
2771    OldBuffer: Pointer;
2772 <  ts: TTimeStamp;
2772 >  Param: ISQLParam;
2773   begin
2774    if (Buffer = nil) then
2775      IBError(ibxeBufferNotSet, [nil]);
# Line 2471 | Line 2777 | begin
2777      InternalPrepare;
2778    OldBuffer := nil;
2779    try
2780 <    for i := 0 to Qry.Params.Count - 1 do
2780 >    for i := 0 to Params.GetCount - 1 do
2781      begin
2782 <      fn := Qry.Params[i].Name;
2782 >      Param := Params[i];
2783 >      fn := Param.Name;
2784        if (Pos('OLD_', fn) = 1) then {mbcs ok}
2785        begin
2786          fn := Copy(fn, 5, Length(fn));
# Line 2493 | Line 2800 | begin
2800               cr := Buffer;
2801        j := FQSelect.FieldIndex[fn] + 1;
2802        if (j > 0) then
2803 <        with PRecordData(cr)^ do
2803 >        with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2804          begin
2805 <          if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2805 >          if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2806            begin
2807 <            PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2807 >            PIBDBKey(Param.AsPointer)^ := rdDBKey;
2808              continue;
2809            end;
2810 <          if rdFields[j].fdIsNull then
2811 <            Qry.Params[i].IsNull := True
2810 >          if fdIsNull then
2811 >            Param.IsNull := True
2812            else begin
2813 <            Qry.Params[i].IsNull := False;
2814 <            data := cr + rdFields[j].fdDataOfs;
2815 <            case rdFields[j].fdDataType of
2813 >            Param.IsNull := False;
2814 >            data := cr + fdDataOfs;
2815 >            case fdDataType of
2816                SQL_TEXT, SQL_VARYING:
2817                begin
2818 <                SetString(st, data, rdFields[j].fdDataLength);
2819 <                Qry.Params[i].AsString := st;
2818 >                SetString(st, data, fdDataLength);
2819 >                SetCodePage(st,fdCodePage,false);
2820 >                Param.AsString := st;
2821                end;
2822              SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2823 <              Qry.Params[i].AsDouble := PDouble(data)^;
2823 >              Param.AsDouble := PDouble(data)^;
2824              SQL_SHORT, SQL_LONG:
2825              begin
2826 <              if rdFields[j].fdDataScale = 0 then
2827 <                Qry.Params[i].AsLong := PLong(data)^
2828 <              else if rdFields[j].fdDataScale >= (-4) then
2829 <                Qry.Params[i].AsCurrency := PCurrency(data)^
2826 >              if fdDataScale = 0 then
2827 >                Param.AsLong := PLong(data)^
2828 >              else
2829 >              if fdDataScale >= (-4) then
2830 >                Param.AsCurrency := PCurrency(data)^
2831                else
2832 <                Qry.Params[i].AsDouble := PDouble(data)^;
2832 >                Param.AsDouble := PDouble(data)^;
2833              end;
2834              SQL_INT64:
2835              begin
2836 <              if rdFields[j].fdDataScale = 0 then
2837 <                Qry.Params[i].AsInt64 := PInt64(data)^
2529 <              else if rdFields[j].fdDataScale >= (-4) then
2530 <                Qry.Params[i].AsCurrency := PCurrency(data)^
2836 >              if fdDataScale = 0 then
2837 >                Param.AsInt64 := PInt64(data)^
2838                else
2839 <                Qry.Params[i].AsDouble := PDouble(data)^;
2839 >              if fdDataScale >= (-4) then
2840 >                Param.AsCurrency := PCurrency(data)^
2841 >              else
2842 >                Param.AsDouble := PDouble(data)^;
2843              end;
2844              SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2845 <              Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2846 <            SQL_TYPE_DATE:
2847 <            begin
2538 <              ts.Date := PInt(data)^;
2539 <              ts.Time := 0;
2540 <              Qry.Params[i].AsDate :=
2541 <                TimeStampToDateTime(ts);
2542 <            end;
2543 <            SQL_TYPE_TIME:
2544 <            begin
2545 <              ts.Date := 0;
2546 <              ts.Time := PInt(data)^;
2547 <              Qry.Params[i].AsTime :=
2548 <                TimeStampToDateTime(ts);
2549 <            end;
2845 >              Param.AsQuad := PISC_QUAD(data)^;
2846 >            SQL_TYPE_DATE,
2847 >            SQL_TYPE_TIME,
2848              SQL_TIMESTAMP:
2849 <              Qry.Params[i].AsDateTime :=
2850 <                       TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2849 >            {This is an IBX native format and not the TDataset approach. See also SetFieldData}
2850 >              Param.AsDateTime := PDateTime(data)^;
2851              SQL_BOOLEAN:
2852 <              Qry.Params[i].AsBoolean := PWordBool(data)^;
2852 >              Param.AsBoolean := PWordBool(data)^;
2853            end;
2854          end;
2855        end;
# Line 2600 | Line 2898 | begin
2898      FQRefresh.Transaction := Value;
2899      FQSelect.Transaction := Value;
2900      FQModify.Transaction := Value;
2901 +    FGeneratorField.Transaction := Value;
2902    end;
2903   end;
2904  
# Line 2640 | Line 2939 | end;
2939   procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2940   begin
2941    if FIBLinks.IndexOf(Sender) = -1 then
2942 +  begin
2943      FIBLinks.Add(Sender);
2944 +    if Active then
2945 +    begin
2946 +      Active := false;
2947 +      Active := true;
2948 +    end;
2949 +  end;
2950   end;
2951  
2952  
# Line 2707 | Line 3013 | begin
3013    Result := Assigned( FQSelect ) and FQSelect.EOF;
3014   end;
3015  
3016 < function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
3016 > function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
3017   begin
3018    ActivateConnection;
3019    ActivateTransaction;
# Line 2844 | Line 3150 | var
3150    Buff: PChar;
3151    bTr, bDB: Boolean;
3152   begin
3153 +  if (Field = nil) or (Field.DataSet <> self) then
3154 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3155    Buff := GetActiveBuf;
3156    if Buff = nil then
3157    begin
3158      fs := TIBBlobStream.Create;
3159      fs.Mode := bmReadWrite;
3160 +    fs.Database := Database;
3161 +    fs.Transaction := Transaction;
3162 +    fs.SetField(Field);
3163      FBlobStreamList.Add(Pointer(fs));
3164      result := TIBDSBlobStream.Create(Field, fs, Mode);
3165      exit;
# Line 2863 | Line 3174 | begin
3174      fs.Mode := bmReadWrite;
3175      fs.Database := Database;
3176      fs.Transaction := Transaction;
3177 +    fs.SetField(Field);
3178      fs.BlobID :=
3179 <      PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3179 >      PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3180      if (CachedUpdates) then
3181      begin
3182        bTr := not Transaction.InTransaction;
# Line 2885 | Line 3197 | begin
3197    result := TIBDSBlobStream.Create(Field, fs, Mode);
3198   end;
3199  
3200 + function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3201 + var Buff: PChar;
3202 +    pda: PArrayDataArray;
3203 +    bTr, bDB: Boolean;
3204 + begin
3205 +  if (Field = nil) or (Field.DataSet <> self) then
3206 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3207 +  Buff := GetActiveBuf;
3208 +  if Buff = nil then
3209 +    Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3210 +                              Field.FRelationName,Field.FieldName)
3211 +  else
3212 +  begin
3213 +    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3214 +    if pda^[Field.FCacheOffset] = nil then
3215 +    begin
3216 +      AdjustRecordOnInsert(Buff);
3217 +      if Field.IsNull then
3218 +        Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3219 +                                Field.FRelationName,Field.FieldName)
3220 +      else
3221 +        Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3222 +                            Field.FRelationName,Field.FieldName,Field.ArrayID);
3223 +      pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3224 +      FArrayList.Add(pda^[Field.FCacheOffset]);
3225 +      if (CachedUpdates) then
3226 +      begin
3227 +        bTr := not Transaction.InTransaction;
3228 +        bDB := not Database.Connected;
3229 +        if bDB then
3230 +          Database.Open;
3231 +        if bTr then
3232 +          Transaction.StartTransaction;
3233 +         pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3234 +        if bTr then
3235 +          Transaction.Commit;
3236 +        if bDB then
3237 +          Database.Close;
3238 +      end;
3239 +      WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3240 +    end
3241 +    else
3242 +      Result := pda^[Field.FCacheOffset].ArrayIntf;
3243 +  end;
3244 + end;
3245 +
3246 + procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3247 + var Buff: PChar;
3248 +    pda: PArrayDataArray;
3249 + begin
3250 +  if (Field = nil) or (Field.DataSet <> self) then
3251 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3252 +  Buff := GetActiveBuf;
3253 +  if Buff <> nil then
3254 +  begin
3255 +    AdjustRecordOnInsert(Buff);
3256 +    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3257 +    pda^[Field.FCacheOffset].FArray := AnArray;
3258 +    WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3259 +  end;
3260 + end;
3261 +
3262   function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3263   const
3264    CMPLess = -1;
# Line 2965 | Line 3339 | end;
3339   procedure TIBCustomDataSet.DoBeforeClose;
3340   begin
3341    inherited DoBeforeClose;
3342 +  if FInTransactionEnd and (FCloseAction = TARollback) then
3343 +     Exit;
3344    if State in [dsInsert,dsEdit] then
3345    begin
2970    if FInTransactionEnd and (FCloseAction = TARollback) then
2971       Exit;
2972
3346      if DataSetCloseAction = dcSaveChanges then
3347        Post;
3348        {Note this can fail with an exception e.g. due to
3349         database validation error. In which case the dataset remains open }
3350    end;
3351 +  if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3352 +    ApplyUpdates;
3353   end;
3354  
3355   procedure TIBCustomDataSet.DoBeforeOpen;
# Line 3006 | Line 3381 | end;
3381  
3382   procedure TIBCustomDataSet.FetchAll;
3383   var
3009  {$IFDEF NEW_TBOOKMARK }
3384    CurBookmark: TBookmark;
3011  {$ELSE}
3012  CurBookmark: string;
3013  {$ENDIF}
3385   begin
3386    FBase.SetCursor;
3387   try
# Line 3121 | Line 3492 | begin
3492      if result and (Buffer <> nil) then
3493        Move(Buff[1], Buffer^, Field.DataSize);
3494    end
3495 <  else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3495 >  else
3496 >  if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3497       (FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3498 +  with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3499 +                         FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3500    begin
3501 <    result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
3501 >    result := not fdIsNull;
3502      if result and (Buffer <> nil) then
3129      with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
3503        begin
3504 <        Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3504 >        Data := Buff + fdDataOfs;
3505          if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3506          begin
3507            if fdDataLength < Field.DataSize then
# Line 3199 | Line 3572 | begin
3572          if FCurrentRecord < FRecordCount then
3573            ReadRecordCache(FCurrentRecord, Buffer, False)
3574          else begin
3575 <          while (not FQSelect.EOF) and
3203 <                (FQSelect.Next <> nil) and
3575 >          while (not FQSelect.EOF) and FQSelect.Next  and
3576                  (FCurrentRecord >= FRecordCount) do begin
3577              FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3578              Inc(FRecordCount);
# Line 3311 | Line 3683 | procedure TIBCustomDataSet.InternalCance
3683   var
3684    Buff: PChar;
3685    CurRec: Integer;
3686 +  pda: PArrayDataArray;
3687 +  i: integer;
3688   begin
3689    inherited InternalCancel;
3690    Buff := GetActiveBuf;
3691 <  if Buff <> nil then begin
3691 >  if Buff <> nil then
3692 >  begin
3693 >    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3694 >    for i := 0 to ArrayFieldCount - 1 do
3695 >      pda^[i].ArrayIntf.CancelChanges;
3696      CurRec := FCurrentRecord;
3697      AdjustRecordOnInsert(Buff);
3698      if (State = dsEdit) then begin
# Line 3337 | Line 3715 | begin
3715      DeactivateTransaction;
3716    FQSelect.Close;
3717    ClearBlobCache;
3718 +  ClearArrayCache;
3719    FreeRecordBuffer(FModelBuffer);
3720    FreeRecordBuffer(FOldBuffer);
3721    FCurrentRecord := -1;
# Line 3352 | Line 3731 | begin
3731    FOBEnd := 0;
3732    FreeMem(FBufferCache);
3733    FBufferCache := nil;
3734 +  FreeMem(FFieldColumns);
3735 +  FFieldColumns := nil;
3736    FreeMem(FOldBufferCache);
3737    FOldBufferCache := nil;
3738    BindFields(False);
# Line 3426 | Line 3807 | const
3807                 'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3808                 'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3809                 '     (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3810 +
3811 +  DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3812 +               'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3813 +               'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3814 +               'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
3815 +               'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3816 +               'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3817 +               '     (not F.RDB$DEFAULT_VALUE is NULL) or ' + {do not localize}
3818 +               '     ( not R.RDB$IDENTITY_TYPE is NULL))' ; {do not localize}
3819 +
3820   var
3821    FieldType: TFieldType;
3822    FieldSize: Word;
3823 <  charSetID: short;
3823 >  FieldDataSize: integer;
3824    CharSetSize: integer;
3825    CharSetName: RawByteString;
3435  {$IFDEF HAS_ANSISTRING_CODEPAGE}
3826    FieldCodePage: TSystemCodePage;
3437  {$ENDIF}
3827    FieldNullable : Boolean;
3828    i, FieldPosition, FieldPrecision: Integer;
3829    FieldAliasName, DBAliasName: string;
3830 <  RelationName, FieldName: string;
3830 >  aRelationName, FieldName: string;
3831    Query : TIBSQL;
3832    FieldIndex: Integer;
3833    FRelationNodes : TRelationNode;
3834 +  aArrayDimensions: integer;
3835 +  aArrayBounds: TArrayBounds;
3836 +  ArrayMetaData: IArrayMetaData;
3837  
3838    function Add_Node(Relation, Field : String) : TRelationNode;
3839    var
# Line 3464 | Line 3856 | var
3856        FField.FieldName := Query.Fields[2].AsString;
3857        FField.DEFAULT_VALUE := not Query.Fields[1].IsNull;
3858        FField.COMPUTED_BLR := not Query.Fields[0].IsNull;
3859 +      FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull;
3860        FField.NextField := Result.FieldNodes;
3861        Result.FieldNodes := FField;
3862        Query.Next;
# Line 3517 | Line 3910 | var
3910          FField := Ffield.NextField;
3911    end;
3912  
3913 +  function Is_IDENTITY_COLUMN(Relation, Field : String) : Boolean;
3914 +  var
3915 +    FRelation : TRelationNode;
3916 +    FField : TFieldNode;
3917 +  begin
3918 +    FRelation := FRelationNodes;
3919 +    while Assigned(FRelation) and
3920 +         (FRelation.RelationName <> Relation) do
3921 +      FRelation := FRelation.NextRelation;
3922 +    if not Assigned(FRelation) then
3923 +      FRelation := Add_Node(Relation, Field);
3924 +    Result := false;
3925 +    FField := FRelation.FieldNodes;
3926 +    while Assigned(FField) do
3927 +      if FField.FieldName = Field then
3928 +      begin
3929 +        Result := Ffield.IDENTITY_COLUMN;
3930 +        Exit;
3931 +      end
3932 +      else
3933 +        FField := Ffield.NextField;
3934 +  end;
3935 +
3936    Procedure FreeNodes;
3937    var
3938      FRelation : TRelationNode;
# Line 3539 | Line 3955 | var
3955   begin
3956    FRelationNodes := TRelationNode.Create;
3957    FNeedsRefresh := False;
3958 <  Database.InternalTransaction.StartTransaction;
3958 >  if not Database.InternalTransaction.InTransaction then
3959 >    Database.InternalTransaction.StartTransaction;
3960    Query := TIBSQL.Create(self);
3961    try
3962      Query.Database := DataBase;
# Line 3547 | Line 3964 | begin
3964      FieldDefs.BeginUpdate;
3965      FieldDefs.Clear;
3966      FieldIndex := 0;
3967 <    if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3968 <      SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3969 <    Query.SQL.Text := DefaultSQL;
3967 >    if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3968 >      SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3969 >    if FDatabaseInfo.ODSMajorVersion >= 12 then
3970 >      Query.SQL.Text := DefaultSQLODS12
3971 >    else
3972 >      Query.SQL.Text := DefaultSQL;
3973      Query.Prepare;
3974 <    SetLength(FAliasNameMap, SourceQuery.Current.Count);
3975 <    SetLength(FAliasNameList, SourceQuery.Current.Count);
3976 <    for i := 0 to SourceQuery.Current.Count - 1 do
3977 <      with SourceQuery.Current[i].Data^ do
3974 >    SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3975 >    SetLength(FAliasNameList, SourceQuery.MetaData.Count);
3976 >    for i := 0 to SourceQuery.MetaData.GetCount - 1 do
3977 >      with SourceQuery.MetaData[i] do
3978        begin
3979          { Get the field name }
3980 <        FieldAliasName := SourceQuery.Current[i].Name;
3981 <        SetString(DBAliasName, aliasname, aliasname_length);
3982 <        SetString(RelationName, relname, relname_length);
3983 <        SetString(FieldName, sqlname, sqlname_length);
3980 >        FieldAliasName := GetName;
3981 >        DBAliasName := GetAliasname;
3982 >        aRelationName := getRelationName;
3983 >        FieldName := getSQLName;
3984          FAliasNameList[i] := DBAliasName;
3985          FieldSize := 0;
3986 +        FieldDataSize := GetSize;
3987          FieldPrecision := 0;
3988 <        FieldNullable := SourceQuery.Current[i].IsNullable;
3988 >        FieldNullable := IsNullable;
3989          CharSetSize := 0;
3990          CharSetName := '';
3570        {$IFDEF HAS_ANSISTRING_CODEPAGE}
3991          FieldCodePage := CP_NONE;
3992 <        {$ENDIF}
3993 <        case sqltype and not 1 of
3992 >        aArrayDimensions := 0;
3993 >        SetLength(aArrayBounds,0);
3994 >        case SQLType of
3995            { All VARCHAR's must be converted to strings before recording
3996             their values }
3997            SQL_VARYING, SQL_TEXT:
3998            begin
3999 <            CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
4000 <            CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
4001 <            {$IFDEF HAS_ANSISTRING_CODEPAGE}
4002 <            FieldCodePage := FBase.GetCodePage(sqlsubtype and $FF);
4003 <            {$ENDIF}
4004 <            {FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3584 <            FieldSize := sqllen;
3585 <            if CharSetSize = 2 then
3586 <              FieldType := ftWideString
3587 <            else
3588 <              FieldType := ftString;
3999 >            if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4000 >              CharSetSize := 1;
4001 >            CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4002 >            Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4003 >            FieldSize := FieldDataSize div CharSetSize;
4004 >            FieldType := ftString;
4005            end;
4006            { All Doubles/Floats should be cast to doubles }
4007            SQL_DOUBLE, SQL_FLOAT:
4008              FieldType := ftFloat;
4009            SQL_SHORT:
4010            begin
4011 <            if (sqlscale = 0) then
4011 >            if (getScale = 0) then
4012                FieldType := ftSmallInt
4013              else begin
4014                FieldType := ftBCD;
4015                FieldPrecision := 4;
4016 <              FieldSize := -sqlscale;
4016 >              FieldSize := -getScale;
4017              end;
4018            end;
4019            SQL_LONG:
4020            begin
4021 <            if (sqlscale = 0) then
4021 >            if (getScale = 0) then
4022                FieldType := ftInteger
4023 <            else if (sqlscale >= (-4)) then
4023 >            else if (getScale >= (-4)) then
4024              begin
4025                FieldType := ftBCD;
4026                FieldPrecision := 9;
4027 <              FieldSize := -sqlscale;
4027 >              FieldSize := -getScale;
4028              end
4029              else
4030              if Database.SQLDialect = 1 then
# Line 3620 | Line 4036 | begin
4036              begin
4037                FieldType := ftFMTBCD;
4038                FieldPrecision := 9;
4039 <              FieldSize := -sqlscale;
4039 >              FieldSize := -getScale;
4040              end;
4041            end;
4042  
4043            SQL_INT64:
4044            begin
4045 <            if (sqlscale = 0) then
4045 >            if (getScale = 0) then
4046                FieldType := ftLargeInt
4047 <            else if (sqlscale >= (-4)) then
4047 >            else if (getScale >= (-4)) then
4048              begin
4049                FieldType := ftBCD;
4050                FieldPrecision := 18;
4051 <              FieldSize := -sqlscale;
4051 >              FieldSize := -getScale;
4052              end
4053              else
4054 <              FieldType := ftFloat
4054 >              FieldType := ftFloat;
4055            end;
4056            SQL_TIMESTAMP: FieldType := ftDateTime;
4057            SQL_TYPE_TIME: FieldType := ftTime;
# Line 3643 | Line 4059 | begin
4059            SQL_BLOB:
4060            begin
4061              FieldSize := sizeof (TISC_QUAD);
4062 <            if (sqlsubtype = 1) then
4062 >            if (getSubtype = 1) then
4063              begin
4064 <              if FBase.GetDefaultCharSetName <> '' then
3649 <              begin
3650 <                CharSetSize := FBase.GetDefaultCharSetSize;
3651 <                CharSetName := FBase.GetDefaultCharSetName;
3652 <                {$IFDEF HAS_ANSISTRING_CODEPAGE}
3653 <                FieldCodePage := FBase.GetDefaultCodePage;
3654 <                {$ENDIF}
3655 <              end
3656 <              else
3657 <              if strpas(sqlname) <> '' then
3658 <              begin
3659 <                charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3660 <                        @relname,@sqlname);
3661 <                CharSetSize := FBase.GetCharSetSize(charSetID);
3662 <                CharSetName := FBase.GetCharSetName(charSetID);
3663 <                {$IFDEF HAS_ANSISTRING_CODEPAGE}
3664 <                FieldCodePage := FBase.GetCodePage(charSetID);
3665 <                {$ENDIF}
3666 <             end
3667 <              else  {Complex SQL with no identifiable column and no connection default}
3668 <              begin
3669 <                CharSetName := '';
4064 >              if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4065                  CharSetSize := 1;
4066 <                {$IFDEF HAS_ANSISTRING_CODEPAGE}
4067 <                FieldCodePage := CP_NONE;
4068 <                {$ENDIF}
3674 <              end;
3675 <              if CharSetSize = 2 then
3676 <                FieldType := ftWideMemo
3677 <              else
3678 <                FieldType := ftMemo;
4066 >              CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4067 >              Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4068 >              FieldType := ftMemo;
4069              end
4070              else
4071                FieldType := ftBlob;
# Line 3683 | Line 4073 | begin
4073            SQL_ARRAY:
4074            begin
4075              FieldSize := sizeof (TISC_QUAD);
4076 <            FieldType := ftUnknown;
4076 >            FieldType := ftArray;
4077 >            ArrayMetaData := GetArrayMetaData;
4078 >            if ArrayMetaData <> nil then
4079 >            begin
4080 >              aArrayDimensions := ArrayMetaData.GetDimensions;
4081 >              aArrayBounds := ArrayMetaData.GetBounds;
4082 >            end;
4083            end;
4084            SQL_BOOLEAN:
4085               FieldType:= ftBoolean;
# Line 3700 | Line 4096 | begin
4096              Name := FieldAliasName;
4097              FAliasNameMap[FieldNo-1] := DBAliasName;
4098              Size := FieldSize;
4099 +            DataSize := FieldDataSize;
4100              Precision := FieldPrecision;
4101              Required := not FieldNullable;
4102 +            RelationName := aRelationName;
4103              InternalCalcField := False;
4104              CharacterSetSize := CharSetSize;
4105              CharacterSetName := CharSetName;
3708            {$IFDEF HAS_ANSISTRING_CODEPAGE}
4106              CodePage := FieldCodePage;
4107 <            {$ENDIF}
4107 >            ArrayDimensions := aArrayDimensions;
4108 >            ArrayBounds := aArrayBounds;
4109              if (FieldName <> '') and (RelationName <> '') then
4110              begin
4111 +              IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName);
4112                if Has_COMPUTED_BLR(RelationName, FieldName) then
4113                begin
4114                  Attributes := [faReadOnly];
# Line 3735 | Line 4134 | begin
4134      FreeNodes;
4135      Database.InternalTransaction.Commit;
4136      FieldDefs.EndUpdate;
4137 +    FieldDefs.Updated := true;
4138    end;
4139   end;
4140  
# Line 3752 | Line 4152 | begin
4152    else begin
4153      Buffer := AllocRecordBuffer;
4154      try
4155 <      while FQSelect.Next <> nil do
4155 >      while FQSelect.Next do
4156        begin
4157          FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
4158          Inc(FRecordCount);
# Line 3767 | Line 4167 | end;
4167   procedure TIBCustomDataSet.InternalSetParamsFromCursor;
4168   var
4169    i: Integer;
4170 <  cur_param: TIBXSQLVAR;
4170 >  cur_param: ISQLParam;
4171    cur_field: TField;
4172    s: TStream;
4173   begin
# Line 3775 | Line 4175 | begin
4175      IBError(ibxeEmptyQuery, [nil]);
4176    if not FInternalPrepared then
4177      InternalPrepare;
4178 <  if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4178 >  if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4179    begin
4180 <    for i := 0 to SQLParams.Count - 1 do
4180 >    for i := 0 to SQLParams.GetCount - 1 do
4181      begin
4182        cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4183 <      cur_param := SQLParams[i];
4184 <      if (cur_field <> nil) then begin
4183 >      if (cur_field <> nil) then
4184 >      begin
4185 >        cur_param := SQLParams[i];
4186          if (cur_field.IsNull) then
4187            cur_param.IsNull := True
4188 <        else case cur_field.DataType of
4188 >        else
4189 >        case cur_field.DataType of
4190            ftString:
4191              cur_param.AsString := cur_field.AsString;
4192            ftBoolean:
# Line 3794 | Line 4196 | begin
4196            ftInteger:
4197              cur_param.AsLong := cur_field.AsInteger;
4198            ftLargeInt:
4199 <            cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
4199 >            cur_param.AsInt64 := cur_field.AsLargeInt;
4200            ftFloat, ftCurrency:
4201             cur_param.AsDouble := cur_field.AsFloat;
4202            ftBCD:
# Line 3811 | Line 4213 | begin
4213              try
4214                s := DataSource.DataSet.
4215                       CreateBlobStream(cur_field, bmRead);
4216 <              cur_param.LoadFromStream(s);
4216 >              cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4217              finally
4218                s.free;
4219              end;
4220            end;
4221 +          ftArray:
4222 +            cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4223            else
4224              IBError(ibxeNotSupported, [nil]);
4225          end;
# Line 3848 | Line 4252 | procedure TIBCustomDataSet.InternalOpen;
4252      result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
4253    end;
4254  
3851  function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3852  var i: integer;
3853  begin
3854    Result := nil;
3855    for i := 0 to FieldDefs.Count - 1 do
3856      if FieldDefs[i].FieldNo = aFieldNo then
3857      begin
3858        Result := TIBFieldDef(FieldDefs[i]);
3859        break;
3860      end;
3861  end;
3862
3863  procedure SetExtendedProperties;
3864  var i: integer;
3865      IBFieldDef: TIBFieldDef;
3866  begin
3867    for i := 0 to Fields.Count - 1 do
3868      if Fields[i].FieldNo > 0 then
3869      begin
3870        if(Fields[i] is TIBStringField) then
3871        with TIBStringField(Fields[i]) do
3872        begin
3873          IBFieldDef := GetFieldDef(FieldNo);
3874          if IBFieldDef <> nil then
3875          begin
3876            CharacterSetSize := IBFieldDef.CharacterSetSize;
3877            CharacterSetName := IBFieldDef.CharacterSetName;
3878            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3879            CodePage := IBFieldDef.CodePage;
3880            {$ENDIF}
3881          end;
3882        end
3883        else
3884        if(Fields[i] is TIBWideStringField) then
3885        with TIBWideStringField(Fields[i]) do
3886        begin
3887          IBFieldDef := GetFieldDef(FieldNo);
3888          if IBFieldDef <> nil then
3889          begin
3890            CharacterSetSize := IBFieldDef.CharacterSetSize;
3891            CharacterSetName := IBFieldDef.CharacterSetName;
3892          end;
3893        end
3894        else
3895        if(Fields[i] is TIBMemoField) then
3896        with TIBMemoField(Fields[i]) do
3897        begin
3898          IBFieldDef := GetFieldDef(FieldNo);
3899          if IBFieldDef <> nil then
3900          begin
3901            CharacterSetSize := IBFieldDef.CharacterSetSize;
3902            CharacterSetName := IBFieldDef.CharacterSetName;
3903            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3904            CodePage := IBFieldDef.CodePage;
3905            {$ENDIF}
3906          end;
3907        end
3908        else
3909        if(Fields[i] is TIBWideMemoField) then
3910        with TIBWideMemoField(Fields[i]) do
3911        begin
3912          IBFieldDef := GetFieldDef(FieldNo);
3913          if IBFieldDef <> nil then
3914          begin
3915            CharacterSetSize := IBFieldDef.CharacterSetSize;
3916            CharacterSetName := IBFieldDef.CharacterSetName;
3917          end;
3918        end
3919      end
3920  end;
3921
4255   begin
4256    FBase.SetCursor;
4257    try
# Line 3928 | Line 4261 | begin
4261        IBError(ibxeEmptyQuery, [nil]);
4262      if not FInternalPrepared then
4263        InternalPrepare;
4264 <   if FQSelect.SQLType = SQLSelect then
4264 >   if FQSelect.SQLStatementType = SQLSelect then
4265     begin
4266        if DefaultFields then
4267          CreateFields;
4268 +      FArrayFieldCount := 0;
4269        BindFields(True);
3936      SetExtendedProperties;
4270        FCurrentRecord := -1;
4271        FQSelect.ExecQuery;
4272        FOpen := FQSelect.Open;
# Line 3944 | Line 4277 | begin
4277          3. After the dummy fetch, FRecordSize will be appropriately
4278             adjusted to reflect the additional "weight" of the field
4279             data.
4280 <        4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4280 >        4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4281          5. Now, with the BufferSize available, allocate memory for chunks of records
4282          6. Re-allocate the model buffer, accounting for the new
4283             FRecordBufferSize.
4284          7. Finally, calls to AllocRecordBuffer will work!.
4285         }
4286        {Step 1}
4287 <      FRecordSize := RecordDataLength(FQSelect.Current.Count);
4287 >      FRecordSize := RecordDataLength(FQSelect.FieldCount);
4288        {Step 2, 3}
4289 +      GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4290        IBAlloc(FModelBuffer, 0, FRecordSize);
4291 <      FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4291 >      InitModelBuffer(FQSelect, FModelBuffer);
4292        {Step 4}
4293        FCalcFieldsOffset := FRecordSize;
4294        FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4295 <      FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4295 >      FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4296 >      FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4297        {Step 5}
4298        if UniDirectional then
4299          FBufferChunkSize := FRecordBufferSize * UniCache
# Line 3974 | Line 4309 | begin
4309        FCacheSize := FBufferChunkSize;
4310        FOldCacheSize := FBufferChunkSize;
4311        {Step 6}
4312 <      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4312 >      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4313                               FRecordBufferSize);
4314        {Step 7}
4315        FOldBuffer := AllocRecordBuffer;
# Line 4072 | Line 4407 | end;
4407   function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4408                                   Options: TLocateOptions): Boolean;
4409   var
4075  {$IFDEF NEW_TBOOKMARK }
4410    CurBookmark: TBookmark;
4077  {$ELSE}
4078  CurBookmark: string;
4079  {$ENDIF}
4411   begin
4412    DisableControls;
4413    try
# Line 4094 | Line 4425 | function TIBCustomDataSet.Lookup(const K
4425                                   const ResultFields: string): Variant;
4426   var
4427    fl: TList;
4097  {$IFDEF NEW_TBOOKMARK }
4428    CurBookmark: TBookmark;
4099  {$ELSE}
4100  CurBookmark: string;
4101  {$ENDIF}
4429   begin
4430    DisableControls;
4431    fl := TList.Create;
# Line 4171 | Line 4498 | begin
4498        MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4499        if (MappedFieldPos > 0) and
4500           (MappedFieldPos <= rdFieldCount) then
4501 +      with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4502        begin
4503          Field.Validate(Buffer);
4504          if (Buffer = nil) or
4505             (Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4506 <          rdFields[MappedFieldPos].fdIsNull := True
4507 <        else begin
4508 <          Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4509 <                 rdFields[MappedFieldPos].fdDataSize);
4510 <          if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4511 <             (rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4512 <            rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4185 <          rdFields[MappedFieldPos].fdIsNull := False;
4506 >          fdIsNull := True
4507 >        else
4508 >        begin
4509 >          Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4510 >          if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4511 >            fdDataLength := StrLen(PChar(Buffer));
4512 >          fdIsNull := False;
4513            if rdUpdateStatus = usUnmodified then
4514            begin
4515              if CachedUpdates then
# Line 4283 | Line 4610 | begin
4610    if FInternalPrepared then
4611    begin
4612      CheckDatasetClosed;
4613 +    if FDidActivate then
4614 +      DeactivateTransaction;
4615      FieldDefs.Clear;
4616      FieldDefs.Updated := false;
4617      FInternalPrepared := False;
# Line 4303 | Line 4632 | begin
4632        IBError(ibxeEmptyQuery, [nil]);
4633      if not FInternalPrepared then
4634        InternalPrepare;
4635 <    if FQSelect.SQLType = SQLSelect then
4635 >    if FQSelect.SQLStatementType = SQLSelect then
4636      begin
4637        IBError(ibxeIsASelectStatement, [nil]);
4638      end
# Line 4316 | Line 4645 | begin
4645    end;
4646   end;
4647  
4648 < function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4648 > function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4649   begin
4650 <  Result := FQSelect.Handle;
4650 >  Result := FQSelect.Statement;
4651   end;
4652  
4653   function TIBCustomDataSet.GetParser: TSelectSQLParser;
# Line 4373 | Line 4702 | end;
4702  
4703   { TIBDataSet IProviderSupport }
4704  
4705 < (*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4705 > procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4706   begin
4707    if Commit then
4708      Transaction.Commit else
# Line 4526 | Line 4855 | begin
4855    Transaction.StartTransaction;
4856   end;
4857  
4858 < function TIBCustomDataSet.PSGetTableName: string;
4858 > function TIBCustomDataSet.PsGetTableName: string;
4859   begin
4860   //  if not FInternalPrepared then
4861   //    InternalPrepare;
# Line 4536 | Line 4865 | begin
4865    if not FQSelect.Prepared then
4866      FQSelect.Prepare;
4867    Result := FQSelect.UniqueRelationName;
4868 < end;*)
4868 > end;
4869  
4870   procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4871   begin
# Line 4621 | Line 4950 | end;
4950   function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
4951    NativeFormat: Boolean): Boolean;
4952   begin
4953 <  if (Field.DataType = ftBCD) and not NativeFormat then
4953 >  {These datatypes use IBX conventions and not TDataset conventions}
4954 >  if (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) and not NativeFormat then
4955      Result := InternalGetFieldData(Field, Buffer)
4956    else
4957      Result := inherited GetFieldData(Field, Buffer, NativeFormat);
# Line 4647 | Line 4977 | end;
4977   procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
4978    NativeFormat: Boolean);
4979   begin
4980 <  if (not NativeFormat) and (Field.DataType = ftBCD) then
4980 >  {These datatypes use IBX conventions and not TDataset conventions}
4981 >  if (not NativeFormat) and (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) then
4982      InternalSetfieldData(Field, Buffer)
4983    else
4984      inherited SetFieldData(Field, buffer, NativeFormat);
# Line 4667 | Line 4998 | begin
4998    inherited Destroy;
4999   end;
5000  
5001 < procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
5001 > procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
5002   begin
5003    FRefreshSQL.Assign(Value);
5004   end;
5005  
5006 + procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
5007 +  buff: PChar);
5008 + begin
5009 +  if not Assigned(DataSet) then Exit;
5010 +  DataSet.SetInternalSQLParams(Params, buff);
5011 + end;
5012 +
5013   procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
5014   begin
5015 +  InternalSetParams(Query.Params,buff);
5016 + end;
5017 +
5018 + procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(UpdateKind: TUpdateKind;
5019 +  QryResults: IResults; Buffer: PChar);
5020 + begin
5021    if not Assigned(DataSet) then Exit;
5022 <  DataSet.SetInternalSQLParams(Query, buff);
5022 >  case UpdateKind of
5023 >  ukModify, ukInsert:
5024 >    DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5025 >  ukDelete:
5026 >    DataSet.DoDeleteReturning(QryResults);
5027 >  end;
5028   end;
5029  
5030   function TIBDSBlobStream.GetSize: Int64;
# Line 4738 | Line 5087 | end;
5087  
5088   procedure TIBGenerator.SetIncrement(const AValue: integer);
5089   begin
5090 +  if FIncrement = AValue then Exit;
5091    if AValue < 0 then
5092 <     raise Exception.Create('A Generator Increment cannot be negative');
5093 <  FIncrement := AValue
5092 >    IBError(ibxeNegativeGenerator,[]);
5093 >  FIncrement := AValue;
5094 >  SetQuerySQL;
5095   end;
5096  
5097 < function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4747 <  ATransaction: TIBTransaction): integer;
5097 > procedure TIBGenerator.SetTransaction(AValue: TIBTransaction);
5098   begin
5099 <  with TIBSQL.Create(nil) do
5100 <  try
5101 <    Database := ADatabase;
5102 <    Transaction := ATransaction;
5103 <    if not assigned(Database) then
5104 <       IBError(ibxeCannotSetDatabase,[]);
5105 <    if not assigned(Transaction) then
5106 <       IBError(ibxeCannotSetTransaction,[]);
5107 <    with Transaction do
5108 <      if not InTransaction then StartTransaction;
5109 <    SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
5110 <    Prepare;
5099 >  FQuery.Transaction := AValue;
5100 > end;
5101 >
5102 > procedure TIBGenerator.SetQuerySQL;
5103 > begin
5104 >  FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5105 > end;
5106 >
5107 > function TIBGenerator.GetDatabase: TIBDatabase;
5108 > begin
5109 >  Result := FQuery.Database;
5110 > end;
5111 >
5112 > function TIBGenerator.GetTransaction: TIBTransaction;
5113 > begin
5114 >  Result := FQuery.Transaction;
5115 > end;
5116 >
5117 > procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5118 > begin
5119 >  FQuery.Database := AValue;
5120 > end;
5121 >
5122 > procedure TIBGenerator.SetGeneratorName(AValue: string);
5123 > begin
5124 >  if FGeneratorName = AValue then Exit;
5125 >  FGeneratorName := AValue;
5126 >  SetQuerySQL;
5127 > end;
5128 >
5129 > function TIBGenerator.GetNextValue: integer;
5130 > begin
5131 >  with FQuery do
5132 >  begin
5133 >    Transaction.Active := true;
5134      ExecQuery;
5135      try
5136 <      Result := FieldByName('ID').AsInteger
5136 >      Result := Fields[0].AsInteger
5137      finally
5138        Close
5139      end;
4767  finally
4768    Free
5140    end;
5141   end;
5142  
# Line 4773 | Line 5144 | constructor TIBGenerator.Create(Owner: T
5144   begin
5145    FOwner := Owner;
5146    FIncrement := 1;
5147 +  FQuery := TIBSQL.Create(nil);
5148 + end;
5149 +
5150 + destructor TIBGenerator.Destroy;
5151 + begin
5152 +  if assigned(FQuery) then FQuery.Free;
5153 +  inherited Destroy;
5154   end;
5155  
5156  
5157   procedure TIBGenerator.Apply;
5158   begin
5159 <  if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5160 <    Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
5159 >  if assigned(Database) and assigned(Transaction) and
5160 >       (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5161 >    Owner.FieldByName(FFieldName).AsInteger := GetNextValue;
5162   end;
5163  
5164  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines