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 MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

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

interface

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

type

   { TFB30BlobMetaData }

   TFB30BlobMetaData  = class(TFBBlobMetaData, IBlobMetaData)
   private
     FHasFullMetaData: boolean;
     FAttachment: TFB30Attachment;
     FTransaction: TFB30Transaction;
   protected
     function Attachment: IAttachment; override;
     procedure NeedFullMetadata; override;
   public
     constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
       RelationName, ColumnName: AnsiString); overload;
     constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
       RelationName, ColumnName: AnsiString; 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 GetInfo(Request: array of byte; Response: IBlobInfo); 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
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

implementation

uses FBMessages, FB30Statement, FBParamBlock, Math;

const
  sLookupBlobMetaData = 'Select F.RDB$FIELD_SUB_TYPE, F.RDB$SEGMENT_LENGTH, F.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(?)) ' +
  'UNION '+
  'Select F.RDB$FIELD_SUB_TYPE, F.RDB$SEGMENT_LENGTH, F.RDB$CHARACTER_SET_ID, F.RDB$FIELD_TYPE '+
  'From RDB$FIELDS F JOIN RDB$PROCEDURE_PARAMETERS P On P.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+
    'Where Trim(P.RDB$PROCEDURE_NAME) = Upper(Trim(?)) and Trim(P.RDB$PARAMETER_NAME) = Upper(Trim(?)) ';

{ TFB30BlobMetaData }

function TFB30BlobMetaData.Attachment: IAttachment;
begin
  Result := FAttachment;
end;

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

  FSegmentSize := 80;
  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;
      SQLParams[2].AsString := GetRelationName;
      SQLParams[3].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;
        if FUnconfirmedCharacterSet then
          FCharSetID := Data[2].AsInteger;
      end
      else
        IBError(ibxeInvalidBlobMetaData,[nil]);

    end;
  end;

    if FUnconfirmedCharacterSet and (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: AnsiString);
begin
  inherited Create(Transaction,RelationName,ColumnName);
  FAttachment := Attachment;
  FTransaction := Transaction;
end;

constructor TFB30BlobMetaData.Create(Attachment: TFB30Attachment;
  Transaction: TFB30Transaction; RelationName, ColumnName: AnsiString;
  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.GetInfo(Request: array of byte; Response: IBlobInfo);
begin
  if FBlobIntf = nil then
    IBError(ibxeBlobNotOpen,[nil]);

  with Firebird30ClientAPI, Response as TBlobInfo do
  begin
    FBlobIntf.getInfo(StatusIntf,Length(Request),BytePtr(@Request),
                                               GetBufSize, BytePtr(Buffer));
    Check4DataBaseError;
    SignalActivity;
  end;
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;

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

  LocalBuffer := PAnsiChar(@Buffer);
  repeat
    localCount := Min(Count,MaxuShort);
    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;
var
  LocalBuffer: PAnsiChar;
  localCount: uShort;
begin
  CheckWritable;
  Result := 0;
  if Count = 0 then Exit;

  LocalBuffer := PAnsiChar(@Buffer);
  repeat
    localCount := Min(Count,MaxuShort);
    with Firebird30ClientAPI do
    begin
      FBlobIntf.putSegment(StatusIntf,localCount,LocalBuffer);
      Check4DataBaseError;
    end;
    Inc(LocalBuffer,localCount);
    Inc(Result,localCount);
    Dec(Count,localCount);
  until Count = 0;
  ClearStringCache;
  SignalActivity;
end;

end.

Revision:	109
Committed:	Thu Jan 18 14:37:48 2018 UTC (6 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	10552 byte(s)
Log Message:	Fixes Merged
#	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	{$IFDEF MSWINDOWS}
29	{$DEFINE WINDOWS}
30	{$ENDIF}
31
32	{$IFDEF FPC}
33	{$mode delphi}
34	{$interfaces COM}
35	{$ENDIF}
36
37	interface
38
39	uses
40	Classes, SysUtils, Firebird, IB, IBHeader, IBExternals, FBClientAPI, FB30ClientAPI, FB30Attachment,
41	FBTransaction, FB30Transaction, FBBlob, FBOutputBlock;
42
43	type
44
45	{ TFB30BlobMetaData }
46
47	TFB30BlobMetaData = class(TFBBlobMetaData, IBlobMetaData)
48	private
49	FHasFullMetaData: boolean;
50	FAttachment: TFB30Attachment;
51	FTransaction: TFB30Transaction;
52	protected
53	function Attachment: IAttachment; override;
54	procedure NeedFullMetadata; override;
55	public
56	constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
57	RelationName, ColumnName: AnsiString); overload;
58	constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
59	RelationName, ColumnName: AnsiString; SubType: integer); overload;
60
61	end;
62
63
64	{ TFB30Blob }
65
66	TFB30Blob = class(TFBBlob,IBlob)
67	private
68	FBlobIntf: Firebird.IBlob;
69	FEOB: boolean;
70	protected
71	procedure CheckReadable; override;
72	procedure CheckWritable; override;
73	function GetIntf: IBlob; override;
74	procedure GetInfo(Request: array of byte; Response: IBlobInfo); override;
75	procedure InternalClose(Force: boolean); override;
76	procedure InternalCancel(Force: boolean); override;
77	public
78	constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
79	MetaData: IBlobMetaData; BPB: IBPB); overload;
80	constructor Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
81	SubType: integer; CharSetID: cardinal; BPB: IBPB); overload;
82	constructor Create(Attachment: TFB30Attachment; Transaction: TFBTransaction;
83	MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB); overload;
84	property BlobIntf: Firebird.IBlob read FBlobIntf;
85
86	{IBlob}
87	public
88	function Read(var Buffer; Count: Longint): Longint; override;
89	function Write(const Buffer; Count: Longint): Longint; override;
90	end;
91
92	implementation
93
94	uses FBMessages, FB30Statement, FBParamBlock, Math;
95
96	const
97	sLookupBlobMetaData = 'Select F.RDB$FIELD_SUB_TYPE, F.RDB$SEGMENT_LENGTH, F.RDB$CHARACTER_SET_ID, F.RDB$FIELD_TYPE '+
98	'From RDB$FIELDS F JOIN RDB$RELATION_FIELDS R On R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+
99	'Where Trim(R.RDB$RELATION_NAME) = Upper(Trim(?)) and Trim(R.RDB$FIELD_NAME) = Upper(Trim(?)) ' +
100	'UNION '+
101	'Select F.RDB$FIELD_SUB_TYPE, F.RDB$SEGMENT_LENGTH, F.RDB$CHARACTER_SET_ID, F.RDB$FIELD_TYPE '+
102	'From RDB$FIELDS F JOIN RDB$PROCEDURE_PARAMETERS P On P.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+
103	'Where Trim(P.RDB$PROCEDURE_NAME) = Upper(Trim(?)) and Trim(P.RDB$PARAMETER_NAME) = Upper(Trim(?)) ';
104
105	{ TFB30BlobMetaData }
106
107	function TFB30BlobMetaData.Attachment: IAttachment;
108	begin
109	Result := FAttachment;
110	end;
111
112	procedure TFB30BlobMetaData.NeedFullMetadata;
113	var stmt: IStatement;
114	begin
115	if FHasFullMetaData then Exit;
116
117	FSegmentSize := 80;
118	if (GetColumnName <> '') and (GetRelationName <> '') then
119	begin
120	stmt := TFB30Statement.Create(FAttachment,FTransaction, sLookupBlobMetaData ,FAttachment.SQLDialect);
121	with stmt do
122	begin
123	SQLParams[0].AsString := GetRelationName;
124	SQLParams[1].AsString := GetColumnName;
125	SQLParams[2].AsString := GetRelationName;
126	SQLParams[3].AsString := GetColumnName;
127	with OpenCursor do
128	if FetchNext then
129	begin
130	if Data[3].AsInteger <> blr_blob then
131	IBError(ibxeInvalidBlobMetaData,[nil]);
132	FSubType := Data[0].AsInteger;
133	FSegmentSize := Data[1].AsInteger;
134	if FUnconfirmedCharacterSet then
135	FCharSetID := Data[2].AsInteger;
136	end
137	else
138	IBError(ibxeInvalidBlobMetaData,[nil]);
139
140	end;
141	end;
142
143	if FUnconfirmedCharacterSet and (FCharSetID > 1) and FAttachment.HasDefaultCharSet then
144	begin
145	FCharSetID := FAttachment.CharSetID;
146	FUnconfirmedCharacterSet := false;
147	end;
148
149	FHasFullMetaData := true;
150	FHasSubType := true;
151	end;
152
153	constructor TFB30BlobMetaData.Create(Attachment: TFB30Attachment;
154	Transaction: TFB30Transaction; RelationName, ColumnName: AnsiString);
155	begin
156	inherited Create(Transaction,RelationName,ColumnName);
157	FAttachment := Attachment;
158	FTransaction := Transaction;
159	end;
160
161	constructor TFB30BlobMetaData.Create(Attachment: TFB30Attachment;
162	Transaction: TFB30Transaction; RelationName, ColumnName: AnsiString;
163	SubType: integer);
164	begin
165	Create(Attachment,Transaction,RelationName,ColumnName);
166	FSubType := SubType;
167	FHasSubType := true;
168	end;
169
170	{ TFB30Blob }
171
172	procedure TFB30Blob.CheckReadable;
173	begin
174	if FCreating or (FBlobIntf = nil) then
175	IBError(ibxeBlobCannotBeRead, [nil]);
176	end;
177
178	procedure TFB30Blob.CheckWritable;
179	begin
180	if not FCreating or (FBlobIntf = nil) then
181	IBError(ibxeBlobCannotBeWritten, [nil]);
182	end;
183
184	function TFB30Blob.GetIntf: IBlob;
185	begin
186	Result := self;
187	end;
188
189	procedure TFB30Blob.GetInfo(Request: array of byte; Response: IBlobInfo);
190	begin
191	if FBlobIntf = nil then
192	IBError(ibxeBlobNotOpen,[nil]);
193
194	with Firebird30ClientAPI, Response as TBlobInfo do
195	begin
196	FBlobIntf.getInfo(StatusIntf,Length(Request),BytePtr(@Request),
197	GetBufSize, BytePtr(Buffer));
198	Check4DataBaseError;
199	SignalActivity;
200	end;
201	end;
202
203	procedure TFB30Blob.InternalClose(Force: boolean);
204	begin
205	if FBlobIntf = nil then
206	Exit;
207	with Firebird30ClientAPI do
208	begin
209	FBlobIntf.close(StatusIntf);
210	if not Force then Check4DataBaseError;
211	end;
212	FBlobIntf.release;
213	FBlobIntf := nil;
214	end;
215
216	procedure TFB30Blob.InternalCancel(Force: boolean);
217	begin
218	if FBlobIntf = nil then
219	Exit;
220	with Firebird30ClientAPI do
221	begin
222	FBlobIntf.cancel(StatusIntf);
223	if not Force then Check4DataBaseError;
224	end;
225	FBlobIntf.release;
226	FBlobIntf := nil;
227	end;
228
229	constructor TFB30Blob.Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
230	MetaData: IBlobMetaData; BPB: IBPB);
231	begin
232	inherited Create(Attachment,Transaction,MetaData,BPB);
233	with Firebird30ClientAPI do
234	begin
235	if BPB = nil then
236	FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
237	@FBlobID,0,nil)
238	else
239	with BPB as TBPB do
240	FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
241	@FBlobID,getDataLength, BytePtr(getBuffer));
242	Check4DataBaseError;
243	end;
244	end;
245
246	constructor TFB30Blob.Create(Attachment: TFB30Attachment;
247	Transaction: TFB30Transaction; SubType: integer; CharSetID: cardinal;
248	BPB: IBPB);
249	var MetaData: TFB30BlobMetaData;
250	begin
251	MetaData := TFB30BlobMetaData.Create(Attachment,Transaction,'','',SubType);
252	MetaData.FCharSetID := CharSetID;
253	MetaData.FHasFullMetaData := true;
254	inherited Create(Attachment,Transaction,MetaData,BPB);
255	with Firebird30ClientAPI do
256	begin
257	if BPB = nil then
258	FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
259	@FBlobID,0,nil)
260	else
261	with BPB as TBPB do
262	FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
263	@FBlobID,getDataLength, BytePtr(getBuffer));
264	Check4DataBaseError;
265	end;
266	end;
267
268	constructor TFB30Blob.Create(Attachment: TFB30Attachment;
269	Transaction: TFBTransaction; MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB);
270	begin
271	inherited Create(Attachment,Transaction,MetaData,BlobID,BPB);
272	if (BlobID.gds_quad_high = 0) and (BlobID.gds_quad_low = 0) then
273	Exit;
274
275	with Firebird30ClientAPI do
276	begin
277	if BPB = nil then
278	FBlobIntf := Attachment.AttachmentIntf.openBlob(StatusIntf,(Transaction as TFB30Transaction).TransactionIntf,
279	@FBlobID, 0, nil)
280	else
281	with BPB as TBPB do
282	FBlobIntf := Attachment.AttachmentIntf.openBlob(StatusIntf,(Transaction as TFB30Transaction).TransactionIntf,
283	@FBlobID, getDataLength, BytePtr(getBuffer));
284	Check4DataBaseError;
285	end;
286	end;
287
288	function TFB30Blob.Read(var Buffer; Count: Longint): Longint;
289	var
290	BytesRead : cardinal;
291	LocalBuffer: PAnsiChar;
292	returnCode: integer;
293	localCount: uShort;
294	begin
295	CheckReadable;
296	Result := 0;
297	if FEOB then
298	Exit;
299
300	LocalBuffer := PAnsiChar(@Buffer);
301	repeat
302	localCount := Min(Count,MaxuShort);
303	with Firebird30ClientAPI do
304	returnCode := FBlobIntf.getSegment(StatusIntf,localCount, LocalBuffer, @BytesRead);
305	SignalActivity;
306	Inc(LocalBuffer,BytesRead);
307	Inc(Result,BytesRead);
308	Dec(Count,BytesRead);
309	until ((returncode <> Firebird.IStatus.Result_OK) and (returnCode <> Firebird.IStatus.Result_SEGMENT)) or (Count = 0);
310
311	FEOB := returnCode = Firebird.IStatus.RESULT_NO_DATA;
312	ClearStringCache;
313	if (returnCode <> Firebird.IStatus.Result_OK) and
314	(returnCode <> Firebird.IStatus.Result_SEGMENT) and
315	(returnCode <> Firebird.IStatus.RESULT_NO_DATA) then
316	Firebird30ClientAPI.IBDataBaseError
317	end;
318
319	function TFB30Blob.Write(const Buffer; Count: Longint): Longint;
320	var
321	LocalBuffer: PAnsiChar;
322	localCount: uShort;
323	begin
324	CheckWritable;
325	Result := 0;
326	if Count = 0 then Exit;
327
328	LocalBuffer := PAnsiChar(@Buffer);
329	repeat
330	localCount := Min(Count,MaxuShort);
331	with Firebird30ClientAPI do
332	begin
333	FBlobIntf.putSegment(StatusIntf,localCount,LocalBuffer);
334	Check4DataBaseError;
335	end;
336	Inc(LocalBuffer,localCount);
337	Inc(Result,localCount);
338	Dec(Count,localCount);
339	until Count = 0;
340	ClearStringCache;
341	SignalActivity;
342	end;
343
344	end.
345