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 FPC}
{$mode objfpc}{$H+}
{$interfaces COM}
{$ENDIF}

interface

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

type

   { TFB25BlobMetaData }

   TFB25BlobMetaData  = class(TFBBlobMetaData, IBlobMetaData)
   private
     FHasFullMetaData: boolean;
     FAttachment: TFB25Attachment;
     FTransaction: TFB25Transaction;
   protected
     procedure NeedFullMetadata; override;
   public
     constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
       RelationName, ColumnName: string); overload;
     constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
       RelationName, ColumnName: string; 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 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
    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 IBErrorCodes, FBMessages, FBParamBlock;

{ TFB25BlobMetaData }

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

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

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

constructor TFB25BlobMetaData.Create(Attachment: TFB25Attachment;
  Transaction: TFB25Transaction; RelationName, ColumnName: string;
  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.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;

procedure TFB25Blob.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 FHandle = 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 Firebird25ClientAPI do
  begin
    Call(isc_blob_info(StatusVector, @FHandle, 4, @items[0], SizeOf(results),
                    @results[0]));
    i := 0;
    while (i < SizeOf(results)) and (results[i] <> Char(isc_info_end)) do
    begin
      item := Integer(results[i]); Inc(i);
      item_length := isc_portable_integer(@results[i], 2); Inc(i, 2);
      case item of
        isc_info_blob_num_segments:
          NumSegments := isc_portable_integer(@results[i], item_length);
        isc_info_blob_max_segment:
          MaxSegmentSize := isc_portable_integer(@results[i], item_length);
        isc_info_blob_total_length:
          TotalSize := isc_portable_integer(@results[i], item_length);
        isc_info_blob_type:
          if isc_portable_integer(@results[i], item_length) = 0 then
            BlobType := btSegmented
          else
            BlobType := btStream;
      end;
      Inc(i, item_length);
    end;
  end;
end;

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

  LocalBuffer := PChar(@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: PChar;
  localCount: uShort;
begin
  CheckWritable;
  LocalBuffer := PChar(@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:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	13066 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	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			{************************************************************************}
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
64			{$IFDEF FPC}
65			{$mode objfpc}{$H+}
66			{$interfaces COM}
67			{$ENDIF}
68
69			interface
70
71			uses
72			Classes, SysUtils, IB, IBHeader,IBExternals, FBClientAPI, FB25ClientAPI, FB25Attachment,
73			FB25Transaction, FBActivityMonitor, FBBlob;
74
75			type
76
77			{ TFB25BlobMetaData }
78
79			TFB25BlobMetaData = class(TFBBlobMetaData, IBlobMetaData)
80			private
81			FHasFullMetaData: boolean;
82			FAttachment: TFB25Attachment;
83			FTransaction: TFB25Transaction;
84			protected
85			procedure NeedFullMetadata; override;
86			public
87			constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
88			RelationName, ColumnName: string); overload;
89			constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
90			RelationName, ColumnName: string; SubType: integer); overload;
91			end;
92
93
94			{ TFB25Blob }
95
96			TFB25Blob = class(TFBBlob,IBlob)
97			private
98			FHandle: TISC_BLOB_HANDLE;
99			FEOB: boolean;
100			protected
101			procedure CheckReadable; override;
102			procedure CheckWritable; override;
103			function GetIntf: IBlob; override;
104			procedure InternalClose(Force: boolean); override;
105			procedure InternalCancel(Force: boolean); override;
106			public
107			constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
108			MetaData: IBlobMetaData; BPB: IBPB); overload;
109			constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
110			SubType: integer; CharSetID: cardinal; BPB: IBPB); overload;
111			constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
112			MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB); overload;
113			property Handle: TISC_BLOB_HANDLE read FHandle;
114
115			public
116			procedure GetInfo(var NumSegments: Int64; var MaxSegmentSize, TotalSize: Int64;
117			var BlobType: TBlobType); override;
118			function Read(var Buffer; Count: Longint): Longint; override;
119			function Write(const Buffer; Count: Longint): Longint; override;
120			end;
121
122			implementation
123
124			uses IBErrorCodes, FBMessages, FBParamBlock;
125
126			{ TFB25BlobMetaData }
127
128			procedure TFB25BlobMetaData.NeedFullMetadata;
129			var
130			BlobDesc: TISC_BLOB_DESC;
131			Global: array [0..31] of char;
132			begin
133			if FHasFullMetaData then Exit;
134
135			FCharSetID := 0;
136			FSegmentSize := 80;
137			FUnconfirmedCharacterSet := false;
138			if (GetColumnName <> '') and (GetRelationName <> '') then
139			begin
140			with Firebird25ClientAPI do
141			Call(isc_blob_lookup_desc(StatusVector,@(FAttachment.Handle),
142			@(FTransaction.Handle),
143			PChar(AnsiUpperCase(GetRelationName)),PChar(AnsiUpperCase(GetColumnName)),@BlobDesc,@Global));
144			FCharSetID := BlobDesc.blob_desc_charset;
145			FSubType := BlobDesc.blob_desc_subtype;
146			FSegmentSize := BlobDesc.blob_desc_segment_size ;
147			end
148			else
149			FUnconfirmedCharacterSet := true;
150
151			if (FCharSetID > 1) and FAttachment.HasDefaultCharSet then
152			begin
153			FCharSetID := FAttachment.CharSetID;
154			FUnconfirmedCharacterSet := false;
155			end;
156
157
158			FHasFullMetaData := true;
159			FHasSubType := true;
160			end;
161
162			constructor TFB25BlobMetaData.Create(Attachment: TFB25Attachment;
163			Transaction: TFB25Transaction; RelationName, ColumnName: string);
164			begin
165			inherited Create(Transaction,RelationName,ColumnName);
166			FAttachment := Attachment;
167			FTransaction := Transaction;
168			end;
169
170			constructor TFB25BlobMetaData.Create(Attachment: TFB25Attachment;
171			Transaction: TFB25Transaction; RelationName, ColumnName: string;
172			SubType: integer);
173			begin
174			Create(Attachment,Transaction,RelationName,ColumnName);
175			FSubType := SubType;
176			FHasSubType := true;
177			end;
178
179			{ TFB25Blob }
180
181			procedure TFB25Blob.CheckReadable;
182			begin
183			if FCreating or (FHandle = nil) then
184			IBError(ibxeBlobCannotBeRead, [nil]);
185			end;
186
187			procedure TFB25Blob.CheckWritable;
188			begin
189			if not FCreating or (FHandle = nil) then
190			IBError(ibxeBlobCannotBeWritten, [nil]);
191			end;
192
193			function TFB25Blob.GetIntf: IBlob;
194			begin
195			Result := self;
196			end;
197
198			procedure TFB25Blob.InternalClose(Force: boolean);
199			begin
200			if FHandle = nil then
201			Exit;
202			with Firebird25ClientAPI do
203			Call(isc_close_blob(StatusVector, @FHandle), not Force);
204			FHandle := nil;
205			end;
206
207			procedure TFB25Blob.InternalCancel(Force: boolean);
208			begin
209			if FHandle = nil then
210			Exit;
211			with Firebird25ClientAPI do
212			Call(isc_cancel_blob(StatusVector,@FHandle),not Force);
213			FHandle := nil;
214			end;
215
216			constructor TFB25Blob.Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
217			MetaData: IBlobMetaData; BPB: IBPB);
218			var DBHandle: TISC_DB_HANDLE;
219			TRHandle: TISC_TR_HANDLE;
220			begin
221			inherited Create(Attachment,Transaction,MetaData,BPB);
222			DBHandle := Attachment.Handle;
223			TRHandle := Transaction.Handle;
224			with Firebird25ClientAPI do
225			if BPB = nil then
226			Call(isc_create_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle, @FBlobID,
227			0, nil))
228			else
229			with BPB as TBPB do
230			Call(isc_create_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle, @FBlobID,
231			getDataLength, getBuffer));
232			end;
233
234			constructor TFB25Blob.Create(Attachment: TFB25Attachment;
235			Transaction: TFB25Transaction; SubType: integer; CharSetID: cardinal;
236			BPB: IBPB);
237			var DBHandle: TISC_DB_HANDLE;
238			TRHandle: TISC_TR_HANDLE;
239			MetaData: TFB25BlobMetaData;
240			begin
241			MetaData := TFB25BlobMetaData.Create(Attachment,Transaction,'','',SubType);
242			MetaData.FCharSetID := CharSetID;
243			MetaData.FHasFullMetaData := true;
244			inherited Create(Attachment,Transaction,MetaData,BPB);
245			DBHandle := Attachment.Handle;
246			TRHandle := Transaction.Handle;
247			with Firebird25ClientAPI do
248			if BPB = nil then
249			Call(isc_create_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle, @FBlobID,
250			0, nil))
251			else
252			with BPB as TBPB do
253			Call(isc_create_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle, @FBlobID,
254			getDataLength, getBuffer));
255			end;
256
257			constructor TFB25Blob.Create(Attachment: TFB25Attachment;
258			Transaction: TFB25Transaction; MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB);
259			var DBHandle: TISC_DB_HANDLE;
260			TRHandle: TISC_TR_HANDLE;
261			begin
262			inherited Create(Attachment,Transaction,MetaData,BlobID,BPB);
263			DBHandle := Attachment.Handle;
264			TRHandle := Transaction.Handle;
265			if (BlobID.gds_quad_high = 0) and (BlobID.gds_quad_low = 0) then
266			Exit;
267
268			with Firebird25ClientAPI do
269			if BPB = nil then
270			Call(isc_open_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle,
271			@FBlobID, 0, nil))
272			else
273			with BPB as TBPB do
274			Call(isc_open_blob2(StatusVector, @DBHandle, @TRHandle, @FHandle,
275			@FBlobID, getDataLength, getBuffer));
276			end;
277
278			procedure TFB25Blob.GetInfo(var NumSegments: Int64; var MaxSegmentSize,
279			TotalSize: Int64; var BlobType: TBlobType);
280			var
281			items: array[0..3] of Char;
282			results: array[0..99] of Char;
283			i, item_length: Integer;
284			item: Integer;
285			begin
286			if FHandle = nil then
287			IBError(ibxeBlobNotOpen,[nil]);
288
289			items[0] := Char(isc_info_blob_num_segments);
290			items[1] := Char(isc_info_blob_max_segment);
291			items[2] := Char(isc_info_blob_total_length);
292			items[3] := Char(isc_info_blob_type);
293
294			with Firebird25ClientAPI do
295			begin
296			Call(isc_blob_info(StatusVector, @FHandle, 4, @items[0], SizeOf(results),
297			@results[0]));
298			i := 0;
299			while (i < SizeOf(results)) and (results[i] <> Char(isc_info_end)) do
300			begin
301			item := Integer(results[i]); Inc(i);
302			item_length := isc_portable_integer(@results[i], 2); Inc(i, 2);
303			case item of
304			isc_info_blob_num_segments:
305			NumSegments := isc_portable_integer(@results[i], item_length);
306			isc_info_blob_max_segment:
307			MaxSegmentSize := isc_portable_integer(@results[i], item_length);
308			isc_info_blob_total_length:
309			TotalSize := isc_portable_integer(@results[i], item_length);
310			isc_info_blob_type:
311			if isc_portable_integer(@results[i], item_length) = 0 then
312			BlobType := btSegmented
313			else
314			BlobType := btStream;
315			end;
316			Inc(i, item_length);
317			end;
318			end;
319			end;
320
321			function TFB25Blob.Read(var Buffer; Count: Longint): Longint;
322			var
323			BytesRead : UShort;
324			LocalBuffer: PChar;
325			returnCode: long;
326			localCount: uShort;
327			begin
328			CheckReadable;
329			Result := 0;
330			if FEOB then
331			Exit;
332
333			LocalBuffer := PChar(@Buffer);
334			repeat
335			if Count > MaxuShort then
336			localCount := MaxuShort
337			else
338			localCount := Count;
339			with Firebird25ClientAPI do
340			returnCode := isc_get_segment(StatusVector, @FHandle, @BytesRead, localCount,
341			LocalBuffer);
342			Inc(LocalBuffer,BytesRead);
343			Inc(Result,BytesRead);
344			Dec(Count,BytesRead);
345			until ((returncode <> 0) and (returnCode <> isc_segment)) or (Count = 0);
346
347			FEOB := returnCode = isc_segstr_eof;
348			ClearStringCache;
349			if (returnCode <> 0) and (returnCode <> isc_segment) and (returnCode <> isc_segstr_eof) then
350			Firebird25ClientAPI.IBDataBaseError
351			end;
352
353			function TFB25Blob.Write(const Buffer; Count: Longint): Longint;
354			var
355			LocalBuffer: PChar;
356			localCount: uShort;
357			begin
358			CheckWritable;
359			LocalBuffer := PChar(@Buffer);
360			Result := 0;
361			if Count = 0 then Exit;
362
363			repeat
364			if Count > MaxuShort then
365			localCount := MaxuShort
366			else
367			localCount := Count;
368			with Firebird25ClientAPI do
369			Call(isc_put_segment(StatusVector,@FHandle,localCount,LocalBuffer));
370			Dec(Count,localCount);
371			Inc(LocalBuffer,localCount);
372			Inc(Result,localCount);
373			until Count = 0;
374			ClearStringCache;
375			end;
376
377
378			end.
379