How to stream components to a TBlobField (Views: 28)
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. |