[ViewVC] Diff of: 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 315 by tony, Thu Feb 25 11:56:36 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 162 \| Line 162 \| type
162		isc_array_get_slice: Tisc_array_get_slice;
163		isc_array_put_slice: Tisc_array_put_slice;
164		isc_prepare_transaction: Tisc_prepare_transaction;
165	+	isc_version: Tisc_Version;
166	+	isc_interprete: Tisc_interprete;
167
168		public
169		{Helper Functions}
170	<	function DecodeInteger(bufptr: PChar; len: short): integer; override;
171	<	procedure SQLEncodeDate(aDate: TDateTime; bufptr: PChar); override;
172	<	function SQLDecodeDate(bufptr: PChar): TDateTime; override;
173	<	procedure SQLEncodeTime(aTime: TDateTime; bufptr: PChar); override;
174	<	function SQLDecodeTime(bufptr: PChar): TDateTime; override;
175	<	procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar); override;
176	<	function SQLDecodeDateTime(bufptr: PChar): TDateTime; override;
177	<
170	>	function DecodeInteger(bufptr: PByte; len: short): integer; override;
171	>	procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); override;
172	>	function SQLDecodeDate(bufptr: PByte): TDateTime; override;
173	>	procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); override;
174	>	function SQLDecodeTime(bufptr: PByte): TDateTime; override;
175	>	procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); override;
176	>	function SQLDecodeDateTime(bufptr: PByte): TDateTime; override;
177	>	function FormatStatus(Status: TFBStatus): AnsiString; override;
178		public
179		{IFirebirdAPI}
180
181		{Database connections}
182		function AllocateDPB: IDPB;
183	<	function OpenDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
184	<	function CreateDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
185	<	function CreateDatabase(sql: string; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
183	>	function OpenDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
184	>	function CreateDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
185	>	function CreateDatabase(sql: AnsiString; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
186
187		{Start Transaction against multiple databases}
188		function AllocateTPB: ITPB;
#	Line 192 \| Line 194 \| type
194		{Service Manager}
195		function AllocateSPB: ISPB;
196		function HasServiceAPI: boolean;
197	<	function GetServiceManager(ServerName: string; Protocol: TProtocol; SPB: ISPB): IServiceManager;
197	>	function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
198	>	function GetServiceManager(ServerName: AnsiString; Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
199
200		{Information}
201		function GetStatus: IStatus; override;
202		function HasRollbackRetaining: boolean;
203		function IsEmbeddedServer: boolean; override;
204	<	function GetImplementationVersion: string;
204	>	function GetClientMajor: integer; override;
205	>	function GetClientMinor: integer; override;
206
207		{Firebird 3 API}
208		function HasMasterIntf: boolean;
#	Line 206 \| Line 210 \| type
210
211		end;
212
209	–	const
210	–	Firebird25ClientAPI: TFB25ClientAPI = nil;
211	–
213		implementation
214
215	<	uses FBMessages, dynlibs, FB25Attachment, FB25Transaction, FB25Services, FBParamBlock,
216	<	IBUtils;
215	>	uses FBMessages,
216	>	{$IFDEF WINDOWS}Windows, {$ENDIF}
217	>	{$IFDEF FPC} Dynlibs, {$ENDIF}
218	>	FB25Attachment, FB25Transaction, FB25Services,
219	>	IBUtils, FBAttachment, FBTransaction, FBServices;
220
221		{ Stubs for 6.0 only functions }
222		function isc_rollback_retaining_stub(status_vector : PISC_STATUS;
#	Line 225 \| Line 229 \| end;
229
230		function isc_service_attach_stub(status_vector : PISC_STATUS;
231		isc_arg2 : UShort;
232	<	isc_arg3 : PChar;
232	>	isc_arg3 : PAnsiChar;
233		service_handle : PISC_SVC_HANDLE;
234		isc_arg5 : UShort;
235	<	isc_arg6 : PChar):
235	>	isc_arg6 : PAnsiChar):
236		ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
237		begin
238		Result := 0;
#	Line 247 \| Line 251 \| function isc_service_query_stub(status_v
251		service_handle : PISC_SVC_HANDLE;
252		recv_handle : PISC_SVC_HANDLE;
253		isc_arg4 : UShort;
254	<	isc_arg5 : PChar;
254	>	isc_arg5 : PAnsiChar;
255		isc_arg6 : UShort;
256	<	isc_arg7 : PChar;
256	>	isc_arg7 : PAnsiChar;
257		isc_arg8 : UShort;
258	<	isc_arg9 : PChar):
258	>	isc_arg9 : PAnsiChar):
259		ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
260		begin
261		Result := 0;
#	Line 262 \| Line 266 \| function isc_service_start_stub(status_v
266		service_handle : PISC_SVC_HANDLE;
267		recv_handle : PISC_SVC_HANDLE;
268		isc_arg4 : UShort;
269	<	isc_arg5 : PChar):
269	>	isc_arg5 : PAnsiChar):
270		ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
271		begin
272		Result := 0;
#	Line 316 \| Line 320 \| end;
320		threadvar
321		FStatusVector: TStatusVector;
322
323	+	{ TFB25ActivityReporter }
324	+
325		function TFB25Status.StatusVector: PStatusVector;
326		begin
327		Result := @FStatusVector;
#	Line 331 \| Line 337 \| begin
337		end;
338		{$ENDIF}
339
340	<	procedure TFB25ClientAPI.LoadInterface;
340	>	function TFB25ClientAPI.LoadInterface: boolean;
341		begin
342	<	inherited LoadInterface;
342	>	Result := inherited LoadInterface;
343		BLOB_get := GetProcAddr('BLOB_get'); {do not localize}
344		BLOB_put := GetProcAddr('BLOB_put'); {do not localize}
345		isc_wait_for_event := GetProcAddr('isc_wait_for_event'); {do not localize}
#	Line 378 \| Line 384 \| begin
384		isc_array_get_slice := GetProcAddr('isc_array_get_slice'); {do not localize}
385		isc_array_put_slice := GetProcAddr('isc_array_put_slice'); {do not localize}
386		isc_prepare_transaction := GetProcAddr('isc_prepare_transaction'); {do not localize}
387	+	isc_version := GetProcAddr('isc_version'); {do not localize}
388	+	isc_interprete := GetProcAddr('isc_interprete'); {do not localize}
389
390		FIBServiceAPIPresent := true;
391	<	isc_rollback_retaining := GetProcAddress(IBLibrary, 'isc_rollback_retaining'); {do not localize}
391	>	isc_rollback_retaining := GetProcAddress(FFBLibrary.IBLibrary, 'isc_rollback_retaining'); {do not localize}
392		if Assigned(isc_rollback_retaining) then
393		begin
394		isc_service_attach := GetProcAddr('isc_service_attach'); {do not localize}
#	Line 408 \| Line 416 \| begin
416		isc_encode_sql_time := @isc_encode_sql_time_stub;
417		isc_encode_timestamp := @isc_encode_timestamp_stub;
418		end;
419	+	Result := Result and assigned(isc_attach_database);
420	+	end;
421	+
422	+	function TFB25ClientAPI.GetAPI: IFirebirdAPI;
423	+	begin
424	+	Result := self;
425		end;
426
427	<	constructor TFB25ClientAPI.Create;
427	>	constructor TFB25ClientAPI.Create(aFBLibrary: TFBLibrary);
428		begin
429	<	inherited;
429	>	inherited Create(aFBLibrary);
430		FStatus := TFB25Status.Create(self);
431		FStatusIntf := FStatus;
418	–	Firebird25ClientAPI := self;
432		end;
433
434		destructor TFB25ClientAPI.Destroy;
435		begin
436		FStatusIntf := nil;
424	–	Firebird25ClientAPI := nil;
437		inherited Destroy;
438		end;
439
#	Line 438 \| Line 450 \| end;
450
451		function TFB25ClientAPI.AllocateDPB: IDPB;
452		begin
453	<	Result := TDPB.Create;
453	>	Result := TDPB.Create(self);
454		end;
455
456	<	function TFB25ClientAPI.OpenDatabase(DatabaseName: string; DPB: IDPB;
456	>	function TFB25ClientAPI.OpenDatabase(DatabaseName: AnsiString; DPB: IDPB;
457		RaiseExceptionOnConnectError: boolean): IAttachment;
458		begin
459	<	Result := TFB25Attachment.Create(DatabaseName,DPB,RaiseExceptionOnConnectError);
459	>	Result := TFB25Attachment.Create(self,DatabaseName,DPB,RaiseExceptionOnConnectError);
460		if not Result.IsConnected then
461		Result := nil;
462		end;
463
464	<	function TFB25ClientAPI.CreateDatabase(DatabaseName: string; DPB: IDPB;
464	>	function TFB25ClientAPI.CreateDatabase(DatabaseName: AnsiString; DPB: IDPB;
465		RaiseExceptionOnError: boolean): IAttachment;
466		begin
467	<	Result := TFB25Attachment.CreateDatabase(DatabaseName, DPB, RaiseExceptionOnError );
467	>	Result := TFB25Attachment.CreateDatabase(self,DatabaseName, DPB, RaiseExceptionOnError );
468		if (Result <> nil) and not Result.IsConnected then
469		Result := nil;
470		end;
471
472	<	function TFB25ClientAPI.CreateDatabase(sql: string; aSQLDialect: integer;
472	>	function TFB25ClientAPI.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
473		RaiseExceptionOnError: boolean): IAttachment;
474		begin
475	<	Result := TFB25Attachment.CreateDatabase(sql,aSQLDialect, RaiseExceptionOnError );
475	>	Result := TFB25Attachment.CreateDatabase(self,sql,aSQLDialect, RaiseExceptionOnError );
476		if (Result <> nil) and not Result.IsConnected then
477		Result := nil;
478		end;
479
480		function TFB25ClientAPI.AllocateSPB: ISPB;
481		begin
482	<	Result := TSPB.Create;
482	>	Result := TSPB.Create(self);
483		end;
484
485		function TFB25ClientAPI.AllocateTPB: ITPB;
486		begin
487	<	Result := TTPB.Create;
487	>	Result := TTPB.Create(self);
488		end;
489
490	<	function TFB25ClientAPI.GetServiceManager(ServerName: string;
490	>	function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString;
491		Protocol: TProtocol; SPB: ISPB): IServiceManager;
492		begin
493		if HasServiceAPI then
494	<	Result := TFB25ServiceManager.Create(ServerName,Protocol,SPB)
494	>	Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB)
495	>	else
496	>	Result := nil;
497	>	end;
498	>
499	>	function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString;
500	>	Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager;
501	>	begin
502	>	if HasServiceAPI then
503	>	Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB,Port)
504		else
505		Result := nil;
506		end;
#	Line 487 \| Line 508 \| end;
508		function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
509		TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction;
510		begin
511	<	Result := TFB25Transaction.Create(Attachments,TPB,DefaultCompletion);
511	>	Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion);
512		end;
513
514		function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
515		TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction;
516		begin
517	<	Result := TFB25Transaction.Create(Attachments,TPB,DefaultCompletion);
517	>	Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion);
518		end;
519
520		function TFB25ClientAPI.HasServiceAPI: boolean;
#	Line 510 \| Line 531 \| function TFB25ClientAPI.IsEmbeddedServer
531		begin
532		Result := false;
533		{$IFDEF UNIX}
534	<	Result := Pos('libfbembed',FFBLibraryName) = 1;
534	>	Result := Pos('libfbembed',FFBLibrary.GetLibraryName) = 1;
535		{$ENDIF}
536		{$IFDEF WINDOWS}
537	<	Result := CompareText(FFBLibraryName,FIREBIRD_EMBEDDED) = 0;
537	>	Result := CompareText(FFBLibrary.GetLibraryName,FIREBIRD_EMBEDDED) = 0;
538		{$ENDIF}
539		end;
540
541	+	function TFB25ClientAPI.GetClientMajor: integer;
542	+	begin
543	+	Result := 2;
544	+	end;
545	+
546	+	function TFB25ClientAPI.GetClientMinor: integer;
547	+	begin
548	+	Result := 5;
549	+	end;
550	+
551		function TFB25ClientAPI.HasMasterIntf: boolean;
552		begin
553		Result := false;
#	Line 527 \| Line 558 \| begin
558		Result := nil;
559		end;
560
561	<	function TFB25ClientAPI.GetImplementationVersion: string;
531	<	begin
532	<	Result := FBClientInterfaceVersion;
533	<	end;
534	<
535	<	function TFB25ClientAPI.DecodeInteger(bufptr: PChar; len: short): integer;
561	>	function TFB25ClientAPI.DecodeInteger(bufptr: PByte; len: short): integer;
562		begin
563		Result := isc_portable_integer(bufptr,len);
564		end;
565
566	<	procedure TFB25ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PChar);
566	>	procedure TFB25ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PByte);
567		var
568		tm_date: TCTimeStructure;
569		Yr, Mn, Dy: Word;
#	Line 554 \| Line 580 \| begin
580		isc_encode_sql_date(@tm_date, PISC_DATE(bufptr));
581		end;
582
583	<	function TFB25ClientAPI.SQLDecodeDate(bufptr: PChar): TDateTime;
583	>	function TFB25ClientAPI.SQLDecodeDate(bufptr: PByte): TDateTime;
584		var
585		tm_date: TCTimeStructure;
586		begin
#	Line 569 \| Line 595 \| begin
595		end;
596		end;
597
598	<	procedure TFB25ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PChar);
598	>	procedure TFB25ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PByte);
599		var
600		tm_date: TCTimeStructure;
601	<	Hr, Mt, S, Ms: Word;
601	>	Hr, Mt, S: Word;
602	>	DMs: cardinal; {DMs = decimilliseconds}
603		begin
604	<	DecodeTime(aTime, Hr, Mt, S, Ms);
604	>	FBDecodeTime(aTime, Hr, Mt, S, DMs);
605		with tm_date do begin
606		tm_sec := S;
607		tm_min := Mt;
#	Line 583 \| Line 610 \| begin
610		tm_mon := 0;
611		tm_year := 0;
612		end;
613	<	with Firebird25ClientAPI do
614	<	isc_encode_sql_time(@tm_date, PISC_TIME(bufptr));
615	<	if Ms > 0 then
589	<	Inc(PISC_TIME(bufptr)^,Ms*10);
613	>	isc_encode_sql_time(@tm_date, PISC_TIME(bufptr));
614	>	if DMs > 0 then
615	>	Inc(PISC_TIME(bufptr)^,DMs);
616		end;
617
618	<	function TFB25ClientAPI.SQLDecodeTime(bufptr: PChar): TDateTime;
618	>	function TFB25ClientAPI.SQLDecodeTime(bufptr: PByte): TDateTime;
619		var
620		tm_date: TCTimeStructure;
621	<	msecs: Word;
621	>	DMs: cardinal; {DMs = decimilliseconds}
622		begin
623		isc_decode_sql_time(PISC_TIME(bufptr), @tm_date);
624		try
625	<	msecs := (PISC_TIME(bufptr)^ mod 10000) div 10;
626	<	result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
627	<	Word(tm_date.tm_sec), msecs)
625	>	DMs := PISC_TIME(bufptr)^ mod 10000;
626	>	result := FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
627	>	Word(tm_date.tm_sec), DMs)
628		except
629		on E: EConvertError do begin
630		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 606 \| Line 632 \| begin
632		end;
633		end;
634
635	<	procedure TFB25ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar);
635	>	procedure TFB25ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte);
636		var
637		tm_date: TCTimeStructure;
638		Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
639	+	DMs: cardinal;
640		begin
641		DecodeDate(aDateTime, Yr, Mn, Dy);
642	<	DecodeTime(aDateTime, Hr, Mt, S, Ms);
642	>	FBDecodeTime(aDateTime, Hr, Mt, S, DMs);
643		with tm_date do begin
644		tm_sec := S;
645		tm_min := Mt;
#	Line 622 \| Line 649 \| begin
649		tm_year := Yr - 1900;
650		end;
651		isc_encode_date(@tm_date, PISC_QUAD(bufptr));
652	<	if Ms > 0 then
653	<	Inc(PISC_TIMESTAMP(bufptr)^.timestamp_time,Ms*10);
652	>	if DMs > 0 then
653	>	Inc(PISC_TIMESTAMP(bufptr)^.timestamp_time,DMs);
654		end;
655
656	<	function TFB25ClientAPI.SQLDecodeDateTime(bufptr: PChar): TDateTime;
656	>	function TFB25ClientAPI.SQLDecodeDateTime(bufptr: PByte): TDateTime;
657		var
658		tm_date: TCTimeStructure;
659	<	msecs: Word;
659	>	Dmsecs: Word;
660		begin
661		isc_decode_date(PISC_QUAD(bufptr), @tm_date);
662		try
663		result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
664		Word(tm_date.tm_mday));
665	<	msecs := (PISC_TIMESTAMP(bufptr)^.timestamp_time mod 10000) div 10;
665	>	Dmsecs := PISC_TIMESTAMP(bufptr)^.timestamp_time mod 10000;
666		if result >= 0 then
667	<	result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
668	<	Word(tm_date.tm_sec), msecs)
667	>	result := result + FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
668	>	Word(tm_date.tm_sec), Dmsecs)
669		else
670	<	result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
671	<	Word(tm_date.tm_sec), msecs)
670	>	result := result - FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
671	>	Word(tm_date.tm_sec), Dmsecs)
672		except
673		on E: EConvertError do begin
674		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 649 \| Line 676 \| begin
676		end;
677		end;
678
679	+	function TFB25ClientAPI.FormatStatus(Status: TFBStatus): AnsiString;
680	+	var psb: PStatusVector;
681	+	local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
682	+	begin
683	+	psb := Status.StatusVector;
684	+	Result := '';
685	+	while isc_interprete(@local_buffer,@psb) > 0 do
686	+	begin
687	+	if (Result <> '') and (Result[Length(Result)] <> LF) then
688	+	Result := Result + LineEnding + '-';
689	+	Result := Result + strpas(local_buffer);
690	+	end;
691	+	end;
692	+
693		end.
694
695	+

Diff Legend

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

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 315 by tony, Thu Feb 25 11:56:36 2021 UTC

Diff Legend

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 315 by tony, Thu Feb 25 11:56:36 2021 UTC