client/2.5/FB25Blob.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): ______________________________________.
 *
*)
{************************************************************************}
{                                                                        }
{       Borland Delphi Visual Component Library                          }
{       InterBase Express core components                                }
{                                                                        }
{       Copyright (c) 1998-2000 Inprise Corporation                      }
{                                                                        }
{    InterBase Express is based in part on the product                   }
{    Free IB Components, written by Gregory H. Deatz for                 }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
{    Free IB Components is used under license.                           }
{                                                                        }
{    The contents of this file are subject to the InterBase              }
{    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 at http://www.Inprise.com/IPL.html }
{    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 Original Code was created by InterBase Software Corporation     }
{       and its successors.                                              }
{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
{       Corporation. All Rights Reserved.                                }
{    Contributor(s): Jeff Overcash                                       }
{                                                                        }
{    IBX For Lazarus (Firebird Express)                                  }
{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
{    Portions created by MWA Software are copyright McCallum Whyman      }
{    Associates Ltd 2011 - 2015                                                }
{                                                                        }
{************************************************************************}
unit FB25Blob;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

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

interface

uses
  Classes, SysUtils, IB,  IBHeader,IBExternals, FBClientAPI, FB25ClientAPI, FB25Attachment,
  FB25Transaction, FBActivityMonitor, FBBlob, FBOutputBlock;

type

   { TFB25BlobMetaData }

   TFB25BlobMetaData  = class(TFBBlobMetaData, IBlobMetaData)
   private
     FHasFullMetaData: boolean;
     FAttachment: TFB25Attachment;
     FTransaction: TFB25Transaction;
   protected
     function Attachment: IAttachment; override;
     procedure NeedFullMetadata; override;
   public
     constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
       RelationName, ColumnName: AnsiString); overload;
     constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
       RelationName, ColumnName: AnsiString; SubType: integer); overload;
  end;


  { TFB25Blob }

  TFB25Blob = class(TFBBlob,IBlob)
  private
    FHandle: TISC_BLOB_HANDLE;
    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: TFB25Attachment; Transaction: TFB25Transaction;
                       MetaData: IBlobMetaData; BPB: IBPB); overload;
    constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
                       SubType: integer; CharSetID: cardinal; BPB: IBPB); overload;
    constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
                       MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB); overload;
    property Handle: TISC_BLOB_HANDLE read FHandle;

  public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

implementation

uses IBErrorCodes, FBMessages, FBParamBlock;

{ TFB25BlobMetaData }

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

procedure TFB25BlobMetaData.NeedFullMetadata;
var
  BlobDesc: TISC_BLOB_DESC;
  Global: array [0..31] of char;
  RelName: AnsiString;
  ColName: AnsiString;
begin
  if FHasFullMetaData then Exit;

  FSegmentSize := 80;
  RelName := AnsiUpperCase(GetRelationName);
  ColName := AnsiUpperCase(GetColumnName);
  if (ColName <> '') and (RelName <> '') then
  begin
    with Firebird25ClientAPI do
      Call(isc_blob_lookup_desc(StatusVector,@(FAttachment.Handle),
                                            @(FTransaction.Handle),
                PAnsiChar(RelName),PAnsiChar(ColName),@BlobDesc,@Global));
    if FUnconfirmedCharacterSet then
      FCharSetID := BlobDesc.blob_desc_charset;
    FSubType := BlobDesc.blob_desc_subtype;
    FSegmentSize := BlobDesc.blob_desc_segment_size ;
  end;

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


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

constructor TFB25BlobMetaData.Create(Attachment: TFB25Attachment;
  Transaction: TFB25Transaction; RelationName, ColumnName: AnsiString);
begin
  inherited Create(Transaction,RelationName,ColumnName);
  FAttachment := Attachment;
  FTransaction := Transaction;
end;

constructor TFB25BlobMetaData.Create(Attachment: TFB25Attachment;
  Transaction: TFB25Transaction; RelationName, ColumnName: AnsiString;
  SubType: integer);
begin
  Create(Attachment,Transaction,RelationName,ColumnName);
  FSubType := SubType;
  FHasSubType := true;
end;

{ TFB25Blob }

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

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

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

