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 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 66 by tony, Wed Aug 23 08:23:42 2017 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines