How to stream components to a TBlobField

Problem/Question/Abstract:

How to stream components to a TBlobField

Answer:

unit CompToBlobField;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, DBTables, DB, DBCtrls, FileCtrl;

type
  TFrmCompToBlobField = class(TForm)
    Table1: TTable;
    Table1TheShortInt: TSmallintField;
    Table1ZeroByteField: TBlobField;
    Table1B32_1: TBlobField;
    Table1B32_2: TBytesField;
    LbxView: TListBox;
    DataSource1: TDataSource;
    DBNavigator1: TDBNavigator;
    Table1ABlobField: TBlobField;
    Panel1: TPanel;
    BtnWrite: TButton;
    BtnRead: TButton;
    RadioGroup1: TRadioGroup;
    procedure BtnWriteClick(Sender: TObject);
    procedure BtnReadClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmCompToBlobField: TFrmCompToBlobField;

implementation

{$R *.DFM}

procedure GetHexDisplay(AData: Pointer; ASize: integer; AList: TStrings);
var
  i: Integer;
  recLen: Integer;
  tBuf: PChar;
  tLng: Integer;
  theStream: TMemoryStream;
  tStr: string;
  tStrEnd: string;
begin
  recLen := ASize;
  AList.Add(EmptyStr);
  theStream := TMemoryStream.Create;
  try
    theStream.Write(AData^, ASize);
    theStream.Seek(0, soFromBeginning);
    while (theStream.Position < theStream.Size) do
    begin
      if (recLen > (theStream.Size - theStream.Position)) then
        recLen := theStream.Size - theStream.Position;
      tBuf := AllocMem(recLen);
      try
        theStream.Read(tBuf[0], recLen);
        tStrEnd := EmptyStr;
        tStr := EmptyStr;
        for i := 0 to recLen - 1 do
        begin
          if ((i = 0) or ((i mod 16) = 0)) then
          begin
            if (i <> 0) then
            begin
              AList.Add(tStr + '|' + tStrEnd + '|');
              tStrEnd := EmptyStr;
            end;
            tStr := Format('%5X', [i]);
            tStr := tStr + ': ';
          end;
          tStr := tStr + Format('%.02X ', [Byte(tBuf[i])]);
          if (tBuf[i] < char($20)) or (tBuf[i] > char($7F)) then
            tBuf[i] := '.';
          tStrEnd := tStrEnd + tBuf[i];
        end;
      finally
        FreeMem(tBuf);
      end;
      if (tStrEnd <> EmptyStr) then
      begin
        if (Length(tStrEnd) < 16) then
        begin
          tLng := 16 - Length(tStrEnd);
          while (tLng > 0) do
          begin
            tStr := tStr + '   ';
            tStrEnd := tStrEnd + ' ';
            Dec(tLng, 1);
          end;
        end;
        AList.Add(tStr + '|' + tStrEnd + '|');
        tStrEnd := EmptyStr;
      end;
    end;
  finally
    theStream.Free;
  end;
  if (tStrEnd <> EmptyStr) then
  begin
    if (Length(tStrEnd) < 16) then
    begin
      tLng := 16 - Length(tStrEnd);
      while (tLng > 0) do
      begin
        tStr := tStr + '   ';
        tStrEnd := tStrEnd + ' ';
        Dec(tLng, 1);
      end;
    end;
    AList.Add(tStr + '|' + tStrEnd + '|');
  end;
end;

procedure TFrmCompToBlobField.BtnWriteClick(Sender: TObject);
const
  count: integer = 0;
var
  theBStream: TBlobStream;
begin
  if Sender is TComponent then
  begin
    Table1.Edit;
    theBStream := TBlobStream.Create(Table1ABlobField, bmReadWrite);
    try
      theBStream.Truncate;
      theBStream.WriteComponentRes(Components[count].Name, Components[count]);
      Inc(count);
      if count = ComponentCount then
        count := 0;
    finally
      theBStream.Free;
    end;
    Table1.Post;
  end;
end;

procedure TFrmCompToBlobField.BtnReadClick(Sender: TObject);
var
  buffer: PChar;
  lng: longint;
  theBStream: TBlobStream;
  theMStream: TMemoryStream;
begin
  LbxView.Clear;
  theBStream := TBlobStream.Create(Table1ABlobField, bmRead);
  try
    if RadioGroup1.ItemIndex = 1 then
    begin
      lng := theBStream.Size;
      buffer := AllocMem(lng);
      try
        theBStream.Read(buffer[0], lng);
        GetHexDisplay(buffer, lng, LbxView.Items);
      finally
        FreeMem(buffer)
      end;
    end
    else
    begin
      theMStream := TMemoryStream.Create;
      try
        theBStream.Seek(0, soFromBeginning);
        ObjectResourceToText(theBStream, theMStream);
        theMStream.Seek(0, soFromBeginning);
        LbxView.Items.LoadFromStream(theMStream);
      finally
        theMStream.Free;
      end;
    end;
  finally
    theBStream.Free;
  end;
end;

procedure TFrmCompToBlobField.FormCreate(Sender: TObject);
begin
  Table1.Open;
  Randomize;
end;

procedure TFrmCompToBlobField.FormDestroy(Sender: TObject);
begin
  Table1.Close;
end;

procedure TFrmCompToBlobField.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
begin
  case Button of
    nbFirst, nbPrior, nbNext, nbLast: BtnRead.Click;
  end;
end;

procedure TFrmCompToBlobField.FormResize(Sender: TObject);
begin
  LbxView.Left := 12;
  LbxView.Width := ClientWidth - 24;
end;

end.