Delphi Sydney 调用 FD CreateBlobStream 时在 TStream 中报告内存泄漏

Question

我使用 FDQUERY 从 MYSQL 中选择一条包含 blob 连续 jpg 图像的记录。一切都按预期完美运行。

我将 ReportMemoryLeaksOnShutdown:=True 添加到项目 DPR。关机时我收到消息：

“发生了意外的内存泄漏。意外的小块泄漏是： 1-12 字节：TStream x 1"

（对以下代码行的每次调用都会增加 1。） 如果我注释掉该行，则没有内存泄漏。

我试图追溯源代码以找到泄漏，但我找不到它。

任何帮助或解决方法将不胜感激。非常感谢。
开发环境是：

Windows 10

德尔福 10.4.2 专业版

MYSQL 8.0.25（64 位）

MS:=FDQuery1.CreateBlobStream(FDQuery1.FieldbyName('Image'),TBlobStreamMode.bmRead);`

MS 流变量正在尝试中释放 ..finally 块。

下面的可重现代码：

1 创建 MYSQL 表脚本

CREATE TABLE `TestTable` (
  `pk_Id` int NOT NULL AUTO_INCREMENT,
  `Image` longblob,
  UNIQUE KEY `pk_Id_UNIQUE` (`pk_Id`)
 ) ENGINE=InnoDB AUTO_INCREMENT=27607 DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_0900_ai_ci;

2 德尔福表格

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 322
  ClientWidth = 720
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 56
    Top = 272
    Width = 129
    Height = 25
    Caption = 'Assign Blob To Stream'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 512
    Top = 40
    Width = 137
    Height = 25
    Caption = 'Insert JPG into Table'
    TabOrder = 1
    OnClick = Button2Click
  end
  object FDConnection1: TFDConnection
    Params.Strings = (
      'Database= INSERT DATABASE NAME HERE'  // <-- Change to your MYSQL Database Name
      'User_Name= INSERT YOUR USERNAME HERE' // <-- Change to Your MYSQL User name
      'Password=INSET YOUR PASSWORD HERE'    // <-- Change to Your MYSQL Password
      'Server=INSER YOUR SERVER HERE'        // <-- Change to Your MYSQL Server Typically 127.0.0.1
      'DriverID=MySQL')
    Connected = True
    LoginPrompt = False
    Left = 55
    Top = 96
  end
  object FDGUIxWaitCursor1: TFDGUIxWaitCursor
    Provider = 'Forms'
    Left = 55
    Top = 32
  end
  object FDQuery1: TFDQuery
    Connection = FDConnection1
    ResourceOptions.AssignedValues = [rvDirectExecute]
    ResourceOptions.DirectExecute = True
    SQL.Strings = (
      'Select Image from testtable'
      ''
      '')
    Left = 56
    Top = 166
  end
  object FDTable1: TFDTable
    IndexFieldNames = 'pk_Id'
    Connection = FDConnection1
    TableName = 'foodforlife.testtable'
    Left = 672
    Top = 40
  end
  object FileOpenDialog1: TFileOpenDialog
    DefaultExtension = 'jpg'
    DefaultFolder = 'C:\'
    FavoriteLinks = <>
    FileTypes = <
      item
        DisplayName = ''
        FileMask = '*.jpg'
      end>
    Options = []
    Left = 432
    Top = 24
  end
end

3 德尔福单元

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, 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.MySQL,
  FireDAC.Phys.MySQLDef, FireDAC.VCLUI.Wait, FireDAC.Stan.Param, FireDAC.DatS,
  FireDAC.DApt.Intf, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet,
  FireDAC.Comp.Client, FireDAC.Comp.UI, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    FDConnection1: TFDConnection;
    FDGUIxWaitCursor1: TFDGUIxWaitCursor;
    FDQuery1: TFDQuery;
    Button2: TButton;
    FDTable1: TFDTable;
    FileOpenDialog1: TFileOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
Var
  MS : TStream;
begin
  MS := TStream.Create;
  try
    FDQuery1.Active:=True;
    MS:=FDQuery1.CreateBlobStream(FDQuery1.FieldbyName('Image'),TBlobStreamMode.bmRead);  // --< Memory Leak Here
    MS.Position:=0;
  finally
    ms.Free;
  end;

end;

procedure TForm1.Button2Click(Sender: TObject);
Var
fs: TFileStream;
begin

  If FileOPenDialog1.execute then fs:=TFileStream.Create(FileOPenDialog1.Files[0],fmShareDenyNone);
  try
     fs.position:=0;
     With fdtable1 do
      begin
        active:=True;
        insert;
        (FieldByName('Image') as TBlobField).LoadFromStream(fs);
        Post
      end;
  finally
    fs.Free;

  end;



end;

end.

4 德尔福 DPR

program Project1;

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  ReportMemoryLeaksOnShutdown:=True;
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

使用：

• 1 在您有权访问的 MYSQL DB 中运行创建脚本

  2 为上面创建的表插入 MYSQL DB 参数 FDConnection1

  3 编译运行

  4 单击标题为 Insert JPG into Table 的按钮以显示打开的文件 对话框，您将从中选择 jpg 文件。当你执行 对话框，它将保存到 MYSQL 表中

  5 单击标题为将 Blob 分配给流的按钮。这将分配 blob 到流并为每个按钮单击创建内存泄漏

Answer 1

您的Button1Click 代码错误。你是Create()'ing 一个TStream 本身的对象实例（你不应该这样做，因为TStream 是一个抽象基类），但你不是Free()'ing 该对象，因此它被泄露了.当您创建 blob 流时，您将该对象分配给分配给 TStream 对象的同一变量，因此您失去了对 TStream 对象的引用。

摆脱对TStream.Create的调用，它不属于这里，例如：

procedure TForm1.Button1Click(Sender: TObject);
Var
  MS : TStream;
begin
  FDQuery1.Active := True; 
  MS := FDQuery1.CreateBlobStream(FDQuery1.FieldbyName('Image'), TBlobStreamMode.bmRead);
  try
    // use MS as needed...
  finally
    MS.Free;
  end;
end;

Answer 2

你可以在Embarcadero blobs demos找到一个例子。

应用于您在问题中显示的代码，它变为：

var
  BStream : TStream;
begin
  BStream := MyFDProductScanQuery.CreateBlobStream(MyFDProductScanQuery.Fields[I], TBlobStreamMode.bmRead);
  try
    Base64ImgStr := TIdEncoderMIME.EncodeStream(BStream);
  finally
    BStream.Free;
  end;
end;

编辑：您的代码不符合我上面显示的内容。这就是为什么你仍然有内存泄漏。您正在创建两个流并且只有一个空闲：您调用 TStream.create，然后用 FDQuery1.CreateBlobStream 返回的流覆盖该值。还要注意 Base64ImgStr 会发生什么，这可能也是一个在您不再需要时必须释放的流。