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 66 by tony, Wed Aug 23 08:23:42 2017 UTC vs.
Revision 106 by tony, Thu Jan 18 14:37:35 2018 UTC

# Line 53 | Line 53 | uses
53    unix,
54   {$ENDIF}
55    SysUtils, Classes, IBDatabase, IBExternals, IB,  IBSQL, Db,
56 <  IBUtils, IBBlob, IBSQLParser;
56 >  IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo;
57  
58   const
59    BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
# Line 74 | 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 >    procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
80      property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
81    public
82      constructor Create(AOwner: TComponent); override;
# Line 207 | Line 209 | type
209       Note: y > 4 will default to Floats
210    }
211    TIBBCDField = class(TBCDField)
212 +  private
213 +    FIdentityColumn: boolean;
214    protected
215 +    procedure Bind(Binding: Boolean); override;
216      class procedure CheckTypeSize(Value: Integer); override;
217      function GetAsCurrency: Currency; override;
218      function GetAsString: string; override;
# Line 215 | Line 220 | type
220      function GetDataSize: Integer; override;
221    public
222      constructor Create(AOwner: TComponent); override;
223 +    property IdentityColumn: boolean read FIdentityColumn;
224    published
225      property Size default 8;
226    end;
227  
228 +  {The following integer field types extend the built in versions to enable IBX appplications
229 +   to check for an Identity column}
230 +
231 +  { TIBSmallintField }
232 +
233 +  TIBSmallintField = class(TSmallintField)
234 +  private
235 +    FIdentityColumn: boolean;
236 +  protected
237 +    procedure Bind(Binding: Boolean); override;
238 +  public
239 +    property IdentityColumn: boolean read FIdentityColumn;
240 +  end;
241 +
242 +  { TIBIntegerField }
243 +
244 +  TIBIntegerField = class(TIntegerField)
245 +  private
246 +    FIdentityColumn: boolean;
247 +  protected
248 +    procedure Bind(Binding: Boolean); override;
249 +  public
250 +    property IdentityColumn: boolean read FIdentityColumn;
251 +  end;
252 +
253 +  { TIBLargeIntField }
254 +
255 +  TIBLargeIntField = class(TLargeIntField)
256 +  private
257 +    FIdentityColumn: boolean;
258 +  protected
259 +    procedure Bind(Binding: Boolean); override;
260 +  public
261 +    property IdentityColumn: boolean read FIdentityColumn;
262 +  end;
263 +
264    {TIBMemoField}
265    {Allows us to show truncated text in DBGrids and anything else that uses
266     DisplayText}
# Line 273 | Line 315 | type
315      FFieldName: string;
316      FGeneratorName: string;
317      FIncrement: integer;
318 +    FQuery: TIBSQL;
319 +    function GetDatabase: TIBDatabase;
320 +    function GetTransaction: TIBTransaction;
321 +    procedure SetDatabase(AValue: TIBDatabase);
322 +    procedure SetGeneratorName(AValue: string);
323      procedure SetIncrement(const AValue: integer);
324 +    procedure SetTransaction(AValue: TIBTransaction);
325 +    procedure SetQuerySQL;
326    protected
327 <    function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
327 >    function GetNextValue: integer;
328    public
329      constructor Create(Owner: TIBCustomDataSet);
330 +    destructor Destroy; override;
331      procedure Apply;
332      property Owner: TIBCustomDataSet read FOwner;
333 +    property Database: TIBDatabase read GetDatabase write SetDatabase;
334 +    property Transaction: TIBTransaction read GetTransaction write SetTransaction;
335    published
336 <    property Generator: string read FGeneratorName write FGeneratorName;
336 >    property Generator: string read FGeneratorName write SetGeneratorName;
337      property Field: string read FFieldName write FFieldName;
338      property Increment: integer read FIncrement write SetIncrement default 1;
339      property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
# Line 359 | Line 411 | type
411      FQRefresh,
412      FQSelect,
413      FQModify: TIBSQL;
414 +    FDatabaseInfo: TIBDatabaseInfo;
415      FRecordBufferSize: Integer;
416      FRecordCount: Integer;
417      FRecordSize: Integer;
# Line 388 | Line 441 | type
441      FInTransactionEnd: boolean;
442      FIBLinks: TList;
443      FFieldColumns: PFieldColumns;
444 +    procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex,
445 +      FieldIndex: integer; Buffer: PChar);
446      procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
447      function GetSelectStmtIntf: IStatement;
448      procedure SetUpdateMode(const Value: TUpdateMode);
# Line 435 | Line 490 | type
490      procedure SetDatabase(Value: TIBDatabase);
491      procedure SetDeleteSQL(Value: TStrings);
492      procedure SetInsertSQL(Value: TStrings);
493 <    procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
493 >    procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
494      procedure SetRefreshSQL(Value: TStrings);
495      procedure SetSelectSQL(Value: TStrings);
496      procedure SetModifySQL(Value: TStrings);
497      procedure SetTransaction(Value: TIBTransaction);
498      procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
499      procedure SetUniDirectional(Value: Boolean);
500 +    procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
501      procedure RefreshParams;
502      function AdjustPosition(FCache: PChar; Offset: DWORD;
503                              Origin: Integer): DWORD;
# Line 790 | Line 846 | type
846      FCharacterSetName: RawByteString;
847      FCharacterSetSize: integer;
848      FCodePage: TSystemCodePage;
849 +    FIdentityColumn: boolean;
850      FRelationName: string;
851      FDataSize: integer;
852    published
# Line 800 | Line 857 | type
857      property RelationName: string read FRelationName write FRelationName;
858      property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
859      property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
860 +    property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false;
861    end;
862  
863   const
864   DefaultFieldClasses: array[TFieldType] of TFieldClass = (
865      nil,                { ftUnknown }
866      TIBStringField,     { ftString }
867 <    TSmallintField,     { ftSmallint }
868 <    TIntegerField,      { ftInteger }
867 >    TIBSmallintField,   { ftSmallint }
868 >    TIBIntegerField,      { ftInteger }
869      TWordField,         { ftWord }
870      TBooleanField,      { ftBoolean }
871      TFloatField,        { ftFloat }
# Line 829 | Line 887 | DefaultFieldClasses: array[TFieldType] o
887      nil,                { ftCursor }
888      TStringField,       { ftFixedChar }
889      nil,    { ftWideString }
890 <    TLargeIntField,     { ftLargeInt }
890 >    TIBLargeIntField,     { ftLargeInt }
891      nil,          { ftADT }
892      TIBArrayField,        { ftArray }
893      nil,    { ftReference }
# Line 873 | Line 931 | type
931      FieldName : String;
932      COMPUTED_BLR : Boolean;
933      DEFAULT_VALUE : boolean;
934 +    IDENTITY_COLUMN : boolean;
935      NextField : TFieldNode;
936    end;
937  
# Line 925 | Line 984 | type
984      Result := str;
985    end;
986  
987 + { TIBLargeIntField }
988 +
989 + procedure TIBLargeIntField.Bind(Binding: Boolean);
990 + begin
991 +  inherited Bind(Binding);
992 +  if Binding and (FieldDef <> nil) then
993 +     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
994 + end;
995 +
996 + { TIBIntegerField }
997 +
998 + procedure TIBIntegerField.Bind(Binding: Boolean);
999 + begin
1000 +  inherited Bind(Binding);
1001 +  if Binding and (FieldDef <> nil) then
1002 +     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1003 + end;
1004 +
1005 + { TIBSmallintField }
1006 +
1007 + procedure TIBSmallintField.Bind(Binding: Boolean);
1008 + begin
1009 +  inherited Bind(Binding);
1010 +  if Binding and (FieldDef <> nil) then
1011 +     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1012 + end;
1013 +
1014   { TIBArray }
1015  
1016   procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
# Line 1034 | Line 1120 | begin
1120         {2: case 2 ignored. This should be handled by TIBWideMemo}
1121  
1122         3, {Assume UNICODE_FSS is really UTF8}
1123 <       4: {Include GB18030 - assuming UTF8 routine work for this codeset}
1123 >       4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1124           if DisplayWidth = 0 then
1125             Result := ValidUTF8String(TextToSingleLine(Result))
1126           else
# Line 1236 | Line 1322 | begin
1322    Size := 8;
1323   end;
1324  
1325 + procedure TIBBCDField.Bind(Binding: Boolean);
1326 + begin
1327 +  inherited Bind(Binding);
1328 +  if Binding and (FieldDef <> nil) then
1329 +     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1330 + end;
1331 +
1332   class procedure TIBBCDField.CheckTypeSize(Value: Integer);
1333   begin
1334   { No need to check as the base type is currency, not BCD }
# Line 1321 | Line 1414 | constructor TIBCustomDataSet.Create(AOwn
1414   begin
1415    inherited Create(AOwner);
1416    FBase := TIBBase.Create(Self);
1417 +  FDatabaseInfo := TIBDatabaseInfo.Create(self);
1418    FIBLinks := TList.Create;
1419    FCurrentRecord := -1;
1420    FDeletedRecords := 0;
# Line 1959 | Line 2053 | begin
2053    end;
2054   end;
2055  
2056 + {Update Buffer Fields from Query Results}
2057 +
2058 + procedure TIBCustomDataSet.UpdateRecordFromQuery(QryResults: IResults;
2059 +  Buffer: PChar);
2060 + var i, j: integer;
2061 + begin
2062 +  for i := 0 to QryResults.Count - 1 do
2063 +  begin
2064 +    j := GetFieldPosition(QryResults[i].GetAliasName);
2065 +    if j > 0 then
2066 +      ColumnDataToBuffer(QryResults,i,j,Buffer);
2067 +  end;
2068 + end;
2069 +
2070 +
2071 + {Move column data returned from query to row buffer}
2072 +
2073 + procedure TIBCustomDataSet.ColumnDataToBuffer(QryResults: IResults;
2074 +               ColumnIndex, FieldIndex: integer; Buffer: PChar);
2075 + var
2076 +  LocalData: PByte;
2077 +  LocalDate: TDateTime;
2078 +  LocalDouble: Double;
2079 +  LocalInt: Integer;
2080 +  LocalBool: wordBool;
2081 +  LocalInt64: Int64;
2082 +  LocalCurrency: Currency;
2083 +  ColData: ISQLData;
2084 + begin
2085 +  LocalData := nil;
2086 +  with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2087 +  begin
2088 +    QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData);
2089 +    if not fdIsNull then
2090 +    begin
2091 +      ColData := QryResults[ColumnIndex];
2092 +      case fdDataType of  {Get Formatted data for column types that need formatting}
2093 +        SQL_TYPE_DATE,
2094 +        SQL_TYPE_TIME,
2095 +        SQL_TIMESTAMP:
2096 +        begin
2097 +          {This is an IBX native format and not the TDataset approach. See also GetFieldData}
2098 +          LocalDate := ColData.AsDateTime;
2099 +          LocalData := PByte(@LocalDate);
2100 +        end;
2101 +        SQL_SHORT, SQL_LONG:
2102 +        begin
2103 +          if (fdDataScale = 0) then
2104 +          begin
2105 +            LocalInt := ColData.AsLong;
2106 +            LocalData := PByte(@LocalInt);
2107 +          end
2108 +          else
2109 +          if (fdDataScale >= (-4)) then
2110 +          begin
2111 +            LocalCurrency := ColData.AsCurrency;
2112 +            LocalData := PByte(@LocalCurrency);
2113 +          end
2114 +          else
2115 +          begin
2116 +           LocalDouble := ColData.AsDouble;
2117 +           LocalData := PByte(@LocalDouble);
2118 +          end;
2119 +        end;
2120 +        SQL_INT64:
2121 +        begin
2122 +          if (fdDataScale = 0) then
2123 +          begin
2124 +            LocalInt64 := ColData.AsInt64;
2125 +            LocalData := PByte(@LocalInt64);
2126 +          end
2127 +          else
2128 +          if (fdDataScale >= (-4)) then
2129 +          begin
2130 +            LocalCurrency := ColData.AsCurrency;
2131 +            LocalData := PByte(@LocalCurrency);
2132 +            end
2133 +            else
2134 +            begin
2135 +              LocalDouble := ColData.AsDouble;
2136 +              LocalData := PByte(@LocalDouble);
2137 +            end
2138 +        end;
2139 +        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2140 +        begin
2141 +          LocalDouble := ColData.AsDouble;
2142 +          LocalData := PByte(@LocalDouble);
2143 +        end;
2144 +        SQL_BOOLEAN:
2145 +        begin
2146 +          LocalBool := ColData.AsBoolean;
2147 +          LocalData := PByte(@LocalBool);
2148 +        end;
2149 +      end;
2150 +
2151 +      if fdDataType = SQL_VARYING then
2152 +        Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2153 +      else
2154 +        Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2155 +    end
2156 +    else {Null column}
2157 +    if fdDataType = SQL_VARYING then
2158 +      FillChar(Buffer[fdDataOfs],fdDataLength,0)
2159 +    else
2160 +      FillChar(Buffer[fdDataOfs],fdDataSize,0);
2161 +  end;
2162 + end;
2163 +
2164   { Read the record from FQSelect.Current into the record buffer
2165    Then write the buffer to in memory cache }
2166   procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
# Line 1967 | Line 2169 | var
2169    pbd: PBlobDataArray;
2170    pda: PArrayDataArray;
2171    i, j: Integer;
1970  LocalData: PByte;
1971  LocalDate, LocalDouble: Double;
1972  LocalInt: Integer;
1973  LocalBool: wordBool;
1974  LocalInt64: Int64;
1975  LocalCurrency: Currency;
2172    FieldsLoaded: Integer;
2173    p: PRecordData;
2174   begin
# Line 2023 | Line 2219 | begin
2219          continue;
2220        end;
2221      if j > 0 then
2222 <    begin
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 <          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:
2069 <            begin
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 <
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 <          FillChar(Buffer[fdDataOfs],fdDataSize,0);
2109 <      end;
2110 <    end;
2222 >      ColumnDataToBuffer(Qry.Current,i,j,Buffer);
2223    end;
2224    WriteRecordCache(RecordNumber, Buffer);
2225   end;
# Line 2202 | Line 2314 | begin
2314      FUpdateObject.Apply(ukDelete,Buff)
2315    else
2316    begin
2317 <    SetInternalSQLParams(FQDelete, Buff);
2317 >    SetInternalSQLParams(FQDelete.Params, Buff);
2318      FQDelete.ExecQuery;
2319    end;
2320    with PRecordData(Buff)^ do
# Line 2351 | Line 2463 | begin
2463        FUpdateObject.Apply(ukModify,Buff);
2464    end
2465    else begin
2466 <    SetInternalSQLParams(Qry, Buff);
2466 >    SetInternalSQLParams(Qry.Params, Buff);
2467      Qry.ExecQuery;
2468    end;
2469 +  if Qry.FieldCount > 0 then {Has RETURNING Clause}
2470 +    UpdateRecordFromQuery(Qry.Current,Buff);
2471    PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
2472    PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2473    SetModified(False);
# Line 2385 | Line 2499 | begin
2499          end
2500          else
2501            Qry := FQRefresh;
2502 <        SetInternalSQLParams(Qry, Buff);
2502 >        SetInternalSQLParams(Qry.Params, Buff);
2503          Qry.ExecQuery;
2504          try
2505            if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
# Line 2597 | Line 2711 | begin
2711    if (FBase.Database <> Value) then
2712    begin
2713      CheckDatasetClosed;
2714 +    InternalUnPrepare;
2715      FBase.Database := Value;
2716      FQDelete.Database := Value;
2717      FQInsert.Database := Value;
2718      FQRefresh.Database := Value;
2719      FQSelect.Database := Value;
2720      FQModify.Database := Value;
2721 +    FDatabaseInfo.Database := Value;
2722 +    FGeneratorField.Database := Value;
2723    end;
2724   end;
2725  
# Line 2624 | Line 2741 | begin
2741    end;
2742   end;
2743  
2744 < procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
2744 > procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
2745   var
2746    i, j: Integer;
2747    cr, data: PChar;
# Line 2640 | Line 2757 | begin
2757      InternalPrepare;
2758    OldBuffer := nil;
2759    try
2760 <    for i := 0 to Qry.Params.GetCount - 1 do
2760 >    for i := 0 to Params.GetCount - 1 do
2761      begin
2762 <      Param := Qry.Params[i];
2762 >      Param := Params[i];
2763        fn := Param.Name;
2764        if (Pos('OLD_', fn) = 1) then {mbcs ok}
2765        begin
# Line 2706 | Line 2823 | begin
2823              end;
2824              SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2825                Param.AsQuad := PISC_QUAD(data)^;
2826 <            SQL_TYPE_DATE:
2827 <            begin
2711 <              ts.Date := PInt(data)^;
2712 <              ts.Time := 0;
2713 <              Param.AsDate := TimeStampToDateTime(ts);
2714 <            end;
2715 <            SQL_TYPE_TIME:
2716 <            begin
2717 <              ts.Date := 0;
2718 <              ts.Time := PInt(data)^;
2719 <              Param.AsTime := TimeStampToDateTime(ts);
2720 <            end;
2826 >            SQL_TYPE_DATE,
2827 >            SQL_TYPE_TIME,
2828              SQL_TIMESTAMP:
2829 <              Param.AsDateTime :=
2830 <                       TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2829 >            {This is an IBX native format and not the TDataset approach. See also SetFieldData}
2830 >              Param.AsDateTime := PDateTime(data)^;
2831              SQL_BOOLEAN:
2832                Param.AsBoolean := PWordBool(data)^;
2833            end;
# Line 2771 | Line 2878 | begin
2878      FQRefresh.Transaction := Value;
2879      FQSelect.Transaction := Value;
2880      FQModify.Transaction := Value;
2881 +    FGeneratorField.Transaction := Value;
2882    end;
2883   end;
2884  
# Line 3672 | Line 3780 | const
3780                 'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3781                 'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3782                 '     (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3783 +
3784 +  DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3785 +               'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3786 +               'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3787 +               'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
3788 +               'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3789 +               'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3790 +               '     (not F.RDB$DEFAULT_VALUE is NULL) or ' + {do not localize}
3791 +               '     ( not R.RDB$IDENTITY_TYPE is NULL))' ; {do not localize}
3792 +
3793   var
3794    FieldType: TFieldType;
3795    FieldSize: Word;
# Line 3712 | Line 3830 | var
3830        FField.FieldName := Query.Fields[2].AsString;
3831        FField.DEFAULT_VALUE := not Query.Fields[1].IsNull;
3832        FField.COMPUTED_BLR := not Query.Fields[0].IsNull;
3833 +      FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull;
3834        FField.NextField := Result.FieldNodes;
3835        Result.FieldNodes := FField;
3836        Query.Next;
# Line 3765 | Line 3884 | var
3884          FField := Ffield.NextField;
3885    end;
3886  
3887 +  function Is_IDENTITY_COLUMN(Relation, Field : String) : Boolean;
3888 +  var
3889 +    FRelation : TRelationNode;
3890 +    FField : TFieldNode;
3891 +  begin
3892 +    FRelation := FRelationNodes;
3893 +    while Assigned(FRelation) and
3894 +         (FRelation.RelationName <> Relation) do
3895 +      FRelation := FRelation.NextRelation;
3896 +    if not Assigned(FRelation) then
3897 +      FRelation := Add_Node(Relation, Field);
3898 +    Result := false;
3899 +    FField := FRelation.FieldNodes;
3900 +    while Assigned(FField) do
3901 +      if FField.FieldName = Field then
3902 +      begin
3903 +        Result := Ffield.IDENTITY_COLUMN;
3904 +        Exit;
3905 +      end
3906 +      else
3907 +        FField := Ffield.NextField;
3908 +  end;
3909 +
3910    Procedure FreeNodes;
3911    var
3912      FRelation : TRelationNode;
# Line 3798 | Line 3940 | begin
3940      FieldIndex := 0;
3941      if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3942        SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3943 <    Query.SQL.Text := DefaultSQL;
3943 >    if FDatabaseInfo.ODSMajorVersion >= 12 then
3944 >      Query.SQL.Text := DefaultSQLODS12
3945 >    else
3946 >      Query.SQL.Text := DefaultSQL;
3947      Query.Prepare;
3948      SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3949      SetLength(FAliasNameList, SourceQuery.MetaData.Count);
# Line 3812 | Line 3957 | begin
3957          FieldName := getSQLName;
3958          FAliasNameList[i] := DBAliasName;
3959          FieldSize := 0;
3960 <        FieldDataSize := 0;
3960 >        FieldDataSize := GetSize;
3961          FieldPrecision := 0;
3962          FieldNullable := IsNullable;
3963          CharSetSize := 0;
# Line 3829 | Line 3974 | begin
3974                CharSetSize := 1;
3975              CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3976              Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3832            FieldDataSize := GetSize;
3977              FieldSize := FieldDataSize div CharSetSize;
3978              FieldType := ftString;
3979            end;
# Line 3844 | Line 3988 | begin
3988                FieldType := ftBCD;
3989                FieldPrecision := 4;
3990                FieldSize := -getScale;
3847              FieldDataSize := FieldSize;
3991              end;
3992            end;
3993            SQL_LONG:
# Line 3869 | Line 4012 | begin
4012                FieldPrecision := 9;
4013                FieldSize := -getScale;
4014              end;
3872            FieldDataSize := FieldSize;
4015            end;
4016  
4017            SQL_INT64:
# Line 3884 | Line 4026 | begin
4026              end
4027              else
4028                FieldType := ftFloat;
3887            FieldDataSize := FieldSize;
4029            end;
4030            SQL_TIMESTAMP: FieldType := ftDateTime;
4031            SQL_TYPE_TIME: FieldType := ftTime;
# Line 3902 | Line 4043 | begin
4043              end
4044              else
4045                FieldType := ftBlob;
3905            FieldDataSize := FieldSize;
4046            end;
4047            SQL_ARRAY:
4048            begin
4049              FieldSize := sizeof (TISC_QUAD);
3910            FieldDataSize := FieldSize;
4050              FieldType := ftArray;
4051              ArrayMetaData := GetArrayMetaData;
4052              if ArrayMetaData <> nil then
# Line 3943 | Line 4082 | begin
4082              ArrayBounds := aArrayBounds;
4083              if (FieldName <> '') and (RelationName <> '') then
4084              begin
4085 +              IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName);
4086                if Has_COMPUTED_BLR(RelationName, FieldName) then
4087                begin
4088                  Attributes := [faReadOnly];
# Line 4014 | Line 4154 | begin
4154      for i := 0 to SQLParams.GetCount - 1 do
4155      begin
4156        cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4157 <      cur_param := SQLParams[i];
4158 <      if (cur_field <> nil) then begin
4157 >      if (cur_field <> nil) then
4158 >      begin
4159 >        cur_param := SQLParams[i];
4160          if (cur_field.IsNull) then
4161            cur_param.IsNull := True
4162 <        else case cur_field.DataType of
4162 >        else
4163 >        case cur_field.DataType of
4164            ftString:
4165              cur_param.AsString := cur_field.AsString;
4166            ftBoolean:
# Line 4028 | Line 4170 | begin
4170            ftInteger:
4171              cur_param.AsLong := cur_field.AsInteger;
4172            ftLargeInt:
4173 <            cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
4173 >            cur_param.AsInt64 := cur_field.AsLargeInt;
4174            ftFloat, ftCurrency:
4175             cur_param.AsDouble := cur_field.AsFloat;
4176            ftBCD:
# Line 4687 | Line 4829 | begin
4829    Transaction.StartTransaction;
4830   end;
4831  
4832 < function TIBCustomDataSet.PSGetTableName: string;
4832 > function TIBCustomDataSet.PsGetTableName: string;
4833   begin
4834   //  if not FInternalPrepared then
4835   //    InternalPrepare;
# Line 4782 | Line 4924 | end;
4924   function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
4925    NativeFormat: Boolean): Boolean;
4926   begin
4927 <  if (Field.DataType = ftBCD) and not NativeFormat then
4927 >  {These datatypes use IBX conventions and not TDataset conventions}
4928 >  if (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) and not NativeFormat then
4929      Result := InternalGetFieldData(Field, Buffer)
4930    else
4931      Result := inherited GetFieldData(Field, Buffer, NativeFormat);
# Line 4808 | Line 4951 | end;
4951   procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
4952    NativeFormat: Boolean);
4953   begin
4954 <  if (not NativeFormat) and (Field.DataType = ftBCD) then
4954 >  {These datatypes use IBX conventions and not TDataset conventions}
4955 >  if (not NativeFormat) and (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) then
4956      InternalSetfieldData(Field, Buffer)
4957    else
4958      inherited SetFieldData(Field, buffer, NativeFormat);
# Line 4828 | Line 4972 | begin
4972    inherited Destroy;
4973   end;
4974  
4975 < procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
4975 > procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
4976   begin
4977    FRefreshSQL.Assign(Value);
4978   end;
4979  
4980 + procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
4981 +  buff: PChar);
4982 + begin
4983 +  if not Assigned(DataSet) then Exit;
4984 +  DataSet.SetInternalSQLParams(Params, buff);
4985 + end;
4986 +
4987   procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4988   begin
4989 +  InternalSetParams(Query.Params,buff);
4990 + end;
4991 +
4992 + procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(QryResults: IResults;
4993 +  Buffer: PChar);
4994 + begin
4995    if not Assigned(DataSet) then Exit;
4996 <  DataSet.SetInternalSQLParams(Query, buff);
4996 >  DataSet.UpdateRecordFromQuery(QryResults, Buffer);
4997   end;
4998  
4999   function TIBDSBlobStream.GetSize: Int64;
# Line 4899 | Line 5056 | end;
5056  
5057   procedure TIBGenerator.SetIncrement(const AValue: integer);
5058   begin
5059 +  if FIncrement = AValue then Exit;
5060    if AValue < 0 then
5061 <     raise Exception.Create('A Generator Increment cannot be negative');
5062 <  FIncrement := AValue
5061 >    IBError(ibxeNegativeGenerator,[]);
5062 >  FIncrement := AValue;
5063 >  SetQuerySQL;
5064   end;
5065  
5066 < function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4908 <  ATransaction: TIBTransaction): integer;
5066 > procedure TIBGenerator.SetTransaction(AValue: TIBTransaction);
5067   begin
5068 <  with TIBSQL.Create(nil) do
5069 <  try
5070 <    Database := ADatabase;
5071 <    Transaction := ATransaction;
5072 <    if not assigned(Database) then
5073 <       IBError(ibxeCannotSetDatabase,[]);
5074 <    if not assigned(Transaction) then
5075 <       IBError(ibxeCannotSetTransaction,[]);
5076 <    with Transaction do
5077 <      if not InTransaction then StartTransaction;
5078 <    SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
5079 <    Prepare;
5068 >  FQuery.Transaction := AValue;
5069 > end;
5070 >
5071 > procedure TIBGenerator.SetQuerySQL;
5072 > begin
5073 >  FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5074 > end;
5075 >
5076 > function TIBGenerator.GetDatabase: TIBDatabase;
5077 > begin
5078 >  Result := FQuery.Database;
5079 > end;
5080 >
5081 > function TIBGenerator.GetTransaction: TIBTransaction;
5082 > begin
5083 >  Result := FQuery.Transaction;
5084 > end;
5085 >
5086 > procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5087 > begin
5088 >  FQuery.Database := AValue;
5089 > end;
5090 >
5091 > procedure TIBGenerator.SetGeneratorName(AValue: string);
5092 > begin
5093 >  if FGeneratorName = AValue then Exit;
5094 >  FGeneratorName := AValue;
5095 >  SetQuerySQL;
5096 > end;
5097 >
5098 > function TIBGenerator.GetNextValue: integer;
5099 > begin
5100 >  with FQuery do
5101 >  begin
5102 >    Transaction.Active := true;
5103      ExecQuery;
5104      try
5105 <      Result := FieldByName('ID').AsInteger
5105 >      Result := Fields[0].AsInteger
5106      finally
5107        Close
5108      end;
4928  finally
4929    Free
5109    end;
5110   end;
5111  
# Line 4934 | Line 5113 | constructor TIBGenerator.Create(Owner: T
5113   begin
5114    FOwner := Owner;
5115    FIncrement := 1;
5116 +  FQuery := TIBSQL.Create(nil);
5117 + end;
5118 +
5119 + destructor TIBGenerator.Destroy;
5120 + begin
5121 +  if assigned(FQuery) then FQuery.Free;
5122 +  inherited Destroy;
5123   end;
5124  
5125  
5126   procedure TIBGenerator.Apply;
5127   begin
5128 <  if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5129 <    Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
5128 >  if assigned(Database) and assigned(Transaction) and
5129 >       (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5130 >    Owner.FieldByName(FFieldName).AsInteger := GetNextValue;
5131   end;
5132  
5133  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines