Связать поле BLOB таблицы Paradox с компонентом TRichEdit через потоки

Связать поле BLOB таблицы Paradox с компонентом TRichEdit через потоки

Автор: Сергей Лагонский

Кроме того, я использую библиотеку ZLib. Это позволяет по ходу перекачивания данных в таблицу сжимать текст, а при чтении - распаковывать его, чем достигается уменьшение размера .MB-файла, что полезно при большом количестве записей с BLOB-полем.

Прект имеет одну форму frmMain. Для работы также необходима таблица Table.db, имеющая структуру:

Имя поля	Тип	Размер
ID		+
BLOBData	B	64

и Alias с именем CBDB, указывающий на каталог с этой таблицей.

object frmMain: TfrmMain

Left = 476
Top = 347
BorderStyle = bsSingle
Caption = 'Compressed BLOB'
ClientHeight = 235
ClientWidth = 246
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Position = poScreenCenter
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object SB1: TSpeedButton
Left = 1
Top = 209
Width = 25
Height = 25
Hint = 'Добавить'
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000130B0000130B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
33333333333FFFFFFFFF333333000000000033333377777777773333330FFFFF
FFF03333337F333333373333330FFFFFFFF03333337F3FF3FFF73333330F00F0
00F03333F37F773777373330330FFFFFFFF03337FF7F3F3FF3F73339030F0800
F0F033377F7F737737373339900FFFFFFFF03FF7777F3FF3FFF70999990F00F0
00007777777F7737777709999990FFF0FF0377777777FF37F3730999999908F0
F033777777777337F73309999990FFF0033377777777FFF77333099999000000
3333777777777777333333399033333333333337773333333333333903333333
3333333773333333333333303333333333333337333333333333}
NumGlyphs = 2
ParentShowHint = False
ShowHint = True
OnClick = SB1Click
end
object SB2: TSpeedButton
Left = 25
Top = 209
Width = 25
Height = 25
Hint = 'Удалить'
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
0400000000000001000000000000000000001000000000000000000000000000
8000008000000080800080000000800080008080000080808000C0C0C0000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
33333333333FFFFFFFFF333333000000000033333377777777773333330FFFFF
FFF03333337F333333373333330FFFFFFFF03333337F3FF3FFF73333330F00F0
00F033333F7F773777373333300FFFFFFFF03333F73FFF3FF3F733330C0F0800
F0F0333F773F337737373330CC0FFFFFFFF033F777FFFFF3FFF7330CCCCC00F0
00003F777777F737777730CCCCCC0FF0FF03F7777777FF37F3730CCCCCCC08F0
F03377777777F337F73330CCCCCC0FF0033337777777FFF77333330CCCCC0000
333333777777777733333330CC3333333333333777333333333333330C333333
3333333377333333333333333033333333333333373333333333}
NumGlyphs = 2
ParentShowHint = False
ShowHint = True
OnClick = SB2Click
end
object SB3: TSpeedButton
Left = 49
Top = 209
Width = 25
Height = 25
Hint = 'Редактировать'
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333000000
000033333377777777773333330FFFFFFFF03FF3FF7FF33F3FF700300000FF0F
00F077F777773F737737E00BFBFB0FFFFFF07773333F7F3333F7E0BFBF000FFF
F0F077F3337773F3F737E0FBFBFBF0F00FF077F3333FF7F77F37E0BFBF00000B
0FF077F3337777737337E0FBFBFBFBF0FFF077F33FFFFFF73337E0BF0000000F
FFF077FF777777733FF7000BFB00B0FF00F07773FF77373377373330000B0FFF
FFF03337777373333FF7333330B0FFFF00003333373733FF777733330B0FF00F
0FF03333737F37737F373330B00FFFFF0F033337F77F33337F733309030FFFFF
00333377737FFFFF773333303300000003333337337777777333}
NumGlyphs = 2
ParentShowHint = False
ShowHint = True
OnClick = SB3Click
end
object SB4: TSpeedButton
Left = 73
Top = 209
Width = 25
Height = 25
Hint = 'Отменить редактирование'
Glyph.Data = {
DE010000424DDE01000000000000760000002800000024000000120000000100
0400000000006801000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
333333333333333333333333000033338833333333333333333F333333333333
0000333911833333983333333388F333333F3333000033391118333911833333
38F38F333F88F33300003339111183911118333338F338F3F8338F3300003333
911118111118333338F3338F833338F3000033333911111111833333338F3338
3333F8330000333333911111183333333338F333333F83330000333333311111
8333333333338F3333383333000033333339111183333333333338F333833333
00003333339111118333333333333833338F3333000033333911181118333333
33338333338F333300003333911183911183333333383338F338F33300003333
9118333911183333338F33838F338F33000033333913333391113333338FF833
38F338F300003333333333333919333333388333338FFF830000333333333333
3333333333333333333888330000333333333333333333333333333333333333
0000}
NumGlyphs = 2
ParentShowHint = False
ShowHint = True
OnClick = SB4Click
end
object P1: TPanel
Left = 0
Top = 0
Width = 246
Height = 206
BevelInner = bvRaised
BevelOuter = bvLowered
BevelWidth = 2
TabOrder = 0
object RE: TRichEdit
Left = 5
Top = 5
Width = 236
Height = 196
ScrollBars = ssVertical
TabOrder = 0
end
object DBN: TDBNavigator
Left = 149
Top = 209
Width = 96
Height = 25
DataSource = DS
VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast]
TabOrder = 1
end
object T1: TTable
Active = True
DatabaseName = 'CBDB'
TableName = 'table.db'
Left = 5
Top = 5
object T1ID: TAutoIncField
FieldName = 'ID'
Visible = False
end
object T1BLOBData: TBlobField
FieldName = 'BLOBData'
Visible = False
BlobType = ftBlob
Size = 64
end
object OD: TOpenDialog
DefaultExt = 'rtf'
Filter = 'RTF-файлы|*.rtf|Все файлы|*.*'
Title = 'Выберите файл'
Left = 5
Top = 35
end
object DS: TDataSource
DataSet = T1
OnDataChange = DSDataChange
Left = 35
Top = 5
end

// Файл 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);
private
EF: 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
begin
ZStream := 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
then
begin
T1.Delete;
SetButtons;
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;

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.

Эта запись была добавлена в Воскресенье, 25 мая, 2008 - 3:12 В разделы BLOB поля, Базы данных. Вы можете подписаться на получение новых комментариев RSS 2.0 feed. Both comments and pings are currently closed.