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:	362
Committed:	Tue Dec 7 13:27:39 2021 UTC (3 years ago) by tony
Content type:	text/x-pascal
File size:	11735 byte(s)
Log Message:	initiate test release
#	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	109	function CanFetchMetaData: boolean;
62	tony	45	procedure NeedFullMetadata; virtual; abstract;
63			procedure NeedSubType;
64			public
65	tony	56	constructor Create(Transaction: TFBTransaction; RelationName, ColumnName: AnsiString
66	tony	45	);
67	tony	47	procedure SetCharSetID(aValue: integer);
68	tony	45
69			public
70			{IBlobMetaData}
71			function GetSubType: integer;
72			function GetCharSetID: cardinal;
73			function GetCodePage: TSystemCodePage;
74			function GetSegmentSize: cardinal;
75	tony	56	function GetRelationName: AnsiString;
76			function GetColumnName: AnsiString;
77	tony	45	function GetUnconfirmedCharacterSet: boolean;
78			end;
79
80	tony	315	TFBBlob = class(TActivityReporter,ITransactionUser)
81	tony	45	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	tony	56	procedure GetInfo(Request: array of byte; Response: IBlobInfo); overload; virtual; abstract;
96	tony	45	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	tony	315	{ITransactionUser}
107			procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
108
109			public
110	tony	45	{IBlobMetaData}
111			function GetSubType: integer;
112			function GetCharSetID: cardinal;
113			function GetCodePage: TSystemCodePage;
114			function GetSegmentSize: cardinal;
115	tony	56	function GetRelationName: AnsiString;
116			function GetColumnName: AnsiString;
117	tony	45	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	tony	56	var BlobType: TBlobType); overload;
126	tony	45	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	tony	56	function LoadFromFile(Filename: AnsiString): IBlob;
131	tony	45	function LoadFromStream(S: TStream) : IBlob;
132	tony	56	function SaveToFile(Filename: AnsiString): IBlob;
133	tony	45	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	tony	315	procedure TFBBlob.TransactionEnding(aTransaction: ITransaction; Force: boolean);
182	tony	45	begin
183	tony	315	if (aTransaction as TObject) <> (FTransaction as TObject) then
184	tony	45	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	tony	56	function TFBBlob.GetRelationName: AnsiString;
212	tony	45	begin
213			Result := FMetaData.GetRelationName;
214			end;
215
216	tony	56	function TFBBlob.GetColumnName: AnsiString;
217	tony	45	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	tony	56	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	tony	263	BlobInfo := TBlobInfo.Create(FAttachment.getFirebirdAPI as TFBClientAPI);
260	tony	56	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	tony	45	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	tony	56	function TFBBlob.LoadFromFile(Filename: AnsiString): IBlob;
296	tony	45	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	tony	56	function TFBBlob.SaveToFile(Filename: AnsiString): IBlob;
324	tony	45	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	tony	109	function TFBBlobMetaData.CanFetchMetaData: boolean;
409			begin
410			Result := (FRelationName <> '') and (FColumnName <> '');
411			end;
412
413	tony	45	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	tony	56	ColumnName: AnsiString);
424	tony	45	begin
425			inherited Create(Transaction);
426			// if (RelationName = '') or (ColumnName = '') then
427			// IBError(ibxeMissingColumnName,[]);
428			FRelationName := RelationName;
429			FColumnName := ColumnName;
430			FSegmentSize := 80;
431	tony	47	FUnconfirmedCharacterSet := true;
432			FCharSetID := 0;
433	tony	45	end;
434
435	tony	47	procedure TFBBlobMetaData.SetCharSetID(aValue: integer);
436			begin
437			FCharSetID := aValue;
438			FUnconfirmedCharacterSet := false;
439			end;
440
441	tony	45	function TFBBlobMetaData.GetSubType: integer;
442			begin
443			NeedSubType;
444			Result := FSubType;
445			end;
446
447			function TFBBlobMetaData.GetCharSetID: cardinal;
448			begin
449	tony	110	if FUnconfirmedCharacterSet and CanFetchMetaData then
450	tony	109	NeedFullMetadata;
451	tony	110	Result := FCharSetID;
452	tony	45	end;
453
454			function TFBBlobMetaData.GetCodePage: TSystemCodePage;
455			begin
456	tony	60	Attachment.CharSetID2CodePage(GetCharSetID,Result);
457	tony	45	end;
458
459			function TFBBlobMetaData.GetSegmentSize: cardinal;
460			begin
461			NeedFullMetadata;
462			Result := FSegmentSize;
463			end;
464
465	tony	56	function TFBBlobMetaData.GetRelationName: AnsiString;
466	tony	45	begin
467			Result := FRelationName;
468			end;
469
470	tony	56	function TFBBlobMetaData.GetColumnName: AnsiString;
471	tony	45	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