Советы по Delphi

         

Blob-поля, потоки, компрессия...


Приветствую Вас, Валентин!

*** skip (личная переписка) ***.

В последней версии "Советов" я нашел рекомендацию по сохранению текста из TStrings в поле BLOB таблицы базы данных (однако на мой взгляд приведенный код делает обратное - т.е. считывает содержимое поля BLOB в TRichEdit). Я сам занимался этой задачей и мое предыдущее письмо к Вам явилось результатом экспериментов над TRichEdit. Поэтому я хочу предложить Вам пример проэкта, в котором я связываю поле BLOB таблицы Paradox с компонентом TRichEdit через потоки. Кроме того я использую библиотеку ZLib из стандартного приложения к Delphi 3 CSS. Это позволяет по ходу перекачивания данных в таблицу сжимать текст, а при чтении - распаковывать его чем достигается уменьшение размера .MB-файла, что полезно при большом количестве записей с BLOB-полем.

В заключение хочу сказать несколько слов о библиотеке ZLib.dcu (размер 48496 байт, дата создания 24.03.97г.) которая включена в поставку Delphi 3. При использовании конструктора TDecompressStream почему-то генерировался Default Beep и это очень задерживало выполнение декомпрессии. По счастью в поставку входит и исходный текст ZLib.pas. Я перекомпилировал модуль с помощью тестового примера, также входящего в поставку, при этом указав в настройках проэкта не включать отладочную информацию. В результате размер ZLib.dcu стал равным 45681 байт, а сигнал генерироваться перестал.

Теперь о проэкте. Он имеет одну форму frmMain. Содержимое файлов проэкта привожу ниже. Для работы также необходима таблица Table.db, имеющая структуру:

Имя поля Тип Размер ID + BLOBData B 64 и Alias с именем CBDB указывающий на каталог с этой таблицей.

Для упрощения размещения компонентов в форме проделайте следующее:

  1. Создайте новый проэкт;
  2. Скопируйте выделенную красным цветом часть файла Main.dfm в буфер обмена;
  3. Сделайте активной вновь созданную форму и вставте в нее содержимое буфера;
  4. Измените свойства самой формы в соответствии с нижеприведенным описанием.
Файл Main.dfm:

