ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBArray.pas
Revision: 362
Committed: Tue Dec 7 13:27:39 2021 UTC (2 years, 3 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/branches/journaling/fbintf/client/FBArray.pas
File size: 35364 byte(s)
Log Message:
initiate test release

File Contents

# User Rev Content
1 tony 45 (*
2     * Firebird Interface (fbintf). The fbintf components provide a set of
3     * Pascal language bindings for the Firebird API.
4     *
5     * The contents of this file are subject to the Initial Developer's
6     * Public License Version 1.0 (the "License"); you may not use this
7     * file except in compliance with the License. You may obtain a copy
8     * of the License here:
9     *
10     * http://www.firebirdsql.org/index.php?op=doc&id=idpl
11     *
12     * Software distributed under the License is distributed on an "AS
13     * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14     * implied. See the License for the specific language governing rights
15     * and limitations under the License.
16     *
17     * The Initial Developer of the Original Code is Tony Whyman.
18     *
19     * The Original Code is (C) 2016 Tony Whyman, MWA Software
20     * (http://www.mwasoftware.co.uk).
21     *
22     * All Rights Reserved.
23     *
24     * Contributor(s): ______________________________________.
25     *
26     *)
27     unit FBArray;
28 tony 56 {$IFDEF MSWINDOWS}
29     {$DEFINE WINDOWS}
30     {$ENDIF}
31 tony 45
32     {$IFDEF FPC}
33 tony 56 {$mode delphi}
34 tony 45 {$codepage UTF8}
35     {$interfaces COM}
36     {$ENDIF}
37    
38     interface
39    
40     uses
41 tony 315 Classes, SysUtils, IBHeader, IB, FBTransaction,
42     FBSQLData, FBClientAPI, IBExternals, FBActivityMonitor, FmtBCD;
43 tony 45
44     (*
45    
46     COMMENTS (copied from IBPP)
47    
48     1)
49     For an array column of type CHAR(X), the internal type returned or expected is blr_text.
50     In such case, the byte array received or submitted to get/put_slice is formatted in
51     elements of X bytes, which correspond to what is reported in array_desc_length.
52     The elements are not '\0' terminated but are right-padded with spaces ' '.
53    
54     2)
55     For an array column of type VARCHAR(X), the internal type is blr_varying.
56     The underlying format is rather curious and different than what is used in XSQLDA.
57     The element size is reported in array_desc_length as X.
58     Yet each element of the byte array is expected to be of size X+2 (just as if we were
59     to stuff a short in the first 2 bytes to store the length (as is done with XSQLDA).
60     No. The string of X characters maximum has to be stored in the chunks of X+2 bytes as
61     a zero-terminated c-string. Note that the buffer is indeed one byte too large.
62     Internally, the API probably convert in-place in these chunks the zero-terminated string
63     to a variable-size string with a short in front and the string data non zero-terminated
64     behind.
65    
66     *)
67    
68     type
69     TFBArray = class;
70    
71     { TFBArrayElement }
72    
73     TFBArrayElement = class(TSQLDataItem)
74     private
75 tony 56 FBufPtr: PByte;
76 tony 45 FArray: TFBArray;
77     protected
78 tony 315 function GetAttachment: IAttachment; override;
79 tony 45 function GetSQLDialect: integer; override;
80     procedure Changing; override;
81     procedure Changed; override;
82 tony 56 function SQLData: PByte; override;
83 tony 45 function GetDataLength: cardinal; override;
84     function GetCodePage: TSystemCodePage; override;
85 tony 47 function getCharSetID: cardinal; override;
86 tony 45 procedure SetDataLength(len: cardinal); override;
87     procedure SetSQLType(aValue: cardinal); override;
88     public
89 tony 56 constructor Create(anArray: TFBArray; P: PByte);
90 tony 45 function GetSQLType: cardinal; override;
91 tony 56 function GetName: AnsiString; override;
92 tony 45 function GetScale: integer; override;
93     function GetSize: integer;
94 tony 309 function GetCharSetWidth: integer; override;
95 tony 56 function GetAsString: AnsiString; override;
96 tony 45 procedure SetAsLong(Value: Long); override;
97     procedure SetAsShort(Value: Short); override;
98     procedure SetAsInt64(Value: Int64); override;
99 tony 56 procedure SetAsString(Value: AnsiString); override;
100 tony 45 procedure SetAsDouble(Value: Double); override;
101     procedure SetAsFloat(Value: Float); override;
102     procedure SetAsCurrency(Value: Currency); override;
103 tony 315 procedure SetAsBcd(aValue: tBCD); override;
104 tony 353 procedure SetAsNumeric(Value: Int64; aScale: integer); override;
105 tony 45 end;
106    
107     { TFBArrayMetaData }
108    
109     TFBArrayMetaData = class(TFBInterfacedObject,IArrayMetaData)
110 tony 47 private
111     function GetDType(SQLType: cardinal): UChar;
112 tony 45 protected
113     FArrayDesc: TISC_ARRAY_DESC;
114 tony 47 FCharSetID: integer;
115 tony 60 FAttachment: IAttachment;
116 tony 45 procedure LoadMetaData(aAttachment: IAttachment; aTransaction: ITransaction;
117 tony 56 relationName, columnName: AnsiString); virtual; abstract;
118 tony 45 function NumOfElements: integer;
119     public
120     constructor Create(aAttachment: IAttachment; aTransaction: ITransaction;
121 tony 56 relationName, columnName: AnsiString); overload;
122 tony 60 constructor Create(aAttachment: IAttachment;SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
123 tony 47 Scale: integer; size: cardinal; charSetID: cardinal;
124     dimensions: cardinal; bounds: TArrayBounds); overload;
125 tony 45 function GetCodePage: TSystemCodePage; virtual; abstract;
126    
127     public
128     {IArrayMetaData}
129     function GetSQLType: cardinal;
130 tony 56 function GetSQLTypeName: AnsiString;
131 tony 45 function GetScale: integer;
132     function GetSize: cardinal;
133     function GetCharSetID: cardinal; virtual; abstract;
134 tony 309 function GetCharSetWidth: integer; virtual; abstract;
135 tony 56 function GetTableName: AnsiString;
136     function GetColumnName: AnsiString;
137 tony 45 function GetDimensions: integer;
138     function GetBounds: TArrayBounds;
139     end;
140    
141    
142     { TFBArray }
143    
144 tony 315 TFBArray = class(TActivityReporter,IArray,ITransactionUser)
145 tony 45 private
146 tony 263 FFirebirdClientAPI: TFBClientAPI;
147 tony 45 FMetaData: IArrayMetaData;
148     FIsNew: boolean;
149     FLoaded: boolean;
150     FModified: boolean;
151     FAttachment: IAttachment;
152     FTransactionIntf: ITransaction;
153     FTransactionSeqNo: integer;
154     FSQLDialect: integer;
155     FOffsets: array of integer;
156     FElement: TFBArrayElement;
157     FElementIntf: IUnknown;
158     FElementSize: integer;
159     FEventHandlers: array of TArrayEventHandler;
160     procedure GetArraySlice;
161     procedure PutArraySlice(Force: boolean=false);
162 tony 56 function GetOffset(index: array of integer): PByte;
163 tony 45 function GetDataLength: short;
164     protected
165 tony 56 FBuffer: PByte;
166 tony 45 FBufSize: ISC_LONG;
167     FArrayID: TISC_QUAD;
168     procedure AllocateBuffer; virtual;
169 tony 291 procedure Changing; virtual;
170     procedure Changed; virtual;
171 tony 45 function GetArrayDesc: PISC_ARRAY_DESC;
172     procedure InternalGetSlice; virtual; abstract;
173     procedure InternalPutSlice(Force: boolean); virtual; abstract;
174     public
175     constructor Create(aAttachment: IAttachment; aTransaction: TFBTransaction;
176     aField: IArrayMetaData); overload;
177     constructor Create(aAttachment: IAttachment; aTransaction: TFBTransaction;
178     aField: IArrayMetaData; ArrayID: TISC_QUAD); overload;
179     destructor Destroy; override;
180     function GetSQLDialect: integer;
181 tony 315
182     public
183     {ITransactionUser}
184 tony 45 procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
185    
186     public
187     {IArrayMetaData}
188     function GetSQLType: cardinal;
189 tony 56 function GetSQLTypeName: AnsiString;
190 tony 45 function GetScale: integer;
191     function GetSize: cardinal;
192     function GetCharSetID: cardinal;
193 tony 309 function GetCharSetWidth: integer;
194 tony 56 function GetTableName: AnsiString;
195     function GetColumnName: AnsiString;
196 tony 45 function GetDimensions: integer;
197     function GetBounds: TArrayBounds;
198     {IArray}
199     function GetArrayID: TISC_QUAD;
200     procedure Clear;
201     function IsEmpty: boolean;
202     procedure PreLoad;
203     procedure CancelChanges;
204     procedure SaveChanges;
205     function GetAsInteger(index: array of integer): integer;
206     function GetAsBoolean(index: array of integer): boolean;
207     function GetAsCurrency(index: array of integer): Currency;
208     function GetAsInt64(index: array of integer): Int64;
209 tony 315 function GetAsDateTime(index: array of integer): TDateTime; overload;
210     procedure GetAsDateTime(index: array of integer; var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
211     procedure GetAsDateTime(index: array of integer; var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
212     procedure GetAsTime(index: array of integer; var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
213     procedure GetAsTime(index: array of integer; var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
214     function GetAsUTCDateTime(index: array of integer): TDateTime;
215 tony 45 function GetAsDouble(index: array of integer): Double;
216     function GetAsFloat(index: array of integer): Float;
217     function GetAsLong(index: array of integer): Long;
218     function GetAsShort(index: array of integer): Short;
219 tony 56 function GetAsString(index: array of integer): AnsiString;
220 tony 45 function GetAsVariant(index: array of integer): Variant;
221 tony 315 function GetAsBCD(index: array of integer): tBCD;
222 tony 45 procedure SetAsInteger(index: array of integer; AValue: integer);
223     procedure SetAsBoolean(index: array of integer; AValue: boolean);
224     procedure SetAsCurrency(index: array of integer; Value: Currency);
225     procedure SetAsInt64(index: array of integer; Value: Int64);
226     procedure SetAsDate(index: array of integer; Value: TDateTime);
227     procedure SetAsLong(index: array of integer; Value: Long);
228 tony 315 procedure SetAsTime(index: array of integer; Value: TDateTime); overload;
229     procedure SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
230     procedure SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
231     procedure SetAsDateTime(index: array of integer; Value: TDateTime); overload;
232     procedure SetAsDateTime(index: array of integer; aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
233     procedure SetAsDateTime(index: array of integer; aValue: TDateTime; aTimeZone: AnsiString); overload;
234     procedure SetAsUTCDateTime(index: array of integer; aUTCTime: TDateTime);
235 tony 45 procedure SetAsDouble(index: array of integer; Value: Double);
236     procedure SetAsFloat(index: array of integer; Value: Float);
237     procedure SetAsShort(index: array of integer; Value: Short);
238 tony 56 procedure SetAsString(index: array of integer; Value: AnsiString);
239 tony 45 procedure SetAsVariant(index: array of integer; Value: Variant);
240 tony 315 procedure SetAsBcd(index: array of integer; aValue: tBCD);
241 tony 45 procedure SetBounds(dim, UpperBound, LowerBound: integer);
242     function GetAttachment: IAttachment;
243     function GetTransaction: ITransaction;
244     procedure AddEventHandler(Handler: TArrayEventHandler);
245     procedure RemoveEventHandler(Handler: TArrayEventHandler);
246     end;
247    
248     implementation
249    
250 tony 353 uses FBMessages, IBUtils;
251 tony 45
252     { TFBArrayElement }
253    
254 tony 315 function TFBArrayElement.GetAttachment: IAttachment;
255     begin
256     Result := FArray.GetAttachment;
257     end;
258    
259 tony 45 function TFBArrayElement.GetSQLDialect: integer;
260     begin
261     Result := FArray.GetSQLDialect;
262     end;
263    
264     procedure TFBArrayElement.Changing;
265     begin
266     inherited Changing;
267     FArray.Changing;
268     end;
269    
270     procedure TFBArrayElement.Changed;
271     begin
272     inherited Changed;
273     FArray.Changed;
274     end;
275    
276 tony 56 function TFBArrayElement.SQLData: PByte;
277 tony 45 begin
278     Result := FBufPtr;
279     end;
280    
281     function TFBArrayElement.GetDataLength: cardinal;
282     begin
283     Result := FArray.GetDataLength
284     end;
285    
286     function TFBArrayElement.GetCodePage: TSystemCodePage;
287     begin
288     Result := (FArray.FMetaData as TFBArrayMetaData).GetCodePage;
289     end;
290    
291 tony 47 function TFBArrayElement.getCharSetID: cardinal;
292     begin
293     Result := (FArray.FMetaData as TFBArrayMetaData).GetCharSetID;
294     end;
295    
296 tony 45 procedure TFBArrayElement.SetDataLength(len: cardinal);
297     begin
298     if len > GetDataLength then
299     IBError(ibxeArrayElementOverFlow,[nil]);
300     end;
301    
302 tony 56 constructor TFBArrayElement.Create(anArray: TFBArray; P: PByte);
303 tony 45 begin
304 tony 263 inherited Create(anArray.FFirebirdClientAPI);
305 tony 45 FArray := anArray;
306     FBufPtr := P;
307     end;
308    
309     function TFBArrayElement.GetSQLType: cardinal;
310     begin
311     Result := FArray.FMetaData.GetSQLType;
312     end;
313    
314 tony 56 function TFBArrayElement.GetName: AnsiString;
315 tony 45 begin
316     Result := FArray.FMetaData.GetColumnName;
317     end;
318    
319     function TFBArrayElement.GetScale: integer;
320     begin
321     Result := FArray.FMetaData.GetScale;
322     end;
323    
324     function TFBArrayElement.GetSize: integer;
325     begin
326     Result := GetDataLength;
327     end;
328    
329 tony 309 function TFBArrayElement.GetCharSetWidth: integer;
330     begin
331     Result := FArray.FMetaData.GetCharSetWidth;
332     end;
333    
334 tony 56 function TFBArrayElement.GetAsString: AnsiString;
335 tony 45 var rs: RawByteString;
336     begin
337     case GetSQLType of
338     SQL_VARYING:
339     begin
340 tony 56 rs := strpas(PAnsiChar(FBufPtr));
341 tony 45 SetCodePage(rs,GetCodePage,false);
342     Result := rs;
343     end;
344     SQL_TEXT:
345     begin
346 tony 56 SetString(rs,PAnsiChar(FBufPtr),GetDataLength);
347 tony 45 SetCodePage(rs,GetCodePage,false);
348     Result := rs;
349     end
350     else
351     Result := inherited GetAsString;
352     end;
353     end;
354    
355     procedure TFBArrayElement.SetAsLong(Value: Long);
356     begin
357     AsInt64 := Value;
358     end;
359    
360     procedure TFBArrayElement.SetAsShort(Value: Short);
361     begin
362     AsInt64 := Value;
363     end;
364    
365     procedure TFBArrayElement.SetAsInt64(Value: Int64);
366     begin
367     CheckActive;
368     case GetSQLType of
369     SQL_LONG:
370 tony 353 PLong(SQLData)^ := AdjustScaleToInt64(Value,getScale);
371 tony 45 SQL_SHORT:
372 tony 353 PShort(SQLData)^ := AdjustScaleToInt64(Value,getScale);
373 tony 45 SQL_INT64:
374 tony 353 PInt64(SQLData)^ := AdjustScaleToInt64(Value,getScale);
375 tony 45 SQL_TEXT, SQL_VARYING:
376     SetAsString(IntToStr(Value));
377     SQL_D_FLOAT,
378     SQL_DOUBLE:
379     PDouble(SQLData)^ := Value;
380     SQL_FLOAT:
381     PSingle(SQLData)^ := Value;
382     else
383     IBError(ibxeInvalidDataConversion, [nil]);
384     end;
385     Changed;
386     end;
387    
388 tony 56 procedure TFBArrayElement.SetAsString(Value: AnsiString);
389 tony 45 var len: integer;
390     ElementSize: integer;
391 tony 349 Int64Value: Int64;
392 tony 353 aScale: integer;
393 tony 45 begin
394     CheckActive;
395     case GetSQLType of
396     SQL_BOOLEAN:
397 tony 56 if AnsiCompareText(Value,STrue) = 0 then
398 tony 45 AsBoolean := true
399     else
400 tony 56 if AnsiCompareText(Value,SFalse) = 0 then
401 tony 45 AsBoolean := false
402     else
403     IBError(ibxeInvalidDataConversion,[nil]);
404    
405     SQL_VARYING:
406     begin
407     Value := Transliterate(Value,GetCodePage);
408     len := Length(Value);
409     ElementSize := GetDataLength;
410     if len > ElementSize - 2 then
411     len := ElementSize - 2;
412     if Len > 0 then
413     Move(Value[1],FBufPtr^,len);
414     if Len < ElementSize - 2 then
415 tony 56 (FBufPtr+len)^ := 0;
416 tony 45 Changed;
417     end;
418    
419     SQL_TEXT:
420     begin
421     Value := Transliterate(Value,GetCodePage);
422     ElementSize := GetDataLength;
423     FillChar(FBufPtr^,ElementSize,' ');
424     len := Length(Value);
425     if len > ElementSize - 1 then len := ElementSize - 1;
426     Move(Value[1],FBufPtr^,len);
427     Changed;
428     end;
429    
430     SQL_SHORT,
431     SQL_LONG,
432     SQL_INT64:
433 tony 353 if TryStrToNumeric(Value,Int64Value,aScale) then
434     SetAsNumeric(Int64Value,AScale)
435 tony 45 else
436 tony 349 SetAsCurrency(StrToCurr(Value));
437 tony 45
438     SQL_D_FLOAT,
439     SQL_DOUBLE,
440     SQL_FLOAT:
441 tony 353 if TryStrToNumeric(Value,Int64Value,aScale) then
442     SetAsDouble(NumericToDouble(Int64Value,aScale))
443     else
444     IBError(ibxeInvalidDataConversion,[nil]);
445 tony 45
446 tony 353 SQL_DEC_FIXED,
447     SQL_DEC16,
448     SQL_DEC34,
449     SQL_INT128:
450     SetAsBCD(StrToBCD(Value));
451    
452 tony 45 SQL_TIMESTAMP:
453     SetAsDateTime(StrToDateTime(Value));
454    
455     SQL_TYPE_DATE:
456     SetAsDate(StrToDateTime(Value));
457    
458     SQL_TYPE_TIME:
459     SetAsTime(StrToDateTime(Value));
460    
461     else
462     IBError(ibxeInvalidDataConversion,[nil]);
463     end;
464     end;
465    
466     procedure TFBArrayElement.SetAsDouble(Value: Double);
467     begin
468     CheckActive;
469     case GetSQLType of
470     SQL_D_FLOAT,
471     SQL_DOUBLE:
472     PDouble(SQLData)^ := Value;
473     SQL_FLOAT:
474     PSingle(SQLData)^ := Value;
475     SQL_SHORT:
476     if Scale < 0 then
477     PShort(SQLData)^ := AdjustScaleFromDouble(Value,Scale)
478     else
479     IBError(ibxeInvalidDataConversion, [nil]);
480     SQL_LONG:
481     if Scale < 0 then
482     PLong(SQLData)^ := AdjustScaleFromDouble(Value,Scale)
483     else
484     IBError(ibxeInvalidDataConversion, [nil]);
485     SQL_INT64:
486     if Scale < 0 then
487     PInt64(SQLData)^ := AdjustScaleFromDouble(Value,Scale)
488     else
489     IBError(ibxeInvalidDataConversion, [nil]);
490     SQL_TEXT, SQL_VARYING:
491     AsString := FloatToStr(Value);
492     else
493     IBError(ibxeInvalidDataConversion, [nil]);
494     end;
495     Changed;
496     end;
497    
498     procedure TFBArrayElement.SetAsFloat(Value: Float);
499     begin
500     AsDouble := Value;
501     end;
502    
503     procedure TFBArrayElement.SetAsCurrency(Value: Currency);
504     begin
505     CheckActive;
506     if (GetSQLDialect < 3) or (SQLType <> SQL_INT64) then
507     AsDouble := Value
508     else
509     begin
510     if Scale = -4 then
511     PCurrency(SQLData)^ := Value
512     else
513     PInt64(SQLData)^ := AdjustScaleFromCurrency(Value,Scale);
514     Changed;
515     end
516     end;
517    
518 tony 315 procedure TFBArrayElement.SetAsBcd(aValue: tBCD);
519     var C: Currency;
520     begin
521     CheckActive;
522     with FirebirdClientAPI do
523     case SQLType of
524     SQL_DEC_FIXED,
525     SQL_DEC16,
526     SQL_DEC34:
527     SQLDecFloatEncode(aValue,SQLType,SQLData);
528    
529     SQL_INT128:
530     StrToInt128(Scale,BcdToStr(aValue),SQLData);
531    
532     else
533     begin
534     BCDToCurr(aValue,C);
535     SetAsCurrency(C);
536     end;
537     end;
538     Changed;
539     end;
540    
541 tony 353 procedure TFBArrayElement.SetAsNumeric(Value: Int64; aScale: integer);
542     begin
543     CheckActive;
544     case GetSQLType of
545     SQL_LONG:
546     PLong(SQLData)^ := AdjustScaleToInt64(Value,aScale - getScale);
547     SQL_SHORT:
548     PShort(SQLData)^ := AdjustScaleToInt64(Value,aScale - getScale);
549     SQL_INT64:
550     PInt64(SQLData)^ := AdjustScaleToInt64(Value,aScale - getScale);
551     SQL_TEXT, SQL_VARYING:
552     SetAsString(AdjustScaleToStr(Value,aScale));
553     SQL_D_FLOAT,
554     SQL_DOUBLE:
555     PDouble(SQLData)^ := AdjustScale(Value,aScale);
556     SQL_FLOAT:
557     PSingle(SQLData)^ := AdjustScale(Value,aScale);
558     else
559     IBError(ibxeInvalidDataConversion, [nil]);
560     end;
561     Changed;
562     end;
563    
564 tony 45 procedure TFBArrayElement.SetSQLType(aValue: cardinal);
565     begin
566 tony 315 if aValue <> GetSQLType then
567 tony 45 IBError(ibxeInvalidDataConversion, [nil]);
568     end;
569    
570     {TFBArrayMetaData}
571    
572     constructor TFBArrayMetaData.Create(aAttachment: IAttachment;
573 tony 56 aTransaction: ITransaction; relationName, columnName: AnsiString);
574 tony 45 begin
575     inherited Create;
576 tony 60 FAttachment := aAttachment;
577 tony 45 LoadMetaData(aAttachment,aTransaction,relationName, columnName);
578     end;
579    
580 tony 60 constructor TFBArrayMetaData.Create(aAttachment: IAttachment;
581     SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
582     Scale: integer; size: cardinal; charSetID: cardinal; dimensions: cardinal;
583     bounds: TArrayBounds);
584 tony 47 var i: integer;
585     begin
586     inherited Create;
587 tony 60 FAttachment := aAttachment;
588 tony 47 with FArrayDesc do
589     begin
590     array_desc_dtype := GetDType(SQLType);
591 tony 56 array_desc_scale := Scale;
592 tony 47 array_desc_length := UShort(size);
593     StrPLCopy(array_desc_field_name,columnName,sizeof(array_desc_field_name));
594     StrPLCopy(array_desc_relation_name,tableName,sizeof(array_desc_relation_name));
595     array_desc_dimensions := dimensions;
596     array_desc_flags := 0;
597     FCharSetID := charSetID;
598     for i := 0 to Length(bounds) - 1 do
599     begin
600     array_desc_bounds[i].array_bound_lower := bounds[i].LowerBound;
601     array_desc_bounds[i].array_bound_upper := bounds[i].UpperBound;
602     end;
603     end;
604     end;
605    
606 tony 45 function TFBArrayMetaData.GetSQLType: cardinal;
607     begin
608     case FArrayDesc.array_desc_dtype of
609     blr_cstring,
610     blr_cstring2,
611     blr_text,blr_text2:
612     Result := SQL_TEXT;
613     blr_short:
614     Result := SQL_SHORT;
615     blr_long:
616     Result := SQL_LONG;
617     blr_quad, blr_blob_id:
618     Result := SQL_QUAD;
619     blr_float:
620     Result := SQL_FLOAT;
621     blr_double,blr_d_float:
622     Result := SQL_D_FLOAT;
623     blr_timestamp:
624     Result := SQL_TIMESTAMP;
625     blr_varying,blr_varying2:
626     Result := SQL_VARYING;
627     blr_sql_date:
628     Result := SQL_TYPE_DATE;
629     blr_sql_time:
630     Result := SQL_TYPE_TIME;
631     blr_int64:
632     Result := SQL_INT64;
633 tony 315 blr_sql_time_tz:
634     Result := SQL_TIME_TZ;
635     blr_timestamp_tz:
636     Result := SQL_TIMESTAMP_TZ;
637     blr_ex_time_tz:
638     Result := SQL_TIME_TZ_EX;
639     blr_ex_timestamp_tz:
640     Result := SQL_TIMESTAMP_TZ_EX;
641     blr_dec64:
642     Result := SQL_DEC16;
643     blr_dec128:
644     Result := SQL_DEC34;
645     blr_int128:
646     Result := SQL_INT128;
647 tony 45 end;
648     end;
649    
650 tony 56 function TFBArrayMetaData.GetSQLTypeName: AnsiString;
651 tony 45 begin
652     Result := TSQLDataItem.GetSQLTypeName(GetSQLType);
653     end;
654    
655     function TFBArrayMetaData.GetScale: integer;
656     begin
657 tony 315 Result := FArrayDesc.array_desc_scale;
658 tony 45 end;
659    
660     function TFBArrayMetaData.GetSize: cardinal;
661     begin
662     Result := FArrayDesc.array_desc_length;
663     end;
664    
665 tony 56 function TFBArrayMetaData.GetTableName: AnsiString;
666 tony 45 begin
667     with FArrayDesc do
668 tony 56 SetString(Result,PAnsiChar(@array_desc_relation_name),sizeof(array_desc_relation_name));
669 tony 45 Result := trim(Result);
670     end;
671    
672 tony 56 function TFBArrayMetaData.GetColumnName: AnsiString;
673 tony 45 begin
674     with FArrayDesc do
675 tony 56 SetString(Result,PAnsiChar(@FArrayDesc.array_desc_field_name),sizeof(array_desc_field_name));
676 tony 45 Result := trim(Result);
677     end;
678    
679     function TFBArrayMetaData.GetDimensions: integer;
680     begin
681     Result := FArrayDesc.array_desc_dimensions;
682     end;
683    
684     function TFBArrayMetaData.GetBounds: TArrayBounds;
685     var i: integer;
686     begin
687     SetLength(Result,GetDimensions);
688     for i := 0 to GetDimensions - 1 do
689     begin
690     Result[i].UpperBound := FArrayDesc.array_desc_bounds[i].array_bound_upper;
691     Result[i].LowerBound := FArrayDesc.array_desc_bounds[i].array_bound_lower;
692     end;
693     end;
694    
695 tony 47 function TFBArrayMetaData.GetDType(SQLType: cardinal): UChar;
696     begin
697     case SQLType of
698     SQL_TEXT:
699     Result := blr_text;
700     SQL_SHORT:
701     Result := blr_short;
702     SQL_LONG:
703     Result := blr_long;
704     SQL_QUAD:
705     Result := blr_quad;
706     SQL_FLOAT:
707     Result := blr_float;
708     SQL_D_FLOAT:
709     Result := blr_double;
710     SQL_TIMESTAMP:
711     Result := blr_timestamp;
712     SQL_VARYING:
713     Result := blr_varying;
714     SQL_TYPE_DATE:
715     Result := blr_sql_date;
716     SQL_TYPE_TIME:
717     Result := blr_sql_time;
718     SQL_INT64:
719     Result := blr_int64;
720 tony 315 SQL_TIME_TZ:
721     Result := blr_sql_time_tz;
722     SQL_TIMESTAMP_TZ:
723     Result := blr_timestamp_tz;
724     SQL_TIME_TZ_EX:
725     Result := blr_ex_time_tz;
726     SQL_TIMESTAMP_TZ_EX:
727     Result := blr_ex_timestamp_tz;
728     SQL_DEC16:
729     Result := blr_dec64;
730     SQL_DEC34:
731     Result := blr_dec128;
732     SQL_INT128:
733     Result := blr_int128;
734 tony 47 end;
735     end;
736    
737 tony 45 function TFBArrayMetaData.NumOfElements: integer;
738     var i: integer;
739     Bounds: TArrayBounds;
740     begin
741     Result := 1;
742     Bounds := GetBounds;
743     for i := 0 to Length(Bounds) - 1 do
744 tony 56 Result := Result * (Bounds[i].UpperBound - Bounds[i].LowerBound + 1);
745 tony 45 end;
746    
747    
748     { TFBArray }
749    
750     procedure TFBArray.AllocateBuffer;
751     var i: integer;
752     l: integer;
753     Bounds: TArrayBounds;
754     Dims: integer;
755     begin
756     SetLength(FOffsets,0);
757     FreeMem(FBuffer);
758     FBuffer := nil;
759     FLoaded := false;
760    
761     with FMetaData as TFBArrayMetaData do
762     begin
763     l := NumOfElements;
764     FElementSize := FArrayDesc.array_desc_length;
765     case GetSQLType of
766     SQL_VARYING:
767 tony 56 FElementSize := FElementSize + 2;
768 tony 45 SQL_TEXT:
769 tony 56 FElementSize := FElementSize + 1;
770 tony 45 end;
771     FBufSize := FElementSize * l;
772    
773 tony 263 with FFirebirdClientAPI do
774 tony 45 IBAlloc(FBuffer,0,FBufSize);
775    
776     Dims := GetDimensions;
777     SetLength(FOffsets,GetDimensions);
778     Bounds := GetBounds;
779     if FArrayDesc.array_desc_flags = 0 {row major} then
780     begin
781     FOffsets[0] := 1;
782     for i := 0 to Dims - 2 do
783     FOffsets[i+1] := FOffsets[i] * (Bounds[i].UpperBound - Bounds[i].LowerBound + 1);
784     end
785     else
786     begin
787     {column major}
788     FOffsets[Dims-1] := 1;
789     for i := Dims - 1 downto 1 do
790     FOffsets[i-1] := FOffsets[i] * (Bounds[i].UpperBound - Bounds[i].LowerBound + 1);
791     end;
792     end;
793     end;
794    
795     procedure TFBArray.Changing;
796     var i: integer;
797     begin
798     for i := 0 to Length(FEventHandlers) - 1 do
799     FEventHandlers[i](self,arChanging);
800     end;
801    
802     procedure TFBArray.Changed;
803     var i: integer;
804     begin
805     FModified := true;
806     for i := 0 to Length(FEventHandlers) - 1 do
807     FEventHandlers[i](self,arChanged);
808     end;
809    
810     procedure TFBArray.GetArraySlice;
811     begin
812     if FIsNew or FLoaded then Exit;
813     InternalGetSlice;
814     FLoaded := true;
815     end;
816    
817     procedure TFBArray.PutArraySlice(Force: boolean);
818     begin
819     if not FModified or not FTransactionIntf.InTransaction or
820     (FTransactionSeqNo < (FTransactionIntf as TFBTransaction).TransactionSeqNo) then Exit;
821    
822     InternalPutSlice(Force);
823     FModified := false;
824     FIsNew := false;
825     end;
826    
827 tony 56 function TFBArray.GetOffset(index: array of integer): PByte;
828 tony 45 var i: integer;
829     Bounds: TArrayBounds;
830     FlatIndex: integer;
831     begin
832     if FMetaData.GetDimensions <> Length(index) then
833     IBError(ibxeInvalidArrayDimensions,[Length(index)]);
834    
835     FlatIndex := 0;
836     Bounds := FMetaData.GetBounds;
837     for i := 0 to Length(index) - 1 do
838     begin
839     if (index[i] < Bounds[i].LowerBound) or (index[i] > Bounds[i].UpperBound) then
840     IBError(ibxeInvalidSubscript,[index[i],i]);
841    
842 tony 56 FlatIndex := FlatIndex + FOffsets[i]*(index[i] - Bounds[i].LowerBound);
843 tony 45 end;
844     Result := FBuffer + FlatIndex*FElementSize;
845     end;
846    
847     function TFBArray.GetDataLength: short;
848     begin
849     Result := FElementSize;
850     end;
851    
852     function TFBArray.GetArrayDesc: PISC_ARRAY_DESC;
853     begin
854     Result := @((FMetaData as TFBArrayMetaData).FArrayDesc);
855     end;
856    
857     constructor TFBArray.Create(aAttachment: IAttachment; aTransaction: TFBTransaction; aField: IArrayMetaData);
858     begin
859     inherited Create(aTransaction);
860     FMetaData := aField;
861     FAttachment := aAttachment;
862 tony 263 FFirebirdClientAPI := aTransaction.FirebirdAPI;
863 tony 45 FTransactionIntf := aTransaction;
864     FTransactionSeqNo := aTransaction.TransactionSeqNo;
865     FIsNew := true;
866     FModified := false;
867     FSQLDialect := aAttachment.GetSQLDialect;
868     AllocateBuffer;
869     FElement := TFBArrayElement.Create(self,FBuffer);
870     FElementIntf := FElement;
871     Setlength(FEventHandlers,0);
872     end;
873    
874     constructor TFBArray.Create(aAttachment: IAttachment; aTransaction: TFBTransaction;
875     aField: IArrayMetaData; ArrayID: TISC_QUAD);
876     begin
877     inherited Create(aTransaction);
878     FMetaData := aField;
879     FArrayID := ArrayID;
880     FAttachment := aAttachment;
881 tony 291 FFirebirdClientAPI := aTransaction.FirebirdAPI;
882 tony 45 FTransactionIntf := aTransaction;
883     FTransactionSeqNo := aTransaction.TransactionSeqNo;
884     FIsNew := false;
885     FModified := false;
886     FSQLDialect := aAttachment.GetSQLDialect;
887     AllocateBuffer;
888     FElement := TFBArrayElement.Create(self,FBuffer);
889     FElementIntf := FElement;
890     Setlength(FEventHandlers,0);
891     end;
892    
893     destructor TFBArray.Destroy;
894     begin
895     FreeMem(FBuffer);
896     inherited Destroy;
897     end;
898    
899     function TFBArray.GetArrayID: TISC_QUAD;
900     begin
901     PutArraySlice;
902     Result := FArrayID;
903     end;
904    
905     procedure TFBArray.Clear;
906     begin
907     FIsNew := true;
908     FModified := false;
909     FArrayID.gds_quad_high := 0;
910     FArrayID.gds_quad_low := 0;
911     AllocateBuffer;
912     end;
913    
914     function TFBArray.IsEmpty: boolean;
915     begin
916     Result := FIsNew and not FModified;
917     end;
918    
919     procedure TFBArray.PreLoad;
920     begin
921     GetArraySlice;
922     end;
923    
924     procedure TFBArray.CancelChanges;
925     begin
926     FModified := false;
927     AllocateBuffer;
928     end;
929    
930     procedure TFBArray.SaveChanges;
931     begin
932     PutArraySlice;
933     end;
934    
935     function TFBArray.GetSQLDialect: integer;
936     begin
937     Result := FSQLDialect;
938     end;
939    
940     procedure TFBArray.TransactionEnding(aTransaction: ITransaction; Force: boolean
941     );
942     begin
943 tony 315 if ((aTransaction as TObject) = (FTransactionIntf as TObject)) and FModified and not FIsNew then
944 tony 45 PutArraySlice(Force);
945     end;
946    
947     function TFBArray.GetSQLType: cardinal;
948     begin
949     Result := FMetaData.GetSQLType;
950     end;
951    
952 tony 56 function TFBArray.GetSQLTypeName: AnsiString;
953 tony 45 begin
954     Result := FMetaData.GetSQLTypeName;
955     end;
956    
957     function TFBArray.GetScale: integer;
958     begin
959     Result := FMetaData.GetScale;
960     end;
961    
962     function TFBArray.GetSize: cardinal;
963     begin
964     Result := FMetaData.GetSize;
965     end;
966    
967     function TFBArray.GetCharSetID: cardinal;
968     begin
969     Result := FMetaData.GetCharSetID;
970     end;
971    
972 tony 309 function TFBArray.GetCharSetWidth: integer;
973     begin
974     Result := FMetaData.GetCharSetWidth;
975     end;
976    
977 tony 56 function TFBArray.GetTableName: AnsiString;
978 tony 45 begin
979     Result := FMetaData.GetTableName;
980     end;
981    
982 tony 56 function TFBArray.GetColumnName: AnsiString;
983 tony 45 begin
984     Result := FMetaData.GetColumnName;
985     end;
986    
987     function TFBArray.GetDimensions: integer;
988     begin
989     Result := FMetaData.GetDimensions;
990     end;
991    
992     function TFBArray.GetBounds: TArrayBounds;
993     begin
994     Result := FMetaData.GetBounds;
995     end;
996    
997     function TFBArray.GetAsInteger(index: array of integer): integer;
998     begin
999     GetArraySlice;
1000     FElement.FBufPtr := GetOffset(index);
1001     Result := FElement.GetAsLong;
1002     end;
1003    
1004     function TFBArray.GetAsBoolean(index: array of integer): boolean;
1005     begin
1006     GetArraySlice;
1007     FElement.FBufPtr := GetOffset(index);
1008     Result := FElement.GetAsBoolean;
1009     end;
1010    
1011     function TFBArray.GetAsCurrency(index: array of integer): Currency;
1012     begin
1013     GetArraySlice;
1014     FElement.FBufPtr := GetOffset(index);
1015     Result := FElement.GetAsCurrency;
1016     end;
1017    
1018     function TFBArray.GetAsInt64(index: array of integer): Int64;
1019     begin
1020     GetArraySlice;
1021     FElement.FBufPtr := GetOffset(index);
1022     Result := FElement.GetAsInt64;
1023     end;
1024    
1025     function TFBArray.GetAsDateTime(index: array of integer): TDateTime;
1026     begin
1027     GetArraySlice;
1028     FElement.FBufPtr := GetOffset(index);
1029     Result := FElement.GetAsDateTime;
1030     end;
1031    
1032 tony 315 procedure TFBArray.GetAsDateTime(index: array of integer;
1033     var aDateTime: TDateTime; var dstOffset: smallint;
1034     var aTimezoneID: TFBTimeZoneID);
1035     begin
1036     GetArraySlice;
1037     FElement.FBufPtr := GetOffset(index);
1038     FElement.GetAsDateTime(aDateTime,dstOffset,aTimezoneID);
1039     end;
1040    
1041     procedure TFBArray.GetAsDateTime(index: array of integer;
1042     var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString);
1043     begin
1044     GetArraySlice;
1045     FElement.FBufPtr := GetOffset(index);
1046     FElement.GetAsDateTime(aDateTime,dstOffset,aTimezone);
1047     end;
1048    
1049     procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime;
1050     var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1051     begin
1052     GetArraySlice;
1053     FElement.FBufPtr := GetOffset(index);
1054     FElement.GetAsTime(aTime,dstOffset,aTimezoneID,OnDate);
1055     end;
1056    
1057     procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime;
1058     var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime);
1059     begin
1060     GetArraySlice;
1061     FElement.FBufPtr := GetOffset(index);
1062     FElement.GetAsTime(aTime,dstOffset,aTimezone,OnDate);
1063     end;
1064    
1065     function TFBArray.GetAsUTCDateTime(index: array of integer): TDateTime;
1066     begin
1067     GetArraySlice;
1068     FElement.FBufPtr := GetOffset(index);
1069     Result := FElement.GetAsUTCDateTime;
1070     end;
1071    
1072 tony 45 function TFBArray.GetAsDouble(index: array of integer): Double;
1073     begin
1074     GetArraySlice;
1075     FElement.FBufPtr := GetOffset(index);
1076     Result := FElement.GetAsDouble;
1077     end;
1078    
1079     function TFBArray.GetAsFloat(index: array of integer): Float;
1080     begin
1081     GetArraySlice;
1082     FElement.FBufPtr := GetOffset(index);
1083     Result := FElement.GetAsFloat;
1084     end;
1085    
1086     function TFBArray.GetAsLong(index: array of integer): Long;
1087     begin
1088     GetArraySlice;
1089     FElement.FBufPtr := GetOffset(index);
1090     Result := FElement.GetAsLong;
1091     end;
1092    
1093     function TFBArray.GetAsShort(index: array of integer): Short;
1094     begin
1095     GetArraySlice;
1096     FElement.FBufPtr := GetOffset(index);
1097     Result := FElement.GetAsShort;
1098     end;
1099    
1100 tony 56 function TFBArray.GetAsString(index: array of integer): AnsiString;
1101 tony 45 begin
1102     GetArraySlice;
1103     FElement.FBufPtr := GetOffset(index);
1104     Result := FElement.GetAsString;
1105     end;
1106    
1107     function TFBArray.GetAsVariant(index: array of integer): Variant;
1108     begin
1109     GetArraySlice;
1110     FElement.FBufPtr := GetOffset(index);
1111     Result := FElement.GetAsVariant;
1112     end;
1113    
1114 tony 315 function TFBArray.GetAsBCD(index: array of integer): tBCD;
1115     begin
1116     GetArraySlice;
1117     FElement.FBufPtr := GetOffset(index);
1118     Result := FElement.GetAsBCD;
1119     end;
1120    
1121 tony 45 procedure TFBArray.SetAsInteger(index: array of integer; AValue: integer);
1122     begin
1123     FElement.FBufPtr := GetOffset(index);
1124     FElement.SetAsLong(AValue);
1125     end;
1126    
1127     procedure TFBArray.SetAsBoolean(index: array of integer; AValue: boolean);
1128     begin
1129     FElement.FBufPtr := GetOffset(index);
1130     FElement.SetAsBoolean(AValue);
1131     end;
1132    
1133     procedure TFBArray.SetAsCurrency(index: array of integer; Value: Currency);
1134     begin
1135     FElement.FBufPtr := GetOffset(index);
1136     FElement.SetAsCurrency(Value);
1137     end;
1138    
1139     procedure TFBArray.SetAsInt64(index: array of integer; Value: Int64);
1140     begin
1141     FElement.FBufPtr := GetOffset(index);
1142     FElement.SetAsInt64(Value);
1143     end;
1144    
1145     procedure TFBArray.SetAsDate(index: array of integer; Value: TDateTime);
1146     begin
1147     FElement.FBufPtr := GetOffset(index);
1148     FElement.SetAsDate(Value);
1149     end;
1150    
1151     procedure TFBArray.SetAsLong(index: array of integer; Value: Long);
1152     begin
1153     FElement.FBufPtr := GetOffset(index);
1154     FElement.SetAsLong(Value);
1155     end;
1156    
1157     procedure TFBArray.SetAsTime(index: array of integer; Value: TDateTime);
1158     begin
1159     FElement.FBufPtr := GetOffset(index);
1160     FElement.SetAsTime(Value);
1161     end;
1162    
1163 tony 315 procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime;
1164     aTimeZoneID: TFBTimeZoneID);
1165     begin
1166     FElement.FBufPtr := GetOffset(index);
1167     FElement.SetAsTime(aValue,OnDate,aTimeZoneID);
1168     end;
1169    
1170     procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime;
1171     aTimeZone: AnsiString);
1172     begin
1173     FElement.FBufPtr := GetOffset(index);
1174     FElement.SetAsTime(aValue,OnDate, aTimeZone);
1175     end;
1176    
1177 tony 45 procedure TFBArray.SetAsDateTime(index: array of integer; Value: TDateTime);
1178     begin
1179     FElement.FBufPtr := GetOffset(index);
1180     FElement.SetAsDateTime(Value);
1181     end;
1182    
1183 tony 315 procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime;
1184     aTimeZoneID: TFBTimeZoneID);
1185     begin
1186     FElement.FBufPtr := GetOffset(index);
1187     FElement.SetAsDateTime(aValue,aTimeZoneID);
1188     end;
1189    
1190     procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime;
1191     aTimeZone: AnsiString);
1192     begin
1193     FElement.FBufPtr := GetOffset(index);
1194     FElement.SetAsDateTime(aValue,aTimeZone);
1195     end;
1196    
1197     procedure TFBArray.SetAsUTCDateTime(index: array of integer;
1198     aUTCTime: TDateTime);
1199     begin
1200     FElement.FBufPtr := GetOffset(index);
1201     FElement.SetAsUTCDateTime(aUTCTime);
1202     end;
1203    
1204 tony 45 procedure TFBArray.SetAsDouble(index: array of integer; Value: Double);
1205     begin
1206     FElement.FBufPtr := GetOffset(index);
1207     FElement.SetAsDouble(Value);
1208     end;
1209    
1210     procedure TFBArray.SetAsFloat(index: array of integer; Value: Float);
1211     begin
1212     FElement.FBufPtr := GetOffset(index);
1213     FElement.SetAsFloat(Value);
1214     end;
1215    
1216     procedure TFBArray.SetAsShort(index: array of integer; Value: Short);
1217     begin
1218     FElement.FBufPtr := GetOffset(index);
1219     FElement.SetAsShort(Value);
1220     end;
1221    
1222 tony 56 procedure TFBArray.SetAsString(index: array of integer; Value: AnsiString);
1223 tony 45 begin
1224     FElement.FBufPtr := GetOffset(index);
1225     FElement.SetAsString(Value);
1226     end;
1227    
1228     procedure TFBArray.SetAsVariant(index: array of integer; Value: Variant);
1229     begin
1230     FElement.FBufPtr := GetOffset(index);
1231     FElement.SetAsVariant(Value);
1232     end;
1233    
1234 tony 315 procedure TFBArray.SetAsBcd(index: array of integer; aValue: tBCD);
1235     begin
1236     FElement.FBufPtr := GetOffset(index);
1237     FElement.SetAsBcd(aValue);
1238     end;
1239    
1240 tony 45 procedure TFBArray.SetBounds(dim, UpperBound, LowerBound: integer);
1241     begin
1242     with (FMetaData as TFBArrayMetaData) do
1243     begin
1244     if (dim < 0) or (dim > GetDimensions) then
1245     IBError(ibxeInvalidArrayDimensions,[dim]);
1246    
1247     if (UpperBound > FArrayDesc.array_desc_bounds[dim].array_bound_upper) or
1248     (LowerBound < FArrayDesc.array_desc_bounds[dim].array_bound_lower) or
1249     (UpperBound < FArrayDesc.array_desc_bounds[dim].array_bound_lower) or
1250     (LowerBound > FArrayDesc.array_desc_bounds[dim].array_bound_upper) then
1251     IBError(ibxArrayBoundsCantIncrease,[nil]);
1252    
1253     PutArraySlice; {Save any changes}
1254    
1255     FArrayDesc.array_desc_bounds[dim].array_bound_upper := UpperBound;
1256     FArrayDesc.array_desc_bounds[dim].array_bound_lower := LowerBound;
1257     end;
1258     AllocateBuffer;
1259     end;
1260    
1261     function TFBArray.GetAttachment: IAttachment;
1262     begin
1263     Result := FAttachment;
1264     end;
1265    
1266     function TFBArray.GetTransaction: ITransaction;
1267     begin
1268     Result := FTransactionIntf;
1269     end;
1270    
1271     procedure TFBArray.AddEventHandler(Handler: TArrayEventHandler);
1272     begin
1273     SetLength(FEventHandlers,Length(FEventHandlers)+1);
1274     FEventHandlers[Length(FEventHandlers)-1] := Handler;
1275     end;
1276    
1277     procedure TFBArray.RemoveEventHandler(Handler: TArrayEventHandler);
1278     var i,j : integer;
1279     begin
1280     for i := Length(FEventHandlers) - 1 downto 0 do
1281 tony 56 if (TMethod(FEventHandlers[i]).Code = TMethod(Handler).Code) and
1282     (TMethod(FEventHandlers[i]).Data = TMethod(Handler).Data) then
1283 tony 45 begin
1284     for j := i to Length(FEventHandlers) - 2 do
1285     FEventHandlers[i] := FEventHandlers[i+1];
1286     SetLength(FEventHandlers,Length(FEventHandlers) - 1);
1287     end;
1288     end;
1289    
1290     end.
1291