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;
    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
  FirebirdClientAPI.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:	56
Committed:	Mon Mar 6 10:20:02 2017 UTC (7 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	11390 byte(s)
Log Message:	Committing updates for Trunk
#	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	procedure NeedFullMetadata; virtual; abstract;
61	procedure NeedSubType;
62	public
63	constructor Create(Transaction: TFBTransaction; RelationName, ColumnName: AnsiString
64	);
65	procedure SetCharSetID(aValue: integer);
66
67	public
68	{IBlobMetaData}
69	function GetSubType: integer;
70	function GetCharSetID: cardinal;
71	function GetCodePage: TSystemCodePage;
72	function GetSegmentSize: cardinal;
73	function GetRelationName: AnsiString;
74	function GetColumnName: AnsiString;
75	function GetUnconfirmedCharacterSet: boolean;
76	end;
77
78	TFBBlob = class(TActivityReporter)
79	private
80	FMetaData: IBlobMetaData;
81	FAttachment: IAttachment;
82	FTransaction: ITransaction;
83	FBPB: IBPB;
84	FStringData: rawbytestring;
85	FStringCached: boolean;
86	protected
87	FCreating: boolean;
88	FBlobID: TISC_QUAD;
89	procedure CheckReadable; virtual; abstract;
90	procedure CheckWritable; virtual; abstract;
91	procedure ClearStringCache;
92	function GetIntf: IBlob; virtual; abstract;
93	procedure GetInfo(Request: array of byte; Response: IBlobInfo); overload; virtual; abstract;
94	procedure InternalClose(Force: boolean); virtual; abstract;
95	procedure InternalCancel(Force: boolean); virtual; abstract;
96	public
97	constructor Create(Attachment: IAttachment; Transaction: TFBTransaction;
98	MetaData: IBlobMetaData; BPB: IBPB); overload;
99	constructor Create(Attachment: IAttachment; Transaction: TFBTransaction;
100	MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB); overload;
101	destructor Destroy; override;
102	procedure TransactionEnding(aTransaction: TFBTransaction; Force: boolean);
103
104	public
105	{IBlobMetaData}
106	function GetSubType: integer;
107	function GetCharSetID: cardinal;
108	function GetCodePage: TSystemCodePage;
109	function GetSegmentSize: cardinal;
110	function GetRelationName: AnsiString;
111	function GetColumnName: AnsiString;
112	function GetUnconfirmedCharacterSet: boolean;
113
114	{IBlob}
115	function GetBPB: IBPB;
116	procedure Cancel;
117	procedure Close;
118	function GetBlobSize: Int64;
119	procedure GetInfo(var NumSegments: Int64; var MaxSegmentSize, TotalSize: Int64;
120	var BlobType: TBlobType); overload;
121	function GetBlobID: TISC_QUAD;
122	function GetBlobMode: TFBBlobMode;
123	function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
124	function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
125	function LoadFromFile(Filename: AnsiString): IBlob;
126	function LoadFromStream(S: TStream) : IBlob;
127	function SaveToFile(Filename: AnsiString): IBlob;
128	function SaveToStream(S: TStream): IBlob;
129	function GetAttachment: IAttachment;
130	function GetTransaction: ITransaction;
131	function GetAsString: rawbytestring;
132	procedure SetAsString(aValue: rawbytestring);
133	function SetString(aValue: rawbytestring): IBlob;
134	end;
135
136
137
138	implementation
139
140	uses FBMessages;
141
142	{ TFBBlob }
143
144	procedure TFBBlob.ClearStringCache;
145	begin
146	FStringData := '';
147	FStringCached := false;
148	end;
149
150	constructor TFBBlob.Create(Attachment: IAttachment;
151	Transaction: TFBTransaction; MetaData: IBlobMetaData; BPB: IBPB);
152	begin
153	inherited Create(Transaction);
154	FAttachment := Attachment;
155	FTransaction := Transaction;
156	FMetaData := MetaData;
157	FBPB := BPB;
158	FCreating := true;
159	end;
160
161	constructor TFBBlob.Create(Attachment: IAttachment;
162	Transaction: TFBTransaction; MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB);
163	begin
164	Create(Attachment,Transaction,MetaData,BPB);
165	FBlobID := BlobID;
166	FCreating := false;
167	end;
168
169	destructor TFBBlob.Destroy;
170	begin
171	if FCreating then
172	Cancel
173	else
174	Close;
175	inherited Destroy;
176	end;
177
178	procedure TFBBlob.TransactionEnding(aTransaction: TFBTransaction;
179	Force: boolean);
180	begin
181	if aTransaction <> (FTransaction as TFBTransaction) then
182	Exit;
183	if FCreating then
184	InternalCancel(Force)
185	else
186	InternalClose(Force);
187	end;
188
189	function TFBBlob.GetSubType: integer;
190	begin
191	Result := FMetaData.GetSubType;
192	end;
193
194	function TFBBlob.GetCharSetID: cardinal;
195	begin
196	Result := FMetaData.GetCharSetID;
197	end;
198
199	function TFBBlob.GetCodePage: TSystemCodePage;
200	begin
201	Result := FMetaData.GetCodePage;
202	end;
203
204	function TFBBlob.GetSegmentSize: cardinal;
205	begin
206	Result := FMetaData.GetSegmentSize;
207	end;
208
209	function TFBBlob.GetRelationName: AnsiString;
210	begin
211	Result := FMetaData.GetRelationName;
212	end;
213
214	function TFBBlob.GetColumnName: AnsiString;
215	begin
216	Result := FMetaData.GetColumnName;
217	end;
218
219	function TFBBlob.GetUnconfirmedCharacterSet: boolean;
220	begin
221	Result := (FMetadata as TFBBlobMetadata).GetUnconfirmedCharacterSet;
222	end;
223
224	function TFBBlob.GetBPB: IBPB;
225	begin
226	Result := FBPB;
227	end;
228
229	procedure TFBBlob.Cancel;
230	begin
231	InternalCancel(false);
232	end;
233
234	procedure TFBBlob.Close;
235	begin
236	InternalClose(false);
237	end;
238
239	function TFBBlob.GetBlobSize: Int64;
240	var NumSegments: Int64;
241	MaxSegmentSize: Int64;
242	BlobType: TBlobType;
243	begin
244	GetInfo(NumSegments,MaxSegmentSize,Result,BlobType);
245	end;
246
247	procedure TFBBlob.GetInfo(var NumSegments: Int64; var MaxSegmentSize,
248	TotalSize: Int64; var BlobType: TBlobType);
249	var BlobInfo: IBlobInfo;
250	i: integer;
251	begin
252	NumSegments := 0;
253	MaxSegmentSize := 0;
254	TotalSize := 0;
255	BlobType := btSegmented;
256
257	BlobInfo := TBlobInfo.Create;
258	GetInfo([isc_info_blob_num_segments,
259	isc_info_blob_max_segment,
260	isc_info_blob_total_length,
261	isc_info_blob_type],BlobInfo);
262
263	for i := 0 to BlobInfo.Count - 1 do
264	with BlobInfo[i] do
265	case getItemType of
266	isc_info_blob_num_segments:
267	NumSegments := GetAsInteger;
268	isc_info_blob_max_segment:
269	MaxSegmentSize := GetAsInteger;
270	isc_info_blob_total_length:
271	TotalSize := GetAsInteger;
272	isc_info_blob_type:
273	if GetAsInteger = 0 then
274	BlobType := btSegmented
275	else
276	BlobType := btStream;
277	end;
278	end;
279
280	function TFBBlob.GetBlobID: TISC_QUAD;
281	begin
282	Result := FBlobID;
283	end;
284
285	function TFBBlob.GetBlobMode: TFBBlobMode;
286	begin
287	if FCreating then
288	Result := fbmWrite
289	else
290	Result := fbmRead;
291	end;
292
293	function TFBBlob.LoadFromFile(Filename: AnsiString): IBlob;
294	var
295	Stream: TStream;
296	begin
297	Stream := TFileStream.Create(FileName, fmOpenRead);
298	try
299	Result := LoadFromStream(Stream);
300	finally
301	Stream.Free;
302	end;
303	end;
304
305	const BufSize = 8 * 1024;
306
307	function TFBBlob.LoadFromStream(S: TStream): IBlob;
308	var Buffer: array [0..BufSize-1] of char;
309	BytesRead: integer;
310	begin
311	CheckWritable;
312	S.Position := 0;
313	repeat
314	BytesRead := S.Read(Buffer,BufSize);
315	Write(Buffer,BytesRead);
316	until BytesRead = 0;
317	Close;
318	Result := GetIntf;
319	end;
320
321	function TFBBlob.SaveToFile(Filename: AnsiString): IBlob;
322	var
323	Stream: TStream;
324	begin
325	Stream := TFileStream.Create(FileName, fmCreate);
326	try
327	Result := SaveToStream(Stream);
328	finally
329	Stream.Free;
330	end;
331	end;
332
333	function TFBBlob.SaveToStream(S: TStream): IBlob;
334	var Buffer: array [0..BufSize-1] of char;
335	BytesRead: integer;
336	begin
337	CheckReadable;
338	repeat
339	BytesRead := Read(Buffer,BufSize);
340	S.Write(Buffer,BytesRead);
341	until BytesRead = 0;
342	Close;
343	Result := GetIntf;
344	end;
345
346	function TFBBlob.GetAttachment: IAttachment;
347	begin
348	Result := FAttachment;
349	end;
350
351	function TFBBlob.GetTransaction: ITransaction;
352	begin
353	Result := FTransaction;
354	end;
355
356	function TFBBlob.GetAsString: rawbytestring;
357	var ss: TStringStream;
358	begin
359	if FStringCached then
360	begin
361	Result := FStringData;
362	Exit;
363	end;
364
365	ss := TStringStream.Create('');
366	try
367	SaveToStream(ss);
368	Result := ss.DataString;
369	if (GetSubType = 1) and (FBPB = nil) then
370	SetCodePage(Result,GetCodePage,false);
371	finally
372	ss.Free;
373	end;
374	FStringData := Result;
375	FStringCached := true;
376	end;
377
378	procedure TFBBlob.SetAsString(aValue: rawbytestring);
379	var
380	ss: TStringStream;
381	begin
382	{if GetUnconfirmedCharacterSet then
383	IBError(ibxeNoDefaultCharacterSet,[nil]);}
384
385	if (GetSubType = 1) and (StringCodePage(aValue) <> GetCodePage) and
386	(GetCodePage <> CP_NONE) and (FBPB = nil) then
387	SetCodePage(aValue,GetCodePage,true);
388	ss := TStringStream.Create(aValue);
389	try
390	LoadFromStream(ss);
391	finally
392	ss.Free;
393	end;
394	FStringData := aValue;
395	FStringCached := true;
396	end;
397
398	function TFBBlob.SetString(aValue: rawbytestring): IBlob;
399	begin
400	SetAsString(aValue);
401	Result := GetIntf;
402	end;
403
404	{TFBBlobMetaData}
405
406	procedure TFBBlobMetaData.NeedSubType;
407	begin
408	if not FHasSubType then
409	begin
410	NeedFullMetadata;
411	FHasSubType := true;
412	end;
413	end;
414
415	constructor TFBBlobMetaData.Create(Transaction: TFBTransaction; RelationName,
416	ColumnName: AnsiString);
417	begin
418	inherited Create(Transaction);
419	// if (RelationName = '') or (ColumnName = '') then
420	// IBError(ibxeMissingColumnName,[]);
421	FRelationName := RelationName;
422	FColumnName := ColumnName;
423	FSegmentSize := 80;
424	FUnconfirmedCharacterSet := true;
425	FCharSetID := 0;
426	end;
427
428	procedure TFBBlobMetaData.SetCharSetID(aValue: integer);
429	begin
430	FCharSetID := aValue;
431	FUnconfirmedCharacterSet := false;
432	end;
433
434	function TFBBlobMetaData.GetSubType: integer;
435	begin
436	NeedSubType;
437	Result := FSubType;
438	end;
439
440	function TFBBlobMetaData.GetCharSetID: cardinal;
441	begin
442	NeedFullMetadata;
443	Result := FCharSetID;
444	end;
445
446	function TFBBlobMetaData.GetCodePage: TSystemCodePage;
447	begin
448	FirebirdClientAPI.CharSetID2CodePage(GetCharSetID,Result);
449	end;
450
451	function TFBBlobMetaData.GetSegmentSize: cardinal;
452	begin
453	NeedFullMetadata;
454	Result := FSegmentSize;
455	end;
456
457	function TFBBlobMetaData.GetRelationName: AnsiString;
458	begin
459	Result := FRelationName;
460	end;
461
462	function TFBBlobMetaData.GetColumnName: AnsiString;
463	begin
464	Result := FColumnName;
465	end;
466
467	function TFBBlobMetaData.GetUnconfirmedCharacterSet: boolean;
468	begin
469	NeedFullMetadata;
470	Result := FUnconfirmedCharacterSet;
471	end;
472
473
474	end.
475