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;
     FFirebird25ClientAPI: TFB25ClientAPI;
   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;
    FFirebird25ClientAPI: TFB25ClientAPI;
  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 FFirebird25ClientAPI 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;
  FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
  OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
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 FFirebird25ClientAPI, 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 FFirebird25ClientAPI do
    Call(isc_close_blob(StatusVector, @FHandle), not Force);
  FHandle := nil;
end;

procedure TFB25Blob.InternalCancel(Force: boolean);
begin
  if FHandle = nil then
    Exit;
  with FFirebird25ClientAPI 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;
  FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
  OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
  with FFirebird25ClientAPI 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;
  FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
  OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
  with FFirebird25ClientAPI 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;
  FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
  OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
  if (BlobID.gds_quad_high = 0) and (BlobID.gds_quad_low = 0) then
    Exit;

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