View Issue Details

IDProjectCategoryView StatusLast Update
0019341FPCDatabasepublic2011-09-30 17:48
Reporterkevin jiangAssigned ToJoost van der Sluis 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
PlatformW32OSwindowsOS Version7
Product VersionProduct Build 
Target VersionFixed in Version3.0.0 
Summary0019341: TOracleConnection and SQLQuery1 ,got error ORA-01455 converting column overflows integer datatype
DescriptionTOracleConnection and SQLQuery1 ,got error ORA-01455 converting column overflows integer datatype

create table T_TEST
(
  A1 NUMBER(6),
  A2 NUMBER(8),
  A3 NUMBER(9),
  A4 NUMBER(10),
  A5 NUMBER(11),
  A6 NUMBER(15),
  A7 NUMBER(18),
  A8 NUMBER(15,2)
);
 
--then insert one row
insert into T_TEST (A1, A2, A3, A4, A5, A6, A7, A8)
values (123456, 12345678, 123456789, 1234567890, 12345678901, 123456789012345, 123456789012346000, 1111111.11);
commit;
var
   SQLQuery1: TSQLQuery;

   SqlQuery1.Close;
   SqlQuery1.SQL.Clear;
   sqlQuery1.SQL.Add('select A1,A2,A3,A4 from t_test') ;
   SqlQuery1.Open;
these flds bellow number(11) no problem.

but when you query A5 got that error ORA-01455.
   SqlQuery1.Close;
   SqlQuery1.SQL.Clear;
   sqlQuery1.SQL.Add('select A5 from t_test') ;
   SqlQuery1.Open;

