trunk/runtime/IBBlob.pas

{************************************************************************}
{                                                                        }
{       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                                                 }
{************************************************************************}

unit IBBlob;

{$mode Delphi}

interface

uses
  SysUtils, Classes, DB, IB, IBDatabase;


const
  DefaultBlobSegmentSize = 16 * 1024;

type
  TIBBlobStates = (bsUninitialised, bsDataPending, bsData, bsModified);

  { TIBBlobStream }
  TIBBlobStream = class(TStream)
  private
    FBase: TIBBase;
    FBlob: IBlob;
    FBlobMaxSegmentSize: Int64;
    FBlobNumSegments: Int64;
    FBlobSize: Int64;
    FBlobType: TBlobType;
    FBuffer: PChar;
    FColumnName: string;
    FMode: TBlobStreamMode;
    FPosition: Int64;
    FBlobState: TIBBlobStates;
    FRelationName: string;
    function GetBlobID: TISC_QUAD;
    function GetModified: Boolean;
    procedure CheckActive;
  protected
    procedure CloseBlob;
    procedure EnsureBlobInitialized;
    procedure EnsureLoaded;
    procedure GetBlobInfo;
    function  GetSize: Int64; override;
    function GetDatabase: TIBDatabase;
    function GetTransaction: TIBTransaction;
    procedure OpenBlob;
    procedure SetBlobID(Value: TISC_QUAD);
    procedure SetDatabase(Value: TIBDatabase);
    procedure SetMode(Value: TBlobStreamMode);
    procedure SetState(aValue: TIBBlobStates);
    procedure SetTransaction(Value: TIBTransaction);
  public
    constructor Create;
    destructor Destroy; override;
    procedure CheckReadable;
    procedure CheckWritable;
    procedure Finalize;
    procedure LoadFromFile(Filename: string);
    procedure LoadFromStream(Stream: TStream);
    function Read(var Buffer; Count: Longint): Longint; override;
    procedure SaveToFile(Filename: string);
    procedure SaveToStream(Stream: TStream);
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
    procedure SetField(aField: TField);
    procedure SetSize(const NewSize: Int64); override;
    procedure SetSize(NewSize: Longint); override;
    procedure Truncate;
    function Write(const Buffer; Count: Longint): Longint; override;
    property BlobID: TISC_QUAD read GetBlobID write SetBlobID;
    property Blob: IBlob read FBlob;
    property BlobMaxSegmentSize: Int64 read FBlobMaxSegmentSize;
    property BlobNumSegments: Int64 read FBlobNumSegments;
    property BlobSize: Int64 read GetSize;
    property BlobType: TBlobType read FBlobType;
    property Database: TIBDatabase read GetDatabase write SetDatabase;
    property Mode: TBlobStreamMode read FMode write SetMode;
    property Modified: Boolean read GetModified;
    property Transaction: TIBTransaction read GetTransaction write SetTransaction;
    property RelationName: string read FRelationName;
    property ColumnName: string read FColumnName;
  end;

implementation

uses FBMessages, IBCustomDataSet;

{ TIBBlobStream }
constructor TIBBlobStream.Create;
begin
  inherited Create;
  FBase := TIBBase.Create(Self);
  FBuffer := nil;
  FBlobSize := 0;
  FBlobState := bsUninitialised;
  FBlob := nil;
end;

destructor TIBBlobStream.Destroy;
begin
  CloseBlob;
  FBase.Free;
  SetSize(0);
  inherited Destroy;
end;

procedure TIBBlobStream.CheckReadable;
begin
  if FMode = bmWrite then IBError(ibxeBlobCannotBeRead, [nil]);
end;

procedure TIBBlobStream.CheckWritable;
begin
  if FMode = bmRead then IBError(ibxeBlobCannotBeWritten, [nil]);
end;

function TIBBlobStream.GetModified: Boolean;
begin
  Result := FBlobState = bsModified;
end;

procedure TIBBlobStream.CheckActive;
begin
  if Database = nil then
    IBError(ibxeDatabaseNotAssigned,[nil]);

  if (Database.Attachment = nil) or
                     not Database.Attachment.IsConnected then
    IBError(ibxeDatabaseClosed,[nil]);

  if Transaction = nil then
    IBError(ibxeTransactionNotAssigned,[nil]);

  if (Transaction.TransactionIntf = nil) or
      not Transaction.TransactionIntf.InTransaction then
    IBError(ibxeNotInTransaction,[nil]);
