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

fcl-db: interbase: detect BLOB CHARACTER SET NONE and set TMemoField.CodePage to CP_NONE in this case. Related to

Browse Source 
git-svn-id: trunk@35245 -
This commit is contained in:
lacak 2017-01-06 08:39:15 +00:00
parent 49fc799e97
commit 18f081150d
1 changed files with 26 additions and 11 deletions

37
packages/fcl-db/src/sqldb/interbase/ibconnection.pp
View File

@ -923,10 +923,10 @@ begin
end;
procedure TIBConnection.Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams);
var tr : pointer;
var TransactionHandle : pointer;
out_SQLDA : PXSQLDA;
begin
tr := aTransaction.Handle;
TransactionHandle := aTransaction.Handle;
if Assigned(APArams) and (AParams.count > 0) then SetParameters(cursor, atransaction, AParams);
if LogEvent(detParamValue) then
LogParams(AParams);
@ -936,7 +936,7 @@ begin
out_SQLDA := SQLDA
else
out_SQLDA := nil;
if isc_dsql_execute2(@Status[0], @tr, @StatementHandle, 1, in_SQLDA, out_SQLDA) <> 0 then
if isc_dsql_execute2(@Status[0], @TransactionHandle, @StatementHandle, 1, in_SQLDA, out_SQLDA) <> 0 then
CheckError('Execute', Status);
end;
end;
@ -947,29 +947,44 @@ const
CS_NONE=0;
CS_BINARY=1;
var
x : integer;
i : integer;
PSQLVar : PXSQLVAR;
TransLen,
TransPrec : word;
TransType : TFieldType;
function GetBlobCharset(TableName,ColumnName: Pointer): smallint;
var TransactionHandle: pointer;
BlobDesc: TISC_BLOB_DESC;
Global: array[0..31] of AnsiChar;
begin
TransactionHandle := TIBCursor(cursor).TransactionHandle;
if isc_blob_lookup_desc(@FStatus[0], @FDatabaseHandle, @TransactionHandle,
TableName, ColumnName, @BlobDesc, @Global) <> 0 then
CheckError('Blob Charset', FStatus);
Result := BlobDesc.blob_desc_charset;
end;
begin
{$push}
{$R-}
with cursor as TIBCursor do
begin
setlength(FieldBinding,SQLDA^.SQLD);
for x := 0 to SQLDA^.SQLD - 1 do
for i := 0 to SQLDA^.SQLD - 1 do
begin
TranslateFldType(SQLDA^.SQLVar[x].SQLType, SQLDA^.SQLVar[x].sqlsubtype, SQLDA^.SQLVar[x].SQLLen, SQLDA^.SQLVar[x].SQLScale,
PSQLVar := @SQLDA^.SQLVar[i];
TranslateFldType(PSQLVar^.SQLType, PSQLVar^.sqlsubtype, PSQLVar^.SQLLen, PSQLVar^.SQLScale,
TransType, TransLen, TransPrec);
// column character set NONE or OCTETS overrides connection charset
if (TransType in [ftString, ftFixedChar]) and (SQLDA^.SQLVar[x].sqlsubtype and $FF in [CS_NONE,CS_BINARY]) then
FieldDefs.Add(SQLDA^.SQLVar[x].AliasName, TransType, TransLen, TransPrec, (SQLDA^.SQLVar[x].sqltype and 1)=0, False, x+1, CP_NONE)
// [var]char or blob column character set NONE or OCTETS overrides connection charset
if ((TransType in [ftString, ftFixedChar]) and (PSQLVar^.sqlsubtype and $FF in [CS_NONE,CS_BINARY])) or
((TransType = ftMemo) and (PSQLVar^.relname_length>0) and (PSQLVar^.sqlname_length>0) and (GetBlobCharset(@PSQLVar^.relname,@PSQLVar^.sqlname) in [CS_NONE,CS_BINARY])) then
FieldDefs.Add(PSQLVar^.AliasName, TransType, TransLen, TransPrec, (PSQLVar^.sqltype and 1)=0, False, i+1, CP_NONE)
else
AddFieldDef(FieldDefs, x+1, SQLDA^.SQLVar[x].AliasName, TransType, TransLen, TransPrec, True, (SQLDA^.SQLVar[x].sqltype and 1)=0, False);
AddFieldDef(FieldDefs, i+1, PSQLVar^.AliasName, TransType, TransLen, TransPrec, True, (PSQLVar^.sqltype and 1)=0, False);
FieldBinding[x] := x;
FieldBinding[i] := i;
end;
end;
{$pop}