and did not support NUMBER(15,2) ,if you select A8 then return nil.



 
TagsNo tags attached.
Fixed in Revision19304
FPCOldBugId0
FPCTarget
Attached Files
  • oracleconnection.diff (10,600 bytes)
    Index: oracleconnection.pp
    ===================================================================
    --- oracleconnection.pp	(revision 19289)
    +++ oracleconnection.pp	(working copy)
    @@ -1,9 +1,5 @@
     unit oracleconnection;
    -//
    -// For usage of "returning" like clauses see mantis #18133
    -//
     
    -
     {$mode objfpc}{$H+}
     
     {$Define LinkDynamically}
    @@ -41,6 +37,7 @@
         Buffer : pointer;
         Ind    : sb2;
         Len    : ub4;
    +    Size   : ub4;
       end;
     
       TOracleCursor = Class(TSQLCursor)
    @@ -104,7 +101,7 @@
     implementation
     
     uses
    -  math, StrUtils;
    +  math, StrUtils, FmtBCD;
     
     ResourceString
       SErrEnvCreateFailed = 'The creation of an Oracle environment failed.';
    @@ -132,12 +129,174 @@
     //only 1 row can be stored. No support for multiple rows. When multiple rows, only last is kept.
       bufpp^:=TOraFieldBuf(octxp^).Buffer;
       indp^ := @TOraFieldBuf(octxp^).Ind;
    +  TOraFieldBuf(octxp^).Len:=TOraFieldBuf(octxp^).Size;   //reset size to full buffer
       alenp^ := @TOraFieldBuf(octxp^).Len;
       rcodep^:=nil;
       piecep^ := OCI_ONE_PIECE;
       result:=OCI_CONTINUE;
     end;
     
    +//conversions
    +
    +Procedure FmtBCD2Nvu(bcd:tBCD;b:pByte);
    +var
    +  i,j,cnt   : integer;
    +  nibbles   : array [0..maxfmtbcdfractionsize-1] of byte;
    +  exp       : shortint;
    +  bb        : byte;
    +begin
    +  fillchar(b[0],22,#0);
    +  if BCDPrecision(bcd)=0 then // zero, special case
    +    begin
    +    b[0]:=1;
    +    b[1]:=$80;
    +    end
    +  else
    +    begin
    +    if (BCDPrecision(bcd)-BCDScale(bcd)) mod 2 <>0 then // odd number before decimal point
    +      begin
    +      nibbles[0]:=0;
    +      j:=1;
    +      end
    +    else
    +      j:=0;
    +    for i:=0 to bcd.Precision -1 do
    +      if i mod 2 =0 then
    +        nibbles[i+j]:=bcd.Fraction[i div 2] shr 4
    +      else
    +        nibbles[i+j]:=bcd.Fraction[i div 2] and $0f;
    +    nibbles[bcd.Precision+j]:=0; // make sure last nibble is also 0 in case we have odd scale
    +    exp:=(BCDPrecision(bcd)-BCDScale(bcd)+1) div 2;
    +    cnt:=exp+(BCDScale(bcd)+1) div 2;
    +    // to avoid "ora 01438: value larger than specified precision allowed for this column"
    +    // remove trailing zeros (scale < 0)
    +    while (nibbles[cnt*2-2]*10+nibbles[cnt*2-1])=0 do
    +      cnt:=cnt-1;
    +    // and remove leading zeros (scale > precision)
    +    j:=0;
    +    while (nibbles[j*2]*10+nibbles[j*2+1])=0 do
    +      begin
    +      j:=j+1;
    +      exp:=exp-1;
    +      end;
    +    if IsBCDNegative(bcd) then
    +      begin
    +      b[0]:=cnt-j+1;
    +      b[1]:=not(exp+64) and $7f ;
    +      for i:=j to cnt-1 do
    +        begin
    +        bb:=nibbles[i*2]*10+nibbles[i*2+1];
    +        b[2+i-j]:=101-bb;
    +        end;
    +      if 2+cnt-j<22 then  // add a 102 at the end of the number if place left.
    +        begin
    +        b[0]:=b[0]+1;
    +        b[2+cnt-j]:=102;
    +        end;
    +      end
    +    else
    +      begin
    +      b[0]:=cnt-j+1;
    +      b[1]:=(exp+64) or $80 ;
    +      for i:=j to cnt-1 do
    +        begin
    +        bb:=nibbles[i*2]*10+nibbles[i*2+1];
    +        b[2+i-j]:=1+bb;
    +        end;
    +      end;
    +    end;
    +end;
    +
    +function Nvu2FmtBCE(b:pbyte):tBCD;
    +var
    +  i,j       : integer;
    +  bb,size   : byte;
    +  exp       : shortint;
    +  nibbles   : array [0..maxfmtbcdfractionsize-1] of byte;
    +  scale     : integer;
    +begin
    +  size := b[0];
    +  if (size=1) and (b[1]=$80) then // special representation for 0
    +    result:=IntegerToBCD(0)
    +  else
    +    begin
    +    result.SignSpecialPlaces:=0; //sign positive, non blank, scale 0
    +    result.Precision:=1;         //BCDNegate works only if Precision <>0
    +    if (b[1] and $80)=$80 then // then the number is positive
    +      begin
    +      exp := (b[1] and $7f)-65;
    +      for i := 0 to size-2 do
    +        begin
    +        bb := b[i+2]-1;
    +        nibbles[i*2]:=bb div 10;
    +        nibbles[i*2+1]:=(bb mod 10);
    +        end;
    +      end
    +    else
    +      begin
    +      BCDNegate(result);
    +      exp := (not(b[1]) and $7f)-65;
    +      if b[size]=102 then  // last byte doesn't count if = 102
    +        size:=size-1;
    +      for i := 0 to size-2 do
    +        begin
    +        bb := 101-b[i+2];
    +        nibbles[i*2]:=bb div 10;
    +        nibbles[i*2+1]:=(bb mod 10);
    +        end;
    +      end;
    +    nibbles[(size-1)*2]:=0;
    +    result.Precision:=(size-1)*2;
    +    scale:=result.Precision-(exp*2+2);
    +    if scale>=0 then
    +      begin
    +      if (scale>result.Precision) then  // need to add leading 0's
    +        begin
    +        for i:=0 to (scale-result.Precision+1) div 2 do
    +          result.Fraction[i]:=0;
    +        i:=scale-result.Precision;
    +        result.Precision:=scale;
    +        end
    +      else
    +        i:=0;
    +      j:=i;
    +      if (i=0) and (nibbles[0]=0) then // get rid of leading zero received from oci
    +        begin
    +        result.Precision:=result.Precision-1;
    +        j:=-1;
    +        end;
    +      while i<=result.Precision do // copy nibbles
    +        begin
    +        if i mod 2 =0 then
    +          result.Fraction[i div 2]:=nibbles[i-j] shl 4
    +        else
    +          result.Fraction[i div 2]:=result.Fraction[i div 2] or nibbles[i-j];
    +        i:=i+1;
    +        end;
    +      result.SignSpecialPlaces:=result.SignSpecialPlaces or scale;
    +      end
    +    else
    +      begin // add trailing zero's, increase precision to take them into account
    +      i:=0;
    +      while i<=result.Precision do // copy nibbles
    +        begin
    +        if i mod 2 =0 then
    +          result.Fraction[i div 2]:=nibbles[i] shl 4
    +        else
    +          result.Fraction[i div 2]:=result.Fraction[i div 2] or nibbles[i];
    +        i:=i+1;
    +        end;
    +      result.Precision:=result.Precision-scale;
    +      for i := size -1 to High(result.Fraction) do
    +        result.Fraction[i] := 0;
    +      end;
    +    end;
    +end;
    +
    +
    +
    +// TOracleConnection
    +
     procedure TOracleConnection.HandleError;
     
     var errcode : sb4;
    @@ -195,7 +354,10 @@
                                 day:=pb[3];
                                 asDateTime:=EncodeDate(year,month,day);
                                 end;
    -      end;
    +        ftFMTBcd          : begin
    +                            AsFMTBCD:=Nvu2FmtBCE(parambuffers[SQLVarNr].buffer);
    +                            end;
    +        end;
     
           end;
     
    @@ -367,10 +529,12 @@
               ftFloat : begin OFieldType := SQLT_FLT; OFieldSize := sizeof(double); end;
               ftDate, ftDateTime : begin OFieldType := SQLT_DAT; OFieldSize := 7; end;
               ftString  : begin OFieldType := SQLT_STR; OFieldSize := 4000; end;
    +          ftFMTBcd : begin OFieldType := SQLT_VNU; OFieldSize := 22; end;
     
             end;
             parambuffers[tel].buffer := getmem(OFieldSize);
    -        parambuffers[tel].len := OFieldSize;
    +        parambuffers[tel].Len := OFieldSize;
    +        parambuffers[tel].Size := OFieldSize;
     
     
             FOciBind := nil;
    @@ -434,6 +598,9 @@
                                 pb[5] := 1;
                                 pb[6] := 1;
                                 end;
    +        ftFmtBCD          : begin
    +                            FmtBCD2Nvu(asFmtBCD,parambuffers[SQLVarNr].buffer);
    +                            end;
           end;
     
           end;
    @@ -546,7 +713,7 @@
     
         FieldType  : TFieldType;
         FieldName  : string;
    -    FieldSize  : word;
    +    FieldSize  : integer;
     
         OFieldType   : ub2;
         OFieldName   : Pchar;
    @@ -586,11 +753,11 @@
                                       HandleError;
                                     if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oscale,nil,OCI_ATTR_SCALE,FOciError) = OCI_ERROR then
                                       HandleError;
    -                                if Oscale = 0 then
    +                                if (Oscale = 0) and (Oprecision<9) then
                                       begin
                                       if Oprecision=0 then //Number(0,0) = number(32,4)
    -                                    begin              //Warning ftBCD is limited to precision 12
    -                                    FieldType := ftBCD;
    +                                    begin
    +                                    FieldType := ftFMTBCD;
                                         FieldSize := 4;
                                         OFieldType := SQLT_VNU;
                                         OFieldSize:= 22;
    @@ -602,20 +769,32 @@
                                         OFieldSize:= sizeof(integer);
                                         end;
                                       end
    -                                else if (oscale = -127) {and (OPrecision=0)} then
    +                                else if (Oscale = -127) {and (OPrecision=0)} then
                                       begin
                                       FieldType := ftFloat;
                                       OFieldType := SQLT_FLT;
                                       OFieldSize:=sizeof(double);
                                       end
    -                                else if (oscale <=4) and (OPrecision<=12) then
    +                                else if (Oscale >=0) and (Oscale <=4) and (OPrecision<=12) then
                                       begin
                                       FieldType := ftBCD;
                                       FieldSize := oscale;
                                       OFieldType := SQLT_VNU;
                                       OFieldSize:= 22;
                                       end
    -                                else FieldType := ftUnknown;
    +                                else if (OPrecision-Oscale<64) and (Oscale < 64) then // limited to 63 digits before or after decimal point
    +                                  begin
    +                                  FieldType := ftFMTBCD;
    +                                  FieldSize := oscale;
    +                                  OFieldType := SQLT_VNU;
    +                                  OFieldSize:= 22;
    +                                  end
    +                                else //approximation with double, best can do
    +                                  begin
    +                                  FieldType := ftFloat;
    +                                  OFieldType := SQLT_FLT;
    +                                  OFieldSize:=sizeof(double);
    +                                  end;
                                     end;
             OCI_TYPECODE_CHAR,
             OCI_TYPECODE_VARCHAR,
    @@ -701,6 +880,9 @@
                                  end;
                                move(cur,buffer^,SizeOf(Currency));
                                end;
    +      ftFMTBCD             :  begin
    +                           pBCD(buffer)^:= Nvu2FmtBCE(fieldbuffers[FieldDef.FieldNo-1].buffer);
    +                           end;
           ftFloat           : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(double));
           ftInteger         : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(integer));
           ftDate  : begin
    
    oracleconnection.diff (10,600 bytes)
  • 0018133.diff (958 bytes)
    Index: oracleconnection.pp
    ===================================================================
    --- oracleconnection.pp	(revision 19296)
    +++ oracleconnection.pp	(working copy)
    @@ -41,6 +41,7 @@
         Buffer : pointer;
         Ind    : sb2;
         Len    : ub4;
    +    Size   : ub4;
       end;
     
       TOracleCursor = Class(TSQLCursor)
    @@ -132,6 +133,7 @@
     //only 1 row can be stored. No support for multiple rows. When multiple rows, only last is kept.
       bufpp^:=TOraFieldBuf(octxp^).Buffer;
       indp^ := @TOraFieldBuf(octxp^).Ind;
    +  TOraFieldBuf(octxp^).Len:=TOraFieldBuf(octxp^).Size;   //reset size to full buffer
       alenp^ := @TOraFieldBuf(octxp^).Len;
       rcodep^:=nil;
       piecep^ := OCI_ONE_PIECE;
    @@ -370,7 +372,8 @@
     
             end;
             parambuffers[tel].buffer := getmem(OFieldSize);
    -        parambuffers[tel].len := OFieldSize;
    +        parambuffers[tel].Len := OFieldSize;
    +        parambuffers[tel].Size := OFieldSize;
     
     
             FOciBind := nil;
    
    0018133.diff (958 bytes)

Relationships

related to 0017376 resolvedLacaK FPC TSQLite3Connection not show whole content for string field when the field is asia language 
has duplicate 0019340 closedPaul Ishenin Lazarus TOracleConnection and SQLQuery1 ,got error ORA-01455 converting column overflows integer datatype 

Activities

yang jixian

2011-05-19 04:07

reporter   ~0048396

The prior version of TOracleConnection is correct. The bug is for current version.

yang jixian

2011-05-19 04:12

reporter   ~0048397

The reporter uploaded a unit for Asia language solution in www.fpccn.com, I think it is better than the UTF8DB20101228.patch in 17376:

{Autuor: kevin jiang}

unit UnitGetSetText;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, LConvEncoding, db;

type

  { TGetSetTextClass }

  TGetSetTextClass = class
  private
    procedure GetText(Sender: TField; var aText: string;
           DisplayText: Boolean);
    procedure SetText(Sender: TField; const aText: string);
  public
    procedure AssignGetTextToQueries(F: TCustomForm);
  end;

var
  GetSetTextClass: TGetSetTextClass;

implementation

{ TGetSetTextClass }

procedure TGetSetTextClass.GetText(Sender: TField; var aText: string;
  DisplayText: Boolean);
begin
  aText := CP936ToUTF8(Sender.AsString);
end;

procedure TGetSetTextClass.SetText(Sender: TField; const aText: string);
begin
  Sender.AsString := UTF8ToCP936(aText);
end;

procedure TGetSetTextClass.AssignGetTextToQueries(F: TCustomForm);
var
  I, J: Integer;
  Q: TDataSet; // doesn't matter if it's TQuery or TTable or TZQuery...
  SF: TStringField;
begin
  for I := 0 to F.ComponentCount - 1 do
    if F.Components[I] is TDataSet then begin
      Q := TDataSet(F.Components[I]);
      for J := 0 to Q.FieldCount - 1 do
        if Q.Fields[J] is TStringField then begin
          SF := TStringField(Q.Fields[J]);
          SF.OnGetText := @GetText;
          SF.OnSetText := @SetText;
        end;
    end;
end;

initialization
  GetSetTextClass := TGetSetTextClass.Create;

finalization
  GetSetTextClass.Free;

end.


for my test, the UTF8Encode and UTF8Decode may be better here.

Ludo Brands

2011-09-30 10:36

developer   ~0052291

Attached patch implements ftFmtBCD fields for Oracle. Full Oracle precision is obtained for Numbers in the range Number(38,-26) (9.9999... E63) to Number(38,64) 9.999... E-26.
ftFmtBCD can also be used as a parameter type for input and output (returning into clause). Unit fmtbcd has to be used when assigning to Params[x].AsFMTBCD or Params.ParamByName('xyz').AsFMTBCD.

Note to Marco: This patch also contains a fix for a bug that slipped in the patch for issue 0018133: when re-issuing a prepared statement and the size of the returned value is bigger than previous returned value an "ORA-03116:invalid buffer length passed to a conversion routine" is raised. This happens only for variable size fields such as ftFmtBCD or ftString.
If you want, I'll separate this fix from the patch.

2011-09-30 10:37

 

oracleconnection.diff (10,600 bytes)
Index: oracleconnection.pp
===================================================================
--- oracleconnection.pp	(revision 19289)
+++ oracleconnection.pp	(working copy)
@@ -1,9 +1,5 @@
 unit oracleconnection;
-//
-// For usage of "returning" like clauses see mantis #18133
-//
 
-
 {$mode objfpc}{$H+}
 
 {$Define LinkDynamically}
@@ -41,6 +37,7 @@
     Buffer : pointer;
     Ind    : sb2;
     Len    : ub4;
+    Size   : ub4;
   end;
 
   TOracleCursor = Class(TSQLCursor)
@@ -104,7 +101,7 @@
 implementation
 
 uses
-  math, StrUtils;
+  math, StrUtils, FmtBCD;
 
 ResourceString
   SErrEnvCreateFailed = 'The creation of an Oracle environment failed.';
@@ -132,12 +129,174 @@
 //only 1 row can be stored. No support for multiple rows. When multiple rows, only last is kept.
   bufpp^:=TOraFieldBuf(octxp^).Buffer;
   indp^ := @TOraFieldBuf(octxp^).Ind;
+  TOraFieldBuf(octxp^).Len:=TOraFieldBuf(octxp^).Size;   //reset size to full buffer
   alenp^ := @TOraFieldBuf(octxp^).Len;
   rcodep^:=nil;
   piecep^ := OCI_ONE_PIECE;
   result:=OCI_CONTINUE;
 end;
 
+//conversions
+
+Procedure FmtBCD2Nvu(bcd:tBCD;b:pByte);
+var
+  i,j,cnt   : integer;
+  nibbles   : array [0..maxfmtbcdfractionsize-1] of byte;
+  exp       : shortint;
+  bb        : byte;
+begin
+  fillchar(b[0],22,#0);
+  if BCDPrecision(bcd)=0 then // zero, special case
+    begin
+    b[0]:=1;
+    b[1]:=$80;
+    end
+  else
+    begin
+    if (BCDPrecision(bcd)-BCDScale(bcd)) mod 2 <>0 then // odd number before decimal point
+      begin
+      nibbles[0]:=0;
+      j:=1;
+      end
+    else
+      j:=0;
+    for i:=0 to bcd.Precision -1 do
+      if i mod 2 =0 then
+        nibbles[i+j]:=bcd.Fraction[i div 2] shr 4
+      else
+        nibbles[i+j]:=bcd.Fraction[i div 2] and $0f;
+    nibbles[bcd.Precision+j]:=0; // make sure last nibble is also 0 in case we have odd scale
+    exp:=(BCDPrecision(bcd)-BCDScale(bcd)+1) div 2;
+    cnt:=exp+(BCDScale(bcd)+1) div 2;
+    // to avoid "ora 01438: value larger than specified precision allowed for this column"
+    // remove trailing zeros (scale < 0)
+    while (nibbles[cnt*2-2]*10+nibbles[cnt*2-1])=0 do
+      cnt:=cnt-1;
+    // and remove leading zeros (scale > precision)
+    j:=0;
+    while (nibbles[j*2]*10+nibbles[j*2+1])=0 do
+      begin
+      j:=j+1;
+      exp:=exp-1;
+      end;
+    if IsBCDNegative(bcd) then
+      begin
+      b[0]:=cnt-j+1;
+      b[1]:=not(exp+64) and $7f ;
+      for i:=j to cnt-1 do
+        begin
+        bb:=nibbles[i*2]*10+nibbles[i*2+1];
+        b[2+i-j]:=101-bb;
+        end;
+      if 2+cnt-j<22 then  // add a 102 at the end of the number if place left.
+        begin
+        b[0]:=b[0]+1;
+        b[2+cnt-j]:=102;
+        end;
+      end
+    else
+      begin
+      b[0]:=cnt-j+1;
+      b[1]:=(exp+64) or $80 ;
+      for i:=j to cnt-1 do
+        begin
+        bb:=nibbles[i*2]*10+nibbles[i*2+1];
+        b[2+i-j]:=1+bb;
+        end;
+      end;
+    end;
+end;
+
+function Nvu2FmtBCE(b:pbyte):tBCD;
+var
+  i,j       : integer;
+  bb,size   : byte;
+  exp       : shortint;
+  nibbles   : array [0..maxfmtbcdfractionsize-1] of byte;
+  scale     : integer;
+begin
+  size := b[0];
+  if (size=1) and (b[1]=$80) then // special representation for 0
+    result:=IntegerToBCD(0)
+  else
+    begin
+    result.SignSpecialPlaces:=0; //sign positive, non blank, scale 0
+    result.Precision:=1;         //BCDNegate works only if Precision <>0
+    if (b[1] and $80)=$80 then // then the number is positive
+      begin
+      exp := (b[1] and $7f)-65;
+      for i := 0 to size-2 do
+        begin
+        bb := b[i+2]-1;
+        nibbles[i*2]:=bb div 10;
+        nibbles[i*2+1]:=(bb mod 10);
+        end;
+      end
+    else
+      begin
+      BCDNegate(result);
+      exp := (not(b[1]) and $7f)-65;
+      if b[size]=102 then  // last byte doesn't count if = 102
+        size:=size-1;
+      for i := 0 to size-2 do
+        begin
+        bb := 101-b[i+2];
+        nibbles[i*2]:=bb div 10;
+        nibbles[i*2+1]:=(bb mod 10);
+        end;
+      end;
+    nibbles[(size-1)*2]:=0;
+    result.Precision:=(size-1)*2;
+    scale:=result.Precision-(exp*2+2);
+    if scale>=0 then
+      begin
+      if (scale>result.Precision) then  // need to add leading 0's
+        begin
+        for i:=0 to (scale-result.Precision+1) div 2 do
+          result.Fraction[i]:=0;
+        i:=scale-result.Precision;
+        result.Precision:=scale;
+        end
+      else
+        i:=0;
+      j:=i;
+      if (i=0) and (nibbles[0]=0) then // get rid of leading zero received from oci
+        begin
+        result.Precision:=result.Precision-1;
+        j:=-1;
+        end;
+      while i<=result.Precision do // copy nibbles
+        begin
+        if i mod 2 =0 then
+          result.Fraction[i div 2]:=nibbles[i-j] shl 4
+        else
+          result.Fraction[i div 2]:=result.Fraction[i div 2] or nibbles[i-j];
+        i:=i+1;
+        end;
+      result.SignSpecialPlaces:=result.SignSpecialPlaces or scale;
+      end
+    else
+      begin // add trailing zero's, increase precision to take them into account
+      i:=0;
+      while i<=result.Precision do // copy nibbles
+        begin
+        if i mod 2 =0 then
+          result.Fraction[i div 2]:=nibbles[i] shl 4
+        else
+          result.Fraction[i div 2]:=result.Fraction[i div 2] or nibbles[i];
+        i:=i+1;
+        end;
+      result.Precision:=result.Precision-scale;
+      for i := size -1 to High(result.Fraction) do
+        result.Fraction[i] := 0;
+      end;
+    end;
+end;
+
+
+
+// TOracleConnection
+
 procedure TOracleConnection.HandleError;
 
 var errcode : sb4;
@@ -195,7 +354,10 @@
                             day:=pb[3];
                             asDateTime:=EncodeDate(year,month,day);
                             end;
-      end;
+        ftFMTBcd          : begin
+                            AsFMTBCD:=Nvu2FmtBCE(parambuffers[SQLVarNr].buffer);
+                            end;
+        end;
 
       end;
 
@@ -367,10 +529,12 @@
           ftFloat : begin OFieldType := SQLT_FLT; OFieldSize := sizeof(double); end;
           ftDate, ftDateTime : begin OFieldType := SQLT_DAT; OFieldSize := 7; end;
           ftString  : begin OFieldType := SQLT_STR; OFieldSize := 4000; end;
+          ftFMTBcd : begin OFieldType := SQLT_VNU; OFieldSize := 22; end;
 
         end;
         parambuffers[tel].buffer := getmem(OFieldSize);
-        parambuffers[tel].len := OFieldSize;
+        parambuffers[tel].Len := OFieldSize;
+        parambuffers[tel].Size := OFieldSize;
 
 
         FOciBind := nil;
@@ -434,6 +598,9 @@
                             pb[5] := 1;
                             pb[6] := 1;
                             end;
+        ftFmtBCD          : begin
+                            FmtBCD2Nvu(asFmtBCD,parambuffers[SQLVarNr].buffer);
+                            end;
       end;
 
       end;
@@ -546,7 +713,7 @@
 
     FieldType  : TFieldType;
     FieldName  : string;
-    FieldSize  : word;
+    FieldSize  : integer;
 
     OFieldType   : ub2;
     OFieldName   : Pchar;
@@ -586,11 +753,11 @@
                                   HandleError;
                                 if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oscale,nil,OCI_ATTR_SCALE,FOciError) = OCI_ERROR then
                                   HandleError;
-                                if Oscale = 0 then
+                                if (Oscale = 0) and (Oprecision<9) then
                                   begin
                                   if Oprecision=0 then //Number(0,0) = number(32,4)
-                                    begin              //Warning ftBCD is limited to precision 12
-                                    FieldType := ftBCD;
+                                    begin
+                                    FieldType := ftFMTBCD;
                                     FieldSize := 4;
                                     OFieldType := SQLT_VNU;
                                     OFieldSize:= 22;
@@ -602,20 +769,32 @@
                                     OFieldSize:= sizeof(integer);
                                     end;
                                   end
-                                else if (oscale = -127) {and (OPrecision=0)} then
+                                else if (Oscale = -127) {and (OPrecision=0)} then
                                   begin
                                   FieldType := ftFloat;
                                   OFieldType := SQLT_FLT;
                                   OFieldSize:=sizeof(double);
                                   end
-                                else if (oscale <=4) and (OPrecision<=12) then
+                                else if (Oscale >=0) and (Oscale <=4) and (OPrecision<=12) then
                                   begin
                                   FieldType := ftBCD;
                                   FieldSize := oscale;
                                   OFieldType := SQLT_VNU;
                                   OFieldSize:= 22;
                                   end
-                                else FieldType := ftUnknown;
+                                else if (OPrecision-Oscale<64) and (Oscale < 64) then // limited to 63 digits before or after decimal point
+                                  begin
+                                  FieldType := ftFMTBCD;
+                                  FieldSize := oscale;
+                                  OFieldType := SQLT_VNU;
+                                  OFieldSize:= 22;
+                                  end
+                                else //approximation with double, best can do
+                                  begin
+                                  FieldType := ftFloat;
+                                  OFieldType := SQLT_FLT;
+                                  OFieldSize:=sizeof(double);
+                                  end;
                                 end;
         OCI_TYPECODE_CHAR,
         OCI_TYPECODE_VARCHAR,
@@ -701,6 +880,9 @@
                              end;
                            move(cur,buffer^,SizeOf(Currency));
                            end;
+      ftFMTBCD             :  begin
+                           pBCD(buffer)^:= Nvu2FmtBCE(fieldbuffers[FieldDef.FieldNo-1].buffer);
+                           end;
       ftFloat           : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(double));
       ftInteger         : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(integer));
       ftDate  : begin
oracleconnection.diff (10,600 bytes)

Marco van de Voort

2011-09-30 12:58

manager   ~0052293

Yes please, then it can still go into the RC1 that is branched tonight, which already has the other fix.

Ludo Brands

2011-09-30 13:54

developer   ~0052295

Fix to 0018133 isolated in 0018133.diff

2011-09-30 13:54

 

0018133.diff (958 bytes)
Index: oracleconnection.pp
===================================================================
--- oracleconnection.pp	(revision 19296)
+++ oracleconnection.pp	(working copy)
@@ -41,6 +41,7 @@
     Buffer : pointer;
     Ind    : sb2;
     Len    : ub4;
+    Size   : ub4;
   end;
 
   TOracleCursor = Class(TSQLCursor)
@@ -132,6 +133,7 @@
 //only 1 row can be stored. No support for multiple rows. When multiple rows, only last is kept.
   bufpp^:=TOraFieldBuf(octxp^).Buffer;
   indp^ := @TOraFieldBuf(octxp^).Ind;
+  TOraFieldBuf(octxp^).Len:=TOraFieldBuf(octxp^).Size;   //reset size to full buffer
   alenp^ := @TOraFieldBuf(octxp^).Len;
   rcodep^:=nil;
   piecep^ := OCI_ONE_PIECE;
@@ -370,7 +372,8 @@
 
         end;
         parambuffers[tel].buffer := getmem(OFieldSize);
-        parambuffers[tel].len := OFieldSize;
+        parambuffers[tel].Len := OFieldSize;
+        parambuffers[tel].Size := OFieldSize;
 
 
         FOciBind := nil;
0018133.diff (958 bytes)

Marco van de Voort

2011-09-30 17:48

manager   ~0052302

Committed the rest. I'll ask Joost if Oracle is considered working at all (in previous versions), if not, this can go into the 2.6 branch between rc1 and -final.

Issue History

Date Modified Username Field Change
2011-05-12 03:16 kevin jiang New Issue
2011-05-12 03:16 kevin jiang Widgetset => Win32/Win64
2011-05-12 04:00 Paul Ishenin Project Lazarus => FPC
2011-05-12 04:00 Paul Ishenin Relationship added has duplicate 0019340
2011-05-13 14:32 Jonas Maebe FPCOldBugId => 0
2011-05-13 14:32 Jonas Maebe Category Database => Database Components
2011-05-13 14:32 Jonas Maebe Product Version 0.9.30 =>
2011-05-13 14:33 Jonas Maebe Status new => assigned
2011-05-13 14:33 Jonas Maebe Assigned To => Joost van der Sluis
2011-05-19 04:07 yang jixian Note Added: 0048396
2011-05-19 04:12 yang jixian Note Added: 0048397
2011-07-14 15:33 Marco van de Voort Relationship added related to 0017376
2011-09-30 10:36 Ludo Brands Note Added: 0052291
2011-09-30 10:37 Ludo Brands File Added: oracleconnection.diff
2011-09-30 12:58 Marco van de Voort Note Added: 0052293
2011-09-30 13:54 Ludo Brands Note Added: 0052295
2011-09-30 13:54 Ludo Brands File Added: 0018133.diff
2011-09-30 17:48 Marco van de Voort Fixed in Revision => 19304
2011-09-30 17:48 Marco van de Voort Status assigned => resolved
2011-09-30 17:48 Marco van de Voort Fixed in Version => 2.7.1
2011-09-30 17:48 Marco van de Voort Resolution open => fixed
2011-09-30 17:48 Marco van de Voort Note Added: 0052302