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 345 by tony, Mon Aug 23 14:22:29 2021 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 71 | Line 74 | interface
74		uses
75		Classes, SysUtils, FBClientAPI, IBHeader, IBExternals, IB;
76
74	–	const
75	–	FBClientInterfaceVersion = '2.5';
76	–
77		type
78
79		{ TFB25Status }
#	Line 92 | Line 92 | type
92		FStatusIntf: IStatus;   {Keep a reference to the interface - automatic destroy
93		when this class is freed and last reference to IStatus
94		goes out of scope.}
95	–	protected
96	–	{$IFDEF UNIX}
97	–	function GetFirebirdLibList: string; override;
98	–	{$ENDIF}
99	–	procedure LoadInterface; override;
95		public
96	<	constructor Create;
96	>	constructor Create(aFBLibrary: TFBLibrary);
97		destructor Destroy; override;
98		function StatusVector: PISC_STATUS;
99	+	function LoadInterface: boolean; override;
100	+	function GetAPI: IFirebirdAPI; override;
101	+	{$IFDEF UNIX}
102	+	function GetFirebirdLibList: string; override;
103	+	{$ENDIF}
104		property IBServiceAPIPresent: boolean read FIBServiceAPIPresent;
105		property Status: TFB25Status read FStatus;
106
#	Line 111 | Line 111 | type
111		BLOB_put: TBLOB_put;
112		isc_wait_for_event: Tisc_wait_for_event;
113		isc_vax_integer: Tisc_vax_integer;
114	–	isc_portable_integer: Tisc_portable_integer;
114		isc_blob_info: Tisc_blob_info;
115		isc_blob_lookup_desc: Tisc_blob_lookup_desc;
116		isc_open_blob2: Tisc_open_blob2;
#	Line 162 | Line 161 | type
161		isc_array_get_slice: Tisc_array_get_slice;
162		isc_array_put_slice: Tisc_array_put_slice;
163		isc_prepare_transaction: Tisc_prepare_transaction;
164	+	isc_version: Tisc_Version;
165	+	isc_interprete: Tisc_interprete;
166
167		public
168		{Helper Functions}
169	<	function DecodeInteger(bufptr: PChar; len: short): integer; override;
170	<	procedure SQLEncodeDate(aDate: TDateTime; bufptr: PChar); override;
171	<	function SQLDecodeDate(bufptr: PChar): TDateTime; override;
172	<	procedure SQLEncodeTime(aTime: TDateTime; bufptr: PChar); override;
173	<	function SQLDecodeTime(bufptr: PChar): TDateTime;  override;
174	<	procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar); override;
175	<	function SQLDecodeDateTime(bufptr: PChar): TDateTime; override;
175	<
169	>	procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); override;
170	>	function SQLDecodeDate(bufptr: PByte): TDateTime; override;
171	>	procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); override;
172	>	function SQLDecodeTime(bufptr: PByte): TDateTime;  override;
173	>	procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); override;
174	>	function SQLDecodeDateTime(bufptr: PByte): TDateTime; override;
175	>	function FormatStatus(Status: TFBStatus): AnsiString; override;
176		public
177		{IFirebirdAPI}
178
179		{Database connections}
180		function AllocateDPB: IDPB;
181	<	function OpenDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
182	<	function CreateDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment;  overload;
183	<	function CreateDatabase(sql: string; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
181	>	function OpenDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
182	>	function CreateDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment;  overload;
183	>	function CreateDatabase(sql: AnsiString; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
184
185		{Start Transaction against multiple databases}
186		function AllocateTPB: ITPB;
#	Line 192 | Line 192 | type
192		{Service Manager}
193		function AllocateSPB: ISPB;
194		function HasServiceAPI: boolean;
195	<	function GetServiceManager(ServerName: string; Protocol: TProtocol; SPB: ISPB): IServiceManager;
195	>	function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
196	>	function GetServiceManager(ServerName: AnsiString; Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
197
198		{Information}
199		function GetStatus: IStatus; override;
200		function HasRollbackRetaining: boolean;
201		function IsEmbeddedServer: boolean; override;
202	<	function GetImplementationVersion: string;
202	>	function GetClientMajor: integer; override;
203	>	function GetClientMinor: integer; override;
204
205		{Firebird 3 API}
206		function HasMasterIntf: boolean;
#	Line 206 | Line 208 | type
208
209		end;
210
209	–	const
210	–	Firebird25ClientAPI: TFB25ClientAPI = nil;
211	–
211		implementation
212
213	<	uses FBMessages, dynlibs, FB25Attachment, FB25Transaction, FB25Services, FBParamBlock,
214	<	IBUtils;
213	>	uses FBMessages,
214	>	{$IFDEF WINDOWS}Windows, {$ENDIF}
215	>	{$IFDEF FPC} Dynlibs, {$ENDIF}
216	>	FB25Attachment, FB25Transaction, FB25Services,
217	>	IBUtils, FBAttachment, FBTransaction, FBServices;
218
219		{ Stubs for 6.0 only functions }
220		function isc_rollback_retaining_stub(status_vector   : PISC_STATUS;
#	Line 225 | Line 227 | end;
227
228		function isc_service_attach_stub(status_vector      : PISC_STATUS;
229		isc_arg2           : UShort;
230	<	isc_arg3           : PChar;
230	>	isc_arg3           : PAnsiChar;
231		service_handle     : PISC_SVC_HANDLE;
232		isc_arg5           : UShort;
233	<	isc_arg6           : PChar):
233	>	isc_arg6           : PAnsiChar):
234		ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
235		begin
236		Result := 0;
#	Line 247 | Line 249 | function isc_service_query_stub(status_v
249		service_handle       : PISC_SVC_HANDLE;
250		recv_handle          : PISC_SVC_HANDLE;
251		isc_arg4             : UShort;
252	<	isc_arg5             : PChar;
252	>	isc_arg5             : PAnsiChar;
253		isc_arg6             : UShort;
254	<	isc_arg7             : PChar;
254	>	isc_arg7             : PAnsiChar;
255		isc_arg8             : UShort;
256	<	isc_arg9             : PChar):
256	>	isc_arg9             : PAnsiChar):
257		ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
258		begin
259		Result := 0;
#	Line 262 | Line 264 | function isc_service_start_stub(status_v
264		service_handle       : PISC_SVC_HANDLE;
265		recv_handle          : PISC_SVC_HANDLE;
266		isc_arg4             : UShort;
267	<	isc_arg5             : PChar):
267	>	isc_arg5             : PAnsiChar):
268		ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
269		begin
270		Result := 0;
#	Line 316 | Line 318 | end;
318		threadvar
319		FStatusVector: TStatusVector;
320
321	+	{ TFB25ActivityReporter }
322	+
323		function TFB25Status.StatusVector: PStatusVector;
324		begin
325		Result := @FStatusVector;
#	Line 331 | Line 335 | begin
335		end;
336		{$ENDIF}
337
338	<	procedure TFB25ClientAPI.LoadInterface;
338	>	function TFB25ClientAPI.LoadInterface: boolean;
339		begin
340	<	inherited LoadInterface;
340	>	Result := inherited LoadInterface;
341		BLOB_get := GetProcAddr('BLOB_get'); {do not localize}
342		BLOB_put := GetProcAddr('BLOB_put'); {do not localize}
343		isc_wait_for_event := GetProcAddr('isc_wait_for_event'); {do not localize}
344		isc_vax_integer := GetProcAddr('isc_vax_integer'); {do not localize}
341	–	isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
345		isc_blob_info := GetProcAddr('isc_blob_info'); {do not localize}
346		isc_blob_lookup_desc := GetProcAddr('isc_blob_lookup_desc');  {do not localize}
347		isc_open_blob2 := GetProcAddr('isc_open_blob2'); {do not localize}
#	Line 378 | Line 381 | begin
381		isc_array_get_slice := GetProcAddr('isc_array_get_slice'); {do not localize}
382		isc_array_put_slice := GetProcAddr('isc_array_put_slice'); {do not localize}
383		isc_prepare_transaction  := GetProcAddr('isc_prepare_transaction'); {do not localize}
384	+	isc_version  := GetProcAddr('isc_version'); {do not localize}
385	+	isc_interprete := GetProcAddr('isc_interprete'); {do not localize}
386
387		FIBServiceAPIPresent := true;
388	<	isc_rollback_retaining := GetProcAddress(IBLibrary, 'isc_rollback_retaining'); {do not localize}
388	>	isc_rollback_retaining := GetProcAddress(FFBLibrary.IBLibrary, 'isc_rollback_retaining'); {do not localize}
389		if Assigned(isc_rollback_retaining) then
390		begin
391		isc_service_attach := GetProcAddr('isc_service_attach'); {do not localize}
#	Line 408 | Line 413 | begin
413		isc_encode_sql_time := @isc_encode_sql_time_stub;
414		isc_encode_timestamp := @isc_encode_timestamp_stub;
415		end;
416	+	Result := Result and assigned(isc_attach_database);
417	+	end;
418	+
419	+	function TFB25ClientAPI.GetAPI: IFirebirdAPI;
420	+	begin
421	+	Result := self;
422		end;
423
424	<	constructor TFB25ClientAPI.Create;
424	>	constructor TFB25ClientAPI.Create(aFBLibrary: TFBLibrary);
425		begin
426	<	inherited;
426	>	inherited Create(aFBLibrary);
427		FStatus := TFB25Status.Create(self);
428		FStatusIntf := FStatus;
418	–	Firebird25ClientAPI := self;
429		end;
430
431		destructor TFB25ClientAPI.Destroy;
432		begin
433		FStatusIntf := nil;
424	–	Firebird25ClientAPI := nil;
434		inherited Destroy;
435		end;
436
#	Line 438 | Line 447 | end;
447
448		function TFB25ClientAPI.AllocateDPB: IDPB;
449		begin
450	<	Result := TDPB.Create;
450	>	Result := TDPB.Create(self);
451		end;
452
453	<	function TFB25ClientAPI.OpenDatabase(DatabaseName: string; DPB: IDPB;
453	>	function TFB25ClientAPI.OpenDatabase(DatabaseName: AnsiString; DPB: IDPB;
454		RaiseExceptionOnConnectError: boolean): IAttachment;
455		begin
456	<	Result := TFB25Attachment.Create(DatabaseName,DPB,RaiseExceptionOnConnectError);
456	>	Result := TFB25Attachment.Create(self,DatabaseName,DPB,RaiseExceptionOnConnectError);
457		if not Result.IsConnected then
458		Result := nil;
459		end;
460
461	<	function TFB25ClientAPI.CreateDatabase(DatabaseName: string; DPB: IDPB;
461	>	function TFB25ClientAPI.CreateDatabase(DatabaseName: AnsiString; DPB: IDPB;
462		RaiseExceptionOnError: boolean): IAttachment;
463		begin
464	<	Result := TFB25Attachment.CreateDatabase(DatabaseName, DPB, RaiseExceptionOnError );
464	>	Result := TFB25Attachment.CreateDatabase(self,DatabaseName, DPB, RaiseExceptionOnError );
465		if (Result <> nil) and not Result.IsConnected then
466		Result := nil;
467		end;
468
469	<	function TFB25ClientAPI.CreateDatabase(sql: string; aSQLDialect: integer;
469	>	function TFB25ClientAPI.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
470		RaiseExceptionOnError: boolean): IAttachment;
471		begin
472	<	Result := TFB25Attachment.CreateDatabase(sql,aSQLDialect, RaiseExceptionOnError );
472	>	Result := TFB25Attachment.CreateDatabase(self,sql,aSQLDialect, RaiseExceptionOnError );
473		if (Result <> nil) and not Result.IsConnected then
474		Result := nil;
475		end;
476
477		function TFB25ClientAPI.AllocateSPB: ISPB;
478		begin
479	<	Result := TSPB.Create;
479	>	Result := TSPB.Create(self);
480		end;
481
482		function TFB25ClientAPI.AllocateTPB: ITPB;
483		begin
484	<	Result := TTPB.Create;
484	>	Result := TTPB.Create(self);
485		end;
486
487	<	function TFB25ClientAPI.GetServiceManager(ServerName: string;
487	>	function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString;
488		Protocol: TProtocol; SPB: ISPB): IServiceManager;
489		begin
490		if HasServiceAPI then
491	<	Result := TFB25ServiceManager.Create(ServerName,Protocol,SPB)
491	>	Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB)
492	>	else
493	>	Result := nil;
494	>	end;
495	>
496	>	function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString;
497	>	Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager;
498	>	begin
499	>	if HasServiceAPI then
500	>	Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB,Port)
501		else
502		Result := nil;
503		end;
#	Line 487 | Line 505 | end;
505		function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
506		TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction;
507		begin
508	<	Result := TFB25Transaction.Create(Attachments,TPB,DefaultCompletion);
508	>	Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion);
509		end;
510
511		function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
512		TPB: ITPB; 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.HasServiceAPI: boolean;
#	Line 510 | Line 528 | function TFB25ClientAPI.IsEmbeddedServer
528		begin
529		Result := false;
530		{$IFDEF UNIX}
531	<	Result := Pos('libfbembed',FFBLibraryName) = 1;
531	>	Result := Pos('libfbembed',FFBLibrary.GetLibraryName) = 1;
532		{$ENDIF}
533		{$IFDEF WINDOWS}
534	<	Result := CompareText(FFBLibraryName,FIREBIRD_EMBEDDED) = 0;
534	>	Result := CompareText(FFBLibrary.GetLibraryName,FIREBIRD_EMBEDDED) = 0;
535		{$ENDIF}
536		end;
537
538	<	function TFB25ClientAPI.HasMasterIntf: boolean;
538	>	function TFB25ClientAPI.GetClientMajor: integer;
539		begin
540	<	Result := false;
540	>	Result := 2;
541		end;
542
543	<	function TFB25ClientAPI.GetIMaster: TObject;
543	>	function TFB25ClientAPI.GetClientMinor: integer;
544		begin
545	<	Result := nil;
545	>	Result := 5;
546		end;
547
548	<	function TFB25ClientAPI.GetImplementationVersion: string;
548	>	function TFB25ClientAPI.HasMasterIntf: boolean;
549		begin
550	<	Result := FBClientInterfaceVersion;
550	>	Result := false;
551		end;
552
553	<	function TFB25ClientAPI.DecodeInteger(bufptr: PChar; len: short): integer;
553	>	function TFB25ClientAPI.GetIMaster: TObject;
554		begin
555	<	Result := isc_portable_integer(bufptr,len);
555	>	Result := nil;
556		end;
557
558	<	procedure TFB25ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PChar);
558	>	procedure TFB25ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PByte);
559		var
560		tm_date: TCTimeStructure;
561		Yr, Mn, Dy: Word;
#	Line 554 | Line 572 | begin
572		isc_encode_sql_date(@tm_date, PISC_DATE(bufptr));
573		end;
574
575	<	function TFB25ClientAPI.SQLDecodeDate(bufptr: PChar): TDateTime;
575	>	function TFB25ClientAPI.SQLDecodeDate(bufptr: PByte): TDateTime;
576		var
577		tm_date: TCTimeStructure;
578		begin
#	Line 569 | Line 587 | begin
587		end;
588		end;
589
590	<	procedure TFB25ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PChar);
590	>	procedure TFB25ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PByte);
591		var
592		tm_date: TCTimeStructure;
593	<	Hr, Mt, S, Ms: Word;
593	>	Hr, Mt, S: Word;
594	>	DMs: cardinal; {DMs = decimilliseconds}
595		begin
596	<	DecodeTime(aTime, Hr, Mt, S, Ms);
596	>	FBDecodeTime(aTime, Hr, Mt, S, DMs);
597		with tm_date do begin
598		tm_sec := S;
599		tm_min := Mt;
#	Line 583 | Line 602 | begin
602		tm_mon := 0;
603		tm_year := 0;
604		end;
605	<	with Firebird25ClientAPI do
606	<	isc_encode_sql_time(@tm_date, PISC_TIME(bufptr));
607	<	if Ms > 0 then
589	<	Inc(PISC_TIME(bufptr)^,Ms*10);
605	>	isc_encode_sql_time(@tm_date, PISC_TIME(bufptr));
606	>	if DMs > 0 then
607	>	Inc(PISC_TIME(bufptr)^,DMs);
608		end;
609
610	<	function TFB25ClientAPI.SQLDecodeTime(bufptr: PChar): TDateTime;
610	>	function TFB25ClientAPI.SQLDecodeTime(bufptr: PByte): TDateTime;
611		var
612		tm_date: TCTimeStructure;
613	<	msecs: Word;
613	>	DMs: cardinal; {DMs = decimilliseconds}
614		begin
615		isc_decode_sql_time(PISC_TIME(bufptr), @tm_date);
616		try
617	<	msecs :=  (PISC_TIME(bufptr)^ mod 10000) div 10;
618	<	result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
619	<	Word(tm_date.tm_sec), msecs)
617	>	DMs :=  PISC_TIME(bufptr)^ mod 10000;
618	>	result := FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
619	>	Word(tm_date.tm_sec), DMs)
620		except
621		on E: EConvertError do begin
622		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 606 | Line 624 | begin
624		end;
625		end;
626
627	<	procedure TFB25ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar);
627	>	procedure TFB25ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte);
628		var
629		tm_date: TCTimeStructure;
630		Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
631	+	DMs: cardinal;
632		begin
633		DecodeDate(aDateTime, Yr, Mn, Dy);
634	<	DecodeTime(aDateTime, Hr, Mt, S, Ms);
634	>	FBDecodeTime(aDateTime, Hr, Mt, S, DMs);
635		with tm_date do begin
636		tm_sec := S;
637		tm_min := Mt;
#	Line 622 | Line 641 | begin
641		tm_year := Yr - 1900;
642		end;
643		isc_encode_date(@tm_date, PISC_QUAD(bufptr));
644	<	if Ms > 0 then
645	<	Inc(PISC_TIMESTAMP(bufptr)^.timestamp_time,Ms*10);
644	>	if DMs > 0 then
645	>	Inc(PISC_TIMESTAMP(bufptr)^.timestamp_time,DMs);
646		end;
647
648	<	function TFB25ClientAPI.SQLDecodeDateTime(bufptr: PChar): TDateTime;
648	>	function TFB25ClientAPI.SQLDecodeDateTime(bufptr: PByte): TDateTime;
649		var
650		tm_date: TCTimeStructure;
651	<	msecs: Word;
651	>	Dmsecs: Word;
652		begin
653		isc_decode_date(PISC_QUAD(bufptr), @tm_date);
654		try
655		result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
656		Word(tm_date.tm_mday));
657	<	msecs := (PISC_TIMESTAMP(bufptr)^.timestamp_time mod 10000) div 10;
657	>	Dmsecs := PISC_TIMESTAMP(bufptr)^.timestamp_time mod 10000;
658		if result >= 0 then
659	<	result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
660	<	Word(tm_date.tm_sec), msecs)
659	>	result := result + FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
660	>	Word(tm_date.tm_sec), Dmsecs)
661		else
662	<	result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
663	<	Word(tm_date.tm_sec), msecs)
662	>	result := result - FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
663	>	Word(tm_date.tm_sec), Dmsecs)
664		except
665		on E: EConvertError do begin
666		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 649 | Line 668 | begin
668		end;
669		end;
670
671	+	function TFB25ClientAPI.FormatStatus(Status: TFBStatus): AnsiString;
672	+	var psb: PStatusVector;
673	+	local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
674	+	begin
675	+	psb := Status.StatusVector;
676	+	Result := '';
677	+	while isc_interprete(@local_buffer,@psb) > 0 do
678	+	begin
679	+	if (Result <> '') and (Result[Length(Result)] <> LF) then
680	+	Result := Result + LineEnding + '-';
681	+	Result := Result + strpas(local_buffer);
682	+	end;
683	+	end;
684	+
685		end.
686
687	+

Diff Legend

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