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 60 by tony, Mon Mar 27 15:21:02 2017 UTC vs.
Revision 291 by tony, Fri Apr 17 10:26:08 2020 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
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	<	{Character Sets}
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}
149	>	function HasDefaultCharSet: boolean;
150	>	function GetDefaultCharSetID: integer;
151		function GetCharsetName(CharSetID: integer): AnsiString;
152		function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
153		function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
#	Line 121 | 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	<	property HasDefaultCharSet: boolean read FHasDefaultCharSet;
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;
166	>	uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
167
168		const
169		CharSetMap: array [0..69] of TCharsetMap = (
#	Line 209 | Line 244 | const
244
245		{ TFBAttachment }
246
247	<	constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
248	<	RaiseExceptionOnConnectError: boolean);
247	>	procedure TFBAttachment.GetODSAndConnectionInfo;
248	>	var DBInfo: IDBInformation;
249	>	i: integer;
250	>	Stmt: IStatement;
251	>	ResultSet: IResultSet;
252	>	Param: IDPBItem;
253	>	begin
254	>	if not IsConnected then Exit;
255	>	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
256	>	isc_info_db_SQL_Dialect]);
257	>	for i := 0 to DBInfo.GetCount - 1 do
258	>	with DBInfo[i] do
259	>	case getItemType of
260	>	isc_info_ods_minor_version:
261	>	FODSMinorVersion := getAsInteger;
262	>	isc_info_ods_version:
263	>	FODSMajorVersion := getAsInteger;
264	>	isc_info_db_SQL_Dialect:
265	>	FSQLDialect := getAsInteger;
266	>	end;
267	>
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 '+
291	>	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
292	>	ResultSet := Stmt.OpenCursor;
293	>	if ResultSet.FetchNext then
294	>	begin
295	>	FCharSetID := ResultSet[0].AsInteger;
296	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
297	>	end
298	>	end
299	>	else
300	>	if DPB <> nil then
301	>	begin
302	>	Param :=  DPB.Find(isc_dpb_lc_ctype);
303	>	if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
304	>	FCharSetID := 0;
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(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;
323		SetLength(FUserCharSetMap,0);
324		FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
325	+	FODSMajorVersion := 0;
326	+	FODSMinorVersion := 0;
327		end;
328
329		function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
#	Line 265 | Line 370 | begin
370		end;
371		end;
372
373	+	{$IFDEF HASREQEX}
374	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
375	+	var RegexObj: TRegExpr;
376	+	begin
377	+	FDPB := FFirebirdAPI.AllocateDPB;
378	+	RegexObj := TRegExpr.Create;
379	+	try
380	+	{extact database file spec}
381	+	RegexObj.ModifierG := false; {turn off greedy matches}
382	+	RegexObj.ModifierI := true; {case insensitive match}
383	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''(.+)'' PASSWORD +''(.+)''';
384	+	if RegexObj.Exec(CreateSQL) then
385	+	begin
386	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
387	+	DPB.Add(isc_dpb_password).AsString := system.copy(CreateSQL,RegexObj.MatchPos[3],RegexObj.MatchLen[3]);
388	+	end
389	+	else
390	+	begin
391	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
392	+	if RegexObj.Exec(CreateSQL) then
393	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
394	+	end;
395	+	finally
396	+	RegexObj.Free;
397	+	end;
398	+	if FCharSetID > 0 then
399	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
400	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
401	+	end;
402	+	{$ELSE}
403	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
404	+	begin
405	+	FDPB := FFirebirdAPI.AllocateDPB;
406	+	if FCharSetID > 0 then
407	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
408	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
409	+	end;
410	+	{$ENDIF}
411	+
412		procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
413		params: array of const);
414		var i: integer;
#	Line 277 | Line 421 | begin
421		case params[i].vtype of
422		vtinteger    :
423		SQLParams[i].AsInteger := params[i].vinteger;
424	+	vtInt64:
425	+	SQLParams[i].AsInt64 := params[i].VInt64^;
426	+	{$IF declared (vtQWord)}
427	+	vtQWord:
428	+	SQLParams[i].AsInt64 := params[i].VQWord^;
429	+	{$IFEND}
430		vtboolean    :
431		SQLParams[i].AsBoolean :=  params[i].vboolean;
432		vtchar       :
#	Line 286 | Line 436 | begin
436		vtCurrency:
437		SQLParams[i].AsDouble := params[i].VCurrency^;
438		vtString     :
439	<	SQLParams[i].AsString := params[i].VString^;
439	>	SQLParams[i].AsString := strpas(PChar(params[i].VString));
440		vtPChar      :
441		SQLParams[i].AsString := strpas(params[i].VPChar);
442		vtAnsiString :
443	<	SQLParams[i].AsString := AnsiString(params[i].VAnsiString^);
443	>	SQLParams[i].AsString := strpas(PAnsiChar(params[i].VAnsiString));
444		vtVariant:
445		SQLParams[i].AsVariant := params[i].VVariant^;
446	+	vtWideChar:
447	+	SQLParams[i].AsString := UTF8Encode(WideCharLenToString(@params[i].VWideChar,1));
448	+	vtPWideChar:
449	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VPWideChar)));
450	+	vtWideString:
451	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VWideString)));
452	+	vtUnicodeString:
453	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VUnicodeString)));
454		else
455		IBError(ibxeInvalidVariantType,[nil]);
456		end;
#	Line 305 | 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 312 | 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 334 | Line 502 | end;
502		function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
503		SQLDialect: integer; params: array of const): IResults;
504		begin
505	<	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
505	>	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
506		end;
507
508		function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
#	Line 435 | 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 457 | 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;
700	+	end;
701	+
702	+	function TFBAttachment.GetRemoteProtocol: AnsiString;
703	+	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;
720	+	end;
721	+
722	+	function TFBAttachment.GetODSMinorVersion: integer;
723	+	begin
724	+	Result := FODSMinorVersion;
725	+	end;
726	+
727	+	function TFBAttachment.HasDefaultCharSet: boolean;
728	+	begin
729	+	Result := FHasDefaultCharSet
730	+	end;
731	+
732	+	function TFBAttachment.GetDefaultCharSetID: integer;
733	+	begin
734	+	Result := FCharsetID;
735	+	end;
736	+
737		function TFBAttachment.GetCharsetName(CharSetID: integer): AnsiString;
738		var i: integer;
739		begin
#	Line 532 | 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 540 | 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