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

git-svn-id: trunk@35245 -
This commit is contained in:
lacak 2017-01-06 08:39:15 +00:00
parent 49fc799e97
commit 18f081150d

View File

@ -923,10 +923,10 @@ begin
end; end;
procedure TIBConnection.Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams); procedure TIBConnection.Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams);
var tr : pointer; var TransactionHandle : pointer;
out_SQLDA : PXSQLDA; out_SQLDA : PXSQLDA;
begin begin
tr := aTransaction.Handle; TransactionHandle := aTransaction.Handle;
if Assigned(APArams) and (AParams.count > 0) then SetParameters(cursor, atransaction, AParams); if Assigned(APArams) and (AParams.count > 0) then SetParameters(cursor, atransaction, AParams);
if LogEvent(detParamValue) then if LogEvent(detParamValue) then
LogParams(AParams); LogParams(AParams);
@ -936,7 +936,7 @@ begin
out_SQLDA := SQLDA out_SQLDA := SQLDA
else else
out_SQLDA := nil; 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); CheckError('Execute', Status);
end; end;
end; end;
@ -947,29 +947,44 @@ const
CS_NONE=0; CS_NONE=0;
CS_BINARY=1; CS_BINARY=1;
var var
x : integer; i : integer;
PSQLVar : PXSQLVAR;
TransLen, TransLen,
TransPrec : word; TransPrec : word;
TransType : TFieldType; 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 begin
{$push} {$push}
{$R-} {$R-}
with cursor as TIBCursor do with cursor as TIBCursor do
begin begin
setlength(FieldBinding,SQLDA^.SQLD); setlength(FieldBinding,SQLDA^.SQLD);
for x := 0 to SQLDA^.SQLD - 1 do for i := 0 to SQLDA^.SQLD - 1 do
begin 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); TransType, TransLen, TransPrec);
// column character set NONE or OCTETS overrides connection charset // [var]char or blob 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 if ((TransType in [ftString, ftFixedChar]) and (PSQLVar^.sqlsubtype and $FF in [CS_NONE,CS_BINARY])) or
FieldDefs.Add(SQLDA^.SQLVar[x].AliasName, TransType, TransLen, TransPrec, (SQLDA^.SQLVar[x].sqltype and 1)=0, False, x+1, CP_NONE) ((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 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;
end; end;
{$pop} {$pop}