client/3.0/FB30Blob.pas

(*
 *  Firebird Interface (fbintf). The fbintf components provide a set of
 *  Pascal language bindings for the Firebird API.
 *
 *  The 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 FB30Blob;

{$IFDEF FPC}
{$mode objfpc}{$H+}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils, Firebird, IB, IBHeader, IBExternals, FBClientAPI, FB30ClientAPI, FB30Attachment,
  FBTransaction, FB30Transaction,  FBBlob;

type

   { TFB30BlobMetaData }

   TFB30BlobMetaData  = class(TFBBlobMetaData, IBlobMetaData)
   private
     FHasFullMetaData: boolean;
     FAttachment: TFB30Attachment;
     FTransaction: TFB30Transaction;
   protected
     procedure NeedFullMetadata; override;
   public
     constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
       RelationName, ColumnName: string); overload;
     constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
       RelationName, ColumnName: string; SubType: integer); overload;

  end;


  { TFB30Blob }

  TFB30Blob = class(TFBBlob,IBlob)
  private
    FBlobIntf: Firebird.IBlob;
    FEOB: boolean;
  protected
    procedure CheckReadable; override;
    procedure CheckWritable; override;
    function GetIntf: IBlob; override;
    procedure InternalClose(Force: boolean); override;
    procedure InternalCancel(Force: boolean); override;
  public
    constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
                       MetaData: IBlobMetaData; BPB: IBPB); overload;
    constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
                       SubType: integer; CharSetID: cardinal; BPB: IBPB); overload;
    constructor Create(Attachment: TFB30Attachment; Transaction: TFBTransaction;
                       MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB); overload;
    property BlobIntf: Firebird.IBlob read FBlobIntf;

  {IBlob}
  public
    procedure GetInfo(var NumSegments: Int64; var MaxSegmentSize, TotalSize: Int64;
      var BlobType: TBlobType); override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

implementation

uses FBMessages, FB30Statement, FBParamBlock;

const
  sLookupBlobMetaData = 'Select F.RDB$FIELD_SUB_TYPE, F.RDB$SEGMENT_LENGTH, RDB$CHARACTER_SET_ID, F.RDB$FIELD_TYPE '+
    'From RDB$FIELDS F JOIN RDB$RELATION_FIELDS R On R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+
  'Where Trim(R.RDB$RELATION_NAME) = Upper(Trim(?)) and Trim(R.RDB$FIELD_NAME) = Upper(Trim(?))';

{ TFB30BlobMetaData }

procedure TFB30BlobMetaData.NeedFullMetadata;
var stmt: IStatement;
begin
  if FHasFullMetaData then Exit;

  FCharSetID := 0;
  FSegmentSize := 80;
  FUnconfirmedCharacterSet := false;
  if (GetColumnName <> '') and (GetRelationName <> '') then
  begin
    stmt := TFB30Statement.Create(FAttachment,FTransaction, sLookupBlobMetaData ,FAttachment.SQLDialect);
    with stmt do
    begin
      SQLParams[0].AsString := GetRelationName;
      SQLParams[1].AsString := GetColumnName;
      with OpenCursor do
      if FetchNext then
      begin
        if Data[3].AsInteger <> blr_blob then
          IBError(ibxeInvalidBlobMetaData,[nil]);
        FSubType := Data[0].AsInteger;
        FSegmentSize := Data[1].AsInteger;
        FCharSetID := Data[2].AsInteger;
      end
      else
        IBError(ibxeInvalidBlobMetaData,[nil]);

    end;
  end
  else
    FUnconfirmedCharacterSet := true;

    if (FCharSetID > 1) and FAttachment.HasDefaultCharSet then
    begin
      FCharSetID := FAttachment.CharSetID;
      FUnconfirmedCharacterSet := false;
    end;

  FHasFullMetaData := true;
  FHasSubType := true;
end;

constructor TFB30BlobMetaData.Create(Attachment: TFB30Attachment;
  Transaction: TFB30Transaction; RelationName, ColumnName: string);