procedure TFB25Blob.GetInfo(Request: array of byte; Response: IBlobInfo);
begin
  if FHandle = nil then
    IBError(ibxeBlobNotOpen,[nil]);

  with Firebird25ClientAPI, Response as TBlobInfo do
    Call(isc_blob_info(StatusVector, @FHandle, Length(Request),@Request,
                                               GetBufSize, Buffer));
end;

procedure TFB25Blob.InternalClose(Force: boolean);
begin
  if FHandle = nil then
    Exit;
  with Firebird25ClientAPI do
    Call(isc_close_blob(StatusVector, @FHandle), not Force);
  FHandle := nil;
end;

procedure TFB25Blob.InternalCancel(Force: boolean);
begin
  if FHandle = nil then
    Exit;
  with Firebird25ClientAPI do
    Call(isc_cancel_blob(StatusVector,@FHandle),not Force);
  FHandle := nil;
end;

constructor TFB25Blob.Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
  MetaData: IBlobMetaData; BPB: IBPB);
var DBHandle: TISC_DB_HANDLE;
    TRHandle: TISC_TR_HANDLE;
begin
  inherited Create(Attachment,Transaction,MetaData,BPB);
  DBHandle := Attachment.Handle;
  TRHandle := Transaction.Handle;
  with Firebird25ClientAPI do
  if BPB = nil then
    Call(isc_create_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle, @FBlobID,
                           0, nil))
  else
  with BPB as TBPB do
    Call(isc_create_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle, @FBlobID,
                         getDataLength, getBuffer));
end;

constructor TFB25Blob.Create(Attachment: TFB25Attachment;
  Transaction: TFB25Transaction; SubType: integer; CharSetID: cardinal;
  BPB: IBPB);
var DBHandle: TISC_DB_HANDLE;
    TRHandle: TISC_TR_HANDLE;
    MetaData: TFB25BlobMetaData;
begin
  MetaData := TFB25BlobMetaData.Create(Attachment,Transaction,'','',SubType);
  MetaData.FCharSetID := CharSetID;
  MetaData.FHasFullMetaData := true;
  inherited Create(Attachment,Transaction,MetaData,BPB);
  DBHandle := Attachment.Handle;
  TRHandle := Transaction.Handle;
  with Firebird25ClientAPI do
  if BPB = nil then
    Call(isc_create_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle, @FBlobID,
                           0, nil))
  else
  with BPB as TBPB do
    Call(isc_create_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle, @FBlobID,
                         getDataLength, getBuffer));
end;

constructor TFB25Blob.Create(Attachment: TFB25Attachment;
  Transaction: TFB25Transaction; MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB);
var DBHandle: TISC_DB_HANDLE;
    TRHandle: TISC_TR_HANDLE;
begin
  inherited Create(Attachment,Transaction,MetaData,BlobID,BPB);
  DBHandle := Attachment.Handle;
  TRHandle := Transaction.Handle;
  if (BlobID.gds_quad_high = 0) and (BlobID.gds_quad_low = 0) then
    Exit;

  with Firebird25ClientAPI do
  if BPB = nil then
    Call(isc_open_blob2(StatusVector,  @DBHandle, @TRHandle, @FHandle,
                     @FBlobID, 0, nil))
  else
  with BPB as TBPB do
    Call(isc_open_blob2(StatusVector,  @DBHandle, @TRHandle, @FHandle,
                   @FBlobID, getDataLength, getBuffer));
end;

function TFB25Blob.Read(var Buffer; Count: Longint): Longint;
var
  BytesRead : UShort;
  LocalBuffer: PByte;
  returnCode: long;
  localCount: uShort;
begin
  CheckReadable;
  Result := 0;
  if FEOB then
    Exit;

  LocalBuffer := PByte(@Buffer);
  repeat
    if Count > MaxuShort then
      localCount := MaxuShort
    else
      localCount := Count;
    with Firebird25ClientAPI do
      returnCode := isc_get_segment(StatusVector, @FHandle, @BytesRead, localCount,
                           LocalBuffer);
    Inc(LocalBuffer,BytesRead);
    Inc(Result,BytesRead);
    Dec(Count,BytesRead);
  until ((returncode <> 0) and (returnCode <> isc_segment)) or (Count = 0);

  FEOB := returnCode = isc_segstr_eof;
  ClearStringCache;
  if (returnCode <> 0) and (returnCode <> isc_segment) and (returnCode <> isc_segstr_eof) then
    Firebird25ClientAPI.IBDataBaseError
