fbintf/client/FBBlob.pas

(*
 *  Firebird Interface (fbintf). The fbintf components provide a set of
 *  Pascal language bindings for the Firebird API. Although predominantly
 *  a new development they include source code taken from IBX and may be
 *  considered a derived product. This software thus also includes the copyright
 *  notice and license conditions from IBX.
 *
 *  Except for those parts dervied from IBX, contents of this file are subject
 *  to the Initial Developer's Public License Version 1.0 (the "License"); you
 *  may not use this file except in compliance with the License. You may obtain a
 *  copy of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit FBBlob;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils, IB, FBActivityMonitor, FBTransaction, FBClientAPI,
  FBOutputBlock;

type

  { TFBBlobMetaData }

  TFBBlobMetaData  = class(TActivityReporter)
  private
    FRelationName: AnsiString;
    FColumnName: AnsiString;
  protected
    FUnconfirmedCharacterSet: boolean;
    FHasSubType: boolean;
    FSubType: integer;
    FCharSetID: cardinal;
    FSegmentSize: cardinal;
    function Attachment: IAttachment; virtual; abstract;
    procedure NeedFullMetadata; virtual; abstract;
    procedure NeedSubType;
  public
    constructor Create(Transaction: TFBTransaction; RelationName, ColumnName: AnsiString
      );
    procedure SetCharSetID(aValue: integer);

  public
    {IBlobMetaData}
   function GetSubType: integer;
   function GetCharSetID: cardinal;
   function GetCodePage: TSystemCodePage;
   function GetSegmentSize: cardinal;
   function GetRelationName: AnsiString;
   function GetColumnName: AnsiString;
   function GetUnconfirmedCharacterSet: boolean;
  end;

  TFBBlob = class(TActivityReporter)
  private
    FMetaData: IBlobMetaData;
    FAttachment: IAttachment;
    FTransaction: ITransaction;
    FBPB: IBPB;
    FStringData: rawbytestring;
    FStringCached: boolean;
  protected
    FCreating: boolean;
    FBlobID: TISC_QUAD;
    procedure CheckReadable; virtual; abstract;
    procedure CheckWritable; virtual; abstract;
    procedure ClearStringCache;
    function GetIntf: IBlob; virtual; abstract;
    procedure GetInfo(Request: array of byte; Response: IBlobInfo); overload; virtual; abstract;
    procedure InternalClose(Force: boolean); virtual; abstract;
    procedure InternalCancel(Force: boolean); virtual; abstract;
  public
    constructor Create(Attachment: IAttachment; Transaction: TFBTransaction;
                       MetaData: IBlobMetaData; BPB: IBPB); overload;
    constructor Create(Attachment: IAttachment; Transaction: TFBTransaction;
                       MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB); overload;
    destructor Destroy; override;
    procedure TransactionEnding(aTransaction: TFBTransaction; Force: boolean);

  public
    {IBlobMetaData}
   function GetSubType: integer;
   function GetCharSetID: cardinal;
   function GetCodePage: TSystemCodePage;
   function GetSegmentSize: cardinal;
   function GetRelationName: AnsiString;
   function GetColumnName: AnsiString;
   function GetUnconfirmedCharacterSet: boolean;

   {IBlob}
    function GetBPB: IBPB;
    procedure Cancel;
    procedure Close;
    function GetBlobSize: Int64;
    procedure GetInfo(var NumSegments: Int64; var MaxSegmentSize, TotalSize: Int64;
      var BlobType: TBlobType); overload;
    function GetBlobID: TISC_QUAD;
    function GetBlobMode: TFBBlobMode;
    function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
    function Write(const Buffer; Count: Longint): Longint;  virtual; abstract;
    function LoadFromFile(Filename: AnsiString): IBlob;
    function LoadFromStream(S: TStream) : IBlob;
    function SaveToFile(Filename: AnsiString): IBlob;
    function SaveToStream(S: TStream): IBlob;
    function GetAttachment: IAttachment;
    function GetTransaction: ITransaction;
    function GetAsString: rawbytestring;
    procedure SetAsString(aValue: rawbytestring);
    function SetString(aValue: rawbytestring): IBlob;
  end;


implementation

uses FBMessages;

{ TFBBlob }

procedure TFBBlob.ClearStringCache;
begin
  FStringData := '';
  FStringCached := false;
end;

constructor TFBBlob.Create(Attachment: IAttachment;
  Transaction: TFBTransaction; MetaData: IBlobMetaData; BPB: IBPB);
begin
  inherited Create(Transaction);
  FAttachment := Attachment;
  FTransaction := Transaction;
  FMetaData := MetaData;
  FBPB := BPB;
  FCreating := true;
end;

constructor TFBBlob.Create(Attachment: IAttachment;
  Transaction: TFBTransaction; MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB);
begin
  Create(Attachment,Transaction,MetaData,BPB);
  FBlobID := BlobID;
  FCreating := false;
end;

destructor TFBBlob.Destroy;
begin
  if FCreating then
    Cancel
  else
    Close;
  inherited Destroy;
end;

procedure TFBBlob.TransactionEnding(aTransaction: TFBTransaction;
  Force: boolean);
begin
  if aTransaction  <> (FTransaction as TFBTransaction)  then
    Exit;
  if FCreating then
    InternalCancel(Force)
  else
    InternalClose(Force);
end;

function TFBBlob.GetSubType: integer;
begin
  Result := FMetaData.GetSubType;
end;

function TFBBlob.GetCharSetID: cardinal;
begin
  Result := FMetaData.GetCharSetID;
end;

function TFBBlob.GetCodePage: TSystemCodePage;
begin
  Result := FMetaData.GetCodePage;
end;

function TFBBlob.GetSegmentSize: cardinal;
begin
  Result := FMetaData.GetSegmentSize;
end;

function TFBBlob.GetRelationName: AnsiString;
begin
  Result := FMetaData.GetRelationName;
end;

function TFBBlob.GetColumnName: AnsiString;
begin
  Result := FMetaData.GetColumnName;
end;

function TFBBlob.GetUnconfirmedCharacterSet: boolean;
begin
  Result := (FMetadata as TFBBlobMetadata).GetUnconfirmedCharacterSet;
end;

function TFBBlob.GetBPB: IBPB;
begin
  Result := FBPB;
end;

procedure TFBBlob.Cancel;
begin
  InternalCancel(false);
end;

procedure TFBBlob.Close;
begin
  InternalClose(false);
end;

function TFBBlob.GetBlobSize: Int64;
var NumSegments: Int64;
    MaxSegmentSize: Int64;
    BlobType: TBlobType;
begin
  GetInfo(NumSegments,MaxSegmentSize,Result,BlobType);
end;

procedure TFBBlob.GetInfo(var NumSegments: Int64; var MaxSegmentSize,
  TotalSize: Int64; var BlobType: TBlobType);
var BlobInfo: IBlobInfo;
    i: integer;
begin
  NumSegments := 0;
  MaxSegmentSize := 0;
  TotalSize := 0;
  BlobType := btSegmented;

  BlobInfo := TBlobInfo.Create;
  GetInfo([isc_info_blob_num_segments,
           isc_info_blob_max_segment,
           isc_info_blob_total_length,
           isc_info_blob_type],BlobInfo);

  for i := 0 to BlobInfo.Count - 1 do
  with BlobInfo[i] do
  case getItemType of
  isc_info_blob_num_segments:
    NumSegments := GetAsInteger;
  isc_info_blob_max_segment:
    MaxSegmentSize := GetAsInteger;
  isc_info_blob_total_length:
    TotalSize := GetAsInteger;
  isc_info_blob_type:
    if GetAsInteger = 0 then
      BlobType := btSegmented
    else
      BlobType := btStream;
  end;
end;

function TFBBlob.GetBlobID: TISC_QUAD;
begin
  Result := FBlobID;
end;

function TFBBlob.GetBlobMode: TFBBlobMode;
begin
  if FCreating then
    Result := fbmWrite
  else
    Result := fbmRead;
end;

function TFBBlob.LoadFromFile(Filename: AnsiString): IBlob;
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    Result := LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

const BufSize = 8 * 1024;

function TFBBlob.LoadFromStream(S: TStream): IBlob;
var Buffer: array [0..BufSize-1] of char;
    BytesRead: integer;
begin
  CheckWritable;
  S.Position := 0;
  repeat
    BytesRead := S.Read(Buffer,BufSize);
    Write(Buffer,BytesRead);
  until BytesRead = 0;
  Close;
  Result := GetIntf;
end;

function TFBBlob.SaveToFile(Filename: AnsiString): IBlob;
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    Result := SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

function TFBBlob.SaveToStream(S: TStream): IBlob;
var Buffer: array [0..BufSize-1] of char;
    BytesRead: integer;
begin
  CheckReadable;
  repeat
    BytesRead := Read(Buffer,BufSize);
    S.Write(Buffer,BytesRead);
  until BytesRead = 0;
  Close;
  Result := GetIntf;
end;

function TFBBlob.GetAttachment: IAttachment;
begin
  Result := FAttachment;
end;

function TFBBlob.GetTransaction: ITransaction;
begin
   Result := FTransaction;
end;

function TFBBlob.GetAsString: rawbytestring;
var ss: TStringStream;
begin
  if FStringCached then
  begin
    Result := FStringData;
    Exit;
  end;

  ss := TStringStream.Create('');
  try
    SaveToStream(ss);
    Result :=  ss.DataString;
    if (GetSubType = 1) and (FBPB = nil) then
      SetCodePage(Result,GetCodePage,false);
  finally
    ss.Free;
  end;
  FStringData := Result;
  FStringCached := true;
end;

procedure TFBBlob.SetAsString(aValue: rawbytestring);
var
  ss: TStringStream;
begin
  {if GetUnconfirmedCharacterSet then
    IBError(ibxeNoDefaultCharacterSet,[nil]);}

  if (GetSubType = 1) and  (StringCodePage(aValue) <> GetCodePage) and
           (GetCodePage <> CP_NONE) and (FBPB = nil) then
    SetCodePage(aValue,GetCodePage,true);
  ss := TStringStream.Create(aValue);
  try
    LoadFromStream(ss);
  finally
    ss.Free;
  end;
  FStringData := aValue;
  FStringCached := true;
end;

function TFBBlob.SetString(aValue: rawbytestring): IBlob;
begin
  SetAsString(aValue);
  Result := GetIntf;
end;

{TFBBlobMetaData}

procedure TFBBlobMetaData.NeedSubType;
begin
  if not FHasSubType then
  begin
    NeedFullMetadata;
    FHasSubType := true;
  end;
end;

constructor TFBBlobMetaData.Create(Transaction: TFBTransaction; RelationName,
  ColumnName: AnsiString);
begin
  inherited Create(Transaction);
//  if (RelationName = '') or (ColumnName = '') then
 //   IBError(ibxeMissingColumnName,[]);
  FRelationName := RelationName;
  FColumnName := ColumnName;
  FSegmentSize := 80;
  FUnconfirmedCharacterSet := true;
  FCharSetID := 0;
end;

procedure TFBBlobMetaData.SetCharSetID(aValue: integer);
begin
  FCharSetID := aValue;
  FUnconfirmedCharacterSet := false;
end;

function TFBBlobMetaData.GetSubType: integer;
begin
  NeedSubType;
  Result := FSubType;
end;

function TFBBlobMetaData.GetCharSetID: cardinal;
begin
  NeedFullMetadata;
  Result := FCharSetID;
end;

function TFBBlobMetaData.GetCodePage: TSystemCodePage;
begin
  Attachment.CharSetID2CodePage(GetCharSetID,Result);
end;

function TFBBlobMetaData.GetSegmentSize: cardinal;
begin
  NeedFullMetadata;
  Result := FSegmentSize;
end;

function TFBBlobMetaData.GetRelationName: AnsiString;
begin
  Result := FRelationName;
end;

function TFBBlobMetaData.GetColumnName: AnsiString;
begin
  Result := FColumnName;
end;

function TFBBlobMetaData.GetUnconfirmedCharacterSet: boolean;
begin
  NeedFullMetadata;
  Result := FUnconfirmedCharacterSet;
end;


end.

Revision:	60
Committed:	Mon Mar 27 15:21:02 2017 UTC (7 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	11440 byte(s)
Log Message:
#	Content
1	(*
2	* Firebird Interface (fbintf). The fbintf components provide a set of
3	* Pascal language bindings for the Firebird API. Although predominantly
4	* a new development they include source code taken from IBX and may be
5	* considered a derived product. This software thus also includes the copyright
6	* notice and license conditions from IBX.
7	*
8	* Except for those parts dervied from IBX, contents of this file are subject
9	* to the Initial Developer's Public License Version 1.0 (the "License"); you
10	* may not use this file except in compliance with the License. You may obtain a
11	* copy of the License here:
12	*
13	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
14	*
15	* Software distributed under the License is distributed on an "AS
16	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
17	* implied. See the License for the specific language governing rights
18	* and limitations under the License.
19	*
20	* The Initial Developer of the Original Code is Tony Whyman.
21	*
22	* The Original Code is (C) 2016 Tony Whyman, MWA Software
23	* (http://www.mwasoftware.co.uk).
24	*
25	* All Rights Reserved.
26	*
27	* Contributor(s): ______________________________________.
28	*
29	*)
30	unit FBBlob;
31	{$IFDEF MSWINDOWS}
32	{$DEFINE WINDOWS}
33	{$ENDIF}
34
35	{$IFDEF FPC}
36	{$mode delphi}
37	{$interfaces COM}
38	{$ENDIF}
39
40	interface
41
42	uses
43	Classes, SysUtils, IB, FBActivityMonitor, FBTransaction, FBClientAPI,
44	FBOutputBlock;
45
46	type
47
48	{ TFBBlobMetaData }
49
50	TFBBlobMetaData = class(TActivityReporter)
51	private
52	FRelationName: AnsiString;
53	FColumnName: AnsiString;
54	protected
55	FUnconfirmedCharacterSet: boolean;
56	FHasSubType: boolean;
57	FSubType: integer;
58	FCharSetID: cardinal;
59	FSegmentSize: cardinal;
60	function Attachment: IAttachment; virtual; abstract;
61	procedure NeedFullMetadata; virtual; abstract;
62	procedure NeedSubType;
63	public
64	constructor Create(Transaction: TFBTransaction; RelationName, ColumnName: AnsiString
65	);
66	procedure SetCharSetID(aValue: integer);
67
68	public
69	{IBlobMetaData}
70	function GetSubType: integer;
71	function GetCharSetID: cardinal;
72	function GetCodePage: TSystemCodePage;
73	function GetSegmentSize: cardinal;
74	function GetRelationName: AnsiString;
75	function GetColumnName: AnsiString;
76	function GetUnconfirmedCharacterSet: boolean;
77	end;
78
79	TFBBlob = class(TActivityReporter)
80	private
81	FMetaData: IBlobMetaData;
82	FAttachment: IAttachment;
83	FTransaction: ITransaction;
84	FBPB: IBPB;
85	FStringData: rawbytestring;
86	FStringCached: boolean;
87	protected
88	FCreating: boolean;
89	FBlobID: TISC_QUAD;
90	procedure CheckReadable; virtual; abstract;
91	procedure CheckWritable; virtual; abstract;
92	procedure ClearStringCache;
93	function GetIntf: IBlob; virtual; abstract;
94	procedure GetInfo(Request: array of byte; Response: IBlobInfo); overload; virtual; abstract;
95	procedure InternalClose(Force: boolean); virtual; abstract;
96	procedure InternalCancel(Force: boolean); virtual; abstract;
97	public
98	constructor Create(Attachment: IAttachment; Transaction: TFBTransaction;
99	MetaData: IBlobMetaData; BPB: IBPB); overload;
100	constructor Create(Attachment: IAttachment; Transaction: TFBTransaction;
101	MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB); overload;
102	destructor Destroy; override;
103	procedure TransactionEnding(aTransaction: TFBTransaction; Force: boolean);
104
105	public
106	{IBlobMetaData}
107	function GetSubType: integer;
108	function GetCharSetID: cardinal;
109	function GetCodePage: TSystemCodePage;
110	function GetSegmentSize: cardinal;
111	function GetRelationName: AnsiString;
112	function GetColumnName: AnsiString;
113	function GetUnconfirmedCharacterSet: boolean;
114
115	{IBlob}
116	function GetBPB: IBPB;
117	procedure Cancel;
118	procedure Close;
119	function GetBlobSize: Int64;
120	procedure GetInfo(var NumSegments: Int64; var MaxSegmentSize, TotalSize: Int64;
121	var BlobType: TBlobType); overload;
122	function GetBlobID: TISC_QUAD;
123	function GetBlobMode: TFBBlobMode;
124	function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
125	function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
126	function LoadFromFile(Filename: AnsiString): IBlob;
127	function LoadFromStream(S: TStream) : IBlob;
128	function SaveToFile(Filename: AnsiString): IBlob;
129	function SaveToStream(S: TStream): IBlob;
130	function GetAttachment: IAttachment;
131	function GetTransaction: ITransaction;
132	function GetAsString: rawbytestring;
133	procedure SetAsString(aValue: rawbytestring);
134	function SetString(aValue: rawbytestring): IBlob;
135	end;
136
137
138
139	implementation
140
141	uses FBMessages;
142
143	{ TFBBlob }
144
145	procedure TFBBlob.ClearStringCache;
146	begin
147	FStringData := '';
148	FStringCached := false;
149	end;
150
151	constructor TFBBlob.Create(Attachment: IAttachment;
152	Transaction: TFBTransaction; MetaData: IBlobMetaData; BPB: IBPB);
153	begin
154	inherited Create(Transaction);
155	FAttachment := Attachment;
156	FTransaction := Transaction;
157	FMetaData := MetaData;
158	FBPB := BPB;
159	FCreating := true;
160	end;
161
162	constructor TFBBlob.Create(Attachment: IAttachment;
163	Transaction: TFBTransaction; MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB);
164	begin
165	Create(Attachment,Transaction,MetaData,BPB);
166	FBlobID := BlobID;
167	FCreating := false;
168	end;
169
170	destructor TFBBlob.Destroy;
171	begin
172	if FCreating then
173	Cancel
174	else
175	Close;
176	inherited Destroy;
177	end;
178
179	procedure TFBBlob.TransactionEnding(aTransaction: TFBTransaction;
180	Force: boolean);
181	begin
182	if aTransaction <> (FTransaction as TFBTransaction) then
183	Exit;
184	if FCreating then
185	InternalCancel(Force)
186	else
187	InternalClose(Force);
188	end;
189
190	function TFBBlob.GetSubType: integer;
191	begin
192	Result := FMetaData.GetSubType;
193	end;
194
195	function TFBBlob.GetCharSetID: cardinal;
196	begin
197	Result := FMetaData.GetCharSetID;
198	end;
199
200	function TFBBlob.GetCodePage: TSystemCodePage;
201	begin
202	Result := FMetaData.GetCodePage;
203	end;
204
205	function TFBBlob.GetSegmentSize: cardinal;
206	begin
207	Result := FMetaData.GetSegmentSize;
208	end;
209
210	function TFBBlob.GetRelationName: AnsiString;
211	begin
212	Result := FMetaData.GetRelationName;
213	end;
214
215	function TFBBlob.GetColumnName: AnsiString;
216	begin
217	Result := FMetaData.GetColumnName;
218	end;
219
220	function TFBBlob.GetUnconfirmedCharacterSet: boolean;
221	begin
222	Result := (FMetadata as TFBBlobMetadata).GetUnconfirmedCharacterSet;
223	end;
224
225	function TFBBlob.GetBPB: IBPB;
226	begin
227	Result := FBPB;
228	end;
229
230	procedure TFBBlob.Cancel;
231	begin
232	InternalCancel(false);
233	end;
234
235	procedure TFBBlob.Close;
236	begin
237	InternalClose(false);
238	end;
239
240	function TFBBlob.GetBlobSize: Int64;
241	var NumSegments: Int64;
242	MaxSegmentSize: Int64;
243	BlobType: TBlobType;
244	begin
245	GetInfo(NumSegments,MaxSegmentSize,Result,BlobType);
246	end;
247
248	procedure TFBBlob.GetInfo(var NumSegments: Int64; var MaxSegmentSize,
249	TotalSize: Int64; var BlobType: TBlobType);
250	var BlobInfo: IBlobInfo;
251	i: integer;
252	begin
253	NumSegments := 0;
254	MaxSegmentSize := 0;
255	TotalSize := 0;
256	BlobType := btSegmented;
257
258	BlobInfo := TBlobInfo.Create;
259	GetInfo([isc_info_blob_num_segments,
260	isc_info_blob_max_segment,
261	isc_info_blob_total_length,
262	isc_info_blob_type],BlobInfo);
263
264	for i := 0 to BlobInfo.Count - 1 do
265	with BlobInfo[i] do
266	case getItemType of
267	isc_info_blob_num_segments:
268	NumSegments := GetAsInteger;
269	isc_info_blob_max_segment:
270	MaxSegmentSize := GetAsInteger;
271	isc_info_blob_total_length:
272	TotalSize := GetAsInteger;
273	isc_info_blob_type:
274	if GetAsInteger = 0 then
275	BlobType := btSegmented
276	else
277	BlobType := btStream;
278	end;
279	end;
280
281	function TFBBlob.GetBlobID: TISC_QUAD;
282	begin
283	Result := FBlobID;
284	end;
285
286	function TFBBlob.GetBlobMode: TFBBlobMode;
287	begin
288	if FCreating then
289	Result := fbmWrite
290	else
291	Result := fbmRead;
292	end;
293
294	function TFBBlob.LoadFromFile(Filename: AnsiString): IBlob;
295	var
296	Stream: TStream;
297	begin
298	Stream := TFileStream.Create(FileName, fmOpenRead);
299	try
300	Result := LoadFromStream(Stream);
301	finally
302	Stream.Free;
303	end;
304	end;
305
306	const BufSize = 8 * 1024;
307
308	function TFBBlob.LoadFromStream(S: TStream): IBlob;
309	var Buffer: array [0..BufSize-1] of char;
310	BytesRead: integer;
311	begin
312	CheckWritable;
313	S.Position := 0;
314	repeat
315	BytesRead := S.Read(Buffer,BufSize);
316	Write(Buffer,BytesRead);
317	until BytesRead = 0;
318	Close;
319	Result := GetIntf;
320	end;
321
322	function TFBBlob.SaveToFile(Filename: AnsiString): IBlob;
323	var
324	Stream: TStream;
325	begin
326	Stream := TFileStream.Create(FileName, fmCreate);
327	try
328	Result := SaveToStream(Stream);
329	finally
330	Stream.Free;
331	end;
332	end;
333
334	function TFBBlob.SaveToStream(S: TStream): IBlob;
335	var Buffer: array [0..BufSize-1] of char;
336	BytesRead: integer;
337	begin
338	CheckReadable;
339	repeat
340	BytesRead := Read(Buffer,BufSize);
341	S.Write(Buffer,BytesRead);
342	until BytesRead = 0;
343	Close;
344	Result := GetIntf;
345	end;
346
347	function TFBBlob.GetAttachment: IAttachment;
348	begin
349	Result := FAttachment;
350	end;
351
352	function TFBBlob.GetTransaction: ITransaction;
353	begin
354	Result := FTransaction;
355	end;
356
357	function TFBBlob.GetAsString: rawbytestring;
358	var ss: TStringStream;
359	begin
360	if FStringCached then
361	begin
362	Result := FStringData;
363	Exit;
364	end;
365
366	ss := TStringStream.Create('');
367	try
368	SaveToStream(ss);
369	Result := ss.DataString;
370	if (GetSubType = 1) and (FBPB = nil) then
371	SetCodePage(Result,GetCodePage,false);
372	finally
373	ss.Free;
374	end;
375	FStringData := Result;
376	FStringCached := true;
377	end;
378
379	procedure TFBBlob.SetAsString(aValue: rawbytestring);
380	var
381	ss: TStringStream;
382	begin
383	{if GetUnconfirmedCharacterSet then
384	IBError(ibxeNoDefaultCharacterSet,[nil]);}
385
386	if (GetSubType = 1) and (StringCodePage(aValue) <> GetCodePage) and
387	(GetCodePage <> CP_NONE) and (FBPB = nil) then
388	SetCodePage(aValue,GetCodePage,true);
389	ss := TStringStream.Create(aValue);
390	try
391	LoadFromStream(ss);
392	finally
393	ss.Free;
394	end;
395	FStringData := aValue;
396	FStringCached := true;
397	end;
398
399	function TFBBlob.SetString(aValue: rawbytestring): IBlob;
400	begin
401	SetAsString(aValue);
402	Result := GetIntf;
403	end;
404
405	{TFBBlobMetaData}
406
407	procedure TFBBlobMetaData.NeedSubType;
408	begin
409	if not FHasSubType then
410	begin
411	NeedFullMetadata;
412	FHasSubType := true;
413	end;
414	end;
415
416	constructor TFBBlobMetaData.Create(Transaction: TFBTransaction; RelationName,
417	ColumnName: AnsiString);
418	begin
419	inherited Create(Transaction);
420	// if (RelationName = '') or (ColumnName = '') then
421	// IBError(ibxeMissingColumnName,[]);
422	FRelationName := RelationName;
423	FColumnName := ColumnName;
424	FSegmentSize := 80;
425	FUnconfirmedCharacterSet := true;
426	FCharSetID := 0;
427	end;
428
429	procedure TFBBlobMetaData.SetCharSetID(aValue: integer);
430	begin
431	FCharSetID := aValue;
432	FUnconfirmedCharacterSet := false;
433	end;
434
435	function TFBBlobMetaData.GetSubType: integer;
436	begin
437	NeedSubType;
438	Result := FSubType;
439	end;
440
441	function TFBBlobMetaData.GetCharSetID: cardinal;
442	begin
443	NeedFullMetadata;
444	Result := FCharSetID;
445	end;
446
447	function TFBBlobMetaData.GetCodePage: TSystemCodePage;
448	begin
449	Attachment.CharSetID2CodePage(GetCharSetID,Result);
450	end;
451
452	function TFBBlobMetaData.GetSegmentSize: cardinal;
453	begin
454	NeedFullMetadata;
455	Result := FSegmentSize;
456	end;
457
458	function TFBBlobMetaData.GetRelationName: AnsiString;
459	begin
460	Result := FRelationName;
461	end;
462
463	function TFBBlobMetaData.GetColumnName: AnsiString;
464	begin
465	Result := FColumnName;
466	end;
467
468	function TFBBlobMetaData.GetUnconfirmedCharacterSet: boolean;
469	begin
470	NeedFullMetadata;
471	Result := FUnconfirmedCharacterSet;
472	end;
473
474
475	end.
476