* Initial (var)binary field support for mysql and sqlite, patch by Lacak2,

    Mantis #20513

git-svn-id: trunk@19516 -

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -55,6 +55,7 @@ Type
     FNeedData : Boolean;
     FStatement : String;
     Row : MYSQL_ROW;
+    Lengths : PLongWord;                { Lengths of the columns of the current row }
     RowsAffected : QWord;
     LastInsertID : QWord;
     ParamBinding : TParamBinding;
@@ -79,7 +80,7 @@ Type
     Procedure ConnectToServer; virtual;
     Procedure SelectDatabase; virtual;
     function MySQLDataType(AField: PMYSQL_FIELD; var NewType: TFieldType; var NewSize: Integer): Boolean;
-    function MySQLWriteData(AType: enum_field_types;ASize: Integer; AFieldType: TFieldType; Source, Dest: PChar; out CreateBlob : boolean): Boolean;
+    function MySQLWriteData(AField: PMYSQL_FIELD; FieldDef: TFieldDef; Source, Dest: PChar; Len: integer; out CreateBlob : boolean): Boolean;
     // SQLConnection methods
     procedure DoInternalConnect; override;
     procedure DoInternalDisconnect; override;
@@ -695,6 +696,10 @@ begin
   C:=Cursor as TCursorName;
   C.Row:=MySQL_Fetch_row(C.FRes);
   Result:=(C.Row<>Nil);
+  if Result then
+    C.Lengths := mysql_fetch_lengths(C.FRes)
+  else
+    C.Lengths := nil;
 end;
 
 function TConnectionName.LoadField(cursor : TSQLCursor;
@@ -702,46 +707,41 @@ function TConnectionName.LoadField(cursor : TSQLCursor;
 
 var
   field: PMYSQL_FIELD;
-  row : MYSQL_ROW;
   C : TCursorName;
+  i : integer;
 
 begin
 //  Writeln('LoadFieldsFromBuffer');
   C:=Cursor as TCursorName;
-  if C.Row=nil then
+  if (C.Row=nil) or (C.Lengths=nil) then
      begin
   //   Writeln('LoadFieldsFromBuffer: row=nil');
      MySQLError(FMySQL,SErrFetchingData,Self);
      end;
-  Row:=C.Row;
-  
-  inc(Row,c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]);
-  field := mysql_fetch_field_direct(C.FRES, c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]);
 
-  Result := MySQLWriteData(field^.ftype, field^.length, FieldDef.DataType, Row^, Buffer, CreateBlob);
+  i := c.MapDSRowToMSQLRow[FieldDef.FieldNo-1];
+  field := mysql_fetch_field_direct(C.FRES, i);
+
+  Result := MySQLWriteData(field, FieldDef, C.Row[i], Buffer, C.Lengths[i], CreateBlob);
 end;
 
 procedure TConnectionName.LoadBlobIntoBuffer(FieldDef: TFieldDef;
   ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
 var
-  row : MYSQL_ROW;
   C : TCursorName;
-  li : longint;
-  Lengths : pculong;
+  i : integer;
+  len : longint;
 begin
   C:=Cursor as TCursorName;
-  if C.Row=nil then
+  if (C.Row=nil) or (C.Lengths=nil) then
     MySQLError(FMySQL,SErrFetchingData,Self);
-  Row:=C.Row;
-
-  inc(Row,c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]);
 
-  Lengths := mysql_fetch_lengths(c.FRes);
-  li := Lengths[c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]];
+  i := c.MapDSRowToMSQLRow[FieldDef.FieldNo-1];
+  len := C.Lengths[i];
 
-  ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer,li);
-  Move(pchar(row^)^, ABlobBuf^.BlobBuffer^.Buffer^, li);
-  ABlobBuf^.BlobBuffer^.Size := li;
+  ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer, len);
+  Move(C.Row[i]^, ABlobBuf^.BlobBuffer^.Buffer^, len);
+  ABlobBuf^.BlobBuffer^.Size := len;
 end;
 
 function InternalStrToFloat(S: string): Extended;
@@ -856,7 +856,7 @@ begin
   Result := Result + EncodeTime(EH, EN, ES, 0);;
 end;
 
-function TConnectionName.MySQLWriteData(AType: enum_field_types;ASize: Integer; AFieldType: TFieldType; Source, Dest: PChar; out CreateBlob : boolean): Boolean;
+function TConnectionName.MySQLWriteData(AField: PMYSQL_FIELD; FieldDef: TFieldDef; Source, Dest: PChar; Len: integer; out CreateBlob : boolean): Boolean;
 
 var
   VI: Integer;
