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 109 by tony, Thu Jan 18 14:37:48 2018 UTC vs.
Revision 270 by tony, Fri Jan 18 11:10:37 2019 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 101 | 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 113 | Line 128 | type
128		property SQLDialect: integer read FSQLDialect;
129		property DPB: IDPB read FDPB;
130		public
131	<	{Character Sets}
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}
141		function HasDefaultCharSet: boolean;
142		function GetDefaultCharSetID: integer;
143		function GetCharsetName(CharSetID: integer): AnsiString;
#	Line 129 | Line 153 | public
153
154		implementation
155
156	<	uses FBMessages, FBTransaction;
156	>	uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
157
158		const
159		CharSetMap: array [0..69] of TCharsetMap = (
#	Line 210 | Line 234 | const
234
235		{ TFBAttachment }
236
237	<	constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
238	<	RaiseExceptionOnConnectError: boolean);
237	>	procedure TFBAttachment.GetODSAndConnectionInfo;
238	>	var DBInfo: IDBInformation;
239	>	i: integer;
240	>	Stmt: IStatement;
241	>	ResultSet: IResultSet;
242	>	Param: IDPBItem;
243	>	begin
244	>	if not IsConnected then Exit;
245	>	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
246	>	isc_info_db_SQL_Dialect]);
247	>	for i := 0 to DBInfo.GetCount - 1 do
248	>	with DBInfo[i] do
249	>	case getItemType of
250	>	isc_info_ods_minor_version:
251	>	FODSMinorVersion := getAsInteger;
252	>	isc_info_ods_version:
253	>	FODSMajorVersion := getAsInteger;
254	>	isc_info_db_SQL_Dialect:
255	>	FSQLDialect := getAsInteger;
256	>	end;
257	>
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 '+
281	>	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
282	>	ResultSet := Stmt.OpenCursor;
283	>	if ResultSet.FetchNext then
284	>	begin
285	>	FCharSetID := ResultSet[0].AsInteger;
286	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
287	>	end
288	>	end
289	>	else
290	>	if DPB <> nil then
291	>	begin
292	>	Param :=  DPB.Find(isc_dpb_lc_ctype);
293	>	if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
294	>	FCharSetID := 0;
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(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;
313		SetLength(FUserCharSetMap,0);
314		FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
315	+	FODSMajorVersion := 0;
316	+	FODSMinorVersion := 0;
317		end;
318
319		function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
#	Line 266 | Line 360 | begin
360		end;
361		end;
362
363	+	{$IFDEF HASREQEX}
364	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
365	+	var RegexObj: TRegExpr;
366	+	begin
367	+	FDPB := FFirebirdAPI.AllocateDPB;
368	+	RegexObj := TRegExpr.Create;
369	+	try
370	+	{extact database file spec}
371	+	RegexObj.ModifierG := false; {turn off greedy matches}
372	+	RegexObj.ModifierI := true; {case insensitive match}
373	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''(.+)'' PASSWORD +''(.+)''';
374	+	if RegexObj.Exec(CreateSQL) then
375	+	begin
376	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
377	+	DPB.Add(isc_dpb_password).AsString := system.copy(CreateSQL,RegexObj.MatchPos[3],RegexObj.MatchLen[3]);
378	+	end
379	+	else
380	+	begin
381	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
382	+	if RegexObj.Exec(CreateSQL) then
383	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
384	+	end;
385	+	finally
386	+	RegexObj.Free;
387	+	end;
388	+	if FCharSetID > 0 then
389	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
390	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
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	+
402		procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
403		params: array of const);
404		var i: integer;
#	Line 320 | 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 327 | 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 349 | Line 492 | end;
492		function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
493		SQLDialect: integer; params: array of const): IResults;
494		begin
495	<	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
495	>	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
496		end;
497
498		function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
#	Line 450 | 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 478 | 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;
663	+	end;
664	+
665	+	function TFBAttachment.GetRemoteProtocol: AnsiString;
666	+	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;
683	+	end;
684	+
685	+	function TFBAttachment.GetODSMinorVersion: integer;
686	+	begin
687	+	Result := FODSMinorVersion;
688	+	end;
689	+
690		function TFBAttachment.HasDefaultCharSet: boolean;
691		begin
692		Result := FHasDefaultCharSet
#	Line 557 | 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 565 | 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