delphi - 自定义组件中的持久二进制数据

Question

我正在制作一个自定义组件来在程序中保存二进制数据。什么数据类型可以保存二进制数据并自动将其流式传输到 .DFM 文件？

我已经尝试过TBytes，但它没有流式传输。 String 和 AnsiString 流，但它们不适合二进制数据。我试图避免使用手动 TReader/TWriter 方法。

下面是描述该问题的一小段代码。即使发布了 BinProp 属性，BinProp (TBytes) 也不会流式传输到 Blob.bin 文件中:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  tBlob = class (TComponent)
  private
    fBinProp : TBytes;
    fString : String;
    procedure SetBinProp(const Value: TBytes);
    procedure SetStringProp(const Value: String);
  public
  published
    property BinProp : TBytes read fBinProp write SetBinProp;
    property StringProp : String read fString write SetStringProp;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure tBlob.SetBinProp(const Value: TBytes);
begin
  fBinProp := Value;
end;

procedure tBlob.SetStringProp(const Value: String);
begin
  fString := Value;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Blob : tBlob;
  i : integer;
  Fs : TFileStream;
begin
  Blob := tBlob.Create(Self);
  SetLength(Blob.fBinProp, 10);
  for I := 0 to 9 do
    Blob.BinProp[I] := i;
  Blob.StringProp := '1234567890';
  Fs := TFileStream.Create('Blob.bin', fmCreate);
  Fs.WriteComponent(Blob);
  Fs.Free;
  Blob.Free;
  Fs := TFileStream.Create('Blob.bin', fmOpenRead);
  Blob := Fs.ReadComponent(nil) as TBlob;
  Caption :=
    'Length BinProp: '+IntToStr(Length(Blob.BinProp))+    //0
    ' - Length StringProp: '+IntToStr(Length(Blob.StringProp))+ // 10
    ' - Value StringProp: '+Blob.StringProp;   // 1234567890
  Fs.free;
end;

initialization
  RegisterClass(tBlob);
end.

Answer 1

没有任何数据类型可以自动将二进制数据流式传输至 DFM 或从 DFM 传输二进制数据。您必须手动传输数据。让您的组件重写虚拟 DefineProperties() 方法，然后它可以调用 TFiler.DefineBinaryProperty() 方法来提供自定义读取器/写入器方法，根据需要传输二进制数据。

请参阅 Embarcadero 的 DocWiki 中的 Overriding the DefineProperties Method。

例如:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  tBlob = class (TComponent)
  private
    fBinProp : TBytes;
    fString : String;
    procedure ReadBinProp(Stream: TStream);
    procedure WriteBinProp(Stream: TStream);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
  published
    property BinProp : TBytes read fBinProp write fBinProp;
    property StringProp : String read fString write fString;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure tBlob.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineBinaryProperty('BinPropBytes', ReadBinProp, WriteBinProp, Length(fBinProp) > 0);
end;

procedure tBlob.ReadBinProp(Stream: TStream);
var
  BinSize: Integer;
begin
  BinSize := Stream.Size;
  SetLength(fBinProp, BinSize);
  if BinSize > 0 then
    Stream.ReadBuffer(PByte(fBinProp)^, BinSize);
end;

procedure tBlob.WriteBinProp(Stream: TStream);
begin
  Stream.WriteBuffer(PByte(fBinProp)^, Length(fBinProp));
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Blob : tBlob;
  I : Integer;
  Fs : TFileStream;
begin
  Blob := tBlob.Create(nil);
  try
    SetLength(Blob.fBinProp, 10);
    for I := 0 to 9 do
      Blob.BinProp[I] := Byte(i);
    Blob.StringProp := '1234567890';
    Fs := TFileStream.Create('Blob.bin', fmCreate);
    try
      Fs.WriteComponent(Blob);
    finally
      Fs.Free;
    end;
    FreeAndNil(Blob);
    Fs := TFileStream.Create('Blob.bin', fmOpenRead or fmShareDenyWrite);
    try
      Blob := Fs.ReadComponent(nil) as TBlob;
    finally
      Fs.Free;
    end;
    Caption :=
      'Length BinProp: '+IntToStr(Length(Blob.BinProp))+    //0
      ' - Length StringProp: '+IntToStr(Length(Blob.StringProp))+ // 10
      ' - Value StringProp: '+Blob.StringProp;   // 1234567890
  finally
    Blob.Free;
  end;
end;

initialization
  RegisterClass(tBlob);

end.