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 41 by tony, Sat Jul 16 12:25:48 2016 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;
#	Line 37 | Line 37 | unit IBBlob;
37		interface
38
39		uses
40	<	SysUtils, Classes, IBHeader, IBErrorCodes, IBExternals, DB, IB, IBDatabase;
40	>	SysUtils, Classes, DB, IB, IBDatabase;
41
42
43		const
#	Line 50 | Line 50 | type
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	<	FHandle: TISC_BLOB_HANDLE;
59	>	FColumnName: string;
60		FMode: TBlobStreamMode;
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;
66	–	procedure CreateBlob;
69		procedure EnsureBlobInitialized;
70		procedure EnsureLoaded;
71		procedure GetBlobInfo;
72		function  GetSize: Int64; override;
73		function GetDatabase: TIBDatabase;
72	–	function GetDBHandle: PISC_DB_HANDLE;
74		function GetTransaction: TIBTransaction;
74	–	function GetTRHandle: PISC_TR_HANDLE;
75		procedure OpenBlob;
76		procedure SetBlobID(Value: TISC_QUAD);
77		procedure SetDatabase(Value: TIBDatabase);
#	Line 81 | Line 81 | type
81		public
82		constructor Create;
83		destructor Destroy; override;
84	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
84		procedure CheckReadable;
85		procedure CheckWritable;
86		procedure Finalize;
#	Line 91 | 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 GetSize;
103	<	property BlobType: Short read FBlobType;
103	>	property BlobType: TBlobType read FBlobType;
104		property Database: TIBDatabase read GetDatabase write SetDatabase;
105	–	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
105		property Mode: TBlobStreamMode read FMode write SetMode;
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
112	–	procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments: Int64; var MaxSegmentSize,
113	–	TotalSize: Int64; var BlobType: Short);
114	–	function GetBlobCharSetID(hDB_Handle: TISC_DB_HANDLE; hTR_Handle: TISC_TR_HANDLE;
115	–	tableName, columnName: PChar): short;
116	–	procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
117	–	procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
118	–
112		implementation
113
114	<	uses IBIntf;
122	<
123	<	procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments: Int64; var MaxSegmentSize,
124	<	TotalSize: Int64; var BlobType: Short);
125	<	var
126	<	items: array[0..3] of Char;
127	<	results: array[0..99] of Char;
128	<	i, item_length: Integer;
129	<	item: Integer;
130	<	begin
131	<	items[0] := Char(isc_info_blob_num_segments);
132	<	items[1] := Char(isc_info_blob_max_segment);
133	<	items[2] := Char(isc_info_blob_total_length);
134	<	items[3] := Char(isc_info_blob_type);
135	<
136	<	if isc_blob_info(StatusVector, hBlobHandle, 4, @items[0], SizeOf(results),
137	<	@results[0]) > 0 then
138	<	IBDatabaseError;
139	<
140	<	i := 0;
141	<	while (i < SizeOf(results)) and (results[i] <> Char(isc_info_end)) do
142	<	begin
143	<	item := Integer(results[i]); Inc(i);
144	<	item_length := isc_vax_integer(@results[i], 2); Inc(i, 2);
145	<	case item of
146	<	isc_info_blob_num_segments:
147	<	NumSegments := isc_portable_integer(@results[i], item_length);
148	<	isc_info_blob_max_segment:
149	<	MaxSegmentSize := isc_portable_integer(@results[i], item_length);
150	<	isc_info_blob_total_length:
151	<	TotalSize := isc_portable_integer(@results[i], item_length);
152	<	isc_info_blob_type:
153	<	BlobType := isc_portable_integer(@results[i], item_length);
154	<	end;
155	<	Inc(i, item_length);
156	<	end;
157	<	end;
158	<
159	<	function GetBlobCharSetID(hDB_Handle: TISC_DB_HANDLE;
160	<	hTR_Handle: TISC_TR_HANDLE; tableName, columnName: PChar): short;
161	<	var desc: TISC_BLOB_DESC;
162	<	uGlobal: array [0..31] of char;
163	<	begin
164	<	if isc_blob_lookup_desc(StatusVector,@hDB_Handle,@hTR_Handle,
165	<	tableName,columnName,@desc,@uGlobal) > 0 then
166	<	IBDatabaseError;
167	<
168	<	Result := desc.blob_desc_charset;
169	<	end;
170	<
171	<	procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
172	<	var
173	<	CurPos: Int64;
174	<	BytesRead, SegLen: UShort;
175	<	LocalBuffer: PChar;
176	<	begin
177	<	CurPos := 0;
178	<	LocalBuffer := Buffer;
179	<	SegLen := UShort(DefaultBlobSegmentSize);
180	<	while (CurPos < BlobSize) do
181	<	begin
182	<	if (CurPos + SegLen > BlobSize) then
183	<	SegLen := BlobSize - CurPos;
184	<	if not ((isc_get_segment(StatusVector, hBlobHandle, @BytesRead, SegLen,
185	<	LocalBuffer) = 0) or
186	<	(StatusVectorArray[1] = isc_segment)) then
187	<	IBDatabaseError;
188	<	Inc(LocalBuffer, BytesRead);
189	<	Inc(CurPos, BytesRead);
190	<	BytesRead := 0;
191	<	end;
192	<	end;
193	<
194	<	procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar;
195	<	BlobSize: Int64);
196	<	var
197	<	CurPos: Int64;
198	<	SegLen: Long;
199	<	begin
200	<	CurPos := 0;
201	<	SegLen := DefaultBlobSegmentSize;
202	<	while (CurPos < BlobSize) do
203	<	begin
204	<	if (CurPos + SegLen > BlobSize) then
205	<	SegLen := BlobSize - CurPos;
206	<	if isc_put_segment(StatusVector, hBlobHandle, SegLen,
207	<	PChar(@Buffer[CurPos])) > 0 then
208	<	IBDatabaseError;
209	<	Inc(CurPos, SegLen);
210	<	end;
211	<	end;
212	<
114	>	uses FBMessages, IBCustomDataSet;
115
116		{ TIBBlobStream }
117		constructor TIBBlobStream.Create;
#	Line 219 | Line 121 | begin
121		FBuffer := nil;
122		FBlobSize := 0;
123		FBlobState := bsUninitialised;
124	+	FBlob := nil;
125		end;
126
127		destructor TIBBlobStream.Destroy;
128		begin
129	<	SetState(bsUninitialised);
129	>	CloseBlob;
130		FBase.Free;
131		SetSize(0);
132		inherited Destroy;
133		end;
134
232	–	function TIBBlobStream.Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
233	–	begin
234	–	result := 0;
235	–	if Transaction <> nil then
236	–	result := Transaction.Call(ErrCode, RaiseError)
237	–	else if RaiseError and (ErrCode > 0) then
238	–	IBDataBaseError;
239	–	end;
240	–
135		procedure TIBBlobStream.CheckReadable;
136		begin
137		if FMode = bmWrite then IBError(ibxeBlobCannotBeRead, [nil]);
#	Line 253 | Line 147 | begin
147		Result := FBlobState = bsModified;
148		end;
149
150	<	procedure TIBBlobStream.CloseBlob;
150	>	procedure TIBBlobStream.CheckActive;
151		begin
152	<	Finalize;
153	<	SetState(bsUninitialised);
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	<	procedure TIBBlobStream.CreateBlob;
167	>	function TIBBlobStream.GetBlobID: TISC_QUAD;
168		begin
169	<	CheckWritable;
170	<	FBlobID.gds_quad_high := 0;
171	<	FBlobID.gds_quad_low := 0;
172	<	SetState(bsData);
173	<	SetSize(0);
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 FBlobState = bsUninitialised 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	+	SetState(bsDataPending);
203	+	end;
204		end;
205
206		procedure TIBBlobStream.EnsureLoaded;
207		begin
208		EnsureBlobInitialized;
209	<	if FBlobState = bsDataPending then
209	>	if (FBlobState = bsDataPending) and (FBlob <> nil) then
210		begin
211		SetSize(FBlobSize);
212	<	try
296	<	IBBlob.ReadBlob(@FHandle, FBuffer, FBlobSize);
297	<	except
298	<	Call(isc_close_blob(StatusVector, @FHandle), False);
299	<	raise;
300	<	end;
212	>	FBlob.Read(FBuffer^, FBlobSize);
213		SetState(bsData);
214		end;
215		end;
#	Line 306 | Line 218 | procedure TIBBlobStream.Finalize;
218		begin
219		if FBlobState <> bsModified then
220		exit;
221	+	CheckWritable;
222		if FBlobSize > 0 then
223		begin
224		{ need to start writing to a blob, create one }
225	<	Call(isc_create_blob2(StatusVector, DBHandle, TRHandle, @FHandle, @FBlobID,
226	<	0, nil), True);
227	<	IBBlob.WriteBlob(@FHandle, FBuffer, FBlobSize);
315	<	Call(isc_close_blob(StatusVector, @FHandle), True);
316	<	end
317	<	else
318	<	begin
319	<	FBlobID.gds_quad_high := 0;
320	<	FBlobID.gds_quad_low := 0;
225	>	FBlob := Database.Attachment.CreateBlob(Transaction.TransactionIntf,RelationName,ColumnName);
226	>	FBlob.Write(FBuffer^, FBlobSize);
227	>	FBlob.Close;
228		end;
229		SetState(bsData);
230		end;
#	Line 326 | Line 233 | 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
#	Line 342 | Line 250 | begin
250		result := FBase.Database;
251		end;
252
345	–	function TIBBlobStream.GetDBHandle: PISC_DB_HANDLE;
346	–	begin
347	–	result := FBase.DBHandle;
348	–	end;
349	–
253		function TIBBlobStream.GetTransaction: TIBTransaction;
254		begin
255		result := FBase.Transaction;
256		end;
257
355	–	function TIBBlobStream.GetTRHandle: PISC_TR_HANDLE;
356	–	begin
357	–	result := FBase.TRHandle;
358	–	end;
359	–
258		procedure TIBBlobStream.LoadFromFile(Filename: string);
259		var
260		Stream: TStream;
#	Line 383 | Line 281 | end;
281		procedure TIBBlobStream.OpenBlob;
282		begin
283		CheckReadable;
386	–	Call(isc_open_blob2(StatusVector, DBHandle, TRHandle, @FHandle,
387	–	@FBlobID, 0, nil), True);
284		try
285		GetBlobInfo;
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		SetState(bsDataPending);
#	Line 399 | Line 295 | function TIBBlobStream.Read(var Buffer;
295		begin
296		CheckReadable;
297		EnsureLoaded;
298	<	if (Count <= 0) then
298	>	if Count <= 0 then
299		begin
300		result := 0;
301		exit;
#	Line 446 | 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	<	SetState(bsUninitialised);
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);
#	Line 468 | Line 377 | procedure TIBBlobStream.SetState(aValue:
377		begin
378		if FBlobState = aValue then Exit;
379
380	<	if FBlobState = bsDataPending then
381	<	Call(isc_close_blob(StatusVector, @FHandle), True);
380	>	if (FBlobState = bsDataPending) and (FBlob <> nil) then
381	>	FBlob.Close;
382
383		FBlobState := aValue;
384		end;

Diff Legend

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