begin
  inherited Create(Transaction,RelationName,ColumnName);
  FAttachment := Attachment;
  FTransaction := Transaction;
end;

constructor TFB30BlobMetaData.Create(Attachment: TFB30Attachment;
  Transaction: TFB30Transaction; RelationName, ColumnName: string;
  SubType: integer);
begin
  Create(Attachment,Transaction,RelationName,ColumnName);
  FSubType := SubType;
  FHasSubType := true;
end;

{ TFB30Blob }

procedure TFB30Blob.CheckReadable;
begin
  if FCreating or (FBlobIntf = nil) then
    IBError(ibxeBlobCannotBeRead, [nil]);
end;

procedure TFB30Blob.CheckWritable;
begin
  if not FCreating or (FBlobIntf = nil) then
    IBError(ibxeBlobCannotBeWritten, [nil]);
end;

function TFB30Blob.GetIntf: IBlob;
begin
  Result := self;
end;

procedure TFB30Blob.InternalClose(Force: boolean);
begin
  if FBlobIntf = nil then
    Exit;
  with Firebird30ClientAPI do
  begin
    FBlobIntf.close(StatusIntf);
    if not Force then Check4DataBaseError;
  end;
  FBlobIntf.release;
  FBlobIntf := nil;
end;

procedure TFB30Blob.InternalCancel(Force: boolean);
begin
  if FBlobIntf = nil then
    Exit;
  with Firebird30ClientAPI do
  begin
    FBlobIntf.cancel(StatusIntf);
    if not Force then Check4DataBaseError;
  end;
  FBlobIntf.release;
  FBlobIntf := nil;
end;

constructor TFB30Blob.Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
  MetaData: IBlobMetaData; BPB: IBPB);
begin
    inherited Create(Attachment,Transaction,MetaData,BPB);
    with Firebird30ClientAPI do
    begin
      if BPB = nil then
        FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
                        @FBlobID,0,nil)
      else
      with BPB as TBPB do
        FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
                      @FBlobID,getDataLength, BytePtr(getBuffer));
      Check4DataBaseError;
    end;
end;

constructor TFB30Blob.Create(Attachment: TFB30Attachment;
  Transaction: TFB30Transaction; SubType: integer; CharSetID: cardinal;
  BPB: IBPB);
var MetaData: TFB30BlobMetaData;
begin
  MetaData := TFB30BlobMetaData.Create(Attachment,Transaction,'','',SubType);
  MetaData.FCharSetID := CharSetID;
  MetaData.FHasFullMetaData := true;
  inherited Create(Attachment,Transaction,MetaData,BPB);
  with Firebird30ClientAPI do
  begin
    if BPB = nil then
      FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
                      @FBlobID,0,nil)
    else
    with BPB as TBPB do
      FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
                    @FBlobID,getDataLength, BytePtr(getBuffer));
    Check4DataBaseError;
  end;
end;

constructor TFB30Blob.Create(Attachment: TFB30Attachment;
  Transaction: TFBTransaction; MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB);
begin
  inherited Create(Attachment,Transaction,MetaData,BlobID,BPB);
  if (BlobID.gds_quad_high = 0) and (BlobID.gds_quad_low = 0) then
    Exit;

  with Firebird30ClientAPI do
  begin
    if BPB = nil then
      FBlobIntf := Attachment.AttachmentIntf.openBlob(StatusIntf,(Transaction as TFB30Transaction).TransactionIntf,
                     @FBlobID, 0, nil)
    else
    with BPB as TBPB do
    FBlobIntf := Attachment.AttachmentIntf.openBlob(StatusIntf,(Transaction as TFB30Transaction).TransactionIntf,
                   @FBlobID, getDataLength, BytePtr(getBuffer));
    Check4DataBaseError;
  end;
end;

procedure TFB30Blob.GetInfo(var NumSegments: Int64; var MaxSegmentSize,
  TotalSize: Int64; var BlobType: TBlobType);
var
  items: array[0..3] of Char;
  results: array[0..99] of Char;
  i, item_length: Integer;
  item: Integer;
begin
  if FBlobIntf = nil then
    IBError(ibxeBlobNotOpen,[nil]);

  items[0] := Char(isc_info_blob_num_segments);
  items[1] := Char(isc_info_blob_max_segment);
  items[2] := Char(isc_info_blob_total_length);
  items[3] := Char(isc_info_blob_type);

  with Firebird30ClientAPI do
  begin
    FBlobIntf.getInfo(StatusIntf,4,@items[0],SizeOf(results),@results[0]);
    Check4DataBaseError;
    SignalActivity;
    i := 0;
    while (i < SizeOf(results)) and (results[i] <> Char(isc_info_end)) do
    begin
      item := Integer(results[i]); Inc(i);
      item_length := DecodeInteger(@results[i], 2); Inc(i, 2);
      case item of
        isc_info_blob_num_segments:
          NumSegments := DecodeInteger(@results[i], item_length);
        isc_info_blob_max_segment:
          MaxSegmentSize := DecodeInteger(@results[i], item_length);
        isc_info_blob_total_length:
          TotalSize := DecodeInteger(@results[i], item_length);
        isc_info_blob_type:
          if DecodeInteger(@results[i], item_length) = 0 then
            BlobType := btSegmented
          else
            BlobType := btStream;
      end;
      Inc(i, item_length);
    end;
  end;
end;

function TFB30Blob.Read(var Buffer; Count: Longint): Longint;
var
  BytesRead : cardinal;
  LocalBuffer: PChar;
  returnCode: integer;
  localCount: uShort;
begin
  CheckReadable;
  Result := 0;
  if FEOB then
    Exit;

  LocalBuffer := PChar(@Buffer);
  repeat
    localCount := Count;
    with Firebird30ClientAPI do
      returnCode := FBlobIntf.getSegment(StatusIntf,localCount, LocalBuffer, @BytesRead);
    SignalActivity;
    Inc(LocalBuffer,BytesRead);
    Inc(Result,BytesRead);
    Dec(Count,BytesRead);
  until ((returncode <> Firebird.IStatus.Result_OK) and (returnCode <> Firebird.IStatus.Result_SEGMENT)) or (Count = 0);

  FEOB := returnCode = Firebird.IStatus.RESULT_NO_DATA;
  ClearStringCache;
  if (returnCode <> Firebird.IStatus.Result_OK) and
     (returnCode <> Firebird.IStatus.Result_SEGMENT) and
     (returnCode <> Firebird.IStatus.RESULT_NO_DATA) then
    Firebird30ClientAPI.IBDataBaseError
end;

function TFB30Blob.Write(const Buffer; Count: Longint): Longint;
begin
  CheckWritable;
  Result := 0;
  if Count = 0 then Exit;

  with Firebird30ClientAPI do
  begin
    FBlobIntf.putSegment(StatusIntf,Count,@Buffer);
    Check4DataBaseError;
  end;
  ClearStringCache;
  SignalActivity;
  Result := Count;
end;

end.

