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 117 by tony, Mon Jan 22 13:58:11 2018 UTC vs.
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC

#	Line 32 | Line 32 | unit FBAttachment;
32		{$IFDEF FPC}
33		{$mode delphi}
34		{$interfaces COM}
35	+	{$define HASREQEX}
36		{$ENDIF}
37
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 57 | 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 65 | 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 119 | Line 126 | type
126		property SQLDialect: integer read FSQLDialect;
127		property DPB: IDPB read FDPB;
128		public
129	<	function GetDBInformation(Requests: array of byte): IDBInformation; overload; virtual; abstract;
130	<	function GetDBInformation(Request: byte): IDBInformation; overload; virtual; abstract;
129	>	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
130	>	function GetDBInformation(Request: byte): IDBInformation; overload;
131	>	function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
132		function GetConnectString: AnsiString;
133		function GetRemoteProtocol: AnsiString;
134	+	function GetAuthenticationMethod: AnsiString;
135	+	function GetSecurityDatabase: AnsiString;
136		function GetODSMajorVersion: integer;
137		function GetODSMinorVersion: integer;
138		{Character Sets}
#	Line 141 | Line 151 | public
151
152		implementation
153
154	<	uses FBMessages, FBTransaction, RegExpr;
154	>	uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
155
156		const
157		CharSetMap: array [0..69] of TCharsetMap = (
#	Line 243 | Line 253 | begin
253		FSQLDialect := getAsInteger;
254		end;
255
256	<	if (FODSMajorVersion > 11) or ((FODSMajorVersion = 11) and (FODSMinorVersion >= 1)) then
256	>	FCharSetID := 0;
257	>	FRemoteProtocol := '';
258	>	FAuthMethod := 'Legacy_Auth';
259	>	FSecDatabase := 'Default';
260	>	if FODSMajorVersion > 11 then
261	>	begin
262	>	Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
263	>	'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD, MON$SEC_DATABASE From MON$ATTACHMENTS, MON$DATABASE '+
264	>	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
265	>	ResultSet := Stmt.OpenCursor;
266	>	if ResultSet.FetchNext then
267	>	begin
268	>	FCharSetID := ResultSet[0].AsInteger;
269	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
270	>	FAuthMethod := Trim(ResultSet[2].AsString);
271	>	FSecDatabase := Trim(ResultSet[3].AsString);
272	>	end
273	>	end
274	>	else
275	>	if (FODSMajorVersion = 11) and (FODSMinorVersion >= 1) then
276		begin
277		Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
278		'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+
#	Line 252 | Line 281 | begin
281		if ResultSet.FetchNext then
282		begin
283		FCharSetID := ResultSet[0].AsInteger;
284	<	FRemoteProtocol := ResultSet[1].AsString;
284	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
285		end
286		end
287		else
#	Line 261 | Line 290 | begin
290		Param :=  DPB.Find(isc_dpb_lc_ctype);
291		if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
292		FCharSetID := 0;
293	<	FRemoteProtocol := '';
294	<	end
295	<	else
296	<	begin
297	<	FCharSetID := 0;
298	<	FRemoteProtocol := '';
293	>	case GetProtocol(FDatabaseName) of
294	>	TCP:       FRemoteProtocol := 'TCPv4';
295	>	Local:     FRemoteProtocol := '';
296	>	NamedPipe: FRemoteProtocol := 'Netbui';
297	>	SPX:       FRemoteProtocol := 'SPX'
298	>	end;
299		end;
300		FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
301		end;
302
303	<	constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
304	<	RaiseExceptionOnConnectError: boolean);
303	>	constructor TFBAttachment.Create(api: TFBClientAPI; DatabaseName: AnsiString;
304	>	DPB: IDPB; RaiseExceptionOnConnectError: boolean);
305		begin
306		inherited Create;
307	<	FFirebirdAPI := FirebirdAPI; {Keep reference to interface}
307	>	FFirebirdAPI := api.GetAPI; {Keep reference to interface}
308		FSQLDialect := 3;
309		FDatabaseName := DatabaseName;
310		FDPB := DPB;
#	Line 329 | Line 358 | begin
358		end;
359		end;
360
361	+	{$IFDEF HASREQEX}
362		procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
363		var RegexObj: TRegExpr;
364		begin
#	Line 357 | Line 387 | begin
387		DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
388		DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
389		end;
390	+	{$ELSE}
391	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
392	+	begin
393	+	FDPB := FFirebirdAPI.AllocateDPB;
394	+	if FCharSetID > 0 then
395	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
396	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
397	+	end;
398	+	{$ENDIF}
399
400		procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
401		params: array of const);
#	Line 412 | Line 451 | begin
451		inherited Destroy;
452		end;
453
454	+	function TFBAttachment.getFirebirdAPI: IFirebirdAPI;
455	+	begin
456	+	Result := FFirebirdAPI;
457	+	end;
458	+
459		function TFBAttachment.getDPB: IDPB;
460		begin
461		Result := FDPB;
#	Line 419 | Line 463 | end;
463
464		function TFBAttachment.AllocateBPB: IBPB;
465		begin
466	<	Result := TBPB.Create;
466	>	Result := TBPB.Create(FFirebirdAPI as TFBClientAPI);
467	>	end;
468	>
469	>	function TFBAttachment.AllocateDIRB: IDIRB;
470	>	begin
471	>	Result := TDIRB.Create(FFirebirdAPI as TFBClientAPI);
472		end;
473
474		procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString;
#	Line 570 | Line 619 | begin
619		Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
620		end;
621
622	+	function TFBAttachment.GetDBInformation(Requests: array of byte
623	+	): IDBInformation;
624	+	var ReqBuffer: PByte;
625	+	i: integer;
626	+	begin
627	+	CheckHandle;
628	+	if Length(Requests) = 1 then
629	+	Result := GetDBInformation(Requests[0])
630	+	else
631	+	begin
632	+	GetMem(ReqBuffer,Length(Requests));
633	+	try
634	+	for i := 0 to Length(Requests) - 1 do
635	+	ReqBuffer[i] := Requests[i];
636	+
637	+	Result := GetDBInfo(ReqBuffer,Length(Requests));
638	+
639	+	finally
640	+	FreeMem(ReqBuffer);
641	+	end;
642	+	end;
643	+	end;
644	+
645	+	function TFBAttachment.GetDBInformation(Request: byte): IDBInformation;
646	+	begin
647	+	CheckHandle;
648	+	Result := GetDBInfo(@Request,1);
649	+	end;
650	+
651	+	function TFBAttachment.GetDBInformation(Requests: IDIRB): IDBInformation;
652	+	begin
653	+	CheckHandle;
654	+	with Requests as TDIRB do
655	+	Result := GetDBInfo(getBuffer,getDataLength);
656	+	end;
657	+
658		function TFBAttachment.GetConnectString: AnsiString;
659		begin
660		Result := FDatabaseName;
#	Line 580 | Line 665 | begin
665		Result := FRemoteProtocol;
666		end;
667
668	+	function TFBAttachment.GetAuthenticationMethod: AnsiString;
669	+	begin
670	+	Result := FAuthMethod;
671	+	end;
672	+
673	+	function TFBAttachment.GetSecurityDatabase: AnsiString;
674	+	begin
675	+	Result := FSecDatabase;
676	+	end;
677	+
678		function TFBAttachment.GetODSMajorVersion: integer;
679		begin
680		Result := FODSMajorVersion;
#	Line 669 | Line 764 | var i: integer;
764		begin
765		Result := false;
766		for i := Low(CharSetMap) to High(CharSetMap) do
767	<	if AnsiCompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then
767	>	if AnsiCompareText(CharSetMap[i].CharSetName, CharSetName) = 0 then
768		begin
769		CharSetID := CharSetMap[i].CharSetID;
770		Result := true;
#	Line 677 | Line 772 | begin
772		end;
773
774		for i := 0 to Length(FUserCharSetMap) - 1 do
775	<	if AnsiCompareStr(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
775	>	if AnsiCompareText(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
776		begin
777		CharSetID := FUserCharSetMap[i].CharSetID;
778		Result := true;

Diff Legend

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