* Trim stringfields longer then dsMaxStringSize in IBConnection + test. (bug 9600)

git-svn-id: trunk@8859 -

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -418,15 +418,13 @@ begin
       TrType := ftFMTBcd;
     end
   else case (SQLType and not 1) of
-    SQL_VARYING :
+    SQL_VARYING,SQL_TEXT :
       begin
         TrType := ftString;
-        TrLen := SQLLen;
-      end;
-    SQL_TEXT :
-      begin
-        TrType := ftString;
-        TrLen := SQLLen;
+        if SQLLen > dsMaxStringSize then
+          TrLen := dsMaxStringSize
+        else
+          TrLen := SQLLen;
       end;
     SQL_TYPE_DATE :
       TrType := ftDate{Time};
@@ -791,12 +789,14 @@ begin
         if ((SQLType and not 1) = SQL_VARYING) then
           begin
           Move(SQLData^, VarcharLen, 2);
+          if VarcharLen > dsMaxStringSize then
+            VarcharLen:=dsMaxStringSize;
           CurrBuff := SQLData + 2;
           end
         else
           begin
           CurrBuff := SQLData;
-          VarCharLen := SQLDA^.SQLVar[x].SQLLen;
+          VarCharLen := FieldDef.Size;
           end;
 
       Result := true;
@@ -827,7 +827,7 @@ begin
           GetDateTime(CurrBuff, Buffer, SQLDA^.SQLVar[x].SQLType);
         ftString  :
           begin
-            Move(CurrBuff^, Buffer^, SQLDA^.SQLVar[x].SQLLen);
+            Move(CurrBuff^, Buffer^, VarCharLen);
             PChar(Buffer + VarCharLen)^ := #0;
           end;
         ftFloat   :

packages/fcl-db/tests/testsqlfieldtypes.pas

@@ -26,7 +26,8 @@ type
     procedure TearDown; override;
     procedure RunTest; override;
   published
-    procedure TestRowsAffected;
+    procedure TestInsertLargeStringFields; // bug 9600
+    procedure TestRowsAffected; // bug 9758
     procedure TestStringsReplace;
     procedure TestCircularParams;
     procedure Test11Params;
@@ -871,6 +872,28 @@ begin
     inherited RunTest;
 end;
 
+procedure TTestFieldTypes.TestInsertLargeStringFields;
+begin
+  with TSQLDBConnector(DBConnector) do
+    begin
+    Connection.ExecuteDirect('create table FPDEV2 (         ' +
+                              '  ID INT NOT NULL          , ' +
+                              '  NAME VARCHAR(16000),       ' +
+                              '  PRIMARY KEY (ID)           ' +
+                              ')                            ');
+// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+    TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+    Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (1,''test1'')';
+    Query.ExecSQL;
+    query.sql.Text:='select * from FPDEV2';
+    Query.Open;
+    AssertEquals(query.FieldByName('NAME').AsString,'test1');
+    Query.insert;
+    query.fields[1].AsString:='11';
+    query.Close;
+    end;
+end;
+
 procedure TTestFieldTypes.TestRowsAffected;
 begin
   with TSQLDBConnector(DBConnector) do
@@ -880,6 +903,8 @@ begin
                               '  NAME VARCHAR(250),         ' +
                               '  PRIMARY KEY (ID)           ' +
                               ')                            ');
+// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+    TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
     Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (1,''test1'')';
     Query.ExecSQL;
     AssertEquals(1,query.RowsAffected);