Revision:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	10726 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	Content
1	(*
2	* Firebird Interface (fbintf). The fbintf components provide a set of
3	* Pascal language bindings for the Firebird API.
4	*
5	* The contents of this file are subject to the Initial Developer's
6	* Public License Version 1.0 (the "License"); you may not use this
7	* file except in compliance with the License. You may obtain a copy
8	* of the License here:
9	*
10	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11	*
12	* Software distributed under the License is distributed on an "AS
13	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14	* implied. See the License for the specific language governing rights
15	* and limitations under the License.
16	*
17	* The Initial Developer of the Original Code is Tony Whyman.
18	*
19	* The Original Code is (C) 2016 Tony Whyman, MWA Software
20	* (http://www.mwasoftware.co.uk).
21	*
22	* All Rights Reserved.
23	*
24	* Contributor(s): ______________________________________.
25	*
26	*)
27	unit FB30Blob;
28
29	{$IFDEF FPC}
30	{$mode objfpc}{$H+}
31	{$interfaces COM}
32	{$ENDIF}
33
34	interface
35
36	uses
37	Classes, SysUtils, Firebird, IB, IBHeader, IBExternals, FBClientAPI, FB30ClientAPI, FB30Attachment,
38	FBTransaction, FB30Transaction, FBBlob;
39
40	type
41
42	{ TFB30BlobMetaData }
43
44	TFB30BlobMetaData = class(TFBBlobMetaData, IBlobMetaData)
45	private
46	FHasFullMetaData: boolean;
47	FAttachment: TFB30Attachment;
48	FTransaction: TFB30Transaction;
49	protected
50	procedure NeedFullMetadata; override;
51	public
52	constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
53	RelationName, ColumnName: string); overload;
54	constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
55	RelationName, ColumnName: string; SubType: integer); overload;
56
57	end;
58
59
60	{ TFB30Blob }
61
62	TFB30Blob = class(TFBBlob,IBlob)
63	private
64	FBlobIntf: Firebird.IBlob;
65	FEOB: boolean;
66	protected
67	procedure CheckReadable; override;
68	procedure CheckWritable; override;
69	function GetIntf: IBlob; override;
70	procedure InternalClose(Force: boolean); override;
71	procedure InternalCancel(Force: boolean); override;
72	public
73	constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
74	MetaData: IBlobMetaData; BPB: IBPB); overload;
75	constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
76	SubType: integer; CharSetID: cardinal; BPB: IBPB); overload;
77	constructor Create(Attachment: TFB30Attachment; Transaction: TFBTransaction;
78	MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB); overload;
79	property BlobIntf: Firebird.IBlob read FBlobIntf;
80
81	{IBlob}
82	public
83	procedure GetInfo(var NumSegments: Int64; var MaxSegmentSize, TotalSize: Int64;
84	var BlobType: TBlobType); override;
85	function Read(var Buffer; Count: Longint): Longint; override;
86	function Write(const Buffer; Count: Longint): Longint; override;
87	end;
88
89	implementation
90
91	uses FBMessages, FB30Statement, FBParamBlock;
92
93	const
94	sLookupBlobMetaData = 'Select F.RDB$FIELD_SUB_TYPE, F.RDB$SEGMENT_LENGTH, RDB$CHARACTER_SET_ID, F.RDB$FIELD_TYPE '+
95	'From RDB$FIELDS F JOIN RDB$RELATION_FIELDS R On R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+
96	'Where Trim(R.RDB$RELATION_NAME) = Upper(Trim(?)) and Trim(R.RDB$FIELD_NAME) = Upper(Trim(?))';
97
98	{ TFB30BlobMetaData }
99
100	procedure TFB30BlobMetaData.NeedFullMetadata;
101	var stmt: IStatement;
102	begin
103	if FHasFullMetaData then Exit;
104
105	FCharSetID := 0;
106	FSegmentSize := 80;
107	FUnconfirmedCharacterSet := false;
108	if (GetColumnName <> '') and (GetRelationName <> '') then
109	begin
110	stmt := TFB30Statement.Create(FAttachment,FTransaction, sLookupBlobMetaData ,FAttachment.SQLDialect);
111	with stmt do
112	begin
113	SQLParams[0].AsString := GetRelationName;
114	SQLParams[1].AsString := GetColumnName;
115	with OpenCursor do
116	if FetchNext then
117	begin
118	if Data[3].AsInteger <> blr_blob then
119	IBError(ibxeInvalidBlobMetaData,[nil]);
120	FSubType := Data[0].AsInteger;
121	FSegmentSize := Data[1].AsInteger;
122	FCharSetID := Data[2].AsInteger;
123	end
124	else
125	IBError(ibxeInvalidBlobMetaData,[nil]);
126
127	end;
128	end
129	else
130	FUnconfirmedCharacterSet := true;
131
132	if (FCharSetID > 1) and FAttachment.HasDefaultCharSet then
133	begin
134	FCharSetID := FAttachment.CharSetID;
135	FUnconfirmedCharacterSet := false;
136	end;
137
138	FHasFullMetaData := true;
139	FHasSubType := true;
140	end;
141
142	constructor TFB30BlobMetaData.Create(Attachment: TFB30Attachment;
143	Transaction: TFB30Transaction; RelationName, ColumnName: string);
144	begin
145	inherited Create(Transaction,RelationName,ColumnName);
146	FAttachment := Attachment;
147	FTransaction := Transaction;
148	end;
149
150	constructor TFB30BlobMetaData.Create(Attachment: TFB30Attachment;
151	Transaction: TFB30Transaction; RelationName, ColumnName: string;
152	SubType: integer);
153	begin
154	Create(Attachment,Transaction,RelationName,ColumnName);
155	FSubType := SubType;
156	FHasSubType := true;
157	end;
158
159	{ TFB30Blob }
160
161	procedure TFB30Blob.CheckReadable;
162	begin
163	if FCreating or (FBlobIntf = nil) then
164	IBError(ibxeBlobCannotBeRead, [nil]);
165	end;
166
167	procedure TFB30Blob.CheckWritable;
168	begin
169	if not FCreating or (FBlobIntf = nil) then
170	IBError(ibxeBlobCannotBeWritten, [nil]);
171	end;
172
173	function TFB30Blob.GetIntf: IBlob;
174	begin
175	Result := self;
176	end;
177
178	procedure TFB30Blob.InternalClose(Force: boolean);
179	begin
180	if FBlobIntf = nil then
181	Exit;
182	with Firebird30ClientAPI do
183	begin
184	FBlobIntf.close(StatusIntf);
185	if not Force then Check4DataBaseError;
186	end;
187	FBlobIntf.release;
188	FBlobIntf := nil;
189	end;
190
191	procedure TFB30Blob.InternalCancel(Force: boolean);
192	begin
193	if FBlobIntf = nil then
194	Exit;
195	with Firebird30ClientAPI do
196	begin
197	FBlobIntf.cancel(StatusIntf);
198	if not Force then Check4DataBaseError;
199	end;
200	FBlobIntf.release;
201	FBlobIntf := nil;
202	end;
203
204	constructor TFB30Blob.Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
205	MetaData: IBlobMetaData; BPB: IBPB);
206	begin
207	inherited Create(Attachment,Transaction,MetaData,BPB);
208	with Firebird30ClientAPI do
209	begin
210	if BPB = nil then
211	FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
212	@FBlobID,0,nil)
213	else
214	with BPB as TBPB do
215	FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
216	@FBlobID,getDataLength, BytePtr(getBuffer));
217	Check4DataBaseError;
218	end;
219	end;
220
221	constructor TFB30Blob.Create(Attachment: TFB30Attachment;
222	Transaction: TFB30Transaction; SubType: integer; CharSetID: cardinal;
223	BPB: IBPB);
224	var MetaData: TFB30BlobMetaData;
225	begin
226	MetaData := TFB30BlobMetaData.Create(Attachment,Transaction,'','',SubType);
227	MetaData.FCharSetID := CharSetID;
228	MetaData.FHasFullMetaData := true;
229	inherited Create(Attachment,Transaction,MetaData,BPB);
230	with Firebird30ClientAPI do
231	begin
232	if BPB = nil then
233	FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
234	@FBlobID,0,nil)
235	else
236	with BPB as TBPB do
237	FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
238	@FBlobID,getDataLength, BytePtr(getBuffer));
239	Check4DataBaseError;
240	end;
241	end;
242
243	constructor TFB30Blob.Create(Attachment: TFB30Attachment;
244	Transaction: TFBTransaction; MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB);
245	begin
246	inherited Create(Attachment,Transaction,MetaData,BlobID,BPB);
247	if (BlobID.gds_quad_high = 0) and (BlobID.gds_quad_low = 0) then
248	Exit;
249
250	with Firebird30ClientAPI do
251	begin
252	if BPB = nil then
253	FBlobIntf := Attachment.AttachmentIntf.openBlob(StatusIntf,(Transaction as TFB30Transaction).TransactionIntf,
254	@FBlobID, 0, nil)
255	else
256	with BPB as TBPB do
257	FBlobIntf := Attachment.AttachmentIntf.openBlob(StatusIntf,(Transaction as TFB30Transaction).TransactionIntf,
258	@FBlobID, getDataLength, BytePtr(getBuffer));
259	Check4DataBaseError;
260	end;
261	end;
262
263	procedure TFB30Blob.GetInfo(var NumSegments: Int64; var MaxSegmentSize,
264	TotalSize: Int64; var BlobType: TBlobType);
265	var
266	items: array[0..3] of Char;
267	results: array[0..99] of Char;
268	i, item_length: Integer;
269	item: Integer;
270	begin
271	if FBlobIntf = nil then
272	IBError(ibxeBlobNotOpen,[nil]);
273
274	items[0] := Char(isc_info_blob_num_segments);
275	items[1] := Char(isc_info_blob_max_segment);
276	items[2] := Char(isc_info_blob_total_length);
277	items[3] := Char(isc_info_blob_type);
278
279	with Firebird30ClientAPI do
280	begin
281	FBlobIntf.getInfo(StatusIntf,4,@items[0],SizeOf(results),@results[0]);
282	Check4DataBaseError;
283	SignalActivity;
284	i := 0;
285	while (i < SizeOf(results)) and (results[i] <> Char(isc_info_end)) do
286	begin
287	item := Integer(results[i]); Inc(i);
288	item_length := DecodeInteger(@results[i], 2); Inc(i, 2);
289	case item of
290	isc_info_blob_num_segments:
291	NumSegments := DecodeInteger(@results[i], item_length);
292	isc_info_blob_max_segment:
293	MaxSegmentSize := DecodeInteger(@results[i], item_length);
294	isc_info_blob_total_length:
295	TotalSize := DecodeInteger(@results[i], item_length);
296	isc_info_blob_type:
297	if DecodeInteger(@results[i], item_length) = 0 then
298	BlobType := btSegmented
299	else
300	BlobType := btStream;
301	end;
302	Inc(i, item_length);
303	end;
304	end;
305	end;
306
307	function TFB30Blob.Read(var Buffer; Count: Longint): Longint;
308	var
309	BytesRead : cardinal;
310	LocalBuffer: PChar;
311	returnCode: integer;
312	localCount: uShort;
313	begin
314	CheckReadable;
315	Result := 0;
316	if FEOB then
317	Exit;
318
319	LocalBuffer := PChar(@Buffer);
320	repeat
321	localCount := Count;
322	with Firebird30ClientAPI do
323	returnCode := FBlobIntf.getSegment(StatusIntf,localCount, LocalBuffer, @BytesRead);
324	SignalActivity;
325	Inc(LocalBuffer,BytesRead);
326	Inc(Result,BytesRead);
327	Dec(Count,BytesRead);
328	until ((returncode <> Firebird.IStatus.Result_OK) and (returnCode <> Firebird.IStatus.Result_SEGMENT)) or (Count = 0);
329
330	FEOB := returnCode = Firebird.IStatus.RESULT_NO_DATA;
331	ClearStringCache;
332	if (returnCode <> Firebird.IStatus.Result_OK) and
333	(returnCode <> Firebird.IStatus.Result_SEGMENT) and
334	(returnCode <> Firebird.IStatus.RESULT_NO_DATA) then
335	Firebird30ClientAPI.IBDataBaseError
336	end;
337
338	function TFB30Blob.Write(const Buffer; Count: Longint): Longint;
339	begin
340	CheckWritable;
341	Result := 0;
342	if Count = 0 then Exit;
343
344	with Firebird30ClientAPI do
345	begin
346	FBlobIntf.putSegment(StatusIntf,Count,@Buffer);
347	Check4DataBaseError;
348	end;
349	ClearStringCache;
350	SignalActivity;
351	Result := Count;
352	end;
353
354	end.
355