ViewVC Help

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

root/public/ibx/branches/journaling/fbintf/client/2.5/FB25ClientAPI.pas

Comparing ibx/trunk/fbintf/client/2.5/FB25ClientAPI.pas (file contents):
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 308 by tony, Sat Jul 18 10:26:30 2020 UTC

#	Line 60 | Line 60
60		{                                                                        }
61		{************************************************************************}
62		unit FB25ClientAPI;
63	+	{$IFDEF MSWINDOWS}
64	+	{$DEFINE WINDOWS}
65	+	{$ENDIF}
66
67		{$IFDEF FPC}
68		{$mode delphi}
#	Line 92 | Line 95 | type
95		FStatusIntf: IStatus;   {Keep a reference to the interface - automatic destroy
96		when this class is freed and last reference to IStatus
97		goes out of scope.}
95	–	protected
96	–	{$IFDEF UNIX}
97	–	function GetFirebirdLibList: string; override;
98	–	{$ENDIF}
99	–	procedure LoadInterface; override;
98		public
99	<	constructor Create;
99	>	constructor Create(aFBLibrary: TFBLibrary);
100		destructor Destroy; override;
101		function StatusVector: PISC_STATUS;
102	+	function LoadInterface: boolean; override;
103	+	function GetAPI: IFirebirdAPI; override;
104	+	{$IFDEF UNIX}
105	+	function GetFirebirdLibList: string; override;
106	+	{$ENDIF}
107		property IBServiceAPIPresent: boolean read FIBServiceAPIPresent;
108		property Status: TFB25Status read FStatus;
109
#	Line 162 | Line 165 | type
165		isc_array_get_slice: Tisc_array_get_slice;
166		isc_array_put_slice: Tisc_array_put_slice;
167		isc_prepare_transaction: Tisc_prepare_transaction;
168	+	isc_version: Tisc_Version;
169	+	isc_interprete: Tisc_interprete;
170
171		public
172		{Helper Functions}
173	<	function DecodeInteger(bufptr: PChar; len: short): integer; override;
174	<	procedure SQLEncodeDate(aDate: TDateTime; bufptr: PChar); override;
175	<	function SQLDecodeDate(bufptr: PChar): TDateTime; override;
176	<	procedure SQLEncodeTime(aTime: TDateTime; bufptr: PChar); override;
177	<	function SQLDecodeTime(bufptr: PChar): TDateTime;  override;
178	<	procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar); override;
179	<	function SQLDecodeDateTime(bufptr: PChar): TDateTime; override;
180	<
173	>	function DecodeInteger(bufptr: PByte; len: short): integer; override;
174	>	procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); override;
175	>	function SQLDecodeDate(bufptr: PByte): TDateTime; override;
176	>	procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); override;
177	>	function SQLDecodeTime(bufptr: PByte): TDateTime;  override;
178	>	procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); override;
179	>	function SQLDecodeDateTime(bufptr: PByte): TDateTime; override;
180	>	function FormatStatus(Status: TFBStatus): AnsiString; override;
181		public
182		{IFirebirdAPI}
183
184		{Database connections}
185		function AllocateDPB: IDPB;
186	<	function OpenDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
187	<	function CreateDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment;  overload;
188	<	function CreateDatabase(sql: string; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
186	>	function OpenDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
187	>	function CreateDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment;  overload;
188	>	function CreateDatabase(sql: AnsiString; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
189
190		{Start Transaction against multiple databases}
191		function AllocateTPB: ITPB;
#	Line 192 | Line 197 | type
197		{Service Manager}
198		function AllocateSPB: ISPB;
199		function HasServiceAPI: boolean;
200	<	function GetServiceManager(ServerName: string; Protocol: TProtocol; SPB: ISPB): IServiceManager;
200	>	function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
201	>	function GetServiceManager(ServerName: AnsiString; Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
202
203		{Information}
204		function GetStatus: IStatus; override;
205		function HasRollbackRetaining: boolean;
206		function IsEmbeddedServer: boolean; override;
207	<	function GetImplementationVersion: string;
207	>	function GetClientMajor: integer; override;
208	>	function GetClientMinor: integer; override;
209
210		{Firebird 3 API}
211		function HasMasterIntf: boolean;
#	Line 206 | Line 213 | type
213
214		end;
215
209	–	const
210	–	Firebird25ClientAPI: TFB25ClientAPI = nil;
211	–
216		implementation
217
218	<	uses FBMessages, dynlibs, FB25Attachment, FB25Transaction, FB25Services, FBParamBlock,
218	>	uses FBMessages,
219	>	{$IFDEF WINDOWS}Windows, {$ENDIF}
220	>	{$IFDEF FPC} Dynlibs, {$ENDIF}
221	>	FB25Attachment, FB25Transaction, FB25Services, FBParamBlock,
222		IBUtils;
223
224		{ Stubs for 6.0 only functions }
#	Line 225 | Line 232 | end;
232
233		function isc_service_attach_stub(status_vector      : PISC_STATUS;
234		isc_arg2           : UShort;
235	<	isc_arg3           : PChar;
235	>	isc_arg3           : PAnsiChar;
236		service_handle     : PISC_SVC_HANDLE;
237		isc_arg5           : UShort;
238	<	isc_arg6           : PChar):
238	>	isc_arg6           : PAnsiChar):
239		ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
240		begin
241		Result := 0;
#	Line 247 | Line 254 | function isc_service_query_stub(status_v
254		service_handle       : PISC_SVC_HANDLE;
255		recv_handle          : PISC_SVC_HANDLE;
256		isc_arg4             : UShort;
257	<	isc_arg5             : PChar;
257	>	isc_arg5             : PAnsiChar;
258		isc_arg6             : UShort;
259	<	isc_arg7             : PChar;
259	>	isc_arg7             : PAnsiChar;
260		isc_arg8             : UShort;
261	<	isc_arg9             : PChar):
261	>	isc_arg9             : PAnsiChar):
262		ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
263		begin
264		Result := 0;
#	Line 262 | Line 269 | function isc_service_start_stub(status_v
269		service_handle       : PISC_SVC_HANDLE;
270		recv_handle          : PISC_SVC_HANDLE;
271		isc_arg4             : UShort;
272	<	isc_arg5             : PChar):
272	>	isc_arg5             : PAnsiChar):
273		ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
274		begin
275		Result := 0;
#	Line 316 | Line 323 | end;
323		threadvar
324		FStatusVector: TStatusVector;
325
326	+	{ TFB25ActivityReporter }
327	+
328		function TFB25Status.StatusVector: PStatusVector;
329		begin
330		Result := @FStatusVector;
#	Line 331 | Line 340 | begin
340		end;
341		{$ENDIF}
342
343	<	procedure TFB25ClientAPI.LoadInterface;
343	>	function TFB25ClientAPI.LoadInterface: boolean;
344		begin
345	<	inherited LoadInterface;
345	>	Result := inherited LoadInterface;
346		BLOB_get := GetProcAddr('BLOB_get'); {do not localize}
347		BLOB_put := GetProcAddr('BLOB_put'); {do not localize}
348		isc_wait_for_event := GetProcAddr('isc_wait_for_event'); {do not localize}
#	Line 378 | Line 387 | begin
387		isc_array_get_slice := GetProcAddr('isc_array_get_slice'); {do not localize}
388		isc_array_put_slice := GetProcAddr('isc_array_put_slice'); {do not localize}
389		isc_prepare_transaction  := GetProcAddr('isc_prepare_transaction'); {do not localize}
390	+	isc_version  := GetProcAddr('isc_version'); {do not localize}
391	+	isc_interprete := GetProcAddr('isc_interprete'); {do not localize}
392
393		FIBServiceAPIPresent := true;
394	<	isc_rollback_retaining := GetProcAddress(IBLibrary, 'isc_rollback_retaining'); {do not localize}
394	>	isc_rollback_retaining := GetProcAddress(FFBLibrary.IBLibrary, 'isc_rollback_retaining'); {do not localize}
395		if Assigned(isc_rollback_retaining) then
396		begin
397		isc_service_attach := GetProcAddr('isc_service_attach'); {do not localize}
#	Line 408 | Line 419 | begin
419		isc_encode_sql_time := @isc_encode_sql_time_stub;
420		isc_encode_timestamp := @isc_encode_timestamp_stub;
421		end;
422	+	Result := Result and assigned(isc_attach_database);
423	+	end;
424	+
425	+	function TFB25ClientAPI.GetAPI: IFirebirdAPI;
426	+	begin
427	+	Result := self;
428		end;
429
430	<	constructor TFB25ClientAPI.Create;
430	>	constructor TFB25ClientAPI.Create(aFBLibrary: TFBLibrary);
431		begin
432	<	inherited;
432	>	inherited Create(aFBLibrary);
433		FStatus := TFB25Status.Create(self);
434		FStatusIntf := FStatus;
418	–	Firebird25ClientAPI := self;
435		end;
436
437		destructor TFB25ClientAPI.Destroy;
438		begin
439		FStatusIntf := nil;
424	–	Firebird25ClientAPI := nil;
440		inherited Destroy;
441		end;
442
#	Line 438 | Line 453 | end;
453
454		function TFB25ClientAPI.AllocateDPB: IDPB;
455		begin
456	<	Result := TDPB.Create;
456	>	Result := TDPB.Create(self);
457		end;
458
459	<	function TFB25ClientAPI.OpenDatabase(DatabaseName: string; DPB: IDPB;
459	>	function TFB25ClientAPI.OpenDatabase(DatabaseName: AnsiString; DPB: IDPB;
460		RaiseExceptionOnConnectError: boolean): IAttachment;
461		begin
462	<	Result := TFB25Attachment.Create(DatabaseName,DPB,RaiseExceptionOnConnectError);
462	>	Result := TFB25Attachment.Create(self,DatabaseName,DPB,RaiseExceptionOnConnectError);
463		if not Result.IsConnected then
464		Result := nil;
465		end;
466
467	<	function TFB25ClientAPI.CreateDatabase(DatabaseName: string; DPB: IDPB;
467	>	function TFB25ClientAPI.CreateDatabase(DatabaseName: AnsiString; DPB: IDPB;
468		RaiseExceptionOnError: boolean): IAttachment;
469		begin
470	<	Result := TFB25Attachment.CreateDatabase(DatabaseName, DPB, RaiseExceptionOnError );
470	>	Result := TFB25Attachment.CreateDatabase(self,DatabaseName, DPB, RaiseExceptionOnError );
471		if (Result <> nil) and not Result.IsConnected then
472		Result := nil;
473		end;
474
475	<	function TFB25ClientAPI.CreateDatabase(sql: string; aSQLDialect: integer;
475	>	function TFB25ClientAPI.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
476		RaiseExceptionOnError: boolean): IAttachment;
477		begin
478	<	Result := TFB25Attachment.CreateDatabase(sql,aSQLDialect, RaiseExceptionOnError );
478	>	Result := TFB25Attachment.CreateDatabase(self,sql,aSQLDialect, RaiseExceptionOnError );
479		if (Result <> nil) and not Result.IsConnected then
480		Result := nil;
481		end;
482
483		function TFB25ClientAPI.AllocateSPB: ISPB;
484		begin
485	<	Result := TSPB.Create;
485	>	Result := TSPB.Create(self);
486		end;
487
488		function TFB25ClientAPI.AllocateTPB: ITPB;
489		begin
490	<	Result := TTPB.Create;
490	>	Result := TTPB.Create(self);
491		end;
492
493	<	function TFB25ClientAPI.GetServiceManager(ServerName: string;
493	>	function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString;
494		Protocol: TProtocol; SPB: ISPB): IServiceManager;
495		begin
496		if HasServiceAPI then
497	<	Result := TFB25ServiceManager.Create(ServerName,Protocol,SPB)
497	>	Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB)
498	>	else
499	>	Result := nil;
500	>	end;
501	>
502	>	function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString;
503	>	Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager;
504	>	begin
505	>	if HasServiceAPI then
506	>	Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB,Port)
507		else
508		Result := nil;
509		end;
#	Line 487 | Line 511 | end;
511		function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
512		TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction;
513		begin
514	<	Result := TFB25Transaction.Create(Attachments,TPB,DefaultCompletion);
514	>	Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion);
515		end;
516
517		function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
518		TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction;
519		begin
520	<	Result := TFB25Transaction.Create(Attachments,TPB,DefaultCompletion);
520	>	Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion);
521		end;
522
523		function TFB25ClientAPI.HasServiceAPI: boolean;
#	Line 510 | Line 534 | function TFB25ClientAPI.IsEmbeddedServer
534		begin
535		Result := false;
536		{$IFDEF UNIX}
537	<	Result := Pos('libfbembed',FFBLibraryName) = 1;
537	>	Result := Pos('libfbembed',FFBLibrary.GetLibraryName) = 1;
538		{$ENDIF}
539		{$IFDEF WINDOWS}
540	<	Result := CompareText(FFBLibraryName,FIREBIRD_EMBEDDED) = 0;
540	>	Result := CompareText(FFBLibrary.GetLibraryName,FIREBIRD_EMBEDDED) = 0;
541		{$ENDIF}
542		end;
543
544	+	function TFB25ClientAPI.GetClientMajor: integer;
545	+	begin
546	+	Result := 2;
547	+	end;
548	+
549	+	function TFB25ClientAPI.GetClientMinor: integer;
550	+	begin
551	+	Result := 5;
552	+	end;
553	+
554		function TFB25ClientAPI.HasMasterIntf: boolean;
555		begin
556		Result := false;
#	Line 527 | Line 561 | begin
561		Result := nil;
562		end;
563
564	<	function TFB25ClientAPI.GetImplementationVersion: string;
531	<	begin
532	<	Result := FBClientInterfaceVersion;
533	<	end;
534	<
535	<	function TFB25ClientAPI.DecodeInteger(bufptr: PChar; len: short): integer;
564	>	function TFB25ClientAPI.DecodeInteger(bufptr: PByte; len: short): integer;
565		begin
566		Result := isc_portable_integer(bufptr,len);
567		end;
568
569	<	procedure TFB25ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PChar);
569	>	procedure TFB25ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PByte);
570		var
571		tm_date: TCTimeStructure;
572		Yr, Mn, Dy: Word;
#	Line 554 | Line 583 | begin
583		isc_encode_sql_date(@tm_date, PISC_DATE(bufptr));
584		end;
585
586	<	function TFB25ClientAPI.SQLDecodeDate(bufptr: PChar): TDateTime;
586	>	function TFB25ClientAPI.SQLDecodeDate(bufptr: PByte): TDateTime;
587		var
588		tm_date: TCTimeStructure;
589		begin
#	Line 569 | Line 598 | begin
598		end;
599		end;
600
601	<	procedure TFB25ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PChar);
601	>	procedure TFB25ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PByte);
602		var
603		tm_date: TCTimeStructure;
604		Hr, Mt, S, Ms: Word;
#	Line 583 | Line 612 | begin
612		tm_mon := 0;
613		tm_year := 0;
614		end;
615	<	with Firebird25ClientAPI do
587	<	isc_encode_sql_time(@tm_date, PISC_TIME(bufptr));
615	>	isc_encode_sql_time(@tm_date, PISC_TIME(bufptr));
616		if Ms > 0 then
617		Inc(PISC_TIME(bufptr)^,Ms*10);
618		end;
619
620	<	function TFB25ClientAPI.SQLDecodeTime(bufptr: PChar): TDateTime;
620	>	function TFB25ClientAPI.SQLDecodeTime(bufptr: PByte): TDateTime;
621		var
622		tm_date: TCTimeStructure;
623		msecs: Word;
#	Line 606 | Line 634 | begin
634		end;
635		end;
636
637	<	procedure TFB25ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar);
637	>	procedure TFB25ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte);
638		var
639		tm_date: TCTimeStructure;
640		Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
#	Line 626 | Line 654 | begin
654		Inc(PISC_TIMESTAMP(bufptr)^.timestamp_time,Ms*10);
655		end;
656
657	<	function TFB25ClientAPI.SQLDecodeDateTime(bufptr: PChar): TDateTime;
657	>	function TFB25ClientAPI.SQLDecodeDateTime(bufptr: PByte): TDateTime;
658		var
659		tm_date: TCTimeStructure;
660		msecs: Word;
#	Line 649 | Line 677 | begin
677		end;
678		end;
679
680	+	function TFB25ClientAPI.FormatStatus(Status: TFBStatus): AnsiString;
681	+	var psb: PStatusVector;
682	+	local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
683	+	begin
684	+	psb := Status.StatusVector;
685	+	Result := '';
686	+	while isc_interprete(@local_buffer,@psb) > 0 do
687	+	begin
688	+	if (Result <> '') and (Result[Length(Result)] <> LF) then
689	+	Result := Result + LineEnding + '-';
690	+	Result := Result + strpas(local_buffer);
691	+	end;
692	+	end;
693	+
694		end.
695
696	+

Diff Legend

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