[ViewVC] Diff of: public/ibx/branches/journaling/fbintf/client/3.0/FB30Attachment.pas

Comparing ibx/trunk/fbintf/client/3.0/FB30Attachment.pas (file contents):
Revision 117 by tony, Mon Jan 22 13:58:11 2018 UTC vs.
Revision 353 by tony, Sat Oct 23 14:11:37 2021 UTC

#	Line 37 \| Line 37 \| unit FB30Attachment;
37		interface
38
39		uses
40	<	Classes, SysUtils, FBAttachment, FB30ClientAPI, Firebird, IB, FBActivityMonitor, FBParamBlock;
40	>	Classes, SysUtils, FBAttachment, FBClientAPI, FB30ClientAPI, Firebird, IB,
41	>	FBActivityMonitor, FBParamBlock;
42
43		type
44
#	Line 46 \| Line 47 \| type
47		TFB30Attachment = class(TFBAttachment,IAttachment, IActivityMonitor)
48		private
49		FAttachmentIntf: Firebird.IAttachment;
50	+	FFirebird30ClientAPI: TFB30ClientAPI;
51	+	FTimeZoneServices: ITimeZoneServices;
52	+	FUsingRemoteICU: boolean;
53	+	procedure SetUseRemoteICU(aValue: boolean);
54		protected
55		procedure CheckHandle; override;
56		public
57	<	constructor Create(DatabaseName: AnsiString; aDPB: IDPB;
57	>	constructor Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
58		RaiseExceptionOnConnectError: boolean);
59	<	constructor CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
60	<	constructor CreateDatabase(sql: AnsiString; aSQLDialect: integer;
59	>	constructor CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
60	>	constructor CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
61		RaiseExceptionOnError: boolean); overload;
62		destructor Destroy; override;
63	+	function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
64	+	override;
65		property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
66	+	property Firebird30ClientAPI: TFB30ClientAPI read FFirebird30ClientAPI;
67
68		public
69		{IAttachment}
#	Line 66 \| Line 74 \| type
74		function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
75		function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
76		procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
77	<	function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; override;
77	>	function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; override;
78		function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
79	<	aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
79	>	aSQLDialect: integer; GenerateParamNames: boolean=false;
80	>	CaseSensitiveParams: boolean=false; CursorName: AnsiString=''): IStatement; override;
81
82		{Events}
83		function GetEventHandler(Events: TStrings): IEvents; override;
84
85		{Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
86
87	<	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
79	<	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
87	>	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; override;
88		function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
81	–	function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
89		function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; override;
90
91		{Array}
92	<	function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
93	<	function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
87	<	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
92	>	function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; override;
93	>	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; override;
94		function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
95		columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
96	<	dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
96	>	dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
97
98
99		{Database Information}
100	<	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
101	<	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
102	<	function GetDBInformation(Requests: array of byte): IDBInformation; overload; override;
103	<	function GetDBInformation(Request: byte): IDBInformation; overload; override;
100	>	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; override;
101	>	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; override;
102	>	procedure getFBVersion(version: TStrings);
103	>	function HasDecFloatSupport: boolean; override;
104	>	function HasBatchMode: boolean; override;
105	>	function HasScollableCursors: boolean;
106	>
107	>	{Time Zone Support}
108	>	function GetTimeZoneServices: ITimeZoneServices; override;
109	>	function HasTimeZoneSupport: boolean; override;
110		end;
111
112		implementation
113
114		uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
115	<	FBOutputBlock, FB30Events, IBUtils;
115	>	FBOutputBlock, FB30Events, IBUtils, FB30TimeZoneServices;
116	>
117	>	type
118	>	{ TVersionCallback }
119	>
120	>	TVersionCallback = class(Firebird.IVersionCallbackImpl)
121	>	private
122	>	FOutput: TStrings;
123	>	FFirebirdClientAPI: TFBClientAPI;
124	>	public
125	>	constructor Create(FirebirdClientAPI: TFBClientAPI; output: TStrings);
126	>	procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
127	>	end;
128	>
129	>	{ TVersionCallback }
130	>
131	>	constructor TVersionCallback.Create(FirebirdClientAPI: TFBClientAPI;
132	>	output: TStrings);
133	>	begin
134	>	inherited Create;
135	>	FFirebirdClientAPI := FirebirdClientAPI;
136	>	FOutput := output;
137	>	end;
138	>
139	>	procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
140	>	var StatusObj: TFB30StatusObject;
141	>	begin
142	>	if ((status.getState and status.STATE_ERRORS) <> 0) then
143	>	begin
144	>	StatusObj := TFB30StatusObject.Create(FFirebirdClientAPI,status);
145	>	try
146	>	raise EIBInterBaseError.Create(StatusObj);
147	>	finally
148	>	StatusObj.Free;
149	>	end;
150	>	end;
151	>	FOutput.Add(text);
152	>	end;
153	>
154
155		{ TFB30Attachment }
156
157	+	procedure TFB30Attachment.SetUseRemoteICU(aValue: boolean);
158	+	begin
159	+	if (FUsingRemoteICU <> aValue) and (GetODSMajorVersion >= 13) then
160	+	begin
161	+	if aValue then
162	+	ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO EXTENDED')
163	+	else
164	+	ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO NATIVE');
165	+	FUsingRemoteICU := aValue;
166	+	end;
167	+	end;
168	+
169		procedure TFB30Attachment.CheckHandle;
170		begin
171		if FAttachmentIntf = nil then
172		IBError(ibxeDatabaseClosed,[nil]);
173		end;
174
175	<	constructor TFB30Attachment.Create(DatabaseName: AnsiString; aDPB: IDPB;
175	>	constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
176		RaiseExceptionOnConnectError: boolean);
177		begin
178	+	FFirebird30ClientAPI := api;
179		if aDPB = nil then
180		begin
181		if RaiseExceptionOnConnectError then
182		IBError(ibxeNoDPB,[nil]);
183		Exit;
184		end;
185	<	inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
185	>	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
186		Connect;
187		end;
188
189	<	constructor TFB30Attachment.CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB;
189	>	constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
190		RaiseExceptionOnError: boolean);
191		var Param: IDPBItem;
192		sql: AnsiString;
193		IsCreateDB: boolean;
194		begin
195	<	inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
195	>	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
196	>	FFirebird30ClientAPI := api;
197		IsCreateDB := true;
198		if aDPB <> nil then
199		begin
#	Line 138 \| Line 202 \| begin
202		FSQLDialect := Param.AsByte;
203		end;
204		sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
205	<	with Firebird30ClientAPI do
205	>	with FFirebird30ClientAPI do
206		begin
207		FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
208		PAnsiChar(sql),FSQLDialect,@IsCreateDB);
#	Line 157 \| Line 221 \| begin
221		end;
222		end;
223
224	<	constructor TFB30Attachment.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
224	>	constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
225		RaiseExceptionOnError: boolean);
226		var IsCreateDB: boolean;
227		begin
228	<	inherited Create('',nil,RaiseExceptionOnError);
228	>	inherited Create(api,'',nil,RaiseExceptionOnError);
229	>	FFirebird30ClientAPI := api;
230		FSQLDialect := aSQLDialect;
231	<	with Firebird30ClientAPI do
231	>	with FFirebird30ClientAPI do
232		begin
233		FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
234		PAnsiChar(sql),aSQLDialect,@IsCreateDB);
#	Line 183 \| Line 248 \| begin
248		FAttachmentIntf.release;
249		end;
250
251	+	function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
252	+	begin
253	+	Result := TDBInformation.Create(Firebird30ClientAPI);
254	+	with FFirebird30ClientAPI, Result as TDBInformation do
255	+	begin
256	+	FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
257	+	getBufSize, BytePtr(Buffer));
258	+	Check4DataBaseError;
259	+	end
260	+	end;
261	+
262		procedure TFB30Attachment.Connect;
263		begin
264	<	with Firebird30ClientAPI do
264	>	with FFirebird30ClientAPI do
265		begin
266		FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
267		(DPB as TDPB).getDataLength,
#	Line 195 \| Line 271 \| begin
271		FAttachmentIntf := nil
272		else
273		GetODSAndConnectionInfo;
274	+
275		end;
276		end;
277
278		procedure TFB30Attachment.Disconnect(Force: boolean);
279		begin
280		if IsConnected then
281	<	with Firebird30ClientAPI do
281	>	with FFirebird30ClientAPI do
282		begin
283		EndAllTransactions;
284		FAttachmentIntf.Detach(StatusIntf);
#	Line 211 \| Line 288 \| begin
288		FHasDefaultCharSet := false;
289		FCodePage := CP_NONE;
290		FCharSetID := 0;
291	+	FTimeZoneServices := nil;
292		end;
293		end;
294
#	Line 222 \| Line 300 \| end;
300		procedure TFB30Attachment.DropDatabase;
301		begin
302		if IsConnected then
303	<	with Firebird30ClientAPI do
303	>	with FFirebird30ClientAPI do
304		begin
305		EndAllTransactions;
306		FAttachmentIntf.dropDatabase(StatusIntf);
#	Line 235 \| Line 313 \| function TFB30Attachment.StartTransactio
313		DefaultCompletion: TTransactionCompletion): ITransaction;
314		begin
315		CheckHandle;
316	<	Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
316	>	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
317		end;
318
319		function TFB30Attachment.StartTransaction(TPB: ITPB;
320		DefaultCompletion: TTransactionCompletion): ITransaction;
321		begin
322		CheckHandle;
323	<	Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
323	>	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
324		end;
325
326		procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
327		aSQLDialect: integer);
328		begin
329		CheckHandle;
330	<	with Firebird30ClientAPI do
330	>	with FFirebird30ClientAPI do
331		begin
332		FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
333		Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
#	Line 258 \| Line 336 \| begin
336		end;
337
338		function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
339	<	aSQLDialect: integer): IStatement;
339	>	aSQLDialect: integer; CursorName: AnsiString): IStatement;
340		begin
341		CheckHandle;
342	<	Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect);
342	>	Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect,CursorName);
343		end;
344
345		function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
346	<	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
346	>	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
347	>	CaseSensitiveParams: boolean; CursorName: AnsiString): IStatement;
348		begin
349		CheckHandle;
350		Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
351	<	GenerateParamNames);
351	>	GenerateParamNames,CaseSensitiveParams,CursorName);
352		end;
353
354		function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
#	Line 278 \| Line 357 \| begin
357		Result := TFB30Events.Create(self,Events);
358		end;
359
281	–	function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
282	–	ColumnName: AnsiString; BPB: IBPB): IBlob;
283	–	begin
284	–	CheckHandle;
285	–	Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
286	–	TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),BPB);
287	–	end;
288	–
360		function TFB30Attachment.CreateBlob(transaction: ITransaction;
361		BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
362		begin
#	Line 300 \| Line 371 \| begin
371		Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
372		end;
373
303	–	function TFB30Attachment.OpenBlob(transaction: ITransaction; RelationName,
304	–	ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
305	–	begin
306	–	CheckHandle;
307	–	Result := TFB30Blob.Create(self,transaction as TFB30transaction,
308	–	TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),
309	–	BlobID,BPB);
310	–	end;
311	–
374		function TFB30Attachment.OpenBlob(transaction: ITransaction;
375		BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
376		begin
#	Line 316 \| Line 378 \| begin
378		Result := TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
379		end;
380
381	<	function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
382	<	ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
381	>	function TFB30Attachment.OpenArray(transaction: ITransaction;
382	>	ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray;
383		begin
384		CheckHandle;
385		Result := TFB30Array.Create(self,transaction as TFB30Transaction,
386	<	GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
325	<	end;
326	<
327	<	function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
328	<	ColumnName: AnsiString): IArray;
329	<	begin
330	<	CheckHandle;
331	<	Result := TFB30Array.Create(self,transaction as TFB30Transaction,
332	<	GetArrayMetaData(transaction,RelationName,ColumnName));
386	>	ArrayMetaData,ArrayID);
387		end;
388
389		function TFB30Attachment.CreateArray(transaction: ITransaction;
#	Line 360 \| Line 414 \| begin
414		Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
415		end;
416
417	<	function TFB30Attachment.GetDBInformation(Requests: array of byte
418	<	): IDBInformation;
365	<	var ReqBuffer: PByte;
366	<	i: integer;
417	>	procedure TFB30Attachment.getFBVersion(version: TStrings);
418	>	var bufferObj: TVersionCallback;
419		begin
420	<	CheckHandle;
421	<	if Length(Requests) = 1 then
422	<	Result := GetDBInformation(Requests[0])
423	<	else
424	<	begin
425	<	Result := TDBInformation.Create;
426	<	GetMem(ReqBuffer,Length(Requests));
375	<	try
376	<	for i := 0 to Length(Requests) - 1 do
377	<	ReqBuffer[i] := Requests[i];
378	<
379	<	with Firebird30ClientAPI, Result as TDBInformation do
380	<	begin
381	<	FAttachmentIntf.getInfo(StatusIntf, Length(Requests), BytePtr(ReqBuffer),
382	<	getBufSize, BytePtr(Buffer));
383	<	Check4DataBaseError;
384	<	end
385	<
386	<	finally
387	<	FreeMem(ReqBuffer);
420	>	version.Clear;
421	>	bufferObj := TVersionCallback.Create(Firebird30ClientAPI,version);
422	>	try
423	>	with FFirebird30ClientAPI do
424	>	begin
425	>	UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
426	>	Check4DataBaseError;
427		end;
428	+	finally
429	+	bufferObj.Free;
430		end;
431		end;
432
433	<	function TFB30Attachment.GetDBInformation(Request: byte): IDBInformation;
433	>	function TFB30Attachment.HasDecFloatSupport: boolean;
434		begin
435	<	CheckHandle;
436	<	Result := TDBInformation.Create;
437	<	with Firebird30ClientAPI, Result as TDBInformation do
438	<	begin
439	<	FAttachmentIntf.getInfo(StatusIntf, 1, BytePtr(@Request),
440	<	getBufSize, BytePtr(Buffer));
441	<	Check4DataBaseError;
442	<	end;
435	>	Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
436	>	(GetODSMajorVersion >= 13);
437	>	end;
438	>
439	>	function TFB30Attachment.HasBatchMode: boolean;
440	>	begin
441	>	Result := FFirebird30ClientAPI.Firebird4orLater and
442	>	(GetODSMajorVersion >= 13);
443	>	end;
444	>
445	>	function TFB30Attachment.HasScollableCursors: boolean;
446	>	begin
447	>	Result := (GetODSMajorVersion >= 12) and (Trim(GetRemoteProtocol) = '');
448	>	end;
449	>
450	>	function TFB30Attachment.GetTimeZoneServices: ITimeZoneServices;
451	>	begin
452	>	if not HasTimeZoneSupport then
453	>	IBError(ibxeNotSupported,[]);
454	>
455	>	if FTimeZoneServices = nil then
456	>	FTimeZoneServices := TFB30TimeZoneServices.Create(self);
457	>	Result := FTimeZoneServices;
458	>	end;
459	>
460	>	function TFB30Attachment.HasTimeZoneSupport: boolean;
461	>	begin
462	>	Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
463	>	(GetODSMajorVersion >= 13);
464		end;
465
466		end.

Diff Legend

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

Comparing ibx/trunk/fbintf/client/3.0/FB30Attachment.pas (file contents): Revision 117 by tony, Mon Jan 22 13:58:11 2018 UTC vs. Revision 353 by tony, Sat Oct 23 14:11:37 2021 UTC

Diff Legend

Comparing ibx/trunk/fbintf/client/3.0/FB30Attachment.pas (file contents):
Revision 117 by tony, Mon Jan 22 13:58:11 2018 UTC vs.
Revision 353 by tony, Sat Oct 23 14:11:37 2021 UTC