paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 02:06:10 +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

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

@ -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]);
i := c.MapDSRowToMSQLRow[FieldDef.FieldNo-1];
len := C.Lengths[i];
Lengths := mysql_fetch_lengths(c.FRes);
li := Lengths[c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]];
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;

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

@ -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;

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.
// 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

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

@ -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;