I'm using
Lazarus 2.1.0 r64512 FPC 3.2.1 i386-win32-win32/win64 and Zeos 7.2.8
Using an ADO-Connection Zeos sets the codepage for a StringField in
procedure TZAbstractRODataset.InternalInitFieldDefs;
Line 3378 to CodePage := GetColumnCodePage(I)
Code: Select all
{$IFDEF WITH_CODEPAGE_AWARE_FIELD}
if FieldType in [ftWideString, ftWideMemo] then
CodePage := zCP_UTF16
else if FieldType in [ftString, ftFixedChar, ftMemo] then
if SQLType in [stUnicodeString, stUnicodeStream] then
if Connection.ControlsCodePage = cGET_ACP
then CodePage := CP_ACP
else CodePage := zCP_UTF8
else CodePage := GetColumnCodePage(I)
else CodePage := CP_ACP;
{$ENDIF}
The FPC-RTL tries now to convert this String to UTF-8 and the default Widestringmanager uses the MultiByteToWideChar Windowsfunction. This function fails (as it is not an UTF16-String), an the returned string is empty.
I suppose the following changes to TZAbstractRODataset.InternalInitFieldDefs to set the codepage for a StringField to the Connection.ControlsCodepage :
Code: Select all
procedure TZAbstractRODataset.InternalInitFieldDefs;
var
I, J, Size: Integer;
AutoInit: Boolean;
FieldType: TFieldType;
SQLType: TZSQLType;
ResultSet: IZResultSet;
FieldName: string;
FName: string;
{$IFDEF WITH_CODEPAGE_AWARE_FIELD}
CodePage: TSystemCodePage;
function GetCPFromControlsCP : TSystemCodePage;
begin
{$IFDEF UNICODE}
case Connection.ControlsCodepage of
cCP_UTF8 : Result := CP_UTF8;
cGET_ACP : Result := CP_ACP
else
Result := CP_UTF16;
end;
{$ELSE}
{$IFDEF FPC}
case Connection.ControlsCodepage of
cCP_UTF16 : Result := CP_UTF16;
cGET_ACP : Result := CP_ACP;
else
Result := CP_UTF8;
end;
{$ELSE}
case Connection.ControlsCodepage of
cCP_UTF8 : Result := CP_UTF8;
cCP_UTF16 : Result := CP_UTF16;
else
Result := CP_ACP;
end;
{$ENDIF}
{$ENDIF}
end;
{$ELSE}
ConSettings: PZConSettings;
{$ENDIF}
begin
FieldDefs.Clear;
ResultSet := Self.ResultSet;
AutoInit := ResultSet = nil;
try
{ Opens an internal result set if query is closed. }
if AutoInit then
begin
CheckSQLQuery;
CheckConnected;
Prepare;
ResultSet := CreateResultSet(FSQL.Statements[0].SQL, 0);
end;
if not Assigned(ResultSet) then
raise Exception.Create(SCanNotOpenResultSet);
{ Reads metadata from resultset. }
with ResultSet.GetMetadata do
begin
{$IFNDEF WITH_CODEPAGE_AWARE_FIELD}
ConSettings := ResultSet.GetConSettings;
{$ENDIF}
if GetColumnCount > 0 then
for I := FirstDbcIndex to GetColumnCount{$IFDEF GENERIC_INDEX}-1{$ENDIF} do
begin
SQLType := GetColumnType(I);
FieldType := ConvertDbcToDatasetType(SQLType);
if (FieldType = ftCurrency) and not ResultSet.GetMetadata.IsCurrency(I) then
FieldType := ftBCD;
if FieldType in [ftBytes, ftVarBytes, ftString, ftWidestring] then begin
Size := GetPrecision(I);
{$IFNDEF WITH_CODEPAGE_AWARE_FIELD}
if (FieldType = ftString) then
if (ConSettings^.CPType = cCP_UTF8)
then Size := Size * 4
else Size := Size * ZOSCodePageMaxCharSize
else {$ENDIF}if (FieldType = ftWideString) and (doAlignMaxRequiredWideStringFieldSize in Options) {and (ConSettings.ClientCodePage.CharWidth > 3)} then
Size := Size * 2;
{if (ConSettings^.CPType = cCP_UTF8) or (ConSettings^.ClientCodePage^.Encoding = ceUTF16) or
((not ConSettings^.AutoEncode) and (ConSettings^.ClientCodePage^.Encoding = ceUTF8)) or
((ConSettings^.CPType = cGET_ACP) and (ZOSCodePage = zCP_UTF8)) then
Size := Size * 4
else
Size := Size * ConSettings^.ClientCodePage^.CharWidth;}
end else
{$IFDEF WITH_FTGUID}
if FieldType = ftGUID then
Size := 38
else
{$ENDIF}
if FieldType = ftBCD then
Size := GetScale(I)
else
Size := 0;
J := 0;
FieldName := GetColumnLabel(I);
FName := FieldName;
while FieldDefs.IndexOf(FName) >= 0 do
begin
Inc(J);
FName := Format('%s_%d', [FieldName, J]);
end;
{$IFDEF WITH_CODEPAGE_AWARE_FIELD}
if FieldType in [ftWideString, ftWideMemo] then
CodePage := zCP_UTF16
else if FieldType in [ftString, ftFixedChar, ftMemo] then
if SQLType in [stUnicodeString, stUnicodeStream] then
if Connection.ControlsCodePage = cGET_ACP
then CodePage := CP_ACP
else CodePage := zCP_UTF8
else CodePage := GetCPFromControlsCP // GetColumnCodePage(I)
else CodePage := CP_ACP;
{$ENDIF}
if FUseZFields then
with TZFieldDef.Create(FieldDefs, FName, FieldType, SQLType, Size, False, I{$IFDEF WITH_CODEPAGE_AWARE_FIELD}, CodePage{$ENDIF}) do begin
if not (ReadOnly or IsUniDirectional) then begin
{$IFNDEF OLDFPC}
Required := IsWritable(I) and (IsNullable(I) = ntNoNulls);
{$ENDIF}
if IsReadOnly(I) then Attributes := Attributes + [faReadonly];
end else
Attributes := Attributes + [faReadonly];
Precision := GetPrecision(I);
DisplayName := FName;
end
else with TFieldDef.Create(FieldDefs, FName, FieldType, Size, False, I{$IFDEF WITH_CODEPAGE_AWARE_FIELD}, CodePage{$ENDIF}) do begin
if not (ReadOnly or IsUniDirectional) then begin
{$IFNDEF OLDFPC}
Required := IsWritable(I) and (IsNullable(I) = ntNoNulls);
{$ENDIF}
if IsReadOnly(I) then Attributes := Attributes + [faReadonly];
end else
Attributes := Attributes + [faReadonly];
Precision := GetPrecision(I);
DisplayName := FName;
end;
end;
end;
finally
{ Closes localy opened resultset. }
if AutoInit then
begin
if ResultSet <> nil then
begin
ResultSet.Close;
ResultSet := nil;
end;
UnPrepare;
end;
end;
Greetings