Delphi ADO BCD 十进制字段值设置不正确

Question

I have created a bug on the Embarcadero quality portal. But maybe someone has a workaround to make the test project work on these marks:

• Connectivity mechanism is still AdoConnection + AdoTable
• The value posted to a database is equal to the value selected from the database
• TestField type is not changed (Decimal(15, 3))
• User doesn't have to reconfigure regional settings.

Issue Details

• Affects Version/s: XE7, 10.2 Tokyo Release 3, 10.3 Rio Release 3
• Build No: Delphi 10.3 Version 26.0.36039.7899
• Platform: Windows 10

The bug appears when you have Windows regional settings : dot as grouping symbol and comma as decimal separator.

When you try to set the value to Decimal field in MS-ACCESS database using AdoConnection + AdoTable, you get actual value multiplied with scale, ie: you set 12,354 you get 12354 for Decimal(15,3) field in MDB.

Test project https://github.com/IgorKaplya/AdoBcdBug

unit Unit1;

interface

uses
  System.SysUtils, System.Variants, System.Classes,
  Vcl.Controls, Vcl.Forms, Vcl.StdCtrls,
  Data.DB, FireDAC.Comp.Client, Data.Win.ADODB, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf,
  FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MSAcc,
  FireDAC.Phys.MSAccDef, FireDAC.VCLUI.Wait, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt,
  FireDAC.Comp.DataSet;

type
  TForm1 = class(TForm)
    conFDac: TFDConnection;
    TableFireDac: TFDTable;
    mmLog: TMemo;
    conAdo: TADOConnection;
    TableAdo: TADOTable;
    btnTestBcdAdo: TButton;
    btnBcdTestFDac: TButton;
    btnSimpleAdo: TButton;
    btnSimpleFDac: TButton;
    procedure btnBcdTestFDacClick(Sender: TObject);
    procedure btnSimpleAdoClick(Sender: TObject);
    procedure btnSimpleFDacClick(Sender: TObject);
    procedure btnTestBcdAdoClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FTestField: string;
    FTestTable: string;
    procedure AddInvitationMessage;
    procedure EnsureTestTableExists;
    procedure InitializeAdoConnection;
    procedure InitializeFDacConnection;
    procedure SetupTableComponents;
    procedure TestBCD(const ATable: TDataSet);
    procedure TestSimple(const ATable: TDataSet);
    { Private declarations }
  public
    property TestField: string read FTestField write FTestField;
    property TestTable: string read FTestTable write FTestTable;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  Data.FmtBcd;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  AddInvitationMessage();
  InitializeAdoConnection;
  EnsureTestTableExists();
  InitializeFDacConnection;
  SetupTableComponents();
end;

procedure TForm1.AddInvitationMessage;
const
  description_message =
    'Hi, the bug appears when you have Windows regional settings: dot as grouping symbol and comma as decimal sepearator';
  affected_message: array[Boolean] of string = ('NOT AFFECTED', 'AFFECTED');
var
  systemIsAffected: Boolean;
begin
  mmLog.Lines.Add(description_message);
  mmLog.Lines.Add(Format('  Your grouping symbol: %s', [QuotedStr(FormatSettings.ThousandSeparator)]));
  mmLog.Lines.Add(Format('  Your decimal separator: %s', [QuotedStr(FormatSettings.DecimalSeparator)]));

  systemIsAffected :=
    SameText(FormatSettings.ThousandSeparator, '.') and
    SameText(FormatSettings.DecimalSeparator, ',');

  mmLog.Lines.Add('This system should be '+ affected_message[systemIsAffected]);
end;

procedure TForm1.btnBcdTestFDacClick(Sender: TObject);
begin
  TestBCD(TableFireDac);
end;

procedure TForm1.btnSimpleAdoClick(Sender: TObject);
begin
  TestSimple(TableAdo);
end;

procedure TForm1.btnSimpleFDacClick(Sender: TObject);
begin
  TestSimple(TableFireDac);
end;

procedure TForm1.InitializeFDacConnection;
begin
  conFDac.DriverName := 'MSAcc';
  conFDac.Params.Database := '.\TestBase.mdb';
  conFDac.Connected := True;
  TableFireDac.Connection := conFDac;
end;

procedure TForm1.InitializeAdoConnection;
const
  ado_jet_connection_string =
    'Provider=Microsoft.Jet.OLEDB.4.0;'+
    'Data Source=TestBase.mdb;'+
    'Mode=ReadWrite;'+
    'Persist Security Info=False;';
  ado_ace_connection_string =
    'Provider=Microsoft.ACE.OLEDB.12.0;'+
    'Data Source=TestBase.mdb;'+
    'Mode=ReadWrite;'+
    'Persist Security Info=False;';
begin
  conAdo.ConnectionString := ado_ace_connection_string;
  conAdo.Connected := True;
  TableAdo.Connection := conAdo;
end;

procedure TForm1.EnsureTestTableExists;
var
  dummy: Integer;
  tables: TStringList;
