paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 20:29:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
Mantis #20513

git-svn-id: trunk@19516 -
This commit is contained in:
marco 2011-10-19 15:11:08 +00:00
parent 4703b63c19
commit 047cff3944
4 changed files with 81 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
View File

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

22
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
View File

@ -201,7 +201,9 @@ begin
str1:= p.asstring; str1:= p.asstring;
checkerror(sqlite3_bind_text(fstatement,I,pcharstr(str1), length(str1),@freebindstring)); checkerror(sqlite3_bind_text(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
end; end;
ftblob: begin ftBytes,
ftVarBytes,
ftBlob: begin
str1:= P.asstring; str1:= P.asstring;
checkerror(sqlite3_bind_blob(fstatement,I,pcharstr(str1), length(str1),@freebindstring)); checkerror(sqlite3_bind_blob(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
end; end;
@ -351,7 +353,7 @@ Type
end; end;
Const Const
FieldMapCount = 24; FieldMapCount = 26;
FieldMap : Array [1..FieldMapCount] of TFieldMap = ( FieldMap : Array [1..FieldMapCount] of TFieldMap = (
(n:'INT'; t: ftInteger), (n:'INT'; t: ftInteger),
(n:'LARGEINT'; t:ftlargeInt), (n:'LARGEINT'; t:ftlargeInt),
@ -376,7 +378,9 @@ Const
(n:'BLOB'; t: ftBlob), (n:'BLOB'; t: ftBlob),
(n:'NCHAR'; t: ftFixedWideChar), (n:'NCHAR'; t: ftFixedWideChar),
(n:'NVARCHAR'; t: ftWideString), (n:'NVARCHAR'; t: ftWideString),
(n:'NCLOB'; t: ftWideMemo) (n:'NCLOB'; t: ftWideMemo),
(n:'VARBINARY'; t: ftVarBytes),
(n:'BINARY'; t: ftBytes)
{ Template: { Template:
(n:''; t: ft) (n:''; t: ft)
} }
@ -446,7 +450,9 @@ begin
ftString, ftString,
ftFixedChar, ftFixedChar,
ftFixedWideChar, ftFixedWideChar,
ftWideString: ftWideString,
ftBytes,
ftVarBytes:
begin begin
size1 := 255; //sql: if length is omitted then length is 1 size1 := 255; //sql: if length is omitted then length is 1
size2 := 0; size2 := 0;
@ -630,6 +636,14 @@ begin
if int1 > 0 then 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. 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; 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, ftWideMemo,
ftMemo, ftMemo,
ftBlob: CreateBlob:=True; ftBlob: CreateBlob:=True;

4
packages/fcl-db/tests/sqldbtoolsunit.pas
View File

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

17
packages/fcl-db/tests/testfieldtypes.pas
View File

@ -93,6 +93,7 @@ type
procedure TestFmtBCDParamQuery; procedure TestFmtBCDParamQuery;
procedure TestFloatParamQuery; procedure TestFloatParamQuery;
procedure TestBCDParamQuery; procedure TestBCDParamQuery;
procedure TestBytesParamQuery;
procedure TestAggregates; procedure TestAggregates;
procedure TestStringLargerThen8192; procedure TestStringLargerThen8192;
@ -148,6 +149,8 @@ const
'1900-01-01' '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; procedure TTestFieldTypes.TestpfInUpdateFlag;
var ds : TCustomBufDataset; var ds : TCustomBufDataset;
@ -793,6 +796,11 @@ begin
TestXXParamQuery(ftBCD,'NUMERIC(10,4)',testBCDValuesCount); TestXXParamQuery(ftBCD,'NUMERIC(10,4)',testBCDValuesCount);
end; end;
procedure TTestFieldTypes.TestBytesParamQuery;
begin
TestXXParamQuery(ftBytes, FieldtypeDefinitions[ftBytes], testBytesValuesCount);
end;
procedure TTestFieldTypes.TestStringParamQuery; procedure TTestFieldTypes.TestStringParamQuery;
begin begin
@ -816,6 +824,9 @@ procedure TTestFieldTypes.TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl
var i : integer; var i : integer;
begin 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+')'); 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 // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
@ -846,7 +857,8 @@ begin
else else
Params.ParamByName('field1').AsDate := StrToDate(testDateValues[i],'yyyy/mm/dd','-'); Params.ParamByName('field1').AsDate := StrToDate(testDateValues[i],'yyyy/mm/dd','-');
ftDateTime:Params.ParamByName('field1').AsDateTime := StrToDateTime(testValues[ADataType,i], DBConnector.FormatSettings); 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 else
AssertTrue('no test for paramtype available',False); AssertTrue('no test for paramtype available',False);
end; end;
@ -870,7 +882,8 @@ begin
ftTime : AssertEquals(testTimeValues[i],DateTimeToTimeString(FieldByName('FIELD1').AsDateTime)); ftTime : AssertEquals(testTimeValues[i],DateTimeToTimeString(FieldByName('FIELD1').AsDateTime));
ftDate : AssertEquals(testDateValues[i],DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings)); ftDate : AssertEquals(testDateValues[i],DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
ftDateTime : AssertEquals(testValues[ADataType,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 else
AssertTrue('no test for paramtype available',False); AssertTrue('no test for paramtype available',False);
end; end;