object frmMain: TfrmMain
Left = 476Top = 347BorderStyle = bsSingleCaption = 'Compressed BLOB'ClientHeight = 235ClientWidth = 246Font.Charset = DEFAULT_CHARSETFont.Color = clWindowTextFont.Height = -11Font.Name = 'MS Sans Serif'Font.Style = []Position = poScreenCenterOnShow = FormShowPixelsPerInch = 96TextHeight = 13object SB1: TSpeedButtonLeft = 1Top = 209Width = 25Height = 25Hint = 'Добавить'Glyph.Data = {76010000424D760100000000000076000000280000002000000010000000010004000000000000010000130B0000130B00001000000000000000000000000000800000800000008080008000000080008000808000007F7F7F00BFBFBF000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF0033333333333333333333333FFFFFFFFF333333000000000033333377777777773333330FFFFFFFF03333337F333333373333330FFFFFFFF03333337F3FF3FFF73333330F00F000F03333F37F773777373330330FFFFFFFF03337FF7F3F3FF3F73339030F0800F0F033377F7F737737373339900FFFFFFFF03FF7777F3FF3FFF70999990F00F000007777777F7737777709999990FFF0FF0377777777FF37F3730999999908F0F033777777777337F73309999990FFF0033377777777FFF7733309999900000033337777777777773333333990333333333333377733333333333339033333333333333773333333333333303333333333333337333333333333}NumGlyphs = 2ParentShowHint = FalseShowHint = TrueOnClick = SB1Clickendobject SB2: TSpeedButtonLeft = 25Top = 209Width = 25Height = 25Hint = 'Удалить'Glyph.Data = {76010000424D760100000000000076000000280000002000000010000000010004000000000000010000000000000000000010000000000000000000000000008000008000000080800080000000800080008080000080808000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF0033333333333333333333333FFFFFFFFF333333000000000033333377777777773333330FFFFFFFF03333337F333333373333330FFFFFFFF03333337F3FF3FFF73333330F00F000F033333F7F773777373333300FFFFFFFF03333F73FFF3FF3F733330C0F0800F0F0333F773F337737373330CC0FFFFFFFF033F777FFFFF3FFF7330CCCCC00F000003F777777F737777730CCCCCC0FF0FF03F7777777FF37F3730CCCCCCC08F0F03377777777F337F73330CCCCCC0FF0033337777777FFF77333330CCCCC0000333333777777777733333330CC3333333333333777333333333333330C3333333333333377333333333333333033333333333333373333333333}NumGlyphs = 2ParentShowHint = FalseShowHint = TrueOnClick = SB2Clickendobject SB3: TSpeedButtonLeft = 49Top = 209Width = 25Height = 25Hint = 'Редактировать'Glyph.Data = {76010000424D760100000000000076000000280000002000000010000000010004000000000000010000120B0000120B00001000000000000000000000000000800000800000008080008000000080008000808000007F7F7F00BFBFBF000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333000000000033333377777777773333330FFFFFFFF03FF3FF7FF33F3FF700300000FF0F00F077F777773F737737E00BFBFB0FFFFFF07773333F7F3333F7E0BFBF000FFFF0F077F3337773F3F737E0FBFBFBF0F00FF077F3333FF7F77F37E0BFBF00000B0FF077F3337777737337E0FBFBFBFBF0FFF077F33FFFFFF73337E0BF0000000FFFF077FF777777733FF7000BFB00B0FF00F07773FF77373377373330000B0FFFFFF03337777373333FF7333330B0FFFF00003333373733FF777733330B0FF00F0FF03333737F37737F373330B00FFFFF0F033337F77F33337F733309030FFFFF00333377737FFFFF773333303300000003333337337777777333}NumGlyphs = 2ParentShowHint = FalseShowHint = TrueOnClick = SB3Clickendobject SB4: TSpeedButtonLeft = 73Top = 209Width = 25Height = 25Hint = 'Отменить редактирование'Glyph.Data = {DE010000424DDE01000000000000760000002800000024000000120000000100040000000000680100000000000000000000100000000000000000000000000080000080000000808000800000008000800080800000C0C0C000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333333333333333333333333333000033338833333333333333333F3333333333330000333911833333983333333388F333333F333300003339111833391183333338F38F333F88F33300003339111183911118333338F338F3F8338F3300003333911118111118333338F3338F833338F3000033333911111111833333338F33383333F8330000333333911111183333333338F333333F833300003333333111118333333333338F3333383333000033333339111183333333333338F33383333300003333339111118333333333333833338F333300003333391118111833333333338333338F333300003333911183911183333333383338F338F333000033339118333911183333338F33838F338F33000033333913333391113333338FF83338F338F300003333333333333919333333388333338FFF83000033333333333333333333333333333338883300003333333333333333333333333333333333330000}NumGlyphs = 2ParentShowHint = FalseShowHint = TrueOnClick = SB4Clickendobject P1: TPanelLeft = 0Top = 0Width = 246Height = 206BevelInner = bvRaisedBevelOuter = bvLoweredBevelWidth = 2TabOrder = 0object RE: TRichEditLeft = 5Top = 5Width = 236Height = 196ScrollBars = ssVerticalTabOrder = 0endendobject DBN: TDBNavigatorLeft = 149Top = 209Width = 96Height = 25DataSource = DSVisibleButtons = [nbFirst, nbPrior, nbNext, nbLast]TabOrder = 1endobject T1: TTableActive = TrueDatabaseName = 'CBDB'TableName = 'table.db'Left = 5Top = 5object T1ID: TAutoIncFieldFieldName = 'ID'Visible = Falseendobject T1BLOBData: TBlobFieldFieldName = 'BLOBData'Visible = FalseBlobType = ftBlobSize = 64endendobject OD: TOpenDialogDefaultExt = 'rtf'Filter = 'RTF-файлы|*.rtf|Все файлы|*.*'Title = 'Выберите файл'Left = 5Top = 35endobject DS: TDataSourceDataSet = T1OnDataChange = DSDataChangeLeft = 35Top = 5endend
<
/p> Файл Main.pas:



unit Main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,Db, DBTables, StdCtrls, ComCtrls, ExtCtrls, DBCtrls, Buttons, swDBPanl,swRecPos;type
TfrmMain = class(TForm)T1: TTable;T1ID: TAutoIncField;T1BLOBData: TBlobField;OD: TOpenDialog;P1: TPanel;SB1: TSpeedButton;SB2: TSpeedButton;SB3: TSpeedButton;SB4: TSpeedButton;DS: TDataSource;DBN: TDBNavigator;procedure SB1Click(Sender: TObject);procedure SB2Click(Sender: TObject);procedure SB3Click(Sender: TObject);procedure SB4Click(Sender: TObject);procedure DSDataChange(Sender: TObject; Field: TField);procedure FormShow(Sender: TObject);privateEF:boolean;procedure SetButtons;procedure UpdateEditor;procedure StoreFromFile;procedure StoreFromEditor;public{ Public declarations }end;
var frmMain: TfrmMain;

implementation
uses
ZLib;

{$R *.DFM}

const LID:longint=0;
procedure TfrmMain.SetButtons;
var c1:boolean;
begin c1:=T1.RecordCount>0;
SB2.Enabled:=not EF and c1;SB3.Enabled:=not EF and c1;SB4.Enabled:=EF;end;

procedure TfrmMain.UpdateEditor;
var Buf:TStream;
ZStream:TCustomZLibStream;id:longint;begin
id:=T1ID.AsInteger;if (id=LID) and not EF then exit else LID:=id;Buf:=TMemoryStream.Create;T1BLOBData.SaveToStream(Buf);if Buf.Size>0 then beginZStream:=TDecompressionStream.Create(Buf);RE.Lines.LoadFromStream(ZStream);ZStream.Free;end else RE.Lines.Clear;Buf.Free;end;

procedure TfrmMain.StoreFromFile;
var InFile,Buf:TStream;
ZStream:TCustomZLibStream;begin
if not
OD.Execute then exit;T1.AppendRecord([NULL]);InFile:=TFileStream.Create(OD.FileName,fmOpenRead);Buf:=TMemoryStream.Create;ZStream:=TCompressionStream.Create(clMax,Buf);ZStream.CopyFrom(InFile,0);ZStream.Free;T1.Edit;T1BLOBData.LoadFromStream(Buf);T1.Post;Buf.Free;InFile.Free;LID:=0;UpdateEditor;end;

procedure TfrmMain.StoreFromEditor;
var InStream,Buf:TStream;
ZStream:TCustomZLibStream;begin
InStream:=TMemoryStream.Create;Buf:=TMemoryStream.Create;RE.Lines.SaveToStream(InStream);ZStream:=TCompressionStream.Create(clMax,Buf);ZStream.CopyFrom(InStream,0);ZStream.Free;T1.Edit;T1BLOBData.LoadFromStream(Buf);T1.Post;UpdateEditor;end;

procedure TfrmMain.SB1Click(Sender: TObject);
begin
if
EF then begin StoreFromEditor;RE.ReadOnly:=true;DBN.Enabled:=true;EF:=false;SB1.Hint:='Добавить';end else StoreFromFile;SetButtons;end;

procedure TfrmMain.SB2Click(Sender: TObject);
begin
if
MessageDlg('Удалять запись?',mtConfirmation,[mbYes,mbNo],0)=mrYes thenbegin T1.Delete;SetButtons;end;end;

procedure TfrmMain.SB3Click(Sender: TObject);
begin
DBN.Enabled:=false;EF:=true;SB1.Hint:='Внести изменения';RE.ReadOnly:=false;SetButtons;end;

procedure TfrmMain.SB4Click(Sender: TObject);
begin
UpdateEditor;DBN.Enabled:=true;EF:=false;SB1.Hint:='Добавить';RE.ReadOnly:=true;end;

procedure TfrmMain.DSDataChange(Sender: TObject; Field: TField);
begin
if
assigned(frmMain) and Visible and not EF then
begin
UpdateEditor;SetButtons;end;end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
EF:=false;SetButtons;DSDataChange(nil,nil);end;

end.
Файл CompBLOB.dpr:

program CompBLOB;
uses
Forms,Main in 'Main.pas' {frmMain};
{$R *.RES}

begin
Application.Initialize;Application.CreateForm(TfrmMain, frmMain);Application.Run;end.
С наилучшими пожеланиями
. [000565]


Содержание раздела