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 70 by tony, Thu Oct 26 12:59:51 2017 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 54 | Line 56 | type
56		private
57		FDPB: IDPB;
58		FFirebirdAPI: IFirebirdAPI;
59	+	FODSMajorVersion: integer;
60	+	FODSMinorVersion: integer;
61		FUserCharSetMap: array of TCharSetMap;
62	+	FSecDatabase: AnsiString;
63		protected
64		FDatabaseName: AnsiString;
65		FRaiseExceptionOnConnectError: boolean;
#	Line 62 | Line 67 | type
67		FHasDefaultCharSet: boolean;
68		FCharSetID: integer;
69		FCodePage: TSystemCodePage;
70	<	constructor Create(DatabaseName: AnsiString; DPB: IDPB;
70	>	FRemoteProtocol: AnsiString;
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 113 | Line 126 | type
126		property SQLDialect: integer read FSQLDialect;
127		property DPB: IDPB read FDPB;
128		public
129	<	{Character Sets}
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}
139	>	function HasDefaultCharSet: boolean;
140	>	function GetDefaultCharSetID: integer;
141		function GetCharsetName(CharSetID: integer): AnsiString;
142		function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
143		function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
#	Line 121 | Line 145 | public
145		function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
146		procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
147		AllowReverseLookup:boolean; out CharSetID: integer);
124	–	property HasDefaultCharSet: boolean read FHasDefaultCharSet;
148		property CharSetID: integer read FCharSetID;
149		property CodePage: TSystemCodePage read FCodePage;
150		end;
151
152		implementation
153
154	<	uses FBMessages, FBTransaction;
154	>	uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
155
156		const
157		CharSetMap: array [0..69] of TCharsetMap = (
#	Line 209 | Line 232 | const
232
233		{ TFBAttachment }
234
235	<	constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
236	<	RaiseExceptionOnConnectError: boolean);
235	>	procedure TFBAttachment.GetODSAndConnectionInfo;
236	>	var DBInfo: IDBInformation;
237	>	i: integer;
238	>	Stmt: IStatement;
239	>	ResultSet: IResultSet;
240	>	Param: IDPBItem;
241	>	begin
242	>	if not IsConnected then Exit;
243	>	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
244	>	isc_info_db_SQL_Dialect]);
245	>	for i := 0 to DBInfo.GetCount - 1 do
246	>	with DBInfo[i] do
247	>	case getItemType of
248	>	isc_info_ods_minor_version:
249	>	FODSMinorVersion := getAsInteger;
250	>	isc_info_ods_version:
251	>	FODSMajorVersion := getAsInteger;
252	>	isc_info_db_SQL_Dialect:
253	>	FSQLDialect := getAsInteger;
254	>	end;
255	>
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 '+
279	>	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
280	>	ResultSet := Stmt.OpenCursor;
281	>	if ResultSet.FetchNext then
282	>	begin
283	>	FCharSetID := ResultSet[0].AsInteger;
284	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
285	>	end
286	>	end
287	>	else
288	>	if DPB <> nil then
289	>	begin
290	>	Param :=  DPB.Find(isc_dpb_lc_ctype);
291	>	if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
292	>	FCharSetID := 0;
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(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;
311		SetLength(FUserCharSetMap,0);
312		FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
313	+	FODSMajorVersion := 0;
314	+	FODSMinorVersion := 0;
315		end;
316
317		function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
#	Line 265 | Line 358 | begin
358		end;
359		end;
360
361	+	{$IFDEF HASREQEX}
362	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
363	+	var RegexObj: TRegExpr;
364	+	begin
365	+	FDPB := FFirebirdAPI.AllocateDPB;
366	+	RegexObj := TRegExpr.Create;
367	+	try
368	+	{extact database file spec}
369	+	RegexObj.ModifierG := false; {turn off greedy matches}
370	+	RegexObj.ModifierI := true; {case insensitive match}
371	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''(.+)'' PASSWORD +''(.+)''';
372	+	if RegexObj.Exec(CreateSQL) then
373	+	begin
374	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
375	+	DPB.Add(isc_dpb_password).AsString := system.copy(CreateSQL,RegexObj.MatchPos[3],RegexObj.MatchLen[3]);
376	+	end
377	+	else
378	+	begin
379	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
380	+	if RegexObj.Exec(CreateSQL) then
381	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
382	+	end;
383	+	finally
384	+	RegexObj.Free;
385	+	end;
386	+	if FCharSetID > 0 then
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);
402		var i: integer;
#	Line 319 | 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 326 | 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 348 | Line 490 | end;
490		function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
491		SQLDialect: integer; params: array of const): IResults;
492		begin
493	<	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
493	>	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
494		end;
495
496		function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
#	Line 477 | 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;
661	+	end;
662	+
663	+	function TFBAttachment.GetRemoteProtocol: AnsiString;
664	+	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;
681	+	end;
682	+
683	+	function TFBAttachment.GetODSMinorVersion: integer;
684	+	begin
685	+	Result := FODSMinorVersion;
686	+	end;
687	+
688	+	function TFBAttachment.HasDefaultCharSet: boolean;
689	+	begin
690	+	Result := FHasDefaultCharSet
691	+	end;
692	+
693	+	function TFBAttachment.GetDefaultCharSetID: integer;
694	+	begin
695	+	Result := FCharsetID;
696	+	end;
697	+
698		function TFBAttachment.GetCharsetName(CharSetID: integer): AnsiString;
699		var i: integer;
700		begin
#	Line 546 | 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 554 | 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