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, Math;

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;

  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;
      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: 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 := 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: PChar;
  localCount: uShort;
begin
  CheckWritable;
  Result := 0;
  if Count = 0 then Exit;

  LocalBuffer := PChar(@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:	47
Committed:	Mon Jan 9 15:31:51 2017 UTC (7 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	10956 byte(s)
Log Message:	Committing updates for Release R2-0-1
#	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.
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	tony	47	uses FBMessages, FB30Statement, FBParamBlock, Math;
92	tony	45
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			FSegmentSize := 80;
106			if (GetColumnName <> '') and (GetRelationName <> '') then
107			begin
108			stmt := TFB30Statement.Create(FAttachment,FTransaction, sLookupBlobMetaData ,FAttachment.SQLDialect);
109			with stmt do
110			begin
111			SQLParams[0].AsString := GetRelationName;
112			SQLParams[1].AsString := GetColumnName;
113			with OpenCursor do
114			if FetchNext then
115			begin
116			if Data[3].AsInteger <> blr_blob then
117			IBError(ibxeInvalidBlobMetaData,[nil]);
118			FSubType := Data[0].AsInteger;
119			FSegmentSize := Data[1].AsInteger;
120	tony	47	if FUnconfirmedCharacterSet then
121			FCharSetID := Data[2].AsInteger;
122	tony	45	end
123			else
124			IBError(ibxeInvalidBlobMetaData,[nil]);
125
126			end;
127	tony	47	end;
128	tony	45
129	tony	47	if FUnconfirmedCharacterSet and (FCharSetID > 1) and FAttachment.HasDefaultCharSet then
130	tony	45	begin
131			FCharSetID := FAttachment.CharSetID;
132			FUnconfirmedCharacterSet := false;
133			end;
134
135			FHasFullMetaData := true;
136			FHasSubType := true;
137			end;
138
139			constructor TFB30BlobMetaData.Create(Attachment: TFB30Attachment;
140			Transaction: TFB30Transaction; RelationName, ColumnName: string);
141			begin
142			inherited Create(Transaction,RelationName,ColumnName);
143			FAttachment := Attachment;
144			FTransaction := Transaction;
145			end;
146
147			constructor TFB30BlobMetaData.Create(Attachment: TFB30Attachment;
148			Transaction: TFB30Transaction; RelationName, ColumnName: string;
149			SubType: integer);
150			begin
151			Create(Attachment,Transaction,RelationName,ColumnName);
152			FSubType := SubType;
153			FHasSubType := true;
154			end;
155
156			{ TFB30Blob }
157
158			procedure TFB30Blob.CheckReadable;
159			begin
160			if FCreating or (FBlobIntf = nil) then
161			IBError(ibxeBlobCannotBeRead, [nil]);
162			end;
163
164			procedure TFB30Blob.CheckWritable;
165			begin
166			if not FCreating or (FBlobIntf = nil) then
167			IBError(ibxeBlobCannotBeWritten, [nil]);
168			end;
169
170			function TFB30Blob.GetIntf: IBlob;
171			begin
172			Result := self;
173			end;
174
175			procedure TFB30Blob.InternalClose(Force: boolean);
176			begin
177			if FBlobIntf = nil then
178			Exit;
179			with Firebird30ClientAPI do
180			begin
181			FBlobIntf.close(StatusIntf);
182			if not Force then Check4DataBaseError;
183			end;
184			FBlobIntf.release;
185			FBlobIntf := nil;
186			end;
187
188			procedure TFB30Blob.InternalCancel(Force: boolean);
189			begin
190			if FBlobIntf = nil then
191			Exit;
192			with Firebird30ClientAPI do
193			begin
194			FBlobIntf.cancel(StatusIntf);
195			if not Force then Check4DataBaseError;
196			end;
197			FBlobIntf.release;
198			FBlobIntf := nil;
199			end;
200
201			constructor TFB30Blob.Create(Attachment: TFB30Attachment; Transaction: TFB30Transaction;
202			MetaData: IBlobMetaData; BPB: IBPB);
203			begin
204			inherited Create(Attachment,Transaction,MetaData,BPB);
205			with Firebird30ClientAPI do
206			begin
207			if BPB = nil then
208			FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
209			@FBlobID,0,nil)
210			else
211			with BPB as TBPB do
212			FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
213			@FBlobID,getDataLength, BytePtr(getBuffer));
214			Check4DataBaseError;
215			end;
216			end;
217
218			constructor TFB30Blob.Create(Attachment: TFB30Attachment;
219			Transaction: TFB30Transaction; SubType: integer; CharSetID: cardinal;
220			BPB: IBPB);
221			var MetaData: TFB30BlobMetaData;
222			begin
223			MetaData := TFB30BlobMetaData.Create(Attachment,Transaction,'','',SubType);
224			MetaData.FCharSetID := CharSetID;
225			MetaData.FHasFullMetaData := true;
226			inherited Create(Attachment,Transaction,MetaData,BPB);
227			with Firebird30ClientAPI do
228			begin
229			if BPB = nil then
230			FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
231			@FBlobID,0,nil)
232			else
233			with BPB as TBPB do
234			FBlobIntf := Attachment.AttachmentIntf.createBlob(StatusIntf,Transaction.TransactionIntf,
235			@FBlobID,getDataLength, BytePtr(getBuffer));
236			Check4DataBaseError;
237			end;
238			end;
239
240			constructor TFB30Blob.Create(Attachment: TFB30Attachment;
241			Transaction: TFBTransaction; MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB);
242			begin
243			inherited Create(Attachment,Transaction,MetaData,BlobID,BPB);
244			if (BlobID.gds_quad_high = 0) and (BlobID.gds_quad_low = 0) then
245			Exit;
246
247			with Firebird30ClientAPI do
248			begin
249			if BPB = nil then
250			FBlobIntf := Attachment.AttachmentIntf.openBlob(StatusIntf,(Transaction as TFB30Transaction).TransactionIntf,
251			@FBlobID, 0, nil)
252			else
253			with BPB as TBPB do
254			FBlobIntf := Attachment.AttachmentIntf.openBlob(StatusIntf,(Transaction as TFB30Transaction).TransactionIntf,
255			@FBlobID, getDataLength, BytePtr(getBuffer));
256			Check4DataBaseError;
257			end;
258			end;
259
260			procedure TFB30Blob.GetInfo(var NumSegments: Int64; var MaxSegmentSize,
261			TotalSize: Int64; var BlobType: TBlobType);
262			var
263			items: array[0..3] of Char;
264			results: array[0..99] of Char;
265			i, item_length: Integer;
266			item: Integer;
267			begin
268			if FBlobIntf = nil then
269			IBError(ibxeBlobNotOpen,[nil]);
270
271			items[0] := Char(isc_info_blob_num_segments);
272			items[1] := Char(isc_info_blob_max_segment);
273			items[2] := Char(isc_info_blob_total_length);
274			items[3] := Char(isc_info_blob_type);
275
276			with Firebird30ClientAPI do
277			begin
278			FBlobIntf.getInfo(StatusIntf,4,@items[0],SizeOf(results),@results[0]);
279			Check4DataBaseError;
280			SignalActivity;
281			i := 0;
282			while (i < SizeOf(results)) and (results[i] <> Char(isc_info_end)) do
283			begin
284			item := Integer(results[i]); Inc(i);
285			item_length := DecodeInteger(@results[i], 2); Inc(i, 2);
286			case item of
287			isc_info_blob_num_segments:
288			NumSegments := DecodeInteger(@results[i], item_length);
289			isc_info_blob_max_segment:
290			MaxSegmentSize := DecodeInteger(@results[i], item_length);
291			isc_info_blob_total_length:
292			TotalSize := DecodeInteger(@results[i], item_length);
293			isc_info_blob_type:
294			if DecodeInteger(@results[i], item_length) = 0 then
295			BlobType := btSegmented
296			else
297			BlobType := btStream;
298			end;
299			Inc(i, item_length);
300			end;
301			end;
302			end;
303
304			function TFB30Blob.Read(var Buffer; Count: Longint): Longint;
305			var
306			BytesRead : cardinal;
307			LocalBuffer: PChar;
308			returnCode: integer;
309			localCount: uShort;
310			begin
311			CheckReadable;
312			Result := 0;
313			if FEOB then
314			Exit;
315
316			LocalBuffer := PChar(@Buffer);
317			repeat
318	tony	47	localCount := Min(Count,MaxuShort);
319	tony	45	with Firebird30ClientAPI do
320			returnCode := FBlobIntf.getSegment(StatusIntf,localCount, LocalBuffer, @BytesRead);
321			SignalActivity;
322			Inc(LocalBuffer,BytesRead);
323			Inc(Result,BytesRead);
324			Dec(Count,BytesRead);
325			until ((returncode <> Firebird.IStatus.Result_OK) and (returnCode <> Firebird.IStatus.Result_SEGMENT)) or (Count = 0);
326
327			FEOB := returnCode = Firebird.IStatus.RESULT_NO_DATA;
328			ClearStringCache;
329			if (returnCode <> Firebird.IStatus.Result_OK) and
330			(returnCode <> Firebird.IStatus.Result_SEGMENT) and
331			(returnCode <> Firebird.IStatus.RESULT_NO_DATA) then
332			Firebird30ClientAPI.IBDataBaseError
333			end;
334
335			function TFB30Blob.Write(const Buffer; Count: Longint): Longint;
336	tony	47	var
337			LocalBuffer: PChar;
338			localCount: uShort;
339	tony	45	begin
340			CheckWritable;
341			Result := 0;
342			if Count = 0 then Exit;
343
344	tony	47	LocalBuffer := PChar(@Buffer);
345			repeat
346			localCount := Min(Count,MaxuShort);
347			with Firebird30ClientAPI do
348			begin
349			FBlobIntf.putSegment(StatusIntf,localCount,LocalBuffer);
350			Check4DataBaseError;
351			end;
352			Inc(LocalBuffer,localCount);
353			Inc(Result,localCount);
354			Dec(Count,localCount);
355			until Count = 0;
356	tony	45	ClearStringCache;
357			SignalActivity;
358			end;
359
360			end.
361