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 35 by tony, Tue Jan 26 14:38:47 2016 UTC vs.
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC

#	Line 32 | Line 32
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	–	function GetBlobCharSetID(hDB_Handle: TISC_DB_HANDLE; hTR_Handle: TISC_TR_HANDLE;
110	–	tableName, columnName: PChar): short;
111	–	procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
112	–	procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
113	–
112		implementation
113
114	<	uses IBIntf;
117	<
118	<	procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments: Int64; var MaxSegmentSize,
119	<	TotalSize: Int64; var BlobType: Short);
120	<	var
121	<	items: array[0..3] of Char;
122	<	results: array[0..99] of Char;
123	<	i, item_length: Integer;
124	<	item: Integer;
125	<	begin
126	<	items[0] := Char(isc_info_blob_num_segments);
127	<	items[1] := Char(isc_info_blob_max_segment);
128	<	items[2] := Char(isc_info_blob_total_length);
129	<	items[3] := Char(isc_info_blob_type);
130	<
131	<	if isc_blob_info(StatusVector, hBlobHandle, 4, @items[0], SizeOf(results),
132	<	@results[0]) > 0 then
133	<	IBDatabaseError;
134	<
135	<	i := 0;
136	<	while (i < SizeOf(results)) and (results[i] <> Char(isc_info_end)) do
137	<	begin
138	<	item := Integer(results[i]); Inc(i);
139	<	item_length := isc_vax_integer(@results[i], 2); Inc(i, 2);
140	<	case item of
141	<	isc_info_blob_num_segments:
142	<	NumSegments := isc_portable_integer(@results[i], item_length);
143	<	isc_info_blob_max_segment:
144	<	MaxSegmentSize := isc_portable_integer(@results[i], item_length);
145	<	isc_info_blob_total_length:
146	<	TotalSize := isc_portable_integer(@results[i], item_length);
147	<	isc_info_blob_type:
148	<	BlobType := isc_portable_integer(@results[i], item_length);
149	<	end;
150	<	Inc(i, item_length);
151	<	end;
152	<	end;
153	<
154	<	function GetBlobCharSetID(hDB_Handle: TISC_DB_HANDLE;
155	<	hTR_Handle: TISC_TR_HANDLE; tableName, columnName: PChar): short;
156	<	var desc: TISC_BLOB_DESC;
157	<	uGlobal: array [0..31] of char;
158	<	begin
159	<	if isc_blob_lookup_desc(StatusVector,@hDB_Handle,@hTR_Handle,
160	<	tableName,columnName,@desc,@uGlobal) > 0 then
161	<	IBDatabaseError;
162	<
163	<	Result := desc.blob_desc_charset;
164	<	end;
165	<
166	<	procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
167	<	var
168	<	CurPos: Int64;
169	<	BytesRead, SegLen: UShort;
170	<	LocalBuffer: PChar;
171	<	begin
172	<	CurPos := 0;
173	<	LocalBuffer := Buffer;
174	<	SegLen := UShort(DefaultBlobSegmentSize);
175	<	while (CurPos < BlobSize) do
176	<	begin
177	<	if (CurPos + SegLen > BlobSize) then
178	<	SegLen := BlobSize - CurPos;
179	<	if not ((isc_get_segment(StatusVector, hBlobHandle, @BytesRead, SegLen,
180	<	LocalBuffer) = 0) or
181	<	(StatusVectorArray[1] = isc_segment)) then
182	<	IBDatabaseError;
183	<	Inc(LocalBuffer, BytesRead);
184	<	Inc(CurPos, BytesRead);
185	<	BytesRead := 0;
186	<	end;
187	<	end;
188	<
189	<	procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar;
190	<	BlobSize: Int64);
191	<	var
192	<	CurPos: Int64;
193	<	SegLen: Long;
194	<	begin
195	<	CurPos := 0;
196	<	SegLen := DefaultBlobSegmentSize;
197	<	while (CurPos < BlobSize) do
198	<	begin
199	<	if (CurPos + SegLen > BlobSize) then
200	<	SegLen := BlobSize - CurPos;
201	<	if isc_put_segment(StatusVector, hBlobHandle, SegLen,
202	<	PChar(@Buffer[CurPos])) > 0 then
203	<	IBDatabaseError;
204	<	Inc(CurPos, SegLen);
205	<	end;
206	<	end;
207	<
114	>	uses FBMessages, IBCustomDataSet;
115
116		{ TIBBlobStream }
117		constructor TIBBlobStream.Create;
#	Line 213 | 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
221	<	(Call(isc_close_blob(StatusVector, @FHandle), False) > 0) then
222	<	IBDataBaseError;
129	>	CloseBlob;
130		FBase.Free;
131		SetSize(0);
132		inherited Destroy;
133		end;
134
228	–	function TIBBlobStream.Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
229	–	begin
230	–	result := 0;
231	–	if Transaction <> nil then
232	–	result := Transaction.Call(ErrCode, RaiseError)
233	–	else if RaiseError and (ErrCode > 0) then
234	–	IBDataBaseError;
235	–	end;
236	–
135		procedure TIBBlobStream.CheckReadable;
136		begin
137		if FMode = bmWrite then IBError(ibxeBlobCannotBeRead, [nil]);
#	Line 244 | 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;
250	<	if (FHandle <> nil) and
251	<	(Call(isc_close_blob(StatusVector, @FHandle), False) > 0) then
252	<	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 315 | Line 255 | begin
255		result := FBase.Transaction;
256		end;
257
318	–	function TIBBlobStream.GetTRHandle: PISC_TR_HANDLE;
319	–	begin
320	–	result := FBase.TRHandle;
321	–	end;
322	–
258		procedure TIBBlobStream.LoadFromFile(Filename: string);
259		var
260		Stream: TStream;
#	Line 340 | 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;
349	–	Call(isc_open_blob2(StatusVector, DBHandle, TRHandle, @FHandle,
350	–	@FBlobID, 0, nil), True);
284		try
285		GetBlobInfo;
286	<	SetSize(FBlobSize);
354	<	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 391 | 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 410 | 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 447 | 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 466 | 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