end;

function TFB25Blob.Write(const Buffer; Count: Longint): Longint;
var
  LocalBuffer: PByte;
  localCount: uShort;
begin
  CheckWritable;
  LocalBuffer := PByte(@Buffer);
  Result := 0;
  if Count = 0 then Exit;

  repeat
    if Count > MaxuShort then
      localCount := MaxuShort
    else
      localCount := Count;
    with Firebird25ClientAPI do
      Call(isc_put_segment(StatusVector,@FHandle,localCount,LocalBuffer));
    Dec(Count,localCount);
    Inc(LocalBuffer,localCount);
    Inc(Result,localCount);
  until Count = 0;
  ClearStringCache;
end;


end.

Revision:	60
Committed:	Mon Mar 27 15:21:02 2017 UTC (7 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	12196 byte(s)
Log Message:
#	Content
1	(*
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	{************************************************************************}
31	{ }
32	{ Borland Delphi Visual Component Library }
33	{ InterBase Express core components }
34	{ }
35	{ Copyright (c) 1998-2000 Inprise Corporation }
36	{ }
37	{ InterBase Express is based in part on the product }
38	{ Free IB Components, written by Gregory H. Deatz for }
39	{ Hoagland, Longo, Moran, Dunst & Doukas Company. }
40	{ Free IB Components is used under license. }
41	{ }
42	{ The contents of this file are subject to the InterBase }
43	{ Public License Version 1.0 (the "License"); you may not }
44	{ use this file except in compliance with the License. You }
45	{ may obtain a copy of the License at http://www.Inprise.com/IPL.html }
46	{ Software distributed under the License is distributed on }
47	{ an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
48	{ express or implied. See the License for the specific language }
49	{ governing rights and limitations under the License. }
50	{ The Original Code was created by InterBase Software Corporation }
51	{ and its successors. }
52	{ Portions created by Inprise Corporation are Copyright (C) Inprise }
53	{ Corporation. All Rights Reserved. }
54	{ Contributor(s): Jeff Overcash }
55	{ }
56	{ IBX For Lazarus (Firebird Express) }
57	{ Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
58	{ Portions created by MWA Software are copyright McCallum Whyman }
59	{ Associates Ltd 2011 - 2015 }
60	{ }
61	{************************************************************************}
62	unit FB25Blob;
63	{$IFDEF MSWINDOWS}
64	{$DEFINE WINDOWS}
65	{$ENDIF}
66
67	{$IFDEF FPC}
68	{$mode delphi}
69	{$interfaces COM}
70	{$ENDIF}
71
72	interface
73
74	uses
75	Classes, SysUtils, IB, IBHeader,IBExternals, FBClientAPI, FB25ClientAPI, FB25Attachment,
76	FB25Transaction, FBActivityMonitor, FBBlob, FBOutputBlock;
77
78	type
79
80	{ TFB25BlobMetaData }
81
82	TFB25BlobMetaData = class(TFBBlobMetaData, IBlobMetaData)
83	private
84	FHasFullMetaData: boolean;
85	FAttachment: TFB25Attachment;
86	FTransaction: TFB25Transaction;
87	protected
88	function Attachment: IAttachment; override;
89	procedure NeedFullMetadata; override;
90	public
91	constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
92	RelationName, ColumnName: AnsiString); overload;
93	constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
94	RelationName, ColumnName: AnsiString; SubType: integer); overload;
95	end;
96
97
98	{ TFB25Blob }
99
100	TFB25Blob = class(TFBBlob,IBlob)
101	private
102	FHandle: TISC_BLOB_HANDLE;
103	FEOB: boolean;
104	protected
105	procedure CheckReadable; override;
106	procedure CheckWritable; override;
107	function GetIntf: IBlob; override;
108	procedure GetInfo(Request: array of byte; Response: IBlobInfo); override;
109	procedure InternalClose(Force: boolean); override;
110	procedure InternalCancel(Force: boolean); override;
111	public
112	constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
113	MetaData: IBlobMetaData; BPB: IBPB); overload;
114	constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
115	SubType: integer; CharSetID: cardinal; BPB: IBPB); overload;
116	constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
117	MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB); overload;
118	property Handle: TISC_BLOB_HANDLE read FHandle;
119
120	public
121	function Read(var Buffer; Count: Longint): Longint; override;
122	function Write(const Buffer; Count: Longint): Longint; override;
123	end;
124
125	implementation
126
127	uses IBErrorCodes, FBMessages, FBParamBlock;
128
129	{ TFB25BlobMetaData }
130
131	function TFB25BlobMetaData.Attachment: IAttachment;
132	begin
133	Result := FAttachment;
134	end;
135
136	procedure TFB25BlobMetaData.NeedFullMetadata;
137	var
138	BlobDesc: TISC_BLOB_DESC;
139	Global: array [0..31] of char;
140	RelName: AnsiString;
141	ColName: AnsiString;
142	begin
143	if FHasFullMetaData then Exit;
144
145	FSegmentSize := 80;
146	RelName := AnsiUpperCase(GetRelationName);
147	ColName := AnsiUpperCase(GetColumnName);
148	if (ColName <> '') and (RelName <> '') then
149	begin
150	with Firebird25ClientAPI do
151	Call(isc_blob_lookup_desc(StatusVector,@(FAttachment.Handle),
152	@(FTransaction.Handle),
153	PAnsiChar(RelName),PAnsiChar(ColName),@BlobDesc,@Global));
154	if FUnconfirmedCharacterSet then
155	FCharSetID := BlobDesc.blob_desc_charset;
156	FSubType := BlobDesc.blob_desc_subtype;
157	FSegmentSize := BlobDesc.blob_desc_segment_size ;
158	end;
159
160	if FUnconfirmedCharacterSet and (FCharSetID > 1) and FAttachment.HasDefaultCharSet then
161	begin
162	FCharSetID := FAttachment.CharSetID;
163	FUnconfirmedCharacterSet := false;
164	end;
165
166
167	FHasFullMetaData := true;
168	FHasSubType := true;
169	end;
170
171	constructor TFB25BlobMetaData.Create(Attachment: TFB25Attachment;
172	Transaction: TFB25Transaction; RelationName, ColumnName: AnsiString);
173	begin
174	inherited Create(Transaction,RelationName,ColumnName);
175	FAttachment := Attachment;
176	FTransaction := Transaction;
177	end;
178
179	constructor TFB25BlobMetaData.Create(Attachment: TFB25Attachment;
180	Transaction: TFB25Transaction; RelationName, ColumnName: AnsiString;
181	SubType: integer);
182	begin
183	Create(Attachment,Transaction,RelationName,ColumnName);
184	FSubType := SubType;
185	FHasSubType := true;
186	end;
187
188	{ TFB25Blob }
189
190	procedure TFB25Blob.CheckReadable;
191	begin
192	if FCreating or (FHandle = nil) then
193	IBError(ibxeBlobCannotBeRead, [nil]);
194	end;
195
196	procedure TFB25Blob.CheckWritable;
197	begin
198	if not FCreating or (FHandle = nil) then
199	IBError(ibxeBlobCannotBeWritten, [nil]);
200	end;
201
202	function TFB25Blob.GetIntf: IBlob;
203	begin
204	Result := self;
205	end;
206
207	procedure TFB25Blob.GetInfo(Request: array of byte; Response: IBlobInfo);
208	begin
209	if FHandle = nil then
210	IBError(ibxeBlobNotOpen,[nil]);
211
212	with Firebird25ClientAPI, Response as TBlobInfo do
213	Call(isc_blob_info(StatusVector, @FHandle, Length(Request),@Request,
214	GetBufSize, Buffer));
215	end;
216
217	procedure TFB25Blob.InternalClose(Force: boolean);
218	begin
219	if FHandle = nil then
220	Exit;
221	with Firebird25ClientAPI do
222	Call(isc_close_blob(StatusVector, @FHandle), not Force);
223	FHandle := nil;
224	end;
225
226	procedure TFB25Blob.InternalCancel(Force: boolean);
227	begin
228	if FHandle = nil then
229	Exit;
230	with Firebird25ClientAPI do
231	Call(isc_cancel_blob(StatusVector,@FHandle),not Force);
232	FHandle := nil;
233	end;
234
235	constructor TFB25Blob.Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
236	MetaData: IBlobMetaData; BPB: IBPB);
237	var DBHandle: TISC_DB_HANDLE;
238	TRHandle: TISC_TR_HANDLE;
239	begin
240	inherited Create(Attachment,Transaction,MetaData,BPB);
241	DBHandle := Attachment.Handle;
242	TRHandle := Transaction.Handle;
243	with Firebird25ClientAPI do
244	if BPB = nil then
245	Call(isc_create_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle, @FBlobID,
246	0, nil))
247	else
248	with BPB as TBPB do
249	Call(isc_create_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle, @FBlobID,
250	getDataLength, getBuffer));
251	end;
252
253	constructor TFB25Blob.Create(Attachment: TFB25Attachment;
254	Transaction: TFB25Transaction; SubType: integer; CharSetID: cardinal;
255	BPB: IBPB);
256	var DBHandle: TISC_DB_HANDLE;
257	TRHandle: TISC_TR_HANDLE;
258	MetaData: TFB25BlobMetaData;
259	begin
260	MetaData := TFB25BlobMetaData.Create(Attachment,Transaction,'','',SubType);
261	MetaData.FCharSetID := CharSetID;
262	MetaData.FHasFullMetaData := true;
263	inherited Create(Attachment,Transaction,MetaData,BPB);
264	DBHandle := Attachment.Handle;
265	TRHandle := Transaction.Handle;
266	with Firebird25ClientAPI do
267	if BPB = nil then
268	Call(isc_create_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle, @FBlobID,
269	0, nil))
270	else
271	with BPB as TBPB do
272	Call(isc_create_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle, @FBlobID,
273	getDataLength, getBuffer));
274	end;
275
276	constructor TFB25Blob.Create(Attachment: TFB25Attachment;
277	Transaction: TFB25Transaction; MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB);
278	var DBHandle: TISC_DB_HANDLE;
279	TRHandle: TISC_TR_HANDLE;
280	begin
281	inherited Create(Attachment,Transaction,MetaData,BlobID,BPB);
282	DBHandle := Attachment.Handle;
283	TRHandle := Transaction.Handle;
284	if (BlobID.gds_quad_high = 0) and (BlobID.gds_quad_low = 0) then
285	Exit;
286
287	with Firebird25ClientAPI do
288	if BPB = nil then
289	Call(isc_open_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle,
290	@FBlobID, 0, nil))
291	else
292	with BPB as TBPB do
293	Call(isc_open_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle,
294	@FBlobID, getDataLength, getBuffer));
295	end;
296
297	function TFB25Blob.Read(var Buffer; Count: Longint): Longint;
298	var
299	BytesRead : UShort;
300	LocalBuffer: PByte;
301	returnCode: long;
302	localCount: uShort;
303	begin
304	CheckReadable;
305	Result := 0;
306	if FEOB then
307	Exit;
308
309	LocalBuffer := PByte(@Buffer);
310	repeat
311	if Count > MaxuShort then
312	localCount := MaxuShort
313	else
314	localCount := Count;
315	with Firebird25ClientAPI do
316	returnCode := isc_get_segment(StatusVector, @FHandle, @BytesRead, localCount,
317	LocalBuffer);
318	Inc(LocalBuffer,BytesRead);
319	Inc(Result,BytesRead);
320	Dec(Count,BytesRead);
321	until ((returncode <> 0) and (returnCode <> isc_segment)) or (Count = 0);
322
323	FEOB := returnCode = isc_segstr_eof;
324	ClearStringCache;
325	if (returnCode <> 0) and (returnCode <> isc_segment) and (returnCode <> isc_segstr_eof) then
326	Firebird25ClientAPI.IBDataBaseError
327	end;
328
329	function TFB25Blob.Write(const Buffer; Count: Longint): Longint;
330	var
331	LocalBuffer: PByte;
332	localCount: uShort;
333	begin
334	CheckWritable;
335	LocalBuffer := PByte(@Buffer);
336	Result := 0;
337	if Count = 0 then Exit;
338
339	repeat
340	if Count > MaxuShort then
341	localCount := MaxuShort
342	else
343	localCount := Count;
344	with Firebird25ClientAPI do
345	Call(isc_put_segment(StatusVector,@FHandle,localCount,LocalBuffer));
346	Dec(Count,localCount);
347	Inc(LocalBuffer,localCount);
348	Inc(Result,localCount);
349	until Count = 0;
350	ClearStringCache;
351	end;
352
353
354	end.
355