ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/IBBlob.pas

Comparing ibx/trunk/runtime/IBBlob.pas (file contents):
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 27 | Line 27
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                                                 }
30	>	{    Associates Ltd 2011 - 2018                                               }
31		{************************************************************************}
32
33		unit IBBlob;
34
35	<	{$Mode Delphi}
35	>	{$mode Delphi}
36
37		interface
38
39		uses
40	<	SysUtils, Classes, IBHeader, IBErrorCodes, IBExternals, DB, IB, IBDatabase;
40	>	SysUtils, Classes, DB, IB, IBDatabase;
41
42
43		const
44	<	DefaultBlobSegmentSize = 16 * 1024;
44	>	DefaultBlobSegmentSize = 16 * 1024;
45
46		type
47	+	TIBBlobStates = (bsUninitialised, bsDataPending, bsData, bsModified);
48	+
49		{ TIBBlobStream }
50		TIBBlobStream = class(TStream)
51		private
52		FBase: TIBBase;
53	<	FBlobID: TISC_QUAD;
53	>	FBlob: IBlob;
54		FBlobMaxSegmentSize: Int64;
55		FBlobNumSegments: Int64;
56		FBlobSize: Int64;
57	<	FBlobType: Short;  { 0 = segmented, 1 = streamed }
57	>	FBlobType: TBlobType;
58		FBuffer: PChar;
59	<	FBlobInitialized: Boolean;
58	<	FHandle: TISC_BLOB_HANDLE;
59	>	FColumnName: string;
60		FMode: TBlobStreamMode;
60	–	FModified: Boolean;
61		FPosition: Int64;
62	+	FBlobState: TIBBlobStates;
63	+	FRelationName: string;
64	+	function GetBlobID: TISC_QUAD;
65	+	function GetModified: Boolean;
66	+	procedure CheckActive;
67		protected
68		procedure CloseBlob;
64	–	procedure CreateBlob;
69		procedure EnsureBlobInitialized;
70	+	procedure EnsureLoaded;
71		procedure GetBlobInfo;
72	+	function  GetSize: Int64; override;
73		function GetDatabase: TIBDatabase;
68	–	function GetDBHandle: PISC_DB_HANDLE;
74		function GetTransaction: TIBTransaction;
70	–	function GetTRHandle: PISC_TR_HANDLE;
75		procedure OpenBlob;
76		procedure SetBlobID(Value: TISC_QUAD);
77		procedure SetDatabase(Value: TIBDatabase);
78		procedure SetMode(Value: TBlobStreamMode);
79	+	procedure SetState(aValue: TIBBlobStates);
80		procedure SetTransaction(Value: TIBTransaction);
81		public
82		constructor Create;
83		destructor Destroy; override;
79	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
84		procedure CheckReadable;
85		procedure CheckWritable;
86		procedure Finalize;
#	Line 86 | Line 90 | type
90		procedure SaveToFile(Filename: string);
91		procedure SaveToStream(Stream: TStream);
92		function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
93	+	procedure SetField(aField: TField);
94		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	<	property Handle: TISC_BLOB_HANDLE read FHandle;
99	<	property BlobID: TISC_QUAD read FBlobID write SetBlobID;
98	>	property BlobID: TISC_QUAD read GetBlobID write SetBlobID;
99	>	property Blob: IBlob read FBlob;
100		property BlobMaxSegmentSize: Int64 read FBlobMaxSegmentSize;
101		property BlobNumSegments: Int64 read FBlobNumSegments;
102	<	property BlobSize: Int64 read FBlobSize;
103	<	property BlobType: Short read FBlobType;
102	>	property BlobSize: Int64 read GetSize;
103	>	property BlobType: TBlobType read FBlobType;
104		property Database: TIBDatabase read GetDatabase write SetDatabase;
100	–	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
105		property Mode: TBlobStreamMode read FMode write SetMode;
106	<	property Modified: Boolean read FModified;
106	>	property Modified: Boolean read GetModified;
107		property Transaction: TIBTransaction read GetTransaction write SetTransaction;
108	<	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
108	>	property RelationName: string read FRelationName;
109	>	property ColumnName: string read FColumnName;
110		end;
111
107	–	procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments: Int64; var MaxSegmentSize,
108	–	TotalSize: Int64; var BlobType: Short);
109	–	procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
110	–	procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
111	–
112		implementation
113
114	<	uses IBIntf;
115	<
116	<	procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments: Int64; var MaxSegmentSize,
117	<	TotalSize: Int64; var BlobType: Short);
118	<	var
119	<	items: array[0..3] of Char;
120	<	results: array[0..99] of Char;
121	<	i, item_length: Integer;
122	<	item: Integer;
123	<	begin
124	<	items[0] := Char(isc_info_blob_num_segments);
125	<	items[1] := Char(isc_info_blob_max_segment);
126	<	items[2] := Char(isc_info_blob_total_length);
127	<	items[3] := Char(isc_info_blob_type);
128	<
129	<	if isc_blob_info(StatusVector, hBlobHandle, 4, @items[0], SizeOf(results),
130	<	@results[0]) > 0 then
131	<	IBDatabaseError;
132	<
133	<	i := 0;
134	<	while (i < SizeOf(results)) and (results[i] <> Char(isc_info_end)) do
135	<	begin
136	<	item := Integer(results[i]); Inc(i);
137	<	item_length := isc_vax_integer(@results[i], 2); Inc(i, 2);
138	<	case item of
139	<	isc_info_blob_num_segments:
140	<	NumSegments := isc_portable_integer(@results[i], item_length);
141	<	isc_info_blob_max_segment:
142	<	MaxSegmentSize := isc_portable_integer(@results[i], item_length);
143	<	isc_info_blob_total_length:
144	<	TotalSize := isc_portable_integer(@results[i], item_length);
145	<	isc_info_blob_type:
146	<	BlobType := isc_portable_integer(@results[i], item_length);
147	<	end;
148	<	Inc(i, item_length);
149	<	end;
150	<	end;
151	<
152	<	procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
153	<	var
154	<	CurPos: Int64;
155	<	BytesRead, SegLen: UShort;
156	<	LocalBuffer: PChar;
157	<	begin
158	<	CurPos := 0;
159	<	LocalBuffer := Buffer;
160	<	SegLen := UShort(DefaultBlobSegmentSize);
161	<	while (CurPos < BlobSize) do
162	<	begin
163	<	if (CurPos + SegLen > BlobSize) then
164	<	SegLen := BlobSize - CurPos;
165	<	if not ((isc_get_segment(StatusVector, hBlobHandle, @BytesRead, SegLen,
166	<	LocalBuffer) = 0) or
167	<	(StatusVectorArray[1] = isc_segment)) then
168	<	IBDatabaseError;
169	<	Inc(LocalBuffer, BytesRead);
170	<	Inc(CurPos, BytesRead);
171	<	BytesRead := 0;
172	<	end;
173	<	end;
174	<
175	<	procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar;
176	<	BlobSize: Int64);
177	<	var
178	<	CurPos: Int64;
179	<	SegLen: Long;
180	<	begin
181	<	CurPos := 0;
182	<	SegLen := DefaultBlobSegmentSize;
183	<	while (CurPos < BlobSize) do
184	<	begin
185	<	if (CurPos + SegLen > BlobSize) then
186	<	SegLen := BlobSize - CurPos;
187	<	if isc_put_segment(StatusVector, hBlobHandle, SegLen,
188	<	PChar(@Buffer[CurPos])) > 0 then
189	<	IBDatabaseError;
190	<	Inc(CurPos, SegLen);
191	<	end;
192	<	end;
193	<
114	>	uses FBMessages, IBCustomDataSet;
115
116		{ TIBBlobStream }
117		constructor TIBBlobStream.Create;
#	Line 199 | Line 120 | begin
120		FBase := TIBBase.Create(Self);
121		FBuffer := nil;
122		FBlobSize := 0;
123	+	FBlobState := bsUninitialised;
124	+	FBlob := nil;
125		end;
126
127		destructor TIBBlobStream.Destroy;
128		begin
129	<	if (FHandle <> nil) and
207	<	(Call(isc_close_blob(StatusVector, @FHandle), False) > 0) then
208	<	IBDataBaseError;
129	>	CloseBlob;
130		FBase.Free;
131		SetSize(0);
132		inherited Destroy;
133		end;
134
214	–	function TIBBlobStream.Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
215	–	begin
216	–	result := 0;
217	–	if Transaction <> nil then
218	–	result := Transaction.Call(ErrCode, RaiseError)
219	–	else if RaiseError and (ErrCode > 0) then
220	–	IBDataBaseError;
221	–	end;
222	–
135		procedure TIBBlobStream.CheckReadable;
136		begin
137		if FMode = bmWrite then IBError(ibxeBlobCannotBeRead, [nil]);
#	Line 230 | Line 142 | begin
142		if FMode = bmRead then IBError(ibxeBlobCannotBeWritten, [nil]);
143		end;
144
145	<	procedure TIBBlobStream.CloseBlob;
145	>	function TIBBlobStream.GetModified: Boolean;
146		begin
147	<	Finalize;
236	<	if (FHandle <> nil) and
237	<	(Call(isc_close_blob(StatusVector, @FHandle), False) > 0) then
238	<	IBDataBaseError;
147	>	Result := FBlobState = bsModified;
148		end;
149
150	<	procedure TIBBlobStream.CreateBlob;
150	>	procedure TIBBlobStream.CheckActive;
151		begin
152	<	CheckWritable;
153	<	FBlobID.gds_quad_high := 0;
154	<	FBlobID.gds_quad_low := 0;
155	<	Truncate;
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	>	procedure TIBBlobStream.CloseBlob;
179	>	begin
180	>	Finalize;
181	>	FBlob := nil;
182	>	SetState(bsUninitialised);
183		end;
184
185		procedure TIBBlobStream.EnsureBlobInitialized;
186		begin
187	<	if not FBlobInitialized then
188	<	case FMode of
189	<	bmWrite:
190	<	CreateBlob;
191	<	bmReadWrite: begin
192	<	if (FBlobID.gds_quad_high = 0) and
193	<	(FBlobID.gds_quad_low = 0) then
194	<	CreateBlob
195	<	else
196	<	OpenBlob;
197	<	end;
198	<	else
199	<	OpenBlob;
187	>	if FBlobState <> bsUninitialised then Exit;
188	>
189	>	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		end;
202	<	FBlobInitialized := True;
202	>	SetState(bsDataPending);
203	>	end;
204	>	end;
205	>
206	>	procedure TIBBlobStream.EnsureLoaded;
207	>	begin
208	>	EnsureBlobInitialized;
209	>	if (FBlobState = bsDataPending) and (FBlob <> nil) then
210	>	begin
211	>	SetSize(FBlobSize);
212	>	FBlob.Read(FBuffer^, FBlobSize);
213	>	SetState(bsData);
214	>	end;
215		end;
216
217		procedure TIBBlobStream.Finalize;
218		begin
219	<	if (not FBlobInitialized) or (FMode = bmRead) or (not FModified) then
219	>	if FBlobState <> bsModified then
220		exit;
221	<	{ need to start writing to a blob, create one }
222	<	Call(isc_create_blob2(StatusVector, DBHandle, TRHandle, @FHandle, @FBlobID,
223	<	0, nil), True);
224	<	IBBlob.WriteBlob(@FHandle, FBuffer, FBlobSize);
225	<	Call(isc_close_blob(StatusVector, @FHandle), True);
226	<	FModified := False;
221	>	CheckWritable;
222	>	if FBlobSize > 0 then
223	>	begin
224	>	{ need to start writing to a blob, create one }
225	>	FBlob := Database.Attachment.CreateBlob(Transaction.TransactionIntf,RelationName,ColumnName);
226	>	FBlob.Write(FBuffer^, FBlobSize);
227	>	FBlob.Close;
228	>	end;
229	>	SetState(bsData);
230		end;
231
232		procedure TIBBlobStream.GetBlobInfo;
233		var
234		iBlobSize: Int64;
235		begin
236	<	IBBlob.GetBlobInfo(@FHandle, FBlobNumSegments, FBlobMaxSegmentSize,
237	<	iBlobSize, FBlobType);
236	>	if FBlob = nil then Exit;
237	>
238	>	FBlob.GetInfo(FBlobNumSegments, FBlobMaxSegmentSize, iBlobSize, FBlobType);
239		SetSize(iBlobSize);
240		end;
241
242	<	function TIBBlobStream.GetDatabase: TIBDatabase;
242	>	function TIBBlobStream.GetSize: Int64;
243		begin
244	<	result := FBase.Database;
244	>	EnsureBlobInitialized;
245	>	Result := FBlobSize;
246		end;
247
248	<	function TIBBlobStream.GetDBHandle: PISC_DB_HANDLE;
248	>	function TIBBlobStream.GetDatabase: TIBDatabase;
249		begin
250	<	result := FBase.DBHandle;
250	>	result := FBase.Database;
251		end;
252
253		function TIBBlobStream.GetTransaction: TIBTransaction;
#	Line 301 | Line 255 | begin
255		result := FBase.Transaction;
256		end;
257
304	–	function TIBBlobStream.GetTRHandle: PISC_TR_HANDLE;
305	–	begin
306	–	result := FBase.TRHandle;
307	–	end;
308	–
258		procedure TIBBlobStream.LoadFromFile(Filename: string);
259		var
260		Stream: TStream;
#	Line 326 | Line 275 | begin
275		SetSize(Stream.Size);
276		if FBlobSize <> 0 then
277		Stream.ReadBuffer(FBuffer^, FBlobSize);
278	<	FModified := True;
278	>	SetState(bsModified);
279		end;
280
281		procedure TIBBlobStream.OpenBlob;
282		begin
283		CheckReadable;
335	–	Call(isc_open_blob2(StatusVector, DBHandle, TRHandle, @FHandle,
336	–	@FBlobID, 0, nil), True);
284		try
285		GetBlobInfo;
286	<	SetSize(FBlobSize);
340	<	IBBlob.ReadBlob(@FHandle, FBuffer, FBlobSize);
286	>	{Defer reading in blob until read method called}
287		except
288	<	Call(isc_close_blob(StatusVector, @FHandle), False);
288	>	FBlob.Close;
289		raise;
290		end;
291	<	Call(isc_close_blob(StatusVector, @FHandle), True);
291	>	SetState(bsDataPending);
292		end;
293
294		function TIBBlobStream.Read(var Buffer; Count: Longint): Longint;
295		begin
296		CheckReadable;
297	<	EnsureBlobInitialized;
298	<	if (Count <= 0) then
297	>	EnsureLoaded;
298	>	if Count <= 0 then
299		begin
300		result := 0;
301		exit;
#	Line 377 | Line 323 | end;
323		procedure TIBBlobStream.SaveToStream(Stream: TStream);
324		begin
325		CheckReadable;
326	<	EnsureBlobInitialized;
326	>	EnsureLoaded;
327		if FBlobSize <> 0 then
328		begin
329		Seek(0, soFromBeginning);
#	Line 396 | Line 342 | begin
342		result := FPosition;
343		end;
344
345	+	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		procedure TIBBlobStream.SetBlobID(Value: TISC_QUAD);
354		begin
355	<	System.Move(Value, FBlobID, SizeOf(TISC_QUAD));
356	<	FBlobInitialized := False;
355	>	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		end;
363
364		procedure TIBBlobStream.SetDatabase(Value: TIBDatabase);
365		begin
366		FBase.Database := Value;
367	<	FBlobInitialized := False;
367	>	SetState(bsUninitialised);
368		end;
369
370		procedure TIBBlobStream.SetMode(Value: TBlobStreamMode);
371		begin
372		FMode := Value;
373	<	FBlobInitialized := False;
373	>	SetState(bsUninitialised);
374	>	end;
375	>
376	>	procedure TIBBlobStream.SetState(aValue: TIBBlobStates);
377	>	begin
378	>	if FBlobState = aValue then Exit;
379	>
380	>	if (FBlobState = bsDataPending) and (FBlob <> nil) then
381	>	FBlob.Close;
382	>
383	>	FBlobState := aValue;
384		end;
385
386		procedure TIBBlobStream.SetSize(const NewSize: Int64);
#	Line 433 | Line 402 | end;
402		procedure TIBBlobStream.SetTransaction(Value: TIBTransaction);
403		begin
404		FBase.Transaction := Value;
405	<	FBlobInitialized := False;
405	>	SetState(bsUninitialised);
406		end;
407
408		procedure TIBBlobStream.Truncate;
409		begin
410		SetSize(0);
411	+	SetState(bsModified);
412		end;
413
414		function TIBBlobStream.Write(const Buffer; Count: Longint): Longint;
415		begin
416		CheckWritable;
417	<	EnsureBlobInitialized;
417	>	EnsureLoaded;  {Could be an untruncated bmReadWrite Blob}
418		result := Count;
419		if Count <= 0 then
420		exit;
#	Line 452 | Line 422 | begin
422		SetSize(FPosition + Count);
423		Move(Buffer, FBuffer[FPosition], Count);
424		Inc(FPosition, Count);
425	<	FModified := True;
425	>	SetState(bsModified);
426		end;
427
428		end.

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines