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 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC

# Line 25 | Line 25
25   *
26   *)
27   unit FBArray;
28 + {$IFDEF MSWINDOWS}
29 + {$DEFINE WINDOWS}
30 + {$ENDIF}
31  
32   {$IFDEF FPC}
33 < {$mode objfpc}{$H+}
33 > {$mode delphi}
34   {$codepage UTF8}
35   {$interfaces COM}
36   {$ENDIF}
# Line 35 | 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 69 | Line 72 | type
72  
73    TFBArrayElement = class(TSQLDataItem)
74    private
75 <   FBufPtr: PChar;
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;
82 <   function SQLData: PChar; override;
82 >   function SQLData: PByte; override;
83     function GetDataLength: cardinal; override;
84     function GetCodePage: TSystemCodePage; override;
85     function getCharSetID: cardinal; override;
86     procedure SetDataLength(len: cardinal); override;
87     procedure SetSQLType(aValue: cardinal); override;
88    public
89 <   constructor Create(anArray: TFBArray; P: PChar);
89 >   constructor Create(anArray: TFBArray; P: PByte);
90     function GetSQLType: cardinal; override;
91 <   function GetName: string; override;
91 >   function GetName: AnsiString; override;
92     function GetScale: integer; override;
93     function GetSize: integer;
94 <   function GetAsString: string; override;
94 >   function GetCharSetWidth: integer; override;
95 >   function GetAsString: AnsiString; override;
96     procedure SetAsLong(Value: Long); override;
97     procedure SetAsShort(Value: Short); override;
98     procedure SetAsInt64(Value: Int64); override;
99 <   procedure SetAsString(Value: String); override;
99 >   procedure SetAsString(Value: AnsiString); override;
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 105 | 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: string); virtual; abstract;
116 >               relationName, columnName: AnsiString); virtual; abstract;
117     function NumOfElements: integer;
118    public
119     constructor Create(aAttachment: IAttachment; aTransaction: ITransaction;
120 <     relationName, columnName: string); overload;
121 <   constructor Create(SQLType: cardinal; tableName: string; columnName: string;
120 >     relationName, columnName: AnsiString); overload;
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 119 | Line 126 | type
126    public
127     {IArrayMetaData}
128     function GetSQLType: cardinal;
129 <   function GetSQLTypeName: string;
129 >   function GetSQLTypeName: AnsiString;
130     function GetScale: integer;
131     function GetSize: cardinal;
132     function GetCharSetID: cardinal; virtual; abstract;
133 <   function GetTableName: string;
134 <   function GetColumnName: string;
133 >   function GetCharSetWidth: integer; virtual; abstract;
134 >   function GetTableName: AnsiString;
135 >   function GetColumnName: AnsiString;
136     function GetDimensions: integer;
137     function GetBounds: TArrayBounds;
138    end;
# Line 132 | 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 149 | Line 158 | type
158      FEventHandlers: array of TArrayEventHandler;
159      procedure GetArraySlice;
160      procedure PutArraySlice(Force: boolean=false);
161 <    function GetOffset(index: array of integer): PChar;
161 >    function GetOffset(index: array of integer): PByte;
162      function GetDataLength: short;
163    protected
164 <    FBuffer: PChar;
164 >    FBuffer: PByte;
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 168 | 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
186      {IArrayMetaData}
187      function GetSQLType: cardinal;
188 <    function GetSQLTypeName: string;
188 >    function GetSQLTypeName: AnsiString;
189      function GetScale: integer;
190      function GetSize: cardinal;
191      function GetCharSetID: cardinal;
192 <    function GetTableName: string;
193 <    function GetColumnName: string;
192 >    function GetCharSetWidth: integer;
193 >    function GetTableName: AnsiString;
194 >    function GetColumnName: AnsiString;
195      function GetDimensions: integer;
196      function GetBounds: TArrayBounds;
197      {IArray}
# Line 192 | 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): String;
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: String);
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 225 | 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 242 | Line 272 | begin
272    FArray.Changed;
273   end;
274  
275 < function TFBArrayElement.SQLData: PChar;
275 > function TFBArrayElement.SQLData: PByte;
276   begin
277    Result := FBufPtr;
278   end;
# Line 268 | Line 298 | begin
298      IBError(ibxeArrayElementOverFlow,[nil]);
299   end;
300  
301 < constructor TFBArrayElement.Create(anArray: TFBArray; P: PChar);
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 280 | Line 310 | begin
310    Result :=  FArray.FMetaData.GetSQLType;
311   end;
312  
313 < function TFBArrayElement.GetName: string;
313 > function TFBArrayElement.GetName: AnsiString;
314   begin
315    Result := FArray.FMetaData.GetColumnName;
316   end;
# Line 295 | Line 325 | begin
325    Result := GetDataLength;
326   end;
327  
328 < function TFBArrayElement.GetAsString: string;
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
336    case GetSQLType of
337    SQL_VARYING:
338      begin
339 <      rs := strpas(FBufPtr);
339 >      rs := strpas(PAnsiChar(FBufPtr));
340        SetCodePage(rs,GetCodePage,false);
341        Result := rs;
342      end;
343    SQL_TEXT:
344      begin
345 <      SetString(rs,FBufPtr,GetDataLength);
345 >      SetString(rs,PAnsiChar(FBufPtr),GetDataLength);
346        SetCodePage(rs,GetCodePage,false);
347        Result := rs;
348      end
# Line 349 | Line 384 | begin
384    Changed;
385   end;
386  
387 < procedure TFBArrayElement.SetAsString(Value: String);
387 > procedure TFBArrayElement.SetAsString(Value: AnsiString);
388   var len: integer;
389      ElementSize: integer;
390   begin
391    CheckActive;
392    case GetSQLType of
393    SQL_BOOLEAN:
394 <    if CompareText(Value,STrue) = 0 then
394 >    if AnsiCompareText(Value,STrue) = 0 then
395        AsBoolean := true
396      else
397 <    if CompareText(Value,SFalse) = 0 then
397 >    if AnsiCompareText(Value,SFalse) = 0 then
398        AsBoolean := false
399      else
400        IBError(ibxeInvalidDataConversion,[nil]);
# Line 374 | Line 409 | begin
409        if Len > 0 then
410          Move(Value[1],FBufPtr^,len);
411        if Len < ElementSize - 2 then
412 <        (FBufPtr+len)^ := #0;
412 >        (FBufPtr+len)^ := 0;
413        Changed;
414      end;
415  
# Line 395 | Line 430 | begin
430      if trim(Value) = '' then
431        SetAsInt64(0)
432      else
433 <      SetAsInt64(StrToInt(Value));
433 >      SetAsInt64(AdjustScaleFromCurrency(StrToCurr(Value),GetScale));
434  
435    SQL_D_FLOAT,
436    SQL_DOUBLE,
# Line 471 | 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  
538   {TFBArrayMetaData}
539  
540   constructor TFBArrayMetaData.Create(aAttachment: IAttachment;
541 <  aTransaction: ITransaction; relationName, columnName: string);
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: string;
549 <  columnName: string; 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);
559 <    array_desc_scale := char(Scale);
559 >    array_desc_scale := Scale;
560      array_desc_length := UShort(size);
561      StrPLCopy(array_desc_field_name,columnName,sizeof(array_desc_field_name));
562      StrPLCopy(array_desc_relation_name,tableName,sizeof(array_desc_relation_name));
# Line 537 | 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  
618 < function TFBArrayMetaData.GetSQLTypeName: string;
618 > function TFBArrayMetaData.GetSQLTypeName: AnsiString;
619   begin
620    Result := TSQLDataItem.GetSQLTypeName(GetSQLType);
621   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 555 | Line 630 | begin
630    Result := FArrayDesc.array_desc_length;
631   end;
632  
633 < function TFBArrayMetaData.GetTableName: string;
633 > function TFBArrayMetaData.GetTableName: AnsiString;
634   begin
635    with FArrayDesc do
636 <   SetString(Result,PChar(@array_desc_relation_name),sizeof(array_desc_relation_name));
636 >   SetString(Result,PAnsiChar(@array_desc_relation_name),sizeof(array_desc_relation_name));
637    Result := trim(Result);
638   end;
639  
640 < function TFBArrayMetaData.GetColumnName: string;
640 > function TFBArrayMetaData.GetColumnName: AnsiString;
641   begin
642    with FArrayDesc do
643 <    SetString(Result,PChar(@FArrayDesc.array_desc_field_name),sizeof(array_desc_field_name));
643 >    SetString(Result,PAnsiChar(@FArrayDesc.array_desc_field_name),sizeof(array_desc_field_name));
644    Result := trim(Result);
645   end;
646  
# Line 610 | 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 620 | Line 709 | begin
709    Result := 1;
710    Bounds := GetBounds;
711    for i := 0 to Length(Bounds) - 1 do
712 <    Result *= (Bounds[i].UpperBound - Bounds[i].LowerBound + 1);
712 >    Result := Result * (Bounds[i].UpperBound - Bounds[i].LowerBound + 1);
713   end;
714  
715  
# Line 643 | Line 732 | begin
732      FElementSize := FArrayDesc.array_desc_length;
733      case GetSQLType of
734      SQL_VARYING:
735 <      FElementSize += 2;
735 >      FElementSize := FElementSize + 2;
736      SQL_TEXT:
737 <      FElementSize += 1;
737 >      FElementSize := FElementSize + 1;
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 703 | Line 792 | begin
792    FIsNew := false;
793   end;
794  
795 < function TFBArray.GetOffset(index: array of integer): PChar;
795 > function TFBArray.GetOffset(index: array of integer): PByte;
796   var i: integer;
797      Bounds: TArrayBounds;
798      FlatIndex: integer;
# Line 718 | Line 807 | begin
807      if (index[i] < Bounds[i].LowerBound) or (index[i] > Bounds[i].UpperBound) then
808        IBError(ibxeInvalidSubscript,[index[i],i]);
809  
810 <    FlatIndex += FOffsets[i]*(index[i] - Bounds[i].LowerBound);
810 >    FlatIndex := FlatIndex + FOffsets[i]*(index[i] - Bounds[i].LowerBound);
811    end;
812    Result := FBuffer + FlatIndex*FElementSize;
813   end;
# Line 738 | 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 756 | 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 817 | 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 826 | Line 917 | begin
917    Result := FMetaData.GetSQLType;
918   end;
919  
920 < function TFBArray.GetSQLTypeName: string;
920 > function TFBArray.GetSQLTypeName: AnsiString;
921   begin
922    Result := FMetaData.GetSQLTypeName;
923   end;
# Line 846 | Line 937 | begin
937    Result := FMetaData.GetCharSetID;
938   end;
939  
940 < function TFBArray.GetTableName: string;
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;
948   end;
949  
950 < function TFBArray.GetColumnName: string;
950 > function TFBArray.GetColumnName: AnsiString;
951   begin
952    Result := FMetaData.GetColumnName;
953   end;
# Line 901 | 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 929 | Line 1065 | begin
1065    Result := FElement.GetAsShort;
1066   end;
1067  
1068 < function TFBArray.GetAsString(index: array of integer): String;
1068 > function TFBArray.GetAsString(index: array of integer): AnsiString;
1069   begin
1070    GetArraySlice;
1071    FElement.FBufPtr := GetOffset(index);
# Line 943 | 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 985 | 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 1009 | Line 1187 | begin
1187    FElement.SetAsShort(Value);
1188   end;
1189  
1190 < procedure TFBArray.SetAsString(index: array of integer; Value: String);
1190 > procedure TFBArray.SetAsString(index: array of integer; Value: AnsiString);
1191   begin
1192    FElement.FBufPtr := GetOffset(index);
1193    FElement.SetAsString(Value);
# Line 1021 | 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
# Line 1062 | Line 1246 | procedure TFBArray.RemoveEventHandler(Ha
1246   var i,j : integer;
1247   begin
1248    for i := Length(FEventHandlers) - 1 downto 0 do
1249 <    if FEventHandlers[i] = Handler then
1249 >    if (TMethod(FEventHandlers[i]).Code = TMethod(Handler).Code) and
1250 >      (TMethod(FEventHandlers[i]).Data = TMethod(Handler).Data) then
1251      begin
1252        for j := i to Length(FEventHandlers) - 2 do
1253          FEventHandlers[i] := FEventHandlers[i+1];

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines