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 80 by tony, Mon Jan 1 11:31:07 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;
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      property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
80    public
81      constructor Create(AOwner: TComponent); override;
# Line 60 | Line 84 | type
84      property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
85    end;
86  
63  PDateTime = ^TDateTime;
87    TBlobDataArray = array[0..0] of TIBBlobStream;
88    PBlobDataArray = ^TBlobDataArray;
89 +  TIBArrayField = class;
90  
91 <  { TIBCustomDataSet }
92 <  TFieldData = record
93 <    fdDataType: Short;
94 <    fdDataScale: Short;
95 <    fdNullable: Boolean;
96 <    fdIsNull: Boolean;
97 <    fdDataSize: Short;
98 <    fdDataLength: Short;
99 <    fdDataOfs: Integer;
91 >  { TIBArray }
92 >
93 >  {Wrapper class to support array cache in TIBCustomDataset and event handling}
94 >
95 >  TIBArray = class
96 >  private
97 >    FArray: IArray;
98 >    FRecNo: integer;
99 >    FField: TIBArrayField;
100 >    procedure EventHandler(Sender: IArray; Reason: TArrayEventReason);
101 >  public
102 >    constructor Create(aField: TIBArrayField; anArray: IArray);
103 >    destructor Destroy; override;
104 >    property ArrayIntf: IArray read FArray;
105    end;
106 <  PFieldData = ^TFieldData;
106 >
107 >  TArrayDataArray = array [0..0] of TIBArray;
108 >  PArrayDataArray = ^TArrayDataArray;
109 >
110 >  { TIBCustomDataSet }
111  
112    TCachedUpdateStatus = (
113                           cusUnmodified, cusModified, cusInserted,
# Line 85 | Line 118 | type
118    end;
119    PIBDBKey = ^TIBDBKey;
120  
121 +  PFieldData = ^TFieldData;
122 +  TFieldData = record
123 +   fdIsNull: Boolean;
124 +   fdDataLength: Short;
125 + end;
126 +
127 + PColumnData = ^TColumnData;
128 + TColumnData = record
129 +  fdDataType: Short;
130 +  fdDataScale: Short;
131 +  fdNullable: Boolean;
132 +  fdDataSize: Short;
133 +  fdDataOfs: Integer;
134 +  fdCodePage: TSystemCodePage;
135 + end;
136 +
137 + PFieldColumns = ^TFieldColumns;
138 + TFieldColumns =  array[1..1] of TColumnData;
139 +
140    TRecordData = record
141      rdBookmarkFlag: TBookmarkFlag;
142      rdFieldCount: Short;
143 <    rdRecordNumber: Long;
143 >    rdRecordNumber: Integer;
144      rdCachedUpdateStatus: TCachedUpdateStatus;
145      rdUpdateStatus: TUpdateStatus;
146      rdSavedOffset: DWORD;
# Line 97 | Line 149 | type
149    end;
150    PRecordData = ^TRecordData;
151  
152 +  { TIBArrayField }
153 +
154 +  TIBArrayField = class(TField)
155 +  private
156 +    FArrayBounds: TArrayBounds;
157 +    FArrayDimensions: integer;
158 +    FRelationName: string;
159 +    FCacheOffset: word;
160 +    function GetArrayID: TISC_QUAD;
161 +    function GetArrayIntf: IArray;
162 +    procedure SetArrayIntf(AValue: IArray);
163 +  protected
164 +    class procedure CheckTypeSize(AValue: Longint); override;
165 +    function GetAsString: string; override;
166 +    function GetDataSize: Integer; override;
167 +    procedure Bind(Binding: Boolean); override;
168 +  public
169 +    constructor Create(AOwner: TComponent); override;
170 +    function CreateArray: IArray;
171 +    property ArrayID: TISC_QUAD read GetArrayID;
172 +    property ArrayIntf: IArray read GetArrayIntf write SetArrayIntf;
173 +    property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
174 +    property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
175 +  end;
176 +
177    { TIBStringField allows us to have strings longer than 8196 }
178  
179    TIBStringField = class(TStringField)
180 +  private
181 +    FCharacterSetName: RawByteString;
182 +    FCharacterSetSize: integer;
183 +    FAutoFieldSize: boolean;
184 +    FCodePage: TSystemCodePage;
185 +    FDataSize: integer;
186 +  protected
187 +    procedure Bind(Binding: Boolean); override;
188 +    function GetDataSize: Integer; override;
189    public
190 <    constructor create(AOwner: TComponent); override;
190 >    constructor Create(aOwner: TComponent); override;
191      class procedure CheckTypeSize(Value: Integer); override;
192      function GetAsString: string; override;
193      function GetAsVariant: Variant; override;
194      function GetValue(var Value: string): Boolean;
195      procedure SetAsString(const Value: string); override;
196 +    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
197 +    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
198 +    property CodePage: TSystemCodePage read FCodePage write FCodePage;
199 +  published
200 +    property AutoFieldSize: boolean read FAutoFieldSize write FAutoFieldSize default true;
201    end;
202  
203    { TIBBCDField }
# Line 129 | Line 220 | type
220      property Size default 8;
221    end;
222  
223 +  {TIBMemoField}
224 +  {Allows us to show truncated text in DBGrids and anything else that uses
225 +   DisplayText}
226 +
227 +   TIBMemoField = class(TMemoField)
228 +   private
229 +     FCharacterSetName: RawByteString;
230 +     FCharacterSetSize: integer;
231 +     FDisplayTextAsClassName: boolean;
232 +     function GetTruncatedText: string;
233 +   protected
234 +     procedure Bind(Binding: Boolean); override;
235 +     function GetAsString: string; override;
236 +     function GetDefaultWidth: Longint; override;
237 +     procedure GetText(var AText: string; ADisplayText: Boolean); override;
238 +     procedure SetAsString(const AValue: string); override;
239 +   public
240 +     constructor Create(AOwner: TComponent); override;
241 +     property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
242 +     property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
243 +   published
244 +     property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
245 +                                            write FDisplayTextAsClassName;
246 +   private
247 +     FCodePage: TSystemCodePage;
248 +     FFCodePage: TSystemCodePage;
249 +   public
250 +     property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
251 +   end;
252 +
253    TIBDataLink = class(TDetailDataLink)
254    private
255      FDataSet: TIBCustomDataSet;
# Line 142 | Line 263 | type
263      destructor Destroy; override;
264    end;
265  
266 +  TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord);
267 +
268 +  { TIBGenerator }
269 +
270 +  TIBGenerator = class(TPersistent)
271 +  private
272 +    FOwner: TIBCustomDataSet;
273 +    FApplyOnEvent: TIBGeneratorApplyOnEvent;
274 +    FFieldName: string;
275 +    FGeneratorName: string;
276 +    FIncrement: integer;
277 +    procedure SetIncrement(const AValue: integer);
278 +  protected
279 +    function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
280 +  public
281 +    constructor Create(Owner: TIBCustomDataSet);
282 +    procedure Apply;
283 +    property Owner: TIBCustomDataSet read FOwner;
284 +  published
285 +    property Generator: string read FGeneratorName write FGeneratorName;
286 +    property Field: string read FFieldName write FFieldName;
287 +    property Increment: integer read FIncrement write SetIncrement default 1;
288 +    property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
289 +  end;
290 +
291 +  {TIBControlLink - Allows IB Aware controls to react to dataset state changes}
292 +
293 +  TIBControlLink = class
294 +  private
295 +    FTIBDataSet: TIBCustomDataSet;
296 +    procedure SetIBDataSet(AValue: TIBCustomDataSet);
297 +  protected
298 +    procedure UpdateSQL(Sender: TObject); virtual;
299 +    procedure UpdateParams(Sender: TObject); virtual;
300 +  public
301 +    destructor Destroy; override;
302 +    property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
303 +  end;
304 +
305 +  TIBAutoCommit = (acDisabled, acCommitRetaining);
306 +
307    { TIBCustomDataSet }
308 +
309    TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
310  
311    TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
312 <                                 UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
312 >                                 UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
313                                   of object;
314    TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
315                                     var UpdateAction: TIBUpdateAction) of object;
316  
317    TIBUpdateRecordTypes = set of TCachedUpdateStatus;
318  
319 +  TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
320 +
321 +  TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
322 +
323    TIBCustomDataSet = class(TDataset)
324    private
325 +    FAllowAutoActivateTransaction: Boolean;
326 +    FArrayFieldCount: integer;
327 +    FArrayCacheOffset: integer;
328 +    FAutoCommit: TIBAutoCommit;
329 +    FGenerateParamNames: Boolean;
330 +    FGeneratorField: TIBGenerator;
331      FNeedsRefresh: Boolean;
332      FForcedRefresh: Boolean;
333      FDidActivate: Boolean;
161    FIBLoaded: Boolean;
334      FBase: TIBBase;
335      FBlobCacheOffset: Integer;
336      FBlobStreamList: TList;
337 +    FArrayList: TList;
338      FBufferChunks: Integer;
339      FBufferCache,
340      FOldBufferCache: PChar;
# Line 179 | Line 352 | type
352      FDeletedRecords: Long;
353      FModelBuffer,
354      FOldBuffer: PChar;
355 +    FOnValidatePost: TOnValidatePost;
356      FOpen: Boolean;
357      FInternalPrepared: Boolean;
358      FQDelete,
# Line 189 | Line 363 | type
363      FRecordBufferSize: Integer;
364      FRecordCount: Integer;
365      FRecordSize: Integer;
366 +    FDataSetCloseAction: TDataSetCloseAction;
367      FUniDirectional: Boolean;
368      FUpdateMode: TUpdateMode;
369      FUpdateObject: TIBDataSetUpdateObject;
# Line 206 | Line 381 | type
381      FBeforeTransactionEnd,
382      FAfterTransactionEnd,
383      FTransactionFree: TNotifyEvent;
384 <
385 <    function GetSelectStmtHandle: TISC_STMT_HANDLE;
384 >    FAliasNameMap: array of string;
385 >    FAliasNameList: array of string;
386 >    FBaseSQLSelect: TStrings;
387 >    FParser: TSelectSQLParser;
388 >    FCloseAction: TTransactionAction;
389 >    FInTransactionEnd: boolean;
390 >    FIBLinks: TList;
391 >    FFieldColumns: PFieldColumns;
392 >    procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
393 >    function GetSelectStmtIntf: IStatement;
394      procedure SetUpdateMode(const Value: TUpdateMode);
395      procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
396  
# Line 219 | Line 402 | type
402      function CanRefresh: Boolean;
403      procedure CheckEditState;
404      procedure ClearBlobCache;
405 +    procedure ClearArrayCache;
406 +    procedure ClearIBLinks;
407      procedure CopyRecordBuffer(Source, Dest: Pointer);
408      procedure DoBeforeDatabaseDisconnect(Sender: TObject);
409      procedure DoAfterDatabaseDisconnect(Sender: TObject);
410      procedure DoDatabaseFree(Sender: TObject);
411 <    procedure DoBeforeTransactionEnd(Sender: TObject);
411 >    procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
412      procedure DoAfterTransactionEnd(Sender: TObject);
413      procedure DoTransactionFree(Sender: TObject);
414      procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
415                                           Buffer: PChar);
416      function GetDatabase: TIBDatabase;
232    function GetDBHandle: PISC_DB_HANDLE;
417      function GetDeleteSQL: TStrings;
418      function GetInsertSQL: TStrings;
419 <    function GetSQLParams: TIBXSQLDA;
419 >    function GetSQLParams: ISQLParams;
420      function GetRefreshSQL: TStrings;
421      function GetSelectSQL: TStrings;
422 <    function GetStatementType: TIBSQLTypes;
422 >    function GetStatementType: TIBSQLStatementTypes;
423      function GetModifySQL: TStrings;
424      function GetTransaction: TIBTransaction;
425 <    function GetTRHandle: PISC_TR_HANDLE;
426 <    procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
425 >    function GetParser: TSelectSQLParser;
426 >    procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
427      function InternalLocate(const KeyFields: string; const KeyValues: Variant;
428                              Options: TLocateOptions): Boolean; virtual;
429 <    procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
430 <    procedure InternalRevertRecord(RecordNumber: Integer);
429 >    procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
430 >    procedure InternalRevertRecord(RecordNumber: Integer); virtual;
431      function IsVisible(Buffer: PChar): Boolean;
432 +    procedure RegisterIBLink(Sender: TIBControlLink);
433 +    procedure UnRegisterIBLink(Sender: TIBControlLink);
434      procedure SaveOldBuffer(Buffer: PChar);
435      procedure SetBufferChunks(Value: Integer);
436      procedure SetDatabase(Value: TIBDatabase);
437      procedure SetDeleteSQL(Value: TStrings);
438      procedure SetInsertSQL(Value: TStrings);
439 <    procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
439 >    procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
440      procedure SetRefreshSQL(Value: TStrings);
441      procedure SetSelectSQL(Value: TStrings);
442      procedure SetModifySQL(Value: TStrings);
# Line 258 | Line 444 | type
444      procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
445      procedure SetUniDirectional(Value: Boolean);
446      procedure RefreshParams;
261    procedure SQLChanging(Sender: TObject); virtual;
447      function AdjustPosition(FCache: PChar; Offset: DWORD;
448 <                            Origin: Integer): Integer;
448 >                            Origin: Integer): DWORD;
449      procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
450                         Buffer: PChar);
451      procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
# Line 269 | Line 454 | type
454                          Buffer: PChar);
455      procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
456      function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
457 <                       DoCheck: Boolean): TGetResult;
457 >                       DoCheck: Boolean): TGetResult; virtual;
458  
459    protected
460      procedure ActivateConnection;
# Line 277 | Line 462 | type
462      procedure DeactivateTransaction;
463      procedure CheckDatasetClosed;
464      procedure CheckDatasetOpen;
465 +    function CreateParser: TSelectSQLParser; virtual;
466 +    procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
467      function GetActiveBuf: PChar;
468 <    procedure InternalBatchInput(InputObject: TIBBatchInput);
469 <    procedure InternalBatchOutput(OutputObject: TIBBatchOutput);
468 >    procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
469 >    procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
470      procedure InternalPrepare; virtual;
471      procedure InternalUnPrepare; virtual;
472      procedure InternalExecQuery; virtual;
473      procedure InternalRefreshRow; virtual;
474 <    procedure InternalSetParamsFromCursor;
474 >    procedure InternalSetParamsFromCursor; virtual;
475      procedure CheckNotUniDirectional;
476 +    procedure SQLChanging(Sender: TObject); virtual;
477 +    procedure SQLChanged(Sender: TObject); virtual;
478  
479      { IProviderSupport }
480      procedure PSEndTransaction(Commit: Boolean); override;
# Line 309 | Line 498 | type
498      procedure ClearCalcFields(Buffer: PChar); override;
499      function AllocRecordBuffer: PChar; override;
500      procedure DoBeforeDelete; override;
501 +    procedure DoAfterDelete; override;
502      procedure DoBeforeEdit; override;
503 +    procedure DoAfterEdit; override;
504      procedure DoBeforeInsert; override;
505 +    procedure DoAfterInsert; override;
506 +    procedure DoBeforeClose; override;
507 +    procedure DoBeforeOpen; override;
508 +    procedure DoBeforePost; override;
509 +    procedure DoAfterPost; override;
510      procedure FreeRecordBuffer(var Buffer: PChar); override;
511      procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
512      function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
513      function GetCanModify: Boolean; override;
514      function GetDataSource: TDataSource; override;
515 +    function GetDBAliasName(FieldNo: integer): string;
516 +    function GetFieldDefFromAlias(aliasName: string): TFieldDef;
517      function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
518      function GetRecNo: Integer; override;
519      function GetRecord(Buffer: PChar; GetMode: TGetMode;
520                         DoCheck: Boolean): TGetResult; override;
521      function GetRecordCount: Integer; override;
522      function GetRecordSize: Word; override;
523 +    procedure InternalAutoCommit;
524      procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
525      procedure InternalCancel; override;
526      procedure InternalClose; override;
527      procedure InternalDelete; override;
528      procedure InternalFirst; override;
529 <    function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
529 >    function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual;
530      procedure InternalGotoBookmark(Bookmark: Pointer); override;
531      procedure InternalHandleException; override;
532      procedure InternalInitFieldDefs; override;
# Line 336 | Line 535 | type
535      procedure InternalOpen; override;
536      procedure InternalPost; override;
537      procedure InternalRefresh; override;
538 <    procedure InternalSetFieldData(Field: TField; Buffer: Pointer);
538 >    procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
539      procedure InternalSetToRecord(Buffer: PChar); override;
540      function IsCursorOpen: Boolean; override;
541 +    procedure Loaded; override;
542      procedure ReQuery;
543      procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
544      procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
545      procedure SetCachedUpdates(Value: Boolean);
546      procedure SetDataSource(Value: TDataSource);
547 +    procedure SetGenerateParamNames(AValue: Boolean); virtual;
548      procedure SetFieldData(Field : TField; Buffer : Pointer); override;
549      procedure SetFieldData(Field : TField; Buffer : Pointer;
550        NativeFormat : Boolean); overload; override;
# Line 351 | Line 552 | type
552  
553    protected
554      {Likely to be made public by descendant classes}
555 <    property SQLParams: TIBXSQLDA read GetSQLParams;
556 <    property Params: TIBXSQLDA read GetSQLParams;
555 >    property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
556 >    property SQLParams: ISQLParams read GetSQLParams;
557 >    property Params: ISQLParams read GetSQLParams;
558      property InternalPrepared: Boolean read FInternalPrepared;
559      property QDelete: TIBSQL read FQDelete;
560      property QInsert: TIBSQL read FQInsert;
561      property QRefresh: TIBSQL read FQRefresh;
562      property QSelect: TIBSQL read FQSelect;
563      property QModify: TIBSQL read FQModify;
564 <    property StatementType: TIBSQLTypes read GetStatementType;
565 <    property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
564 >    property StatementType: TIBSQLStatementTypes read GetStatementType;
565 >    property SelectStmtHandle: IStatement read GetSelectStmtIntf;
566  
567      {Likely to be made published by descendant classes}
568      property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
569      property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
570      property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
571 +    property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
572      property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
573      property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
574      property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
# Line 373 | Line 576 | type
576      property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
577      property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
578      property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
579 +    property Parser: TSelectSQLParser read GetParser;
580 +    property BaseSQLSelect: TStrings read FBaseSQLSelect;
581  
582      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
583                                                   write FBeforeDatabaseDisconnect;
# Line 386 | Line 591 | type
591                                              write FAfterTransactionEnd;
592      property TransactionFree: TNotifyEvent read FTransactionFree
593                                             write FTransactionFree;
594 +    property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
595  
596    public
597      constructor Create(AOwner: TComponent); override;
# Line 393 | Line 599 | type
599      procedure ApplyUpdates;
600      function CachedUpdateStatus: TCachedUpdateStatus;
601      procedure CancelUpdates;
602 +    function GetFieldPosition(AliasName: string): integer;
603      procedure FetchAll;
604      function LocateNext(const KeyFields: string; const KeyValues: Variant;
605                          Options: TLocateOptions): Boolean;
606      procedure RecordModified(Value: Boolean);
607      procedure RevertRecord;
608      procedure Undelete;
609 +    procedure ResetParser; virtual;
610 +    function HasParser: boolean;
611  
612      { TDataSet support methods }
613      function BookmarkValid(Bookmark: TBookmark): Boolean; override;
614      function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
615      function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
616 +    function GetArray(Field: TIBArrayField): IArray;
617 +    procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
618      function GetCurrentRecord(Buffer: PChar): Boolean; override;
619      function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
620 <    function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
620 >    function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
621      function GetFieldData(Field : TField; Buffer : Pointer;
622        NativeFormat : Boolean) : Boolean; overload; override;
623 +    property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
624      function Locate(const KeyFields: string; const KeyValues: Variant;
625                      Options: TLocateOptions): Boolean; override;
626      function Lookup(const KeyFields: string; const KeyValues: Variant;
627                      const ResultFields: string): Variant; override;
628      function UpdateStatus: TUpdateStatus; override;
629      function IsSequenced: Boolean; override;
630 <
631 <    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
632 <    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
630 >    procedure Post; override;
631 >    function ParamByName(ParamName: String): ISQLParam;
632 >    property ArrayFieldCount: integer read FArrayFieldCount;
633      property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
634      property UpdatesPending: Boolean read FUpdatesPending;
635      property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
636                                                        write SetUpdateRecordTypes;
637 +    property DataSetCloseAction: TDataSetCloseAction
638 +               read FDataSetCloseAction write FDataSetCloseAction;
639  
640    published
641 +    property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
642 +                 write FAllowAutoActivateTransaction;
643      property Database: TIBDatabase read GetDatabase write SetDatabase;
644      property Transaction: TIBTransaction read GetTransaction
645                                            write SetTransaction;
646      property ForcedRefresh: Boolean read FForcedRefresh
647                                      write FForcedRefresh default False;
648      property AutoCalcFields;
433    property ObjectView default False;
649  
650      property AfterCancel;
651      property AfterClose;
# Line 461 | Line 676 | type
676                                                     write FOnUpdateRecord;
677    end;
678  
679 <  TIBDataSet = class(TIBCustomDataSet)
679 >  TIBParserDataSet = class(TIBCustomDataSet)
680 >  public
681 >    property Parser;
682 >  end;
683 >
684 >  TIBDataSet = class(TIBParserDataSet)
685    private
686      function GetPrepared: Boolean;
687  
# Line 486 | Line 706 | type
706      property QModify;
707      property StatementType;
708      property SelectStmtHandle;
709 +    property BaseSQLSelect;
710  
711    published
712      { TIBCustomDataSet }
713 +    property AutoCommit;
714      property BufferChunks;
715      property CachedUpdates;
716      property DeleteSQL;
# Line 496 | Line 718 | type
718      property RefreshSQL;
719      property SelectSQL;
720      property ModifySQL;
721 +    property GeneratorField;
722 +    property GenerateParamNames;
723      property ParamCheck;
724      property UniDirectional;
725      property Filtered;
726 +    property DataSetCloseAction;
727  
728      property BeforeDatabaseDisconnect;
729      property AfterDatabaseDisconnect;
# Line 534 | Line 759 | type
759      property OnFilterRecord;
760      property OnNewRecord;
761      property OnPostError;
762 +    property OnValidatePost;
763    end;
764  
765    { TIBDSBlobStream }
766    TIBDSBlobStream = class(TStream)
767 +  private
768 +    FHasWritten: boolean;
769    protected
770      FField: TField;
771      FBlobStream: TIBBlobStream;
772 +    function  GetSize: Int64; override;
773    public
774      constructor Create(AField: TField; ABlobStream: TIBBlobStream;
775                         Mode: TBlobStreamMode);
776 +    destructor Destroy; override;
777      function Read(var Buffer; Count: Longint): Longint; override;
778      function Seek(Offset: Longint; Origin: Word): Longint; override;
779      procedure SetSize(NewSize: Longint); override;
780      function Write(const Buffer; Count: Longint): Longint; override;
781    end;
782  
783 +  {Extended Field Def for character set info}
784 +
785 +  { TIBFieldDef }
786 +
787 +  TIBFieldDef = class(TFieldDef)
788 +  private
789 +    FArrayBounds: TArrayBounds;
790 +    FArrayDimensions: integer;
791 +    FCharacterSetName: RawByteString;
792 +    FCharacterSetSize: integer;
793 +    FCodePage: TSystemCodePage;
794 +    FRelationName: string;
795 +    FDataSize: integer;
796 +  published
797 +    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
798 +    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
799 +    property CodePage: TSystemCodePage read FCodePage write FCodePage;
800 +    property DataSize: integer read FDataSize write FDataSize;
801 +    property RelationName: string read FRelationName write FRelationName;
802 +    property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
803 +    property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
804 +  end;
805 +
806   const
807   DefaultFieldClasses: array[TFieldType] of TFieldClass = (
808      nil,                { ftUnknown }
# Line 568 | Line 821 | DefaultFieldClasses: array[TFieldType] o
821      TVarBytesField,     { ftVarBytes }
822      TAutoIncField,      { ftAutoInc }
823      TBlobField,         { ftBlob }
824 <    TMemoField,         { ftMemo }
824 >    TIBMemoField,       { ftMemo }
825      TGraphicField,      { ftGraphic }
826      TBlobField,         { ftFmtMemo }
827      TBlobField,         { ftParadoxOle }
# Line 576 | Line 829 | DefaultFieldClasses: array[TFieldType] o
829      TBlobField,         { ftTypedBinary }
830      nil,                { ftCursor }
831      TStringField,       { ftFixedChar }
832 <    nil, {TWideStringField } { ftWideString }
832 >    nil,    { ftWideString }
833      TLargeIntField,     { ftLargeInt }
834 +    nil,          { ftADT }
835 +    TIBArrayField,        { ftArray }
836 +    nil,    { ftReference }
837 +    nil,     { ftDataSet }
838 +    TBlobField,         { ftOraBlob }
839 +    TMemoField,         { ftOraClob }
840 +    TVariantField,      { ftVariant }
841 +    nil,    { ftInterface }
842 +    nil,     { ftIDispatch }
843 +    TGuidField,        { ftGuid }
844 +    TDateTimeField,    {ftTimestamp}
845 +    TIBBCDField,       {ftFMTBcd}
846 +    nil,  {ftFixedWideChar}
847 +    nil);   {ftWideMemo}
848 + (*
849      TADTField,          { ftADT }
850      TArrayField,        { ftArray }
851      TReferenceField,    { ftReference }
# Line 587 | Line 855 | DefaultFieldClasses: array[TFieldType] o
855      TVariantField,      { ftVariant }
856      TInterfaceField,    { ftInterface }
857      TIDispatchField,     { ftIDispatch }
858 <    TGuidField);        { ftGuid }
859 < var
860 <  CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;
858 >    TGuidField);        { ftGuid } *)
859 > (*var
860 >  CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
861  
862   implementation
863  
864 < uses IBIntf, IBQuery;
864 > uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
865 >
866 > const FILE_BEGIN = 0;
867 >      FILE_CURRENT = 1;
868 >      FILE_END = 2;
869  
870   type
871  
# Line 613 | Line 885 | type
885    end;
886  
887  
888 +  {  Copied from LCLProc in order to avoid LCL dependency
889 +
890 +    Ensures the covenient look of multiline string
891 +    when displaying it in the single line
892 +    * Replaces CR and LF with spaces
893 +    * Removes duplicate spaces
894 +  }
895 +  function TextToSingleLine(const AText: string): string;
896 +  var
897 +    str: string;
898 +    i, wstart, wlen: Integer;
899 +  begin
900 +    str := Trim(AText);
901 +    wstart := 0;
902 +    wlen := 0;
903 +    i := 1;
904 +    while i < Length(str) - 1 do
905 +    begin
906 +      if (str[i] in [' ', #13, #10]) then
907 +      begin
908 +        if (wstart = 0) then
909 +        begin
910 +          wstart := i;
911 +          wlen := 1;
912 +        end else
913 +          Inc(wlen);
914 +      end else
915 +      begin
916 +        if wstart > 0 then
917 +        begin
918 +          str[wstart] := ' ';
919 +          Delete(str, wstart+1, wlen-1);
920 +          Dec(i, wlen-1);
921 +          wstart := 0;
922 +        end;
923 +      end;
924 +      Inc(i);
925 +    end;
926 +    Result := str;
927 +  end;
928 +
929 + { TIBArray }
930 +
931 + procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
932 + begin
933 +  case Reason of
934 +  arChanging:
935 +    if FRecNo <> FField.Dataset.RecNo then
936 +      IBError(ibxeNotCurrentArray,[nil]);
937 +
938 +  arChanged:
939 +    FField.DataChanged;
940 +  end;
941 + end;
942 +
943 + constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
944 + begin
945 +  inherited Create;
946 +  FField := aField;
947 +  FArray := anArray;
948 +  FRecNo := FField.Dataset.RecNo;
949 +  FArray.AddEventHandler(EventHandler);
950 + end;
951 +
952 + destructor TIBArray.Destroy;
953 + begin
954 +  FArray.RemoveEventHandler(EventHandler);
955 +  inherited Destroy;
956 + end;
957 +
958 + { TIBArrayField }
959 +
960 + function TIBArrayField.GetArrayIntf: IArray;
961 + begin
962 +  Result := TIBCustomDataSet(DataSet).GetArray(self);
963 + end;
964 +
965 + function TIBArrayField.GetArrayID: TISC_QUAD;
966 + begin
967 +  GetData(@Result);
968 + end;
969 +
970 + procedure TIBArrayField.SetArrayIntf(AValue: IArray);
971 + begin
972 +  TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
973 +  DataChanged;
974 + end;
975 +
976 + class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
977 + begin
978 +  //Ignore
979 + end;
980 +
981 + function TIBArrayField.GetAsString: string;
982 + begin
983 +  Result := '(Array)';
984 + end;
985 +
986 + function TIBArrayField.GetDataSize: Integer;
987 + begin
988 +  Result := sizeof(TISC_QUAD);
989 + end;
990 +
991 + procedure TIBArrayField.Bind(Binding: Boolean);
992 + begin
993 +  inherited Bind(Binding);
994 +  if Binding then
995 +  begin
996 +    FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
997 +    Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
998 +    if FieldDef <> nil then
999 +    begin
1000 +      FRelationName := TIBFieldDef(FieldDef).FRelationName;
1001 +      FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
1002 +      FArrayBounds :=  TIBFieldDef(FieldDef).ArrayBounds;
1003 +    end;
1004 +  end;
1005 + end;
1006 +
1007 + constructor TIBArrayField.Create(AOwner: TComponent);
1008 + begin
1009 +  inherited Create(AOwner);
1010 +  SetDataType(ftArray);
1011 + end;
1012 +
1013 + function TIBArrayField.CreateArray: IArray;
1014 + begin
1015 + with DataSet as TIBCustomDataSet do
1016 +  Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1017 + end;
1018 +
1019 + { TIBMemoField }
1020 +
1021 + function TIBMemoField.GetTruncatedText: string;
1022 + begin
1023 +   Result := GetAsString;
1024 +
1025 +   if Result <> '' then
1026 +   begin
1027 +       case CharacterSetSize of
1028 +       1:
1029 +         if DisplayWidth = 0 then
1030 +           Result := TextToSingleLine(Result)
1031 +         else
1032 +         if Length(Result) > DisplayWidth then {Show truncation with elipses}
1033 +           Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
1034 +
1035 +       {2: case 2 ignored. This should be handled by TIBWideMemo}
1036 +
1037 +       3, {Assume UNICODE_FSS is really UTF8}
1038 +       4: {Include GB18030 - assuming UTF8 routine work for this codeset}
1039 +         if DisplayWidth = 0 then
1040 +           Result := ValidUTF8String(TextToSingleLine(Result))
1041 +         else
1042 +         if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1043 +           Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1044 +       end;
1045 +   end
1046 + end;
1047 +
1048 + procedure TIBMemoField.Bind(Binding: Boolean);
1049 + var IBFieldDef: TIBFieldDef;
1050 + begin
1051 +  inherited Bind(Binding);
1052 +  if Binding and (FieldDef <> nil) then
1053 +  begin
1054 +    IBFieldDef := FieldDef as TIBFieldDef;
1055 +    CharacterSetSize := IBFieldDef.CharacterSetSize;
1056 +    CharacterSetName := IBFieldDef.CharacterSetName;
1057 +    CodePage := IBFieldDef.CodePage;
1058 +  end;
1059 + end;
1060 +
1061 + function TIBMemoField.GetAsString: string;
1062 + var s: RawByteString;
1063 + begin
1064 +  s := inherited GetAsString;
1065 +  SetCodePage(s,CodePage,false);
1066 +  if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1067 +    SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1068 +  Result := s;
1069 + end;
1070 +
1071 + function TIBMemoField.GetDefaultWidth: Longint;
1072 + begin
1073 +  if DisplayTextAsClassName then
1074 +    Result := inherited
1075 +  else
1076 +    Result := 128;
1077 + end;
1078 +
1079 + procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
1080 + begin
1081 +  if ADisplayText then
1082 +  begin
1083 +    if not DisplayTextAsClassName and (CharacterSetName <> '') then
1084 +      AText := GetTruncatedText
1085 +    else
1086 +      inherited GetText(AText, ADisplayText);
1087 +  end
1088 +  else
1089 +    AText := GetAsString;
1090 + end;
1091 +
1092 + procedure TIBMemoField.SetAsString(const AValue: string);
1093 + var s: RawByteString;
1094 + begin
1095 +  s := AValue;
1096 +  if StringCodePage(s) <> CodePage then
1097 +    SetCodePage(s,CodePage,CodePage<>CP_NONE);
1098 +  inherited SetAsString(s);
1099 + end;
1100 +
1101 + constructor TIBMemoField.Create(AOwner: TComponent);
1102 + begin
1103 +  inherited Create(AOwner);
1104 +  BlobType := ftMemo;
1105 +  FCodePage := CP_NONE;
1106 + end;
1107 +
1108 + { TIBControlLink }
1109 +
1110 + destructor TIBControlLink.Destroy;
1111 + begin
1112 +  IBDataSet := nil;
1113 +  inherited Destroy;
1114 + end;
1115 +
1116 + procedure TIBControlLink.UpdateParams(Sender: TObject);
1117 + begin
1118 +
1119 + end;
1120 +
1121 + procedure TIBControlLink.UpdateSQL(Sender: TObject);
1122 + begin
1123 +
1124 + end;
1125 +
1126 + procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1127 + begin
1128 +  if FTIBDataSet = AValue then Exit;
1129 +  if IBDataSet <> nil then
1130 +    IBDataSet.UnRegisterIBLink(self);
1131 +  FTIBDataSet := AValue;
1132 +  if IBDataSet <> nil then
1133 +    IBDataSet.RegisterIBLink(self);
1134 + end;
1135 +
1136 +
1137   { TIBStringField}
1138  
1139 < constructor TIBStringField.Create(AOwner: TComponent);
1139 > procedure TIBStringField.Bind(Binding: Boolean);
1140 > var IBFieldDef: TIBFieldDef;
1141   begin
1142 <  inherited;
1142 >  inherited Bind(Binding);
1143 >  if Binding and (FieldDef <> nil) then
1144 >  begin
1145 >    IBFieldDef := FieldDef as TIBFieldDef;
1146 >    CharacterSetSize := IBFieldDef.CharacterSetSize;
1147 >    CharacterSetName := IBFieldDef.CharacterSetName;
1148 >    FDataSize := IBFieldDef.DataSize + 1;
1149 >    if AutoFieldSize then
1150 >      Size := IBFieldDef.Size;
1151 >    CodePage := IBFieldDef.CodePage;
1152 >  end;
1153 > end;
1154 >
1155 > function TIBStringField.GetDataSize: Integer;
1156 > begin
1157 >  Result := FDataSize;
1158 > end;
1159 >
1160 > constructor TIBStringField.Create(aOwner: TComponent);
1161 > begin
1162 >  inherited Create(aOwner);
1163 >  FCharacterSetSize := 1;
1164 >  FCodePage := CP_NONE;
1165 >  FAutoFieldSize := true;
1166   end;
1167  
1168   class procedure TIBStringField.CheckTypeSize(Value: Integer);
# Line 640 | Line 1185 | end;
1185   function TIBStringField.GetValue(var Value: string): Boolean;
1186   var
1187    Buffer: PChar;
1188 +  s: RawByteString;
1189   begin
1190    Buffer := nil;
1191 <  IBAlloc(Buffer, 0, Size + 1);
1191 >  IBAlloc(Buffer, 0, DataSize);
1192    try
1193      Result := GetData(Buffer);
1194      if Result then
1195      begin
1196 <      Value := string(Buffer);
1196 >      s := strpas(Buffer);
1197 >      SetCodePage(s,CodePage,false);
1198 >      if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1199 >        SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1200 >      Value := s;
1201 > //      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1202        if Transliterate and (Value <> '') then
1203          DataSet.Translate(PChar(Value), PChar(Value), False);
1204      end
# Line 659 | Line 1210 | end;
1210   procedure TIBStringField.SetAsString(const Value: string);
1211   var
1212    Buffer: PChar;
1213 +  s: RawByteString;
1214   begin
1215    Buffer := nil;
1216 <  IBAlloc(Buffer, 0, Size + 1);
1216 >  IBAlloc(Buffer, 0, DataSize);
1217    try
1218 <    StrLCopy(Buffer, PChar(Value), Size);
1218 >    s := Value;
1219 >    if StringCodePage(s) <> CodePage then
1220 >      SetCodePage(s,CodePage,CodePage<>CP_NONE);
1221 >    StrLCopy(Buffer, PChar(s), DataSize-1);
1222      if Transliterate then
1223        DataSet.Translate(Buffer, Buffer, True);
1224      SetData(Buffer);
# Line 672 | Line 1227 | begin
1227    end;
1228   end;
1229  
1230 +
1231   { TIBBCDField }
1232  
1233   constructor TIBBCDField.Create(AOwner: TComponent);
# Line 714 | Line 1270 | end;
1270  
1271   function TIBBCDField.GetDataSize: Integer;
1272   begin
1273 + {$IFDEF TBCDFIELD_IS_BCD}
1274    Result := 8;
1275 + {$ELSE}
1276 +  Result := inherited GetDataSize
1277 + {$ENDIF}
1278   end;
1279  
1280   { TIBDataLink }
# Line 728 | Line 1288 | end;
1288   destructor TIBDataLink.Destroy;
1289   begin
1290    FDataSet.FDataLink := nil;
1291 <  inherited;
1291 >  inherited Destroy;
1292   end;
1293  
1294  
# Line 760 | Line 1320 | end;
1320  
1321   constructor TIBCustomDataSet.Create(AOwner: TComponent);
1322   begin
1323 <  inherited;
764 <  FIBLoaded := False;
765 <  CheckIBLoaded;
766 <  FIBLoaded := True;
1323 >  inherited Create(AOwner);
1324    FBase := TIBBase.Create(Self);
1325 +  FIBLinks := TList.Create;
1326    FCurrentRecord := -1;
1327    FDeletedRecords := 0;
1328    FUniDirectional := False;
1329    FBufferChunks := BufferCacheSize;
1330    FBlobStreamList := TList.Create;
1331 +  FArrayList := TList.Create;
1332 +  FGeneratorField := TIBGenerator.Create(self);
1333    FDataLink := TIBDataLink.Create(Self);
1334    FQDelete := TIBSQL.Create(Self);
1335    FQDelete.OnSQLChanging := SQLChanging;
# Line 782 | Line 1342 | begin
1342    FQRefresh.GoToFirstRecordOnExecute := False;
1343    FQSelect := TIBSQL.Create(Self);
1344    FQSelect.OnSQLChanging := SQLChanging;
1345 +  FQSelect.OnSQLChanged := SQLChanged;
1346    FQSelect.GoToFirstRecordOnExecute := False;
1347    FQModify := TIBSQL.Create(Self);
1348    FQModify.OnSQLChanging := SQLChanging;
1349    FQModify.GoToFirstRecordOnExecute := False;
1350    FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1351    FParamCheck := True;
1352 +  FGenerateParamNames := False;
1353    FForcedRefresh := False;
1354 +  FAutoCommit:= acDisabled;
1355 +  FDataSetCloseAction := dcDiscardChanges;
1356    {Bookmark Size is Integer for IBX}
1357    BookmarkSize := SizeOf(Integer);
1358    FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
# Line 802 | Line 1366 | begin
1366    else
1367      if AOwner is TIBTransaction then
1368        Transaction := TIBTransaction(AOwner);
1369 +  FBaseSQLSelect := TStringList.Create;
1370   end;
1371  
1372   destructor TIBCustomDataSet.Destroy;
1373   begin
1374 <  inherited;
1375 <  if FIBLoaded then
1376 <  begin
1377 <    FDataLink.Free;
1378 <    FBase.Free;
1379 <    ClearBlobCache;
1380 <    FBlobStreamList.Free;
1381 <    FreeMem(FBufferCache);
1382 <    FBufferCache := nil;
1383 <    FreeMem(FOldBufferCache);
1384 <    FOldBufferCache := nil;
1385 <    FCacheSize := 0;
1386 <    FOldCacheSize := 0;
1387 <    FMappedFieldPosition := nil;
1388 <  end;
1374 >  if Active then Active := false;
1375 >  if assigned(FGeneratorField) then FGeneratorField.Free;
1376 >  FDataLink.Free;
1377 >  FBase.Free;
1378 >  ClearBlobCache;
1379 >  ClearIBLinks;
1380 >  FIBLinks.Free;
1381 >  FBlobStreamList.Free;
1382 >  FArrayList.Free;
1383 >  FreeMem(FBufferCache);
1384 >  FBufferCache := nil;
1385 >  FreeMem(FOldBufferCache);
1386 >  FOldBufferCache := nil;
1387 >  FCacheSize := 0;
1388 >  FOldCacheSize := 0;
1389 >  FMappedFieldPosition := nil;
1390 >  if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1391 >  if assigned(FParser) then FParser.Free;
1392 >  inherited Destroy;
1393   end;
1394  
1395   function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
# Line 842 | Line 1411 | begin
1411        Inc(FCurrentRecord);
1412        if (FCurrentRecord = FRecordCount) then
1413        begin
1414 <        if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1414 >        if (not FQSelect.EOF) and FQSelect.Next  then
1415          begin
1416            FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1417            Inc(FRecordCount);
# Line 861 | Line 1430 | end;
1430  
1431   procedure TIBCustomDataSet.ApplyUpdates;
1432   var
1433 <  CurBookmark: string;
1433 >  CurBookmark: TBookmark;
1434    Buffer: PRecordData;
1435    CurUpdateTypes: TIBUpdateRecordTypes;
1436    UpdateAction: TIBUpdateAction;
# Line 921 | Line 1490 | var
1490    procedure UpdateUsingUpdateObject;
1491    begin
1492      try
1493 <      FUpdateObject.Apply(UpdateKind);
1493 >      FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1494        ResetBufferUpdateStatus;
1495      except
1496        on E: Exception do
# Line 1059 | Line 1628 | begin
1628    end;
1629   end;
1630  
1631 + function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1632 + var i: integer;
1633 +    Prepared: boolean;
1634 + begin
1635 +  Result := 0;
1636 +  Prepared := FInternalPrepared;
1637 +  if not Prepared then
1638 +    InternalPrepare;
1639 +  try
1640 +    for i := 0 to Length(FAliasNameList) - 1 do
1641 +      if FAliasNameList[i] = AliasName then
1642 +      begin
1643 +        Result := i + 1;
1644 +        Exit
1645 +      end;
1646 +  finally
1647 +    if not Prepared then
1648 +      InternalUnPrepare;
1649 +  end;
1650 + end;
1651 +
1652   procedure TIBCustomDataSet.ActivateConnection;
1653   begin
1654    if not Assigned(Database) then
# Line 1071 | Line 1661 | end;
1661   function TIBCustomDataSet.ActivateTransaction: Boolean;
1662   begin
1663    Result := False;
1664 <  if not Assigned(Transaction) then
1075 <    IBError(ibxeTransactionNotAssigned, [nil]);
1076 <  if not Transaction.Active then
1664 >  if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1665    begin
1666 <    Result := True;
1667 <    Transaction.StartTransaction;
1668 <    FDidActivate := True;
1666 >    if not Assigned(Transaction) then
1667 >      IBError(ibxeTransactionNotAssigned, [nil]);
1668 >    if not Transaction.Active then
1669 >    begin
1670 >      Result := True;
1671 >      Transaction.StartTransaction;
1672 >      FDidActivate := True;
1673 >    end;
1674    end;
1675   end;
1676  
# Line 1119 | Line 1712 | begin
1712      IBError(ibxeDatasetClosed, [nil]);
1713   end;
1714  
1715 + function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1716 + begin
1717 +  Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1718 +  Result.OnSQLChanging := SQLChanging
1719 + end;
1720 +
1721   procedure TIBCustomDataSet.CheckNotUniDirectional;
1722   begin
1723    if UniDirectional then
# Line 1196 | Line 1795 | begin
1795    FBlobStreamList.Pack;
1796   end;
1797  
1798 + procedure TIBCustomDataSet.ClearArrayCache;
1799 + var
1800 +  i: Integer;
1801 + begin
1802 +  for i := 0 to FArrayList.Count - 1 do
1803 +  begin
1804 +    TIBArray(FArrayList[i]).Free;
1805 +    FArrayList[i] := nil;
1806 +  end;
1807 +  FArrayList.Pack;
1808 + end;
1809 +
1810   procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1811   begin
1812    Move(Source^, Dest^, FRecordBufferSize);
# Line 1205 | Line 1816 | procedure TIBCustomDataSet.DoBeforeDatab
1816   begin
1817    if Active then
1818      Active := False;
1819 <  FInternalPrepared := False;
1819 >  InternalUnPrepare;
1820    if Assigned(FBeforeDatabaseDisconnect) then
1821      FBeforeDatabaseDisconnect(Sender);
1822   end;
# Line 1222 | Line 1833 | begin
1833      FDatabaseFree(Sender);
1834   end;
1835  
1836 < procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1836 > procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1837 >  Action: TTransactionAction);
1838   begin
1839 <  if Active then
1840 <    Active := False;
1839 >  FCloseAction := Action;
1840 >  FInTransactionEnd := true;
1841 >  try
1842 >    if Active then
1843 >      Active := False;
1844 >  finally
1845 >    FInTransactionEnd := false;
1846 >  end;
1847    if FQSelect <> nil then
1848      FQSelect.FreeHandle;
1849    if FQDelete <> nil then
# Line 1236 | Line 1854 | begin
1854      FQModify.FreeHandle;
1855    if FQRefresh <> nil then
1856      FQRefresh.FreeHandle;
1857 +  InternalUnPrepare;
1858    if Assigned(FBeforeTransactionEnd) then
1859      FBeforeTransactionEnd(Sender);
1860   end;
# Line 1252 | Line 1871 | begin
1871      FTransactionFree(Sender);
1872   end;
1873  
1874 + procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1875 + var i, j: Integer;
1876 +    FieldsLoaded: integer;
1877 +    p: PRecordData;
1878 +    colMetadata: IColumnMetaData;
1879 + begin
1880 +  p := PRecordData(Buffer);
1881 +  { Get record information }
1882 +  p^.rdBookmarkFlag := bfCurrent;
1883 +  p^.rdFieldCount := Qry.FieldCount;
1884 +  p^.rdRecordNumber := -1;
1885 +  p^.rdUpdateStatus := usUnmodified;
1886 +  p^.rdCachedUpdateStatus := cusUnmodified;
1887 +  p^.rdSavedOffset := $FFFFFFFF;
1888 +
1889 +  { Load up the fields }
1890 +  FieldsLoaded := FQSelect.MetaData.Count;
1891 +  j := 1;
1892 +  for i := 0 to Qry.MetaData.Count - 1 do
1893 +  begin
1894 +    if (Qry = FQSelect) then
1895 +      j := i + 1
1896 +    else
1897 +    begin
1898 +      if FieldsLoaded = 0 then
1899 +        break;
1900 +      j := FQSelect.FieldIndex[Qry[i].Name] + 1;
1901 +      if j < 1 then
1902 +        continue
1903 +      else
1904 +        Dec(FieldsLoaded);
1905 +    end;
1906 +    if j > 0 then
1907 +    begin
1908 +      colMetadata := Qry.MetaData[i];
1909 +      with p^.rdFields[j], FFieldColumns^[j] do
1910 +      begin
1911 +        fdDataType := colMetadata.GetSQLType;
1912 +        if fdDataType = SQL_BLOB then
1913 +          fdDataScale := 0
1914 +        else
1915 +          fdDataScale := colMetadata.getScale;
1916 +        fdNullable := colMetadata.getIsNullable;
1917 +        fdIsNull := true;
1918 +        fdDataSize := colMetadata.GetSize;
1919 +        fdDataLength := 0;
1920 +        fdCodePage := CP_NONE;
1921 +
1922 +        case fdDataType of
1923 +        SQL_TIMESTAMP,
1924 +        SQL_TYPE_DATE,
1925 +        SQL_TYPE_TIME:
1926 +          fdDataSize := SizeOf(TDateTime);
1927 +        SQL_SHORT, SQL_LONG:
1928 +        begin
1929 +          if (fdDataScale = 0) then
1930 +            fdDataSize := SizeOf(Integer)
1931 +          else
1932 +          if (fdDataScale >= (-4)) then
1933 +            fdDataSize := SizeOf(Currency)
1934 +          else
1935 +            fdDataSize := SizeOf(Double);
1936 +        end;
1937 +        SQL_INT64:
1938 +        begin
1939 +          if (fdDataScale = 0) then
1940 +            fdDataSize := SizeOf(Int64)
1941 +          else
1942 +          if (fdDataScale >= (-4)) then
1943 +            fdDataSize := SizeOf(Currency)
1944 +          else
1945 +            fdDataSize := SizeOf(Double);
1946 +        end;
1947 +        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1948 +          fdDataSize := SizeOf(Double);
1949 +        SQL_BOOLEAN:
1950 +          fdDataSize := SizeOf(wordBool);
1951 +        SQL_VARYING,
1952 +        SQL_TEXT,
1953 +        SQL_BLOB:
1954 +          fdCodePage := Qry.Metadata[i].getCodePage;
1955 +        end;
1956 +        fdDataOfs := FRecordSize;
1957 +        Inc(FRecordSize, fdDataSize);
1958 +      end;
1959 +    end;
1960 +  end;
1961 + end;
1962 +
1963   { Read the record from FQSelect.Current into the record buffer
1964    Then write the buffer to in memory cache }
1965   procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1966    RecordNumber: Integer; Buffer: PChar);
1967   var
1260  p: PRecordData;
1968    pbd: PBlobDataArray;
1969 +  pda: PArrayDataArray;
1970    i, j: Integer;
1971 <  LocalData: Pointer;
1971 >  LocalData: PByte;
1972    LocalDate, LocalDouble: Double;
1973    LocalInt: Integer;
1974 +  LocalBool: wordBool;
1975    LocalInt64: Int64;
1976    LocalCurrency: Currency;
1977    FieldsLoaded: Integer;
1978 +  p: PRecordData;
1979   begin
1980 +  if RecordNumber = -1 then
1981 +  begin
1982 +    InitModelBuffer(Qry,Buffer);
1983 +    Exit;
1984 +  end;
1985    p := PRecordData(Buffer);
1986    { Make sure blob cache is empty }
1987    pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1988 <  if RecordNumber > -1 then
1989 <    for i := 0 to BlobFieldCount - 1 do
1990 <      pbd^[i] := nil;
1988 >  pda := PArrayDataArray(Buffer + FArrayCacheOffset);
1989 >  for i := 0 to BlobFieldCount - 1 do
1990 >    pbd^[i] := nil;
1991 >  for i := 0 to ArrayFieldCount - 1 do
1992 >    pda^[i] := nil;
1993 >
1994    { Get record information }
1995    p^.rdBookmarkFlag := bfCurrent;
1996 <  p^.rdFieldCount := Qry.Current.Count;
1996 >  p^.rdFieldCount := Qry.FieldCount;
1997    p^.rdRecordNumber := RecordNumber;
1998    p^.rdUpdateStatus := usUnmodified;
1999    p^.rdCachedUpdateStatus := cusUnmodified;
2000    p^.rdSavedOffset := $FFFFFFFF;
2001  
2002    { Load up the fields }
2003 <  FieldsLoaded := FQSelect.Current.Count;
2003 >  FieldsLoaded := FQSelect.MetaData.Count;
2004    j := 1;
2005 <  for i := 0 to Qry.Current.Count - 1 do
2005 >  for i := 0 to Qry.FieldCount - 1 do
2006    begin
2007      if (Qry = FQSelect) then
2008        j := i + 1
2009 <    else begin
2009 >    else
2010 >    begin
2011        if FieldsLoaded = 0 then
2012          break;
2013 <      j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
2013 >      j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2014        if j < 1 then
2015          continue
2016        else
2017          Dec(FieldsLoaded);
2018      end;
2019 <    with FQSelect.Current[j - 1].Data^ do
2020 <      if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2019 >    with FQSelect.MetaData[j - 1] do
2020 >      if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2021        begin
2022 <        if sqllen <= 8 then
2023 <          p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
2022 >        if (GetSize <= 8) then
2023 >          p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2024          continue;
2025        end;
2026 <    if j > 0 then with p^ do
2026 >    if j > 0 then
2027      begin
2028 <      rdFields[j].fdDataType :=
2029 <        Qry.Current[i].Data^.sqltype and (not 1);
2030 <      rdFields[j].fdDataScale :=
2031 <        Qry.Current[i].Data^.sqlscale;
2032 <      rdFields[j].fdNullable :=
1314 <        (Qry.Current[i].Data^.sqltype and 1 = 1);
1315 <      rdFields[j].fdIsNull :=
1316 <        (rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1317 <      LocalData := Qry.Current[i].Data^.sqldata;
1318 <      case rdFields[j].fdDataType of
1319 <        SQL_TIMESTAMP:
1320 <        begin
1321 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1322 <          if RecordNumber >= 0 then
1323 <            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);
1339 <        end;
1340 <        SQL_SHORT, SQL_LONG:
2028 >      LocalData := nil;
2029 >      with p^.rdFields[j], FFieldColumns^[j] do
2030 >      begin
2031 >        Qry.Current.GetData(i,fdIsNull,fdDataLength,LocalData);
2032 >        if not fdIsNull then
2033          begin
2034 <          if (rdFields[j].fdDataScale = 0) then
2035 <          begin
2036 <            rdFields[j].fdDataSize := SizeOf(Integer);
2037 <            if RecordNumber >= 0 then
2038 <              LocalInt := Qry.Current[i].AsLong;
2039 <            LocalData := PChar(@LocalInt);
2040 <          end
2041 <          else if (rdFields[j].fdDataScale >= (-4)) then
2042 <               begin
2043 <                 rdFields[j].fdDataSize := SizeOf(Currency);
2044 <                 if RecordNumber >= 0 then
2045 <                   LocalCurrency := Qry.Current[i].AsCurrency;
2046 <                 LocalData := PChar(@LocalCurrency);
2047 <               end
2048 <               else begin
2049 <                 rdFields[j].fdDataSize := SizeOf(Double);
2050 <                 if RecordNumber >= 0 then
2051 <                   LocalDouble := Qry.Current[i].AsDouble;
2052 <                LocalData := PChar(@LocalDouble);
2034 >          case fdDataType of  {Get Formatted data for column types that need formatting}
2035 >            SQL_TIMESTAMP:
2036 >            begin
2037 >              LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry[i].AsDateTime));
2038 >              LocalData := PByte(@LocalDate);
2039 >            end;
2040 >            SQL_TYPE_DATE:
2041 >            begin
2042 >              LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Date;
2043 >              LocalData := PByte(@LocalInt);
2044 >            end;
2045 >            SQL_TYPE_TIME:
2046 >            begin
2047 >              LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Time;
2048 >              LocalData := PByte(@LocalInt);
2049 >            end;
2050 >            SQL_SHORT, SQL_LONG:
2051 >            begin
2052 >              if (fdDataScale = 0) then
2053 >              begin
2054 >                LocalInt := Qry[i].AsLong;
2055 >                LocalData := PByte(@LocalInt);
2056 >              end
2057 >              else
2058 >              if (fdDataScale >= (-4)) then
2059 >              begin
2060 >                LocalCurrency := Qry[i].AsCurrency;
2061 >                LocalData := PByte(@LocalCurrency);
2062 >              end
2063 >              else
2064 >              begin
2065 >               LocalDouble := Qry[i].AsDouble;
2066 >               LocalData := PByte(@LocalDouble);
2067                end;
2068 <        end;
2069 <        SQL_INT64:
2070 <        begin
2071 <          if (rdFields[j].fdDataScale = 0) then
2072 <          begin
2073 <            rdFields[j].fdDataSize := SizeOf(Int64);
2074 <            if RecordNumber >= 0 then
2075 <              LocalInt64 := Qry.Current[i].AsInt64;
2076 <            LocalData := PChar(@LocalInt64);
2077 <          end
2078 <          else if (rdFields[j].fdDataScale >= (-4)) then
2079 <               begin
2080 <                 rdFields[j].fdDataSize := SizeOf(Currency);
2081 <                 if RecordNumber >= 0 then
2082 <                   LocalCurrency := Qry.Current[i].AsCurrency;
2083 <                   LocalData := PChar(@LocalCurrency);
2084 <               end
2085 <               else begin
2086 <                  rdFields[j].fdDataSize := SizeOf(Double);
2087 <                  if RecordNumber >= 0 then
2088 <                    LocalDouble := Qry.Current[i].AsDouble;
2089 <                  LocalData := PChar(@LocalDouble);
2090 <               end
2091 <        end;
2092 <        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2093 <        begin
2094 <          rdFields[j].fdDataSize := SizeOf(Double);
2095 <          if RecordNumber >= 0 then
2096 <            LocalDouble := Qry.Current[i].AsDouble;
2097 <          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];
2068 >            end;
2069 >            SQL_INT64:
2070 >            begin
2071 >              if (fdDataScale = 0) then
2072 >              begin
2073 >                LocalInt64 := Qry[i].AsInt64;
2074 >                LocalData := PByte(@LocalInt64);
2075 >              end
2076 >              else
2077 >              if (fdDataScale >= (-4)) then
2078 >              begin
2079 >                LocalCurrency := Qry[i].AsCurrency;
2080 >                LocalData := PByte(@LocalCurrency);
2081 >                end
2082 >                else
2083 >                begin
2084 >                  LocalDouble := Qry[i].AsDouble;
2085 >                  LocalData := PByte(@LocalDouble);
2086 >                end
2087 >            end;
2088 >            SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2089 >            begin
2090 >              LocalDouble := Qry[i].AsDouble;
2091 >              LocalData := PByte(@LocalDouble);
2092 >            end;
2093 >            SQL_BOOLEAN:
2094 >            begin
2095 >              LocalBool := Qry[i].AsBoolean;
2096 >              LocalData := PByte(@LocalBool);
2097 >            end;
2098            end;
2099 <        end;
2100 <        else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
2101 <        begin
2102 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
2103 <          if (rdFields[j].fdDataType = SQL_TEXT) then
1409 <            rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1410 <        end;
1411 <      end;
1412 <      if RecordNumber < 0 then
1413 <      begin
1414 <        rdFields[j].fdIsNull := True;
1415 <        rdFields[j].fdDataOfs := FRecordSize;
1416 <        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)
2099 >
2100 >          if fdDataType = SQL_VARYING then
2101 >            Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2102 >          else
2103 >            Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2104          end
2105 +        else {Null column}
2106 +        if fdDataType = SQL_VARYING then
2107 +          FillChar(Buffer[fdDataOfs],fdDataLength,0)
2108          else
2109 <          Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
2109 >          FillChar(Buffer[fdDataOfs],fdDataSize,0);
2110        end;
2111      end;
2112    end;
2113 <  WriteRecordCache(RecordNumber, PChar(p));
2113 >  WriteRecordCache(RecordNumber, Buffer);
2114   end;
2115  
2116   function TIBCustomDataSet.GetActiveBuf: PChar;
# Line 1471 | Line 2155 | begin
2155    result := FBase.Database;
2156   end;
2157  
1474 function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1475 begin
1476  result := FBase.DBHandle;
1477 end;
1478
2158   function TIBCustomDataSet.GetDeleteSQL: TStrings;
2159   begin
2160    result := FQDelete.SQL;
# Line 1486 | Line 2165 | begin
2165    result := FQInsert.SQL;
2166   end;
2167  
2168 < function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
2168 > function TIBCustomDataSet.GetSQLParams: ISQLParams;
2169   begin
2170    if not FInternalPrepared then
2171      InternalPrepare;
# Line 1503 | Line 2182 | begin
2182    result := FQSelect.SQL;
2183   end;
2184  
2185 < function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
2185 > function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2186   begin
2187 <  result := FQSelect.SQLType;
2187 >  result := FQSelect.SQLStatementType;
2188   end;
2189  
2190   function TIBCustomDataSet.GetModifySQL: TStrings;
# Line 1518 | Line 2197 | begin
2197    result := FBase.Transaction;
2198   end;
2199  
1521 function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1522 begin
1523  result := FBase.TRHandle;
1524 end;
1525
2200   procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2201   begin
2202    if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2203 <    FUpdateObject.Apply(ukDelete)
2203 >    FUpdateObject.Apply(ukDelete,Buff)
2204    else
2205    begin
2206 <    SetInternalSQLParams(FQDelete, Buff);
2206 >    SetInternalSQLParams(FQDelete.Params, Buff);
2207      FQDelete.ExecQuery;
2208    end;
2209    with PRecordData(Buff)^ do
# Line 1543 | Line 2217 | end;
2217   function TIBCustomDataSet.InternalLocate(const KeyFields: string;
2218    const KeyValues: Variant; Options: TLocateOptions): Boolean;
2219   var
2220 <  fl: TList;
2221 <  CurBookmark: string;
2222 <  fld, val: Variant;
2223 <  i, fld_cnt: Integer;
2220 >  keyFieldList: TList;
2221 >  CurBookmark: TBookmark;
2222 >  fieldValue: Variant;
2223 >  lookupValues: array of variant;
2224 >  i, fieldCount: Integer;
2225 >  fieldValueAsString: string;
2226 >  lookupValueAsString: string;
2227   begin
2228 <  fl := TList.Create;
2228 >  keyFieldList := TList.Create;
2229    try
2230 <    GetFieldList(fl, KeyFields);
2231 <    fld_cnt := fl.Count;
2230 >    GetFieldList(keyFieldList, KeyFields);
2231 >    fieldCount := keyFieldList.Count;
2232      CurBookmark := Bookmark;
2233 <    result := False;
2234 <    while ((not result) and (not EOF)) do
2233 >    result := false;
2234 >    SetLength(lookupValues, fieldCount);
2235 >    if not EOF then
2236      begin
2237 <      i := 0;
1560 <      result := True;
1561 <      while (result and (i < fld_cnt)) do
2237 >      for i := 0 to fieldCount - 1 do  {expand key values into lookupValues array}
2238        begin
2239 <        if fld_cnt > 1 then
2240 <          val := KeyValues[i]
2239 >        if VarIsArray(KeyValues) then
2240 >          lookupValues[i] := KeyValues[i]
2241          else
2242 <          val := KeyValues;
2243 <        fld := TField(fl[i]).Value;
2244 <        result := not (VarIsNull(val) xor VarIsNull(fld));
2245 <        if result and not VarIsNull(val) then
2242 >        if i > 0 then
2243 >          lookupValues[i] := NULL
2244 >        else
2245 >          lookupValues[0] := KeyValues;
2246 >
2247 >        {convert to upper case is case insensitive search}
2248 >        if (TField(keyFieldList[i]).DataType = ftString) and
2249 >           not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
2250 >            lookupValues[i] := UpperCase(lookupValues[i]);
2251 >      end;
2252 >    end;
2253 >    while not result and not EOF do   {search for a matching record}
2254 >    begin
2255 >      i := 0;
2256 >      result := true;
2257 >      while result and (i < fieldCount) do
2258 >      {see if all of the key fields matches}
2259 >      begin
2260 >        fieldValue := TField(keyFieldList[i]).Value;
2261 >        result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
2262 >        if result and not VarIsNull(fieldValue) then
2263          begin
2264            try
2265 <            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
2265 >            if TField(keyFieldList[i]).DataType = ftString then
2266              begin
2267 +              {strings need special handling because of the locate options that
2268 +               apply to them}
2269 +              fieldValueAsString := TField(keyFieldList[i]).AsString;
2270 +              lookupValueAsString := lookupValues[i];
2271                if (loCaseInsensitive in Options) then
2272 <              begin
2273 <                fld := AnsiUpperCase(fld);
1582 <                val := AnsiUpperCase(val);
1583 <              end;
1584 <              fld := TrimRight(fld);
1585 <              val := TrimRight(val);
2272 >                fieldValueAsString := UpperCase(fieldValueAsString);
2273 >
2274                if (loPartialKey in Options) then
2275 <                result := result and (AnsiPos(val, fld) = 1)
2275 >                result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
2276                else
2277 <                result := result and (val = fld);
2278 <            end else
2279 <                result := result and (val = fld);
2277 >                result := result and (fieldValueAsString = lookupValueAsString);
2278 >            end
2279 >            else
2280 >              result := result and (lookupValues[i] =
2281 >                             VarAsType(fieldValue, VarType(lookupValues[i])));
2282 >          except on EVariantError do
2283 >            result := False;
2284 >          end;
2285          end;
2286          Inc(i);
2287        end;
2288        if not result then
2289 <        Next;
2289 >          Next;
2290      end;
2291      if not result then
2292        Bookmark := CurBookmark
2293      else
2294        CursorPosChanged;
2295    finally
2296 <    fl.Free;
2296 >    keyFieldList.Free;
2297 >    SetLength(lookupValues,0)
2298    end;
2299   end;
2300  
2301   procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2302   var
2303 <  i, j, k: Integer;
2303 >  i, j, k, arr: Integer;
2304    pbd: PBlobDataArray;
2305 +  pda: PArrayDataArray;
2306   begin
2307    pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2308 <  j := 0;
2308 >  pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2309 >  j := 0; arr := 0;
2310    for i := 0 to FieldCount - 1 do
2311      if Fields[i].IsBlob then
2312      begin
# Line 1619 | Line 2315 | begin
2315        begin
2316          pbd^[j].Finalize;
2317          PISC_QUAD(
2318 <          PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
2318 >          PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2319            pbd^[j].BlobID;
2320          PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2321 +      end
2322 +      else
2323 +      begin
2324 +        PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2325 +        with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2326 +        begin
2327 +          gds_quad_high := 0;
2328 +          gds_quad_low := 0;
2329 +        end;
2330        end;
2331        Inc(j);
2332 +    end
2333 +    else
2334 +    if Fields[i] is TIBArrayField then
2335 +    begin
2336 +      if pda^[arr] <> nil then
2337 +      begin
2338 +        k := FMappedFieldPosition[Fields[i].FieldNo -1];
2339 +        PISC_QUAD(
2340 +          PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=  pda^[arr].ArrayIntf.GetArrayID;
2341 +        PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2342 +      end;
2343 +      Inc(arr);
2344      end;
2345    if Assigned(FUpdateObject) then
2346    begin
2347      if (Qry = FQDelete) then
2348 <      FUpdateObject.Apply(ukDelete)
2348 >      FUpdateObject.Apply(ukDelete,Buff)
2349      else if (Qry = FQInsert) then
2350 <      FUpdateObject.Apply(ukInsert)
2350 >      FUpdateObject.Apply(ukInsert,Buff)
2351      else
2352 <      FUpdateObject.Apply(ukModify);
2352 >      FUpdateObject.Apply(ukModify,Buff);
2353    end
2354    else begin
2355 <    SetInternalSQLParams(Qry, Buff);
2355 >    SetInternalSQLParams(Qry.Params, Buff);
2356      Qry.ExecQuery;
2357    end;
2358    PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
# Line 1649 | Line 2366 | end;
2366   procedure TIBCustomDataSet.InternalRefreshRow;
2367   var
2368    Buff: PChar;
1652  SetCursor: Boolean;
2369    ofs: DWORD;
2370    Qry: TIBSQL;
2371   begin
2372 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1657 <  if SetCursor then
1658 <    Screen.Cursor := crHourGlass;
2372 >  FBase.SetCursor;
2373    try
2374      Buff := GetActiveBuf;
2375      if CanRefresh then
# Line 1672 | Line 2386 | begin
2386          end
2387          else
2388            Qry := FQRefresh;
2389 <        SetInternalSQLParams(Qry, Buff);
2389 >        SetInternalSQLParams(Qry.Params, Buff);
2390          Qry.ExecQuery;
2391          try
2392 <          if (Qry.SQLType = SQLExecProcedure) or
1679 <             (Qry.Next <> nil) then
2392 >          if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2393            begin
2394              ofs := PRecordData(Buff)^.rdSavedOffset;
2395              FetchCurrentRecordToBuffer(Qry,
# Line 1699 | Line 2412 | begin
2412      else
2413        IBError(ibxeCannotRefresh, [nil]);
2414    finally
2415 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1703 <      Screen.Cursor := crDefault;
2415 >    FBase.RestoreCursor;
2416    end;
2417   end;
2418  
# Line 1770 | Line 2482 | begin
2482   end;
2483  
2484   procedure TIBCustomDataSet.InternalPrepare;
1773 var
1774  SetCursor: Boolean;
1775  DidActivate: Boolean;
2485   begin
2486    if FInternalPrepared then
2487      Exit;
2488 <  DidActivate := False;
1780 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1781 <  if SetCursor then
1782 <    Screen.Cursor := crHourGlass;
2488 >  FBase.SetCursor;
2489    try
2490      ActivateConnection;
2491 <    DidActivate := ActivateTransaction;
2491 >    ActivateTransaction;
2492      FBase.CheckDatabase;
2493      FBase.CheckTransaction;
2494 +    if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2495 +    begin
2496 +      FQSelect.OnSQLChanged := nil; {Do not react to change}
2497 +      try
2498 +        FQSelect.SQL.Text := FParser.SQLText;
2499 +      finally
2500 +        FQSelect.OnSQLChanged := SQLChanged;
2501 +      end;
2502 +    end;
2503 + //   writeln( FQSelect.SQL.Text);
2504      if FQSelect.SQL.Text <> '' then
2505      begin
2506        if not FQSelect.Prepared then
2507        begin
2508 +        FQSelect.GenerateParamNames := FGenerateParamNames;
2509          FQSelect.ParamCheck := ParamCheck;
2510          FQSelect.Prepare;
2511        end;
2512 <      if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
2512 >      FQDelete.GenerateParamNames := FGenerateParamNames;
2513 >      if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2514          FQDelete.Prepare;
2515 <      if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
2515 >      FQInsert.GenerateParamNames := FGenerateParamNames;
2516 >      if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2517          FQInsert.Prepare;
2518 <      if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
2518 >      FQRefresh.GenerateParamNames := FGenerateParamNames;
2519 >      if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2520          FQRefresh.Prepare;
2521 <      if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
2521 >      FQModify.GenerateParamNames := FGenerateParamNames;
2522 >      if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2523          FQModify.Prepare;
2524        FInternalPrepared := True;
2525        InternalInitFieldDefs;
2526      end else
2527        IBError(ibxeEmptyQuery, [nil]);
2528    finally
2529 <    if DidActivate then
1809 <      DeactivateTransaction;
1810 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1811 <      Screen.Cursor := crDefault;
2529 >    FBase.RestoreCursor;
2530    end;
2531   end;
2532  
# Line 1837 | Line 2555 | var
2555    begin
2556      CopyRecordBuffer(Buffer, OldBuffer);
2557      if BlobFieldCount > 0 then
2558 <      FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2558 >      FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2559 >               BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2560                 0);
2561    end;
2562  
# Line 1879 | Line 2598 | begin
2598    if (FBase.Database <> Value) then
2599    begin
2600      CheckDatasetClosed;
2601 +    InternalUnPrepare;
2602      FBase.Database := Value;
2603      FQDelete.Database := Value;
2604      FQInsert.Database := Value;
# Line 1906 | Line 2626 | begin
2626    end;
2627   end;
2628  
2629 < procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
2629 > procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
2630   var
2631    i, j: Integer;
2632    cr, data: PChar;
2633 <  fn, st: string;
2633 >  fn: string;
2634 >  st: RawByteString;
2635    OldBuffer: Pointer;
2636    ts: TTimeStamp;
2637 +  Param: ISQLParam;
2638   begin
2639    if (Buffer = nil) then
2640      IBError(ibxeBufferNotSet, [nil]);
# Line 1920 | Line 2642 | begin
2642      InternalPrepare;
2643    OldBuffer := nil;
2644    try
2645 <    for i := 0 to Qry.Params.Count - 1 do
2645 >    for i := 0 to Params.GetCount - 1 do
2646      begin
2647 <      fn := Qry.Params[i].Name;
2647 >      Param := Params[i];
2648 >      fn := Param.Name;
2649        if (Pos('OLD_', fn) = 1) then {mbcs ok}
2650        begin
2651          fn := Copy(fn, 5, Length(fn));
# Line 1942 | Line 2665 | begin
2665               cr := Buffer;
2666        j := FQSelect.FieldIndex[fn] + 1;
2667        if (j > 0) then
2668 <        with PRecordData(cr)^ do
2668 >        with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2669          begin
2670 <          if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2670 >          if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2671            begin
2672 <            PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2672 >            PIBDBKey(Param.AsPointer)^ := rdDBKey;
2673              continue;
2674            end;
2675 <          if rdFields[j].fdIsNull then
2676 <            Qry.Params[i].IsNull := True
2675 >          if fdIsNull then
2676 >            Param.IsNull := True
2677            else begin
2678 <            Qry.Params[i].IsNull := False;
2679 <            data := cr + rdFields[j].fdDataOfs;
2680 <            case rdFields[j].fdDataType of
2678 >            Param.IsNull := False;
2679 >            data := cr + fdDataOfs;
2680 >            case fdDataType of
2681                SQL_TEXT, SQL_VARYING:
2682                begin
2683 <                SetString(st, data, rdFields[j].fdDataLength);
2684 <                Qry.Params[i].AsString := st;
2683 >                SetString(st, data, fdDataLength);
2684 >                SetCodePage(st,fdCodePage,false);
2685 >                Param.AsString := st;
2686                end;
2687              SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2688 <              Qry.Params[i].AsDouble := PDouble(data)^;
2688 >              Param.AsDouble := PDouble(data)^;
2689              SQL_SHORT, SQL_LONG:
2690              begin
2691 <              if rdFields[j].fdDataScale = 0 then
2692 <                Qry.Params[i].AsLong := PLong(data)^
2693 <              else if rdFields[j].fdDataScale >= (-4) then
2694 <                Qry.Params[i].AsCurrency := PCurrency(data)^
2691 >              if fdDataScale = 0 then
2692 >                Param.AsLong := PLong(data)^
2693 >              else
2694 >              if fdDataScale >= (-4) then
2695 >                Param.AsCurrency := PCurrency(data)^
2696                else
2697 <                Qry.Params[i].AsDouble := PDouble(data)^;
2697 >                Param.AsDouble := PDouble(data)^;
2698              end;
2699              SQL_INT64:
2700              begin
2701 <              if rdFields[j].fdDataScale = 0 then
2702 <                Qry.Params[i].AsInt64 := PInt64(data)^
2703 <              else if rdFields[j].fdDataScale >= (-4) then
2704 <                Qry.Params[i].AsCurrency := PCurrency(data)^
2701 >              if fdDataScale = 0 then
2702 >                Param.AsInt64 := PInt64(data)^
2703 >              else
2704 >              if fdDataScale >= (-4) then
2705 >                Param.AsCurrency := PCurrency(data)^
2706                else
2707 <                Qry.Params[i].AsDouble := PDouble(data)^;
2707 >                Param.AsDouble := PDouble(data)^;
2708              end;
2709              SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2710 <              Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2710 >              Param.AsQuad := PISC_QUAD(data)^;
2711              SQL_TYPE_DATE:
2712              begin
2713                ts.Date := PInt(data)^;
2714                ts.Time := 0;
2715 <              Qry.Params[i].AsDate :=
1990 <                TimeStampToDateTime(ts);
2715 >              Param.AsDate := TimeStampToDateTime(ts);
2716              end;
2717              SQL_TYPE_TIME:
2718              begin
2719                ts.Date := 0;
2720                ts.Time := PInt(data)^;
2721 <              Qry.Params[i].AsTime :=
1997 <                TimeStampToDateTime(ts);
2721 >              Param.AsTime := TimeStampToDateTime(ts);
2722              end;
2723              SQL_TIMESTAMP:
2724 <              Qry.Params[i].AsDateTime :=
2725 <                TimeStampToDateTime(
2726 <                  MSecsToTimeStamp(PDouble(data)^));
2724 >              Param.AsDateTime :=
2725 >                       TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2726 >            SQL_BOOLEAN:
2727 >              Param.AsBoolean := PWordBool(data)^;
2728            end;
2729          end;
2730        end;
# Line 2085 | Line 2810 | begin
2810    end;
2811   end;
2812  
2813 + procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2814 + begin
2815 +  if FIBLinks.IndexOf(Sender) = -1 then
2816 +    FIBLinks.Add(Sender);
2817 + end;
2818 +
2819  
2820   procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2821   begin
2822 <  if FOpen then
2823 <    InternalClose;
2822 >  Active := false;
2823 > {  if FOpen then
2824 >    InternalClose;}
2825    if FInternalPrepared then
2826      InternalUnPrepare;
2827 +  FieldDefs.Clear;
2828 +  FieldDefs.Updated := false;
2829 + end;
2830 +
2831 + procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2832 + begin
2833 +  FBaseSQLSelect.assign(FQSelect.SQL);
2834   end;
2835  
2836   { I can "undelete" uninserted records (make them "inserted" again).
# Line 2120 | Line 2859 | begin
2859    end;
2860   end;
2861  
2862 + procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2863 + begin
2864 +  FIBLinks.Remove(Sender);
2865 + end;
2866 +
2867   function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2868   begin
2869    if Active then
# Line 2136 | Line 2880 | begin
2880    Result := Assigned( FQSelect ) and FQSelect.EOF;
2881   end;
2882  
2883 + function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
2884 + begin
2885 +  ActivateConnection;
2886 +  ActivateTransaction;
2887 +  if not FInternalPrepared then
2888 +    InternalPrepare;
2889 +  Result := Params.ByName(ParamName);
2890 + end;
2891 +
2892 + {Beware: the parameter FCache is used as an identifier to determine which
2893 + cache is being operated on and is not referenced in the computation.
2894 + The result is an adjusted offset into the identified cache, either the
2895 + Buffer Cache or the old Buffer Cache.}
2896 +
2897   function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
2898 <                                        Origin: Integer): Integer;
2898 >                                        Origin: Integer): DWORD;
2899   var
2900    OldCacheSize: Integer;
2901   begin
# Line 2174 | Line 2932 | procedure TIBCustomDataSet.ReadCache(FCa
2932                                      Buffer: PChar);
2933   var
2934    pCache: PChar;
2935 +  AdjustedOffset: DWORD;
2936    bOld: Boolean;
2937   begin
2938    bOld := (FCache = FOldBufferCache);
2939 <  pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2939 >  AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2940    if not bOld then
2941 <    pCache := FBufferCache + Integer(pCache)
2941 >    pCache := FBufferCache + AdjustedOffset
2942    else
2943 <    pCache := FOldBufferCache + Integer(pCache);
2943 >    pCache := FOldBufferCache + AdjustedOffset;
2944    Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
2945    AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2946   end;
# Line 2211 | Line 2970 | procedure TIBCustomDataSet.WriteCache(FC
2970                                       Buffer: PChar);
2971   var
2972    pCache: PChar;
2973 +  AdjustedOffset: DWORD;
2974    bOld: Boolean;
2975    dwEnd: DWORD;
2976   begin
2977    bOld := (FCache = FOldBufferCache);
2978 <  pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2978 >  AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2979    if not bOld then
2980 <    pCache := FBufferCache + Integer(pCache)
2980 >    pCache := FBufferCache + AdjustedOffset
2981    else
2982 <    pCache := FOldBufferCache + Integer(pCache);
2982 >    pCache := FOldBufferCache + AdjustedOffset;
2983    Move(Buffer^, pCache^, FRecordBufferSize);
2984    dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2985    if not bOld then
# Line 2257 | Line 3017 | var
3017    Buff: PChar;
3018    bTr, bDB: Boolean;
3019   begin
3020 +  if (Field = nil) or (Field.DataSet <> self) then
3021 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3022    Buff := GetActiveBuf;
3023    if Buff = nil then
3024    begin
3025      fs := TIBBlobStream.Create;
3026      fs.Mode := bmReadWrite;
3027 +    fs.Database := Database;
3028 +    fs.Transaction := Transaction;
3029 +    fs.SetField(Field);
3030      FBlobStreamList.Add(Pointer(fs));
3031      result := TIBDSBlobStream.Create(Field, fs, Mode);
3032      exit;
# Line 2276 | Line 3041 | begin
3041      fs.Mode := bmReadWrite;
3042      fs.Database := Database;
3043      fs.Transaction := Transaction;
3044 +    fs.SetField(Field);
3045      fs.BlobID :=
3046 <      PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3046 >      PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3047      if (CachedUpdates) then
3048      begin
3049        bTr := not Transaction.InTransaction;
# Line 2298 | Line 3064 | begin
3064    result := TIBDSBlobStream.Create(Field, fs, Mode);
3065   end;
3066  
3067 + function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3068 + var Buff: PChar;
3069 +    pda: PArrayDataArray;
3070 +    bTr, bDB: Boolean;
3071 + begin
3072 +  if (Field = nil) or (Field.DataSet <> self) then
3073 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3074 +  Buff := GetActiveBuf;
3075 +  if Buff = nil then
3076 +    Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3077 +                              Field.FRelationName,Field.FieldName)
3078 +  else
3079 +  begin
3080 +    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3081 +    if pda^[Field.FCacheOffset] = nil then
3082 +    begin
3083 +      AdjustRecordOnInsert(Buff);
3084 +      if Field.IsNull then
3085 +        Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3086 +                                Field.FRelationName,Field.FieldName)
3087 +      else
3088 +        Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3089 +                            Field.FRelationName,Field.FieldName,Field.ArrayID);
3090 +      pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3091 +      FArrayList.Add(pda^[Field.FCacheOffset]);
3092 +      if (CachedUpdates) then
3093 +      begin
3094 +        bTr := not Transaction.InTransaction;
3095 +        bDB := not Database.Connected;
3096 +        if bDB then
3097 +          Database.Open;
3098 +        if bTr then
3099 +          Transaction.StartTransaction;
3100 +         pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3101 +        if bTr then
3102 +          Transaction.Commit;
3103 +        if bDB then
3104 +          Database.Close;
3105 +      end;
3106 +      WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3107 +    end
3108 +    else
3109 +      Result := pda^[Field.FCacheOffset].ArrayIntf;
3110 +  end;
3111 + end;
3112 +
3113 + procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3114 + var Buff: PChar;
3115 +    pda: PArrayDataArray;
3116 + begin
3117 +  if (Field = nil) or (Field.DataSet <> self) then
3118 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3119 +  Buff := GetActiveBuf;
3120 +  if Buff <> nil then
3121 +  begin
3122 +    AdjustRecordOnInsert(Buff);
3123 +    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3124 +    pda^[Field.FCacheOffset].FArray := AnArray;
3125 +    WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3126 +  end;
3127 + end;
3128 +
3129   function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3130   const
3131    CMPLess = -1;
# Line 2330 | Line 3158 | begin
3158    if FCachedUpdates and
3159      (Buff^.rdCachedUpdateStatus in [cusUnmodified]) then
3160      SaveOldBuffer(PChar(Buff));
3161 <  inherited;
3161 >  inherited DoBeforeDelete;
3162 > end;
3163 >
3164 > procedure TIBCustomDataSet.DoAfterDelete;
3165 > begin
3166 >  inherited DoAfterDelete;
3167 >  FBase.DoAfterDelete(self);
3168 >  InternalAutoCommit;
3169   end;
3170  
3171   procedure TIBCustomDataSet.DoBeforeEdit;
# Line 2344 | Line 3179 | begin
3179    if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
3180      SaveOldBuffer(PChar(Buff));
3181    CopyRecordBuffer(GetActiveBuf, FOldBuffer);
3182 <  inherited;
3182 >  inherited DoBeforeEdit;
3183 > end;
3184 >
3185 > procedure TIBCustomDataSet.DoAfterEdit;
3186 > begin
3187 >  inherited DoAfterEdit;
3188 >  FBase.DoAfterEdit(self);
3189   end;
3190  
3191   procedure TIBCustomDataSet.DoBeforeInsert;
3192   begin
3193    if not CanInsert then
3194      IBError(ibxeCannotInsert, [nil]);
3195 <  inherited;
3195 >  inherited DoBeforeInsert;
3196 > end;
3197 >
3198 > procedure TIBCustomDataSet.DoAfterInsert;
3199 > begin
3200 >  if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
3201 >    GeneratorField.Apply;
3202 >  inherited DoAfterInsert;
3203 >  FBase.DoAfterInsert(self);
3204 > end;
3205 >
3206 > procedure TIBCustomDataSet.DoBeforeClose;
3207 > begin
3208 >  inherited DoBeforeClose;
3209 >  if FInTransactionEnd and (FCloseAction = TARollback) then
3210 >     Exit;
3211 >  if State in [dsInsert,dsEdit] then
3212 >  begin
3213 >    if DataSetCloseAction = dcSaveChanges then
3214 >      Post;
3215 >      {Note this can fail with an exception e.g. due to
3216 >       database validation error. In which case the dataset remains open }
3217 >  end;
3218 >  if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3219 >    ApplyUpdates;
3220 > end;
3221 >
3222 > procedure TIBCustomDataSet.DoBeforeOpen;
3223 > var i: integer;
3224 > begin
3225 >  if assigned(FParser) then
3226 >     FParser.Reset;
3227 >  for i := 0 to FIBLinks.Count - 1 do
3228 >    TIBControlLink(FIBLinks[i]).UpdateSQL(self);
3229 >  inherited DoBeforeOpen;
3230 >  for i := 0 to FIBLinks.Count - 1 do
3231 >    TIBControlLink(FIBLinks[i]).UpdateParams(self);
3232 > end;
3233 >
3234 > procedure TIBCustomDataSet.DoBeforePost;
3235 > begin
3236 >  inherited DoBeforePost;
3237 >  if (State = dsInsert) and
3238 >     (GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
3239 >     GeneratorField.Apply
3240 > end;
3241 >
3242 > procedure TIBCustomDataSet.DoAfterPost;
3243 > begin
3244 >  inherited DoAfterPost;
3245 >  FBase.DoAfterPost(self);
3246 >  InternalAutoCommit;
3247   end;
3248  
3249   procedure TIBCustomDataSet.FetchAll;
3250   var
3251 <  SetCursor: Boolean;
2360 <  CurBookmark: string;
3251 >  CurBookmark: TBookmark;
3252   begin
3253 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3254 <  if SetCursor then
2364 <    Screen.Cursor := crHourGlass;
2365 <  try
3253 >  FBase.SetCursor;
3254 > try
3255      if FQSelect.EOF or not FQSelect.Open then
3256        exit;
3257      DisableControls;
# Line 2374 | Line 3263 | begin
3263        EnableControls;
3264      end;
3265    finally
3266 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2378 <      Screen.Cursor := crDefault;
3266 >    FBase.RestoreCursor;
3267    end;
3268   end;
3269  
# Line 2423 | Line 3311 | begin
3311      result := FDataLink.DataSource;
3312   end;
3313  
3314 + function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3315 + begin
3316 +  Result := FAliasNameMap[FieldNo-1]
3317 + end;
3318 +
3319 + function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3320 + var
3321 +   i: integer;
3322 + begin
3323 +   Result := nil;
3324 +   for i := 0 to Length(FAliasNameMap) - 1 do
3325 +       if FAliasNameMap[i] = aliasName then
3326 +       begin
3327 +         Result := FieldDefs[i];
3328 +         Exit
3329 +       end;
3330 + end;
3331 +
3332   function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3333   begin
3334    Result := DefaultFieldClasses[FieldType];
# Line 2441 | Line 3347 | begin
3347    result := False;
3348    Buff := GetActiveBuf;
3349    if (Buff = nil) or
3350 <     (not IsVisible(Buff)) then
3350 >     (not IsVisible(Buff)) or not assigned(Field.DataSet) then
3351      exit;
3352    { The intention here is to stuff the buffer with the data for the
3353     referenced field for the current record }
# Line 2453 | Line 3359 | begin
3359      if result and (Buffer <> nil) then
3360        Move(Buff[1], Buffer^, Field.DataSize);
3361    end
3362 <  else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3362 >  else
3363 >  if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3364       (FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3365 +  with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3366 +                         FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3367    begin
3368 <    result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
3368 >    result := not fdIsNull;
3369      if result and (Buffer <> nil) then
2461      with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
3370        begin
3371 <        Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3371 >        Data := Buff + fdDataOfs;
3372          if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3373          begin
3374 <          Move(Data^, Buffer^, fdDataLength);
3375 <          PChar(Buffer)[fdDataLength] := #0;
3374 >          if fdDataLength < Field.DataSize then
3375 >          begin
3376 >            Move(Data^, Buffer^, fdDataLength);
3377 >            PChar(Buffer)[fdDataLength] := #0;
3378 >          end
3379 >          else
3380 >            IBError(ibxeFieldSizeError,[Field.FieldName])
3381          end
3382          else
3383            Move(Data^, Buffer^, Field.DataSize);
# Line 2507 | Line 3420 | begin
3420          if not Accept and (GetMode = gmCurrent) then
3421            GetMode := gmPrior;
3422        except
3423 < //        Application.HandleException(Self);
3423 > //        FBase.HandleException(Self);
3424        end;
3425      end;
3426      RestoreState(SaveState);
# Line 2526 | Line 3439 | begin
3439          if FCurrentRecord < FRecordCount then
3440            ReadRecordCache(FCurrentRecord, Buffer, False)
3441          else begin
3442 <          while (not FQSelect.EOF) and
2530 <                (FQSelect.Next <> nil) and
3442 >          while (not FQSelect.EOF) and FQSelect.Next  and
3443                  (FCurrentRecord >= FRecordCount) do begin
3444              FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3445              Inc(FRecordCount);
# Line 2601 | Line 3513 | begin
3513    result := FRecordBufferSize;
3514   end;
3515  
3516 + procedure TIBCustomDataSet.InternalAutoCommit;
3517 + begin
3518 +  with Transaction do
3519 +    if InTransaction and (FAutoCommit = acCommitRetaining) then
3520 +    begin
3521 +      if CachedUpdates then ApplyUpdates;
3522 +      CommitRetaining;
3523 +    end;
3524 + end;
3525 +
3526   procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3527   begin
3528    CheckEditState;
# Line 2628 | Line 3550 | procedure TIBCustomDataSet.InternalCance
3550   var
3551    Buff: PChar;
3552    CurRec: Integer;
3553 +  pda: PArrayDataArray;
3554 +  i: integer;
3555   begin
3556 <  inherited;
3556 >  inherited InternalCancel;
3557    Buff := GetActiveBuf;
3558 <  if Buff <> nil then begin
3558 >  if Buff <> nil then
3559 >  begin
3560 >    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3561 >    for i := 0 to ArrayFieldCount - 1 do
3562 >      pda^[i].ArrayIntf.CancelChanges;
3563      CurRec := FCurrentRecord;
3564      AdjustRecordOnInsert(Buff);
3565      if (State = dsEdit) then begin
# Line 2654 | Line 3582 | begin
3582      DeactivateTransaction;
3583    FQSelect.Close;
3584    ClearBlobCache;
3585 +  ClearArrayCache;
3586    FreeRecordBuffer(FModelBuffer);
3587    FreeRecordBuffer(FOldBuffer);
3588    FCurrentRecord := -1;
# Line 2669 | Line 3598 | begin
3598    FOBEnd := 0;
3599    FreeMem(FBufferCache);
3600    FBufferCache := nil;
3601 +  FreeMem(FFieldColumns);
3602 +  FFieldColumns := nil;
3603    FreeMem(FOldBufferCache);
3604    FOldBufferCache := nil;
3605    BindFields(False);
3606 +  ResetParser;
3607    if DefaultFields then DestroyFields;
3608   end;
3609  
3610   procedure TIBCustomDataSet.InternalDelete;
3611   var
3612    Buff: PChar;
2681  SetCursor: Boolean;
3613   begin
3614 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2684 <  if SetCursor then
2685 <    Screen.Cursor := crHourGlass;
3614 >  FBase.SetCursor;
3615    try
3616      Buff := GetActiveBuf;
3617      if CanDelete then
# Line 2707 | Line 3636 | begin
3636      end else
3637        IBError(ibxeCannotDelete, [nil]);
3638    finally
3639 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2711 <      Screen.Cursor := crDefault;
3639 >    FBase.RestoreCursor;
3640    end;
3641   end;
3642  
# Line 2724 | Line 3652 | end;
3652  
3653   procedure TIBCustomDataSet.InternalHandleException;
3654   begin
3655 <  Application.HandleException(Self)
3655 >  FBase.HandleException(Self)
3656   end;
3657  
3658   procedure TIBCustomDataSet.InternalInitFieldDefs;
3659 + begin
3660 +  if not InternalPrepared then
3661 +  begin
3662 +    InternalPrepare;
3663 +    exit;
3664 +  end;
3665 +   FieldDefsFromQuery(FQSelect);
3666 + end;
3667 +
3668 + procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3669   const
3670    DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3671                 'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
# Line 2739 | Line 3677 | const
3677   var
3678    FieldType: TFieldType;
3679    FieldSize: Word;
3680 +  FieldDataSize: integer;
3681 +  charSetID: short;
3682 +  CharSetSize: integer;
3683 +  CharSetName: RawByteString;
3684 +  FieldCodePage: TSystemCodePage;
3685    FieldNullable : Boolean;
3686    i, FieldPosition, FieldPrecision: Integer;
3687 <  FieldAliasName: string;
3688 <  RelationName, FieldName: string;
3687 >  FieldAliasName, DBAliasName: string;
3688 >  aRelationName, FieldName: string;
3689    Query : TIBSQL;
3690    FieldIndex: Integer;
3691    FRelationNodes : TRelationNode;
3692 +  aArrayDimensions: integer;
3693 +  aArrayBounds: TArrayBounds;
3694 +  ArrayMetaData: IArrayMetaData;
3695  
3696    function Add_Node(Relation, Field : String) : TRelationNode;
3697    var
# Line 2841 | Line 3787 | var
3787    end;
3788  
3789   begin
2844  if not InternalPrepared then
2845  begin
2846    InternalPrepare;
2847    exit;
2848  end;
3790    FRelationNodes := TRelationNode.Create;
3791    FNeedsRefresh := False;
3792 <  Database.InternalTransaction.StartTransaction;
3792 >  if not Database.InternalTransaction.InTransaction then
3793 >    Database.InternalTransaction.StartTransaction;
3794    Query := TIBSQL.Create(self);
3795    try
3796      Query.Database := DataBase;
# Line 2856 | Line 3798 | begin
3798      FieldDefs.BeginUpdate;
3799      FieldDefs.Clear;
3800      FieldIndex := 0;
3801 <    if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3802 <      SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3801 >    if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3802 >      SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3803      Query.SQL.Text := DefaultSQL;
3804      Query.Prepare;
3805 <    for i := 0 to FQSelect.Current.Count - 1 do
3806 <      with FQSelect.Current[i].Data^ do
3805 >    SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3806 >    SetLength(FAliasNameList, SourceQuery.MetaData.Count);
3807 >    for i := 0 to SourceQuery.MetaData.GetCount - 1 do
3808 >      with SourceQuery.MetaData[i] do
3809        begin
3810          { Get the field name }
3811 <        SetString(FieldAliasName, aliasname, aliasname_length);
3812 <        SetString(RelationName, relname, relname_length);
3813 <        SetString(FieldName, sqlname, sqlname_length);
3811 >        FieldAliasName := GetName;
3812 >        DBAliasName := GetAliasname;
3813 >        aRelationName := getRelationName;
3814 >        FieldName := getSQLName;
3815 >        FAliasNameList[i] := DBAliasName;
3816          FieldSize := 0;
3817 +        FieldDataSize := GetSize;
3818          FieldPrecision := 0;
3819 <        FieldNullable := FQSelect.Current[i].IsNullable;
3820 <        case sqltype and not 1 of
3819 >        FieldNullable := IsNullable;
3820 >        CharSetSize := 0;
3821 >        CharSetName := '';
3822 >        FieldCodePage := CP_NONE;
3823 >        aArrayDimensions := 0;
3824 >        SetLength(aArrayBounds,0);
3825 >        case SQLType of
3826            { All VARCHAR's must be converted to strings before recording
3827             their values }
3828            SQL_VARYING, SQL_TEXT:
3829            begin
3830 <            FieldSize := sqllen;
3830 >            if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3831 >              CharSetSize := 1;
3832 >            CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3833 >            Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3834 >            FieldSize := FieldDataSize div CharSetSize;
3835              FieldType := ftString;
3836            end;
3837            { All Doubles/Floats should be cast to doubles }
# Line 2883 | Line 3839 | begin
3839              FieldType := ftFloat;
3840            SQL_SHORT:
3841            begin
3842 <            if (sqlscale = 0) then
3842 >            if (getScale = 0) then
3843                FieldType := ftSmallInt
3844              else begin
3845                FieldType := ftBCD;
3846                FieldPrecision := 4;
3847 <              FieldSize := -sqlscale;
3847 >              FieldSize := -getScale;
3848              end;
3849            end;
3850            SQL_LONG:
3851            begin
3852 <            if (sqlscale = 0) then
3852 >            if (getScale = 0) then
3853                FieldType := ftInteger
3854 <            else if (sqlscale >= (-4)) then
3854 >            else if (getScale >= (-4)) then
3855              begin
3856                FieldType := ftBCD;
3857                FieldPrecision := 9;
3858 <              FieldSize := -sqlscale;
3858 >              FieldSize := -getScale;
3859              end
3860              else
3861 <              FieldType := ftFloat;
3861 >            if Database.SQLDialect = 1 then
3862 >              FieldType := ftFloat
3863 >            else
3864 >            if (FieldCount > i) and (Fields[i] is TFloatField) then
3865 >              FieldType := ftFloat
3866 >            else
3867 >            begin
3868 >              FieldType := ftFMTBCD;
3869 >              FieldPrecision := 9;
3870 >              FieldSize := -getScale;
3871              end;
3872 +          end;
3873 +
3874            SQL_INT64:
3875            begin
3876 <            if (sqlscale = 0) then
3876 >            if (getScale = 0) then
3877                FieldType := ftLargeInt
3878 <            else if (sqlscale >= (-4)) then
3878 >            else if (getScale >= (-4)) then
3879              begin
3880                FieldType := ftBCD;
3881                FieldPrecision := 18;
3882 <              FieldSize := -sqlscale;
3882 >              FieldSize := -getScale;
3883              end
3884              else
3885                FieldType := ftFloat;
3886 <            end;
3886 >          end;
3887            SQL_TIMESTAMP: FieldType := ftDateTime;
3888            SQL_TYPE_TIME: FieldType := ftTime;
3889            SQL_TYPE_DATE: FieldType := ftDate;
3890            SQL_BLOB:
3891            begin
3892              FieldSize := sizeof (TISC_QUAD);
3893 <            if (sqlsubtype = 1) then
3894 <              FieldType := ftmemo
3893 >            if (getSubtype = 1) then
3894 >            begin
3895 >              if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3896 >                CharSetSize := 1;
3897 >              CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3898 >              Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3899 >              FieldType := ftMemo;
3900 >            end
3901              else
3902                FieldType := ftBlob;
3903            end;
3904            SQL_ARRAY:
3905            begin
3906              FieldSize := sizeof (TISC_QUAD);
3907 <            FieldType := ftUnknown;
3907 >            FieldType := ftArray;
3908 >            ArrayMetaData := GetArrayMetaData;
3909 >            if ArrayMetaData <> nil then
3910 >            begin
3911 >              aArrayDimensions := ArrayMetaData.GetDimensions;
3912 >              aArrayBounds := ArrayMetaData.GetBounds;
3913 >            end;
3914            end;
3915 +          SQL_BOOLEAN:
3916 +             FieldType:= ftBoolean;
3917            else
3918              FieldType := ftUnknown;
3919          end;
# Line 2941 | Line 3922 | begin
3922          begin
3923            FMappedFieldPosition[FieldIndex] := FieldPosition;
3924            Inc(FieldIndex);
3925 <          with FieldDefs.AddFieldDef do
3925 >          with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3926            begin
3927 <            Name := string( FieldAliasName );
3928 <            FieldNo := FieldPosition;
2948 <            DataType := FieldType;
3927 >            Name := FieldAliasName;
3928 >            FAliasNameMap[FieldNo-1] := DBAliasName;
3929              Size := FieldSize;
3930 +            DataSize := FieldDataSize;
3931              Precision := FieldPrecision;
3932 <            Required := False;
3932 >            Required := not FieldNullable;
3933 >            RelationName := aRelationName;
3934              InternalCalcField := False;
3935 +            CharacterSetSize := CharSetSize;
3936 +            CharacterSetName := CharSetName;
3937 +            CodePage := FieldCodePage;
3938 +            ArrayDimensions := aArrayDimensions;
3939 +            ArrayBounds := aArrayBounds;
3940              if (FieldName <> '') and (RelationName <> '') then
3941              begin
3942                if Has_COMPUTED_BLR(RelationName, FieldName) then
# Line 2977 | Line 3964 | begin
3964      FreeNodes;
3965      Database.InternalTransaction.Commit;
3966      FieldDefs.EndUpdate;
3967 +    FieldDefs.Updated := true;
3968    end;
3969   end;
3970  
# Line 2994 | Line 3982 | begin
3982    else begin
3983      Buffer := AllocRecordBuffer;
3984      try
3985 <      while FQSelect.Next <> nil do
3985 >      while FQSelect.Next do
3986        begin
3987          FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3988          Inc(FRecordCount);
# Line 3009 | Line 3997 | end;
3997   procedure TIBCustomDataSet.InternalSetParamsFromCursor;
3998   var
3999    i: Integer;
4000 <  cur_param: TIBXSQLVAR;
4000 >  cur_param: ISQLParam;
4001    cur_field: TField;
4002    s: TStream;
4003   begin
# Line 3017 | Line 4005 | begin
4005      IBError(ibxeEmptyQuery, [nil]);
4006    if not FInternalPrepared then
4007      InternalPrepare;
4008 <  if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4008 >  if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4009    begin
4010 <    for i := 0 to SQLParams.Count - 1 do
4010 >    for i := 0 to SQLParams.GetCount - 1 do
4011      begin
4012        cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4013        cur_param := SQLParams[i];
# Line 3029 | Line 4017 | begin
4017          else case cur_field.DataType of
4018            ftString:
4019              cur_param.AsString := cur_field.AsString;
4020 <          ftBoolean, ftSmallint, ftWord:
4020 >          ftBoolean:
4021 >            cur_param.AsBoolean := cur_field.AsBoolean;
4022 >          ftSmallint, ftWord:
4023              cur_param.AsShort := cur_field.AsInteger;
4024            ftInteger:
4025              cur_param.AsLong := cur_field.AsInteger;
# Line 3051 | Line 4041 | begin
4041              try
4042                s := DataSource.DataSet.
4043                       CreateBlobStream(cur_field, bmRead);
4044 <              cur_param.LoadFromStream(s);
4044 >              cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4045              finally
4046                s.free;
4047              end;
4048            end;
4049 +          ftArray:
4050 +            cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4051            else
4052              IBError(ibxeNotSupported, [nil]);
4053          end;
# Line 3082 | Line 4074 | begin
4074   end;
4075  
4076   procedure TIBCustomDataSet.InternalOpen;
3085 var
3086  SetCursor: Boolean;
4077  
4078    function RecordDataLength(n: Integer): Long;
4079    begin
# Line 3091 | Line 4081 | var
4081    end;
4082  
4083   begin
4084 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3095 <  if SetCursor then
3096 <    Screen.Cursor := crHourGlass;
4084 >  FBase.SetCursor;
4085    try
4086      ActivateConnection;
4087      ActivateTransaction;
# Line 3101 | Line 4089 | begin
4089        IBError(ibxeEmptyQuery, [nil]);
4090      if not FInternalPrepared then
4091        InternalPrepare;
4092 <   if FQSelect.SQLType = SQLSelect then
4092 >   if FQSelect.SQLStatementType = SQLSelect then
4093     begin
4094        if DefaultFields then
4095          CreateFields;
4096 +      FArrayFieldCount := 0;
4097        BindFields(True);
4098        FCurrentRecord := -1;
4099        FQSelect.ExecQuery;
# Line 3116 | Line 4105 | begin
4105          3. After the dummy fetch, FRecordSize will be appropriately
4106             adjusted to reflect the additional "weight" of the field
4107             data.
4108 <        4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4108 >        4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4109          5. Now, with the BufferSize available, allocate memory for chunks of records
4110          6. Re-allocate the model buffer, accounting for the new
4111             FRecordBufferSize.
4112          7. Finally, calls to AllocRecordBuffer will work!.
4113         }
4114        {Step 1}
4115 <      FRecordSize := RecordDataLength(FQSelect.Current.Count);
4115 >      FRecordSize := RecordDataLength(FQSelect.FieldCount);
4116        {Step 2, 3}
4117 +      GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4118        IBAlloc(FModelBuffer, 0, FRecordSize);
4119 <      FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4119 >      InitModelBuffer(FQSelect, FModelBuffer);
4120        {Step 4}
4121        FCalcFieldsOffset := FRecordSize;
4122        FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4123 <      FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4123 >      FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4124 >      FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4125        {Step 5}
4126        if UniDirectional then
4127          FBufferChunkSize := FRecordBufferSize * UniCache
# Line 3146 | Line 4137 | begin
4137        FCacheSize := FBufferChunkSize;
4138        FOldCacheSize := FBufferChunkSize;
4139        {Step 6}
4140 <      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4140 >      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4141                               FRecordBufferSize);
4142        {Step 7}
4143        FOldBuffer := AllocRecordBuffer;
# Line 3154 | Line 4145 | begin
4145      else
4146        FQSelect.ExecQuery;
4147    finally
4148 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3158 <      Screen.Cursor := crDefault;
4148 >    FBase.RestoreCursor;
4149    end;
4150   end;
4151  
# Line 3163 | Line 4153 | procedure TIBCustomDataSet.InternalPost;
4153   var
4154    Qry: TIBSQL;
4155    Buff: PChar;
3166  SetCursor: Boolean;
4156    bInserting: Boolean;
4157   begin
4158 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3170 <  if SetCursor then
3171 <    Screen.Cursor := crHourGlass;
4158 >  FBase.SetCursor;
4159    try
4160      Buff := GetActiveBuf;
4161      CheckEditState;
# Line 3206 | Line 4193 | begin
4193      if bInserting then
4194        Inc(FRecordCount);
4195    finally
4196 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3210 <      Screen.Cursor := crDefault;
4196 >    FBase.RestoreCursor;
4197    end;
4198   end;
4199  
4200   procedure TIBCustomDataSet.InternalRefresh;
4201   begin
4202 <  inherited;
4202 >  inherited InternalRefresh;
4203    InternalRefreshRow;
4204   end;
4205  
# Line 3227 | Line 4213 | begin
4213    result := FOpen;
4214   end;
4215  
4216 + procedure TIBCustomDataSet.Loaded;
4217 + begin
4218 +  if assigned(FQSelect) then
4219 +    FBaseSQLSelect.assign(FQSelect.SQL);
4220 +  inherited Loaded;
4221 + end;
4222 +
4223 + procedure TIBCustomDataSet.Post;
4224 + var CancelPost: boolean;
4225 + begin
4226 +  CancelPost := false;
4227 +  if assigned(FOnValidatePost) then
4228 +    OnValidatePost(self,CancelPost);
4229 +  if CancelPost then
4230 +    Cancel
4231 +  else
4232 +   inherited Post;
4233 + end;
4234 +
4235   function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4236                                   Options: TLocateOptions): Boolean;
4237   var
4238 <  CurBookmark: string;
4238 >  CurBookmark: TBookmark;
4239   begin
4240    DisableControls;
4241    try
# Line 3248 | Line 4253 | function TIBCustomDataSet.Lookup(const K
4253                                   const ResultFields: string): Variant;
4254   var
4255    fl: TList;
4256 <  CurBookmark: string;
4256 >  CurBookmark: TBookmark;
4257   begin
4258    DisableControls;
4259    fl := TList.Create;
# Line 3301 | Line 4306 | end;
4306   procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4307   var
4308    Buff, TmpBuff: PChar;
4309 +  MappedFieldPos: integer;
4310   begin
4311    Buff := GetActiveBuf;
4312    if Field.FieldNo < 0 then
# Line 3317 | Line 4323 | begin
4323      begin
4324        { If inserting, Adjust record position }
4325        AdjustRecordOnInsert(Buff);
4326 <      if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4327 <         (FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4326 >      MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4327 >      if (MappedFieldPos > 0) and
4328 >         (MappedFieldPos <= rdFieldCount) then
4329 >      with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4330        begin
4331          Field.Validate(Buffer);
4332          if (Buffer = nil) or
4333             (Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4334 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4335 <        else begin
4336 <          Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4337 <                 rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4338 <          if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4339 <             (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4340 <            rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
3333 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4334 >          fdIsNull := True
4335 >        else
4336 >        begin
4337 >          Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4338 >          if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4339 >            fdDataLength := StrLen(PChar(Buffer));
4340 >          fdIsNull := False;
4341            if rdUpdateStatus = usUnmodified then
4342            begin
4343              if CachedUpdates then
# Line 3354 | Line 4361 | begin
4361      end;
4362    end;
4363    if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
4364 <      DataEvent(deFieldChange, Longint(Field));
4364 >      DataEvent(deFieldChange, PtrInt(Field));
4365   end;
4366  
4367   procedure TIBCustomDataSet.SetRecNo(Value: Integer);
# Line 3418 | Line 4425 | begin
4425   FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4426   end;
4427  
4428 + procedure TIBCustomDataSet.ClearIBLinks;
4429 + var i: integer;
4430 + begin
4431 +  for i := FIBLinks.Count - 1 downto 0 do
4432 +    TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4433 + end;
4434 +
4435  
4436   procedure TIBCustomDataSet.InternalUnPrepare;
4437   begin
4438    if FInternalPrepared then
4439    begin
4440      CheckDatasetClosed;
4441 +    if FDidActivate then
4442 +      DeactivateTransaction;
4443      FieldDefs.Clear;
4444 +    FieldDefs.Updated := false;
4445      FInternalPrepared := False;
4446 +    Setlength(FAliasNameList,0);
4447    end;
4448   end;
4449  
4450   procedure TIBCustomDataSet.InternalExecQuery;
4451   var
4452    DidActivate: Boolean;
3435  SetCursor: Boolean;
4453   begin
4454    DidActivate := False;
4455 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3439 <  if SetCursor then
3440 <    Screen.Cursor := crHourGlass;
4455 >  FBase.SetCursor;
4456    try
4457      ActivateConnection;
4458      DidActivate := ActivateTransaction;
# Line 3445 | Line 4460 | begin
4460        IBError(ibxeEmptyQuery, [nil]);
4461      if not FInternalPrepared then
4462        InternalPrepare;
4463 <    if FQSelect.SQLType = SQLSelect then
4463 >    if FQSelect.SQLStatementType = SQLSelect then
4464      begin
4465        IBError(ibxeIsASelectStatement, [nil]);
4466      end
# Line 3454 | Line 4469 | begin
4469    finally
4470      if DidActivate then
4471        DeactivateTransaction;
4472 <    if SetCursor and (Screen.Cursor = crHourGlass) then
4473 <      Screen.Cursor := crDefault;
4472 >    FBase.RestoreCursor;
4473 >  end;
4474 > end;
4475 >
4476 > function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4477 > begin
4478 >  Result := FQSelect.Statement;
4479 > end;
4480 >
4481 > function TIBCustomDataSet.GetParser: TSelectSQLParser;
4482 > begin
4483 >  if not assigned(FParser) then
4484 >    FParser := CreateParser;
4485 >  Result := FParser
4486 > end;
4487 >
4488 > procedure TIBCustomDataSet.ResetParser;
4489 > begin
4490 >  if assigned(FParser) then
4491 >  begin
4492 >    FParser.Free;
4493 >    FParser := nil;
4494 >    FQSelect.OnSQLChanged := nil; {Do not react to change}
4495 >    try
4496 >      FQSelect.SQL.Assign(FBaseSQLSelect);
4497 >    finally
4498 >      FQSelect.OnSQLChanged := SQLChanged;
4499 >    end;
4500    end;
4501   end;
4502  
4503 < function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4503 > function TIBCustomDataSet.HasParser: boolean;
4504   begin
4505 <  Result := FQSelect.Handle;
4505 >  Result := not (csDesigning in ComponentState) and (FParser <> nil)
4506 > end;
4507 >
4508 > procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4509 > begin
4510 >  if FGenerateParamNames = AValue then Exit;
4511 >  FGenerateParamNames := AValue;
4512 >  Disconnect
4513   end;
4514  
4515   procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
# Line 3635 | Line 4683 | begin
4683    Transaction.StartTransaction;
4684   end;
4685  
4686 < function TIBCustomDataSet.PSGetTableName: string;
4686 > function TIBCustomDataSet.PsGetTableName: string;
4687   begin
4688   //  if not FInternalPrepared then
4689   //    InternalPrepare;
# Line 3682 | Line 4730 | begin
4730    ActivateConnection;
4731    ActivateTransaction;
4732    InternalSetParamsFromCursor;
4733 <  Inherited;
4733 >  Inherited InternalOpen;
4734   end;
4735  
4736   procedure TIBDataSet.SetFiltered(Value: Boolean);
# Line 3710 | Line 4758 | end;
4758  
4759   function TIBCustomDataSet.GetFieldData(Field: TField;
4760    Buffer: Pointer): Boolean;
4761 + {$IFDEF TBCDFIELD_IS_BCD}
4762   var
4763    lTempCurr : System.Currency;
4764   begin
# Line 3720 | Line 4769 | begin
4769        CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4770    end
4771    else
4772 + {$ELSE}
4773 + begin
4774 + {$ENDIF}
4775      Result := InternalGetFieldData(Field, Buffer);
4776   end;
4777  
# Line 3733 | Line 4785 | begin
4785   end;
4786  
4787   procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4788 + {$IFDEF TDBDFIELD_IS_BCD}
4789   var
4790    lTempCurr : System.Currency;
4791   begin
4792 <  if Field.DataType = ftBCD then
4792 >  if (Field.DataType = ftBCD) and (Buffer <> nil) then
4793    begin
4794      BCDToCurr(TBCD(Buffer^), lTempCurr);
4795      InternalSetFieldData(Field, @lTempCurr);
4796    end
4797    else
4798 + {$ELSE}
4799 + begin
4800 + {$ENDIF}
4801      InternalSetFieldData(Field, Buffer);
4802   end;
4803  
# Line 3765 | Line 4821 | end;
4821   destructor TIBDataSetUpdateObject.Destroy;
4822   begin
4823    FRefreshSQL.Free;
4824 <  inherited destroy;
4824 >  inherited Destroy;
4825   end;
4826  
4827 < procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
4827 > procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
4828   begin
4829    FRefreshSQL.Assign(Value);
4830   end;
4831  
4832 + procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
4833 +  buff: PChar);
4834 + begin
4835 +  if not Assigned(DataSet) then Exit;
4836 +  DataSet.SetInternalSQLParams(Params, buff);
4837 + end;
4838 +
4839 + procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4840 + begin
4841 +  InternalSetParams(Query.Params,buff);
4842 + end;
4843 +
4844 + function TIBDSBlobStream.GetSize: Int64;
4845 + begin
4846 +  Result := FBlobStream.BlobSize;
4847 + end;
4848 +
4849   { TIBDSBlobStream }
4850   constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4851                                      Mode: TBlobStreamMode);
# Line 3781 | Line 4854 | begin
4854    FBlobStream := ABlobStream;
4855    FBlobStream.Seek(0, soFromBeginning);
4856    if (Mode = bmWrite) then
4857 +  begin
4858      FBlobStream.Truncate;
4859 +    TIBCustomDataSet(FField.DataSet).RecordModified(True);
4860 +    TBlobField(FField).Modified := true;
4861 +    FHasWritten := true;
4862 +  end;
4863 + end;
4864 +
4865 + destructor TIBDSBlobStream.Destroy;
4866 + begin
4867 +  if FHasWritten then
4868 +     TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4869 +  inherited Destroy;
4870   end;
4871  
4872   function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
# Line 3804 | Line 4889 | begin
4889    if not (FField.DataSet.State in [dsEdit, dsInsert]) then
4890      IBError(ibxeNotEditing, [nil]);
4891    TIBCustomDataSet(FField.DataSet).RecordModified(True);
4892 +  TBlobField(FField).Modified := true;
4893    result := FBlobStream.Write(Buffer, Count);
4894 <  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
4894 >  FHasWritten := true;
4895 > {  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4896 >  Removed as this caused a seek to beginning of the blob stream thus corrupting
4897 >  the blob stream. Moved to the destructor i.e. called after blob written}
4898 > end;
4899 >
4900 > { TIBGenerator }
4901 >
4902 > procedure TIBGenerator.SetIncrement(const AValue: integer);
4903 > begin
4904 >  if AValue < 0 then
4905 >     raise Exception.Create('A Generator Increment cannot be negative');
4906 >  FIncrement := AValue
4907 > end;
4908 >
4909 > function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4910 >  ATransaction: TIBTransaction): integer;
4911 > begin
4912 >  with TIBSQL.Create(nil) do
4913 >  try
4914 >    Database := ADatabase;
4915 >    Transaction := ATransaction;
4916 >    if not assigned(Database) then
4917 >       IBError(ibxeCannotSetDatabase,[]);
4918 >    if not assigned(Transaction) then
4919 >       IBError(ibxeCannotSetTransaction,[]);
4920 >    with Transaction do
4921 >      if not InTransaction then StartTransaction;
4922 >    SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
4923 >    Prepare;
4924 >    ExecQuery;
4925 >    try
4926 >      Result := FieldByName('ID').AsInteger
4927 >    finally
4928 >      Close
4929 >    end;
4930 >  finally
4931 >    Free
4932 >  end;
4933   end;
4934  
4935 + constructor TIBGenerator.Create(Owner: TIBCustomDataSet);
4936 + begin
4937 +  FOwner := Owner;
4938 +  FIncrement := 1;
4939 + end;
4940 +
4941 +
4942 + procedure TIBGenerator.Apply;
4943 + begin
4944 +  if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4945 +    Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4946 + end;
4947 +
4948 +
4949   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines