Browse Source

* Add support for int128 integers. Patch by Lacak, fixes issue #41178

Michaël Van Canneyt 5 months ago
parent
commit
6215d7e8d2
2 changed files with 43 additions and 17 deletions
  1. 34 17
      packages/fcl-db/src/sqldb/interbase/ibconnection.pp
  2. 9 0
      packages/ibase/src/ibase60.inc

+ 34 - 17
packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -195,11 +195,6 @@ uses
   StrUtils, FmtBCD;
   StrUtils, FmtBCD;
 {$ENDIF FPC_DOTTEDUNITS}
 {$ENDIF FPC_DOTTEDUNITS}
 
 
-const
-  SQL_BOOLEAN_INTERBASE = 590;
-  SQL_BOOLEAN_FIREBIRD = 32764;
-  SQL_NULL = 32767;
-  INVALID_DATA = -1;
 
 
 procedure TIBConnection.CheckError(const ProcName : string; Status : PISC_STATUS);
 procedure TIBConnection.CheckError(const ProcName : string; Status : PISC_STATUS);
 
 
@@ -804,6 +799,9 @@ begin
         TrType := ftFloat;
         TrType := ftFloat;
     SQL_BOOLEAN_INTERBASE, SQL_BOOLEAN_FIREBIRD :
     SQL_BOOLEAN_INTERBASE, SQL_BOOLEAN_FIREBIRD :
         TrType := ftBoolean;
         TrType := ftBoolean;
+    SQL_INT128,
+    SQL_DEC16, SQL_DEC34:
+        TrType := ftFmtBCD;
     else
     else
         TrType := ftUnknown;
         TrType := ftUnknown;
   end;
   end;
@@ -1083,7 +1081,7 @@ begin
       TranslateFldType(PSQLVar^.SQLType, PSQLVar^.sqlsubtype, PSQLVar^.SQLLen, PSQLVar^.SQLScale,
       TranslateFldType(PSQLVar^.SQLType, PSQLVar^.sqlsubtype, PSQLVar^.SQLLen, PSQLVar^.SQLScale,
         TransType, TransLen, TransPrec);
         TransType, TransLen, TransPrec);
 
 
-      // [var]AnsiChar or blob column character set NONE or OCTETS overrides connection charset
+      // [var]char or blob column character set NONE or OCTETS overrides connection charset
       if (((TransType in [ftString, ftFixedChar]) and (PSQLVar^.sqlsubtype and $FF in [CS_NONE,CS_BINARY])) and not UseConnectionCharSetIfNone)
       if (((TransType in [ftString, ftFixedChar]) and (PSQLVar^.sqlsubtype and $FF in [CS_NONE,CS_BINARY])) and not UseConnectionCharSetIfNone)
          or
          or
          ((TransType = ftMemo) and (PSQLVar^.relname_length>0) and (PSQLVar^.sqlname_length>0) and (GetBlobCharset(@PSQLVar^.relname,@PSQLVar^.sqlname) in [CS_NONE,CS_BINARY])) then
          ((TransType = ftMemo) and (PSQLVar^.relname_length>0) and (PSQLVar^.sqlname_length>0) and (GetBlobCharset(@PSQLVar^.relname,@PSQLVar^.sqlname) in [CS_NONE,CS_BINARY])) then
@@ -1200,6 +1198,7 @@ var
   li       : LargeInt;
   li       : LargeInt;
   CurrBuff : PAnsiChar;
   CurrBuff : PAnsiChar;
   w        : word;
   w        : word;
+  i128     : Int128Rec;
 
 
 begin
 begin
   {$push}
   {$push}
@@ -1283,6 +1282,15 @@ begin
           SetDateTime(VSQLVar^.SQLData, AParam.AsDateTime, VSQLVar^.SQLType);
           SetDateTime(VSQLVar^.SQLData, AParam.AsDateTime, VSQLVar^.SQLType);
         SQL_BOOLEAN_FIREBIRD:
         SQL_BOOLEAN_FIREBIRD:
           PByte(VSQLVar^.SQLData)^ := Byte(AParam.AsBoolean);
           PByte(VSQLVar^.SQLData)^ := Byte(AParam.AsBoolean);
+        SQL_INT128:
+          begin
+            i128 := BCDToInt128(AParam.AsFMTBCD);
+            Move(i128, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
+          end;
+        SQL_DEC16:
+          begin
+          // ToDo
+          end;
       else
       else
         if (VSQLVar^.sqltype <> SQL_NULL) then
         if (VSQLVar^.sqltype <> SQL_NULL) then
           DatabaseErrorFmt(SUnsupportedParameter,[FieldTypeNames[AParam.DataType]],self);
           DatabaseErrorFmt(SUnsupportedParameter,[FieldTypeNames[AParam.DataType]],self);
@@ -1294,12 +1302,14 @@ end;
 
 
 function TIBConnection.LoadField(cursor : TSQLCursor; FieldDef : TFieldDef; buffer : pointer; out CreateBlob : boolean) : boolean;
 function TIBConnection.LoadField(cursor : TSQLCursor; FieldDef : TFieldDef; buffer : pointer; out CreateBlob : boolean) : boolean;
 
 
+type
+  PInt128Rec = ^Int128Rec;
 var
 var
   VSQLVar    : PXSQLVAR;
   VSQLVar    : PXSQLVAR;
   VarcharLen : word;
   VarcharLen : word;
-  CurrBuff     : PAnsiChar;
-  c            : currency;
-  AFmtBcd      : tBCD;
+  CurrBuff   : PAnsiChar;
+  c          : currency;
+  AFmtBcd    : tBCD;
 
 
   function BcdDivPower10(Dividend: largeint; e: integer): TBCD;
   function BcdDivPower10(Dividend: largeint; e: integer): TBCD;
   var d: double;
   var d: double;
@@ -1358,15 +1368,22 @@ begin
           end;
           end;
         ftFMTBcd :
         ftFMTBcd :
           begin
           begin
-            case VSQLVar^.SQLLen of
-              2 : AFmtBcd := BcdDivPower10(PSmallint(CurrBuff)^, -VSQLVar^.SQLScale);
-              4 : AFmtBcd := BcdDivPower10(PLongint(CurrBuff)^,  -VSQLVar^.SQLScale);
-              8 : if Dialect < 3 then
-                    AFmtBcd := PDouble(CurrBuff)^
-                  else
-                    AFmtBcd := BcdDivPower10(PLargeint(CurrBuff)^, -VSQLVar^.SQLScale);
+            case (VSQLVar^.sqltype and not 1) of
+              SQL_DEC16:
+                // ToDo
+                AFmtBcd := 0;
               else
               else
-                Result := False; // Just to be sure, in principle this will never happen
+                case VSQLVar^.SQLLen of
+                  2 : AFmtBcd := BcdDivPower10(PSmallint(CurrBuff)^, -VSQLVar^.SQLScale);
+                  4 : AFmtBcd := BcdDivPower10(PLongint(CurrBuff)^,  -VSQLVar^.SQLScale);
+                  8 : if Dialect < 3 then
+                        AFmtBcd := PDouble(CurrBuff)^
+                      else
+                        AFmtBcd := BcdDivPower10(PLargeint(CurrBuff)^, -VSQLVar^.SQLScale);
+                  16: AFmtBcd := Int128ToBcd(PInt128Rec(CurrBuff)^);
+                  else
+                    Result := False; // Just to be sure, in principle this will never happen
+                end; {case}
             end; {case}
             end; {case}
             Move(AFmtBcd, buffer^ , sizeof(AFmtBcd));
             Move(AFmtBcd, buffer^ , sizeof(AFmtBcd));
           end;
           end;

+ 9 - 0
packages/ibase/src/ibase60.inc

@@ -1657,6 +1657,15 @@ type
      SQL_INT64 = 580;
      SQL_INT64 = 580;
   { Historical alias for pre V6 applications  }
   { Historical alias for pre V6 applications  }
      SQL_DATE = SQL_TIMESTAMP;
      SQL_DATE = SQL_TIMESTAMP;
+     // Moved here from ibconnection  
+     SQL_BOOLEAN_INTERBASE = 590;
+     SQL_INT128 = 32752;
+     SQL_DEC16 = 32760;
+     SQL_DEC34 = 32762;
+     SQL_BOOLEAN_FIREBIRD = 32764;
+     SQL_NULL = 32767;
+     INVALID_DATA = -1;
+       
   {                }
   {                }
   { Blob Subtypes  }
   { Blob Subtypes  }
   {                }
   {                }