ViewVC Help

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

root/public/ibx/branches/journaling/fbintf/client/3.0/FB30Attachment.pas

Comparing:
ibx/trunk/fbintf/client/3.0/FB30Attachment.pas (file contents), Revision 266 by tony, Wed Dec 26 18:34:32 2018 UTC vs.
ibx/branches/journaling/fbintf/client/3.0/FB30Attachment.pas (file contents), Revision 363 by tony, Tue Dec 7 13:30:05 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 47 | Line 48 | type
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	+	function GetAttachment: IAttachment; override;
57		public
58		constructor Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
59		RaiseExceptionOnConnectError: boolean);
#	Line 67 | Line 72 | type
72		procedure Disconnect(Force: boolean=false); override;
73		function IsConnected: boolean; override;
74		procedure DropDatabase;
75	<	function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
76	<	function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
75	>	function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion; aName: AnsiString=''): ITransaction; override;
76	>	function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion; aName: AnsiString=''): ITransaction; override;
77		procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
78	<	function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; override;
78	>	function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; override;
79		function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
80	<	aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
80	>	aSQLDialect: integer; GenerateParamNames: boolean=false;
81	>	CaseSensitiveParams: boolean=false; CursorName: AnsiString=''): IStatement; override;
82
83		{Events}
84		function GetEventHandler(Events: TStrings): IEvents; override;
85
86		{Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
87
88	<	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
83	<	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
88	>	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; override;
89		function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
85	–	function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
90		function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;  overload; override;
91
92		{Array}
93	<	function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
94	<	function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
91	<	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
93	>	function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; override;
94	>	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; override;
95		function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
96		columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
97		dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
98
99
100		{Database Information}
101	<	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
102	<	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
101	>	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; override;
102	>	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; override;
103		procedure getFBVersion(version: TStrings);
104	+	function HasDecFloatSupport: boolean; override;
105	+	function HasBatchMode: boolean; override;
106	+	function HasScollableCursors: boolean;
107	+
108	+	{Time Zone Support}
109	+	function GetTimeZoneServices: ITimeZoneServices; override;
110	+	function HasTimeZoneSupport: boolean; override;
111		end;
112
113		implementation
114
115		uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
116	<	FBOutputBlock, FB30Events, IBUtils;
116	>	FBOutputBlock, FB30Events, IBUtils, FB30TimeZoneServices;
117
118		type
119		{ TVersionCallback }
#	Line 111 | Line 121 | type
121		TVersionCallback = class(Firebird.IVersionCallbackImpl)
122		private
123		FOutput: TStrings;
124	+	FFirebirdClientAPI: TFBClientAPI;
125		public
126	<	constructor Create(output: TStrings);
126	>	constructor Create(FirebirdClientAPI: TFBClientAPI; output: TStrings);
127		procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
128		end;
129
130		{ TVersionCallback }
131
132	<	constructor TVersionCallback.Create(output: TStrings);
132	>	constructor TVersionCallback.Create(FirebirdClientAPI: TFBClientAPI;
133	>	output: TStrings);
134		begin
135		inherited Create;
136	+	FFirebirdClientAPI := FirebirdClientAPI;
137		FOutput := output;
138		end;
139
140		procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
141	+	var StatusObj: TFB30StatusObject;
142		begin
143	+	if ((status.getState and status.STATE_ERRORS) <> 0) then
144	+	begin
145	+	StatusObj := TFB30StatusObject.Create(FFirebirdClientAPI,status);
146	+	try
147	+	raise EIBInterBaseError.Create(StatusObj);
148	+	finally
149	+	StatusObj.Free;
150	+	end;
151	+	end;
152		FOutput.Add(text);
153		end;
154
155
156		{ TFB30Attachment }
157
158	+	procedure TFB30Attachment.SetUseRemoteICU(aValue: boolean);
159	+	begin
160	+	if (FUsingRemoteICU <> aValue) and (GetODSMajorVersion >= 13) then
161	+	begin
162	+	if aValue then
163	+	ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO EXTENDED')
164	+	else
165	+	ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO NATIVE');
166	+	FUsingRemoteICU := aValue;
167	+	end;
168	+	end;
169	+
170		procedure TFB30Attachment.CheckHandle;
171		begin
172		if FAttachmentIntf = nil then
173		IBError(ibxeDatabaseClosed,[nil]);
174		end;
175
176	+	function TFB30Attachment.GetAttachment: IAttachment;
177	+	begin
178	+	Result := self;
179	+	end;
180	+
181		constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
182		RaiseExceptionOnConnectError: boolean);
183		begin
#	Line 237 | Line 277 | begin
277		FAttachmentIntf := nil
278		else
279		GetODSAndConnectionInfo;
280	+
281		end;
282		end;
283
284		procedure TFB30Attachment.Disconnect(Force: boolean);
285		begin
286	+	inherited Disconnect(Force);
287		if IsConnected then
288		with FFirebird30ClientAPI do
289		begin
#	Line 253 | Line 295 | begin
295		FHasDefaultCharSet := false;
296		FCodePage := CP_NONE;
297		FCharSetID := 0;
298	+	FTimeZoneServices := nil;
299		end;
300		end;
301
#	Line 267 | Line 310 | begin
310		with FFirebird30ClientAPI do
311		begin
312		EndAllTransactions;
313	+	EndSession(false);
314		FAttachmentIntf.dropDatabase(StatusIntf);
315		Check4DataBaseError;
316		FAttachmentIntf := nil;
#	Line 274 | Line 318 | begin
318		end;
319
320		function TFB30Attachment.StartTransaction(TPB: array of byte;
321	<	DefaultCompletion: TTransactionCompletion): ITransaction;
321	>	DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction;
322		begin
323		CheckHandle;
324	<	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
324	>	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion, aName);
325		end;
326
327		function TFB30Attachment.StartTransaction(TPB: ITPB;
328	<	DefaultCompletion: TTransactionCompletion): ITransaction;
328	>	DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction;
329		begin
330		CheckHandle;
331	<	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
331	>	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion,aName);
332		end;
333
334		procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
#	Line 300 | Line 344 | begin
344		end;
345
346		function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
347	<	aSQLDialect: integer): IStatement;
347	>	aSQLDialect: integer; CursorName: AnsiString): IStatement;
348		begin
349		CheckHandle;
350	<	Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect);
350	>	Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect,CursorName);
351		end;
352
353		function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
354	<	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
354	>	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
355	>	CaseSensitiveParams: boolean; CursorName: AnsiString): IStatement;
356		begin
357		CheckHandle;
358		Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
359	<	GenerateParamNames);
359	>	GenerateParamNames,CaseSensitiveParams,CursorName);
360		end;
361
362		function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
#	Line 320 | Line 365 | begin
365		Result := TFB30Events.Create(self,Events);
366		end;
367
323	–	function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
324	–	ColumnName: AnsiString; BPB: IBPB): IBlob;
325	–	begin
326	–	CheckHandle;
327	–	Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
328	–	TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),BPB);
329	–	end;
330	–
368		function TFB30Attachment.CreateBlob(transaction: ITransaction;
369		BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
370		begin
#	Line 342 | Line 379 | begin
379		Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
380		end;
381
345	–	function TFB30Attachment.OpenBlob(transaction: ITransaction; RelationName,
346	–	ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
347	–	begin
348	–	CheckHandle;
349	–	Result := TFB30Blob.Create(self,transaction as TFB30transaction,
350	–	TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),
351	–	BlobID,BPB);
352	–	end;
353	–
382		function TFB30Attachment.OpenBlob(transaction: ITransaction;
383		BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
384		begin
#	Line 358 | Line 386 | begin
386		Result :=  TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
387		end;
388
389	<	function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
390	<	ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
363	<	begin
364	<	CheckHandle;
365	<	Result := TFB30Array.Create(self,transaction as TFB30Transaction,
366	<	GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
367	<	end;
368	<
369	<	function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
370	<	ColumnName: AnsiString): IArray;
389	>	function TFB30Attachment.OpenArray(transaction: ITransaction;
390	>	ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray;
391		begin
392		CheckHandle;
393		Result := TFB30Array.Create(self,transaction as TFB30Transaction,
394	<	GetArrayMetaData(transaction,RelationName,ColumnName));
394	>	ArrayMetaData,ArrayID);
395		end;
396
397		function TFB30Attachment.CreateArray(transaction: ITransaction;
#	Line 405 | Line 425 | end;
425		procedure TFB30Attachment.getFBVersion(version: TStrings);
426		var bufferObj: TVersionCallback;
427		begin
428	<	bufferObj := TVersionCallback.Create(version);
428	>	version.Clear;
429	>	bufferObj := TVersionCallback.Create(Firebird30ClientAPI,version);
430		try
431		with FFirebird30ClientAPI do
432	+	begin
433		UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
434	+	Check4DataBaseError;
435	+	end;
436		finally
437		bufferObj.Free;
438		end;
439		end;
440
441	+	function TFB30Attachment.HasDecFloatSupport: boolean;
442	+	begin
443	+	Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
444	+	(GetODSMajorVersion >= 13);
445	+	end;
446	+
447	+	function TFB30Attachment.HasBatchMode: boolean;
448	+	begin
449	+	Result := FFirebird30ClientAPI.Firebird4orLater and
450	+	(GetODSMajorVersion >= 13);
451	+	end;
452	+
453	+	function TFB30Attachment.HasScollableCursors: boolean;
454	+	begin
455	+	Result := (GetODSMajorVersion >= 12);
456	+	end;
457	+
458	+	function TFB30Attachment.GetTimeZoneServices: ITimeZoneServices;
459	+	begin
460	+	if not HasTimeZoneSupport then
461	+	IBError(ibxeNotSupported,[]);
462	+
463	+	if FTimeZoneServices = nil then
464	+	FTimeZoneServices := TFB30TimeZoneServices.Create(self);
465	+	Result := FTimeZoneServices;
466	+	end;
467	+
468	+	function TFB30Attachment.HasTimeZoneSupport: boolean;
469	+	begin
470	+	Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
471	+	(GetODSMajorVersion >= 13);
472	+	end;
473	+
474		end.
475

Diff Legend

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