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;
    function CanFetchMetaData: boolean;
    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,ITransactionUser)
  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;

  public
    {ITransactionUser}
    procedure TransactionEnding(aTransaction: ITransaction; 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

{ 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: ITransaction; Force: boolean);
begin
  if (aTransaction as TObject) <> (FTransaction as TObject) 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(FAttachment.getFirebirdAPI as TFBClientAPI);
  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}

function TFBBlobMetaData.CanFetchMetaData: boolean;
begin
  Result := (FRelationName <> '') and (FColumnName <> '');
end;

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