ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBArray.pas
(Generate patch)

Comparing ibx/trunk/fbintf/client/FBArray.pas (file contents):
Revision 59 by tony, Mon Mar 13 09:51:56 2017 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC

# Line 38 | Line 38 | unit FBArray;
38   interface
39  
40   uses
41 <  Classes, SysUtils, IB, IBHeader, FBTransaction,
42 <  FBSQLData,  FBClientAPI, IBExternals, FBActivityMonitor;
41 >  Classes, SysUtils, IBHeader, IB,  FBTransaction,
42 >  FBSQLData,  FBClientAPI, IBExternals, FBActivityMonitor, FmtBCD;
43  
44   (*
45  
# Line 75 | Line 75 | type
75     FBufPtr: PByte;
76     FArray: TFBArray;
77    protected
78 +   function GetAttachment: IAttachment; override;
79     function GetSQLDialect: integer; override;
80     procedure Changing; override;
81     procedure Changed; override;
# Line 90 | Line 91 | type
91     function GetName: AnsiString; override;
92     function GetScale: integer; override;
93     function GetSize: integer;
94 +   function GetCharSetWidth: integer; override;
95     function GetAsString: AnsiString; override;
96     procedure SetAsLong(Value: Long); override;
97     procedure SetAsShort(Value: Short); override;
# Line 98 | Line 100 | type
100     procedure SetAsDouble(Value: Double); override;
101     procedure SetAsFloat(Value: Float); override;
102     procedure SetAsCurrency(Value: Currency); override;
103 +   procedure SetAsBcd(aValue: tBCD); override;
104    end;
105  
106    { TFBArrayMetaData }
# Line 108 | Line 111 | type
111    protected
112     FArrayDesc: TISC_ARRAY_DESC;
113     FCharSetID: integer;
114 +   FAttachment: IAttachment;
115     procedure LoadMetaData(aAttachment: IAttachment; aTransaction: ITransaction;
116                 relationName, columnName: AnsiString); virtual; abstract;
117     function NumOfElements: integer;
118    public
119     constructor Create(aAttachment: IAttachment; aTransaction: ITransaction;
120       relationName, columnName: AnsiString); overload;
121 <   constructor Create(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
121 >   constructor Create(aAttachment: IAttachment;SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
122       Scale: integer; size: cardinal; charSetID: cardinal;
123       dimensions: cardinal; bounds: TArrayBounds); overload;
124     function GetCodePage: TSystemCodePage; virtual; abstract;
# Line 126 | Line 130 | type
130     function GetScale: integer;
131     function GetSize: cardinal;
132     function GetCharSetID: cardinal; virtual; abstract;
133 +   function GetCharSetWidth: integer; virtual; abstract;
134     function GetTableName: AnsiString;
135     function GetColumnName: AnsiString;
136     function GetDimensions: integer;
# Line 135 | Line 140 | type
140  
141    { TFBArray }
142  
143 <  TFBArray = class(TActivityReporter,IArray)
143 >  TFBArray = class(TActivityReporter,IArray,ITransactionUser)
144    private
145 +    FFirebirdClientAPI: TFBClientAPI;
146      FMetaData: IArrayMetaData;
147      FIsNew: boolean;
148      FLoaded: boolean;
# Line 159 | Line 165 | type
165      FBufSize: ISC_LONG;
166      FArrayID: TISC_QUAD;
167      procedure AllocateBuffer; virtual;
168 <    procedure Changing;
169 <    procedure Changed;
168 >    procedure Changing; virtual;
169 >    procedure Changed;  virtual;
170      function GetArrayDesc: PISC_ARRAY_DESC;
171      procedure InternalGetSlice; virtual; abstract;
172      procedure InternalPutSlice(Force: boolean); virtual; abstract;
# Line 171 | Line 177 | type
177        aField: IArrayMetaData; ArrayID: TISC_QUAD); overload;
178      destructor Destroy; override;
179      function GetSQLDialect: integer;
180 +
181 +  public
182 +    {ITransactionUser}
183      procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
184  
185     public
# Line 180 | Line 189 | type
189      function GetScale: integer;
190      function GetSize: cardinal;
191      function GetCharSetID: cardinal;
192 +    function GetCharSetWidth: integer;
193      function GetTableName: AnsiString;
194      function GetColumnName: AnsiString;
195      function GetDimensions: integer;
# Line 195 | Line 205 | type
205      function GetAsBoolean(index: array of integer): boolean;
206      function GetAsCurrency(index: array of integer): Currency;
207      function GetAsInt64(index: array of integer): Int64;
208 <    function GetAsDateTime(index: array of integer): TDateTime;
208 >    function GetAsDateTime(index: array of integer): TDateTime; overload;
209 >    procedure GetAsDateTime(index: array of integer; var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
210 >    procedure GetAsDateTime(index: array of integer; var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
211 >    procedure GetAsTime(index: array of integer; var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
212 >    procedure GetAsTime(index: array of integer; var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
213 >    function GetAsUTCDateTime(index: array of integer): TDateTime;
214      function GetAsDouble(index: array of integer): Double;
215      function GetAsFloat(index: array of integer): Float;
216      function GetAsLong(index: array of integer): Long;
217      function GetAsShort(index: array of integer): Short;
218      function GetAsString(index: array of integer): AnsiString;
219      function GetAsVariant(index: array of integer): Variant;
220 +    function GetAsBCD(index: array of integer): tBCD;
221      procedure SetAsInteger(index: array of integer; AValue: integer);
222      procedure SetAsBoolean(index: array of integer; AValue: boolean);
223      procedure SetAsCurrency(index: array of integer; Value: Currency);
224      procedure SetAsInt64(index: array of integer; Value: Int64);
225      procedure SetAsDate(index: array of integer; Value: TDateTime);
226      procedure SetAsLong(index: array of integer; Value: Long);
227 <    procedure SetAsTime(index: array of integer; Value: TDateTime);
228 <    procedure SetAsDateTime(index: array of integer; Value: TDateTime);
227 >    procedure SetAsTime(index: array of integer; Value: TDateTime); overload;
228 >    procedure SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
229 >    procedure SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
230 >    procedure SetAsDateTime(index: array of integer; Value: TDateTime); overload;
231 >    procedure SetAsDateTime(index: array of integer; aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
232 >    procedure SetAsDateTime(index: array of integer; aValue: TDateTime; aTimeZone: AnsiString); overload;
233 >    procedure SetAsUTCDateTime(index: array of integer; aUTCTime: TDateTime);
234      procedure SetAsDouble(index: array of integer; Value: Double);
235      procedure SetAsFloat(index: array of integer; Value: Float);
236      procedure SetAsShort(index: array of integer; Value: Short);
237      procedure SetAsString(index: array of integer; Value: AnsiString);
238      procedure SetAsVariant(index: array of integer; Value: Variant);
239 +    procedure SetAsBcd(index: array of integer; aValue: tBCD);
240      procedure SetBounds(dim, UpperBound, LowerBound: integer);
241      function GetAttachment: IAttachment;
242      function GetTransaction: ITransaction;
# Line 228 | Line 250 | uses FBMessages;
250  
251   { TFBArrayElement }
252  
253 + function TFBArrayElement.GetAttachment: IAttachment;
254 + begin
255 +  Result := FArray.GetAttachment;
256 + end;
257 +
258   function TFBArrayElement.GetSQLDialect: integer;
259   begin
260    Result := FArray.GetSQLDialect;
# Line 273 | Line 300 | end;
300  
301   constructor TFBArrayElement.Create(anArray: TFBArray; P: PByte);
302   begin
303 <  inherited Create;
303 >  inherited Create(anArray.FFirebirdClientAPI);
304    FArray := anArray;
305    FBufPtr := P;
306   end;
# Line 298 | Line 325 | begin
325    Result := GetDataLength;
326   end;
327  
328 + function TFBArrayElement.GetCharSetWidth: integer;
329 + begin
330 +  Result := FArray.FMetaData.GetCharSetWidth;
331 + end;
332 +
333   function TFBArrayElement.GetAsString: AnsiString;
334   var rs: RawByteString;
335   begin
# Line 474 | Line 506 | begin
506    end
507   end;
508  
509 + procedure TFBArrayElement.SetAsBcd(aValue: tBCD);
510 + var C: Currency;
511 + begin
512 +  CheckActive;
513 +  with FirebirdClientAPI do
514 +  case SQLType of
515 +  SQL_DEC_FIXED,
516 +  SQL_DEC16,
517 +  SQL_DEC34:
518 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
519 +
520 +  SQL_INT128:
521 +    StrToInt128(Scale,BcdToStr(aValue),SQLData);
522 +
523 +  else
524 +    begin
525 +      BCDToCurr(aValue,C);
526 +      SetAsCurrency(C);
527 +    end;
528 +  end;
529 +  Changed;
530 + end;
531 +
532   procedure TFBArrayElement.SetSQLType(aValue: cardinal);
533   begin
534 <  if aValue = GetSQLType then
534 >  if aValue <> GetSQLType then
535      IBError(ibxeInvalidDataConversion, [nil]);
536   end;
537  
# Line 486 | Line 541 | constructor TFBArrayMetaData.Create(aAtt
541    aTransaction: ITransaction; relationName, columnName: AnsiString);
542   begin
543    inherited Create;
544 +  FAttachment := aAttachment;
545    LoadMetaData(aAttachment,aTransaction,relationName, columnName);
546   end;
547  
548 < constructor TFBArrayMetaData.Create(SQLType: cardinal; tableName: AnsiString;
549 <  columnName: AnsiString; Scale: integer; size: cardinal; charSetID: cardinal;
550 <  dimensions: cardinal; bounds: TArrayBounds);
548 > constructor TFBArrayMetaData.Create(aAttachment: IAttachment;
549 >  SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
550 >  Scale: integer; size: cardinal; charSetID: cardinal; dimensions: cardinal;
551 >  bounds: TArrayBounds);
552   var i: integer;
553   begin
554    inherited Create;
555 +  FAttachment := aAttachment;
556    with FArrayDesc do
557    begin
558      array_desc_dtype := GetDType(SQLType);
# Line 540 | Line 598 | begin
598      Result :=  SQL_TYPE_TIME;
599    blr_int64:
600      Result := SQL_INT64;
601 +  blr_sql_time_tz:
602 +    Result := SQL_TIME_TZ;
603 +  blr_timestamp_tz:
604 +    Result := SQL_TIMESTAMP_TZ;
605 +  blr_ex_time_tz:
606 +    Result := SQL_TIME_TZ_EX;
607 +  blr_ex_timestamp_tz:
608 +    Result := SQL_TIMESTAMP_TZ_EX;
609 +  blr_dec64:
610 +    Result := SQL_DEC16;
611 +  blr_dec128:
612 +    Result := SQL_DEC34;
613 +  blr_int128:
614 +    Result := SQL_INT128;
615    end;
616   end;
617  
# Line 550 | Line 622 | end;
622  
623   function TFBArrayMetaData.GetScale: integer;
624   begin
625 <  Result := byte(FArrayDesc.array_desc_scale);
625 >  Result := FArrayDesc.array_desc_scale;
626   end;
627  
628   function TFBArrayMetaData.GetSize: cardinal;
# Line 613 | Line 685 | begin
685      Result :=  blr_sql_time;
686    SQL_INT64:
687      Result := blr_int64;
688 +  SQL_TIME_TZ:
689 +    Result := blr_sql_time_tz;
690 +  SQL_TIMESTAMP_TZ:
691 +    Result := blr_timestamp_tz;
692 +  SQL_TIME_TZ_EX:
693 +    Result := blr_ex_time_tz;
694 +  SQL_TIMESTAMP_TZ_EX:
695 +    Result := blr_ex_timestamp_tz;
696 +  SQL_DEC16:
697 +    Result := blr_dec64;
698 +  SQL_DEC34:
699 +    Result := blr_dec128;
700 +  SQL_INT128:
701 +    Result := blr_int128;
702    end;
703   end;
704  
# Line 652 | Line 738 | begin
738      end;
739      FBufSize := FElementSize * l;
740  
741 <    with FirebirdClientAPI do
741 >    with FFirebirdClientAPI do
742        IBAlloc(FBuffer,0,FBufSize);
743  
744      Dims := GetDimensions;
# Line 741 | Line 827 | begin
827    inherited Create(aTransaction);
828    FMetaData := aField;
829    FAttachment := aAttachment;
830 +  FFirebirdClientAPI := aTransaction.FirebirdAPI;
831    FTransactionIntf :=  aTransaction;
832    FTransactionSeqNo := aTransaction.TransactionSeqNo;
833    FIsNew := true;
# Line 759 | Line 846 | begin
846    FMetaData := aField;
847    FArrayID := ArrayID;
848    FAttachment := aAttachment;
849 +  FFirebirdClientAPI := aTransaction.FirebirdAPI;
850    FTransactionIntf :=  aTransaction;
851    FTransactionSeqNo := aTransaction.TransactionSeqNo;
852    FIsNew := false;
# Line 820 | Line 908 | end;
908   procedure TFBArray.TransactionEnding(aTransaction: ITransaction; Force: boolean
909    );
910   begin
911 <  if (aTransaction = FTransactionIntf) and FModified and not FIsNew then
911 >  if ((aTransaction as TObject) = (FTransactionIntf as TObject)) and FModified and not FIsNew then
912      PutArraySlice(Force);
913   end;
914  
# Line 849 | Line 937 | begin
937    Result := FMetaData.GetCharSetID;
938   end;
939  
940 + function TFBArray.GetCharSetWidth: integer;
941 + begin
942 +  Result := FMetaData.GetCharSetWidth;
943 + end;
944 +
945   function TFBArray.GetTableName: AnsiString;
946   begin
947    Result := FMetaData.GetTableName;
# Line 904 | Line 997 | begin
997    Result := FElement.GetAsDateTime;
998   end;
999  
1000 + procedure TFBArray.GetAsDateTime(index: array of integer;
1001 +  var aDateTime: TDateTime; var dstOffset: smallint;
1002 +  var aTimezoneID: TFBTimeZoneID);
1003 + begin
1004 +  GetArraySlice;
1005 +  FElement.FBufPtr := GetOffset(index);
1006 +  FElement.GetAsDateTime(aDateTime,dstOffset,aTimezoneID);
1007 + end;
1008 +
1009 + procedure TFBArray.GetAsDateTime(index: array of integer;
1010 +  var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString);
1011 + begin
1012 +  GetArraySlice;
1013 +  FElement.FBufPtr := GetOffset(index);
1014 +  FElement.GetAsDateTime(aDateTime,dstOffset,aTimezone);
1015 + end;
1016 +
1017 + procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime;
1018 +  var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1019 + begin
1020 +  GetArraySlice;
1021 +  FElement.FBufPtr := GetOffset(index);
1022 +  FElement.GetAsTime(aTime,dstOffset,aTimezoneID,OnDate);
1023 + end;
1024 +
1025 + procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime;
1026 +  var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime);
1027 + begin
1028 +  GetArraySlice;
1029 +  FElement.FBufPtr := GetOffset(index);
1030 +  FElement.GetAsTime(aTime,dstOffset,aTimezone,OnDate);
1031 + end;
1032 +
1033 + function TFBArray.GetAsUTCDateTime(index: array of integer): TDateTime;
1034 + begin
1035 +  GetArraySlice;
1036 +  FElement.FBufPtr := GetOffset(index);
1037 +  Result := FElement.GetAsUTCDateTime;
1038 + end;
1039 +
1040   function TFBArray.GetAsDouble(index: array of integer): Double;
1041   begin
1042    GetArraySlice;
# Line 946 | Line 1079 | begin
1079    Result := FElement.GetAsVariant;
1080   end;
1081  
1082 + function TFBArray.GetAsBCD(index: array of integer): tBCD;
1083 + begin
1084 +  GetArraySlice;
1085 +  FElement.FBufPtr := GetOffset(index);
1086 +  Result := FElement.GetAsBCD;
1087 + end;
1088 +
1089   procedure TFBArray.SetAsInteger(index: array of integer; AValue: integer);
1090   begin
1091    FElement.FBufPtr := GetOffset(index);
# Line 988 | Line 1128 | begin
1128    FElement.SetAsTime(Value);
1129   end;
1130  
1131 + procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime;
1132 +  aTimeZoneID: TFBTimeZoneID);
1133 + begin
1134 +  FElement.FBufPtr := GetOffset(index);
1135 +  FElement.SetAsTime(aValue,OnDate,aTimeZoneID);
1136 + end;
1137 +
1138 + procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime;
1139 +  aTimeZone: AnsiString);
1140 + begin
1141 +  FElement.FBufPtr := GetOffset(index);
1142 +  FElement.SetAsTime(aValue,OnDate, aTimeZone);
1143 + end;
1144 +
1145   procedure TFBArray.SetAsDateTime(index: array of integer; Value: TDateTime);
1146   begin
1147    FElement.FBufPtr := GetOffset(index);
1148    FElement.SetAsDateTime(Value);
1149   end;
1150  
1151 + procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime;
1152 +  aTimeZoneID: TFBTimeZoneID);
1153 + begin
1154 +  FElement.FBufPtr := GetOffset(index);
1155 +  FElement.SetAsDateTime(aValue,aTimeZoneID);
1156 + end;
1157 +
1158 + procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime;
1159 +  aTimeZone: AnsiString);
1160 + begin
1161 +  FElement.FBufPtr := GetOffset(index);
1162 +  FElement.SetAsDateTime(aValue,aTimeZone);
1163 + end;
1164 +
1165 + procedure TFBArray.SetAsUTCDateTime(index: array of integer;
1166 +  aUTCTime: TDateTime);
1167 + begin
1168 +  FElement.FBufPtr := GetOffset(index);
1169 +  FElement.SetAsUTCDateTime(aUTCTime);
1170 + end;
1171 +
1172   procedure TFBArray.SetAsDouble(index: array of integer; Value: Double);
1173   begin
1174    FElement.FBufPtr := GetOffset(index);
# Line 1024 | Line 1199 | begin
1199    FElement.SetAsVariant(Value);
1200   end;
1201  
1202 + procedure TFBArray.SetAsBcd(index: array of integer; aValue: tBCD);
1203 + begin
1204 +  FElement.FBufPtr := GetOffset(index);
1205 +  FElement.SetAsBcd(aValue);
1206 + end;
1207 +
1208   procedure TFBArray.SetBounds(dim, UpperBound, LowerBound: integer);
1209   begin
1210    with (FMetaData as TFBArrayMetaData) do

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines