From 77daccf9e6bc916a4f4f97efed606f71ba3a7d5b Mon Sep 17 00:00:00 2001
From: joost <joost@cnoc.nl>
Date: Fri, 19 Oct 2007 22:07:56 +0000
Subject: [PATCH]  * Added checks to TField.Size  * Cleanup and several fixes
 regarding TField.Size in IBconnection

git-svn-id: trunk@8856 -
---
 packages/fcl-db/src/db.pas                    |  2 +-
 packages/fcl-db/src/fields.inc                |  2 +-
 .../src/sqldb/interbase/ibconnection.pp       | 47 +++++--------------
 3 files changed, 14 insertions(+), 37 deletions(-)

diff --git a/packages/fcl-db/src/db.pas b/packages/fcl-db/src/db.pas
index d52a84a3a6..1ce04d5fde 100644
--- a/packages/fcl-db/src/db.pas
+++ b/packages/fcl-db/src/db.pas
@@ -397,7 +397,7 @@ type
     property IsNull: Boolean read GetIsNull;
     property NewValue: Variant read GetNewValue write SetNewValue;
     property Offset: word read FOffset;
-    property Size: Word read FSize write FSize;
+    property Size: Word read FSize write SetSize;
     property Text: string read GetEditText write SetEditText;
     property ValidChars : TFieldChars Read FValidChars;
     property Value: variant read GetAsVariant write SetAsVariant;
diff --git a/packages/fcl-db/src/fields.inc b/packages/fcl-db/src/fields.inc
index 72a32876f6..3f658aa7ee 100644
--- a/packages/fcl-db/src/fields.inc
+++ b/packages/fcl-db/src/fields.inc
@@ -950,7 +950,7 @@ begin
   SetDataType(ftString);
   FFixedChar := False;
   FTransliterate := False;
-  Size:=20;
+  FSize:=20;
 end;
 
 class procedure TStringField.CheckTypeSize(AValue: Longint);
diff --git a/packages/fcl-db/src/sqldb/interbase/ibconnection.pp b/packages/fcl-db/src/sqldb/interbase/ibconnection.pp
index 16c9dd4121..6304dd4804 100644
--- a/packages/fcl-db/src/sqldb/interbase/ibconnection.pp
+++ b/packages/fcl-db/src/sqldb/interbase/ibconnection.pp
@@ -53,12 +53,12 @@ type
     function GetDialect: integer;
     procedure SetDBDialect;
     procedure AllocSQLDA(var aSQLDA : PXSQLDA;Count : integer);
-    procedure TranslateFldType(SQLType, SQLLen, SQLScale : integer; var LensSet : boolean;
+    procedure TranslateFldType(SQLType, SQLLen, SQLScale : integer;
       var TrType : TFieldType; var TrLen : word);
     // conversion methods
     procedure GetDateTime(CurrBuff, Buffer : pointer; AType : integer);
     procedure SetDateTime(CurrBuff: pointer; PTime : TDateTime; AType : integer);
-    procedure GetFloat(CurrBuff, Buffer : pointer; Field : TFieldDef);
+    procedure GetFloat(CurrBuff, Buffer : pointer; Size : Byte);
     procedure SetFloat(CurrBuff: pointer; Dbl: Double; Size: integer);
     procedure CheckError(ProcName : string; Status : PISC_STATUS);
     function getMaxBlobSize(blobHandle : TIsc_Blob_Handle) : longInt;
@@ -403,17 +403,15 @@ begin
     reAllocMem(aSQLDA,0);
 end;
 
-procedure TIBConnection.TranslateFldType(SQLType, SQLLen, SQLScale : integer; var LensSet : boolean;
-  var TrType : TFieldType; var TrLen : word);
+procedure TIBConnection.TranslateFldType(SQLType, SQLLen, SQLScale : integer;
+           var TrType : TFieldType; var TrLen : word);
 begin
-  LensSet := False;
-
+  trlen := 0;
   if SQLScale < 0 then
     begin
     if (SQLScale >= -4) and (SQLScale <= -1) then //in [-4..-1] then
       begin
-      LensSet := True;
-      TrLen := SQLLen;
+      TrLen := abs(SQLScale);
       TrType := ftBCD
       end
     else
@@ -422,13 +420,11 @@ begin
   else case (SQLType and not 1) of
     SQL_VARYING :
       begin
-        LensSet := True;
         TrType := ftString;
         TrLen := SQLLen;
       end;
     SQL_TEXT :
       begin
-        LensSet := True;
         TrType := ftString;
         TrLen := SQLLen;
       end;
@@ -441,43 +437,25 @@ begin
     SQL_ARRAY :
       begin
         TrType := ftArray;
-        LensSet := true;
         TrLen := SQLLen;
       end;
     SQL_BLOB :
       begin
-          TrType := ftBlob;
-          LensSet := True;
-          TrLen := SQLLen;
+        TrType := ftBlob;
+        TrLen := SQLLen;
       end;
     SQL_SHORT :
         TrType := ftSmallint;
     SQL_LONG :
-      begin
-        LensSet := True;
-        TrLen := 0;
         TrType := ftInteger;
-      end;
     SQL_INT64 :
         TrType := ftLargeInt;
     SQL_DOUBLE :
-      begin
-        LensSet := True;
-        TrLen := SQLLen;
         TrType := ftFloat;
-      end;
     SQL_FLOAT :
-      begin
-        LensSet := True;
-        TrLen := SQLLen;
         TrType := ftFloat;
-      end
     else
-      begin
-        LensSet := True;
-        TrLen := 0;
         TrType := ftUnknown;
-      end;
   end;
 end;
 
@@ -633,7 +611,6 @@ end;
 procedure TIBConnection.AddFieldDefs(cursor: TSQLCursor;FieldDefs : TfieldDefs);
 var
   x         : integer;
-  lenset    : boolean;
   TransLen  : word;
   TransType : TFieldType;
   FD        : TFieldDef;
@@ -646,7 +623,7 @@ begin
     for x := 0 to SQLDA^.SQLD - 1 do
       begin
       TranslateFldType(SQLDA^.SQLVar[x].SQLType, SQLDA^.SQLVar[x].SQLLen, SQLDA^.SQLVar[x].SQLScale,
-        lenset, TransType, TransLen);
+        TransType, TransLen);
       FD := TFieldDef.Create(FieldDefs, SQLDA^.SQLVar[x].AliasName, TransType,
          TransLen, False, (x + 1));
       if TransType = ftBCD then FD.precision := SQLDA^.SQLVar[x].SQLLen;
@@ -854,7 +831,7 @@ begin
             PChar(Buffer + VarCharLen)^ := #0;
           end;
         ftFloat   :
-          GetFloat(CurrBuff, Buffer, FieldDef);
+          GetFloat(CurrBuff, Buffer, SQLDA^.SQLVar[x].SQLLen);
         ftBlob : begin  // load the BlobIb in field's buffer
             FillByte(buffer^,sizeof(TBufBlobField),0);
             Move(CurrBuff^, Buffer^, SQLDA^.SQLVar[x].SQLLen);
@@ -1066,13 +1043,13 @@ begin
   end;
 end;
 
-procedure TIBConnection.GetFloat(CurrBuff, Buffer : pointer; Field : TFieldDef);
+procedure TIBConnection.GetFloat(CurrBuff, Buffer : pointer; Size : byte);
 var
   Ext : extended;
   Dbl : double;
   Sin : single;
 begin
-  case Field.Size of
+  case Size of
     4 :
       begin
         Move(CurrBuff^, Sin, 4);