ViewVC Help

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

root/public/ibx/trunk/fbintf/client/2.5/FB25ClientAPI.pas

Comparing ibx/trunk/fbintf/client/2.5/FB25ClientAPI.pas (file contents):
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC vs.
Revision 350 by tony, Wed Oct 20 14:58:56 2021 UTC

#	Line 74 | Line 74 | interface
74		uses
75		Classes, SysUtils, FBClientAPI, IBHeader, IBExternals, IB;
76
77	–	const
78	–	FBClientInterfaceVersion = '2.5';
79	–
77		type
78
79		{ TFB25Status }
#	Line 95 | 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.}
98	–	protected
99	–	{$IFDEF UNIX}
100	–	function GetFirebirdLibList: string; override;
101	–	{$ENDIF}
102	–	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 114 | Line 111 | type
111		BLOB_put: TBLOB_put;
112		isc_wait_for_event: Tisc_wait_for_event;
113		isc_vax_integer: Tisc_vax_integer;
117	–	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 165 | 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}
171	–	function DecodeInteger(bufptr: PByte; len: short): integer; override;
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	<
175	>	function FormatStatus(Status: TFBStatus): AnsiString; override;
176		public
177		{IFirebirdAPI}
178
#	Line 202 | Line 199 | type
199		function GetStatus: IStatus; override;
200		function HasRollbackRetaining: boolean;
201		function IsEmbeddedServer: boolean; override;
202	<	function GetImplementationVersion: AnsiString;
202	>	function GetClientMajor: integer; override;
203	>	function GetClientMinor: integer; override;
204	>	function HasScollableCursors: boolean;
205
206		{Firebird 3 API}
207		function HasMasterIntf: boolean;
#	Line 210 | Line 209 | type
209
210		end;
211
213	–	var
214	–	Firebird25ClientAPI: TFB25ClientAPI = nil;
215	–
212		implementation
213
214		uses FBMessages,
215		{$IFDEF WINDOWS}Windows, {$ENDIF}
216		{$IFDEF FPC} Dynlibs, {$ENDIF}
217	<	FB25Attachment, FB25Transaction, FB25Services, FBParamBlock,
218	<	IBUtils;
217	>	FB25Attachment, FB25Transaction, FB25Services,
218	>	IBUtils, FBAttachment, FBTransaction, FBServices;
219
220		{ Stubs for 6.0 only functions }
221		function isc_rollback_retaining_stub(status_vector   : PISC_STATUS;
#	Line 323 | Line 319 | end;
319		threadvar
320		FStatusVector: TStatusVector;
321
322	+	{ TFB25ActivityReporter }
323	+
324		function TFB25Status.StatusVector: PStatusVector;
325		begin
326		Result := @FStatusVector;
#	Line 338 | Line 336 | begin
336		end;
337		{$ENDIF}
338
339	<	procedure TFB25ClientAPI.LoadInterface;
339	>	function TFB25ClientAPI.LoadInterface: boolean;
340		begin
341	<	inherited LoadInterface;
341	>	Result := inherited LoadInterface;
342		BLOB_get := GetProcAddr('BLOB_get'); {do not localize}
343		BLOB_put := GetProcAddr('BLOB_put'); {do not localize}
344		isc_wait_for_event := GetProcAddr('isc_wait_for_event'); {do not localize}
345		isc_vax_integer := GetProcAddr('isc_vax_integer'); {do not localize}
348	–	isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
346		isc_blob_info := GetProcAddr('isc_blob_info'); {do not localize}
347		isc_blob_lookup_desc := GetProcAddr('isc_blob_lookup_desc');  {do not localize}
348		isc_open_blob2 := GetProcAddr('isc_open_blob2'); {do not localize}
#	Line 385 | Line 382 | begin
382		isc_array_get_slice := GetProcAddr('isc_array_get_slice'); {do not localize}
383		isc_array_put_slice := GetProcAddr('isc_array_put_slice'); {do not localize}
384		isc_prepare_transaction  := GetProcAddr('isc_prepare_transaction'); {do not localize}
385	+	isc_version  := GetProcAddr('isc_version'); {do not localize}
386	+	isc_interprete := GetProcAddr('isc_interprete'); {do not localize}
387
388		FIBServiceAPIPresent := true;
389	<	isc_rollback_retaining := GetProcAddress(IBLibrary, 'isc_rollback_retaining'); {do not localize}
389	>	isc_rollback_retaining := GetProcAddress(FFBLibrary.IBLibrary, 'isc_rollback_retaining'); {do not localize}
390		if Assigned(isc_rollback_retaining) then
391		begin
392		isc_service_attach := GetProcAddr('isc_service_attach'); {do not localize}
#	Line 415 | Line 414 | begin
414		isc_encode_sql_time := @isc_encode_sql_time_stub;
415		isc_encode_timestamp := @isc_encode_timestamp_stub;
416		end;
417	+	Result := Result and assigned(isc_attach_database);
418		end;
419
420	<	constructor TFB25ClientAPI.Create;
420	>	function TFB25ClientAPI.GetAPI: IFirebirdAPI;
421		begin
422	<	inherited;
422	>	Result := self;
423	>	end;
424	>
425	>	constructor TFB25ClientAPI.Create(aFBLibrary: TFBLibrary);
426	>	begin
427	>	inherited Create(aFBLibrary);
428		FStatus := TFB25Status.Create(self);
429		FStatusIntf := FStatus;
425	–	Firebird25ClientAPI := self;
430		end;
431
432		destructor TFB25ClientAPI.Destroy;
433		begin
434		FStatusIntf := nil;
431	–	Firebird25ClientAPI := nil;
435		inherited Destroy;
436		end;
437
#	Line 445 | Line 448 | end;
448
449		function TFB25ClientAPI.AllocateDPB: IDPB;
450		begin
451	<	Result := TDPB.Create;
451	>	Result := TDPB.Create(self);
452		end;
453
454		function TFB25ClientAPI.OpenDatabase(DatabaseName: AnsiString; DPB: IDPB;
455		RaiseExceptionOnConnectError: boolean): IAttachment;
456		begin
457	<	Result := TFB25Attachment.Create(DatabaseName,DPB,RaiseExceptionOnConnectError);
457	>	Result := TFB25Attachment.Create(self,DatabaseName,DPB,RaiseExceptionOnConnectError);
458		if not Result.IsConnected then
459		Result := nil;
460		end;
#	Line 459 | Line 462 | end;
462		function TFB25ClientAPI.CreateDatabase(DatabaseName: AnsiString; DPB: IDPB;
463		RaiseExceptionOnError: boolean): IAttachment;
464		begin
465	<	Result := TFB25Attachment.CreateDatabase(DatabaseName, DPB, RaiseExceptionOnError );
465	>	Result := TFB25Attachment.CreateDatabase(self,DatabaseName, DPB, RaiseExceptionOnError );
466		if (Result <> nil) and not Result.IsConnected then
467		Result := nil;
468		end;
#	Line 467 | Line 470 | end;
470		function TFB25ClientAPI.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
471		RaiseExceptionOnError: boolean): IAttachment;
472		begin
473	<	Result := TFB25Attachment.CreateDatabase(sql,aSQLDialect, RaiseExceptionOnError );
473	>	Result := TFB25Attachment.CreateDatabase(self,sql,aSQLDialect, RaiseExceptionOnError );
474		if (Result <> nil) and not Result.IsConnected then
475		Result := nil;
476		end;
477
478		function TFB25ClientAPI.AllocateSPB: ISPB;
479		begin
480	<	Result := TSPB.Create;
480	>	Result := TSPB.Create(self);
481		end;
482
483		function TFB25ClientAPI.AllocateTPB: ITPB;
484		begin
485	<	Result := TTPB.Create;
485	>	Result := TTPB.Create(self);
486		end;
487
488		function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString;
489		Protocol: TProtocol; SPB: ISPB): IServiceManager;
490		begin
491		if HasServiceAPI then
492	<	Result := TFB25ServiceManager.Create(ServerName,Protocol,SPB)
492	>	Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB)
493		else
494		Result := nil;
495		end;
#	Line 495 | Line 498 | function TFB25ClientAPI.GetServiceManage
498		Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager;
499		begin
500		if HasServiceAPI then
501	<	Result := TFB25ServiceManager.Create(ServerName,Protocol,SPB,Port)
501	>	Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB,Port)
502		else
503		Result := nil;
504		end;
#	Line 503 | Line 506 | end;
506		function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
507		TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction;
508		begin
509	<	Result := TFB25Transaction.Create(Attachments,TPB,DefaultCompletion);
509	>	Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion);
510		end;
511
512		function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
513		TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction;
514		begin
515	<	Result := TFB25Transaction.Create(Attachments,TPB,DefaultCompletion);
515	>	Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion);
516		end;
517
518		function TFB25ClientAPI.HasServiceAPI: boolean;
#	Line 526 | Line 529 | function TFB25ClientAPI.IsEmbeddedServer
529		begin
530		Result := false;
531		{$IFDEF UNIX}
532	<	Result := Pos('libfbembed',FFBLibraryName) = 1;
532	>	Result := Pos('libfbembed',FFBLibrary.GetLibraryName) = 1;
533		{$ENDIF}
534		{$IFDEF WINDOWS}
535	<	Result := CompareText(FFBLibraryName,FIREBIRD_EMBEDDED) = 0;
535	>	Result := CompareText(FFBLibrary.GetLibraryName,FIREBIRD_EMBEDDED) = 0;
536		{$ENDIF}
537		end;
538
539	<	function TFB25ClientAPI.HasMasterIntf: boolean;
539	>	function TFB25ClientAPI.GetClientMajor: integer;
540		begin
541	<	Result := false;
541	>	Result := 2;
542		end;
543
544	<	function TFB25ClientAPI.GetIMaster: TObject;
544	>	function TFB25ClientAPI.GetClientMinor: integer;
545		begin
546	<	Result := nil;
546	>	Result := 5;
547		end;
548
549	<	function TFB25ClientAPI.GetImplementationVersion: AnsiString;
549	>	function TFB25ClientAPI.HasScollableCursors: boolean;
550		begin
551	<	Result := FBClientInterfaceVersion;
551	>	Result := false;
552		end;
553
554	<	function TFB25ClientAPI.DecodeInteger(bufptr: PByte; len: short): integer;
554	>	function TFB25ClientAPI.HasMasterIntf: boolean;
555		begin
556	<	Result := isc_portable_integer(bufptr,len);
556	>	Result := false;
557	>	end;
558	>
559	>	function TFB25ClientAPI.GetIMaster: TObject;
560	>	begin
561	>	Result := nil;
562		end;
563
564		procedure TFB25ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PByte);
#	Line 588 | Line 596 | end;
596		procedure TFB25ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PByte);
597		var
598		tm_date: TCTimeStructure;
599	<	Hr, Mt, S, Ms: Word;
599	>	Hr, Mt, S: Word;
600	>	DMs: cardinal; {DMs = decimilliseconds}
601		begin
602	<	DecodeTime(aTime, Hr, Mt, S, Ms);
602	>	FBDecodeTime(aTime, Hr, Mt, S, DMs);
603		with tm_date do begin
604		tm_sec := S;
605		tm_min := Mt;
#	Line 599 | Line 608 | begin
608		tm_mon := 0;
609		tm_year := 0;
610		end;
611	<	with Firebird25ClientAPI do
612	<	isc_encode_sql_time(@tm_date, PISC_TIME(bufptr));
613	<	if Ms > 0 then
605	<	Inc(PISC_TIME(bufptr)^,Ms*10);
611	>	isc_encode_sql_time(@tm_date, PISC_TIME(bufptr));
612	>	if DMs > 0 then
613	>	Inc(PISC_TIME(bufptr)^,DMs);
614		end;
615
616		function TFB25ClientAPI.SQLDecodeTime(bufptr: PByte): TDateTime;
617		var
618		tm_date: TCTimeStructure;
619	<	msecs: Word;
619	>	DMs: cardinal; {DMs = decimilliseconds}
620		begin
621		isc_decode_sql_time(PISC_TIME(bufptr), @tm_date);
622		try
623	<	msecs :=  (PISC_TIME(bufptr)^ mod 10000) div 10;
624	<	result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
625	<	Word(tm_date.tm_sec), msecs)
623	>	DMs :=  PISC_TIME(bufptr)^ mod 10000;
624	>	result := FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
625	>	Word(tm_date.tm_sec), DMs)
626		except
627		on E: EConvertError do begin
628		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 626 | Line 634 | procedure TFB25ClientAPI.SQLEncodeDateTi
634		var
635		tm_date: TCTimeStructure;
636		Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
637	+	DMs: cardinal;
638		begin
639		DecodeDate(aDateTime, Yr, Mn, Dy);
640	<	DecodeTime(aDateTime, Hr, Mt, S, Ms);
640	>	FBDecodeTime(aDateTime, Hr, Mt, S, DMs);
641		with tm_date do begin
642		tm_sec := S;
643		tm_min := Mt;
#	Line 638 | Line 647 | begin
647		tm_year := Yr - 1900;
648		end;
649		isc_encode_date(@tm_date, PISC_QUAD(bufptr));
650	<	if Ms > 0 then
651	<	Inc(PISC_TIMESTAMP(bufptr)^.timestamp_time,Ms*10);
650	>	if DMs > 0 then
651	>	Inc(PISC_TIMESTAMP(bufptr)^.timestamp_time,DMs);
652		end;
653
654		function TFB25ClientAPI.SQLDecodeDateTime(bufptr: PByte): TDateTime;
655		var
656		tm_date: TCTimeStructure;
657	<	msecs: Word;
657	>	Dmsecs: Word;
658		begin
659		isc_decode_date(PISC_QUAD(bufptr), @tm_date);
660		try
661		result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
662		Word(tm_date.tm_mday));
663	<	msecs := (PISC_TIMESTAMP(bufptr)^.timestamp_time mod 10000) div 10;
663	>	Dmsecs := PISC_TIMESTAMP(bufptr)^.timestamp_time mod 10000;
664		if result >= 0 then
665	<	result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
666	<	Word(tm_date.tm_sec), msecs)
665	>	result := result + FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
666	>	Word(tm_date.tm_sec), Dmsecs)
667		else
668	<	result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
669	<	Word(tm_date.tm_sec), msecs)
668	>	result := result - FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
669	>	Word(tm_date.tm_sec), Dmsecs)
670		except
671		on E: EConvertError do begin
672		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 665 | Line 674 | begin
674		end;
675		end;
676
677	+	function TFB25ClientAPI.FormatStatus(Status: TFBStatus): AnsiString;
678	+	var psb: PStatusVector;
679	+	local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
680	+	begin
681	+	psb := Status.StatusVector;
682	+	Result := '';
683	+	while isc_interprete(@local_buffer,@psb) > 0 do
684	+	begin
685	+	if (Result <> '') and (Result[Length(Result)] <> LF) then
686	+	Result := Result + LineEnding + '-';
687	+	Result := Result + strpas(local_buffer);
688	+	end;
689	+	end;
690	+
691		end.
692
693

Diff Legend

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