fbintf/client/FBBlob.pas

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

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

interface

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

type

  { TFBBlobMetaData }

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

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

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

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

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


implementation

uses FBMessages;

{ TFBBlob }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

const BufSize = 8 * 1024;

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

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

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

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

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

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

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

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

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

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

{TFBBlobMetaData}

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

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

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

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

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

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

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

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

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

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


end.

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