begin
  TestTable := 'test_table';
  TestField := 'test_field';

  tables := TStringList.Create;
  tables.Sorted := true;
  try
    conAdo.GetTableNames(tables);
    if tables.Find(TestTable, dummy) then
      conAdo.Execute(format('drop table %s', [TestTable]));
    conAdo.Execute(format('create table %s (%s decimal(15,3))', [TestTable, TestField]));
  finally
    tables.Free;
  end;
end;

procedure TForm1.SetupTableComponents;
begin
  TableAdo.TableName := TestTable;
  TableFireDac.TableName := TestTable;
end;

procedure TForm1.TestBCD(const ATable: TDataSet);
var
  doubleValue: Double;
  bcd, normalizedBcd: TBCD;
  postedValue, reloadedValue: string;
begin
  mmLog.Lines.Add('');
  mmLog.Lines.Add('TestBCD: '+ATable.Name);

  doubleValue := 12.34567;
  mmLog.Lines.Add('Double: '+ doubleValue.ToString);

  bcd := DoubleToBcd(doubleValue);
  mmLog.Lines.Add('BCD: '+ BcdToStr(bcd));

  NormalizeBcd(bcd, normalizedBcd, 15, 3);
  mmLog.Lines.Add('Normalized BCD: '+BcdToStr(normalizedBcd));

  ATable.Open;
  ATable.Insert;
  ATable.FieldByName(TestField).AsBCD := normalizedBcd;
  ATable.Post;
  postedValue := ATable.FieldByName(TestField).AsString;
  mmLog.Lines.Add('Posted: ' + postedValue);

  ATable.Close;
  ATable.Open;
  ATable.Last;
  reloadedValue := ATable.FieldByName(TestField).AsString;
  mmLog.Lines.Add('Reloaded: '+reloadedValue);

  Assert(reloadedValue.Equals(postedValue), 'Reloaded value is not equal to posted.');
end;

procedure TForm1.btnTestBcdAdoClick(Sender: TObject);
begin
  TestBCD(TableAdo);
end;

procedure TForm1.TestSimple(const ATable: TDataSet);
var
  stringValue: String;
  postedValue, reloadedValue: string;
begin
  mmLog.Lines.Add('');
  mmLog.Lines.Add('TestSimple: '+ATable.Name);

  stringValue := '12,345';
  mmLog.Lines.Add('String: '+ stringValue);

  ATable.Open;
  ATable.Insert;
  ATable[TestField] := stringValue;
  ATable.Post;
  postedValue := ATable.FieldByName(TestField).AsString;
  mmLog.Lines.Add('Posted: ' + postedValue);

  ATable.Close;
  ATable.Open;
  ATable.Last;
  reloadedValue := ATable.FieldByName(TestField).AsString;
  mmLog.Lines.Add('Reloaded: '+reloadedValue);

  Assert(reloadedValue.Equals(postedValue), 'Reloaded value is not equal to posted.');
end;

end.

• FireDac MSAcc driver doesn't meet this bug.
• The bug appears on both providers Microsoft.Jet.OLEDB.4.0, Microsoft.ACE.OLEDB.12.0.
• Visual Basic for Access seems to work fine

The output in mmLog is

Hi, the bug appears when you have Windows regional settings: dot as grouping symbol and comma as decimal sepearator
  Your grouping symbol: '.'
  Your decimal separator: ','
This system should be AFFECTED

TestBCD: TableAdo
Double: 12,34567
BCD: 12,34567
Normalized BCD: 12,345
Posted: 12,345
Reloaded: 12345

TestBCD: TableFireDac
Double: 12,34567
BCD: 12,34567
Normalized BCD: 12,345
Posted: 12,345
Reloaded: 12,345

TestSimple: TableAdo
String: 12,345
Posted: 12,345
Reloaded: 12345

TestSimple: TableFireDac
String: 12,345
Posted: 12,345
Reloaded: 12,345

Actual value stored in database

• for ADO: 12345
• for FireDac: 12,345

This piece of VBA code works fine (can be found in TestVBA.mdb in https://github.com/IgorKaplya/AdoBcdBug )

    Public Function ConnectToOtherDB() As ADODB.Connection
        Dim conn As ADODB.Connection
        Set conn = New ADODB.Connection
        conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & CurrentProject.Path & "\TestVBA_OtherBase.mdb;" & _
            "Mode=ReadWrite;" & _
            "Persist Security Info=False;"
        
        Set ConnectToOtherDB = conn
    End Function
    
    Public Sub TestBCD()
        Dim conn As ADODB.Connection
        Set conn = ConnectToOtherDB()
            
        conn.Execute "drop table test_table"
        conn.Execute "create table test_table (test_field decimal(15,3))"
        
        conn.Close
        conn.Open
            
        Dim rs As ADODB.Recordset
        Set rs = New ADODB.Recordset
        
        rs.Open "test_table", conn, adOpenDynamic, adLockOptimistic, adCmdTable
         
        rs.AddNew
        rs!test_field = "21,345"
        rs.Update
            
        rs.Close
       
        Set rs = Nothing
    End Sub

The result in TestVBA_OtherBase database is 21,345

Answer 1

Not an actual answer, but I ended up switching back to float field in MS Access. Another solution could be to switch from ADO to FireDAC. There is still hope, that Embarcadero will help to resolve this one day, watch RSP-34075 for progress.