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 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC

#	Line 24 | Line 24
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	+	{$mode Delphi}
36	+
37		interface
38
39		uses
40	<	Windows, SysUtils, Classes, Forms, IBHeader, IBErrorCodes, IBExternals,
41	<	DB, IB, IBDatabase, IBUtils;
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;
54	<	FBlobMaxSegmentSize,
55	<	FBlobNumSegments,
56	<	FBlobSize: Long;
57	<	FBlobType: Short;  { 0 = segmented, 1 = streamed }
53	>	FBlob: IBlob;
54	>	FBlobMaxSegmentSize: Int64;
55	>	FBlobNumSegments: Int64;
56	>	FBlobSize: Int64;
57	>	FBlobType: TBlobType;
58		FBuffer: PChar;
59	<	FBlobInitialized: Boolean;
52	<	FHandle: TISC_BLOB_HANDLE;
59	>	FColumnName: string;
60		FMode: TBlobStreamMode;
61	<	FModified: Boolean;
62	<	FPosition: Long;
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;
58	–	procedure CreateBlob;
69		procedure EnsureBlobInitialized;
70	+	procedure EnsureLoaded;
71		procedure GetBlobInfo;
72	+	function  GetSize: Int64; override;
73		function GetDatabase: TIBDatabase;
62	–	function GetDBHandle: PISC_DB_HANDLE;
74		function GetTransaction: TIBTransaction;
64	–	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;
73	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
84		procedure CheckReadable;
85		procedure CheckWritable;
86		procedure Finalize;
#	Line 79 | Line 89 | type
89		function Read(var Buffer; Count: Longint): Longint; override;
90		procedure SaveToFile(Filename: string);
91		procedure SaveToStream(Stream: TStream);
92	<	function Seek(Offset: Longint; Origin: Word): Longint; override;
93	<	procedure SetSize(NewSize: Long); override;
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;
100	<	property BlobMaxSegmentSize: Long read FBlobMaxSegmentSize;
101	<	property BlobNumSegments: Long read FBlobNumSegments;
102	<	property BlobSize: Long read FBlobSize;
103	<	property BlobType: Short read FBlobType;
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 GetSize;
103	>	property BlobType: TBlobType read FBlobType;
104		property Database: TIBDatabase read GetDatabase write SetDatabase;
93	–	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
100	–	procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments, MaxSegmentSize,
101	–	TotalSize: Long; var BlobType: Short);
102	–	procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Long);
103	–	procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Long);
104	–
112		implementation
113
114	<	uses IBIntf, IBCustomDataSet;
108	<
109	<	procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments, MaxSegmentSize,
110	<	TotalSize: Long; var BlobType: Short);
111	<	var
112	<	items: array[0..3] of Char;
113	<	results: array[0..99] of Char;
114	<	i, item_length: Integer;
115	<	item: Integer;
116	<	begin
117	<	items[0] := Char(isc_info_blob_num_segments);
118	<	items[1] := Char(isc_info_blob_max_segment);
119	<	items[2] := Char(isc_info_blob_total_length);
120	<	items[3] := Char(isc_info_blob_type);
121	<
122	<	if isc_blob_info(StatusVector, hBlobHandle, 4, @items[0], SizeOf(results),
123	<	@results[0]) > 0 then
124	<	IBDatabaseError;
125	<
126	<	i := 0;
127	<	while (i < SizeOf(results)) and (results[i] <> Char(isc_info_end)) do
128	<	begin
129	<	item := Integer(results[i]); Inc(i);
130	<	item_length := isc_vax_integer(@results[i], 2); Inc(i, 2);
131	<	case item of
132	<	isc_info_blob_num_segments:
133	<	NumSegments := isc_vax_integer(@results[i], item_length);
134	<	isc_info_blob_max_segment:
135	<	MaxSegmentSize := isc_vax_integer(@results[i], item_length);
136	<	isc_info_blob_total_length:
137	<	TotalSize := isc_vax_integer(@results[i], item_length);
138	<	isc_info_blob_type:
139	<	BlobType := isc_vax_integer(@results[i], item_length);
140	<	end;
141	<	Inc(i, item_length);
142	<	end;
143	<	end;
144	<
145	<	procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Long);
146	<	var
147	<	CurPos: Long;
148	<	BytesRead, SegLen: UShort;
149	<	LocalBuffer: PChar;
150	<	begin
151	<	CurPos := 0;
152	<	LocalBuffer := Buffer;
153	<	SegLen := UShort(DefaultBlobSegmentSize);
154	<	while (CurPos < BlobSize) do
155	<	begin
156	<	if (CurPos + SegLen > BlobSize) then
157	<	SegLen := BlobSize - CurPos;
158	<	if not ((isc_get_segment(StatusVector, hBlobHandle, @BytesRead, SegLen,
159	<	LocalBuffer) = 0) or
160	<	(StatusVectorArray[1] = isc_segment)) then
161	<	IBDatabaseError;
162	<	Inc(LocalBuffer, BytesRead);
163	<	Inc(CurPos, BytesRead);
164	<	BytesRead := 0;
165	<	end;
166	<	end;
167	<
168	<	procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar;
169	<	BlobSize: Long);
170	<	var
171	<	CurPos, SegLen: Long;
172	<	begin
173	<	CurPos := 0;
174	<	SegLen := DefaultBlobSegmentSize;
175	<	while (CurPos < BlobSize) do
176	<	begin
177	<	if (CurPos + SegLen > BlobSize) then
178	<	SegLen := BlobSize - CurPos;
179	<	if isc_put_segment(StatusVector, hBlobHandle, SegLen,
180	<	PChar(@Buffer[CurPos])) > 0 then
181	<	IBDatabaseError;
182	<	Inc(CurPos, SegLen);
183	<	end;
184	<	end;
185	<
114	>	uses FBMessages, IBCustomDataSet;
115
116		{ TIBBlobStream }
117		constructor TIBBlobStream.Create;
#	Line 191 | 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
199	<	(Call(isc_close_blob(StatusVector, @FHandle), False) > 0) then
200	<	IBDataBaseError;
129	>	CloseBlob;
130		FBase.Free;
131		SetSize(0);
132		inherited Destroy;
133		end;
134
206	–	function TIBBlobStream.Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
207	–	begin
208	–	result := 0;
209	–	if Transaction <> nil then
210	–	result := Transaction.Call(ErrCode, RaiseError)
211	–	else if RaiseError and (ErrCode > 0) then
212	–	IBDataBaseError;
213	–	end;
214	–
135		procedure TIBBlobStream.CheckReadable;
136		begin
137		if FMode = bmWrite then IBError(ibxeBlobCannotBeRead, [nil]);
#	Line 222 | 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;
228	<	if (FHandle <> nil) and
229	<	(Call(isc_close_blob(StatusVector, @FHandle), False) > 0) then
230	<	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: Long;
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 293 | Line 255 | begin
255		result := FBase.Transaction;
256		end;
257
296	–	function TIBBlobStream.GetTRHandle: PISC_TR_HANDLE;
297	–	begin
298	–	result := FBase.TRHandle;
299	–	end;
300	–
258		procedure TIBBlobStream.LoadFromFile(Filename: string);
259		var
260		Stream: TStream;
#	Line 318 | 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;
327	–	Call(isc_open_blob2(StatusVector, DBHandle, TRHandle, @FHandle,
328	–	@FBlobID, 0, nil), True);
284		try
285		GetBlobInfo;
286	<	SetSize(FBlobSize);
332	<	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 369 | 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 377 | Line 331 | begin
331		end;
332		end;
333
334	<	function TIBBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
334	>	function TIBBlobStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
335		begin
336		EnsureBlobInitialized;
337		case Origin of
338	<	soFromBeginning     : FPosition := Offset;
339	<	soFromCurrent       : Inc(FPosition, Offset);
340	<	soFromEnd           : FPosition := FBlobSize + Offset;
338	>	soBeginning     : FPosition := Offset;
339	>	soCurrent       : Inc(FPosition, Offset);
340	>	soEnd           : FPosition := FBlobSize + Offset;
341		end;
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(NewSize: Long);
386	>	procedure TIBBlobStream.SetSize(const NewSize: Int64);
387		begin
388		if (NewSize <> FBlobSize) then
389		begin
#	Line 417 | Line 394 | begin
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	<	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 439 | 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