ViewVC Help

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

root/public/ibx/branches/udr/client/FBAttachment.pas

Comparing ibx/trunk/fbintf/client/FBAttachment.pas (file contents):
Revision 118 by tony, Mon Jan 22 13:58:14 2018 UTC vs.
Revision 270 by tony, Fri Jan 18 11:10:37 2019 UTC

#	Line 27 | Line 27
27		unit FBAttachment;
28		{$IFDEF MSWINDOWS}
29		{$DEFINE WINDOWS}
30	–	{$IF 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
#	Line 124 | Line 128 | type
128		property SQLDialect: integer read FSQLDialect;
129		property DPB: IDPB read FDPB;
130		public
131	<	function GetDBInformation(Requests: array of byte): IDBInformation; overload; virtual; abstract;
132	<	function GetDBInformation(Request: byte): IDBInformation; overload; virtual; abstract;
131	>	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
132	>	function GetDBInformation(Request: byte): IDBInformation; overload;
133	>	function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
134		function GetConnectString: AnsiString;
135		function GetRemoteProtocol: AnsiString;
136	+	function GetAuthenticationMethod: AnsiString;
137	+	function GetSecurityDatabase: AnsiString;
138		function GetODSMajorVersion: integer;
139		function GetODSMinorVersion: integer;
140		{Character Sets}
#	Line 146 | Line 153 | public
153
154		implementation
155
156	<	uses FBMessages, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
156	>	uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
157
158		const
159		CharSetMap: array [0..69] of TCharsetMap = (
#	Line 248 | Line 255 | begin
255		FSQLDialect := getAsInteger;
256		end;
257
258	<	if (FODSMajorVersion > 11) or ((FODSMajorVersion = 11) and (FODSMinorVersion >= 1)) then
258	>	FCharSetID := 0;
259	>	FRemoteProtocol := '';
260	>	FAuthMethod := 'Legacy_Auth';
261	>	FSecDatabase := 'Default';
262	>	if FODSMajorVersion > 11 then
263	>	begin
264	>	Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
265	>	'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD, MON$SEC_DATABASE From MON$ATTACHMENTS, MON$DATABASE '+
266	>	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
267	>	ResultSet := Stmt.OpenCursor;
268	>	if ResultSet.FetchNext then
269	>	begin
270	>	FCharSetID := ResultSet[0].AsInteger;
271	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
272	>	FAuthMethod := Trim(ResultSet[2].AsString);
273	>	FSecDatabase := Trim(ResultSet[3].AsString);
274	>	end
275	>	end
276	>	else
277	>	if (FODSMajorVersion = 11) and (FODSMinorVersion >= 1) then
278		begin
279		Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
280		'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+
#	Line 257 | Line 283 | begin
283		if ResultSet.FetchNext then
284		begin
285		FCharSetID := ResultSet[0].AsInteger;
286	<	FRemoteProtocol := ResultSet[1].AsString;
286	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
287		end
288		end
289		else
#	Line 266 | Line 292 | begin
292		Param :=  DPB.Find(isc_dpb_lc_ctype);
293		if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
294		FCharSetID := 0;
295	<	FRemoteProtocol := '';
296	<	end
297	<	else
298	<	begin
299	<	FCharSetID := 0;
300	<	FRemoteProtocol := '';
295	>	case GetProtocol(FDatabaseName) of
296	>	TCP:       FRemoteProtocol := 'TCPv4';
297	>	Local:     FRemoteProtocol := '';
298	>	NamedPipe: FRemoteProtocol := 'Netbui';
299	>	SPX:       FRemoteProtocol := 'SPX'
300	>	end;
301		end;
302		FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
303		end;
304
305	<	constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
306	<	RaiseExceptionOnConnectError: boolean);
305	>	constructor TFBAttachment.Create(api: TFBClientAPI; DatabaseName: AnsiString;
306	>	DPB: IDPB; RaiseExceptionOnConnectError: boolean);
307		begin
308		inherited Create;
309	<	FFirebirdAPI := FirebirdAPI; {Keep reference to interface}
309	>	FFirebirdAPI := api.GetAPI; {Keep reference to interface}
310		FSQLDialect := 3;
311		FDatabaseName := DatabaseName;
312		FDPB := DPB;
#	Line 365 | Line 391 | begin
391		end;
392		{$ELSE}
393		procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
394	+	begin
395	+	FDPB := FFirebirdAPI.AllocateDPB;
396	+	if FCharSetID > 0 then
397	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
398	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
399		end;
400		{$ENDIF}
401
#	Line 422 | Line 453 | begin
453		inherited Destroy;
454		end;
455
456	+	function TFBAttachment.getFirebirdAPI: IFirebirdAPI;
457	+	begin
458	+	Result := FFirebirdAPI;
459	+	end;
460	+
461		function TFBAttachment.getDPB: IDPB;
462		begin
463		Result := FDPB;
#	Line 429 | Line 465 | end;
465
466		function TFBAttachment.AllocateBPB: IBPB;
467		begin
468	<	Result := TBPB.Create;
468	>	Result := TBPB.Create(FFirebirdAPI as TFBClientAPI);
469	>	end;
470	>
471	>	function TFBAttachment.AllocateDIRB: IDIRB;
472	>	begin
473	>	Result := TDIRB.Create(FFirebirdAPI as TFBClientAPI);
474		end;
475
476		procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString;
#	Line 552 | Line 593 | begin
593		end;
594
595		function TFBAttachment.PrepareWithNamedParameters(transaction: ITransaction;
596	<	sql: AnsiString; GenerateParamNames: boolean): IStatement;
596	>	sql: AnsiString; GenerateParamNames: boolean; CaseSensitiveParams: boolean): IStatement;
597		begin
598	<	Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames);
598	>	Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames,CaseSensitiveParams);
599		end;
600
601		function TFBAttachment.GetEventHandler(Event: AnsiString): IEvents;
#	Line 580 | Line 621 | begin
621		Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
622		end;
623
624	+	function TFBAttachment.GetDBInformation(Requests: array of byte
625	+	): IDBInformation;
626	+	var ReqBuffer: PByte;
627	+	i: integer;
628	+	begin
629	+	CheckHandle;
630	+	if Length(Requests) = 1 then
631	+	Result := GetDBInformation(Requests[0])
632	+	else
633	+	begin
634	+	GetMem(ReqBuffer,Length(Requests));
635	+	try
636	+	for i := 0 to Length(Requests) - 1 do
637	+	ReqBuffer[i] := Requests[i];
638	+
639	+	Result := GetDBInfo(ReqBuffer,Length(Requests));
640	+
641	+	finally
642	+	FreeMem(ReqBuffer);
643	+	end;
644	+	end;
645	+	end;
646	+
647	+	function TFBAttachment.GetDBInformation(Request: byte): IDBInformation;
648	+	begin
649	+	CheckHandle;
650	+	Result := GetDBInfo(@Request,1);
651	+	end;
652	+
653	+	function TFBAttachment.GetDBInformation(Requests: IDIRB): IDBInformation;
654	+	begin
655	+	CheckHandle;
656	+	with Requests as TDIRB do
657	+	Result := GetDBInfo(getBuffer,getDataLength);
658	+	end;
659	+
660		function TFBAttachment.GetConnectString: AnsiString;
661		begin
662		Result := FDatabaseName;
#	Line 590 | Line 667 | begin
667		Result := FRemoteProtocol;
668		end;
669
670	+	function TFBAttachment.GetAuthenticationMethod: AnsiString;
671	+	begin
672	+	Result := FAuthMethod;
673	+	end;
674	+
675	+	function TFBAttachment.GetSecurityDatabase: AnsiString;
676	+	begin
677	+	Result := FSecDatabase;
678	+	end;
679	+
680		function TFBAttachment.GetODSMajorVersion: integer;
681		begin
682		Result := FODSMajorVersion;
#	Line 679 | Line 766 | var i: integer;
766		begin
767		Result := false;
768		for i := Low(CharSetMap) to High(CharSetMap) do
769	<	if AnsiCompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then
769	>	if AnsiCompareText(CharSetMap[i].CharSetName, CharSetName) = 0 then
770		begin
771		CharSetID := CharSetMap[i].CharSetID;
772		Result := true;
#	Line 687 | Line 774 | begin
774		end;
775
776		for i := 0 to Length(FUserCharSetMap) - 1 do
777	<	if AnsiCompareStr(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
777	>	if AnsiCompareText(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
778		begin
779		CharSetID := FUserCharSetMap[i].CharSetID;
780		Result := true;

Diff Legend

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