Delphi12的一个数据库问题

我身边的朋友都是第一时间更新Delphi的版本。

他把服务端程序由Delphi11更新到最新的Delphi12，发现DBExpress的用FieldByName().asBytes读取Blob型数据有问题，读的不正确。

FieldByName().asString读到的字符串也不正确。

经过跟他的排查发现Delphi12的数据库在64位的时候读取Blob的时候会出问题。

主要原因是Delphi12的Classes文件里面把TStream.ReadBuffer的64位实现重写，发生了变化。

下面是Delphi11的TStream.ReadBuffer

procedure TStream.ReadBuffer(var Buffer: TBytes; Offset, Count: NativeInt);
var
  LTotalCount,
  LReadCount: NativeInt;
begin
  { Perform a read directly. Most of the time this will succeed
    without the need to go into the WHILE loop. }
  LTotalCount := Read(Buffer, Offset, Count);
  { Check if there was an error }
  if LTotalCount < 0 then
    ReadError;

  while (LTotalCount < Count) do
  begin
    { Try to read a contiguous block of <Count> size }
    LReadCount := Read(Buffer, Offset + LTotalCount, (Count - LTotalCount));

    { Check if we read something and decrease the number of bytes left to read }
    if LReadCount <= 0 then
      ReadError
    else
      Inc(LTotalCount, LReadCount);
  end
end;

下面是Delphi12的TStream.ReadBuffer

差别就在于如果是64位的时候，调用的是Read64.

procedure TStream.ReadBuffer(var Buffer: TBytes; Offset, Count: NativeInt);
var
  LTotalCount,
  LReadCount: NativeInt;
begin
  { Perform a read directly. Most of the time this will succeed
    without the need to go into the WHILE loop. }
{$IF SizeOf(NativeInt) = SizeOf(Int64)}
  LTotalCount := Read64(Buffer, Offset, Count);
{$ELSE}
  LTotalCount := Read(Buffer, Offset, Count);
{$ENDIF}
  { Check if there was an error }
  if LTotalCount < 0 then
    ReadError;

  while (LTotalCount < Count) do
  begin
    { Try to read a contiguous block of <Count> size }
{$IF SizeOf(NativeInt) = SizeOf(Int64)}
    LReadCount := Read64(Buffer, Offset + LTotalCount, (Count - LTotalCount));
{$ELSE}
    LReadCount := Read(Buffer, Offset + LTotalCount, (Count - LTotalCount));
{$ENDIF}

    { Check if we read something and decrease the number of bytes left to read }
    if LReadCount <= 0 then
      ReadError
    else
      Inc(LTotalCount, LReadCount);
  end
end;

数据库读Blob类型数据的时候是通过Stream实现的，比如DBExpress的Blob类型是通过TSQLBlobStream来实现的，TSQLBlobStream是覆盖了TSQLBlobStream.Read(Buffer: TBytes; Offset, Count: LongInt): LongInt;这个方法在里面处理读取Blob类型数据的。

而易博龙此次Delphi12在64位的时候忘了override实现Read64(Buffer: TBytes; Offset, Count: Int64): Int64;这个函数，导致相当于直接用的classes中的默认实现。所以读不到正确的Blob类型数据。

现在情况有两个方案可以尽量避免这种错误。

方案一：把程序设置成32位，就不会有问题。

方案二：自己针对自己使用的数据库引擎代码的Stream进行处理。比如，DBExpress的实现，把系统中Data.SqlExpr.pas文件，复制到自己工程的当前目录中。给TSQLBlobStream补上易博龙漏了override的read64方法。

function Read64(Buffer: TBytes; Offset, Count: Int64): Int64; override;

。。。

function TSQLBlobStream.Read64(Buffer: TBytes; Offset, Count: Int64): Int64;
begin
if not FHasData then
ReadBlobData;
Result := inherited Read64(Buffer, Offset, Count);
end;

其他数据库引擎都是类似，把源代码复制到你的工程文件夹下，补上read64方法，即可在64位程序中正确的读到Blob类型数据。

AsString读到不正确，与AsBytes读到不正确类似。

function TBlobField.GetAsWideString: string;
var
  Len: Integer;
  LStream: TStream;
begin
  LStream := DataSet.CreateBlobStream(Self, bmRead);
  try
    Len := LStream.Size;
    SetString(Result, nil, (Len+1) div SizeOf(Char));
    LStream.ReadBuffer(Pointer(Result)^, Len);
  finally
    LStream.Free;
  end;
end;

procedure TStream.ReadBuffer(var Buffer; Count: NativeInt);
var
  LTotalCount,
  LReadCount: NativeInt;
begin
  { Perform a read directly. Most of the time this will succeed
    without the need to go into the WHILE loop. }
  LTotalCount := Read(Buffer, Count);
  { Check if there was an error }
  if LTotalCount < 0 then
    ReadError;

  while (LTotalCount < Count) do
  begin
    { Try to read a contiguous block of <Count> size }
    LReadCount := Read(PByte(PByte(@Buffer) + LTotalCount)^,
      (Count - LTotalCount));

    { Check if we read something and decrease the number of bytes left to read }
    if LReadCount <= 0 then
      ReadError
    else
      Inc(LTotalCount, LReadCount);
  end
end;

Delphi12的TStream增加了一个read的重载。

{$IF Sizeof(LongInt) <> Sizeof(NativeInt)}
    function Read(var Buffer; Count: NativeInt): NativeInt; overload; virtual;
    function Write(const Buffer; Count: NativeInt): NativeInt; overload; virtual;
{$ENDIF Sizeof(LongInt) <> Sizeof(NativeInt)}

而这个重载的方法在TSQLBlobStream上没有override。相当于调用的TStream默认的方法，结果读不到真正的String的内容。

对于DBExpress的话还是类似方案

方案1.把工程编译为32位应用，就没这个问题。

方案2.己针对自己使用的数据库引擎代码的Stream进行处理。比如，DBExpress的实现，把系统中Data.SqlExpr.pas文件，复制到自己工程的当前目录中。给TSQLBlobStream补上易博龙漏了override的

function Read(var Buffer; Count: NativeInt): NativeInt; 

方法。

function Read(var Buffer; Count: NativeInt): NativeInt; overload; override;
。。。

function TSQLBlobStream.Read(var Buffer; Count: NativeInt): NativeInt;
begin
  if not FHasData then
    ReadBlobData;
  Result := inherited Read(Buffer, Count);
end;

看来易博龙在修改RTL的功能的时候，对其它方面的影响评估和测试都还比较欠缺。

这个只看到了数据库引擎的Stream派生类出了问题，很多新增加方法没有override，导致走了默认功能。对其他的方面也产生了怀疑

经过一番检查，只发现DBExpress中用到的Stream没有override 那些TStream新增的方法

Data.DBXDataSets.pas中TDBXReaderDataSet.TBlobStream

Data.SqlExpr.pas中的TSQLBlobStream