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

Posted 2023-03-23

技术标签:

【中文标题】Delphi ADO BCD 十进制字段值设置不正确【英文标题】：Delphi ADO BCD Decimal field value set inproperly 【发布时间】：2021-05-27 11:04:30 【问题描述】：

我在 Embarcadero 质量门户上创建了一个bug。但也许有人有一种解决方法可以让测试项目在这些标记上工作：

连接机制还是AdoConnection + AdoTable 发布到数据库的值等于从数据库中选择的值 TestField 类型未更改（Decimal(15, 3)）用户不必重新配置区域设置。

问题详情

影响版本/s：XE7、10.2 Tokyo Release 3、10.3 Rio Release 3 内部版本号：Delphi 10.3 版本 26.0.36039.7899 平台：Windows 10

当您使用 Windows regional settings 时会出现该错误：点作为分组符号，逗号作为小数分隔符。

当您尝试使用 AdoConnection + AdoTable 将值设置为 MS-ACCESS 数据库中的 Decimal 字段时，您会得到实际值乘以比例，即：您将 MDB 中的 Decimal(15,3) 字段设置为 12,354，您将获得 12354。

测试项目 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 驱动程序不符合此错误。该错误出现在 Microsoft.Jet.OLEDB.4.0、Microsoft.ACE.OLEDB.12.0 两个提供商上。 Visual Basic for Access 似乎工作正常

mmLog中的输出是

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

存储在数据库中的实际值

对于 ADO：12345 对于 FireDac：12,345

这段 VBA 代码运行良好（可以在 https://github.com/IgorKaplya/AdoBcdBug 的 TestVBA.mdb 中找到）


    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

TestVBA_OtherBase 数据库中的结果是21,345

【问题讨论】：

从列表中看不出来，但 TableAdo 是使用默认 EnableBCD 值 (True) 创建的。没有问题，@J...，现在添加输出。 you get actual value multiplied with scale, ie: you set 12,354 you get 12354 我不认为这是一个乘法。这很可能是 ADO 将逗号解释为千位分隔符。在 ADO 案例中，DB 中的实际值是多少？它是否正确存储了12,345 并且在检索值时出错了？还是它实际上存储了12345？ @J... 对，如果您将 DB 字段创建为 Decimal(X,Y) 您最终会在数据库中得到 Value * 10^Y。我的意思是，如果您只是发布“1”，就我而言，您将获得 1000。所以回答你的第二个问题：数据库存储 12345。 【参考方案1】：

不是一个实际的答案，但我最终切换回 MS Access 中的浮点字段。另一种解决方案可能是从 ADO 切换到 FireDAC。仍有希望，Embarcadero 有一天会帮助解决这个问题，请注意 RSP-34075 的进展。

【讨论】：

以上是关于Delphi ADO BCD 十进制字段值设置不正确的主要内容，如果未能解决你的问题，请参考以下文章

delphi Sqlite

delphi中adodataset问题

delphi中的SQL语句

delphi中ado连接sqlserver

Delphi 7：ADO，需要基本的编码示例

delphi treeview和ADO数据库配合问题