@@ -873,8 +873,8 @@ begin
   CreateBlob := False;
   if Source = Nil then
     exit;
-  Src:=StrPas(Source);
-  case AType of
+  SetString(Src, Source, Len);
+  case AField^.ftype of
     FIELD_TYPE_TINY, FIELD_TYPE_SHORT:
       begin
       if (Src<>'') then
@@ -903,24 +903,26 @@ begin
     FIELD_TYPE_NEWDECIMAL,
 {$endif}      
     FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
-      if AFieldType = ftBCD then
-        begin
-        VC := InternalStrToCurrency(Src);
-        Move(VC, Dest^, SizeOf(Currency));
-        end
-      else if AFieldType = ftFmtBCD then
-        begin
-        VB:=StrToBCD(Src, FSQLFormatSettings);
-        Move(VB, Dest^, SizeOf(TBCD));
-        end
-      else
-        begin
-        if Src <> '' then
-          VF := InternalStrToFloat(Src)
+      case FieldDef.DataType of
+        ftBCD:
+          begin
+          VC := InternalStrToCurrency(Src);
+          Move(VC, Dest^, SizeOf(Currency));
+          end;
+        ftFmtBCD:
+          begin
+          VB := StrToBCD(Src, FSQLFormatSettings);
+          Move(VB, Dest^, SizeOf(TBCD));
+          end
         else
-          VF := 0;
-        Move(VF, Dest^, SizeOf(Double));
-        end;
+          begin
+          if Src <> '' then
+            VF := InternalStrToFloat(Src)
+          else
+            VF := 0;
+          Move(VF, Dest^, SizeOf(Double));
+          end;
+      end;
     FIELD_TYPE_TIMESTAMP:
       begin
       if Src <> '' then
@@ -967,10 +969,10 @@ begin
 }
       // String-fields which can contain more then dsMaxStringSize characters
       // are mapped to ftBlob fields, while their mysql-datatype is FIELD_TYPE_BLOB
-      if AFieldType in [ftBlob,ftMemo] then
+      if FieldDef.DataType in [ftBlob,ftMemo] then
         CreateBlob := True
       else if Src<> '' then