end;

function TIBBlobStream.GetBlobID: TISC_QUAD;
begin
  if (FBlob = nil) or (FBlobSize = 0) then
  begin
    Result.gds_quad_high := 0;
    Result.gds_quad_low := 0;
  end
  else
    Result := FBlob.GetBlobID;
end;

procedure TIBBlobStream.CloseBlob;
begin
  Finalize;
  FBlob := nil;
  SetState(bsUninitialised);
end;

procedure TIBBlobStream.EnsureBlobInitialized;
begin
  if FBlobState <> bsUninitialised then Exit;

  if FMode = bmWrite then
    SetState(bsData)
  else
  begin
    CheckReadable;
    if FBlob = nil then Exit;
    try
      GetBlobInfo;
      {Defer reading in blob until read method called}
    except
      FBlob := nil;
      raise;
    end;
    SetState(bsDataPending);
  end;
end;

procedure TIBBlobStream.EnsureLoaded;
begin
  EnsureBlobInitialized;
  if (FBlobState = bsDataPending) and (FBlob <> nil) then
  begin
    SetSize(FBlobSize);
    FBlob.Read(FBuffer^, FBlobSize);
    SetState(bsData);
  end;
end;

procedure TIBBlobStream.Finalize;
begin
  if FBlobState <> bsModified then
    exit;
  CheckWritable;
  if FBlobSize > 0 then
  begin
    { need to start writing to a blob, create one }
    FBlob := Database.Attachment.CreateBlob(Transaction.TransactionIntf,RelationName,ColumnName);
    FBlob.Write(FBuffer^, FBlobSize);
    FBlob.Close;
  end;
  SetState(bsData);
end;

procedure TIBBlobStream.GetBlobInfo;
var
  iBlobSize: Int64;
begin
  if FBlob = nil then Exit;

  FBlob.GetInfo(FBlobNumSegments, FBlobMaxSegmentSize, iBlobSize, FBlobType);
  SetSize(iBlobSize);
end;

function TIBBlobStream.GetSize: Int64;
begin
  EnsureBlobInitialized;
  Result := FBlobSize;
end;

function TIBBlobStream.GetDatabase: TIBDatabase;
begin
  result := FBase.Database;
end;

function TIBBlobStream.GetTransaction: TIBTransaction;
begin
  result := FBase.Transaction;
end;

procedure TIBBlobStream.LoadFromFile(Filename: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TIBBlobStream.LoadFromStream(Stream: TStream);
begin
  CheckWritable;
  EnsureBlobInitialized;
  Stream.Position := 0;
  SetSize(Stream.Size);
  if FBlobSize <> 0 then
    Stream.ReadBuffer(FBuffer^, FBlobSize);
  SetState(bsModified);
end;

procedure TIBBlobStream.OpenBlob;
begin
  CheckReadable;
  try
    GetBlobInfo;
    {Defer reading in blob until read method called}
  except
    FBlob.Close;
    raise;
  end;
  SetState(bsDataPending);
end;

function TIBBlobStream.Read(var Buffer; Count: Longint): Longint;
begin
  CheckReadable;
  EnsureLoaded;
  if Count <= 0 then
  begin
    result := 0;
    exit;
  end;
  if (FPosition + Count > FBlobSize) then
    result := FBlobSize - FPosition
  else
    result := Count;
  Move(FBuffer[FPosition], Buffer, result);
  Inc(FPosition, Result);
end;

procedure TIBBlobStream.SaveToFile(Filename: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TIBBlobStream.SaveToStream(Stream: TStream);
begin
  CheckReadable;
  EnsureLoaded;
  if FBlobSize <> 0 then
  begin
    Seek(0, soFromBeginning);
    Stream.WriteBuffer(FBuffer^, FBlobSize);
  end;
end;

function TIBBlobStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  EnsureBlobInitialized;
  case Origin of
    soBeginning     : FPosition := Offset;
    soCurrent       : Inc(FPosition, Offset);
    soEnd           : FPosition := FBlobSize + Offset;
  end;
  result := FPosition;
end;

procedure TIBBlobStream.SetField(aField: TField);
begin
  FRelationName := '';
  if aField.FieldDef <> nil then
    FRelationName := (aField.FieldDef as TIBFieldDef).RelationName;
  FColumnName := aField.FieldName;;
end;

procedure TIBBlobStream.SetBlobID(Value: TISC_QUAD);
begin
  CheckActive;
  FBlob := nil;
  if (Value.gds_quad_high = 0) and (Value.gds_quad_low = 0) then
    Exit;
  FBlob := Database.Attachment.OpenBlob(Transaction.TransactionIntf,RelationName,ColumnName,Value);
  if FBlobState <> bsData then
    SetState(bsUninitialised);
end;

procedure TIBBlobStream.SetDatabase(Value: TIBDatabase);
begin
  FBase.Database := Value;
  SetState(bsUninitialised);
end;

procedure TIBBlobStream.SetMode(Value: TBlobStreamMode);
begin
  FMode := Value;
  SetState(bsUninitialised);
end;

procedure TIBBlobStream.SetState(aValue: TIBBlobStates);
begin
  if FBlobState = aValue then Exit;

  if (FBlobState = bsDataPending) and (FBlob <> nil) then
    FBlob.Close;

  FBlobState := aValue;
end;

procedure TIBBlobStream.SetSize(const NewSize: Int64);
begin
  if (NewSize <> FBlobSize) then
  begin
    ReallocMem(FBuffer, NewSize);
    FBlobSize := NewSize;
    if NewSize = 0 then
      FBuffer := nil;
  end;
end;

procedure TIBBlobStream.SetSize(NewSize: Longint);
begin
  SetSize(Int64(NewSize));
end;

procedure TIBBlobStream.SetTransaction(Value: TIBTransaction);
begin
  FBase.Transaction := Value;
  SetState(bsUninitialised);
end;

procedure TIBBlobStream.Truncate;
begin
  SetSize(0);
  SetState(bsModified);
end;

function TIBBlobStream.Write(const Buffer; Count: Longint): Longint;
begin
  CheckWritable;
  EnsureLoaded;  {Could be an untruncated bmReadWrite Blob}
  result := Count;
  if Count <= 0 then
    exit;
  if (FPosition + Count > FBlobSize) then
    SetSize(FPosition + Count);
  Move(Buffer, FBuffer[FPosition], Count);
  Inc(FPosition, Count);
  SetState(bsModified);
end;

end.
Revision:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	11537 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	User	Rev	Content
1	tony	33	{************************************************************************}
2			{ }
3			{ Borland Delphi Visual Component Library }
4			{ InterBase Express core components }
5			{ }
6			{ Copyright (c) 1998-2000 Inprise Corporation }
7			{ }
8			{ InterBase Express is based in part on the product }
9			{ Free IB Components, written by Gregory H. Deatz for }
10			{ Hoagland, Longo, Moran, Dunst & Doukas Company. }
11			{ Free IB Components is used under license. }
12			{ }
13			{ The contents of this file are subject to the InterBase }
14			{ Public License Version 1.0 (the "License"); you may not }
15			{ use this file except in compliance with the License. You }
16			{ may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17			{ Software distributed under the License is distributed on }
18			{ an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19			{ express or implied. See the License for the specific language }
20			{ governing rights and limitations under the License. }
21			{ The Original Code was created by InterBase Software Corporation }
22			{ and its successors. }
23			{ Portions created by Inprise Corporation are Copyright (C) Inprise }
24			{ Corporation. All Rights Reserved. }
25			{ Contributor(s): Jeff Overcash }
26			{ }
27			{ IBX For Lazarus (Firebird Express) }
28			{ Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29			{ Portions created by MWA Software are copyright McCallum Whyman }
30			{ Associates Ltd 2011 }
31			{************************************************************************}
32
33			unit IBBlob;
34
35	tony	41	{$mode Delphi}
36	tony	33
37			interface
38
39			uses
40	tony	45	SysUtils, Classes, DB, IB, IBDatabase;
41	tony	33
42
43			const
44	tony	41	DefaultBlobSegmentSize = 16 * 1024;
45	tony	33
46			type
47	tony	41	TIBBlobStates = (bsUninitialised, bsDataPending, bsData, bsModified);
48
49	tony	33	{ TIBBlobStream }
50			TIBBlobStream = class(TStream)
51			private
52			FBase: TIBBase;
53	tony	45	FBlob: IBlob;
54	tony	33	FBlobMaxSegmentSize: Int64;
55			FBlobNumSegments: Int64;
56			FBlobSize: Int64;
57	tony	45	FBlobType: TBlobType;
58	tony	33	FBuffer: PChar;
59	tony	45	FColumnName: string;
60	tony	33	FMode: TBlobStreamMode;
61			FPosition: Int64;
62	tony	41	FBlobState: TIBBlobStates;
63	tony	45	FRelationName: string;
64			function GetBlobID: TISC_QUAD;
65	tony	41	function GetModified: Boolean;
66	tony	45	procedure CheckActive;
67	tony	33	protected
68			procedure CloseBlob;
69			procedure EnsureBlobInitialized;
70	tony	41	procedure EnsureLoaded;
71	tony	33	procedure GetBlobInfo;
72	tony	41	function GetSize: Int64; override;
73	tony	33	function GetDatabase: TIBDatabase;
74			function GetTransaction: TIBTransaction;
75			procedure OpenBlob;
76			procedure SetBlobID(Value: TISC_QUAD);
77			procedure SetDatabase(Value: TIBDatabase);
78			procedure SetMode(Value: TBlobStreamMode);
79	tony	41	procedure SetState(aValue: TIBBlobStates);
80	tony	33	procedure SetTransaction(Value: TIBTransaction);
81			public
82			constructor Create;
83			destructor Destroy; override;
84			procedure CheckReadable;
85			procedure CheckWritable;
86			procedure Finalize;
87			procedure LoadFromFile(Filename: string);
88			procedure LoadFromStream(Stream: TStream);
89			function Read(var Buffer; Count: Longint): Longint; override;
90			procedure SaveToFile(Filename: string);
91			procedure SaveToStream(Stream: TStream);
92			function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
93	tony	45	procedure SetField(aField: TField);
94	tony	33	procedure SetSize(const NewSize: Int64); override;
95			procedure SetSize(NewSize: Longint); override;
96			procedure Truncate;
97			function Write(const Buffer; Count: Longint): Longint; override;
98	tony	45	property BlobID: TISC_QUAD read GetBlobID write SetBlobID;
99			property Blob: IBlob read FBlob;
100	tony	33	property BlobMaxSegmentSize: Int64 read FBlobMaxSegmentSize;
101			property BlobNumSegments: Int64 read FBlobNumSegments;
102	tony	41	property BlobSize: Int64 read GetSize;
103	tony	45	property BlobType: TBlobType read FBlobType;
104	tony	33	property Database: TIBDatabase read GetDatabase write SetDatabase;
105			property Mode: TBlobStreamMode read FMode write SetMode;
106	tony	41	property Modified: Boolean read GetModified;
107	tony	33	property Transaction: TIBTransaction read GetTransaction write SetTransaction;
108	tony	45	property RelationName: string read FRelationName;
109			property ColumnName: string read FColumnName;
110	tony	33	end;
111
112			implementation
113
114	tony	45	uses FBMessages, IBCustomDataSet;
115	tony	33
116			{ TIBBlobStream }
117			constructor TIBBlobStream.Create;
118			begin
119			inherited Create;
120			FBase := TIBBase.Create(Self);
121			FBuffer := nil;
122			FBlobSize := 0;
123	tony	41	FBlobState := bsUninitialised;
124	tony	45	FBlob := nil;
125	tony	33	end;
126
127			destructor TIBBlobStream.Destroy;
128			begin
129	tony	45	CloseBlob;
130	tony	33	FBase.Free;
131			SetSize(0);
132			inherited Destroy;
133			end;
134
135			procedure TIBBlobStream.CheckReadable;
136			begin
137			if FMode = bmWrite then IBError(ibxeBlobCannotBeRead, [nil]);
138			end;
139
140			procedure TIBBlobStream.CheckWritable;
141			begin
142			if FMode = bmRead then IBError(ibxeBlobCannotBeWritten, [nil]);
143			end;
144
145	tony	41	function TIBBlobStream.GetModified: Boolean;
146			begin
147			Result := FBlobState = bsModified;
148			end;
149
150	tony	45	procedure TIBBlobStream.CheckActive;
151			begin
152			if Database = nil then
153			IBError(ibxeDatabaseNotAssigned,[nil]);
154
155			if (Database.Attachment = nil) or
156			not Database.Attachment.IsConnected then
157			IBError(ibxeDatabaseClosed,[nil]);
158
159			if Transaction = nil then
160			IBError(ibxeTransactionNotAssigned,[nil]);
161
162			if (Transaction.TransactionIntf = nil) or
163			not Transaction.TransactionIntf.InTransaction then
164			IBError(ibxeNotInTransaction,[nil]);
165			end;
166
167			function TIBBlobStream.GetBlobID: TISC_QUAD;
168			begin
169			if (FBlob = nil) or (FBlobSize = 0) then
170			begin
171			Result.gds_quad_high := 0;
172			Result.gds_quad_low := 0;
173			end
174			else
175			Result := FBlob.GetBlobID;
176			end;
177
178	tony	33	procedure TIBBlobStream.CloseBlob;
179			begin
180			Finalize;
181	tony	45	FBlob := nil;
182	tony	41	SetState(bsUninitialised);
183	tony	33	end;
184
185	tony	45	procedure TIBBlobStream.EnsureBlobInitialized;
186	tony	33	begin
187	tony	45	if FBlobState <> bsUninitialised then Exit;
188	tony	33
189	tony	45	if FMode = bmWrite then
190			SetState(bsData)
191			else
192			begin
193			CheckReadable;
194			if FBlob = nil then Exit;
195			try
196			GetBlobInfo;
197			{Defer reading in blob until read method called}
198			except
199			FBlob := nil;
200			raise;
201	tony	33	end;
202	tony	45	SetState(bsDataPending);
203			end;
204	tony	33	end;
205
206	tony	41	procedure TIBBlobStream.EnsureLoaded;
207			begin
208			EnsureBlobInitialized;
209	tony	45	if (FBlobState = bsDataPending) and (FBlob <> nil) then
210	tony	41	begin
211			SetSize(FBlobSize);
212	tony	45	FBlob.Read(FBuffer^, FBlobSize);
213	tony	41	SetState(bsData);
214			end;
215			end;
216
217	tony	33	procedure TIBBlobStream.Finalize;
218			begin
219	tony	41	if FBlobState <> bsModified then
220	tony	33	exit;
221	tony	45	CheckWritable;
222	tony	41	if FBlobSize > 0 then
223			begin
224			{ need to start writing to a blob, create one }
225	tony	45	FBlob := Database.Attachment.CreateBlob(Transaction.TransactionIntf,RelationName,ColumnName);
226			FBlob.Write(FBuffer^, FBlobSize);
227			FBlob.Close;
228	tony	41	end;
229			SetState(bsData);
230	tony	33	end;
231
232			procedure TIBBlobStream.GetBlobInfo;
233			var
234			iBlobSize: Int64;
235			begin
236	tony	45	if FBlob = nil then Exit;
237
238			FBlob.GetInfo(FBlobNumSegments, FBlobMaxSegmentSize, iBlobSize, FBlobType);
239	tony	33	SetSize(iBlobSize);
240			end;
241
242	tony	41	function TIBBlobStream.GetSize: Int64;
243			begin
244			EnsureBlobInitialized;
245			Result := FBlobSize;
246			end;
247
248	tony	33	function TIBBlobStream.GetDatabase: TIBDatabase;
249			begin
250			result := FBase.Database;
251			end;
252
253			function TIBBlobStream.GetTransaction: TIBTransaction;
254			begin
255			result := FBase.Transaction;
256			end;
257
258			procedure TIBBlobStream.LoadFromFile(Filename: string);
259			var
260			Stream: TStream;
261			begin
262			Stream := TFileStream.Create(FileName, fmOpenRead);
263			try
264			LoadFromStream(Stream);
265			finally
266			Stream.Free;
267			end;
268			end;
269
270			procedure TIBBlobStream.LoadFromStream(Stream: TStream);
271			begin
272			CheckWritable;
273			EnsureBlobInitialized;
274			Stream.Position := 0;
275			SetSize(Stream.Size);
276			if FBlobSize <> 0 then
277			Stream.ReadBuffer(FBuffer^, FBlobSize);
278	tony	41	SetState(bsModified);
279	tony	33	end;
280
281			procedure TIBBlobStream.OpenBlob;
282			begin
283			CheckReadable;
284			try
285			GetBlobInfo;
286	tony	41	{Defer reading in blob until read method called}
287	tony	33	except
288	tony	45	FBlob.Close;
289	tony	33	raise;
290			end;
291	tony	41	SetState(bsDataPending);
292	tony	33	end;
293
294			function TIBBlobStream.Read(var Buffer; Count: Longint): Longint;
295			begin
296			CheckReadable;
297	tony	41	EnsureLoaded;
298	tony	45	if Count <= 0 then
299	tony	33	begin
300			result := 0;
301			exit;
302			end;
303			if (FPosition + Count > FBlobSize) then
304			result := FBlobSize - FPosition
305			else
306			result := Count;
307			Move(FBuffer[FPosition], Buffer, result);
308			Inc(FPosition, Result);
309			end;
310
311			procedure TIBBlobStream.SaveToFile(Filename: string);
312			var
313			Stream: TStream;
314			begin
315			Stream := TFileStream.Create(FileName, fmCreate);
316			try
317			SaveToStream(Stream);
318			finally
319			Stream.Free;
320			end;
321			end;
322
323			procedure TIBBlobStream.SaveToStream(Stream: TStream);
324			begin
325			CheckReadable;
326	tony	41	EnsureLoaded;
327	tony	33	if FBlobSize <> 0 then
328			begin
329			Seek(0, soFromBeginning);
330			Stream.WriteBuffer(FBuffer^, FBlobSize);
331			end;
332			end;
333
334			function TIBBlobStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
335			begin
336			EnsureBlobInitialized;
337			case Origin of
338			soBeginning : FPosition := Offset;
339			soCurrent : Inc(FPosition, Offset);
340			soEnd : FPosition := FBlobSize + Offset;
341			end;
342			result := FPosition;
343			end;
344
345	tony	45	procedure TIBBlobStream.SetField(aField: TField);
346			begin
347			FRelationName := '';
348			if aField.FieldDef <> nil then
349			FRelationName := (aField.FieldDef as TIBFieldDef).RelationName;
350			FColumnName := aField.FieldName;;
351			end;
352
353	tony	33	procedure TIBBlobStream.SetBlobID(Value: TISC_QUAD);
354			begin
355	tony	45	CheckActive;
356			FBlob := nil;
357			if (Value.gds_quad_high = 0) and (Value.gds_quad_low = 0) then
358			Exit;
359			FBlob := Database.Attachment.OpenBlob(Transaction.TransactionIntf,RelationName,ColumnName,Value);
360			if FBlobState <> bsData then
361			SetState(bsUninitialised);
362	tony	33	end;
363
364			procedure TIBBlobStream.SetDatabase(Value: TIBDatabase);
365			begin
366			FBase.Database := Value;
367	tony	41	SetState(bsUninitialised);
368	tony	33	end;
369
370			procedure TIBBlobStream.SetMode(Value: TBlobStreamMode);
371			begin
372			FMode := Value;
373	tony	41	SetState(bsUninitialised);
374	tony	33	end;
375
376	tony	41	procedure TIBBlobStream.SetState(aValue: TIBBlobStates);
377			begin
378			if FBlobState = aValue then Exit;
379
380	tony	45	if (FBlobState = bsDataPending) and (FBlob <> nil) then
381			FBlob.Close;
382	tony	41
383			FBlobState := aValue;
384			end;
385
386	tony	33	procedure TIBBlobStream.SetSize(const NewSize: Int64);
387			begin
388			if (NewSize <> FBlobSize) then
389			begin
390			ReallocMem(FBuffer, NewSize);
391			FBlobSize := NewSize;
392			if NewSize = 0 then
393			FBuffer := nil;
394			end;
395			end;
396
397			procedure TIBBlobStream.SetSize(NewSize: Longint);
398			begin
399			SetSize(Int64(NewSize));
400			end;
401
402			procedure TIBBlobStream.SetTransaction(Value: TIBTransaction);
403			begin
404			FBase.Transaction := Value;
405	tony	41	SetState(bsUninitialised);
406	tony	33	end;
407
408			procedure TIBBlobStream.Truncate;
409			begin
410			SetSize(0);
411	tony	41	SetState(bsModified);
412	tony	33	end;
413
414			function TIBBlobStream.Write(const Buffer; Count: Longint): Longint;
415			begin
416			CheckWritable;
417	tony	41	EnsureLoaded; {Could be an untruncated bmReadWrite Blob}
418	tony	33	result := Count;
419			if Count <= 0 then
420			exit;
421			if (FPosition + Count > FBlobSize) then
422			SetSize(FPosition + Count);
423			Move(Buffer, FBuffer[FPosition], Count);
424			Inc(FPosition, Count);
425	tony	41	SetState(bsModified);
426	tony	33	end;
427
428			end.