| 25 |
|
* |
| 26 |
|
*) |
| 27 |
|
unit FB25Array; |
| 28 |
+ |
{$IFDEF MSWINDOWS} |
| 29 |
+ |
{$DEFINE WINDOWS} |
| 30 |
+ |
{$ENDIF} |
| 31 |
|
|
| 32 |
|
{$IFDEF FPC} |
| 33 |
< |
{$mode objfpc}{$H+} |
| 33 |
> |
{$mode delphi} |
| 34 |
|
{$codepage UTF8} |
| 35 |
|
{$interfaces COM} |
| 36 |
|
{$ENDIF} |
| 50 |
|
FCodePage: TSystemCodePage; |
| 51 |
|
protected |
| 52 |
|
procedure LoadMetaData(aAttachment: IAttachment; aTransaction: ITransaction; |
| 53 |
< |
relationName, columnName: string); override; |
| 53 |
> |
relationName, columnName: AnsiString); override; |
| 54 |
|
public |
| 55 |
|
function GetCharSetID: cardinal; override; |
| 56 |
|
function GetCodePage: TSystemCodePage; override; |
| 78 |
|
sGetArrayMetaData = 'Select F.RDB$CHARACTER_SET_ID '+ |
| 79 |
|
'From RDB$FIELDS F JOIN RDB$RELATION_FIELDS RF '+ |
| 80 |
|
'On F.RDB$FIELD_NAME = RF.RDB$FIELD_SOURCE '+ |
| 81 |
< |
'Where RF.RDB$RELATION_NAME = ? and RF.RDB$FIELD_NAME = ?'; |
| 81 |
> |
'Where RF.RDB$RELATION_NAME = ? and RF.RDB$FIELD_NAME = ? '+ |
| 82 |
> |
'UNION '+ |
| 83 |
> |
'Select F.RDB$CHARACTER_SET_ID '+ |
| 84 |
> |
'From RDB$FIELDS F JOIN RDB$PROCEDURE_PARAMETERS PP '+ |
| 85 |
> |
'On F.RDB$FIELD_NAME = PP.RDB$FIELD_SOURCE '+ |
| 86 |
> |
'Where PP.RDB$PROCEDURE_NAME = ? and PP.RDB$PARAMETER_NAME = ?'; |
| 87 |
|
|
| 88 |
|
{ TFB25ArrayMetaData } |
| 89 |
|
|
| 90 |
|
procedure TFB25ArrayMetaData.LoadMetaData(aAttachment: IAttachment; |
| 91 |
< |
aTransaction: ITransaction; relationName, columnName: string); |
| 91 |
> |
aTransaction: ITransaction; relationName, columnName: AnsiString); |
| 92 |
|
var |
| 93 |
|
DBHandle: TISC_DB_HANDLE; |
| 94 |
|
TRHandle: TISC_TR_HANDLE; |
| 95 |
|
stmt: IStatement; |
| 96 |
|
CharWidth: integer; |
| 97 |
+ |
RelName: AnsiString; |
| 98 |
+ |
ColName: AnsiString; |
| 99 |
|
begin |
| 100 |
|
DBHandle := (aAttachment as TFB25Attachment).Handle; |
| 101 |
|
TRHandle := (aTransaction as TFB25Transaction).Handle; |
| 102 |
+ |
RelName := AnsiUpperCase(relationName); |
| 103 |
+ |
ColName := AnsiUpperCase(columnName); |
| 104 |
|
with Firebird25ClientAPI do |
| 105 |
|
if isc_array_lookup_bounds(StatusVector,@(DBHandle),@(TRHandle), |
| 106 |
< |
PChar(AnsiUpperCase(relationName)),PChar(AnsiUpperCase(columnName)),@FArrayDesc) > 0 then |
| 106 |
> |
PAnsiChar(RelName),PAnsiChar(ColName),@FArrayDesc) > 0 then |
| 107 |
|
IBDatabaseError; |
| 108 |
|
|
| 109 |
|
if (GetSQLType = SQL_TEXT) or (GetSQLType = SQL_VARYING) then |
| 114 |
|
begin |
| 115 |
|
SQLParams[0].AsString := RelationName; |
| 116 |
|
SQLParams[1].AsString := ColumnName; |
| 117 |
+ |
SQLParams[2].AsString := RelationName; |
| 118 |
+ |
SQLParams[3].AsString := ColumnName; |
| 119 |
|
with OpenCursor do |
| 120 |
|
if FetchNext then |
| 121 |
|
begin |
| 129 |
|
else |
| 130 |
|
begin |
| 131 |
|
FCodePage := CP_NONE; |
| 132 |
< |
FirebirdClientAPI.CharSetID2CodePage(FCharSetID,FCodePage); |
| 132 |
> |
FAttachment.CharSetID2CodePage(FCharSetID,FCodePage); |
| 133 |
|
end; |
| 134 |
|
end; |
| 135 |
|
end; |
| 138 |
|
(FCharSetID = 0) then {This really shouldn't be necessary - but it is :(} |
| 139 |
|
with aAttachment as TFBAttachment do |
| 140 |
|
begin |
| 141 |
< |
if HasDefaultCharSet and FirebirdClientAPI.CharSetWidth(CharSetID,CharWidth) then |
| 142 |
< |
FArrayDesc.array_desc_length *= CharWidth; |
| 141 |
> |
if HasDefaultCharSet and FAttachment.CharSetWidth(CharSetID,CharWidth) then |
| 142 |
> |
FArrayDesc.array_desc_length := FArrayDesc.array_desc_length * CharWidth; |
| 143 |
|
end; |
| 144 |
|
end; |
| 145 |
|
|
