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, 1 month ago) by tony
Content type:	text/x-pascal
File size:	11390 byte(s)
Log Message:	Committing updates for Trunk
#	User	Rev	Content
1	tony	45	(*
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	tony	56	{$IFDEF MSWINDOWS}
32			{$DEFINE WINDOWS}
33			{$ENDIF}
34	tony	45
35			{$IFDEF FPC}
36	tony	56	{$mode delphi}
37	tony	45	{$interfaces COM}
38			{$ENDIF}
39
40			interface
41
42			uses
43	tony	56	Classes, SysUtils, IB, FBActivityMonitor, FBTransaction, FBClientAPI,
44			FBOutputBlock;
45	tony	45
46			type
47
48			{ TFBBlobMetaData }
49
50			TFBBlobMetaData = class(TActivityReporter)
51			private
52	tony	56	FRelationName: AnsiString;
53			FColumnName: AnsiString;
54	tony	45	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	tony	56	constructor Create(Transaction: TFBTransaction; RelationName, ColumnName: AnsiString
64	tony	45	);
65	tony	47	procedure SetCharSetID(aValue: integer);
66	tony	45
67			public
68			{IBlobMetaData}
69			function GetSubType: integer;
70			function GetCharSetID: cardinal;
71			function GetCodePage: TSystemCodePage;
72			function GetSegmentSize: cardinal;
73	tony	56	function GetRelationName: AnsiString;
74			function GetColumnName: AnsiString;
75	tony	45	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	tony	56	procedure GetInfo(Request: array of byte; Response: IBlobInfo); overload; virtual; abstract;
94	tony	45	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	tony	56	function GetRelationName: AnsiString;
111			function GetColumnName: AnsiString;
112	tony	45	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	tony	56	var BlobType: TBlobType); overload;
121	tony	45	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	tony	56	function LoadFromFile(Filename: AnsiString): IBlob;
126	tony	45	function LoadFromStream(S: TStream) : IBlob;
127	tony	56	function SaveToFile(Filename: AnsiString): IBlob;
128	tony	45	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	tony	56	if aTransaction <> (FTransaction as TFBTransaction) then
182	tony	45	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	tony	56	function TFBBlob.GetRelationName: AnsiString;
210	tony	45	begin
211			Result := FMetaData.GetRelationName;
212			end;
213
214	tony	56	function TFBBlob.GetColumnName: AnsiString;
215	tony	45	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	tony	56	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	tony	45	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	tony	56	function TFBBlob.LoadFromFile(Filename: AnsiString): IBlob;
294	tony	45	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	tony	56	function TFBBlob.SaveToFile(Filename: AnsiString): IBlob;
322	tony	45	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	tony	56	ColumnName: AnsiString);
417	tony	45	begin
418			inherited Create(Transaction);
419			// if (RelationName = '') or (ColumnName = '') then
420			// IBError(ibxeMissingColumnName,[]);
421			FRelationName := RelationName;
422			FColumnName := ColumnName;
423			FSegmentSize := 80;
424	tony	47	FUnconfirmedCharacterSet := true;
425			FCharSetID := 0;
426	tony	45	end;
427
428	tony	47	procedure TFBBlobMetaData.SetCharSetID(aValue: integer);
429			begin
430			FCharSetID := aValue;
431			FUnconfirmedCharacterSet := false;
432			end;
433
434	tony	45	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	tony	56	function TFBBlobMetaData.GetRelationName: AnsiString;
458	tony	45	begin
459			Result := FRelationName;
460			end;
461
462	tony	56	function TFBBlobMetaData.GetColumnName: AnsiString;
463	tony	45	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