-        Move(Source^, Dest^, ASize)
+        Move(Source^, Dest^, FieldDef.Size)
       else
         Dest^ := #0;
       end;

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -201,7 +201,9 @@ begin
                 str1:= p.asstring;
                 checkerror(sqlite3_bind_text(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
                 end;
-        ftblob: begin
+        ftBytes,
+        ftVarBytes,
+        ftBlob: begin
                 str1:= P.asstring;
                 checkerror(sqlite3_bind_blob(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
                 end; 
@@ -351,7 +353,7 @@ Type
   end;
   
 Const
-  FieldMapCount = 24;
+  FieldMapCount = 26;
   FieldMap : Array [1..FieldMapCount] of TFieldMap = (
    (n:'INT'; t: ftInteger),
    (n:'LARGEINT'; t:ftlargeInt),
@@ -376,7 +378,9 @@ Const
    (n:'BLOB'; t: ftBlob),
    (n:'NCHAR'; t: ftFixedWideChar),
    (n:'NVARCHAR'; t: ftWideString),
-   (n:'NCLOB'; t: ftWideMemo)
+   (n:'NCLOB'; t: ftWideMemo),
+   (n:'VARBINARY'; t: ftVarBytes),
+   (n:'BINARY'; t: ftBytes)
 { Template:
   (n:''; t: ft)
 }
@@ -446,7 +450,9 @@ begin
       ftString,
       ftFixedChar,
       ftFixedWideChar,
-      ftWideString:
+      ftWideString,
+      ftBytes,
+      ftVarBytes:
                begin
                  size1 := 255; //sql: if length is omitted then length is 1
                  size2 := 0;
@@ -630,6 +636,14 @@ begin
       if int1 > 0 then
         move(sqlite3_column_text16(st,fnum)^, buffer^, int1); //Strings returned by sqlite3_column_text() and sqlite3_column_text16(), even empty strings, are always zero terminated.
       end;
+    ftBytes:
+      begin
+      int1 := sqlite3_column_bytes(st,fnum);
+      if int1 > FieldDef.Size then
+        int1 := FieldDef.Size;
+      if int1 > 0 then
+         move(sqlite3_column_blob(st,fnum)^, buffer^, int1);
+      end;
     ftWideMemo,
     ftMemo,
     ftBlob: CreateBlob:=True;

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -126,12 +126,16 @@ begin
     // mysql's timestamps are only valid in the range 1970-2038.
     // Downside is that fields defined as 'TIMESTAMP' aren't tested
     FieldtypeDefinitions[ftDateTime] := 'DATETIME';
+    FieldtypeDefinitions[ftBytes] := 'BINARY(5)';
+    FieldtypeDefinitions[ftVarBytes] := 'VARBINARY(10)';
     FieldtypeDefinitions[ftMemo] := 'TEXT';
     end;
   if SQLDbType = sqlite3 then
     begin
     Fconnection := TSQLite3Connection.Create(nil);
     FieldtypeDefinitions[ftCurrency] := 'CURRENCY';
+    FieldtypeDefinitions[ftBytes] := 'BINARY(5)';
+    FieldtypeDefinitions[ftVarBytes] := 'VARBINARY(10)';
     FieldtypeDefinitions[ftMemo] := 'CLOB'; //or TEXT SQLite supports both, but CLOB is sql standard (TEXT not)
     end;
   if SQLDbType = POSTGRESQL then

packages/fcl-db/tests/testfieldtypes.pas

@@ -93,6 +93,7 @@ type
     procedure TestFmtBCDParamQuery;
     procedure TestFloatParamQuery;
     procedure TestBCDParamQuery;
+    procedure TestBytesParamQuery;
     procedure TestAggregates;
 
     procedure TestStringLargerThen8192;
@@ -148,6 +149,8 @@ const
     '1900-01-01'
   );
 
+  testBytesValuesCount = 5;
+  testBytesValues : Array[0..testBytesValuesCount-1] of shortstring = (#1#0#1#0#1, #0#0#1#0#1, #0''''#13#0#1, '\'#0'"\'#13, #13#13#0#10#10);
 
 procedure TTestFieldTypes.TestpfInUpdateFlag;
 var ds   : TCustomBufDataset;
@@ -793,6 +796,11 @@ begin
   TestXXParamQuery(ftBCD,'NUMERIC(10,4)',testBCDValuesCount);
 end;
 
+procedure TTestFieldTypes.TestBytesParamQuery;
+begin
+  TestXXParamQuery(ftBytes, FieldtypeDefinitions[ftBytes], testBytesValuesCount);
+end;
+
 procedure TTestFieldTypes.TestStringParamQuery;
 
 begin
@@ -816,6 +824,9 @@ procedure TTestFieldTypes.TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl
 var i : integer;
 
 begin
+  if ASQLTypeDecl = '' then
+    Ignore('Fields of the type ' + FieldTypeNames[ADatatype] + ' are not supported by this sqldb-connection type');
+
   TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID INT, FIELD1 '+ASQLTypeDecl+')');
 
 // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
@@ -846,7 +857,8 @@ begin
                    else
                      Params.ParamByName('field1').AsDate := StrToDate(testDateValues[i],'yyyy/mm/dd','-');
         ftDateTime:Params.ParamByName('field1').AsDateTime := StrToDateTime(testValues[ADataType,i], DBConnector.FormatSettings);
-        ftFMTBcd : Params.ParamByName('field1').AsFMTBCD:= StrToBCD(testFmtBCDValues[i],DBConnector.FormatSettings)
+        ftFMTBcd : Params.ParamByName('field1').AsFMTBCD := StrToBCD(testFmtBCDValues[i],DBConnector.FormatSettings);
+        ftBytes  : Params.ParamByName('field1').AsBlob := testBytesValues[i];
       else
         AssertTrue('no test for paramtype available',False);
       end;
@@ -870,7 +882,8 @@ begin
         ftTime   : AssertEquals(testTimeValues[i],DateTimeToTimeString(FieldByName('FIELD1').AsDateTime));
         ftDate   : AssertEquals(testDateValues[i],DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
         ftDateTime : AssertEquals(testValues[ADataType,i], DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
-        ftFMTBcd : AssertEquals(testFmtBCDValues[i],BCDToStr(FieldByName('FIELD1').AsBCD,DBConnector.FormatSettings))
+        ftFMTBcd : AssertEquals(testFmtBCDValues[i], BCDToStr(FieldByName('FIELD1').AsBCD, DBConnector.FormatSettings));
+        ftBytes  : AssertEquals(testBytesValues[i], shortstring(FieldByName('FIELD1').AsString));
       else
         AssertTrue('no test for paramtype available',False);
       end;