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 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 80 by tony, Mon Jan 1 11:31:07 2018 UTC

# Line 27 | Line 27
27   {    IBX For Lazarus (Firebird Express)                                  }
28   {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29   {    Portions created by MWA Software are copyright McCallum Whyman      }
30 < {    Associates Ltd 2011                                                 }
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}
# Line 47 | Line 52 | uses
52   {$ELSE}
53    unix,
54   {$ENDIF}
55 <  SysUtils, Classes, Forms, Controls, IBDatabase,
56 <  IBExternals, IB, IBHeader,  IBSQL, Db,
52 <  IBUtils, IBBlob;
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 70 | Line 74 | type
74      procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
75      procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract;
76      function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
77 <    procedure InternalSetParams(Query: TIBSQL; buff: PChar);
77 >    procedure InternalSetParams(Params: ISQLParams; buff: PChar); overload;
78 >    procedure InternalSetParams(Query: TIBSQL; buff: PChar); overload;
79      property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
80    public
81      constructor Create(AOwner: TComponent); override;
# Line 81 | Line 86 | type
86  
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 103 | 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;
# Line 115 | 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 147 | 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 185 | Line 288 | type
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;
205    FIBLoaded: Boolean;
334      FBase: TIBBase;
335      FBlobCacheOffset: Integer;
336      FBlobStreamList: TList;
337 +    FArrayList: TList;
338      FBufferChunks: Integer;
339      FBufferCache,
340      FOldBufferCache: PChar;
# Line 223 | Line 352 | type
352      FDeletedRecords: Long;
353      FModelBuffer,
354      FOldBuffer: PChar;
355 +    FOnValidatePost: TOnValidatePost;
356      FOpen: Boolean;
357      FInternalPrepared: Boolean;
358      FQDelete,
# Line 233 | 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 250 | 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 263 | 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;
276    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;
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); 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 302 | Line 444 | type
444      procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
445      procedure SetUniDirectional(Value: Boolean);
446      procedure RefreshParams;
305    procedure SQLChanging(Sender: TObject); virtual;
447      function AdjustPosition(FCache: PChar; Offset: DWORD;
448                              Origin: Integer): DWORD;
449      procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
# Line 321 | 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); virtual;
469      procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
# Line 330 | Line 473 | type
473      procedure InternalRefreshRow; virtual;
474      procedure InternalSetParamsFromCursor; virtual;
475      procedure CheckNotUniDirectional;
476 +    procedure SQLChanging(Sender: TObject); virtual;
477 +    procedure SQLChanged(Sender: TObject); virtual;
478  
479 < (*    { IProviderSupport }
479 >    { IProviderSupport }
480      procedure PSEndTransaction(Commit: Boolean); override;
481      function PSExecuteStatement(const ASQL: string; AParams: TParams;
482        ResultSet: Pointer = nil): Integer; override;
# Line 344 | Line 489 | type
489      procedure PSStartTransaction; override;
490      procedure PSReset; override;
491      function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
492 < *)
492 >
493      { TDataSet support }
494      procedure InternalInsert; override;
495      procedure InitRecord(Buffer: PChar); override;
# Line 353 | 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;
# Line 385 | Line 538 | type
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 397 | 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;
# Line 420 | 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 433 | 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 440 | 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;*)
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 <    function ParamByName(ParamName: String): TIBXSQLVAR;
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;
# Line 507 | 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 532 | 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 543 | Line 719 | type
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 581 | 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 615 | 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 623 | Line 829 | DefaultFieldClasses: array[TFieldType] o
829      TBlobField,         { ftTypedBinary }
830      nil,                { ftCursor }
831      TStringField,       { ftFixedChar }
832 <    TWideStringField,    { ftWideString }
832 >    nil,    { ftWideString }
833      TLargeIntField,     { ftLargeInt }
834      nil,          { ftADT }
835 <    nil,        { ftArray }
835 >    TIBArrayField,        { ftArray }
836      nil,    { ftReference }
837      nil,     { ftDataSet }
838      TBlobField,         { ftOraBlob }
# Line 638 | Line 844 | DefaultFieldClasses: array[TFieldType] o
844      TDateTimeField,    {ftTimestamp}
845      TIBBCDField,       {ftFMTBcd}
846      nil,  {ftFixedWideChar}
847 <    TWideMemoField);   {ftWideMemo}
847 >    nil);   {ftWideMemo}
848   (*
849      TADTField,          { ftADT }
850      TArrayField,        { ftArray }
# Line 655 | Line 861 | DefaultFieldClasses: array[TFieldType] o
861  
862   implementation
863  
864 < uses IBIntf, Variants, FmtBCD;
864 > uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
865  
866   const FILE_BEGIN = 0;
867        FILE_CURRENT = 1;
# Line 679 | Line 885 | type
885    end;
886  
887  
888 < { TIBStringField}
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 < constructor TIBStringField.Create(AOwner: TComponent);
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 + procedure TIBStringField.Bind(Binding: Boolean);
1140 + var IBFieldDef: TIBFieldDef;
1141 + begin
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 706 | 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 725 | 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 738 | Line 1227 | begin
1227    end;
1228   end;
1229  
1230 +
1231   { TIBBCDField }
1232  
1233   constructor TIBBCDField.Create(AOwner: TComponent);
# Line 831 | Line 1321 | end;
1321   constructor TIBCustomDataSet.Create(AOwner: TComponent);
1322   begin
1323    inherited Create(AOwner);
834  FIBLoaded := False;
835  CheckIBLoaded;
836  FIBLoaded := True;
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);
# Line 853 | 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 873 | 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    if Active then Active := false;
1375 <  if FIBLoaded then
1376 <  begin
1377 <    if assigned(FGeneratorField) then FGeneratorField.Free;
1378 <    FDataLink.Free;
1379 <    FBase.Free;
1380 <    ClearBlobCache;
1381 <    FBlobStreamList.Free;
1382 <    FreeMem(FBufferCache);
1383 <    FBufferCache := nil;
1384 <    FreeMem(FOldBufferCache);
1385 <    FOldBufferCache := nil;
1386 <    FCacheSize := 0;
1387 <    FOldCacheSize := 0;
1388 <    FMappedFieldPosition := nil;
1389 <  end;
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  
# Line 915 | 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 934 | Line 1430 | end;
1430  
1431   procedure TIBCustomDataSet.ApplyUpdates;
1432   var
937  {$IF FPC_FULLVERSION > 20600 }
1433    CurBookmark: TBookmark;
939  {$ELSE}
940  CurBookmark: string;
941  {$ENDIF}
1434    Buffer: PRecordData;
1435    CurUpdateTypes: TIBUpdateRecordTypes;
1436    UpdateAction: TIBUpdateAction;
# Line 1136 | 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 1148 | Line 1661 | end;
1661   function TIBCustomDataSet.ActivateTransaction: Boolean;
1662   begin
1663    Result := False;
1664 <  if not Assigned(Transaction) then
1152 <    IBError(ibxeTransactionNotAssigned, [nil]);
1153 <  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 1196 | 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 1273 | 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 1282 | 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 1299 | 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 1313 | 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 1329 | 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
1337  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 <  temp: TIBXSQLVAR;
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 :=
1392 <        (Qry.Current[i].Data^.sqltype and 1 = 1);
1393 <      rdFields[j].fdIsNull :=
1394 <        (rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1395 <      LocalData := Qry.Current[i].Data^.sqldata;
1396 <      case rdFields[j].fdDataType of
1397 <        SQL_TIMESTAMP:
1398 <        begin
1399 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1400 <          if RecordNumber >= 0 then
1401 <            LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
1402 <          LocalData := PChar(@LocalDate);
1403 <        end;
1404 <        SQL_TYPE_DATE:
1405 <        begin
1406 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1407 <          if RecordNumber >= 0 then
1408 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
1409 <          LocalData := PChar(@LocalInt);
1410 <        end;
1411 <        SQL_TYPE_TIME:
1412 <        begin
1413 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1414 <          if RecordNumber >= 0 then
1415 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1416 <          LocalData := PChar(@LocalInt);
1417 <        end;
1418 <        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
1466 <          rdFields[j].fdDataSize := SizeOf(Double);
1467 <          if RecordNumber >= 0 then
1468 <            LocalDouble := Qry.Current[i].AsDouble;
1469 <          LocalData := PChar(@LocalDouble);
1470 <        end;
1471 <        SQL_VARYING:
1472 <        begin
1473 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1474 <          rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1475 <          if RecordNumber >= 0 then
1476 <          begin
1477 <            if (rdFields[j].fdDataLength = 0) then
1478 <              LocalData := nil
1479 <            else
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 <              temp :=  Qry.Current[i];
2096 <              LocalData := @temp.Data^.sqldata[2];
1483 < (*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
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
1491 <            rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1492 <        end;
1493 <      end;
1494 <      if RecordNumber < 0 then
1495 <      begin
1496 <        rdFields[j].fdIsNull := True;
1497 <        rdFields[j].fdDataOfs := FRecordSize;
1498 <        Inc(FRecordSize, rdFields[j].fdDataSize);
1499 <      end
1500 <      else begin
1501 <        if rdFields[j].fdDataType = SQL_VARYING then
1502 <        begin
1503 <          if LocalData <> nil then
1504 <            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 1553 | Line 2155 | begin
2155    result := FBase.Database;
2156   end;
2157  
1556 function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1557 begin
1558  result := FBase.DBHandle;
1559 end;
1560
2158   function TIBCustomDataSet.GetDeleteSQL: TStrings;
2159   begin
2160    result := FQDelete.SQL;
# Line 1568 | 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 1585 | 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 1600 | Line 2197 | begin
2197    result := FBase.Transaction;
2198   end;
2199  
1603 function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1604 begin
1605  result := FBase.TRHandle;
1606 end;
1607
2200   procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2201   begin
2202    if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
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 1626 | Line 2218 | function TIBCustomDataSet.InternalLocate
2218    const KeyValues: Variant; Options: TLocateOptions): Boolean;
2219   var
2220    keyFieldList: TList;
1629  {$IF FPC_FULLVERSION > 20600 }
2221    CurBookmark: TBookmark;
1631  {$ELSE}
1632  CurBookmark: string;
1633  {$ENDIF}
2222    fieldValue: Variant;
2223    lookupValues: array of variant;
2224    i, fieldCount: Integer;
# Line 1712 | Line 2300 | 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 1725 | 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
# Line 1741 | Line 2352 | begin
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 1755 | Line 2366 | end;
2366   procedure TIBCustomDataSet.InternalRefreshRow;
2367   var
2368    Buff: PChar;
1758  SetCursor: Boolean;
2369    ofs: DWORD;
2370    Qry: TIBSQL;
2371   begin
2372 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1763 <  if SetCursor then
1764 <    Screen.Cursor := crHourGlass;
2372 >  FBase.SetCursor;
2373    try
2374      Buff := GetActiveBuf;
2375      if CanRefresh then
# Line 1778 | 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
1785 <             (Qry.Next <> nil) then
2392 >          if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2393            begin
2394              ofs := PRecordData(Buff)^.rdSavedOffset;
2395              FetchCurrentRecordToBuffer(Qry,
# Line 1805 | Line 2412 | begin
2412      else
2413        IBError(ibxeCannotRefresh, [nil]);
2414    finally
2415 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1809 <      Screen.Cursor := crDefault;
2415 >    FBase.RestoreCursor;
2416    end;
2417   end;
2418  
# Line 1876 | Line 2482 | begin
2482   end;
2483  
2484   procedure TIBCustomDataSet.InternalPrepare;
1879 var
1880  SetCursor: Boolean;
1881  DidActivate: Boolean;
2485   begin
2486    if FInternalPrepared then
2487      Exit;
2488 <  DidActivate := False;
1886 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1887 <  if SetCursor then
1888 <    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 +      FQDelete.GenerateParamNames := FGenerateParamNames;
2513        if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2514          FQDelete.Prepare;
2515 +      FQInsert.GenerateParamNames := FGenerateParamNames;
2516        if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2517          FQInsert.Prepare;
2518 +      FQRefresh.GenerateParamNames := FGenerateParamNames;
2519        if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2520          FQRefresh.Prepare;
2521 +      FQModify.GenerateParamNames := FGenerateParamNames;
2522        if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2523          FQModify.Prepare;
2524        FInternalPrepared := True;
# Line 1911 | Line 2526 | begin
2526      end else
2527        IBError(ibxeEmptyQuery, [nil]);
2528    finally
2529 <    if DidActivate then
1915 <      DeactivateTransaction;
1916 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1917 <      Screen.Cursor := crDefault;
2529 >    FBase.RestoreCursor;
2530    end;
2531   end;
2532  
# Line 1943 | 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 1985 | 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 2012 | 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 2026 | 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 2048 | 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)^
2075 <              else if rdFields[j].fdDataScale >= (-4) then
2076 <                Qry.Params[i].AsCurrency := PCurrency(data)^
2691 >              if fdDataScale = 0 then
2692 >                Param.AsLong := PLong(data)^
2693                else
2694 <                Qry.Params[i].AsDouble := PDouble(data)^;
2694 >              if fdDataScale >= (-4) then
2695 >                Param.AsCurrency := PCurrency(data)^
2696 >              else
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 :=
2096 <                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 :=
2103 <                TimeStampToDateTime(ts);
2721 >              Param.AsTime := TimeStampToDateTime(ts);
2722              end;
2723              SQL_TIMESTAMP:
2724 <              Qry.Params[i].AsDateTime :=
2724 >              Param.AsDateTime :=
2725                         TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2726 +            SQL_BOOLEAN:
2727 +              Param.AsBoolean := PWordBool(data)^;
2728            end;
2729          end;
2730        end;
# Line 2190 | 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 2225 | 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 2241 | Line 2880 | begin
2880    Result := Assigned( FQSelect ) and FQSelect.EOF;
2881   end;
2882  
2883 < function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2883 > function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
2884   begin
2885    ActivateConnection;
2886    ActivateTransaction;
# Line 2378 | 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 2397 | 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 2419 | 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 2454 | Line 3161 | begin
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;
3172   var
3173    Buff: PRecordData;
# Line 2468 | Line 3182 | begin
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
# Line 2480 | Line 3200 | 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;
# Line 2490 | Line 3239 | begin
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
2495  SetCursor: Boolean;
2496  {$IF FPC_FULLVERSION > 20600 }
3251    CurBookmark: TBookmark;
3252 <  {$ELSE}
3253 <  CurBookmark: string;
3254 <  {$ENDIF}
2501 < begin
2502 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2503 <  if SetCursor then
2504 <    Screen.Cursor := crHourGlass;
2505 <  try
3252 > begin
3253 >  FBase.SetCursor;
3254 > try
3255      if FQSelect.EOF or not FQSelect.Open then
3256        exit;
3257      DisableControls;
# Line 2514 | Line 3263 | begin
3263        EnableControls;
3264      end;
3265    finally
3266 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2518 <      Screen.Cursor := crDefault;
3266 >    FBase.RestoreCursor;
3267    end;
3268   end;
3269  
# Line 2563 | 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 2593 | 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
2601      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 <          if fdDataLength <= Field.Size then
3374 >          if fdDataLength < Field.DataSize then
3375            begin
3376              Move(Data^, Buffer^, fdDataLength);
3377              PChar(Buffer)[fdDataLength] := #0;
# Line 2652 | 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 2671 | Line 3439 | begin
3439          if FCurrentRecord < FRecordCount then
3440            ReadRecordCache(FCurrentRecord, Buffer, False)
3441          else begin
3442 <          while (not FQSelect.EOF) and
2675 <                (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 2746 | 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 2773 | Line 3550 | procedure TIBCustomDataSet.InternalCance
3550   var
3551    Buff: PChar;
3552    CurRec: Integer;
3553 +  pda: PArrayDataArray;
3554 +  i: integer;
3555   begin
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 2799 | Line 3582 | begin
3582      DeactivateTransaction;
3583    FQSelect.Close;
3584    ClearBlobCache;
3585 +  ClearArrayCache;
3586    FreeRecordBuffer(FModelBuffer);
3587    FreeRecordBuffer(FOldBuffer);
3588    FCurrentRecord := -1;
# Line 2814 | 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;
2826  SetCursor: Boolean;
3613   begin
3614 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2829 <  if SetCursor then
2830 <    Screen.Cursor := crHourGlass;
3614 >  FBase.SetCursor;
3615    try
3616      Buff := GetActiveBuf;
3617      if CanDelete then
# Line 2852 | Line 3636 | begin
3636      end else
3637        IBError(ibxeCannotDelete, [nil]);
3638    finally
3639 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2856 <      Screen.Cursor := crDefault;
3639 >    FBase.RestoreCursor;
3640    end;
3641   end;
3642  
# Line 2869 | 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 2884 | 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 2986 | Line 3787 | var
3787    end;
3788  
3789   begin
2989  if not InternalPrepared then
2990  begin
2991    InternalPrepare;
2992    exit;
2993  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 3001 | 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 3028 | 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              if Database.SQLDialect = 1 then
# Line 3056 | Line 3867 | begin
3867              begin
3868                FieldType := ftFMTBCD;
3869                FieldPrecision := 9;
3870 <              FieldSize := -sqlscale;
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
3885 >              FieldType := ftFloat;
3886            end;
3887            SQL_TIMESTAMP: FieldType := ftDateTime;
3888            SQL_TYPE_TIME: FieldType := ftTime;
# Line 3079 | Line 3890 | begin
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 3097 | 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 := FieldAliasName;
3928 < (*           FieldNo := FieldPosition;*)
3104 <            DataType := FieldType;
3928 >            FAliasNameMap[FieldNo-1] := DBAliasName;
3929              Size := FieldSize;
3930 +            DataSize := FieldDataSize;
3931              Precision := FieldPrecision;
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 3133 | Line 3964 | begin
3964      FreeNodes;
3965      Database.InternalTransaction.Commit;
3966      FieldDefs.EndUpdate;
3967 +    FieldDefs.Updated := true;
3968    end;
3969   end;
3970  
# Line 3150 | 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 3165 | 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 3173 | 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 3185 | 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 3207 | 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 3238 | Line 4074 | begin
4074   end;
4075  
4076   procedure TIBCustomDataSet.InternalOpen;
3241 var
3242  SetCursor: Boolean;
4077  
4078    function RecordDataLength(n: Integer): Long;
4079    begin
# Line 3247 | Line 4081 | var
4081    end;
4082  
4083   begin
4084 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3251 <  if SetCursor then
3252 <    Screen.Cursor := crHourGlass;
4084 >  FBase.SetCursor;
4085    try
4086      ActivateConnection;
4087      ActivateTransaction;
# Line 3257 | 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 3272 | 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 3302 | 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 3310 | Line 4145 | begin
4145      else
4146        FQSelect.ExecQuery;
4147    finally
4148 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3314 <      Screen.Cursor := crDefault;
4148 >    FBase.RestoreCursor;
4149    end;
4150   end;
4151  
# Line 3319 | Line 4153 | procedure TIBCustomDataSet.InternalPost;
4153   var
4154    Qry: TIBSQL;
4155    Buff: PChar;
3322  SetCursor: Boolean;
4156    bInserting: Boolean;
4157   begin
4158 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3326 <  if SetCursor then
3327 <    Screen.Cursor := crHourGlass;
4158 >  FBase.SetCursor;
4159    try
4160      Buff := GetActiveBuf;
4161      CheckEditState;
# Line 3362 | Line 4193 | begin
4193      if bInserting then
4194        Inc(FRecordCount);
4195    finally
4196 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3366 <      Screen.Cursor := crDefault;
4196 >    FBase.RestoreCursor;
4197    end;
4198   end;
4199  
# Line 3383 | 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
3389  {$IF FPC_FULLVERSION > 20600 }
4238    CurBookmark: TBookmark;
3391  {$ELSE}
3392  CurBookmark: string;
3393  {$ENDIF}
4239   begin
4240    DisableControls;
4241    try
# Line 3408 | Line 4253 | function TIBCustomDataSet.Lookup(const K
4253                                   const ResultFields: string): Variant;
4254   var
4255    fl: TList;
3411  {$IF FPC_FULLVERSION > 20600 }
4256    CurBookmark: TBookmark;
3413  {$ELSE}
3414  CurBookmark: string;
3415  {$ENDIF}
4257   begin
4258    DisableControls;
4259    fl := TList.Create;
# Line 3465 | 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 3481 | 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));
3497 <          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 3582 | 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;
3599  SetCursor: Boolean;
4453   begin
4454    DidActivate := False;
4455 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3603 <  if SetCursor then
3604 <    Screen.Cursor := crHourGlass;
4455 >  FBase.SetCursor;
4456    try
4457      ActivateConnection;
4458      DidActivate := ActivateTransaction;
# Line 3609 | 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 3618 | 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 3646 | Line 4530 | end;
4530  
4531   { TIBDataSet IProviderSupport }
4532  
4533 < (*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4533 > procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4534   begin
4535    if Commit then
4536      Transaction.Commit else
# Line 3799 | 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 3809 | Line 4693 | begin
4693    if not FQSelect.Prepared then
4694      FQSelect.Prepare;
4695    Result := FQSelect.UniqueRelationName;
4696 < end;*)
4696 > end;
4697  
4698   procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4699   begin
# Line 3940 | Line 4824 | begin
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(Query: TIBSQL; buff: PChar);
4832 > procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
4833 >  buff: PChar);
4834   begin
4835    if not Assigned(DataSet) then Exit;
4836 <  DataSet.SetInternalSQLParams(Query, buff);
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 }
# Line 3959 | 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 3984 | Line 4891 | begin
4891    TIBCustomDataSet(FField.DataSet).RecordModified(True);
4892    TBlobField(FField).Modified := true;
4893    result := FBlobStream.Write(Buffer, Count);
4894 <  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(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 }
# Line 4031 | Line 4941 | end;
4941  
4942   procedure TIBGenerator.Apply;
4943   begin
4944 <  if (FGeneratorName <> '') and (FFieldName <> '')  then
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