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 43 by tony, Thu Sep 22 17:10:15 2016 UTC vs.
Revision 80 by tony, Mon Jan 1 11:31:07 2018 UTC

# Line 33 | Line 33
33  
34   unit IBCustomDataSet;
35  
36 {$IF FPC_FULLVERSION >= 20700 }
37 {$codepage UTF8}
38 {$DEFINE HAS_ANSISTRING_CODEPAGE}
39 {$DEFINE NEW_TBOOKMARK}
40 {$ENDIF}
41
36   {$R-}
37  
38 + {$IFDEF FPC}
39   {$Mode Delphi}
40 + {$codepage UTF8}
41 + {$ENDIF}
42  
43   {$IFDEF DELPHI}
44   {$DEFINE TDBDFIELD_IS_BCD}
# Line 55 | Line 52 | uses
52   {$ELSE}
53    unix,
54   {$ENDIF}
55 <  SysUtils, Classes, IBDatabase, IBExternals, IB, IBHeader,  IBSQL, Db,
55 >  SysUtils, Classes, IBDatabase, IBExternals, IB,  IBSQL, Db,
56    IBUtils, IBBlob, IBSQLParser;
57  
58   const
# Line 77 | Line 74 | type
74      procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
75      procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract;
76      function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
77 <    procedure InternalSetParams(Query: TIBSQL; buff: PChar);
77 >    procedure InternalSetParams(Params: ISQLParams; buff: PChar); overload;
78 >    procedure InternalSetParams(Query: TIBSQL; buff: PChar); overload;
79      property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
80    public
81      constructor Create(AOwner: TComponent); override;
# Line 88 | Line 86 | type
86  
87    TBlobDataArray = array[0..0] of TIBBlobStream;
88    PBlobDataArray = ^TBlobDataArray;
89 +  TIBArrayField = class;
90  
91 <  { TIBCustomDataSet }
92 <  TFieldData = record
93 <    fdDataType: Short;
94 <    fdDataScale: Short;
95 <    fdNullable: Boolean;
96 <    fdIsNull: Boolean;
97 <    fdDataSize: Short;
98 <    fdDataLength: Short;
99 <    fdDataOfs: Integer;
100 <    {$IFDEF HAS_ANSISTRING_CODEPAGE}
101 <    fdCodePage: TSystemCodePage;
102 <    {$ENDIF}
91 >  { TIBArray }
92 >
93 >  {Wrapper class to support array cache in TIBCustomDataset and event handling}
94 >
95 >  TIBArray = class
96 >  private
97 >    FArray: IArray;
98 >    FRecNo: integer;
99 >    FField: TIBArrayField;
100 >    procedure EventHandler(Sender: IArray; Reason: TArrayEventReason);
101 >  public
102 >    constructor Create(aField: TIBArrayField; anArray: IArray);
103 >    destructor Destroy; override;
104 >    property ArrayIntf: IArray read FArray;
105    end;
106 <  PFieldData = ^TFieldData;
106 >
107 >  TArrayDataArray = array [0..0] of TIBArray;
108 >  PArrayDataArray = ^TArrayDataArray;
109 >
110 >  { TIBCustomDataSet }
111  
112    TCachedUpdateStatus = (
113                           cusUnmodified, cusModified, cusInserted,
# Line 113 | Line 118 | type
118    end;
119    PIBDBKey = ^TIBDBKey;
120  
121 +  PFieldData = ^TFieldData;
122 +  TFieldData = record
123 +   fdIsNull: Boolean;
124 +   fdDataLength: Short;
125 + end;
126 +
127 + PColumnData = ^TColumnData;
128 + TColumnData = record
129 +  fdDataType: Short;
130 +  fdDataScale: Short;
131 +  fdNullable: Boolean;
132 +  fdDataSize: Short;
133 +  fdDataOfs: Integer;
134 +  fdCodePage: TSystemCodePage;
135 + end;
136 +
137 + PFieldColumns = ^TFieldColumns;
138 + TFieldColumns =  array[1..1] of TColumnData;
139 +
140    TRecordData = record
141      rdBookmarkFlag: TBookmarkFlag;
142      rdFieldCount: Short;
# Line 125 | Line 149 | type
149    end;
150    PRecordData = ^TRecordData;
151  
152 +  { TIBArrayField }
153 +
154 +  TIBArrayField = class(TField)
155 +  private
156 +    FArrayBounds: TArrayBounds;
157 +    FArrayDimensions: integer;
158 +    FRelationName: string;
159 +    FCacheOffset: word;
160 +    function GetArrayID: TISC_QUAD;
161 +    function GetArrayIntf: IArray;
162 +    procedure SetArrayIntf(AValue: IArray);
163 +  protected
164 +    class procedure CheckTypeSize(AValue: Longint); override;
165 +    function GetAsString: string; override;
166 +    function GetDataSize: Integer; override;
167 +    procedure Bind(Binding: Boolean); override;
168 +  public
169 +    constructor Create(AOwner: TComponent); override;
170 +    function CreateArray: IArray;
171 +    property ArrayID: TISC_QUAD read GetArrayID;
172 +    property ArrayIntf: IArray read GetArrayIntf write SetArrayIntf;
173 +    property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
174 +    property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
175 +  end;
176 +
177    { TIBStringField allows us to have strings longer than 8196 }
178  
179    TIBStringField = class(TStringField)
180    private
181      FCharacterSetName: RawByteString;
182      FCharacterSetSize: integer;
183 +    FAutoFieldSize: boolean;
184 +    FCodePage: TSystemCodePage;
185 +    FDataSize: integer;
186    protected
187 <    function GetDefaultWidth: Longint; override;
187 >    procedure Bind(Binding: Boolean); override;
188 >    function GetDataSize: Integer; override;
189    public
190      constructor Create(aOwner: TComponent); override;
191      class procedure CheckTypeSize(Value: Integer); override;
# Line 142 | Line 195 | type
195      procedure SetAsString(const Value: string); override;
196      property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
197      property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
198 <    {$IFDEF HAS_ANSISTRING_CODEPAGE}
199 <    private
200 <      FCodePage: TSystemCodePage;
148 <    public
149 <      property CodePage: TSystemCodePage read FCodePage write FCodePage;
150 <    {$ENDIF}
198 >    property CodePage: TSystemCodePage read FCodePage write FCodePage;
199 >  published
200 >    property AutoFieldSize: boolean read FAutoFieldSize write FAutoFieldSize default true;
201    end;
202  
203    { TIBBCDField }
# Line 181 | Line 231 | type
231       FDisplayTextAsClassName: boolean;
232       function GetTruncatedText: string;
233     protected
234 +     procedure Bind(Binding: Boolean); override;
235       function GetAsString: string; override;
236       function GetDefaultWidth: Longint; override;
237       procedure GetText(var AText: string; ADisplayText: Boolean); override;
# Line 192 | Line 243 | type
243     published
244       property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
245                                              write FDisplayTextAsClassName;
195   {$IFDEF HAS_ANSISTRING_CODEPAGE}
246     private
247       FCodePage: TSystemCodePage;
248       FFCodePage: TSystemCodePage;
249     public
250       property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
201   {$ENDIF}
251     end;
252  
253    TIBDataLink = class(TDetailDataLink)
# Line 256 | Line 305 | type
305    TIBAutoCommit = (acDisabled, acCommitRetaining);
306  
307    { TIBCustomDataSet }
308 +
309    TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
310  
311    TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
# Line 272 | Line 322 | type
322  
323    TIBCustomDataSet = class(TDataset)
324    private
325 +    FAllowAutoActivateTransaction: Boolean;
326 +    FArrayFieldCount: integer;
327 +    FArrayCacheOffset: integer;
328      FAutoCommit: TIBAutoCommit;
329      FGenerateParamNames: Boolean;
330      FGeneratorField: TIBGenerator;
331      FNeedsRefresh: Boolean;
332      FForcedRefresh: Boolean;
333      FDidActivate: Boolean;
281    FIBLoaded: Boolean;
334      FBase: TIBBase;
335      FBlobCacheOffset: Integer;
336      FBlobStreamList: TList;
337 +    FArrayList: TList;
338      FBufferChunks: Integer;
339      FBufferCache,
340      FOldBufferCache: PChar;
# Line 335 | Line 388 | type
388      FCloseAction: TTransactionAction;
389      FInTransactionEnd: boolean;
390      FIBLinks: TList;
391 <    function GetSelectStmtHandle: TISC_STMT_HANDLE;
391 >    FFieldColumns: PFieldColumns;
392 >    procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
393 >    function GetSelectStmtIntf: IStatement;
394      procedure SetUpdateMode(const Value: TUpdateMode);
395      procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
396  
# Line 347 | Line 402 | type
402      function CanRefresh: Boolean;
403      procedure CheckEditState;
404      procedure ClearBlobCache;
405 +    procedure ClearArrayCache;
406      procedure ClearIBLinks;
407      procedure CopyRecordBuffer(Source, Dest: Pointer);
408      procedure DoBeforeDatabaseDisconnect(Sender: TObject);
# Line 358 | Line 414 | type
414      procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
415                                           Buffer: PChar);
416      function GetDatabase: TIBDatabase;
361    function GetDBHandle: PISC_DB_HANDLE;
417      function GetDeleteSQL: TStrings;
418      function GetInsertSQL: TStrings;
419 <    function GetSQLParams: TIBXSQLDA;
419 >    function GetSQLParams: ISQLParams;
420      function GetRefreshSQL: TStrings;
421      function GetSelectSQL: TStrings;
422 <    function GetStatementType: TIBSQLTypes;
422 >    function GetStatementType: TIBSQLStatementTypes;
423      function GetModifySQL: TStrings;
424      function GetTransaction: TIBTransaction;
370    function GetTRHandle: PISC_TR_HANDLE;
425      function GetParser: TSelectSQLParser;
426      procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
427      function InternalLocate(const KeyFields: string; const KeyValues: Variant;
# Line 382 | Line 436 | type
436      procedure SetDatabase(Value: TIBDatabase);
437      procedure SetDeleteSQL(Value: TStrings);
438      procedure SetInsertSQL(Value: TStrings);
439 <    procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
439 >    procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
440      procedure SetRefreshSQL(Value: TStrings);
441      procedure SetSelectSQL(Value: TStrings);
442      procedure SetModifySQL(Value: TStrings);
# Line 422 | Line 476 | type
476      procedure SQLChanging(Sender: TObject); virtual;
477      procedure SQLChanged(Sender: TObject); virtual;
478  
479 < (*    { IProviderSupport }
479 >    { IProviderSupport }
480      procedure PSEndTransaction(Commit: Boolean); override;
481      function PSExecuteStatement(const ASQL: string; AParams: TParams;
482        ResultSet: Pointer = nil): Integer; override;
# Line 435 | Line 489 | type
489      procedure PSStartTransaction; override;
490      procedure PSReset; override;
491      function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
492 < *)
492 >
493      { TDataSet support }
494      procedure InternalInsert; override;
495      procedure InitRecord(Buffer: PChar); override;
# Line 499 | Line 553 | type
553    protected
554      {Likely to be made public by descendant classes}
555      property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
556 <    property SQLParams: TIBXSQLDA read GetSQLParams;
557 <    property Params: TIBXSQLDA read GetSQLParams;
556 >    property SQLParams: ISQLParams read GetSQLParams;
557 >    property Params: ISQLParams read GetSQLParams;
558      property InternalPrepared: Boolean read FInternalPrepared;
559      property QDelete: TIBSQL read FQDelete;
560      property QInsert: TIBSQL read FQInsert;
561      property QRefresh: TIBSQL read FQRefresh;
562      property QSelect: TIBSQL read FQSelect;
563      property QModify: TIBSQL read FQModify;
564 <    property StatementType: TIBSQLTypes read GetStatementType;
565 <    property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
564 >    property StatementType: TIBSQLStatementTypes read GetStatementType;
565 >    property SelectStmtHandle: IStatement read GetSelectStmtIntf;
566  
567      {Likely to be made published by descendant classes}
568      property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
# Line 559 | Line 613 | type
613      function BookmarkValid(Bookmark: TBookmark): Boolean; override;
614      function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
615      function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
616 +    function GetArray(Field: TIBArrayField): IArray;
617 +    procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
618      function GetCurrentRecord(Buffer: PChar): Boolean; override;
619      function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
620      function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
# Line 572 | Line 628 | type
628      function UpdateStatus: TUpdateStatus; override;
629      function IsSequenced: Boolean; override;
630      procedure Post; override;
631 <    function ParamByName(ParamName: String): TIBXSQLVAR;
632 <    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
577 <    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
631 >    function ParamByName(ParamName: String): ISQLParam;
632 >    property ArrayFieldCount: integer read FArrayFieldCount;
633      property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
634      property UpdatesPending: Boolean read FUpdatesPending;
635      property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
# Line 583 | Line 638 | type
638                 read FDataSetCloseAction write FDataSetCloseAction;
639  
640    published
641 +    property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
642 +                 write FAllowAutoActivateTransaction;
643      property Database: TIBDatabase read GetDatabase write SetDatabase;
644      property Transaction: TIBTransaction read GetTransaction
645                                            write SetTransaction;
# Line 723 | Line 780 | type
780      function Write(const Buffer; Count: Longint): Longint; override;
781    end;
782  
783 +  {Extended Field Def for character set info}
784 +
785 +  { TIBFieldDef }
786 +
787 +  TIBFieldDef = class(TFieldDef)
788 +  private
789 +    FArrayBounds: TArrayBounds;
790 +    FArrayDimensions: integer;
791 +    FCharacterSetName: RawByteString;
792 +    FCharacterSetSize: integer;
793 +    FCodePage: TSystemCodePage;
794 +    FRelationName: string;
795 +    FDataSize: integer;
796 +  published
797 +    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
798 +    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
799 +    property CodePage: TSystemCodePage read FCodePage write FCodePage;
800 +    property DataSize: integer read FDataSize write FDataSize;
801 +    property RelationName: string read FRelationName write FRelationName;
802 +    property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
803 +    property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
804 +  end;
805 +
806   const
807   DefaultFieldClasses: array[TFieldType] of TFieldClass = (
808      nil,                { ftUnknown }
# Line 752 | Line 832 | DefaultFieldClasses: array[TFieldType] o
832      nil,    { ftWideString }
833      TLargeIntField,     { ftLargeInt }
834      nil,          { ftADT }
835 <    nil,        { ftArray }
835 >    TIBArrayField,        { ftArray }
836      nil,    { ftReference }
837      nil,     { ftDataSet }
838      TBlobField,         { ftOraBlob }
# Line 781 | Line 861 | DefaultFieldClasses: array[TFieldType] o
861  
862   implementation
863  
864 < uses IBIntf, Variants, FmtBCD, LazUTF8, IBCodePage;
864 > uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
865  
866   const FILE_BEGIN = 0;
867        FILE_CURRENT = 1;
# Line 804 | Line 884 | type
884      NextRelation : TRelationNode;
885    end;
886  
807  {Extended Field Def for character set info}
808
809  { TIBFieldDef }
810
811  TIBFieldDef = class(TFieldDef)
812  private
813    FCharacterSetName: RawByteString;
814    FCharacterSetSize: integer;
815    {$IFDEF HAS_ANSISTRING_CODEPAGE}
816    FCodePage: TSystemCodePage;
817    {$ENDIF}
818  published
819    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
820    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
821    {$IFDEF HAS_ANSISTRING_CODEPAGE}
822    property CodePage: TSystemCodePage read FCodePage write FCodePage;
823    {$ENDIF}
824  end;
825
887  
888    {  Copied from LCLProc in order to avoid LCL dependency
889  
# Line 865 | Line 926 | type
926      Result := str;
927    end;
928  
929 + { TIBArray }
930 +
931 + procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
932 + begin
933 +  case Reason of
934 +  arChanging:
935 +    if FRecNo <> FField.Dataset.RecNo then
936 +      IBError(ibxeNotCurrentArray,[nil]);
937 +
938 +  arChanged:
939 +    FField.DataChanged;
940 +  end;
941 + end;
942 +
943 + constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
944 + begin
945 +  inherited Create;
946 +  FField := aField;
947 +  FArray := anArray;
948 +  FRecNo := FField.Dataset.RecNo;
949 +  FArray.AddEventHandler(EventHandler);
950 + end;
951 +
952 + destructor TIBArray.Destroy;
953 + begin
954 +  FArray.RemoveEventHandler(EventHandler);
955 +  inherited Destroy;
956 + end;
957 +
958 + { TIBArrayField }
959 +
960 + function TIBArrayField.GetArrayIntf: IArray;
961 + begin
962 +  Result := TIBCustomDataSet(DataSet).GetArray(self);
963 + end;
964 +
965 + function TIBArrayField.GetArrayID: TISC_QUAD;
966 + begin
967 +  GetData(@Result);
968 + end;
969 +
970 + procedure TIBArrayField.SetArrayIntf(AValue: IArray);
971 + begin
972 +  TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
973 +  DataChanged;
974 + end;
975 +
976 + class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
977 + begin
978 +  //Ignore
979 + end;
980 +
981 + function TIBArrayField.GetAsString: string;
982 + begin
983 +  Result := '(Array)';
984 + end;
985 +
986 + function TIBArrayField.GetDataSize: Integer;
987 + begin
988 +  Result := sizeof(TISC_QUAD);
989 + end;
990 +
991 + procedure TIBArrayField.Bind(Binding: Boolean);
992 + begin
993 +  inherited Bind(Binding);
994 +  if Binding then
995 +  begin
996 +    FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
997 +    Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
998 +    if FieldDef <> nil then
999 +    begin
1000 +      FRelationName := TIBFieldDef(FieldDef).FRelationName;
1001 +      FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
1002 +      FArrayBounds :=  TIBFieldDef(FieldDef).ArrayBounds;
1003 +    end;
1004 +  end;
1005 + end;
1006 +
1007 + constructor TIBArrayField.Create(AOwner: TComponent);
1008 + begin
1009 +  inherited Create(AOwner);
1010 +  SetDataType(ftArray);
1011 + end;
1012 +
1013 + function TIBArrayField.CreateArray: IArray;
1014 + begin
1015 + with DataSet as TIBCustomDataSet do
1016 +  Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1017 + end;
1018 +
1019   { TIBMemoField }
1020  
1021   function TIBMemoField.GetTruncatedText: string;
# Line 894 | Line 1045 | begin
1045     end
1046   end;
1047  
1048 + procedure TIBMemoField.Bind(Binding: Boolean);
1049 + var IBFieldDef: TIBFieldDef;
1050 + begin
1051 +  inherited Bind(Binding);
1052 +  if Binding and (FieldDef <> nil) then
1053 +  begin
1054 +    IBFieldDef := FieldDef as TIBFieldDef;
1055 +    CharacterSetSize := IBFieldDef.CharacterSetSize;
1056 +    CharacterSetName := IBFieldDef.CharacterSetName;
1057 +    CodePage := IBFieldDef.CodePage;
1058 +  end;
1059 + end;
1060 +
1061   function TIBMemoField.GetAsString: string;
1062   var s: RawByteString;
1063   begin
1064    s := inherited GetAsString;
901  {$IFDEF HAS_ANSISTRING_CODEPAGE}
1065    SetCodePage(s,CodePage,false);
1066    if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1067      SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
905  {$ENDIF}
1068    Result := s;
1069   end;
1070  
# Line 931 | Line 1093 | procedure TIBMemoField.SetAsString(const
1093   var s: RawByteString;
1094   begin
1095    s := AValue;
1096 <  {$IFDEF HAS_ANSISTRING_CODEPAGE}
935 <  if StringCodePage(Value) <> CodePage then
1096 >  if StringCodePage(s) <> CodePage then
1097      SetCodePage(s,CodePage,CodePage<>CP_NONE);
937  {$ENDIF}
1098    inherited SetAsString(s);
1099   end;
1100  
# Line 942 | Line 1102 | constructor TIBMemoField.Create(AOwner:
1102   begin
1103    inherited Create(AOwner);
1104    BlobType := ftMemo;
945  {$IFDEF HAS_ANSISTRING_CODEPAGE}
1105    FCodePage := CP_NONE;
947  {$ENDIF}
1106   end;
1107  
1108   { TIBControlLink }
# Line 978 | Line 1136 | end;
1136  
1137   { TIBStringField}
1138  
1139 < function TIBStringField.GetDefaultWidth: Longint;
1139 > procedure TIBStringField.Bind(Binding: Boolean);
1140 > var IBFieldDef: TIBFieldDef;
1141   begin
1142 <  Result := Size div CharacterSetSize;
1142 >  inherited Bind(Binding);
1143 >  if Binding and (FieldDef <> nil) then
1144 >  begin
1145 >    IBFieldDef := FieldDef as TIBFieldDef;
1146 >    CharacterSetSize := IBFieldDef.CharacterSetSize;
1147 >    CharacterSetName := IBFieldDef.CharacterSetName;
1148 >    FDataSize := IBFieldDef.DataSize + 1;
1149 >    if AutoFieldSize then
1150 >      Size := IBFieldDef.Size;
1151 >    CodePage := IBFieldDef.CodePage;
1152 >  end;
1153 > end;
1154 >
1155 > function TIBStringField.GetDataSize: Integer;
1156 > begin
1157 >  Result := FDataSize;
1158   end;
1159  
1160   constructor TIBStringField.Create(aOwner: TComponent);
1161   begin
1162    inherited Create(aOwner);
1163    FCharacterSetSize := 1;
990  {$IFDEF HAS_ANSISTRING_CODEPAGE}
1164    FCodePage := CP_NONE;
1165 <  {$ENDIF}
1165 >  FAutoFieldSize := true;
1166   end;
1167  
1168   class procedure TIBStringField.CheckTypeSize(Value: Integer);
# Line 1013 | Line 1186 | function TIBStringField.GetValue(var Val
1186   var
1187    Buffer: PChar;
1188    s: RawByteString;
1016 //  i: integer;
1189   begin
1190    Buffer := nil;
1191 <  IBAlloc(Buffer, 0, Size + 1);
1191 >  IBAlloc(Buffer, 0, DataSize);
1192    try
1193      Result := GetData(Buffer);
1194      if Result then
1195      begin
1196 <      {$IFDEF HAS_ANSISTRING_CODEPAGE}
1025 <      s := string(Buffer);
1196 >      s := strpas(Buffer);
1197        SetCodePage(s,CodePage,false);
1198        if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1199          SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1200        Value := s;
1201 < (*      write(FieldName,': ', StringCodePage(Value),', ',Value,' ');
1031 <      for i := 1 to Length(Value) do
1032 <        write(Format('%x ',[byte(Value[i])]));
1033 <      writeln;*)
1034 <      {$ELSE}
1035 <      Value := string(Buffer);
1036 <      {$ENDIF}
1201 > //      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1202        if Transliterate and (Value <> '') then
1203          DataSet.Translate(PChar(Value), PChar(Value), False);
1204      end
# Line 1048 | Line 1213 | var
1213    s: RawByteString;
1214   begin
1215    Buffer := nil;
1216 <  IBAlloc(Buffer, 0, Size + 1);
1216 >  IBAlloc(Buffer, 0, DataSize);
1217    try
1218      s := Value;
1054    {$IFDEF HAS_ANSISTRING_CODEPAGE}
1219      if StringCodePage(s) <> CodePage then
1220        SetCodePage(s,CodePage,CodePage<>CP_NONE);
1221 <    {$ENDIF}
1058 <    StrLCopy(Buffer, PChar(s), Size);
1221 >    StrLCopy(Buffer, PChar(s), DataSize-1);
1222      if Transliterate then
1223        DataSet.Translate(Buffer, Buffer, True);
1224      SetData(Buffer);
# Line 1158 | Line 1321 | end;
1321   constructor TIBCustomDataSet.Create(AOwner: TComponent);
1322   begin
1323    inherited Create(AOwner);
1161  FIBLoaded := False;
1162  CheckIBLoaded;
1163  FIBLoaded := True;
1324    FBase := TIBBase.Create(Self);
1325    FIBLinks := TList.Create;
1326    FCurrentRecord := -1;
# Line 1168 | Line 1328 | begin
1328    FUniDirectional := False;
1329    FBufferChunks := BufferCacheSize;
1330    FBlobStreamList := TList.Create;
1331 +  FArrayList := TList.Create;
1332    FGeneratorField := TIBGenerator.Create(self);
1333    FDataLink := TIBDataLink.Create(Self);
1334    FQDelete := TIBSQL.Create(Self);
# Line 1211 | Line 1372 | end;
1372   destructor TIBCustomDataSet.Destroy;
1373   begin
1374    if Active then Active := false;
1375 <  if FIBLoaded then
1376 <  begin
1377 <    if assigned(FGeneratorField) then FGeneratorField.Free;
1378 <    FDataLink.Free;
1379 <    FBase.Free;
1380 <    ClearBlobCache;
1381 <    ClearIBLinks;
1382 <    FIBLinks.Free;
1383 <    FBlobStreamList.Free;
1384 <    FreeMem(FBufferCache);
1385 <    FBufferCache := nil;
1386 <    FreeMem(FOldBufferCache);
1387 <    FOldBufferCache := nil;
1388 <    FCacheSize := 0;
1389 <    FOldCacheSize := 0;
1229 <    FMappedFieldPosition := nil;
1230 <  end;
1375 >  if assigned(FGeneratorField) then FGeneratorField.Free;
1376 >  FDataLink.Free;
1377 >  FBase.Free;
1378 >  ClearBlobCache;
1379 >  ClearIBLinks;
1380 >  FIBLinks.Free;
1381 >  FBlobStreamList.Free;
1382 >  FArrayList.Free;
1383 >  FreeMem(FBufferCache);
1384 >  FBufferCache := nil;
1385 >  FreeMem(FOldBufferCache);
1386 >  FOldBufferCache := nil;
1387 >  FCacheSize := 0;
1388 >  FOldCacheSize := 0;
1389 >  FMappedFieldPosition := nil;
1390    if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1391    if assigned(FParser) then FParser.Free;
1392    inherited Destroy;
# Line 1252 | Line 1411 | begin
1411        Inc(FCurrentRecord);
1412        if (FCurrentRecord = FRecordCount) then
1413        begin
1414 <        if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1414 >        if (not FQSelect.EOF) and FQSelect.Next  then
1415          begin
1416            FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1417            Inc(FRecordCount);
# Line 1271 | Line 1430 | end;
1430  
1431   procedure TIBCustomDataSet.ApplyUpdates;
1432   var
1274  {$IFDEF NEW_TBOOKMARK }
1433    CurBookmark: TBookmark;
1276  {$ELSE}
1277  CurBookmark: string;
1278  {$ENDIF}
1434    Buffer: PRecordData;
1435    CurUpdateTypes: TIBUpdateRecordTypes;
1436    UpdateAction: TIBUpdateAction;
# Line 1506 | Line 1661 | end;
1661   function TIBCustomDataSet.ActivateTransaction: Boolean;
1662   begin
1663    Result := False;
1664 <  if not Assigned(Transaction) then
1510 <    IBError(ibxeTransactionNotAssigned, [nil]);
1511 <  if not Transaction.Active then
1664 >  if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1665    begin
1666 <    Result := True;
1667 <    Transaction.StartTransaction;
1668 <    FDidActivate := True;
1666 >    if not Assigned(Transaction) then
1667 >      IBError(ibxeTransactionNotAssigned, [nil]);
1668 >    if not Transaction.Active then
1669 >    begin
1670 >      Result := True;
1671 >      Transaction.StartTransaction;
1672 >      FDidActivate := True;
1673 >    end;
1674    end;
1675   end;
1676  
# Line 1637 | Line 1795 | begin
1795    FBlobStreamList.Pack;
1796   end;
1797  
1798 + procedure TIBCustomDataSet.ClearArrayCache;
1799 + var
1800 +  i: Integer;
1801 + begin
1802 +  for i := 0 to FArrayList.Count - 1 do
1803 +  begin
1804 +    TIBArray(FArrayList[i]).Free;
1805 +    FArrayList[i] := nil;
1806 +  end;
1807 +  FArrayList.Pack;
1808 + end;
1809 +
1810   procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1811   begin
1812    Move(Source^, Dest^, FRecordBufferSize);
# Line 1646 | Line 1816 | procedure TIBCustomDataSet.DoBeforeDatab
1816   begin
1817    if Active then
1818      Active := False;
1819 <  FInternalPrepared := False;
1819 >  InternalUnPrepare;
1820    if Assigned(FBeforeDatabaseDisconnect) then
1821      FBeforeDatabaseDisconnect(Sender);
1822   end;
# Line 1684 | Line 1854 | begin
1854      FQModify.FreeHandle;
1855    if FQRefresh <> nil then
1856      FQRefresh.FreeHandle;
1857 +  InternalUnPrepare;
1858    if Assigned(FBeforeTransactionEnd) then
1859      FBeforeTransactionEnd(Sender);
1860   end;
# Line 1700 | Line 1871 | begin
1871      FTransactionFree(Sender);
1872   end;
1873  
1874 + procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1875 + var i, j: Integer;
1876 +    FieldsLoaded: integer;
1877 +    p: PRecordData;
1878 +    colMetadata: IColumnMetaData;
1879 + begin
1880 +  p := PRecordData(Buffer);
1881 +  { Get record information }
1882 +  p^.rdBookmarkFlag := bfCurrent;
1883 +  p^.rdFieldCount := Qry.FieldCount;
1884 +  p^.rdRecordNumber := -1;
1885 +  p^.rdUpdateStatus := usUnmodified;
1886 +  p^.rdCachedUpdateStatus := cusUnmodified;
1887 +  p^.rdSavedOffset := $FFFFFFFF;
1888 +
1889 +  { Load up the fields }
1890 +  FieldsLoaded := FQSelect.MetaData.Count;
1891 +  j := 1;
1892 +  for i := 0 to Qry.MetaData.Count - 1 do
1893 +  begin
1894 +    if (Qry = FQSelect) then
1895 +      j := i + 1
1896 +    else
1897 +    begin
1898 +      if FieldsLoaded = 0 then
1899 +        break;
1900 +      j := FQSelect.FieldIndex[Qry[i].Name] + 1;
1901 +      if j < 1 then
1902 +        continue
1903 +      else
1904 +        Dec(FieldsLoaded);
1905 +    end;
1906 +    if j > 0 then
1907 +    begin
1908 +      colMetadata := Qry.MetaData[i];
1909 +      with p^.rdFields[j], FFieldColumns^[j] do
1910 +      begin
1911 +        fdDataType := colMetadata.GetSQLType;
1912 +        if fdDataType = SQL_BLOB then
1913 +          fdDataScale := 0
1914 +        else
1915 +          fdDataScale := colMetadata.getScale;
1916 +        fdNullable := colMetadata.getIsNullable;
1917 +        fdIsNull := true;
1918 +        fdDataSize := colMetadata.GetSize;
1919 +        fdDataLength := 0;
1920 +        fdCodePage := CP_NONE;
1921 +
1922 +        case fdDataType of
1923 +        SQL_TIMESTAMP,
1924 +        SQL_TYPE_DATE,
1925 +        SQL_TYPE_TIME:
1926 +          fdDataSize := SizeOf(TDateTime);
1927 +        SQL_SHORT, SQL_LONG:
1928 +        begin
1929 +          if (fdDataScale = 0) then
1930 +            fdDataSize := SizeOf(Integer)
1931 +          else
1932 +          if (fdDataScale >= (-4)) then
1933 +            fdDataSize := SizeOf(Currency)
1934 +          else
1935 +            fdDataSize := SizeOf(Double);
1936 +        end;
1937 +        SQL_INT64:
1938 +        begin
1939 +          if (fdDataScale = 0) then
1940 +            fdDataSize := SizeOf(Int64)
1941 +          else
1942 +          if (fdDataScale >= (-4)) then
1943 +            fdDataSize := SizeOf(Currency)
1944 +          else
1945 +            fdDataSize := SizeOf(Double);
1946 +        end;
1947 +        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1948 +          fdDataSize := SizeOf(Double);
1949 +        SQL_BOOLEAN:
1950 +          fdDataSize := SizeOf(wordBool);
1951 +        SQL_VARYING,
1952 +        SQL_TEXT,
1953 +        SQL_BLOB:
1954 +          fdCodePage := Qry.Metadata[i].getCodePage;
1955 +        end;
1956 +        fdDataOfs := FRecordSize;
1957 +        Inc(FRecordSize, fdDataSize);
1958 +      end;
1959 +    end;
1960 +  end;
1961 + end;
1962 +
1963   { Read the record from FQSelect.Current into the record buffer
1964    Then write the buffer to in memory cache }
1965   procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1966    RecordNumber: Integer; Buffer: PChar);
1967   var
1708  p: PRecordData;
1968    pbd: PBlobDataArray;
1969 +  pda: PArrayDataArray;
1970    i, j: Integer;
1971 <  LocalData: Pointer;
1971 >  LocalData: PByte;
1972    LocalDate, LocalDouble: Double;
1973    LocalInt: Integer;
1974    LocalBool: wordBool;
1975    LocalInt64: Int64;
1976    LocalCurrency: Currency;
1977    FieldsLoaded: Integer;
1978 +  p: PRecordData;
1979   begin
1980 +  if RecordNumber = -1 then
1981 +  begin
1982 +    InitModelBuffer(Qry,Buffer);
1983 +    Exit;
1984 +  end;
1985    p := PRecordData(Buffer);
1986    { Make sure blob cache is empty }
1987    pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1988 <  if RecordNumber > -1 then
1989 <    for i := 0 to BlobFieldCount - 1 do
1990 <      pbd^[i] := nil;
1988 >  pda := PArrayDataArray(Buffer + FArrayCacheOffset);
1989 >  for i := 0 to BlobFieldCount - 1 do
1990 >    pbd^[i] := nil;
1991 >  for i := 0 to ArrayFieldCount - 1 do
1992 >    pda^[i] := nil;
1993 >
1994    { Get record information }
1995    p^.rdBookmarkFlag := bfCurrent;
1996 <  p^.rdFieldCount := Qry.Current.Count;
1996 >  p^.rdFieldCount := Qry.FieldCount;
1997    p^.rdRecordNumber := RecordNumber;
1998    p^.rdUpdateStatus := usUnmodified;
1999    p^.rdCachedUpdateStatus := cusUnmodified;
2000    p^.rdSavedOffset := $FFFFFFFF;
2001  
2002    { Load up the fields }
2003 <  FieldsLoaded := FQSelect.Current.Count;
2003 >  FieldsLoaded := FQSelect.MetaData.Count;
2004    j := 1;
2005 <  for i := 0 to Qry.Current.Count - 1 do
2005 >  for i := 0 to Qry.FieldCount - 1 do
2006    begin
2007      if (Qry = FQSelect) then
2008        j := i + 1
2009 <    else begin
2009 >    else
2010 >    begin
2011        if FieldsLoaded = 0 then
2012          break;
2013 <      j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
2013 >      j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2014        if j < 1 then
2015          continue
2016        else
2017          Dec(FieldsLoaded);
2018      end;
2019 <    with FQSelect.Current[j - 1].Data^ do
2020 <      if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2019 >    with FQSelect.MetaData[j - 1] do
2020 >      if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2021        begin
2022 <        if sqllen <= 8 then
2023 <          p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
2022 >        if (GetSize <= 8) then
2023 >          p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2024          continue;
2025        end;
2026 <    if j > 0 then with p^ do
2026 >    if j > 0 then
2027      begin
2028 <      rdFields[j].fdDataType :=
2029 <        Qry.Current[i].Data^.sqltype and (not 1);
2030 <      rdFields[j].fdDataScale :=
2031 <        Qry.Current[i].Data^.sqlscale;
2032 <      rdFields[j].fdNullable :=
1763 <        (Qry.Current[i].Data^.sqltype and 1 = 1);
1764 <      rdFields[j].fdIsNull :=
1765 <        (rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1766 <      {$IFDEF HAS_ANSISTRING_CODEPAGE}
1767 <      rdFields[j].fdCodePage := 0;
1768 <      {$ENDIF}
1769 <      LocalData := Qry.Current[i].Data^.sqldata;
1770 <      case rdFields[j].fdDataType of
1771 <        SQL_TIMESTAMP:
1772 <        begin
1773 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1774 <          if RecordNumber >= 0 then
1775 <            LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
1776 <          LocalData := PChar(@LocalDate);
1777 <        end;
1778 <        SQL_TYPE_DATE:
1779 <        begin
1780 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1781 <          if RecordNumber >= 0 then
1782 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
1783 <          LocalData := PChar(@LocalInt);
1784 <        end;
1785 <        SQL_TYPE_TIME:
1786 <        begin
1787 <          rdFields[j].fdDataSize := SizeOf(TDateTime);
1788 <          if RecordNumber >= 0 then
1789 <            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1790 <          LocalData := PChar(@LocalInt);
1791 <        end;
1792 <        SQL_SHORT, SQL_LONG:
2028 >      LocalData := nil;
2029 >      with p^.rdFields[j], FFieldColumns^[j] do
2030 >      begin
2031 >        Qry.Current.GetData(i,fdIsNull,fdDataLength,LocalData);
2032 >        if not fdIsNull then
2033          begin
2034 <          if (rdFields[j].fdDataScale = 0) then
2035 <          begin
2036 <            rdFields[j].fdDataSize := SizeOf(Integer);
2037 <            if RecordNumber >= 0 then
2038 <              LocalInt := Qry.Current[i].AsLong;
2039 <            LocalData := PChar(@LocalInt);
2040 <          end
2041 <          else if (rdFields[j].fdDataScale >= (-4)) then
2042 <               begin
2043 <                 rdFields[j].fdDataSize := SizeOf(Currency);
2044 <                 if RecordNumber >= 0 then
2045 <                   LocalCurrency := Qry.Current[i].AsCurrency;
2046 <                 LocalData := PChar(@LocalCurrency);
2047 <               end
2048 <               else begin
2049 <                 rdFields[j].fdDataSize := SizeOf(Double);
2050 <                 if RecordNumber >= 0 then
2051 <                   LocalDouble := Qry.Current[i].AsDouble;
2052 <                LocalData := PChar(@LocalDouble);
2034 >          case fdDataType of  {Get Formatted data for column types that need formatting}
2035 >            SQL_TIMESTAMP:
2036 >            begin
2037 >              LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry[i].AsDateTime));
2038 >              LocalData := PByte(@LocalDate);
2039 >            end;
2040 >            SQL_TYPE_DATE:
2041 >            begin
2042 >              LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Date;
2043 >              LocalData := PByte(@LocalInt);
2044 >            end;
2045 >            SQL_TYPE_TIME:
2046 >            begin
2047 >              LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Time;
2048 >              LocalData := PByte(@LocalInt);
2049 >            end;
2050 >            SQL_SHORT, SQL_LONG:
2051 >            begin
2052 >              if (fdDataScale = 0) then
2053 >              begin
2054 >                LocalInt := Qry[i].AsLong;
2055 >                LocalData := PByte(@LocalInt);
2056 >              end
2057 >              else
2058 >              if (fdDataScale >= (-4)) then
2059 >              begin
2060 >                LocalCurrency := Qry[i].AsCurrency;
2061 >                LocalData := PByte(@LocalCurrency);
2062 >              end
2063 >              else
2064 >              begin
2065 >               LocalDouble := Qry[i].AsDouble;
2066 >               LocalData := PByte(@LocalDouble);
2067                end;
2068 <        end;
2069 <        SQL_INT64:
2070 <        begin
2071 <          if (rdFields[j].fdDataScale = 0) then
2072 <          begin
2073 <            rdFields[j].fdDataSize := SizeOf(Int64);
2074 <            if RecordNumber >= 0 then
2075 <              LocalInt64 := Qry.Current[i].AsInt64;
2076 <            LocalData := PChar(@LocalInt64);
2077 <          end
2078 <          else if (rdFields[j].fdDataScale >= (-4)) then
2079 <               begin
2080 <                 rdFields[j].fdDataSize := SizeOf(Currency);
2081 <                 if RecordNumber >= 0 then
2082 <                   LocalCurrency := Qry.Current[i].AsCurrency;
2083 <                   LocalData := PChar(@LocalCurrency);
2084 <               end
2085 <               else begin
2086 <                  rdFields[j].fdDataSize := SizeOf(Double);
2087 <                  if RecordNumber >= 0 then
2088 <                    LocalDouble := Qry.Current[i].AsDouble;
2089 <                  LocalData := PChar(@LocalDouble);
2090 <               end
2091 <        end;
2092 <        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2093 <        begin
2094 <          rdFields[j].fdDataSize := SizeOf(Double);
2095 <          if RecordNumber >= 0 then
2096 <            LocalDouble := Qry.Current[i].AsDouble;
2097 <          LocalData := PChar(@LocalDouble);
1844 <        end;
1845 <        SQL_VARYING:
1846 <        begin
1847 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1848 <          rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1849 <          {$IFDEF HAS_ANSISTRING_CODEPAGE}
1850 <          TFirebirdCharacterSets.CharSetID2CodePage(Qry.Current[i].Data^.sqlsubtype and $FF,
1851 <                                                    rdFields[j].fdCodePage);
1852 <          {$ENDIF}
1853 <          if RecordNumber >= 0 then
1854 <          begin
1855 <            if (rdFields[j].fdDataLength = 0) then
1856 <              LocalData := nil
1857 <            else
1858 <              Inc(LocalData,2);
2068 >            end;
2069 >            SQL_INT64:
2070 >            begin
2071 >              if (fdDataScale = 0) then
2072 >              begin
2073 >                LocalInt64 := Qry[i].AsInt64;
2074 >                LocalData := PByte(@LocalInt64);
2075 >              end
2076 >              else
2077 >              if (fdDataScale >= (-4)) then
2078 >              begin
2079 >                LocalCurrency := Qry[i].AsCurrency;
2080 >                LocalData := PByte(@LocalCurrency);
2081 >                end
2082 >                else
2083 >                begin
2084 >                  LocalDouble := Qry[i].AsDouble;
2085 >                  LocalData := PByte(@LocalDouble);
2086 >                end
2087 >            end;
2088 >            SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2089 >            begin
2090 >              LocalDouble := Qry[i].AsDouble;
2091 >              LocalData := PByte(@LocalDouble);
2092 >            end;
2093 >            SQL_BOOLEAN:
2094 >            begin
2095 >              LocalBool := Qry[i].AsBoolean;
2096 >              LocalData := PByte(@LocalBool);
2097 >            end;
2098            end;
2099 <        end;
2100 <        SQL_BOOLEAN:
2101 <        begin
2102 <          LocalBool:= false;
2103 <          rdFields[j].fdDataSize := SizeOf(wordBool);
1865 <          if RecordNumber >= 0 then
1866 <            LocalBool := Qry.Current[i].AsBoolean;
1867 <          LocalData := PChar(@LocalBool);
1868 <        end;
1869 <        SQL_TEXT:
1870 <        begin
1871 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1872 <          rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1873 <           {$IFDEF HAS_ANSISTRING_CODEPAGE}
1874 <          TFirebirdCharacterSets.CharSetID2CodePage(Qry.Current[i].Data^.sqlsubtype and $FF,
1875 <                                                    rdFields[j].fdCodePage);
1876 <          {$ENDIF}
1877 <       end;
1878 <        else {  SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1879 <        begin
1880 <          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1881 <        end;
1882 <      end;
1883 <      if RecordNumber < 0 then
1884 <      begin
1885 <        rdFields[j].fdIsNull := True;
1886 <        rdFields[j].fdDataOfs := FRecordSize;
1887 <        Inc(FRecordSize, rdFields[j].fdDataSize);
1888 <      end
1889 <      else begin
1890 <        if rdFields[j].fdDataType = SQL_VARYING then
1891 <        begin
1892 <          if LocalData <> nil then
1893 <            Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)
2099 >
2100 >          if fdDataType = SQL_VARYING then
2101 >            Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2102 >          else
2103 >            Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2104          end
2105 +        else {Null column}
2106 +        if fdDataType = SQL_VARYING then
2107 +          FillChar(Buffer[fdDataOfs],fdDataLength,0)
2108          else
2109 <          Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
2109 >          FillChar(Buffer[fdDataOfs],fdDataSize,0);
2110        end;
2111      end;
2112    end;
2113 <  WriteRecordCache(RecordNumber, PChar(p));
2113 >  WriteRecordCache(RecordNumber, Buffer);
2114   end;
2115  
2116   function TIBCustomDataSet.GetActiveBuf: PChar;
# Line 1942 | Line 2155 | begin
2155    result := FBase.Database;
2156   end;
2157  
1945 function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1946 begin
1947  result := FBase.DBHandle;
1948 end;
1949
2158   function TIBCustomDataSet.GetDeleteSQL: TStrings;
2159   begin
2160    result := FQDelete.SQL;
# Line 1957 | Line 2165 | begin
2165    result := FQInsert.SQL;
2166   end;
2167  
2168 < function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
2168 > function TIBCustomDataSet.GetSQLParams: ISQLParams;
2169   begin
2170    if not FInternalPrepared then
2171      InternalPrepare;
# Line 1974 | Line 2182 | begin
2182    result := FQSelect.SQL;
2183   end;
2184  
2185 < function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
2185 > function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2186   begin
2187 <  result := FQSelect.SQLType;
2187 >  result := FQSelect.SQLStatementType;
2188   end;
2189  
2190   function TIBCustomDataSet.GetModifySQL: TStrings;
# Line 1989 | Line 2197 | begin
2197    result := FBase.Transaction;
2198   end;
2199  
1992 function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1993 begin
1994  result := FBase.TRHandle;
1995 end;
1996
2200   procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2201   begin
2202    if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2203      FUpdateObject.Apply(ukDelete,Buff)
2204    else
2205    begin
2206 <    SetInternalSQLParams(FQDelete, Buff);
2206 >    SetInternalSQLParams(FQDelete.Params, Buff);
2207      FQDelete.ExecQuery;
2208    end;
2209    with PRecordData(Buff)^ do
# Line 2015 | Line 2218 | function TIBCustomDataSet.InternalLocate
2218    const KeyValues: Variant; Options: TLocateOptions): Boolean;
2219   var
2220    keyFieldList: TList;
2018  {$IFDEF NEW_TBOOKMARK }
2221    CurBookmark: TBookmark;
2020  {$ELSE}
2021  CurBookmark: string;
2022  {$ENDIF}
2222    fieldValue: Variant;
2223    lookupValues: array of variant;
2224    i, fieldCount: Integer;
# Line 2101 | Line 2300 | end;
2300  
2301   procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2302   var
2303 <  i, j, k: Integer;
2303 >  i, j, k, arr: Integer;
2304    pbd: PBlobDataArray;
2305 +  pda: PArrayDataArray;
2306   begin
2307    pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2308 <  j := 0;
2308 >  pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2309 >  j := 0; arr := 0;
2310    for i := 0 to FieldCount - 1 do
2311      if Fields[i].IsBlob then
2312      begin
# Line 2114 | Line 2315 | begin
2315        begin
2316          pbd^[j].Finalize;
2317          PISC_QUAD(
2318 <          PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
2318 >          PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2319            pbd^[j].BlobID;
2320          PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2321 +      end
2322 +      else
2323 +      begin
2324 +        PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2325 +        with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2326 +        begin
2327 +          gds_quad_high := 0;
2328 +          gds_quad_low := 0;
2329 +        end;
2330        end;
2331        Inc(j);
2332 +    end
2333 +    else
2334 +    if Fields[i] is TIBArrayField then
2335 +    begin
2336 +      if pda^[arr] <> nil then
2337 +      begin
2338 +        k := FMappedFieldPosition[Fields[i].FieldNo -1];
2339 +        PISC_QUAD(
2340 +          PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=  pda^[arr].ArrayIntf.GetArrayID;
2341 +        PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2342 +      end;
2343 +      Inc(arr);
2344      end;
2345    if Assigned(FUpdateObject) then
2346    begin
# Line 2130 | Line 2352 | begin
2352        FUpdateObject.Apply(ukModify,Buff);
2353    end
2354    else begin
2355 <    SetInternalSQLParams(Qry, Buff);
2355 >    SetInternalSQLParams(Qry.Params, Buff);
2356      Qry.ExecQuery;
2357    end;
2358    PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
# Line 2164 | Line 2386 | begin
2386          end
2387          else
2388            Qry := FQRefresh;
2389 <        SetInternalSQLParams(Qry, Buff);
2389 >        SetInternalSQLParams(Qry.Params, Buff);
2390          Qry.ExecQuery;
2391          try
2392 <          if (Qry.SQLType = SQLExecProcedure) or
2171 <             (Qry.Next <> nil) then
2392 >          if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2393            begin
2394              ofs := PRecordData(Buff)^.rdSavedOffset;
2395              FetchCurrentRecordToBuffer(Qry,
# Line 2261 | Line 2482 | begin
2482   end;
2483  
2484   procedure TIBCustomDataSet.InternalPrepare;
2264 var
2265  DidActivate: Boolean;
2485   begin
2486    if FInternalPrepared then
2487      Exit;
2269  DidActivate := False;
2488    FBase.SetCursor;
2489    try
2490      ActivateConnection;
2491 <    DidActivate := ActivateTransaction;
2491 >    ActivateTransaction;
2492      FBase.CheckDatabase;
2493      FBase.CheckTransaction;
2494      if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
# Line 2308 | Line 2526 | begin
2526      end else
2527        IBError(ibxeEmptyQuery, [nil]);
2528    finally
2311    if DidActivate then
2312      DeactivateTransaction;
2529      FBase.RestoreCursor;
2530    end;
2531   end;
# Line 2339 | Line 2555 | var
2555    begin
2556      CopyRecordBuffer(Buffer, OldBuffer);
2557      if BlobFieldCount > 0 then
2558 <      FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2558 >      FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2559 >               BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2560                 0);
2561    end;
2562  
# Line 2381 | Line 2598 | begin
2598    if (FBase.Database <> Value) then
2599    begin
2600      CheckDatasetClosed;
2601 +    InternalUnPrepare;
2602      FBase.Database := Value;
2603      FQDelete.Database := Value;
2604      FQInsert.Database := Value;
# Line 2408 | Line 2626 | begin
2626    end;
2627   end;
2628  
2629 < procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
2629 > procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
2630   var
2631    i, j: Integer;
2632    cr, data: PChar;
# Line 2416 | Line 2634 | var
2634    st: RawByteString;
2635    OldBuffer: Pointer;
2636    ts: TTimeStamp;
2637 +  Param: ISQLParam;
2638   begin
2639    if (Buffer = nil) then
2640      IBError(ibxeBufferNotSet, [nil]);
# Line 2423 | Line 2642 | begin
2642      InternalPrepare;
2643    OldBuffer := nil;
2644    try
2645 <    for i := 0 to Qry.Params.Count - 1 do
2645 >    for i := 0 to Params.GetCount - 1 do
2646      begin
2647 <      fn := Qry.Params[i].Name;
2647 >      Param := Params[i];
2648 >      fn := Param.Name;
2649        if (Pos('OLD_', fn) = 1) then {mbcs ok}
2650        begin
2651          fn := Copy(fn, 5, Length(fn));
# Line 2445 | Line 2665 | begin
2665               cr := Buffer;
2666        j := FQSelect.FieldIndex[fn] + 1;
2667        if (j > 0) then
2668 <        with PRecordData(cr)^ do
2668 >        with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2669          begin
2670 <          if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2670 >          if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2671            begin
2672 <            PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2672 >            PIBDBKey(Param.AsPointer)^ := rdDBKey;
2673              continue;
2674            end;
2675 <          if rdFields[j].fdIsNull then
2676 <            Qry.Params[i].IsNull := True
2675 >          if fdIsNull then
2676 >            Param.IsNull := True
2677            else begin
2678 <            Qry.Params[i].IsNull := False;
2679 <            data := cr + rdFields[j].fdDataOfs;
2680 <            case rdFields[j].fdDataType of
2678 >            Param.IsNull := False;
2679 >            data := cr + fdDataOfs;
2680 >            case fdDataType of
2681                SQL_TEXT, SQL_VARYING:
2682                begin
2683 <                SetString(st, data, rdFields[j].fdDataLength);
2684 <                {$IFDEF HAS_ANSISTRING_CODEPAGE}
2685 <                SetCodePage(st,rdFields[j].fdCodePage,false);
2466 <                {$ENDIF}
2467 <                Qry.Params[i].AsString := st;
2683 >                SetString(st, data, fdDataLength);
2684 >                SetCodePage(st,fdCodePage,false);
2685 >                Param.AsString := st;
2686                end;
2687              SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2688 <              Qry.Params[i].AsDouble := PDouble(data)^;
2688 >              Param.AsDouble := PDouble(data)^;
2689              SQL_SHORT, SQL_LONG:
2690              begin
2691 <              if rdFields[j].fdDataScale = 0 then
2692 <                Qry.Params[i].AsLong := PLong(data)^
2475 <              else if rdFields[j].fdDataScale >= (-4) then
2476 <                Qry.Params[i].AsCurrency := PCurrency(data)^
2691 >              if fdDataScale = 0 then
2692 >                Param.AsLong := PLong(data)^
2693                else
2694 <                Qry.Params[i].AsDouble := PDouble(data)^;
2694 >              if fdDataScale >= (-4) then
2695 >                Param.AsCurrency := PCurrency(data)^
2696 >              else
2697 >                Param.AsDouble := PDouble(data)^;
2698              end;
2699              SQL_INT64:
2700              begin
2701 <              if rdFields[j].fdDataScale = 0 then
2702 <                Qry.Params[i].AsInt64 := PInt64(data)^
2703 <              else if rdFields[j].fdDataScale >= (-4) then
2704 <                Qry.Params[i].AsCurrency := PCurrency(data)^
2701 >              if fdDataScale = 0 then
2702 >                Param.AsInt64 := PInt64(data)^
2703 >              else
2704 >              if fdDataScale >= (-4) then
2705 >                Param.AsCurrency := PCurrency(data)^
2706                else
2707 <                Qry.Params[i].AsDouble := PDouble(data)^;
2707 >                Param.AsDouble := PDouble(data)^;
2708              end;
2709              SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2710 <              Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2710 >              Param.AsQuad := PISC_QUAD(data)^;
2711              SQL_TYPE_DATE:
2712              begin
2713                ts.Date := PInt(data)^;
2714                ts.Time := 0;
2715 <              Qry.Params[i].AsDate :=
2496 <                TimeStampToDateTime(ts);
2715 >              Param.AsDate := TimeStampToDateTime(ts);
2716              end;
2717              SQL_TYPE_TIME:
2718              begin
2719                ts.Date := 0;
2720                ts.Time := PInt(data)^;
2721 <              Qry.Params[i].AsTime :=
2503 <                TimeStampToDateTime(ts);
2721 >              Param.AsTime := TimeStampToDateTime(ts);
2722              end;
2723              SQL_TIMESTAMP:
2724 <              Qry.Params[i].AsDateTime :=
2724 >              Param.AsDateTime :=
2725                         TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2726              SQL_BOOLEAN:
2727 <              Qry.Params[i].AsBoolean := PWordBool(data)^;
2727 >              Param.AsBoolean := PWordBool(data)^;
2728            end;
2729          end;
2730        end;
# Line 2662 | Line 2880 | begin
2880    Result := Assigned( FQSelect ) and FQSelect.EOF;
2881   end;
2882  
2883 < function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2883 > function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
2884   begin
2885    ActivateConnection;
2886    ActivateTransaction;
# Line 2799 | Line 3017 | var
3017    Buff: PChar;
3018    bTr, bDB: Boolean;
3019   begin
3020 +  if (Field = nil) or (Field.DataSet <> self) then
3021 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3022    Buff := GetActiveBuf;
3023    if Buff = nil then
3024    begin
3025      fs := TIBBlobStream.Create;
3026      fs.Mode := bmReadWrite;
3027 +    fs.Database := Database;
3028 +    fs.Transaction := Transaction;
3029 +    fs.SetField(Field);
3030      FBlobStreamList.Add(Pointer(fs));
3031      result := TIBDSBlobStream.Create(Field, fs, Mode);
3032      exit;
# Line 2818 | Line 3041 | begin
3041      fs.Mode := bmReadWrite;
3042      fs.Database := Database;
3043      fs.Transaction := Transaction;
3044 +    fs.SetField(Field);
3045      fs.BlobID :=
3046 <      PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3046 >      PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3047      if (CachedUpdates) then
3048      begin
3049        bTr := not Transaction.InTransaction;
# Line 2840 | Line 3064 | begin
3064    result := TIBDSBlobStream.Create(Field, fs, Mode);
3065   end;
3066  
3067 + function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3068 + var Buff: PChar;
3069 +    pda: PArrayDataArray;
3070 +    bTr, bDB: Boolean;
3071 + begin
3072 +  if (Field = nil) or (Field.DataSet <> self) then
3073 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3074 +  Buff := GetActiveBuf;
3075 +  if Buff = nil then
3076 +    Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3077 +                              Field.FRelationName,Field.FieldName)
3078 +  else
3079 +  begin
3080 +    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3081 +    if pda^[Field.FCacheOffset] = nil then
3082 +    begin
3083 +      AdjustRecordOnInsert(Buff);
3084 +      if Field.IsNull then
3085 +        Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3086 +                                Field.FRelationName,Field.FieldName)
3087 +      else
3088 +        Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3089 +                            Field.FRelationName,Field.FieldName,Field.ArrayID);
3090 +      pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3091 +      FArrayList.Add(pda^[Field.FCacheOffset]);
3092 +      if (CachedUpdates) then
3093 +      begin
3094 +        bTr := not Transaction.InTransaction;
3095 +        bDB := not Database.Connected;
3096 +        if bDB then
3097 +          Database.Open;
3098 +        if bTr then
3099 +          Transaction.StartTransaction;
3100 +         pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3101 +        if bTr then
3102 +          Transaction.Commit;
3103 +        if bDB then
3104 +          Database.Close;
3105 +      end;
3106 +      WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3107 +    end
3108 +    else
3109 +      Result := pda^[Field.FCacheOffset].ArrayIntf;
3110 +  end;
3111 + end;
3112 +
3113 + procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3114 + var Buff: PChar;
3115 +    pda: PArrayDataArray;
3116 + begin
3117 +  if (Field = nil) or (Field.DataSet <> self) then
3118 +    IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3119 +  Buff := GetActiveBuf;
3120 +  if Buff <> nil then
3121 +  begin
3122 +    AdjustRecordOnInsert(Buff);
3123 +    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3124 +    pda^[Field.FCacheOffset].FArray := AnArray;
3125 +    WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3126 +  end;
3127 + end;
3128 +
3129   function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3130   const
3131    CMPLess = -1;
# Line 2920 | Line 3206 | end;
3206   procedure TIBCustomDataSet.DoBeforeClose;
3207   begin
3208    inherited DoBeforeClose;
3209 +  if FInTransactionEnd and (FCloseAction = TARollback) then
3210 +     Exit;
3211    if State in [dsInsert,dsEdit] then
3212    begin
2925    if FInTransactionEnd and (FCloseAction = TARollback) then
2926       Exit;
2927
3213      if DataSetCloseAction = dcSaveChanges then
3214        Post;
3215        {Note this can fail with an exception e.g. due to
3216         database validation error. In which case the dataset remains open }
3217    end;
3218 +  if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3219 +    ApplyUpdates;
3220   end;
3221  
3222   procedure TIBCustomDataSet.DoBeforeOpen;
# Line 2961 | Line 3248 | end;
3248  
3249   procedure TIBCustomDataSet.FetchAll;
3250   var
2964  {$IFDEF NEW_TBOOKMARK }
3251    CurBookmark: TBookmark;
2966  {$ELSE}
2967  CurBookmark: string;
2968  {$ENDIF}
3252   begin
3253    FBase.SetCursor;
3254   try
# Line 3076 | Line 3359 | begin
3359      if result and (Buffer <> nil) then
3360        Move(Buff[1], Buffer^, Field.DataSize);
3361    end
3362 <  else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3362 >  else
3363 >  if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3364       (FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3365 +  with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3366 +                         FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3367    begin
3368 <    result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
3368 >    result := not fdIsNull;
3369      if result and (Buffer <> nil) then
3084      with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
3370        begin
3371 <        Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3371 >        Data := Buff + fdDataOfs;
3372          if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3373          begin
3374            if fdDataLength < Field.DataSize then
# Line 3154 | Line 3439 | begin
3439          if FCurrentRecord < FRecordCount then
3440            ReadRecordCache(FCurrentRecord, Buffer, False)
3441          else begin
3442 <          while (not FQSelect.EOF) and
3158 <                (FQSelect.Next <> nil) and
3442 >          while (not FQSelect.EOF) and FQSelect.Next  and
3443                  (FCurrentRecord >= FRecordCount) do begin
3444              FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3445              Inc(FRecordCount);
# Line 3266 | Line 3550 | procedure TIBCustomDataSet.InternalCance
3550   var
3551    Buff: PChar;
3552    CurRec: Integer;
3553 +  pda: PArrayDataArray;
3554 +  i: integer;
3555   begin
3556    inherited InternalCancel;
3557    Buff := GetActiveBuf;
3558 <  if Buff <> nil then begin
3558 >  if Buff <> nil then
3559 >  begin
3560 >    pda := PArrayDataArray(Buff + FArrayCacheOffset);
3561 >    for i := 0 to ArrayFieldCount - 1 do
3562 >      pda^[i].ArrayIntf.CancelChanges;
3563      CurRec := FCurrentRecord;
3564      AdjustRecordOnInsert(Buff);
3565      if (State = dsEdit) then begin
# Line 3292 | Line 3582 | begin
3582      DeactivateTransaction;
3583    FQSelect.Close;
3584    ClearBlobCache;
3585 +  ClearArrayCache;
3586    FreeRecordBuffer(FModelBuffer);
3587    FreeRecordBuffer(FOldBuffer);
3588    FCurrentRecord := -1;
# Line 3307 | Line 3598 | begin
3598    FOBEnd := 0;
3599    FreeMem(FBufferCache);
3600    FBufferCache := nil;
3601 +  FreeMem(FFieldColumns);
3602 +  FFieldColumns := nil;
3603    FreeMem(FOldBufferCache);
3604    FOldBufferCache := nil;
3605    BindFields(False);
# Line 3384 | Line 3677 | const
3677   var
3678    FieldType: TFieldType;
3679    FieldSize: Word;
3680 <  charSetID: integer;
3680 >  FieldDataSize: integer;
3681 >  charSetID: short;
3682    CharSetSize: integer;
3683    CharSetName: RawByteString;
3390  {$IFDEF HAS_ANSISTRING_CODEPAGE}
3684    FieldCodePage: TSystemCodePage;
3392  {$ENDIF}
3685    FieldNullable : Boolean;
3686    i, FieldPosition, FieldPrecision: Integer;
3687    FieldAliasName, DBAliasName: string;
3688 <  RelationName, FieldName: string;
3688 >  aRelationName, FieldName: string;
3689    Query : TIBSQL;
3690    FieldIndex: Integer;
3691    FRelationNodes : TRelationNode;
3692 +  aArrayDimensions: integer;
3693 +  aArrayBounds: TArrayBounds;
3694 +  ArrayMetaData: IArrayMetaData;
3695  
3696    function Add_Node(Relation, Field : String) : TRelationNode;
3697    var
# Line 3494 | Line 3789 | var
3789   begin
3790    FRelationNodes := TRelationNode.Create;
3791    FNeedsRefresh := False;
3792 <  Database.InternalTransaction.StartTransaction;
3792 >  if not Database.InternalTransaction.InTransaction then
3793 >    Database.InternalTransaction.StartTransaction;
3794    Query := TIBSQL.Create(self);
3795    try
3796      Query.Database := DataBase;
# Line 3502 | Line 3798 | begin
3798      FieldDefs.BeginUpdate;
3799      FieldDefs.Clear;
3800      FieldIndex := 0;
3801 <    if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3802 <      SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3801 >    if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3802 >      SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3803      Query.SQL.Text := DefaultSQL;
3804      Query.Prepare;
3805 <    SetLength(FAliasNameMap, SourceQuery.Current.Count);
3806 <    SetLength(FAliasNameList, SourceQuery.Current.Count);
3807 <    for i := 0 to SourceQuery.Current.Count - 1 do
3808 <      with SourceQuery.Current[i].Data^ do
3805 >    SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3806 >    SetLength(FAliasNameList, SourceQuery.MetaData.Count);
3807 >    for i := 0 to SourceQuery.MetaData.GetCount - 1 do
3808 >      with SourceQuery.MetaData[i] do
3809        begin
3810          { Get the field name }
3811 <        FieldAliasName := SourceQuery.Current[i].Name;
3812 <        SetString(DBAliasName, aliasname, aliasname_length);
3813 <        SetString(RelationName, relname, relname_length);
3814 <        SetString(FieldName, sqlname, sqlname_length);
3811 >        FieldAliasName := GetName;
3812 >        DBAliasName := GetAliasname;
3813 >        aRelationName := getRelationName;
3814 >        FieldName := getSQLName;
3815          FAliasNameList[i] := DBAliasName;
3816          FieldSize := 0;
3817 +        FieldDataSize := GetSize;
3818          FieldPrecision := 0;
3819 <        FieldNullable := SourceQuery.Current[i].IsNullable;
3819 >        FieldNullable := IsNullable;
3820          CharSetSize := 0;
3821          CharSetName := '';
3525        {$IFDEF HAS_ANSISTRING_CODEPAGE}
3822          FieldCodePage := CP_NONE;
3823 <        {$ENDIF}
3824 <        case sqltype and not 1 of
3823 >        aArrayDimensions := 0;
3824 >        SetLength(aArrayBounds,0);
3825 >        case SQLType of
3826            { All VARCHAR's must be converted to strings before recording
3827             their values }
3828            SQL_VARYING, SQL_TEXT:
3829            begin
3830 <            CharSetID := SourceQuery.Current[i].GetCharSetID;
3831 <            TFirebirdCharacterSets.CharSetWidth(CharSetID,CharSetSize);
3832 <            CharSetName := TFirebirdCharacterSets.GetCharsetName(CharSetID);
3833 <            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3834 <            TFirebirdCharacterSets.CharSetID2CodePage(CharSetID,FieldCodePage);
3538 <            {$ENDIF}
3539 <            FieldSize := sqllen;
3830 >            if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3831 >              CharSetSize := 1;
3832 >            CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3833 >            Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3834 >            FieldSize := FieldDataSize div CharSetSize;
3835              FieldType := ftString;
3836            end;
3837            { All Doubles/Floats should be cast to doubles }
# Line 3544 | Line 3839 | begin
3839              FieldType := ftFloat;
3840            SQL_SHORT:
3841            begin
3842 <            if (sqlscale = 0) then
3842 >            if (getScale = 0) then
3843                FieldType := ftSmallInt
3844              else begin
3845                FieldType := ftBCD;
3846                FieldPrecision := 4;
3847 <              FieldSize := -sqlscale;
3847 >              FieldSize := -getScale;
3848              end;
3849            end;
3850            SQL_LONG:
3851            begin
3852 <            if (sqlscale = 0) then
3852 >            if (getScale = 0) then
3853                FieldType := ftInteger
3854 <            else if (sqlscale >= (-4)) then
3854 >            else if (getScale >= (-4)) then
3855              begin
3856                FieldType := ftBCD;
3857                FieldPrecision := 9;
3858 <              FieldSize := -sqlscale;
3858 >              FieldSize := -getScale;
3859              end
3860              else
3861              if Database.SQLDialect = 1 then
# Line 3572 | Line 3867 | begin
3867              begin
3868                FieldType := ftFMTBCD;
3869                FieldPrecision := 9;
3870 <              FieldSize := -sqlscale;
3870 >              FieldSize := -getScale;
3871              end;
3872            end;
3873  
3874            SQL_INT64:
3875            begin
3876 <            if (sqlscale = 0) then
3876 >            if (getScale = 0) then
3877                FieldType := ftLargeInt
3878 <            else if (sqlscale >= (-4)) then
3878 >            else if (getScale >= (-4)) then
3879              begin
3880                FieldType := ftBCD;
3881                FieldPrecision := 18;
3882 <              FieldSize := -sqlscale;
3882 >              FieldSize := -getScale;
3883              end
3884              else
3885 <              FieldType := ftFloat
3885 >              FieldType := ftFloat;
3886            end;
3887            SQL_TIMESTAMP: FieldType := ftDateTime;
3888            SQL_TYPE_TIME: FieldType := ftTime;
# Line 3595 | Line 3890 | begin
3890            SQL_BLOB:
3891            begin
3892              FieldSize := sizeof (TISC_QUAD);
3893 <            if (sqlsubtype = 1) then
3893 >            if (getSubtype = 1) then
3894              begin
3895 <              CharSetID := SourceQuery.Current[i].GetCharSetID;
3896 <              TFirebirdCharacterSets.CharSetWidth(CharSetID,CharSetSize);
3897 <              CharSetName := TFirebirdCharacterSets.GetCharsetName(CharSetID);
3898 <              {$IFDEF HAS_ANSISTRING_CODEPAGE}
3604 <              TFirebirdCharacterSets.CharSetID2CodePage(CharSetID,FieldCodePage);
3605 <              {$ENDIF}
3895 >              if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3896 >                CharSetSize := 1;
3897 >              CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3898 >              Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3899                FieldType := ftMemo;
3900              end
3901              else
# Line 3611 | Line 3904 | begin
3904            SQL_ARRAY:
3905            begin
3906              FieldSize := sizeof (TISC_QUAD);
3907 <            FieldType := ftUnknown;
3907 >            FieldType := ftArray;
3908 >            ArrayMetaData := GetArrayMetaData;
3909 >            if ArrayMetaData <> nil then
3910 >            begin
3911 >              aArrayDimensions := ArrayMetaData.GetDimensions;
3912 >              aArrayBounds := ArrayMetaData.GetBounds;
3913 >            end;
3914            end;
3915            SQL_BOOLEAN:
3916               FieldType:= ftBoolean;
# Line 3628 | Line 3927 | begin
3927              Name := FieldAliasName;
3928              FAliasNameMap[FieldNo-1] := DBAliasName;
3929              Size := FieldSize;
3930 +            DataSize := FieldDataSize;
3931              Precision := FieldPrecision;
3932              Required := not FieldNullable;
3933 +            RelationName := aRelationName;
3934              InternalCalcField := False;
3935              CharacterSetSize := CharSetSize;
3936              CharacterSetName := CharSetName;
3636            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3937              CodePage := FieldCodePage;
3938 <            {$ENDIF}
3938 >            ArrayDimensions := aArrayDimensions;
3939 >            ArrayBounds := aArrayBounds;
3940              if (FieldName <> '') and (RelationName <> '') then
3941              begin
3942                if Has_COMPUTED_BLR(RelationName, FieldName) then
# Line 3663 | Line 3964 | begin
3964      FreeNodes;
3965      Database.InternalTransaction.Commit;
3966      FieldDefs.EndUpdate;
3967 +    FieldDefs.Updated := true;
3968    end;
3969   end;
3970  
# Line 3680 | Line 3982 | begin
3982    else begin
3983      Buffer := AllocRecordBuffer;
3984      try
3985 <      while FQSelect.Next <> nil do
3985 >      while FQSelect.Next do
3986        begin
3987          FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3988          Inc(FRecordCount);
# Line 3695 | Line 3997 | end;
3997   procedure TIBCustomDataSet.InternalSetParamsFromCursor;
3998   var
3999    i: Integer;
4000 <  cur_param: TIBXSQLVAR;
4000 >  cur_param: ISQLParam;
4001    cur_field: TField;
4002    s: TStream;
4003   begin
# Line 3703 | Line 4005 | begin
4005      IBError(ibxeEmptyQuery, [nil]);
4006    if not FInternalPrepared then
4007      InternalPrepare;
4008 <  if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4008 >  if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4009    begin
4010 <    for i := 0 to SQLParams.Count - 1 do
4010 >    for i := 0 to SQLParams.GetCount - 1 do
4011      begin
4012        cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4013        cur_param := SQLParams[i];
# Line 3739 | Line 4041 | begin
4041              try
4042                s := DataSource.DataSet.
4043                       CreateBlobStream(cur_field, bmRead);
4044 <              cur_param.LoadFromStream(s);
4044 >              cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4045              finally
4046                s.free;
4047              end;
4048            end;
4049 +          ftArray:
4050 +            cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4051            else
4052              IBError(ibxeNotSupported, [nil]);
4053          end;
# Line 3776 | Line 4080 | procedure TIBCustomDataSet.InternalOpen;
4080      result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
4081    end;
4082  
3779  function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3780  var i: integer;
3781  begin
3782    Result := nil;
3783    for i := 0 to FieldDefs.Count - 1 do
3784      if FieldDefs[i].FieldNo = aFieldNo then
3785      begin
3786        Result := TIBFieldDef(FieldDefs[i]);
3787        break;
3788      end;
3789  end;
3790
3791  procedure SetExtendedProperties;
3792  var i: integer;
3793      IBFieldDef: TIBFieldDef;
3794  begin
3795    for i := 0 to Fields.Count - 1 do
3796      if Fields[i].FieldNo > 0 then
3797      begin
3798        if(Fields[i] is TIBStringField) then
3799        with TIBStringField(Fields[i]) do
3800        begin
3801          IBFieldDef := GetFieldDef(FieldNo);
3802          if IBFieldDef <> nil then
3803          begin
3804            CharacterSetSize := IBFieldDef.CharacterSetSize;
3805            CharacterSetName := IBFieldDef.CharacterSetName;
3806            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3807            CodePage := IBFieldDef.CodePage;
3808            {$ENDIF}
3809          end;
3810        end
3811        else
3812        if(Fields[i] is TIBMemoField) then
3813        with TIBMemoField(Fields[i]) do
3814        begin
3815          IBFieldDef := GetFieldDef(FieldNo);
3816          if IBFieldDef <> nil then
3817          begin
3818            CharacterSetSize := IBFieldDef.CharacterSetSize;
3819            CharacterSetName := IBFieldDef.CharacterSetName;
3820            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3821            CodePage := IBFieldDef.CodePage;
3822            {$ENDIF}
3823          end;
3824        end
3825      end
3826  end;
3827
4083   begin
4084    FBase.SetCursor;
4085    try
# Line 3834 | Line 4089 | begin
4089        IBError(ibxeEmptyQuery, [nil]);
4090      if not FInternalPrepared then
4091        InternalPrepare;
4092 <   if FQSelect.SQLType = SQLSelect then
4092 >   if FQSelect.SQLStatementType = SQLSelect then
4093     begin
4094        if DefaultFields then
4095          CreateFields;
4096 +      FArrayFieldCount := 0;
4097        BindFields(True);
3842      SetExtendedProperties;
4098        FCurrentRecord := -1;
4099        FQSelect.ExecQuery;
4100        FOpen := FQSelect.Open;
# Line 3850 | Line 4105 | begin
4105          3. After the dummy fetch, FRecordSize will be appropriately
4106             adjusted to reflect the additional "weight" of the field
4107             data.
4108 <        4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4108 >        4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4109          5. Now, with the BufferSize available, allocate memory for chunks of records
4110          6. Re-allocate the model buffer, accounting for the new
4111             FRecordBufferSize.
4112          7. Finally, calls to AllocRecordBuffer will work!.
4113         }
4114        {Step 1}
4115 <      FRecordSize := RecordDataLength(FQSelect.Current.Count);
4115 >      FRecordSize := RecordDataLength(FQSelect.FieldCount);
4116        {Step 2, 3}
4117 +      GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4118        IBAlloc(FModelBuffer, 0, FRecordSize);
4119 <      FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4119 >      InitModelBuffer(FQSelect, FModelBuffer);
4120        {Step 4}
4121        FCalcFieldsOffset := FRecordSize;
4122        FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4123 <      FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4123 >      FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4124 >      FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4125        {Step 5}
4126        if UniDirectional then
4127          FBufferChunkSize := FRecordBufferSize * UniCache
# Line 3880 | Line 4137 | begin
4137        FCacheSize := FBufferChunkSize;
4138        FOldCacheSize := FBufferChunkSize;
4139        {Step 6}
4140 <      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4140 >      IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4141                               FRecordBufferSize);
4142        {Step 7}
4143        FOldBuffer := AllocRecordBuffer;
# Line 3978 | Line 4235 | end;
4235   function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4236                                   Options: TLocateOptions): Boolean;
4237   var
3981  {$IFDEF NEW_TBOOKMARK }
4238    CurBookmark: TBookmark;
3983  {$ELSE}
3984  CurBookmark: string;
3985  {$ENDIF}
4239   begin
4240    DisableControls;
4241    try
# Line 4000 | Line 4253 | function TIBCustomDataSet.Lookup(const K
4253                                   const ResultFields: string): Variant;
4254   var
4255    fl: TList;
4003  {$IFDEF NEW_TBOOKMARK }
4256    CurBookmark: TBookmark;
4005  {$ELSE}
4006  CurBookmark: string;
4007  {$ENDIF}
4257   begin
4258    DisableControls;
4259    fl := TList.Create;
# Line 4077 | Line 4326 | begin
4326        MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4327        if (MappedFieldPos > 0) and
4328           (MappedFieldPos <= rdFieldCount) then
4329 +      with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4330        begin
4331          Field.Validate(Buffer);
4332          if (Buffer = nil) or
4333             (Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4334 <          rdFields[MappedFieldPos].fdIsNull := True
4335 <        else begin
4336 <          Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4337 <                 rdFields[MappedFieldPos].fdDataSize);
4338 <          if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4339 <             (rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4340 <            rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4091 <          rdFields[MappedFieldPos].fdIsNull := False;
4334 >          fdIsNull := True
4335 >        else
4336 >        begin
4337 >          Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4338 >          if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4339 >            fdDataLength := StrLen(PChar(Buffer));
4340 >          fdIsNull := False;
4341            if rdUpdateStatus = usUnmodified then
4342            begin
4343              if CachedUpdates then
# Line 4189 | Line 4438 | begin
4438    if FInternalPrepared then
4439    begin
4440      CheckDatasetClosed;
4441 +    if FDidActivate then
4442 +      DeactivateTransaction;
4443      FieldDefs.Clear;
4444      FieldDefs.Updated := false;
4445      FInternalPrepared := False;
# Line 4209 | Line 4460 | begin
4460        IBError(ibxeEmptyQuery, [nil]);
4461      if not FInternalPrepared then
4462        InternalPrepare;
4463 <    if FQSelect.SQLType = SQLSelect then
4463 >    if FQSelect.SQLStatementType = SQLSelect then
4464      begin
4465        IBError(ibxeIsASelectStatement, [nil]);
4466      end
# Line 4222 | Line 4473 | begin
4473    end;
4474   end;
4475  
4476 < function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4476 > function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4477   begin
4478 <  Result := FQSelect.Handle;
4478 >  Result := FQSelect.Statement;
4479   end;
4480  
4481   function TIBCustomDataSet.GetParser: TSelectSQLParser;
# Line 4279 | Line 4530 | end;
4530  
4531   { TIBDataSet IProviderSupport }
4532  
4533 < (*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4533 > procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4534   begin
4535    if Commit then
4536      Transaction.Commit else
# Line 4432 | Line 4683 | begin
4683    Transaction.StartTransaction;
4684   end;
4685  
4686 < function TIBCustomDataSet.PSGetTableName: string;
4686 > function TIBCustomDataSet.PsGetTableName: string;
4687   begin
4688   //  if not FInternalPrepared then
4689   //    InternalPrepare;
# Line 4442 | Line 4693 | begin
4693    if not FQSelect.Prepared then
4694      FQSelect.Prepare;
4695    Result := FQSelect.UniqueRelationName;
4696 < end;*)
4696 > end;
4697  
4698   procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4699   begin
# Line 4573 | Line 4824 | begin
4824    inherited Destroy;
4825   end;
4826  
4827 < procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
4827 > procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
4828   begin
4829    FRefreshSQL.Assign(Value);
4830   end;
4831  
4832 < procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4832 > procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
4833 >  buff: PChar);
4834   begin
4835    if not Assigned(DataSet) then Exit;
4836 <  DataSet.SetInternalSQLParams(Query, buff);
4836 >  DataSet.SetInternalSQLParams(Params, buff);
4837 > end;
4838 >
4839 > procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4840 > begin
4841 >  InternalSetParams(Query.Params,buff);
4842   end;
4843  
4844   function TIBDSBlobStream.GetSize: Int64;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines