ViewVC Help

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

root/public/ibx/trunk/fbintf/client/FBAttachment.pas

Comparing ibx/trunk/fbintf/client/FBAttachment.pas (file contents):
Revision 119 by tony, Mon Jan 22 13:58:18 2018 UTC vs.
Revision 291 by tony, Fri Apr 17 10:26:08 2020 UTC

#	Line 27 | Line 27
27		unit FBAttachment;
28		{$IFDEF MSWINDOWS}
29		{$DEFINE WINDOWS}
30	–	{$IF defined(CompilerVersion) and (CompilerVersion >= 28)}
31	–	{Delphi XE7 onwards}}
32	–	{$define HASREQEX}
33	–	{$IFEND}
30		{$ENDIF}
31
32		{$IFDEF FPC}
#	Line 42 | Line 38 | unit FBAttachment;
38		interface
39
40		uses
41	<	Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB,  FBParamBlock, FBActivityMonitor;
41	>	Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB,  FBParamBlock,
42	>	FBActivityMonitor, FBClientAPI;
43
44		type
45		TCharsetMap = record
#	Line 62 | Line 59 | type
59		FODSMajorVersion: integer;
60		FODSMinorVersion: integer;
61		FUserCharSetMap: array of TCharSetMap;
62	+	FSecDatabase: AnsiString;
63		protected
64		FDatabaseName: AnsiString;
65		FRaiseExceptionOnConnectError: boolean;
#	Line 70 | Line 68 | type
68		FCharSetID: integer;
69		FCodePage: TSystemCodePage;
70		FRemoteProtocol: AnsiString;
71	<	constructor Create(DatabaseName: AnsiString; DPB: IDPB;
71	>	FAuthMethod: AnsiString;
72	>	constructor Create(api: TFBClientAPI; DatabaseName: AnsiString; DPB: IDPB;
73		RaiseExceptionOnConnectError: boolean);
74		procedure CheckHandle; virtual; abstract;
75		function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
76		procedure GetODSAndConnectionInfo;
77	+	function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; virtual; abstract;
78		function IsConnected: boolean; virtual; abstract;
79		procedure EndAllTransactions;
80		procedure DPBFromCreateSQL(CreateSQL: AnsiString);
81		procedure SetParameters(SQLParams: ISQLParams; params: array of const);
82		public
83		destructor Destroy; override;
84	+	function getFirebirdAPI: IFirebirdAPI;
85		function getDPB: IDPB;
86		function AllocateBPB: IBPB;
87	+	function AllocateDIRB: IDIRB;
88		function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
89		function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
90		procedure Disconnect(Force: boolean=false); virtual; abstract;
#	Line 112 | Line 114 | type
114		function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; overload; virtual; abstract;
115		function Prepare(transaction: ITransaction; sql: AnsiString): IStatement; overload;
116		function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
117	<	aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; overload; virtual; abstract;
117	>	aSQLDialect: integer; GenerateParamNames: boolean=false;
118	>	CaseSensitiveParams: boolean = false): IStatement; overload; virtual; abstract;
119		function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
120	<	GenerateParamNames: boolean=false): IStatement; overload;
120	>	GenerateParamNames: boolean=false;
121	>	CaseSensitiveParams: boolean = false): IStatement; overload;
122		function GetEventHandler(Events: TStrings): IEvents; overload; virtual; abstract;
123		function GetEventHandler(Event: AnsiString): IEvents; overload;
124
125		function GetSQLDialect: integer;
126	+	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
127	+	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
128		function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
129	+	function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
130		function OpenBlob(transaction: ITransaction; Field: ISQLData; BPB: IBPB=nil): IBlob; overload;
131	+	function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString
132	+	): IArray; overload;
133	+	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; virtual; abstract;
134	+	function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray; overload;
135	+	function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; virtual; abstract;
136		property SQLDialect: integer read FSQLDialect;
137		property DPB: IDPB read FDPB;
138		public
139	<	function GetDBInformation(Requests: array of byte): IDBInformation; overload; virtual; abstract;
140	<	function GetDBInformation(Request: byte): IDBInformation; overload; virtual; abstract;
139	>	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
140	>	function GetDBInformation(Request: byte): IDBInformation; overload;
141	>	function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
142		function GetConnectString: AnsiString;
143		function GetRemoteProtocol: AnsiString;
144	+	function GetAuthenticationMethod: AnsiString;
145	+	function GetSecurityDatabase: AnsiString;
146		function GetODSMajorVersion: integer;
147		function GetODSMinorVersion: integer;
148		{Character Sets}
#	Line 140 | Line 155 | public
155		function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
156		procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
157		AllowReverseLookup:boolean; out CharSetID: integer);
158	+	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; virtual; abstract;
159	+	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; virtual; abstract;
160		property CharSetID: integer read FCharSetID;
161		property CodePage: TSystemCodePage read FCodePage;
162		end;
163
164		implementation
165
166	<	uses FBMessages, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
166	>	uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
167
168		const
169		CharSetMap: array [0..69] of TCharsetMap = (
#	Line 248 | Line 265 | begin
265		FSQLDialect := getAsInteger;
266		end;
267
268	<	if (FODSMajorVersion > 11) or ((FODSMajorVersion = 11) and (FODSMinorVersion >= 1)) then
268	>	FCharSetID := 0;
269	>	FRemoteProtocol := '';
270	>	FAuthMethod := 'Legacy_Auth';
271	>	FSecDatabase := 'Default';
272	>	if FODSMajorVersion > 11 then
273	>	begin
274	>	Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
275	>	'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD, MON$SEC_DATABASE From MON$ATTACHMENTS, MON$DATABASE '+
276	>	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
277	>	ResultSet := Stmt.OpenCursor;
278	>	if ResultSet.FetchNext then
279	>	begin
280	>	FCharSetID := ResultSet[0].AsInteger;
281	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
282	>	FAuthMethod := Trim(ResultSet[2].AsString);
283	>	FSecDatabase := Trim(ResultSet[3].AsString);
284	>	end
285	>	end
286	>	else
287	>	if (FODSMajorVersion = 11) and (FODSMinorVersion >= 1) then
288		begin
289		Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
290		'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+
#	Line 257 | Line 293 | begin
293		if ResultSet.FetchNext then
294		begin
295		FCharSetID := ResultSet[0].AsInteger;
296	<	FRemoteProtocol := ResultSet[1].AsString;
296	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
297		end
298		end
299		else
#	Line 266 | Line 302 | begin
302		Param :=  DPB.Find(isc_dpb_lc_ctype);
303		if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
304		FCharSetID := 0;
305	<	FRemoteProtocol := '';
306	<	end
307	<	else
308	<	begin
309	<	FCharSetID := 0;
310	<	FRemoteProtocol := '';
305	>	case GetProtocol(FDatabaseName) of
306	>	TCP:       FRemoteProtocol := 'TCPv4';
307	>	Local:     FRemoteProtocol := '';
308	>	NamedPipe: FRemoteProtocol := 'Netbui';
309	>	SPX:       FRemoteProtocol := 'SPX'
310	>	end;
311		end;
312		FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
313		end;
314
315	<	constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
316	<	RaiseExceptionOnConnectError: boolean);
315	>	constructor TFBAttachment.Create(api: TFBClientAPI; DatabaseName: AnsiString;
316	>	DPB: IDPB; RaiseExceptionOnConnectError: boolean);
317		begin
318		inherited Create;
319	<	FFirebirdAPI := FirebirdAPI; {Keep reference to interface}
319	>	FFirebirdAPI := api.GetAPI; {Keep reference to interface}
320		FSQLDialect := 3;
321		FDatabaseName := DatabaseName;
322		FDPB := DPB;
#	Line 427 | Line 463 | begin
463		inherited Destroy;
464		end;
465
466	+	function TFBAttachment.getFirebirdAPI: IFirebirdAPI;
467	+	begin
468	+	Result := FFirebirdAPI;
469	+	end;
470	+
471		function TFBAttachment.getDPB: IDPB;
472		begin
473		Result := FDPB;
#	Line 434 | Line 475 | end;
475
476		function TFBAttachment.AllocateBPB: IBPB;
477		begin
478	<	Result := TBPB.Create;
478	>	Result := TBPB.Create(FFirebirdAPI as TFBClientAPI);
479	>	end;
480	>
481	>	function TFBAttachment.AllocateDIRB: IDIRB;
482	>	begin
483	>	Result := TDIRB.Create(FFirebirdAPI as TFBClientAPI);
484		end;
485
486		procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString;
#	Line 557 | Line 603 | begin
603		end;
604
605		function TFBAttachment.PrepareWithNamedParameters(transaction: ITransaction;
606	<	sql: AnsiString; GenerateParamNames: boolean): IStatement;
606	>	sql: AnsiString; GenerateParamNames: boolean; CaseSensitiveParams: boolean): IStatement;
607		begin
608	<	Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames);
608	>	Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames,CaseSensitiveParams);
609		end;
610
611		function TFBAttachment.GetEventHandler(Event: AnsiString): IEvents;
#	Line 579 | Line 625 | begin
625		Result := FSQLDialect;
626		end;
627
628	+	function TFBAttachment.CreateBlob(transaction: ITransaction; RelationName,
629	+	ColumnName: AnsiString; BPB: IBPB): IBlob;
630	+	begin
631	+	Result := CreateBlob(transaction,GetBlobMetaData(Transaction,RelationName,ColumnName),BPB);
632	+	end;
633	+
634	+	function TFBAttachment.OpenBlob(transaction: ITransaction; RelationName,
635	+	ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
636	+	begin
637	+	Result := OpenBlob(Transaction,
638	+	GetBlobMetaData(Transaction,RelationName,ColumnName),
639	+	BlobID,BPB);
640	+	end;
641	+
642		function TFBAttachment.OpenBlob(transaction: ITransaction; Field: ISQLData;
643		BPB: IBPB): IBlob;
644		begin
645		Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
646		end;
647
648	+	function TFBAttachment.CreateArray(transaction: ITransaction; RelationName,
649	+	ColumnName: AnsiString): IArray;
650	+	begin
651	+	Result := CreateArray(transaction,GetArrayMetaData(transaction,RelationName,ColumnName));
652	+	end;
653	+
654	+	function TFBAttachment.OpenArray(transaction: ITransaction; RelationName,
655	+	ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
656	+	begin
657	+	Result := OpenArray(transaction,
658	+	GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
659	+	end;
660	+
661	+	function TFBAttachment.GetDBInformation(Requests: array of byte
662	+	): IDBInformation;
663	+	var ReqBuffer: PByte;
664	+	i: integer;
665	+	begin
666	+	CheckHandle;
667	+	if Length(Requests) = 1 then
668	+	Result := GetDBInformation(Requests[0])
669	+	else
670	+	begin
671	+	GetMem(ReqBuffer,Length(Requests));
672	+	try
673	+	for i := 0 to Length(Requests) - 1 do
674	+	ReqBuffer[i] := Requests[i];
675	+
676	+	Result := GetDBInfo(ReqBuffer,Length(Requests));
677	+
678	+	finally
679	+	FreeMem(ReqBuffer);
680	+	end;
681	+	end;
682	+	end;
683	+
684	+	function TFBAttachment.GetDBInformation(Request: byte): IDBInformation;
685	+	begin
686	+	CheckHandle;
687	+	Result := GetDBInfo(@Request,1);
688	+	end;
689	+
690	+	function TFBAttachment.GetDBInformation(Requests: IDIRB): IDBInformation;
691	+	begin
692	+	CheckHandle;
693	+	with Requests as TDIRB do
694	+	Result := GetDBInfo(getBuffer,getDataLength);
695	+	end;
696	+
697		function TFBAttachment.GetConnectString: AnsiString;
698		begin
699		Result := FDatabaseName;
#	Line 595 | Line 704 | begin
704		Result := FRemoteProtocol;
705		end;
706
707	+	function TFBAttachment.GetAuthenticationMethod: AnsiString;
708	+	begin
709	+	Result := FAuthMethod;
710	+	end;
711	+
712	+	function TFBAttachment.GetSecurityDatabase: AnsiString;
713	+	begin
714	+	Result := FSecDatabase;
715	+	end;
716	+
717		function TFBAttachment.GetODSMajorVersion: integer;
718		begin
719		Result := FODSMajorVersion;
#	Line 684 | Line 803 | var i: integer;
803		begin
804		Result := false;
805		for i := Low(CharSetMap) to High(CharSetMap) do
806	<	if AnsiCompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then
806	>	if AnsiCompareText(CharSetMap[i].CharSetName, CharSetName) = 0 then
807		begin
808		CharSetID := CharSetMap[i].CharSetID;
809		Result := true;
#	Line 692 | Line 811 | begin
811		end;
812
813		for i := 0 to Length(FUserCharSetMap) - 1 do
814	<	if AnsiCompareStr(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
814	>	if AnsiCompareText(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
815		begin
816		CharSetID := FUserCharSetMap[i].CharSetID;
817		Result := true;

Diff Legend

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