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

Comparing ibx/trunk/fbintf/client/FBArray.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 60 by tony, Mon Mar 27 15:21:02 2017 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 69 | Line 72 | type
72  
73    TFBArrayElement = class(TSQLDataItem)
74    private
75 <   FBufPtr: PChar;
75 >   FBufPtr: PByte;
76     FArray: TFBArray;
77    protected
78     function GetSQLDialect: integer; override;
79     procedure Changing; override;
80     procedure Changed; override;
81 <   function SQLData: PChar; override;
81 >   function SQLData: PByte; override;
82     function GetDataLength: cardinal; override;
83     function GetCodePage: TSystemCodePage; override;
84 +   function getCharSetID: cardinal; override;
85     procedure SetDataLength(len: cardinal); override;
86     procedure SetSQLType(aValue: cardinal); override;
87    public
88 <   constructor Create(anArray: TFBArray; P: PChar);
88 >   constructor Create(anArray: TFBArray; P: PByte);
89     function GetSQLType: cardinal; override;
90 <   function GetName: string; override;
90 >   function GetName: AnsiString; override;
91     function GetScale: integer; override;
92     function GetSize: integer;
93 <   function GetAsString: string; override;
93 >   function GetAsString: AnsiString; override;
94     procedure SetAsLong(Value: Long); override;
95     procedure SetAsShort(Value: Short); override;
96     procedure SetAsInt64(Value: Int64); override;
97 <   procedure SetAsString(Value: String); override;
97 >   procedure SetAsString(Value: AnsiString); override;
98     procedure SetAsDouble(Value: Double); override;
99     procedure SetAsFloat(Value: Float); override;
100     procedure SetAsCurrency(Value: Currency); override;
# Line 99 | Line 103 | type
103    { TFBArrayMetaData }
104  
105    TFBArrayMetaData = class(TFBInterfacedObject,IArrayMetaData)
106 +  private
107 +   function GetDType(SQLType: cardinal): UChar;
108    protected
109     FArrayDesc: TISC_ARRAY_DESC;
110 +   FCharSetID: integer;
111 +   FAttachment: IAttachment;
112     procedure LoadMetaData(aAttachment: IAttachment; aTransaction: ITransaction;
113 <               relationName, columnName: string); virtual; abstract;
113 >               relationName, columnName: AnsiString); virtual; abstract;
114     function NumOfElements: integer;
115    public
116     constructor Create(aAttachment: IAttachment; aTransaction: ITransaction;
117 <     relationName, columnName: string);
117 >     relationName, columnName: AnsiString); overload;
118 >   constructor Create(aAttachment: IAttachment;SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
119 >     Scale: integer; size: cardinal; charSetID: cardinal;
120 >     dimensions: cardinal; bounds: TArrayBounds); overload;
121     function GetCodePage: TSystemCodePage; virtual; abstract;
122  
123    public
124     {IArrayMetaData}
125     function GetSQLType: cardinal;
126 <   function GetSQLTypeName: string;
126 >   function GetSQLTypeName: AnsiString;
127     function GetScale: integer;
128     function GetSize: cardinal;
129     function GetCharSetID: cardinal; virtual; abstract;
130 <   function GetTableName: string;
131 <   function GetColumnName: string;
130 >   function GetTableName: AnsiString;
131 >   function GetColumnName: AnsiString;
132     function GetDimensions: integer;
133     function GetBounds: TArrayBounds;
134    end;
# Line 142 | Line 153 | type
153      FEventHandlers: array of TArrayEventHandler;
154      procedure GetArraySlice;
155      procedure PutArraySlice(Force: boolean=false);
156 <    function GetOffset(index: array of integer): PChar;
156 >    function GetOffset(index: array of integer): PByte;
157      function GetDataLength: short;
158    protected
159 <    FBuffer: PChar;
159 >    FBuffer: PByte;
160      FBufSize: ISC_LONG;
161      FArrayID: TISC_QUAD;
162      procedure AllocateBuffer; virtual;
# Line 166 | Line 177 | type
177     public
178      {IArrayMetaData}
179      function GetSQLType: cardinal;
180 <    function GetSQLTypeName: string;
180 >    function GetSQLTypeName: AnsiString;
181      function GetScale: integer;
182      function GetSize: cardinal;
183      function GetCharSetID: cardinal;
184 <    function GetTableName: string;
185 <    function GetColumnName: string;
184 >    function GetTableName: AnsiString;
185 >    function GetColumnName: AnsiString;
186      function GetDimensions: integer;
187      function GetBounds: TArrayBounds;
188      {IArray}
# Line 190 | Line 201 | type
201      function GetAsFloat(index: array of integer): Float;
202      function GetAsLong(index: array of integer): Long;
203      function GetAsShort(index: array of integer): Short;
204 <    function GetAsString(index: array of integer): String;
204 >    function GetAsString(index: array of integer): AnsiString;
205      function GetAsVariant(index: array of integer): Variant;
206      procedure SetAsInteger(index: array of integer; AValue: integer);
207      procedure SetAsBoolean(index: array of integer; AValue: boolean);
# Line 203 | Line 214 | type
214      procedure SetAsDouble(index: array of integer; Value: Double);
215      procedure SetAsFloat(index: array of integer; Value: Float);
216      procedure SetAsShort(index: array of integer; Value: Short);
217 <    procedure SetAsString(index: array of integer; Value: String);
217 >    procedure SetAsString(index: array of integer; Value: AnsiString);
218      procedure SetAsVariant(index: array of integer; Value: Variant);
219      procedure SetBounds(dim, UpperBound, LowerBound: integer);
220      function GetAttachment: IAttachment;
# Line 235 | Line 246 | begin
246    FArray.Changed;
247   end;
248  
249 < function TFBArrayElement.SQLData: PChar;
249 > function TFBArrayElement.SQLData: PByte;
250   begin
251    Result := FBufPtr;
252   end;
# Line 250 | Line 261 | begin
261    Result := (FArray.FMetaData as TFBArrayMetaData).GetCodePage;
262   end;
263  
264 + function TFBArrayElement.getCharSetID: cardinal;
265 + begin
266 +  Result := (FArray.FMetaData as TFBArrayMetaData).GetCharSetID;
267 + end;
268 +
269   procedure TFBArrayElement.SetDataLength(len: cardinal);
270   begin
271    if len > GetDataLength then
272      IBError(ibxeArrayElementOverFlow,[nil]);
273   end;
274  
275 < constructor TFBArrayElement.Create(anArray: TFBArray; P: PChar);
275 > constructor TFBArrayElement.Create(anArray: TFBArray; P: PByte);
276   begin
277    inherited Create;
278    FArray := anArray;
# Line 268 | Line 284 | begin
284    Result :=  FArray.FMetaData.GetSQLType;
285   end;
286  
287 < function TFBArrayElement.GetName: string;
287 > function TFBArrayElement.GetName: AnsiString;
288   begin
289    Result := FArray.FMetaData.GetColumnName;
290   end;
# Line 283 | Line 299 | begin
299    Result := GetDataLength;
300   end;
301  
302 < function TFBArrayElement.GetAsString: string;
302 > function TFBArrayElement.GetAsString: AnsiString;
303   var rs: RawByteString;
304   begin
305    case GetSQLType of
306    SQL_VARYING:
307      begin
308 <      rs := strpas(FBufPtr);
308 >      rs := strpas(PAnsiChar(FBufPtr));
309        SetCodePage(rs,GetCodePage,false);
310        Result := rs;
311      end;
312    SQL_TEXT:
313      begin
314 <      SetString(rs,FBufPtr,GetDataLength);
314 >      SetString(rs,PAnsiChar(FBufPtr),GetDataLength);
315        SetCodePage(rs,GetCodePage,false);
316        Result := rs;
317      end
# Line 337 | Line 353 | begin
353    Changed;
354   end;
355  
356 < procedure TFBArrayElement.SetAsString(Value: String);
356 > procedure TFBArrayElement.SetAsString(Value: AnsiString);
357   var len: integer;
358      ElementSize: integer;
359   begin
360    CheckActive;
361    case GetSQLType of
362    SQL_BOOLEAN:
363 <    if CompareText(Value,STrue) = 0 then
363 >    if AnsiCompareText(Value,STrue) = 0 then
364        AsBoolean := true
365      else
366 <    if CompareText(Value,SFalse) = 0 then
366 >    if AnsiCompareText(Value,SFalse) = 0 then
367        AsBoolean := false
368      else
369        IBError(ibxeInvalidDataConversion,[nil]);
# Line 362 | Line 378 | begin
378        if Len > 0 then
379          Move(Value[1],FBufPtr^,len);
380        if Len < ElementSize - 2 then
381 <        (FBufPtr+len)^ := #0;
381 >        (FBufPtr+len)^ := 0;
382        Changed;
383      end;
384  
# Line 383 | Line 399 | begin
399      if trim(Value) = '' then
400        SetAsInt64(0)
401      else
402 <      SetAsInt64(StrToInt(Value));
402 >      SetAsInt64(AdjustScaleFromCurrency(StrToCurr(Value),GetScale));
403  
404    SQL_D_FLOAT,
405    SQL_DOUBLE,
# Line 468 | Line 484 | end;
484   {TFBArrayMetaData}
485  
486   constructor TFBArrayMetaData.Create(aAttachment: IAttachment;
487 <  aTransaction: ITransaction; relationName, columnName: string);
487 >  aTransaction: ITransaction; relationName, columnName: AnsiString);
488   begin
489    inherited Create;
490 +  FAttachment := aAttachment;
491    LoadMetaData(aAttachment,aTransaction,relationName, columnName);
492   end;
493  
494 + constructor TFBArrayMetaData.Create(aAttachment: IAttachment;
495 +  SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
496 +  Scale: integer; size: cardinal; charSetID: cardinal; dimensions: cardinal;
497 +  bounds: TArrayBounds);
498 + var i: integer;
499 + begin
500 +  inherited Create;
501 +  FAttachment := aAttachment;
502 +  with FArrayDesc do
503 +  begin
504 +    array_desc_dtype := GetDType(SQLType);
505 +    array_desc_scale := Scale;
506 +    array_desc_length := UShort(size);
507 +    StrPLCopy(array_desc_field_name,columnName,sizeof(array_desc_field_name));
508 +    StrPLCopy(array_desc_relation_name,tableName,sizeof(array_desc_relation_name));
509 +    array_desc_dimensions := dimensions;
510 +    array_desc_flags := 0;
511 +    FCharSetID := charSetID;
512 +    for i := 0 to Length(bounds) - 1 do
513 +    begin
514 +     array_desc_bounds[i].array_bound_lower := bounds[i].LowerBound;
515 +     array_desc_bounds[i].array_bound_upper := bounds[i].UpperBound;
516 +    end;
517 +  end;
518 + end;
519 +
520   function TFBArrayMetaData.GetSQLType: cardinal;
521   begin
522    case  FArrayDesc.array_desc_dtype of
# Line 504 | Line 547 | begin
547    end;
548   end;
549  
550 < function TFBArrayMetaData.GetSQLTypeName: string;
550 > function TFBArrayMetaData.GetSQLTypeName: AnsiString;
551   begin
552    Result := TSQLDataItem.GetSQLTypeName(GetSQLType);
553   end;
# Line 519 | Line 562 | begin
562    Result := FArrayDesc.array_desc_length;
563   end;
564  
565 < function TFBArrayMetaData.GetTableName: string;
565 > function TFBArrayMetaData.GetTableName: AnsiString;
566   begin
567    with FArrayDesc do
568 <   SetString(Result,PChar(@array_desc_relation_name),sizeof(array_desc_relation_name));
568 >   SetString(Result,PAnsiChar(@array_desc_relation_name),sizeof(array_desc_relation_name));
569    Result := trim(Result);
570   end;
571  
572 < function TFBArrayMetaData.GetColumnName: string;
572 > function TFBArrayMetaData.GetColumnName: AnsiString;
573   begin
574    with FArrayDesc do
575 <    SetString(Result,PChar(@FArrayDesc.array_desc_field_name),sizeof(array_desc_field_name));
575 >    SetString(Result,PAnsiChar(@FArrayDesc.array_desc_field_name),sizeof(array_desc_field_name));
576    Result := trim(Result);
577   end;
578  
# Line 549 | Line 592 | begin
592    end;
593   end;
594  
595 + function TFBArrayMetaData.GetDType(SQLType: cardinal): UChar;
596 + begin
597 +  case  SQLType of
598 +  SQL_TEXT:
599 +    Result := blr_text;
600 +  SQL_SHORT:
601 +    Result :=  blr_short;
602 +  SQL_LONG:
603 +    Result := blr_long;
604 +  SQL_QUAD:
605 +    Result := blr_quad;
606 +  SQL_FLOAT:
607 +    Result := blr_float;
608 +  SQL_D_FLOAT:
609 +    Result := blr_double;
610 +  SQL_TIMESTAMP:
611 +    Result := blr_timestamp;
612 +  SQL_VARYING:
613 +    Result := blr_varying;
614 +  SQL_TYPE_DATE:
615 +    Result := blr_sql_date;
616 +  SQL_TYPE_TIME:
617 +    Result :=  blr_sql_time;
618 +  SQL_INT64:
619 +    Result := blr_int64;
620 +  end;
621 + end;
622 +
623   function TFBArrayMetaData.NumOfElements: integer;
624   var i: integer;
625      Bounds: TArrayBounds;
# Line 556 | Line 627 | begin
627    Result := 1;
628    Bounds := GetBounds;
629    for i := 0 to Length(Bounds) - 1 do
630 <    Result *= (Bounds[i].UpperBound - Bounds[i].LowerBound + 1);
630 >    Result := Result * (Bounds[i].UpperBound - Bounds[i].LowerBound + 1);
631   end;
632  
633  
# Line 579 | Line 650 | begin
650      FElementSize := FArrayDesc.array_desc_length;
651      case GetSQLType of
652      SQL_VARYING:
653 <      FElementSize += 2;
653 >      FElementSize := FElementSize + 2;
654      SQL_TEXT:
655 <      FElementSize += 1;
655 >      FElementSize := FElementSize + 1;
656      end;
657      FBufSize := FElementSize * l;
658  
# Line 639 | Line 710 | begin
710    FIsNew := false;
711   end;
712  
713 < function TFBArray.GetOffset(index: array of integer): PChar;
713 > function TFBArray.GetOffset(index: array of integer): PByte;
714   var i: integer;
715      Bounds: TArrayBounds;
716      FlatIndex: integer;
# Line 654 | Line 725 | begin
725      if (index[i] < Bounds[i].LowerBound) or (index[i] > Bounds[i].UpperBound) then
726        IBError(ibxeInvalidSubscript,[index[i],i]);
727  
728 <    FlatIndex += FOffsets[i]*(index[i] - Bounds[i].LowerBound);
728 >    FlatIndex := FlatIndex + FOffsets[i]*(index[i] - Bounds[i].LowerBound);
729    end;
730    Result := FBuffer + FlatIndex*FElementSize;
731   end;
# Line 762 | Line 833 | begin
833    Result := FMetaData.GetSQLType;
834   end;
835  
836 < function TFBArray.GetSQLTypeName: string;
836 > function TFBArray.GetSQLTypeName: AnsiString;
837   begin
838    Result := FMetaData.GetSQLTypeName;
839   end;
# Line 782 | Line 853 | begin
853    Result := FMetaData.GetCharSetID;
854   end;
855  
856 < function TFBArray.GetTableName: string;
856 > function TFBArray.GetTableName: AnsiString;
857   begin
858    Result := FMetaData.GetTableName;
859   end;
860  
861 < function TFBArray.GetColumnName: string;
861 > function TFBArray.GetColumnName: AnsiString;
862   begin
863    Result := FMetaData.GetColumnName;
864   end;
# Line 865 | Line 936 | begin
936    Result := FElement.GetAsShort;
937   end;
938  
939 < function TFBArray.GetAsString(index: array of integer): String;
939 > function TFBArray.GetAsString(index: array of integer): AnsiString;
940   begin
941    GetArraySlice;
942    FElement.FBufPtr := GetOffset(index);
# Line 945 | Line 1016 | begin
1016    FElement.SetAsShort(Value);
1017   end;
1018  
1019 < procedure TFBArray.SetAsString(index: array of integer; Value: String);
1019 > procedure TFBArray.SetAsString(index: array of integer; Value: AnsiString);
1020   begin
1021    FElement.FBufPtr := GetOffset(index);
1022    FElement.SetAsString(Value);
# Line 998 | Line 1069 | procedure TFBArray.RemoveEventHandler(Ha
1069   var i,j : integer;
1070   begin
1071    for i := Length(FEventHandlers) - 1 downto 0 do
1072 <    if FEventHandlers[i] = Handler then
1072 >    if (TMethod(FEventHandlers[i]).Code = TMethod(Handler).Code) and
1073 >      (TMethod(FEventHandlers[i]).Data = TMethod(Handler).Data) then
1074      begin
1075        for j := i to Length(FEventHandlers) - 2 do
1076          FEventHandlers[i] := FEventHandlers[i+1];

Diff Legend

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