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

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 118 by tony, Mon Jan 22 13:58:14 2018 UTC

# Line 24 | Line 24
24   {       Corporation. All Rights Reserved.                                }
25   {    Contributor(s): Jeff Overcash                                       }
26   {                                                                        }
27 + {    IBX For Lazarus (Firebird Express)                                  }
28 + {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 + {    Portions created by MWA Software are copyright McCallum Whyman      }
30 + {    Associates Ltd 2011 - 2015                                          }
31 + {                                                                        }
32   {************************************************************************}
33  
34   unit IBCustomDataSet;
35  
36 + {$R-}
37 +
38 + {$IFDEF FPC}
39 + {$Mode Delphi}
40 + {$codepage UTF8}
41 + {$ENDIF}
42 +
43 + {$IFDEF DELPHI}
44 + {$DEFINE TDBDFIELD_IS_BCD}
45 + {$ENDIF}
46 +
47   interface
48  
49   uses
50 <  Windows, SysUtils, Classes, Forms, Controls, StdVCL,
51 <  IBExternals, IB, IBHeader, IBDatabase, IBSQL, Db,
52 <  IBUtils, IBBlob;
50 > {$IFDEF WINDOWS }
51 >  Windows,
52 > {$ELSE}
53 >  unix,
54 > {$ENDIF}
55 >  SysUtils, Classes, IBDatabase, IBExternals, IB,  IBSQL, Db,
56 >  IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo;
57  
58   const
59    BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
# Line 43 | Line 63 | type
63    TIBCustomDataSet = class;
64    TIBDataSet = class;
65  
66 +  { TIBDataSetUpdateObject }
67 +
68    TIBDataSetUpdateObject = class(TComponent)
69    private
70      FRefreshSQL: TStrings;
# Line 50 | Line 72 | type
72    protected
73      function GetDataSet: TIBCustomDataSet; virtual; abstract;
74      procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
75 <    procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
75 >    procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract;
76      function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
77 +    procedure InternalSetParams(Params: ISQLParams; buff: PChar); overload;
78 +    procedure InternalSetParams(Query: TIBSQL; buff: PChar); overload;
79 +    procedure UpdateRecordFromQuery(UpdateKind: TUpdateKind; QryResults: IResults; Buffer: PChar);
80      property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
81    public
82      constructor Create(AOwner: TComponent); override;
# Line 60 | Line 85 | type
85      property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
86    end;
87  
63  PDateTime = ^TDateTime;
88    TBlobDataArray = array[0..0] of TIBBlobStream;
89    PBlobDataArray = ^TBlobDataArray;
90 +  TIBArrayField = class;
91  
92 <  { TIBCustomDataSet }
93 <  TFieldData = record
94 <    fdDataType: Short;
95 <    fdDataScale: Short;
96 <    fdNullable: Boolean;
97 <    fdIsNull: Boolean;
98 <    fdDataSize: Short;
99 <    fdDataLength: Short;
100 <    fdDataOfs: Integer;
92 >  { TIBArray }
93 >
94 >  {Wrapper class to support array cache in TIBCustomDataset and event handling}
95 >
96 >  TIBArray = class
97 >  private
98 >    FArray: IArray;
99 >    FRecNo: integer;
100 >    FField: TIBArrayField;
101 >    procedure EventHandler(Sender: IArray; Reason: TArrayEventReason);
102 >  public
103 >    constructor Create(aField: TIBArrayField; anArray: IArray);
104 >    destructor Destroy; override;
105 >    property ArrayIntf: IArray read FArray;
106    end;
107 <  PFieldData = ^TFieldData;
107 >
108 >  TArrayDataArray = array [0..0] of TIBArray;
109 >  PArrayDataArray = ^TArrayDataArray;
110 >
111 >  { TIBCustomDataSet }
112  
113    TCachedUpdateStatus = (
114                           cusUnmodified, cusModified, cusInserted,
# Line 85 | Line 119 | type
119    end;
120    PIBDBKey = ^TIBDBKey;
121  
122 +  PFieldData = ^TFieldData;
123 +  TFieldData = record
124 +   fdIsNull: Boolean;
125 +   fdDataLength: Short;
126 + end;
127 +
128 + PColumnData = ^TColumnData;
129 + TColumnData = record
130 +  fdDataType: Short;
131 +  fdDataScale: Short;
132 +  fdNullable: Boolean;
133 +  fdDataSize: Short;
134 +  fdDataOfs: Integer;
135 +  fdCodePage: TSystemCodePage;
136 + end;
137 +
138 + PFieldColumns = ^TFieldColumns;
139 + TFieldColumns =  array[1..1] of TColumnData;
140 +
141    TRecordData = record
142      rdBookmarkFlag: TBookmarkFlag;
143      rdFieldCount: Short;
144 <    rdRecordNumber: Long;
144 >    rdRecordNumber: Integer;
145      rdCachedUpdateStatus: TCachedUpdateStatus;
146      rdUpdateStatus: TUpdateStatus;
147      rdSavedOffset: DWORD;
# Line 97 | Line 150 | type
150    end;
151    PRecordData = ^TRecordData;
152  
153 +  { TIBArrayField }
154 +
155 +  TIBArrayField = class(TField)
156 +  private
157 +    FArrayBounds: TArrayBounds;
158 +    FArrayDimensions: integer;
159 +    FRelationName: string;
160 +    FCacheOffset: word;
161 +    function GetArrayID: TISC_QUAD;
162 +    function GetArrayIntf: IArray;
163 +    procedure SetArrayIntf(AValue: IArray);
164 +  protected
165 +    class procedure CheckTypeSize(AValue: Longint); override;
166 +    function GetAsString: string; override;
167 +    function GetDataSize: Integer; override;
168 +    procedure Bind(Binding: Boolean); override;
169 +  public
170 +    constructor Create(AOwner: TComponent); override;
171 +    function CreateArray: IArray;
172 +    property ArrayID: TISC_QUAD read GetArrayID;
173 +    property ArrayIntf: IArray read GetArrayIntf write SetArrayIntf;
174 +    property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
175 +    property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
176 +  end;
177 +
178    { TIBStringField allows us to have strings longer than 8196 }
179  
180    TIBStringField = class(TStringField)
181 +  private
182 +    FCharacterSetName: RawByteString;
183 +    FCharacterSetSize: integer;
184 +    FAutoFieldSize: boolean;
185 +    FCodePage: TSystemCodePage;
186 +    FDataSize: integer;
187 +  protected
188 +    procedure Bind(Binding: Boolean); override;
189 +    function GetDataSize: Integer; override;
190    public
191 <    constructor create(AOwner: TComponent); override;
191 >    constructor Create(aOwner: TComponent); override;
192      class procedure CheckTypeSize(Value: Integer); override;
193      function GetAsString: string; override;
194      function GetAsVariant: Variant; override;
195      function GetValue(var Value: string): Boolean;
196      procedure SetAsString(const Value: string); override;
197 +    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
198 +    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
199 +    property CodePage: TSystemCodePage read FCodePage write FCodePage;
200 +  published
201 +    property AutoFieldSize: boolean read FAutoFieldSize write FAutoFieldSize default true;
202    end;
203  
204    { TIBBCDField }
# Line 117 | Line 209 | type
209       Note: y > 4 will default to Floats
210    }
211    TIBBCDField = class(TBCDField)
212 +  private
213 +    FIdentityColumn: boolean;
214    protected
215 +    procedure Bind(Binding: Boolean); override;
216      class procedure CheckTypeSize(Value: Integer); override;
217      function GetAsCurrency: Currency; override;
218      function GetAsString: string; override;
# Line 125 | Line 220 | type
220      function GetDataSize: Integer; override;
221    public
222      constructor Create(AOwner: TComponent); override;
223 +    property IdentityColumn: boolean read FIdentityColumn;
224    published
225      property Size default 8;
226    end;
227  
228 +  {The following integer field types extend the built in versions to enable IBX appplications
229 +   to check for an Identity column}
230 +
231 +  { TIBSmallintField }
232 +
233 +  TIBSmallintField = class(TSmallintField)
234 +  private
235 +    FIdentityColumn: boolean;
236 +  protected
237 +    procedure Bind(Binding: Boolean); override;
238 +  public
239 +    property IdentityColumn: boolean read FIdentityColumn;
240 +  end;
241 +
242 +  { TIBIntegerField }
243 +
244 +  TIBIntegerField = class(TIntegerField)
245 +  private
246 +    FIdentityColumn: boolean;
247 +  protected
248 +    procedure Bind(Binding: Boolean); override;
249 +  public
250 +    property IdentityColumn: boolean read FIdentityColumn;
251 +  end;
252 +
253 +  { TIBLargeIntField }
254 +
255 +  TIBLargeIntField = class(TLargeIntField)
256 +  private
257 +    FIdentityColumn: boolean;
258 +  protected
259 +    procedure Bind(Binding: Boolean); override;
260 +  public
261 +    property IdentityColumn: boolean read FIdentityColumn;
262 +  end;
263 +
264 +  {TIBMemoField}
265 +  {Allows us to show truncated text in DBGrids and anything else that uses
266 +   DisplayText}
267 +
268 +   TIBMemoField = class(TMemoField)
269 +   private
270 +     FCharacterSetName: RawByteString;
271 +     FCharacterSetSize: integer;
272 +     FDisplayTextAsClassName: boolean;
273 +     function GetTruncatedText: string;
274 +   protected
275 +     procedure Bind(Binding: Boolean); override;
276 +     function GetAsString: string; override;
277 +     function GetDefaultWidth: Longint; override;
278 +     procedure GetText(var AText: string; ADisplayText: Boolean); override;
279 +     procedure SetAsString(const AValue: string); override;
280 +   public
281 +     constructor Create(AOwner: TComponent); override;
282 +     property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
283 +     property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
284 +   published
285 +     property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
286 +                                            write FDisplayTextAsClassName;
287 +   private
288 +     FCodePage: TSystemCodePage;
289 +     FFCodePage: TSystemCodePage;
290 +   public
291 +     property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
292 +   end;
293 +
294    TIBDataLink = class(TDetailDataLink)
295    private
296      FDataSet: TIBCustomDataSet;
# Line 142 | Line 304 | type
304      destructor Destroy; override;
305    end;
306  
307 +  TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord);
308 +
309 +  { TIBGenerator }
310 +
311 +  TIBGenerator = class(TPersistent)
312 +  private
313 +    FOwner: TIBCustomDataSet;
314 +    FApplyOnEvent: TIBGeneratorApplyOnEvent;
315 +    FFieldName: string;
316 +    FGeneratorName: string;
317 +    FIncrement: integer;
318 +    FQuery: TIBSQL;
319 +    function GetDatabase: TIBDatabase;
320 +    function GetTransaction: TIBTransaction;
321 +    procedure SetDatabase(AValue: TIBDatabase);
322 +    procedure SetGeneratorName(AValue: string);
323 +    procedure SetIncrement(const AValue: integer);
324 +    procedure SetTransaction(AValue: TIBTransaction);
325 +    procedure SetQuerySQL;
326 +  protected
327 +    function GetNextValue: integer;
328 +  public
329 +    constructor Create(Owner: TIBCustomDataSet);
330 +    destructor Destroy; override;
331 +    procedure Apply;
332 +    property Owner: TIBCustomDataSet read FOwner;
333 +    property Database: TIBDatabase read GetDatabase write SetDatabase;
334 +    property Transaction: TIBTransaction read GetTransaction write SetTransaction;
335 +  published
336 +    property Generator: string read FGeneratorName write SetGeneratorName;
337 +    property Field: string read FFieldName write FFieldName;
338 +    property Increment: integer read FIncrement write SetIncrement default 1;
339 +    property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
340 +  end;
341 +
342 +  {TIBControlLink - Allows IB Aware controls to react to dataset state changes}
343 +
344 +  TIBControlLink = class
345 +  private
346 +    FTIBDataSet: TIBCustomDataSet;
347 +    procedure SetIBDataSet(AValue: TIBCustomDataSet);
348 +  protected
349 +    procedure UpdateSQL(Sender: TObject); virtual;
350 +    procedure UpdateParams(Sender: TObject); virtual;
351 +  public
352 +    destructor Destroy; override;
353 +    property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
354 +  end;
355 +
356 +  TIBAutoCommit = (acDisabled, acCommitRetaining);
357 +
358    { TIBCustomDataSet }
359 +
360    TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
361  
362    TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
363 <                                 UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
363 >                                 UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
364                                   of object;
365    TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
366                                     var UpdateAction: TIBUpdateAction) of object;
367  
368    TIBUpdateRecordTypes = set of TCachedUpdateStatus;
369  
370 +  TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
371 +
372 +  TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
373 +
374 +  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;
161    FIBLoaded: Boolean;
387      FBase: TIBBase;
388      FBlobCacheOffset: Integer;
389      FBlobStreamList: TList;
390 +    FArrayList: TList;
391      FBufferChunks: Integer;
392      FBufferCache,
393      FOldBufferCache: PChar;
# Line 179 | Line 405 | type
405      FDeletedRecords: Long;
406      FModelBuffer,
407      FOldBuffer: PChar;
408 +    FOnDeleteReturning: TOnDeleteReturning;
409 +    FOnValidatePost: TOnValidatePost;
410      FOpen: Boolean;
411      FInternalPrepared: Boolean;
412      FQDelete,
# Line 186 | Line 414 | type
414      FQRefresh,
415      FQSelect,
416      FQModify: TIBSQL;
417 +    FDatabaseInfo: TIBDatabaseInfo;
418      FRecordBufferSize: Integer;
419      FRecordCount: Integer;
420      FRecordSize: Integer;
421 +    FDataSetCloseAction: TDataSetCloseAction;
422      FUniDirectional: Boolean;
423      FUpdateMode: TUpdateMode;
424      FUpdateObject: TIBDataSetUpdateObject;
# Line 206 | Line 436 | type
436      FBeforeTransactionEnd,
437      FAfterTransactionEnd,
438      FTransactionFree: TNotifyEvent;
439 <
440 <    function GetSelectStmtHandle: TISC_STMT_HANDLE;
439 >    FAliasNameMap: array of string;
440 >    FAliasNameList: array of string;
441 >    FBaseSQLSelect: TStrings;
442 >    FParser: TSelectSQLParser;
443 >    FCloseAction: TTransactionAction;
444 >    FInTransactionEnd: boolean;
445 >    FIBLinks: TList;
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 219 | 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);
467      procedure DoAfterDatabaseDisconnect(Sender: TObject);
468      procedure DoDatabaseFree(Sender: TObject);
469 <    procedure DoBeforeTransactionEnd(Sender: TObject);
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;
232    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;
484 <    function GetTRHandle: PISC_TR_HANDLE;
485 <    procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
484 >    function GetParser: TSelectSQLParser;
485 >    procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
486      function InternalLocate(const KeyFields: string; const KeyValues: Variant;
487                              Options: TLocateOptions): Boolean; virtual;
488 <    procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
489 <    procedure InternalRevertRecord(RecordNumber: Integer);
488 >    procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
489 >    procedure InternalRevertRecord(RecordNumber: Integer); virtual;
490      function IsVisible(Buffer: PChar): Boolean;
491 +    procedure RegisterIBLink(Sender: TIBControlLink);
492 +    procedure UnRegisterIBLink(Sender: TIBControlLink);
493      procedure SaveOldBuffer(Buffer: PChar);
494      procedure SetBufferChunks(Value: Integer);
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;
261    procedure SQLChanging(Sender: TObject); virtual;
507      function AdjustPosition(FCache: PChar; Offset: DWORD;
508 <                            Origin: Integer): Integer;
508 >                            Origin: Integer): DWORD;
509      procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
510                         Buffer: PChar);
511      procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
# Line 269 | Line 514 | type
514                          Buffer: PChar);
515      procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
516      function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
517 <                       DoCheck: Boolean): TGetResult;
517 >                       DoCheck: Boolean): TGetResult; virtual;
518  
519    protected
520      procedure ActivateConnection;
# Line 277 | Line 522 | type
522      procedure DeactivateTransaction;
523      procedure CheckDatasetClosed;
524      procedure CheckDatasetOpen;
525 +    function CreateParser: TSelectSQLParser; virtual;
526 +    procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
527      function GetActiveBuf: PChar;
528 <    procedure InternalBatchInput(InputObject: TIBBatchInput);
529 <    procedure InternalBatchOutput(OutputObject: TIBBatchOutput);
528 >    procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
529 >    procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
530      procedure InternalPrepare; virtual;
531      procedure InternalUnPrepare; virtual;
532      procedure InternalExecQuery; virtual;
533      procedure InternalRefreshRow; virtual;
534 <    procedure InternalSetParamsFromCursor;
534 >    procedure InternalSetParamsFromCursor; virtual;
535      procedure CheckNotUniDirectional;
536 +    procedure SQLChanging(Sender: TObject); virtual;
537 +    procedure SQLChanged(Sender: TObject); virtual;
538  
539      { IProviderSupport }
540      procedure PSEndTransaction(Commit: Boolean); override;
# Line 309 | Line 558 | type
558      procedure ClearCalcFields(Buffer: PChar); override;
559      function AllocRecordBuffer: PChar; override;
560      procedure DoBeforeDelete; override;
561 +    procedure DoAfterDelete; override;
562      procedure DoBeforeEdit; override;
563 +    procedure DoAfterEdit; override;
564      procedure DoBeforeInsert; override;
565 +    procedure DoAfterInsert; override;
566 +    procedure DoBeforeClose; override;
567 +    procedure DoBeforeOpen; override;
568 +    procedure DoBeforePost; override;
569 +    procedure DoAfterPost; override;
570      procedure FreeRecordBuffer(var Buffer: PChar); override;
571      procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
572      function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
573      function GetCanModify: Boolean; override;
574      function GetDataSource: TDataSource; override;
575 +    function GetDBAliasName(FieldNo: integer): string;
576 +    function GetFieldDefFromAlias(aliasName: string): TFieldDef;
577      function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
578      function GetRecNo: Integer; override;
579      function GetRecord(Buffer: PChar; GetMode: TGetMode;
580                         DoCheck: Boolean): TGetResult; override;
581      function GetRecordCount: Integer; override;
582      function GetRecordSize: Word; override;
583 +    procedure InternalAutoCommit;
584      procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
585      procedure InternalCancel; override;
586      procedure InternalClose; override;
587      procedure InternalDelete; override;
588      procedure InternalFirst; override;
589 <    function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
589 >    function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual;
590      procedure InternalGotoBookmark(Bookmark: Pointer); override;
591      procedure InternalHandleException; override;
592      procedure InternalInitFieldDefs; override;
# Line 336 | Line 595 | type
595      procedure InternalOpen; override;
596      procedure InternalPost; override;
597      procedure InternalRefresh; override;
598 <    procedure InternalSetFieldData(Field: TField; Buffer: Pointer);
598 >    procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
599      procedure InternalSetToRecord(Buffer: PChar); override;
600      function IsCursorOpen: Boolean; override;
601 +    procedure Loaded; override;
602      procedure ReQuery;
603      procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
604      procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
605      procedure SetCachedUpdates(Value: Boolean);
606      procedure SetDataSource(Value: TDataSource);
607 +    procedure SetGenerateParamNames(AValue: Boolean); virtual;
608      procedure SetFieldData(Field : TField; Buffer : Pointer); override;
609      procedure SetFieldData(Field : TField; Buffer : Pointer;
610        NativeFormat : Boolean); overload; override;
# Line 351 | Line 612 | type
612  
613    protected
614      {Likely to be made public by descendant classes}
615 <    property SQLParams: TIBXSQLDA read GetSQLParams;
616 <    property Params: TIBXSQLDA read GetSQLParams;
615 >    property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
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;
629      property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
630      property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
631 +    property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
632      property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
633      property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
634      property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
# Line 373 | Line 636 | type
636      property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
637      property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
638      property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
639 +    property Parser: TSelectSQLParser read GetParser;
640 +    property BaseSQLSelect: TStrings read FBaseSQLSelect;
641  
642      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
643                                                   write FBeforeDatabaseDisconnect;
# Line 386 | Line 651 | type
651                                              write FAfterTransactionEnd;
652      property TransactionFree: TNotifyEvent read FTransactionFree
653                                             write FTransactionFree;
654 +    property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
655  
656    public
657      constructor Create(AOwner: TComponent); override;
# Line 393 | Line 659 | type
659      procedure ApplyUpdates;
660      function CachedUpdateStatus: TCachedUpdateStatus;
661      procedure CancelUpdates;
662 +    function GetFieldPosition(AliasName: string): integer;
663      procedure FetchAll;
664      function LocateNext(const KeyFields: string; const KeyValues: Variant;
665                          Options: TLocateOptions): Boolean;
666      procedure RecordModified(Value: Boolean);
667      procedure RevertRecord;
668      procedure Undelete;
669 +    procedure ResetParser; virtual;
670 +    function HasParser: boolean;
671  
672      { TDataSet support methods }
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;
680 >    function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
681      function GetFieldData(Field : TField; Buffer : Pointer;
682        NativeFormat : Boolean) : Boolean; overload; override;
683 +    property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
684      function Locate(const KeyFields: string; const KeyValues: Variant;
685                      Options: TLocateOptions): Boolean; override;
686      function Lookup(const KeyFields: string; const KeyValues: Variant;
687                      const ResultFields: string): Variant; override;
688      function UpdateStatus: TUpdateStatus; override;
689      function IsSequenced: Boolean; override;
690 <
691 <    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
692 <    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
690 >    procedure Post; override;
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
697                                                        write SetUpdateRecordTypes;
698 +    property DataSetCloseAction: TDataSetCloseAction
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;
707      property ForcedRefresh: Boolean read FForcedRefresh
708                                      write FForcedRefresh default False;
709      property AutoCalcFields;
433    property ObjectView default False;
710  
711      property AfterCancel;
712      property AfterClose;
# Line 459 | 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)
743 +  public
744 +    property Parser;
745    end;
746  
747 <  TIBDataSet = class(TIBCustomDataSet)
747 >  TIBDataSet = class(TIBParserDataSet)
748    private
749      function GetPrepared: Boolean;
750  
# Line 486 | Line 769 | type
769      property QModify;
770      property StatementType;
771      property SelectStmtHandle;
772 +    property BaseSQLSelect;
773  
774    published
775      { TIBCustomDataSet }
776 +    property AutoCommit;
777      property BufferChunks;
778      property CachedUpdates;
779      property DeleteSQL;
# Line 496 | Line 781 | type
781      property RefreshSQL;
782      property SelectSQL;
783      property ModifySQL;
784 +    property GeneratorField;
785 +    property GenerateParamNames;
786      property ParamCheck;
787      property UniDirectional;
788      property Filtered;
789 +    property DataSetCloseAction;
790  
791      property BeforeDatabaseDisconnect;
792      property AfterDatabaseDisconnect;
# Line 534 | Line 822 | type
822      property OnFilterRecord;
823      property OnNewRecord;
824      property OnPostError;
825 +    property OnValidatePost;
826 +    property OnDeleteReturning;
827    end;
828  
829    { TIBDSBlobStream }
830    TIBDSBlobStream = class(TStream)
831 +  private
832 +    FHasWritten: boolean;
833    protected
834      FField: TField;
835      FBlobStream: TIBBlobStream;
836 +    function  GetSize: Int64; override;
837    public
838      constructor Create(AField: TField; ABlobStream: TIBBlobStream;
839                         Mode: TBlobStreamMode);
840 +    destructor Destroy; override;
841      function Read(var Buffer; Count: Longint): Longint; override;
842      function Seek(Offset: Longint; Origin: Word): Longint; override;
843      procedure SetSize(NewSize: Longint); override;
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 568 | Line 887 | DefaultFieldClasses: array[TFieldType] o
887      TVarBytesField,     { ftVarBytes }
888      TAutoIncField,      { ftAutoInc }
889      TBlobField,         { ftBlob }
890 <    TMemoField,         { ftMemo }
890 >    TIBMemoField,       { ftMemo }
891      TGraphicField,      { ftGraphic }
892      TBlobField,         { ftFmtMemo }
893      TBlobField,         { ftParadoxOle }
# Line 576 | Line 895 | DefaultFieldClasses: array[TFieldType] o
895      TBlobField,         { ftTypedBinary }
896      nil,                { ftCursor }
897      TStringField,       { ftFixedChar }
898 <    nil, {TWideStringField } { ftWideString }
899 <    TLargeIntField,     { ftLargeInt }
898 >    nil,    { ftWideString }
899 >    TIBLargeIntField,     { ftLargeInt }
900 >    nil,          { ftADT }
901 >    TIBArrayField,        { ftArray }
902 >    nil,    { ftReference }
903 >    nil,     { ftDataSet }
904 >    TBlobField,         { ftOraBlob }
905 >    TMemoField,         { ftOraClob }
906 >    TVariantField,      { ftVariant }
907 >    nil,    { ftInterface }
908 >    nil,     { ftIDispatch }
909 >    TGuidField,        { ftGuid }
910 >    TDateTimeField,    {ftTimestamp}
911 >    TIBBCDField,       {ftFMTBcd}
912 >    nil,  {ftFixedWideChar}
913 >    nil);   {ftWideMemo}
914 > (*
915      TADTField,          { ftADT }
916      TArrayField,        { ftArray }
917      TReferenceField,    { ftReference }
# Line 587 | Line 921 | DefaultFieldClasses: array[TFieldType] o
921      TVariantField,      { ftVariant }
922      TInterfaceField,    { ftInterface }
923      TIDispatchField,     { ftIDispatch }
924 <    TGuidField);        { ftGuid }
925 < var
926 <  CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;
924 >    TGuidField);        { ftGuid } *)
925 > (*var
926 >  CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
927  
928   implementation
929  
930 < uses IBIntf, IBQuery;
930 > uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
931 >
932 > const FILE_BEGIN = 0;
933 >      FILE_CURRENT = 1;
934 >      FILE_END = 2;
935  
936   type
937  
# Line 602 | 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 613 | Line 952 | type
952    end;
953  
954  
955 +  {  Copied from LCLProc in order to avoid LCL dependency
956 +
957 +    Ensures the covenient look of multiline string
958 +    when displaying it in the single line
959 +    * Replaces CR and LF with spaces
960 +    * Removes duplicate spaces
961 +  }
962 +  function TextToSingleLine(const AText: string): string;
963 +  var
964 +    str: string;
965 +    i, wstart, wlen: Integer;
966 +  begin
967 +    str := Trim(AText);
968 +    wstart := 0;
969 +    wlen := 0;
970 +    i := 1;
971 +    while i < Length(str) - 1 do
972 +    begin
973 +      if (str[i] in [' ', #13, #10]) then
974 +      begin
975 +        if (wstart = 0) then
976 +        begin
977 +          wstart := i;
978 +          wlen := 1;
979 +        end else
980 +          Inc(wlen);
981 +      end else
982 +      begin
983 +        if wstart > 0 then
984 +        begin
985 +          str[wstart] := ' ';
986 +          Delete(str, wstart+1, wlen-1);
987 +          Dec(i, wlen-1);
988 +          wstart := 0;
989 +        end;
990 +      end;
991 +      Inc(i);
992 +    end;
993 +    Result := str;
994 +  end;
995 +
996 + { TIBLargeIntField }
997 +
998 + procedure TIBLargeIntField.Bind(Binding: Boolean);
999 + begin
1000 +  inherited Bind(Binding);
1001 +  if Binding and (FieldDef <> nil) then
1002 +     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1003 + end;
1004 +
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 + { TIBSmallintField }
1015 +
1016 + procedure TIBSmallintField.Bind(Binding: Boolean);
1017 + begin
1018 +  inherited Bind(Binding);
1019 +  if Binding and (FieldDef <> nil) then
1020 +     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1021 + end;
1022 +
1023 + { TIBArray }
1024 +
1025 + procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
1026 + begin
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 +    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 TIBArrayField.Create(AOwner: TComponent);
1102 + begin
1103 +  inherited Create(AOwner);
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 }
1114 +
1115 + function TIBMemoField.GetTruncatedText: string;
1116 + begin
1117 +   Result := GetAsString;
1118 +
1119 +   if Result <> '' then
1120 +   begin
1121 +       case CharacterSetSize of
1122 +       1:
1123 +         if DisplayWidth = 0 then
1124 +           Result := TextToSingleLine(Result)
1125 +         else
1126 +         if Length(Result) > DisplayWidth then {Show truncation with elipses}
1127 +           Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
1128 +
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 routines work for this codeset}
1133 +         if DisplayWidth = 0 then
1134 +           Result := ValidUTF8String(TextToSingleLine(Result))
1135 +         else
1136 +         if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1137 +           Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1138 +       end;
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;
1159 +  SetCodePage(s,CodePage,false);
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 +
1165 + function TIBMemoField.GetDefaultWidth: Longint;
1166 + begin
1167 +  if DisplayTextAsClassName then
1168 +    Result := inherited
1169 +  else
1170 +    Result := 128;
1171 + end;
1172 +
1173 + procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
1174 + begin
1175 +  if ADisplayText then
1176 +  begin
1177 +    if not DisplayTextAsClassName and (CharacterSetName <> '') then
1178 +      AText := GetTruncatedText
1179 +    else
1180 +      inherited GetText(AText, ADisplayText);
1181 +  end
1182 +  else
1183 +    AText := GetAsString;
1184 + end;
1185 +
1186 + procedure TIBMemoField.SetAsString(const AValue: string);
1187 + var s: RawByteString;
1188 + begin
1189 +  s := AValue;
1190 +  if StringCodePage(s) <> CodePage then
1191 +    SetCodePage(s,CodePage,CodePage<>CP_NONE);
1192 +  inherited SetAsString(s);
1193 + end;
1194 +
1195 + constructor TIBMemoField.Create(AOwner: TComponent);
1196 + begin
1197 +  inherited Create(AOwner);
1198 +  BlobType := ftMemo;
1199 +  FCodePage := CP_NONE;
1200 + end;
1201 +
1202 + { TIBControlLink }
1203 +
1204 + destructor TIBControlLink.Destroy;
1205 + begin
1206 +  IBDataSet := nil;
1207 +  inherited Destroy;
1208 + end;
1209 +
1210 + procedure TIBControlLink.UpdateParams(Sender: TObject);
1211 + begin
1212 +
1213 + end;
1214 +
1215 + procedure TIBControlLink.UpdateSQL(Sender: TObject);
1216 + begin
1217 +
1218 + end;
1219 +
1220 + procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1221 + begin
1222 +  if FTIBDataSet = AValue then Exit;
1223 +  if IBDataSet <> nil then
1224 +    IBDataSet.UnRegisterIBLink(self);
1225 +  FTIBDataSet := AValue;
1226 +  if IBDataSet <> nil then
1227 +    IBDataSet.RegisterIBLink(self);
1228 + end;
1229 +
1230 +
1231   { TIBStringField}
1232  
1233 < constructor TIBStringField.Create(AOwner: TComponent);
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 := FDataSize;
1252 > end;
1253 >
1254 > constructor TIBStringField.Create(aOwner: TComponent);
1255   begin
1256 <  inherited;
1256 >  inherited Create(aOwner);
1257 >  FCharacterSetSize := 1;
1258 >  FCodePage := CP_NONE;
1259 >  FAutoFieldSize := true;
1260   end;
1261  
1262   class procedure TIBStringField.CheckTypeSize(Value: Integer);
# Line 640 | Line 1279 | end;
1279   function TIBStringField.GetValue(var Value: string): Boolean;
1280   var
1281    Buffer: PChar;
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 <      Value := 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);
1296        if Transliterate and (Value <> '') then
1297          DataSet.Translate(PChar(Value), PChar(Value), False);
1298      end
# Line 659 | Line 1304 | end;
1304   procedure TIBStringField.SetAsString(const Value: string);
1305   var
1306    Buffer: PChar;
1307 +  s: RawByteString;
1308   begin
1309    Buffer := nil;
1310 <  IBAlloc(Buffer, 0, Size + 1);
1310 >  IBAlloc(Buffer, 0, DataSize);
1311    try
1312 <    StrLCopy(Buffer, PChar(Value), Size);
1312 >    s := Value;
1313 >    if StringCodePage(s) <> CodePage then
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 672 | Line 1321 | begin
1321    end;
1322   end;
1323  
1324 +
1325   { TIBBCDField }
1326  
1327   constructor TIBBCDField.Create(AOwner: TComponent);
# Line 681 | 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 714 | Line 1371 | end;
1371  
1372   function TIBBCDField.GetDataSize: Integer;
1373   begin
1374 + {$IFDEF TBCDFIELD_IS_BCD}
1375    Result := 8;
1376 + {$ELSE}
1377 +  Result := inherited GetDataSize
1378 + {$ENDIF}
1379   end;
1380  
1381   { TIBDataLink }
# Line 728 | Line 1389 | end;
1389   destructor TIBDataLink.Destroy;
1390   begin
1391    FDataSet.FDataLink := nil;
1392 <  inherited;
1392 >  inherited Destroy;
1393   end;
1394  
1395  
# Line 760 | Line 1421 | end;
1421  
1422   constructor TIBCustomDataSet.Create(AOwner: TComponent);
1423   begin
1424 <  inherited;
764 <  FIBLoaded := False;
765 <  CheckIBLoaded;
766 <  FIBLoaded := True;
1424 >  inherited Create(AOwner);
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);
1437    FQDelete.OnSQLChanging := SQLChanging;
# Line 782 | Line 1444 | begin
1444    FQRefresh.GoToFirstRecordOnExecute := False;
1445    FQSelect := TIBSQL.Create(Self);
1446    FQSelect.OnSQLChanging := SQLChanging;
1447 +  FQSelect.OnSQLChanged := SQLChanged;
1448    FQSelect.GoToFirstRecordOnExecute := False;
1449    FQModify := TIBSQL.Create(Self);
1450    FQModify.OnSQLChanging := SQLChanging;
1451    FQModify.GoToFirstRecordOnExecute := False;
1452    FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1453    FParamCheck := True;
1454 +  FGenerateParamNames := False;
1455    FForcedRefresh := False;
1456 +  FAutoCommit:= acDisabled;
1457 +  FDataSetCloseAction := dcDiscardChanges;
1458    {Bookmark Size is Integer for IBX}
1459    BookmarkSize := SizeOf(Integer);
1460    FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
# Line 802 | Line 1468 | begin
1468    else
1469      if AOwner is TIBTransaction then
1470        Transaction := TIBTransaction(AOwner);
1471 +  FBaseSQLSelect := TStringList.Create;
1472   end;
1473  
1474   destructor TIBCustomDataSet.Destroy;
1475   begin
1476 <  inherited;
1477 <  if FIBLoaded then
1478 <  begin
1479 <    FDataLink.Free;
1480 <    FBase.Free;
1481 <    ClearBlobCache;
1482 <    FBlobStreamList.Free;
1483 <    FreeMem(FBufferCache);
1484 <    FBufferCache := nil;
1485 <    FreeMem(FOldBufferCache);
1486 <    FOldBufferCache := nil;
1487 <    FCacheSize := 0;
1488 <    FOldCacheSize := 0;
1489 <    FMappedFieldPosition := nil;
1490 <  end;
1476 >  if Active then Active := false;
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;
1495   end;
1496  
1497   function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
# Line 842 | 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 861 | Line 1532 | end;
1532  
1533   procedure TIBCustomDataSet.ApplyUpdates;
1534   var
1535 <  CurBookmark: string;
1535 >  CurBookmark: TBookmark;
1536    Buffer: PRecordData;
1537    CurUpdateTypes: TIBUpdateRecordTypes;
1538    UpdateAction: TIBUpdateAction;
# Line 921 | Line 1592 | var
1592    procedure UpdateUsingUpdateObject;
1593    begin
1594      try
1595 <      FUpdateObject.Apply(UpdateKind);
1595 >      FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1596        ResetBufferUpdateStatus;
1597      except
1598        on E: Exception do
# Line 1059 | Line 1730 | begin
1730    end;
1731   end;
1732  
1733 + function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1734 + var i: integer;
1735 +    Prepared: boolean;
1736 + begin
1737 +  Result := 0;
1738 +  Prepared := FInternalPrepared;
1739 +  if not Prepared then
1740 +    InternalPrepare;
1741 +  try
1742 +    for i := 0 to Length(FAliasNameList) - 1 do
1743 +      if FAliasNameList[i] = AliasName then
1744 +      begin
1745 +        Result := i + 1;
1746 +        Exit
1747 +      end;
1748 +  finally
1749 +    if not Prepared then
1750 +      InternalUnPrepare;
1751 +  end;
1752 + end;
1753 +
1754   procedure TIBCustomDataSet.ActivateConnection;
1755   begin
1756    if not Assigned(Database) then
# Line 1071 | Line 1763 | end;
1763   function TIBCustomDataSet.ActivateTransaction: Boolean;
1764   begin
1765    Result := False;
1766 <  if not Assigned(Transaction) then
1075 <    IBError(ibxeTransactionNotAssigned, [nil]);
1076 <  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 1119 | Line 1814 | begin
1814      IBError(ibxeDatasetClosed, [nil]);
1815   end;
1816  
1817 + function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1818 + begin
1819 +  Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1820 +  Result.OnSQLChanging := SQLChanging
1821 + end;
1822 +
1823   procedure TIBCustomDataSet.CheckNotUniDirectional;
1824   begin
1825    if UniDirectional then
# Line 1196 | 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 1205 | 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 1222 | Line 1935 | begin
1935      FDatabaseFree(Sender);
1936   end;
1937  
1938 < procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1938 > procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1939 >  Action: TTransactionAction);
1940   begin
1941 <  if Active then
1942 <    Active := False;
1941 >  FCloseAction := Action;
1942 >  FInTransactionEnd := true;
1943 >  try
1944 >    if Active then
1945 >      Active := False;
1946 >  finally
1947 >    FInTransactionEnd := false;
1948 >  end;
1949    if FQSelect <> nil then
1950      FQSelect.FreeHandle;
1951    if FQDelete <> nil then
# Line 1236 | 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 1252 | 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;
1266 <  LocalInt64: Int64;
1267 <  LocalCurrency: Currency;
1268 <  FieldsLoaded: Integer;
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);
1271  { Make sure blob cache is empty }
1272  pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1273  if RecordNumber > -1 then
1274    for i := 0 to BlobFieldCount - 1 do
1275      pbd^[i] := nil;
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
2015 <      if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2014 >    if j > 0 then
2015 >    begin
2016 >      colMetadata := Qry.MetaData[i];
2017 >      with p^.rdFields[j], FFieldColumns^[j] do
2018        begin
2019 <        if sqllen <= 8 then
2020 <          p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
2021 <        continue;
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 >          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_INT64:
2046 >        begin
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_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 <    if j > 0 then with p^ do
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 <      rdFields[j].fdDataType :=
2083 <        Qry.Current[i].Data^.sqltype and (not 1);
2084 <      rdFields[j].fdDataScale :=
2085 <        Qry.Current[i].Data^.sqlscale;
2086 <      rdFields[j].fdNullable :=
2087 <        (Qry.Current[i].Data^.sqltype and 1 = 1);
2088 <      rdFields[j].fdIsNull :=
2089 <        (rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
2090 <      LocalData := Qry.Current[i].Data^.sqldata;
2091 <      case rdFields[j].fdDataType of
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 <            LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
1324 <          LocalData := PChar(@LocalDate);
1325 <        end;
1326 <        SQL_TYPE_DATE:
1327 <        begin
1328 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1329 <          if RecordNumber >= 0 then
1330 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
1331 <          LocalData := PChar(@LocalInt);
1332 <        end;
1333 <        SQL_TYPE_TIME:
1334 <        begin
1335 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1336 <          if RecordNumber >= 0 then
1337 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1338 <          LocalData := PChar(@LocalInt);
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
1346 <              LocalInt := Qry.Current[i].AsLong;
1347 <            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;
1360 <                LocalData := PChar(@LocalDouble);
1361 <              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
1369 <              LocalInt64 := Qry.Current[i].AsInt64;
1370 <            LocalData := PChar(@LocalInt64);
2142 >            LocalInt64 := ColData.AsInt64;
2143 >            LocalData := PByte(@LocalInt64);
2144            end
2145 <          else if (rdFields[j].fdDataScale >= (-4)) then
2146 <               begin
2147 <                 rdFields[j].fdDataSize := SizeOf(Currency);
2148 <                 if RecordNumber >= 0 then
2149 <                   LocalCurrency := Qry.Current[i].AsCurrency;
2150 <                   LocalData := PChar(@LocalCurrency);
2151 <               end
2152 <               else begin
2153 <                  rdFields[j].fdDataSize := SizeOf(Double);
2154 <                  if RecordNumber >= 0 then
2155 <                    LocalDouble := Qry.Current[i].AsDouble;
1383 <                  LocalData := PChar(@LocalDouble);
1384 <               end
2145 >          else
2146 >          if (fdDataScale >= (-4)) then
2147 >          begin
2148 >            LocalCurrency := ColData.AsCurrency;
2149 >            LocalData := PByte(@LocalCurrency);
2150 >            end
2151 >            else
2152 >            begin
2153 >              LocalDouble := ColData.AsDouble;
2154 >              LocalData := PByte(@LocalDouble);
2155 >            end
2156          end;
2157          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2158          begin
2159 <          rdFields[j].fdDataSize := SizeOf(Double);
2160 <          if RecordNumber >= 0 then
1390 <            LocalDouble := Qry.Current[i].AsDouble;
1391 <          LocalData := PChar(@LocalDouble);
1392 <        end;
1393 <        SQL_VARYING:
1394 <        begin
1395 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1396 <          rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1397 <          if RecordNumber >= 0 then
1398 <          begin
1399 <            if (rdFields[j].fdDataLength = 0) then
1400 <              LocalData := nil
1401 <            else
1402 <              LocalData := @Qry.Current[i].Data^.sqldata[2];
1403 <          end;
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
1409 <            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);
1417 <      end
1418 <      else begin
1419 <        if rdFields[j].fdDataType = SQL_VARYING then
1420 <        begin
1421 <          if LocalData <> nil then
1422 <            Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)
1423 <        end
1424 <        else
1425 <          Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
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 1471 | Line 2284 | begin
2284    result := FBase.Database;
2285   end;
2286  
1474 function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1475 begin
1476  result := FBase.DBHandle;
1477 end;
1478
2287   function TIBCustomDataSet.GetDeleteSQL: TStrings;
2288   begin
2289    result := FQDelete.SQL;
# Line 1486 | 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 1503 | 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 1518 | Line 2326 | begin
2326    result := FBase.Transaction;
2327   end;
2328  
1521 function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1522 begin
1523  result := FBase.TRHandle;
1524 end;
1525
2329   procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2330   begin
2331    if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2332 <    FUpdateObject.Apply(ukDelete)
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 1543 | Line 2348 | end;
2348   function TIBCustomDataSet.InternalLocate(const KeyFields: string;
2349    const KeyValues: Variant; Options: TLocateOptions): Boolean;
2350   var
2351 <  fl: TList;
2352 <  CurBookmark: string;
2353 <  fld, val: Variant;
2354 <  i, fld_cnt: Integer;
2351 >  keyFieldList: TList;
2352 >  CurBookmark: TBookmark;
2353 >  fieldValue: Variant;
2354 >  lookupValues: array of variant;
2355 >  i, fieldCount: Integer;
2356 >  fieldValueAsString: string;
2357 >  lookupValueAsString: string;
2358   begin
2359 <  fl := TList.Create;
2359 >  keyFieldList := TList.Create;
2360    try
2361 <    GetFieldList(fl, KeyFields);
2362 <    fld_cnt := fl.Count;
2361 >    GetFieldList(keyFieldList, KeyFields);
2362 >    fieldCount := keyFieldList.Count;
2363      CurBookmark := Bookmark;
2364 <    result := False;
2365 <    while ((not result) and (not EOF)) do
2364 >    result := false;
2365 >    SetLength(lookupValues, fieldCount);
2366 >    if not EOF then
2367      begin
2368 <      i := 0;
1560 <      result := True;
1561 <      while (result and (i < fld_cnt)) do
2368 >      for i := 0 to fieldCount - 1 do  {expand key values into lookupValues array}
2369        begin
2370 <        if fld_cnt > 1 then
2371 <          val := KeyValues[i]
2370 >        if VarIsArray(KeyValues) then
2371 >          lookupValues[i] := KeyValues[i]
2372 >        else
2373 >        if i > 0 then
2374 >          lookupValues[i] := NULL
2375          else
2376 <          val := KeyValues;
2377 <        fld := TField(fl[i]).Value;
2378 <        result := not (VarIsNull(val) xor VarIsNull(fld));
2379 <        if result and not VarIsNull(val) then
2376 >          lookupValues[0] := KeyValues;
2377 >
2378 >        {convert to upper case is case insensitive search}
2379 >        if (TField(keyFieldList[i]).DataType = ftString) and
2380 >           not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
2381 >            lookupValues[i] := UpperCase(lookupValues[i]);
2382 >      end;
2383 >    end;
2384 >    while not result and not EOF do   {search for a matching record}
2385 >    begin
2386 >      i := 0;
2387 >      result := true;
2388 >      while result and (i < fieldCount) do
2389 >      {see if all of the key fields matches}
2390 >      begin
2391 >        fieldValue := TField(keyFieldList[i]).Value;
2392 >        result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
2393 >        if result and not VarIsNull(fieldValue) then
2394          begin
2395            try
2396 <            fld := VarAsType(fld, VarType(val));
1573 <          except
1574 <            on E: EVariantError do result := False;
1575 <          end;
1576 <          if Result then
1577 <            if TField(fl[i]).DataType = ftString then
2396 >            if TField(keyFieldList[i]).DataType = ftString then
2397              begin
2398 +              {strings need special handling because of the locate options that
2399 +               apply to them}
2400 +              fieldValueAsString := TField(keyFieldList[i]).AsString;
2401 +              lookupValueAsString := lookupValues[i];
2402                if (loCaseInsensitive in Options) then
2403 <              begin
2404 <                fld := AnsiUpperCase(fld);
1582 <                val := AnsiUpperCase(val);
1583 <              end;
1584 <              fld := TrimRight(fld);
1585 <              val := TrimRight(val);
2403 >                fieldValueAsString := UpperCase(fieldValueAsString);
2404 >
2405                if (loPartialKey in Options) then
2406 <                result := result and (AnsiPos(val, fld) = 1)
2406 >                result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
2407                else
2408 <                result := result and (val = fld);
2409 <            end else
2410 <                result := result and (val = fld);
2408 >                result := result and (fieldValueAsString = lookupValueAsString);
2409 >            end
2410 >            else
2411 >              result := result and (lookupValues[i] =
2412 >                             VarAsType(fieldValue, VarType(lookupValues[i])));
2413 >          except on EVariantError do
2414 >            result := False;
2415 >          end;
2416          end;
2417          Inc(i);
2418        end;
2419        if not result then
2420 <        Next;
2420 >          Next;
2421      end;
2422      if not result then
2423        Bookmark := CurBookmark
2424      else
2425        CursorPosChanged;
2426    finally
2427 <    fl.Free;
2427 >    keyFieldList.Free;
2428 >    SetLength(lookupValues,0)
2429    end;
2430   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 1619 | 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
2480 <      FUpdateObject.Apply(ukDelete)
2480 >      FUpdateObject.Apply(ukDelete,Buff)
2481      else if (Qry = FQInsert) then
2482 <      FUpdateObject.Apply(ukInsert)
2482 >      FUpdateObject.Apply(ukInsert,Buff)
2483      else
2484 <      FUpdateObject.Apply(ukModify);
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  
2500   procedure TIBCustomDataSet.InternalRefreshRow;
2501   var
2502    Buff: PChar;
1652  SetCursor: Boolean;
2503    ofs: DWORD;
2504    Qry: TIBSQL;
2505   begin
2506 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1657 <  if SetCursor then
1658 <    Screen.Cursor := crHourGlass;
2506 >  FBase.SetCursor;
2507    try
2508      Buff := GetActiveBuf;
2509      if CanRefresh then
# Line 1672 | 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
1679 <             (Qry.Next <> nil) then
2526 >          if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2527            begin
2528              ofs := PRecordData(Buff)^.rdSavedOffset;
2529              FetchCurrentRecordToBuffer(Qry,
# Line 1699 | Line 2546 | begin
2546      else
2547        IBError(ibxeCannotRefresh, [nil]);
2548    finally
2549 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1703 <      Screen.Cursor := crDefault;
2549 >    FBase.RestoreCursor;
2550    end;
2551   end;
2552  
# Line 1770 | Line 2616 | begin
2616   end;
2617  
2618   procedure TIBCustomDataSet.InternalPrepare;
1773 var
1774  SetCursor: Boolean;
1775  DidActivate: Boolean;
2619   begin
2620    if FInternalPrepared then
2621      Exit;
2622 <  DidActivate := False;
1780 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1781 <  if SetCursor then
1782 <    Screen.Cursor := crHourGlass;
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
2629 +    begin
2630 +      FQSelect.OnSQLChanged := nil; {Do not react to change}
2631 +      try
2632 +        FQSelect.SQL.Text := FParser.SQLText;
2633 +      finally
2634 +        FQSelect.OnSQLChanged := SQLChanged;
2635 +      end;
2636 +    end;
2637 + //   writeln( FQSelect.SQL.Text);
2638      if FQSelect.SQL.Text <> '' then
2639      begin
2640        if not FQSelect.Prepared then
2641        begin
2642 +        FQSelect.GenerateParamNames := FGenerateParamNames;
2643          FQSelect.ParamCheck := ParamCheck;
2644          FQSelect.Prepare;
2645        end;
2646 <      if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
2646 >      FQDelete.GenerateParamNames := FGenerateParamNames;
2647 >      if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2648          FQDelete.Prepare;
2649 <      if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
2649 >      FQInsert.GenerateParamNames := FGenerateParamNames;
2650 >      if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2651          FQInsert.Prepare;
2652 <      if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
2652 >      FQRefresh.GenerateParamNames := FGenerateParamNames;
2653 >      if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2654          FQRefresh.Prepare;
2655 <      if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
2655 >      FQModify.GenerateParamNames := FGenerateParamNames;
2656 >      if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2657          FQModify.Prepare;
2658        FInternalPrepared := True;
2659        InternalInitFieldDefs;
2660      end else
2661        IBError(ibxeEmptyQuery, [nil]);
2662    finally
2663 <    if DidActivate then
1809 <      DeactivateTransaction;
1810 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1811 <      Screen.Cursor := crDefault;
2663 >    FBase.RestoreCursor;
2664    end;
2665   end;
2666  
# Line 1837 | 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 1876 | 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 1906 | 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;
2773 +  Param: ISQLParam;
2774   begin
2775    if (Buffer = nil) then
2776      IBError(ibxeBufferNotSet, [nil]);
# Line 1920 | Line 2778 | begin
2778      InternalPrepare;
2779    OldBuffer := nil;
2780    try
2781 <    for i := 0 to Qry.Params.Count - 1 do
2781 >    for i := 0 to Params.GetCount - 1 do
2782      begin
2783 <      fn := Qry.Params[i].Name;
2783 >      Param := Params[i];
2784 >      fn := Param.Name;
2785        if (Pos('OLD_', fn) = 1) then {mbcs ok}
2786        begin
2787          fn := Copy(fn, 5, Length(fn));
# Line 1942 | Line 2801 | begin
2801               cr := Buffer;
2802        j := FQSelect.FieldIndex[fn] + 1;
2803        if (j > 0) then
2804 <        with PRecordData(cr)^ do
2804 >        with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2805          begin
2806 <          if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2806 >          if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2807            begin
2808 <            PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2808 >            PIBDBKey(Param.AsPointer)^ := rdDBKey;
2809              continue;
2810            end;
2811 <          if rdFields[j].fdIsNull then
2812 <            Qry.Params[i].IsNull := True
2811 >          if fdIsNull then
2812 >            Param.IsNull := True
2813            else begin
2814 <            Qry.Params[i].IsNull := False;
2815 <            data := cr + rdFields[j].fdDataOfs;
2816 <            case rdFields[j].fdDataType of
2814 >            Param.IsNull := False;
2815 >            data := cr + fdDataOfs;
2816 >            case fdDataType of
2817                SQL_TEXT, SQL_VARYING:
2818                begin
2819 <                SetString(st, data, rdFields[j].fdDataLength);
2820 <                Qry.Params[i].AsString := st;
2819 >                SetString(st, data, fdDataLength);
2820 >                SetCodePage(st,fdCodePage,false);
2821 >                Param.AsString := st;
2822                end;
2823              SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2824 <              Qry.Params[i].AsDouble := PDouble(data)^;
2824 >              Param.AsDouble := PDouble(data)^;
2825              SQL_SHORT, SQL_LONG:
2826              begin
2827 <              if rdFields[j].fdDataScale = 0 then
2828 <                Qry.Params[i].AsLong := PLong(data)^
1969 <              else if rdFields[j].fdDataScale >= (-4) then
1970 <                Qry.Params[i].AsCurrency := PCurrency(data)^
2827 >              if fdDataScale = 0 then
2828 >                Param.AsLong := PLong(data)^
2829                else
2830 <                Qry.Params[i].AsDouble := PDouble(data)^;
2830 >              if fdDataScale >= (-4) then
2831 >                Param.AsCurrency := PCurrency(data)^
2832 >              else
2833 >                Param.AsDouble := PDouble(data)^;
2834              end;
2835              SQL_INT64:
2836              begin
2837 <              if rdFields[j].fdDataScale = 0 then
2838 <                Qry.Params[i].AsInt64 := PInt64(data)^
2839 <              else if rdFields[j].fdDataScale >= (-4) then
2840 <                Qry.Params[i].AsCurrency := PCurrency(data)^
2837 >              if fdDataScale = 0 then
2838 >                Param.AsInt64 := PInt64(data)^
2839 >              else
2840 >              if fdDataScale >= (-4) then
2841 >                Param.AsCurrency := PCurrency(data)^
2842                else
2843 <                Qry.Params[i].AsDouble := PDouble(data)^;
2843 >                Param.AsDouble := PDouble(data)^;
2844              end;
2845              SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2846 <              Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2847 <            SQL_TYPE_DATE:
2848 <            begin
1987 <              ts.Date := PInt(data)^;
1988 <              ts.Time := 0;
1989 <              Qry.Params[i].AsDate :=
1990 <                TimeStampToDateTime(ts);
1991 <            end;
1992 <            SQL_TYPE_TIME:
1993 <            begin
1994 <              ts.Date := 0;
1995 <              ts.Time := PInt(data)^;
1996 <              Qry.Params[i].AsTime :=
1997 <                TimeStampToDateTime(ts);
1998 <            end;
2846 >              Param.AsQuad := PISC_QUAD(data)^;
2847 >            SQL_TYPE_DATE,
2848 >            SQL_TYPE_TIME,
2849              SQL_TIMESTAMP:
2850 <              Qry.Params[i].AsDateTime :=
2851 <                TimeStampToDateTime(
2852 <                  MSecsToTimeStamp(PDouble(data)^));
2850 >            {This is an IBX native format and not the TDataset approach. See also SetFieldData}
2851 >              Param.AsDateTime := PDateTime(data)^;
2852 >            SQL_BOOLEAN:
2853 >              Param.AsBoolean := PWordBool(data)^;
2854            end;
2855          end;
2856        end;
# Line 2048 | Line 2899 | begin
2899      FQRefresh.Transaction := Value;
2900      FQSelect.Transaction := Value;
2901      FQModify.Transaction := Value;
2902 +    FGeneratorField.Transaction := Value;
2903    end;
2904   end;
2905  
# Line 2085 | Line 2937 | begin
2937    end;
2938   end;
2939  
2940 + procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2941 + begin
2942 +  if FIBLinks.IndexOf(Sender) = -1 then
2943 +    FIBLinks.Add(Sender);
2944 + end;
2945 +
2946  
2947   procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2948   begin
2949 <  if FOpen then
2950 <    InternalClose;
2949 >  Active := false;
2950 > {  if FOpen then
2951 >    InternalClose;}
2952    if FInternalPrepared then
2953      InternalUnPrepare;
2954 +  FieldDefs.Clear;
2955 +  FieldDefs.Updated := false;
2956 + end;
2957 +
2958 + procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2959 + begin
2960 +  FBaseSQLSelect.assign(FQSelect.SQL);
2961   end;
2962  
2963   { I can "undelete" uninserted records (make them "inserted" again).
# Line 2120 | Line 2986 | begin
2986    end;
2987   end;
2988  
2989 + procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2990 + begin
2991 +  FIBLinks.Remove(Sender);
2992 + end;
2993 +
2994   function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2995   begin
2996    if Active then
# Line 2136 | Line 3007 | begin
3007    Result := Assigned( FQSelect ) and FQSelect.EOF;
3008   end;
3009  
3010 + function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
3011 + begin
3012 +  ActivateConnection;
3013 +  ActivateTransaction;
3014 +  if not FInternalPrepared then
3015 +    InternalPrepare;
3016 +  Result := Params.ByName(ParamName);
3017 + end;
3018 +
3019 + {Beware: the parameter FCache is used as an identifier to determine which
3020 + cache is being operated on and is not referenced in the computation.
3021 + The result is an adjusted offset into the identified cache, either the
3022 + Buffer Cache or the old Buffer Cache.}
3023 +
3024   function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
3025 <                                        Origin: Integer): Integer;
3025 >                                        Origin: Integer): DWORD;
3026   var
3027    OldCacheSize: Integer;
3028   begin
# Line 2174 | Line 3059 | procedure TIBCustomDataSet.ReadCache(FCa
3059                                      Buffer: PChar);
3060   var
3061    pCache: PChar;
3062 +  AdjustedOffset: DWORD;
3063    bOld: Boolean;
3064   begin
3065    bOld := (FCache = FOldBufferCache);
3066 <  pCache := PChar(AdjustPosition(FCache, Offset, Origin));
3066 >  AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
3067    if not bOld then
3068 <    pCache := FBufferCache + Integer(pCache)
3068 >    pCache := FBufferCache + AdjustedOffset
3069    else
3070 <    pCache := FOldBufferCache + Integer(pCache);
3070 >    pCache := FOldBufferCache + AdjustedOffset;
3071    Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
3072    AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
3073   end;
# Line 2211 | Line 3097 | procedure TIBCustomDataSet.WriteCache(FC
3097                                       Buffer: PChar);
3098   var
3099    pCache: PChar;
3100 +  AdjustedOffset: DWORD;
3101    bOld: Boolean;
3102    dwEnd: DWORD;
3103   begin
3104    bOld := (FCache = FOldBufferCache);
3105 <  pCache := PChar(AdjustPosition(FCache, Offset, Origin));
3105 >  AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
3106    if not bOld then
3107 <    pCache := FBufferCache + Integer(pCache)
3107 >    pCache := FBufferCache + AdjustedOffset
3108    else
3109 <    pCache := FOldBufferCache + Integer(pCache);
3109 >    pCache := FOldBufferCache + AdjustedOffset;
3110    Move(Buffer^, pCache^, FRecordBufferSize);
3111    dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
3112    if not bOld then
# Line 2257 | Line 3144 | var
3144    Buff: PChar;
3145    bTr, bDB: Boolean;
3146   begin
3147 +  if (Field = nil) or (Field.DataSet <> self) then
3148 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3149    Buff := GetActiveBuf;
3150    if Buff = nil then
3151    begin
3152      fs := TIBBlobStream.Create;
3153      fs.Mode := bmReadWrite;
3154 +    fs.Database := Database;
3155 +    fs.Transaction := Transaction;
3156 +    fs.SetField(Field);
3157      FBlobStreamList.Add(Pointer(fs));
3158      result := TIBDSBlobStream.Create(Field, fs, Mode);
3159      exit;
# Line 2276 | Line 3168 | begin
3168      fs.Mode := bmReadWrite;
3169      fs.Database := Database;
3170      fs.Transaction := Transaction;
3171 +    fs.SetField(Field);
3172      fs.BlobID :=
3173 <      PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3173 >      PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3174      if (CachedUpdates) then
3175      begin
3176        bTr := not Transaction.InTransaction;
# Line 2298 | Line 3191 | begin
3191    result := TIBDSBlobStream.Create(Field, fs, Mode);
3192   end;
3193  
3194 + function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3195 + var Buff: PChar;
3196 +    pda: PArrayDataArray;
3197 +    bTr, bDB: Boolean;
3198 + begin
3199 +  if (Field = nil) or (Field.DataSet <> self) then
3200 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3201 +  Buff := GetActiveBuf;
3202 +  if Buff = nil then
3203 +    Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3204 +                              Field.FRelationName,Field.FieldName)
3205 +  else
3206 +  begin
3207 +    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3208 +    if pda^[Field.FCacheOffset] = nil then
3209 +    begin
3210 +      AdjustRecordOnInsert(Buff);
3211 +      if Field.IsNull then
3212 +        Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3213 +                                Field.FRelationName,Field.FieldName)
3214 +      else
3215 +        Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3216 +                            Field.FRelationName,Field.FieldName,Field.ArrayID);
3217 +      pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3218 +      FArrayList.Add(pda^[Field.FCacheOffset]);
3219 +      if (CachedUpdates) then
3220 +      begin
3221 +        bTr := not Transaction.InTransaction;
3222 +        bDB := not Database.Connected;
3223 +        if bDB then
3224 +          Database.Open;
3225 +        if bTr then
3226 +          Transaction.StartTransaction;
3227 +         pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3228 +        if bTr then
3229 +          Transaction.Commit;
3230 +        if bDB then
3231 +          Database.Close;
3232 +      end;
3233 +      WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3234 +    end
3235 +    else
3236 +      Result := pda^[Field.FCacheOffset].ArrayIntf;
3237 +  end;
3238 + end;
3239 +
3240 + procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3241 + var Buff: PChar;
3242 +    pda: PArrayDataArray;
3243 + begin
3244 +  if (Field = nil) or (Field.DataSet <> self) then
3245 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3246 +  Buff := GetActiveBuf;
3247 +  if Buff <> nil then
3248 +  begin
3249 +    AdjustRecordOnInsert(Buff);
3250 +    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3251 +    pda^[Field.FCacheOffset].FArray := AnArray;
3252 +    WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3253 +  end;
3254 + end;
3255 +
3256   function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3257   const
3258    CMPLess = -1;
# Line 2330 | Line 3285 | begin
3285    if FCachedUpdates and
3286      (Buff^.rdCachedUpdateStatus in [cusUnmodified]) then
3287      SaveOldBuffer(PChar(Buff));
3288 <  inherited;
3288 >  inherited DoBeforeDelete;
3289 > end;
3290 >
3291 > procedure TIBCustomDataSet.DoAfterDelete;
3292 > begin
3293 >  inherited DoAfterDelete;
3294 >  FBase.DoAfterDelete(self);
3295 >  InternalAutoCommit;
3296   end;
3297  
3298   procedure TIBCustomDataSet.DoBeforeEdit;
# Line 2344 | Line 3306 | begin
3306    if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
3307      SaveOldBuffer(PChar(Buff));
3308    CopyRecordBuffer(GetActiveBuf, FOldBuffer);
3309 <  inherited;
3309 >  inherited DoBeforeEdit;
3310 > end;
3311 >
3312 > procedure TIBCustomDataSet.DoAfterEdit;
3313 > begin
3314 >  inherited DoAfterEdit;
3315 >  FBase.DoAfterEdit(self);
3316   end;
3317  
3318   procedure TIBCustomDataSet.DoBeforeInsert;
3319   begin
3320    if not CanInsert then
3321      IBError(ibxeCannotInsert, [nil]);
3322 <  inherited;
3322 >  inherited DoBeforeInsert;
3323 > end;
3324 >
3325 > procedure TIBCustomDataSet.DoAfterInsert;
3326 > begin
3327 >  if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
3328 >    GeneratorField.Apply;
3329 >  inherited DoAfterInsert;
3330 >  FBase.DoAfterInsert(self);
3331 > end;
3332 >
3333 > procedure TIBCustomDataSet.DoBeforeClose;
3334 > begin
3335 >  inherited DoBeforeClose;
3336 >  if FInTransactionEnd and (FCloseAction = TARollback) then
3337 >     Exit;
3338 >  if State in [dsInsert,dsEdit] then
3339 >  begin
3340 >    if DataSetCloseAction = dcSaveChanges then
3341 >      Post;
3342 >      {Note this can fail with an exception e.g. due to
3343 >       database validation error. In which case the dataset remains open }
3344 >  end;
3345 >  if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3346 >    ApplyUpdates;
3347 > end;
3348 >
3349 > procedure TIBCustomDataSet.DoBeforeOpen;
3350 > var i: integer;
3351 > begin
3352 >  if assigned(FParser) then
3353 >     FParser.Reset;
3354 >  for i := 0 to FIBLinks.Count - 1 do
3355 >    TIBControlLink(FIBLinks[i]).UpdateSQL(self);
3356 >  inherited DoBeforeOpen;
3357 >  for i := 0 to FIBLinks.Count - 1 do
3358 >    TIBControlLink(FIBLinks[i]).UpdateParams(self);
3359 > end;
3360 >
3361 > procedure TIBCustomDataSet.DoBeforePost;
3362 > begin
3363 >  inherited DoBeforePost;
3364 >  if (State = dsInsert) and
3365 >     (GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
3366 >     GeneratorField.Apply
3367 > end;
3368 >
3369 > procedure TIBCustomDataSet.DoAfterPost;
3370 > begin
3371 >  inherited DoAfterPost;
3372 >  FBase.DoAfterPost(self);
3373 >  InternalAutoCommit;
3374   end;
3375  
3376   procedure TIBCustomDataSet.FetchAll;
3377   var
3378 <  SetCursor: Boolean;
2360 <  CurBookmark: string;
3378 >  CurBookmark: TBookmark;
3379   begin
3380 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3381 <  if SetCursor then
2364 <    Screen.Cursor := crHourGlass;
2365 <  try
3380 >  FBase.SetCursor;
3381 > try
3382      if FQSelect.EOF or not FQSelect.Open then
3383        exit;
3384      DisableControls;
# Line 2374 | Line 3390 | begin
3390        EnableControls;
3391      end;
3392    finally
3393 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2378 <      Screen.Cursor := crDefault;
3393 >    FBase.RestoreCursor;
3394    end;
3395   end;
3396  
# Line 2423 | Line 3438 | begin
3438      result := FDataLink.DataSource;
3439   end;
3440  
3441 + function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3442 + begin
3443 +  Result := FAliasNameMap[FieldNo-1]
3444 + end;
3445 +
3446 + function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3447 + var
3448 +   i: integer;
3449 + begin
3450 +   Result := nil;
3451 +   for i := 0 to Length(FAliasNameMap) - 1 do
3452 +       if FAliasNameMap[i] = aliasName then
3453 +       begin
3454 +         Result := FieldDefs[i];
3455 +         Exit
3456 +       end;
3457 + end;
3458 +
3459   function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3460   begin
3461    Result := DefaultFieldClasses[FieldType];
# Line 2441 | Line 3474 | begin
3474    result := False;
3475    Buff := GetActiveBuf;
3476    if (Buff = nil) or
3477 <     (not IsVisible(Buff)) then
3477 >     (not IsVisible(Buff)) or not assigned(Field.DataSet) then
3478      exit;
3479    { The intention here is to stuff the buffer with the data for the
3480     referenced field for the current record }
# Line 2453 | Line 3486 | begin
3486      if result and (Buffer <> nil) then
3487        Move(Buff[1], Buffer^, Field.DataSize);
3488    end
3489 <  else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3489 >  else
3490 >  if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3491       (FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3492 +  with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3493 +                         FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3494    begin
3495 <    result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
3495 >    result := not fdIsNull;
3496      if result and (Buffer <> nil) then
2461      with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
3497        begin
3498 <        Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3498 >        Data := Buff + fdDataOfs;
3499          if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3500          begin
3501 <          Move(Data^, Buffer^, fdDataLength);
3502 <          PChar(Buffer)[fdDataLength] := #0;
3501 >          if fdDataLength < Field.DataSize then
3502 >          begin
3503 >            Move(Data^, Buffer^, fdDataLength);
3504 >            PChar(Buffer)[fdDataLength] := #0;
3505 >          end
3506 >          else
3507 >            IBError(ibxeFieldSizeError,[Field.FieldName])
3508          end
3509          else
3510            Move(Data^, Buffer^, Field.DataSize);
# Line 2507 | Line 3547 | begin
3547          if not Accept and (GetMode = gmCurrent) then
3548            GetMode := gmPrior;
3549        except
3550 < //        Application.HandleException(Self);
3550 > //        FBase.HandleException(Self);
3551        end;
3552      end;
3553      RestoreState(SaveState);
# Line 2526 | Line 3566 | begin
3566          if FCurrentRecord < FRecordCount then
3567            ReadRecordCache(FCurrentRecord, Buffer, False)
3568          else begin
3569 <          while (not FQSelect.EOF) and
2530 <                (FQSelect.Next <> nil) and
3569 >          while (not FQSelect.EOF) and FQSelect.Next  and
3570                  (FCurrentRecord >= FRecordCount) do begin
3571              FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3572              Inc(FRecordCount);
# Line 2601 | Line 3640 | begin
3640    result := FRecordBufferSize;
3641   end;
3642  
3643 + procedure TIBCustomDataSet.InternalAutoCommit;
3644 + begin
3645 +  with Transaction do
3646 +    if InTransaction and (FAutoCommit = acCommitRetaining) then
3647 +    begin
3648 +      if CachedUpdates then ApplyUpdates;
3649 +      CommitRetaining;
3650 +    end;
3651 + end;
3652 +
3653   procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3654   begin
3655    CheckEditState;
# Line 2628 | Line 3677 | procedure TIBCustomDataSet.InternalCance
3677   var
3678    Buff: PChar;
3679    CurRec: Integer;
3680 +  pda: PArrayDataArray;
3681 +  i: integer;
3682   begin
3683 <  inherited;
3683 >  inherited InternalCancel;
3684    Buff := GetActiveBuf;
3685 <  if Buff <> nil then begin
3685 >  if Buff <> nil then
3686 >  begin
3687 >    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3688 >    for i := 0 to ArrayFieldCount - 1 do
3689 >      pda^[i].ArrayIntf.CancelChanges;
3690      CurRec := FCurrentRecord;
3691      AdjustRecordOnInsert(Buff);
3692      if (State = dsEdit) then begin
# Line 2654 | Line 3709 | begin
3709      DeactivateTransaction;
3710    FQSelect.Close;
3711    ClearBlobCache;
3712 +  ClearArrayCache;
3713    FreeRecordBuffer(FModelBuffer);
3714    FreeRecordBuffer(FOldBuffer);
3715    FCurrentRecord := -1;
# Line 2669 | Line 3725 | begin
3725    FOBEnd := 0;
3726    FreeMem(FBufferCache);
3727    FBufferCache := nil;
3728 +  FreeMem(FFieldColumns);
3729 +  FFieldColumns := nil;
3730    FreeMem(FOldBufferCache);
3731    FOldBufferCache := nil;
3732    BindFields(False);
3733 +  ResetParser;
3734    if DefaultFields then DestroyFields;
3735   end;
3736  
3737   procedure TIBCustomDataSet.InternalDelete;
3738   var
3739    Buff: PChar;
2681  SetCursor: Boolean;
3740   begin
3741 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2684 <  if SetCursor then
2685 <    Screen.Cursor := crHourGlass;
3741 >  FBase.SetCursor;
3742    try
3743      Buff := GetActiveBuf;
3744      if CanDelete then
# Line 2707 | Line 3763 | begin
3763      end else
3764        IBError(ibxeCannotDelete, [nil]);
3765    finally
3766 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2711 <      Screen.Cursor := crDefault;
3766 >    FBase.RestoreCursor;
3767    end;
3768   end;
3769  
# Line 2724 | Line 3779 | end;
3779  
3780   procedure TIBCustomDataSet.InternalHandleException;
3781   begin
3782 <  Application.HandleException(Self)
3782 >  FBase.HandleException(Self)
3783   end;
3784  
3785   procedure TIBCustomDataSet.InternalInitFieldDefs;
3786 + begin
3787 +  if not InternalPrepared then
3788 +  begin
3789 +    InternalPrepare;
3790 +    exit;
3791 +  end;
3792 +   FieldDefsFromQuery(FQSelect);
3793 + end;
3794 +
3795 + procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3796   const
3797    DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3798                 'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
# Line 2736 | Line 3801 | const
3801                 'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3802                 'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3803                 '     (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3804 +
3805 +  DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3806 +               'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3807 +               'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3808 +               'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
3809 +               'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3810 +               'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3811 +               '     (not F.RDB$DEFAULT_VALUE is NULL) or ' + {do not localize}
3812 +               '     ( not R.RDB$IDENTITY_TYPE is NULL))' ; {do not localize}
3813 +
3814   var
3815    FieldType: TFieldType;
3816    FieldSize: Word;
3817 +  FieldDataSize: integer;
3818 +  charSetID: short;
3819 +  CharSetSize: integer;
3820 +  CharSetName: RawByteString;
3821 +  FieldCodePage: TSystemCodePage;
3822    FieldNullable : Boolean;
3823    i, FieldPosition, FieldPrecision: Integer;
3824 <  FieldAliasName: string;
3825 <  RelationName, FieldName: string;
3824 >  FieldAliasName, DBAliasName: string;
3825 >  aRelationName, FieldName: string;
3826    Query : TIBSQL;
3827    FieldIndex: Integer;
3828    FRelationNodes : TRelationNode;
3829 +  aArrayDimensions: integer;
3830 +  aArrayBounds: TArrayBounds;
3831 +  ArrayMetaData: IArrayMetaData;
3832  
3833    function Add_Node(Relation, Field : String) : TRelationNode;
3834    var
# Line 2768 | Line 3851 | var
3851        FField.FieldName := Query.Fields[2].AsString;
3852        FField.DEFAULT_VALUE := not Query.Fields[1].IsNull;
3853        FField.COMPUTED_BLR := not Query.Fields[0].IsNull;
3854 +      FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull;
3855        FField.NextField := Result.FieldNodes;
3856        Result.FieldNodes := FField;
3857        Query.Next;
# Line 2821 | Line 3905 | var
3905          FField := Ffield.NextField;
3906    end;
3907  
3908 +  function Is_IDENTITY_COLUMN(Relation, Field : String) : Boolean;
3909 +  var
3910 +    FRelation : TRelationNode;
3911 +    FField : TFieldNode;
3912 +  begin
3913 +    FRelation := FRelationNodes;
3914 +    while Assigned(FRelation) and
3915 +         (FRelation.RelationName <> Relation) do
3916 +      FRelation := FRelation.NextRelation;
3917 +    if not Assigned(FRelation) then
3918 +      FRelation := Add_Node(Relation, Field);
3919 +    Result := false;
3920 +    FField := FRelation.FieldNodes;
3921 +    while Assigned(FField) do
3922 +      if FField.FieldName = Field then
3923 +      begin
3924 +        Result := Ffield.IDENTITY_COLUMN;
3925 +        Exit;
3926 +      end
3927 +      else
3928 +        FField := Ffield.NextField;
3929 +  end;
3930 +
3931    Procedure FreeNodes;
3932    var
3933      FRelation : TRelationNode;
# Line 2841 | Line 3948 | var
3948    end;
3949  
3950   begin
2844  if not InternalPrepared then
2845  begin
2846    InternalPrepare;
2847    exit;
2848  end;
3951    FRelationNodes := TRelationNode.Create;
3952    FNeedsRefresh := False;
3953 <  Database.InternalTransaction.StartTransaction;
3953 >  if not Database.InternalTransaction.InTransaction then
3954 >    Database.InternalTransaction.StartTransaction;
3955    Query := TIBSQL.Create(self);
3956    try
3957      Query.Database := DataBase;
# Line 2856 | Line 3959 | begin
3959      FieldDefs.BeginUpdate;
3960      FieldDefs.Clear;
3961      FieldIndex := 0;
3962 <    if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3963 <      SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3964 <    Query.SQL.Text := DefaultSQL;
3962 >    if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3963 >      SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3964 >    if FDatabaseInfo.ODSMajorVersion >= 12 then
3965 >      Query.SQL.Text := DefaultSQLODS12
3966 >    else
3967 >      Query.SQL.Text := DefaultSQL;
3968      Query.Prepare;
3969 <    for i := 0 to FQSelect.Current.Count - 1 do
3970 <      with FQSelect.Current[i].Data^ do
3969 >    SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3970 >    SetLength(FAliasNameList, SourceQuery.MetaData.Count);
3971 >    for i := 0 to SourceQuery.MetaData.GetCount - 1 do
3972 >      with SourceQuery.MetaData[i] do
3973        begin
3974          { Get the field name }
3975 <        SetString(FieldAliasName, aliasname, aliasname_length);
3976 <        SetString(RelationName, relname, relname_length);
3977 <        SetString(FieldName, sqlname, sqlname_length);
3975 >        FieldAliasName := GetName;
3976 >        DBAliasName := GetAliasname;
3977 >        aRelationName := getRelationName;
3978 >        FieldName := getSQLName;
3979 >        FAliasNameList[i] := DBAliasName;
3980          FieldSize := 0;
3981 +        FieldDataSize := GetSize;
3982          FieldPrecision := 0;
3983 <        FieldNullable := FQSelect.Current[i].IsNullable;
3984 <        case sqltype and not 1 of
3983 >        FieldNullable := IsNullable;
3984 >        CharSetSize := 0;
3985 >        CharSetName := '';
3986 >        FieldCodePage := CP_NONE;
3987 >        aArrayDimensions := 0;
3988 >        SetLength(aArrayBounds,0);
3989 >        case SQLType of
3990            { All VARCHAR's must be converted to strings before recording
3991             their values }
3992            SQL_VARYING, SQL_TEXT:
3993            begin
3994 <            FieldSize := sqllen;
3994 >            if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3995 >              CharSetSize := 1;
3996 >            CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3997 >            Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3998 >            FieldSize := FieldDataSize div CharSetSize;
3999              FieldType := ftString;
4000            end;
4001            { All Doubles/Floats should be cast to doubles }
# Line 2883 | Line 4003 | begin
4003              FieldType := ftFloat;
4004            SQL_SHORT:
4005            begin
4006 <            if (sqlscale = 0) then
4006 >            if (getScale = 0) then
4007                FieldType := ftSmallInt
4008              else begin
4009                FieldType := ftBCD;
4010                FieldPrecision := 4;
4011 <              FieldSize := -sqlscale;
4011 >              FieldSize := -getScale;
4012              end;
4013            end;
4014            SQL_LONG:
4015            begin
4016 <            if (sqlscale = 0) then
4016 >            if (getScale = 0) then
4017                FieldType := ftInteger
4018 <            else if (sqlscale >= (-4)) then
4018 >            else if (getScale >= (-4)) then
4019              begin
4020                FieldType := ftBCD;
4021                FieldPrecision := 9;
4022 <              FieldSize := -sqlscale;
4022 >              FieldSize := -getScale;
4023              end
4024              else
4025 <              FieldType := ftFloat;
4025 >            if Database.SQLDialect = 1 then
4026 >              FieldType := ftFloat
4027 >            else
4028 >            if (FieldCount > i) and (Fields[i] is TFloatField) then
4029 >              FieldType := ftFloat
4030 >            else
4031 >            begin
4032 >              FieldType := ftFMTBCD;
4033 >              FieldPrecision := 9;
4034 >              FieldSize := -getScale;
4035              end;
4036 +          end;
4037 +
4038            SQL_INT64:
4039            begin
4040 <            if (sqlscale = 0) then
4040 >            if (getScale = 0) then
4041                FieldType := ftLargeInt
4042 <            else if (sqlscale >= (-4)) then
4042 >            else if (getScale >= (-4)) then
4043              begin
4044                FieldType := ftBCD;
4045                FieldPrecision := 18;
4046 <              FieldSize := -sqlscale;
4046 >              FieldSize := -getScale;
4047              end
4048              else
4049                FieldType := ftFloat;
4050 <            end;
4050 >          end;
4051            SQL_TIMESTAMP: FieldType := ftDateTime;
4052            SQL_TYPE_TIME: FieldType := ftTime;
4053            SQL_TYPE_DATE: FieldType := ftDate;
4054            SQL_BLOB:
4055            begin
4056              FieldSize := sizeof (TISC_QUAD);
4057 <            if (sqlsubtype = 1) then
4058 <              FieldType := ftmemo
4057 >            if (getSubtype = 1) then
4058 >            begin
4059 >              if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4060 >                CharSetSize := 1;
4061 >              CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4062 >              Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4063 >              FieldType := ftMemo;
4064 >            end
4065              else
4066                FieldType := ftBlob;
4067            end;
4068            SQL_ARRAY:
4069            begin
4070              FieldSize := sizeof (TISC_QUAD);
4071 <            FieldType := ftUnknown;
4071 >            FieldType := ftArray;
4072 >            ArrayMetaData := GetArrayMetaData;
4073 >            if ArrayMetaData <> nil then
4074 >            begin
4075 >              aArrayDimensions := ArrayMetaData.GetDimensions;
4076 >              aArrayBounds := ArrayMetaData.GetBounds;
4077 >            end;
4078            end;
4079 +          SQL_BOOLEAN:
4080 +             FieldType:= ftBoolean;
4081            else
4082              FieldType := ftUnknown;
4083          end;
# Line 2941 | Line 4086 | begin
4086          begin
4087            FMappedFieldPosition[FieldIndex] := FieldPosition;
4088            Inc(FieldIndex);
4089 <          with FieldDefs.AddFieldDef do
4089 >          with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
4090            begin
4091 <            Name := string( FieldAliasName );
4092 <            FieldNo := FieldPosition;
2948 <            DataType := FieldType;
4091 >            Name := FieldAliasName;
4092 >            FAliasNameMap[FieldNo-1] := DBAliasName;
4093              Size := FieldSize;
4094 +            DataSize := FieldDataSize;
4095              Precision := FieldPrecision;
4096 <            Required := False;
4096 >            Required := not FieldNullable;
4097 >            RelationName := aRelationName;
4098              InternalCalcField := False;
4099 +            CharacterSetSize := CharSetSize;
4100 +            CharacterSetName := CharSetName;
4101 +            CodePage := FieldCodePage;
4102 +            ArrayDimensions := aArrayDimensions;
4103 +            ArrayBounds := aArrayBounds;
4104              if (FieldName <> '') and (RelationName <> '') then
4105              begin
4106 +              IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName);
4107                if Has_COMPUTED_BLR(RelationName, FieldName) then
4108                begin
4109                  Attributes := [faReadOnly];
# Line 2977 | Line 4129 | begin
4129      FreeNodes;
4130      Database.InternalTransaction.Commit;
4131      FieldDefs.EndUpdate;
4132 +    FieldDefs.Updated := true;
4133    end;
4134   end;
4135  
# Line 2994 | Line 4147 | begin
4147    else begin
4148      Buffer := AllocRecordBuffer;
4149      try
4150 <      while FQSelect.Next <> nil do
4150 >      while FQSelect.Next do
4151        begin
4152          FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
4153          Inc(FRecordCount);
# Line 3009 | Line 4162 | end;
4162   procedure TIBCustomDataSet.InternalSetParamsFromCursor;
4163   var
4164    i: Integer;
4165 <  cur_param: TIBXSQLVAR;
4165 >  cur_param: ISQLParam;
4166    cur_field: TField;
4167    s: TStream;
4168   begin
# Line 3017 | Line 4170 | begin
4170      IBError(ibxeEmptyQuery, [nil]);
4171    if not FInternalPrepared then
4172      InternalPrepare;
4173 <  if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4173 >  if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4174    begin
4175 <    for i := 0 to SQLParams.Count - 1 do
4175 >    for i := 0 to SQLParams.GetCount - 1 do
4176      begin
4177        cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4178 <      cur_param := SQLParams[i];
4179 <      if (cur_field <> nil) then begin
4178 >      if (cur_field <> nil) then
4179 >      begin
4180 >        cur_param := SQLParams[i];
4181          if (cur_field.IsNull) then
4182            cur_param.IsNull := True
4183 <        else case cur_field.DataType of
4183 >        else
4184 >        case cur_field.DataType of
4185            ftString:
4186              cur_param.AsString := cur_field.AsString;
4187 <          ftBoolean, ftSmallint, ftWord:
4187 >          ftBoolean:
4188 >            cur_param.AsBoolean := cur_field.AsBoolean;
4189 >          ftSmallint, ftWord:
4190              cur_param.AsShort := cur_field.AsInteger;
4191            ftInteger:
4192              cur_param.AsLong := cur_field.AsInteger;
4193            ftLargeInt:
4194 <            cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
4194 >            cur_param.AsInt64 := cur_field.AsLargeInt;
4195            ftFloat, ftCurrency:
4196             cur_param.AsDouble := cur_field.AsFloat;
4197            ftBCD:
# Line 3051 | Line 4208 | begin
4208              try
4209                s := DataSource.DataSet.
4210                       CreateBlobStream(cur_field, bmRead);
4211 <              cur_param.LoadFromStream(s);
4211 >              cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4212              finally
4213                s.free;
4214              end;
4215            end;
4216 +          ftArray:
4217 +            cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4218            else
4219              IBError(ibxeNotSupported, [nil]);
4220          end;
# Line 3082 | Line 4241 | begin
4241   end;
4242  
4243   procedure TIBCustomDataSet.InternalOpen;
3085 var
3086  SetCursor: Boolean;
4244  
4245    function RecordDataLength(n: Integer): Long;
4246    begin
# Line 3091 | Line 4248 | var
4248    end;
4249  
4250   begin
4251 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3095 <  if SetCursor then
3096 <    Screen.Cursor := crHourGlass;
4251 >  FBase.SetCursor;
4252    try
4253      ActivateConnection;
4254      ActivateTransaction;
# Line 3101 | Line 4256 | begin
4256        IBError(ibxeEmptyQuery, [nil]);
4257      if not FInternalPrepared then
4258        InternalPrepare;
4259 <   if FQSelect.SQLType = SQLSelect then
4259 >   if FQSelect.SQLStatementType = SQLSelect then
4260     begin
4261        if DefaultFields then
4262          CreateFields;
4263 +      FArrayFieldCount := 0;
4264        BindFields(True);
4265        FCurrentRecord := -1;
4266        FQSelect.ExecQuery;
# Line 3116 | Line 4272 | begin
4272          3. After the dummy fetch, FRecordSize will be appropriately
4273             adjusted to reflect the additional "weight" of the field
4274             data.
4275 <        4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4275 >        4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4276          5. Now, with the BufferSize available, allocate memory for chunks of records
4277          6. Re-allocate the model buffer, accounting for the new
4278             FRecordBufferSize.
4279          7. Finally, calls to AllocRecordBuffer will work!.
4280         }
4281        {Step 1}
4282 <      FRecordSize := RecordDataLength(FQSelect.Current.Count);
4282 >      FRecordSize := RecordDataLength(FQSelect.FieldCount);
4283        {Step 2, 3}
4284 +      GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4285        IBAlloc(FModelBuffer, 0, FRecordSize);
4286 <      FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4286 >      InitModelBuffer(FQSelect, FModelBuffer);
4287        {Step 4}
4288        FCalcFieldsOffset := FRecordSize;
4289        FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4290 <      FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4290 >      FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4291 >      FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4292        {Step 5}
4293        if UniDirectional then
4294          FBufferChunkSize := FRecordBufferSize * UniCache
# Line 3146 | Line 4304 | begin
4304        FCacheSize := FBufferChunkSize;
4305        FOldCacheSize := FBufferChunkSize;
4306        {Step 6}
4307 <      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4307 >      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4308                               FRecordBufferSize);
4309        {Step 7}
4310        FOldBuffer := AllocRecordBuffer;
# Line 3154 | Line 4312 | begin
4312      else
4313        FQSelect.ExecQuery;
4314    finally
4315 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3158 <      Screen.Cursor := crDefault;
4315 >    FBase.RestoreCursor;
4316    end;
4317   end;
4318  
# Line 3163 | Line 4320 | procedure TIBCustomDataSet.InternalPost;
4320   var
4321    Qry: TIBSQL;
4322    Buff: PChar;
3166  SetCursor: Boolean;
4323    bInserting: Boolean;
4324   begin
4325 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3170 <  if SetCursor then
3171 <    Screen.Cursor := crHourGlass;
4325 >  FBase.SetCursor;
4326    try
4327      Buff := GetActiveBuf;
4328      CheckEditState;
# Line 3206 | Line 4360 | begin
4360      if bInserting then
4361        Inc(FRecordCount);
4362    finally
4363 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3210 <      Screen.Cursor := crDefault;
4363 >    FBase.RestoreCursor;
4364    end;
4365   end;
4366  
4367   procedure TIBCustomDataSet.InternalRefresh;
4368   begin
4369 <  inherited;
4369 >  inherited InternalRefresh;
4370    InternalRefreshRow;
4371   end;
4372  
# Line 3227 | Line 4380 | begin
4380    result := FOpen;
4381   end;
4382  
4383 + procedure TIBCustomDataSet.Loaded;
4384 + begin
4385 +  if assigned(FQSelect) then
4386 +    FBaseSQLSelect.assign(FQSelect.SQL);
4387 +  inherited Loaded;
4388 + end;
4389 +
4390 + procedure TIBCustomDataSet.Post;
4391 + var CancelPost: boolean;
4392 + begin
4393 +  CancelPost := false;
4394 +  if assigned(FOnValidatePost) then
4395 +    OnValidatePost(self,CancelPost);
4396 +  if CancelPost then
4397 +    Cancel
4398 +  else
4399 +   inherited Post;
4400 + end;
4401 +
4402   function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4403                                   Options: TLocateOptions): Boolean;
4404   var
4405 <  CurBookmark: string;
4405 >  CurBookmark: TBookmark;
4406   begin
4407    DisableControls;
4408    try
# Line 3248 | Line 4420 | function TIBCustomDataSet.Lookup(const K
4420                                   const ResultFields: string): Variant;
4421   var
4422    fl: TList;
4423 <  CurBookmark: string;
4423 >  CurBookmark: TBookmark;
4424   begin
4425    DisableControls;
4426    fl := TList.Create;
# Line 3301 | Line 4473 | end;
4473   procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4474   var
4475    Buff, TmpBuff: PChar;
4476 +  MappedFieldPos: integer;
4477   begin
4478    Buff := GetActiveBuf;
4479    if Field.FieldNo < 0 then
# Line 3317 | Line 4490 | begin
4490      begin
4491        { If inserting, Adjust record position }
4492        AdjustRecordOnInsert(Buff);
4493 <      if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4494 <         (FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4493 >      MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4494 >      if (MappedFieldPos > 0) and
4495 >         (MappedFieldPos <= rdFieldCount) then
4496 >      with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4497        begin
4498          Field.Validate(Buffer);
4499          if (Buffer = nil) or
4500             (Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4501 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4502 <        else begin
4503 <          Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4504 <                 rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4505 <          if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4506 <             (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4507 <            rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
3333 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4501 >          fdIsNull := True
4502 >        else
4503 >        begin
4504 >          Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4505 >          if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4506 >            fdDataLength := StrLen(PChar(Buffer));
4507 >          fdIsNull := False;
4508            if rdUpdateStatus = usUnmodified then
4509            begin
4510              if CachedUpdates then
# Line 3354 | Line 4528 | begin
4528      end;
4529    end;
4530    if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
4531 <      DataEvent(deFieldChange, Longint(Field));
4531 >      DataEvent(deFieldChange, PtrInt(Field));
4532   end;
4533  
4534   procedure TIBCustomDataSet.SetRecNo(Value: Integer);
# Line 3418 | Line 4592 | begin
4592   FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4593   end;
4594  
4595 + procedure TIBCustomDataSet.ClearIBLinks;
4596 + var i: integer;
4597 + begin
4598 +  for i := FIBLinks.Count - 1 downto 0 do
4599 +    TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4600 + end;
4601 +
4602  
4603   procedure TIBCustomDataSet.InternalUnPrepare;
4604   begin
4605    if FInternalPrepared then
4606    begin
4607      CheckDatasetClosed;
4608 +    if FDidActivate then
4609 +      DeactivateTransaction;
4610      FieldDefs.Clear;
4611 +    FieldDefs.Updated := false;
4612      FInternalPrepared := False;
4613 +    Setlength(FAliasNameList,0);
4614    end;
4615   end;
4616  
4617   procedure TIBCustomDataSet.InternalExecQuery;
4618   var
4619    DidActivate: Boolean;
3435  SetCursor: Boolean;
4620   begin
4621    DidActivate := False;
4622 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3439 <  if SetCursor then
3440 <    Screen.Cursor := crHourGlass;
4622 >  FBase.SetCursor;
4623    try
4624      ActivateConnection;
4625      DidActivate := ActivateTransaction;
# Line 3445 | Line 4627 | begin
4627        IBError(ibxeEmptyQuery, [nil]);
4628      if not FInternalPrepared then
4629        InternalPrepare;
4630 <    if FQSelect.SQLType = SQLSelect then
4630 >    if FQSelect.SQLStatementType = SQLSelect then
4631      begin
4632        IBError(ibxeIsASelectStatement, [nil]);
4633      end
# Line 3454 | Line 4636 | begin
4636    finally
4637      if DidActivate then
4638        DeactivateTransaction;
4639 <    if SetCursor and (Screen.Cursor = crHourGlass) then
4640 <      Screen.Cursor := crDefault;
4639 >    FBase.RestoreCursor;
4640 >  end;
4641 > end;
4642 >
4643 > function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4644 > begin
4645 >  Result := FQSelect.Statement;
4646 > end;
4647 >
4648 > function TIBCustomDataSet.GetParser: TSelectSQLParser;
4649 > begin
4650 >  if not assigned(FParser) then
4651 >    FParser := CreateParser;
4652 >  Result := FParser
4653 > end;
4654 >
4655 > procedure TIBCustomDataSet.ResetParser;
4656 > begin
4657 >  if assigned(FParser) then
4658 >  begin
4659 >    FParser.Free;
4660 >    FParser := nil;
4661 >    FQSelect.OnSQLChanged := nil; {Do not react to change}
4662 >    try
4663 >      FQSelect.SQL.Assign(FBaseSQLSelect);
4664 >    finally
4665 >      FQSelect.OnSQLChanged := SQLChanged;
4666 >    end;
4667    end;
4668   end;
4669  
4670 < function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4670 > function TIBCustomDataSet.HasParser: boolean;
4671   begin
4672 <  Result := FQSelect.Handle;
4672 >  Result := not (csDesigning in ComponentState) and (FParser <> nil)
4673 > end;
4674 >
4675 > procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4676 > begin
4677 >  if FGenerateParamNames = AValue then Exit;
4678 >  FGenerateParamNames := AValue;
4679 >  Disconnect
4680   end;
4681  
4682   procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
# Line 3635 | Line 4850 | begin
4850    Transaction.StartTransaction;
4851   end;
4852  
4853 < function TIBCustomDataSet.PSGetTableName: string;
4853 > function TIBCustomDataSet.PsGetTableName: string;
4854   begin
4855   //  if not FInternalPrepared then
4856   //    InternalPrepare;
# Line 3682 | Line 4897 | begin
4897    ActivateConnection;
4898    ActivateTransaction;
4899    InternalSetParamsFromCursor;
4900 <  Inherited;
4900 >  Inherited InternalOpen;
4901   end;
4902  
4903   procedure TIBDataSet.SetFiltered(Value: Boolean);
# Line 3710 | Line 4925 | end;
4925  
4926   function TIBCustomDataSet.GetFieldData(Field: TField;
4927    Buffer: Pointer): Boolean;
4928 + {$IFDEF TBCDFIELD_IS_BCD}
4929   var
4930    lTempCurr : System.Currency;
4931   begin
# Line 3720 | Line 4936 | begin
4936        CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4937    end
4938    else
4939 + {$ELSE}
4940 + begin
4941 + {$ENDIF}
4942      Result := InternalGetFieldData(Field, Buffer);
4943   end;
4944  
4945   function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
4946    NativeFormat: Boolean): Boolean;
4947   begin
4948 <  if (Field.DataType = ftBCD) and not NativeFormat then
4948 >  {These datatypes use IBX conventions and not TDataset conventions}
4949 >  if (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) and not NativeFormat then
4950      Result := InternalGetFieldData(Field, Buffer)
4951    else
4952      Result := inherited GetFieldData(Field, Buffer, NativeFormat);
4953   end;
4954  
4955   procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4956 + {$IFDEF TDBDFIELD_IS_BCD}
4957   var
4958    lTempCurr : System.Currency;
4959   begin
4960 <  if Field.DataType = ftBCD then
4960 >  if (Field.DataType = ftBCD) and (Buffer <> nil) then
4961    begin
4962      BCDToCurr(TBCD(Buffer^), lTempCurr);
4963      InternalSetFieldData(Field, @lTempCurr);
4964    end
4965    else
4966 + {$ELSE}
4967 + begin
4968 + {$ENDIF}
4969      InternalSetFieldData(Field, Buffer);
4970   end;
4971  
4972   procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
4973    NativeFormat: Boolean);
4974   begin
4975 <  if (not NativeFormat) and (Field.DataType = ftBCD) then
4975 >  {These datatypes use IBX conventions and not TDataset conventions}
4976 >  if (not NativeFormat) and (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) then
4977      InternalSetfieldData(Field, Buffer)
4978    else
4979      inherited SetFieldData(Field, buffer, NativeFormat);
# Line 3765 | Line 4990 | end;
4990   destructor TIBDataSetUpdateObject.Destroy;
4991   begin
4992    FRefreshSQL.Free;
4993 <  inherited destroy;
4993 >  inherited Destroy;
4994   end;
4995  
4996 < procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
4996 > procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
4997   begin
4998    FRefreshSQL.Assign(Value);
4999   end;
5000  
5001 + procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
5002 +  buff: PChar);
5003 + begin
5004 +  if not Assigned(DataSet) then Exit;
5005 +  DataSet.SetInternalSQLParams(Params, buff);
5006 + end;
5007 +
5008 + procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
5009 + begin
5010 +  InternalSetParams(Query.Params,buff);
5011 + end;
5012 +
5013 + procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(UpdateKind: TUpdateKind;
5014 +  QryResults: IResults; Buffer: PChar);
5015 + begin
5016 +  if not Assigned(DataSet) then Exit;
5017 +  case UpdateKind of
5018 +  ukModify, ukInsert:
5019 +    DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5020 +  ukDelete:
5021 +    DataSet.DoDeleteReturning(QryResults);
5022 +  end;
5023 + end;
5024 +
5025 + function TIBDSBlobStream.GetSize: Int64;
5026 + begin
5027 +  Result := FBlobStream.BlobSize;
5028 + end;
5029 +
5030   { TIBDSBlobStream }
5031   constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
5032                                      Mode: TBlobStreamMode);
# Line 3781 | Line 5035 | begin
5035    FBlobStream := ABlobStream;
5036    FBlobStream.Seek(0, soFromBeginning);
5037    if (Mode = bmWrite) then
5038 +  begin
5039      FBlobStream.Truncate;
5040 +    TIBCustomDataSet(FField.DataSet).RecordModified(True);
5041 +    TBlobField(FField).Modified := true;
5042 +    FHasWritten := true;
5043 +  end;
5044 + end;
5045 +
5046 + destructor TIBDSBlobStream.Destroy;
5047 + begin
5048 +  if FHasWritten then
5049 +     TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
5050 +  inherited Destroy;
5051   end;
5052  
5053   function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
# Line 3804 | Line 5070 | begin
5070    if not (FField.DataSet.State in [dsEdit, dsInsert]) then
5071      IBError(ibxeNotEditing, [nil]);
5072    TIBCustomDataSet(FField.DataSet).RecordModified(True);
5073 +  TBlobField(FField).Modified := true;
5074    result := FBlobStream.Write(Buffer, Count);
5075 <  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
5075 >  FHasWritten := true;
5076 > {  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
5077 >  Removed as this caused a seek to beginning of the blob stream thus corrupting
5078 >  the blob stream. Moved to the destructor i.e. called after blob written}
5079 > end;
5080 >
5081 > { TIBGenerator }
5082 >
5083 > procedure TIBGenerator.SetIncrement(const AValue: integer);
5084 > begin
5085 >  if FIncrement = AValue then Exit;
5086 >  if AValue < 0 then
5087 >    IBError(ibxeNegativeGenerator,[]);
5088 >  FIncrement := AValue;
5089 >  SetQuerySQL;
5090 > end;
5091 >
5092 > procedure TIBGenerator.SetTransaction(AValue: TIBTransaction);
5093 > begin
5094 >  FQuery.Transaction := AValue;
5095 > end;
5096 >
5097 > procedure TIBGenerator.SetQuerySQL;
5098 > begin
5099 >  FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5100 > end;
5101 >
5102 > function TIBGenerator.GetDatabase: TIBDatabase;
5103 > begin
5104 >  Result := FQuery.Database;
5105   end;
5106  
5107 + function TIBGenerator.GetTransaction: TIBTransaction;
5108 + begin
5109 +  Result := FQuery.Transaction;
5110 + end;
5111 +
5112 + procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5113 + begin
5114 +  FQuery.Database := AValue;
5115 + end;
5116 +
5117 + procedure TIBGenerator.SetGeneratorName(AValue: string);
5118 + begin
5119 +  if FGeneratorName = AValue then Exit;
5120 +  FGeneratorName := AValue;
5121 +  SetQuerySQL;
5122 + end;
5123 +
5124 + function TIBGenerator.GetNextValue: integer;
5125 + begin
5126 +  with FQuery do
5127 +  begin
5128 +    Transaction.Active := true;
5129 +    ExecQuery;
5130 +    try
5131 +      Result := Fields[0].AsInteger
5132 +    finally
5133 +      Close
5134 +    end;
5135 +  end;
5136 + end;
5137 +
5138 + constructor TIBGenerator.Create(Owner: TIBCustomDataSet);
5139 + begin
5140 +  FOwner := Owner;
5141 +  FIncrement := 1;
5142 +  FQuery := TIBSQL.Create(nil);
5143 + end;
5144 +
5145 + destructor TIBGenerator.Destroy;
5146 + begin
5147 +  if assigned(FQuery) then FQuery.Free;
5148 +  inherited Destroy;
5149 + end;
5150 +
5151 +
5152 + procedure TIBGenerator.Apply;
5153 + begin
5154 +  if assigned(Database) and assigned(Transaction) and
5155 +       (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5156 +    Owner.FieldByName(FFieldName).AsInteger := GetNextValue;
5157 + end;
5158 +
5159 +
5160   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines