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
    FConnectionCodePage: TSystemCodePage;
    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;
    property ConnectionCodePage: TSystemCodePage read FConnectionCodePage;

  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

uses IBUtils {$ifdef WINDOWS}, Windows{$endif};

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