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;
    FFirebird30ClientAPI: TFB30ClientAPI;
  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 FFirebird30ClientAPI, 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 FFirebird30ClientAPI 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 FFirebird30ClientAPI 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);
    FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
    with FFirebird30ClientAPI 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);
  FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
  with FFirebird30ClientAPI 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);
  FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
  if (BlobID.gds_quad_high = 0) and (BlobID.gds_quad_low = 0) then
    Exit;

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